diff options
342 files changed, 5468 insertions, 2252 deletions
diff --git a/.gitignore b/.gitignore index 011463cbc9..cbf7881ae7 100644 --- a/.gitignore +++ b/.gitignore @@ -132,6 +132,7 @@ JAVADOC-GENERATED /bootstrap/lib/ic /bootstrap/lib/orber /bootstrap/lib/parsetools +/bootstrap/lib/runtime_tools /bootstrap/lib/sasl /bootstrap/lib/snmp /bootstrap/lib/syntax_tools diff --git a/Makefile.in b/Makefile.in index 3289f1d86b..ca31955c7d 100644 --- a/Makefile.in +++ b/Makefile.in @@ -694,6 +694,8 @@ tertiary_bootstrap_copy: $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/wx/include ; fi $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test ; fi $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/common_test/include ; fi + $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools ; fi + $(V_at)if test ! -d $(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools/include ; then mkdir $(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools/include ; fi $(V_at)for x in lib/ic/ebin/*.beam; do \ BN=`basename $$x`; \ TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/ic/ebin/$$BN; \ @@ -782,6 +784,18 @@ tertiary_bootstrap_copy: cp $$x $$TF; \ true; \ done + +# copy runtime_tool includes to be able to compile with include_lib + $(V_at)for x in lib/runtime_tools/include/*.hrl; do \ + BN=`basename $$x`; \ + TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/runtime_tools/include/$$BN; \ + test -f $$TF && \ + test '!' -z "`find $$x -newer $$TF -print`" && \ + cp $$x $$TF; \ + test '!' -f $$TF && \ + cp $$x $$TF; \ + true; \ + done # $(V_at)cp lib/syntax_tools/ebin/*.beam $(BOOTSTRAP_ROOT)/bootstrap/lib/syntax_tools/ebin doc_bootstrap_build: diff --git a/bootstrap/bin/no_dot_erlang.boot b/bootstrap/bin/no_dot_erlang.boot Binary files differindex 2b909efb58..c8ea423483 100644 --- a/bootstrap/bin/no_dot_erlang.boot +++ b/bootstrap/bin/no_dot_erlang.boot diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex 2b909efb58..c8ea423483 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex 2b909efb58..c8ea423483 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam Binary files differindex 47376e1964..57affa6b30 100644 --- a/bootstrap/lib/compiler/ebin/beam_a.beam +++ b/bootstrap/lib/compiler/ebin/beam_a.beam diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 7ce46af61c..5e94a4b715 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam Binary files differindex 98d5ec2e59..082458338e 100644 --- a/bootstrap/lib/compiler/ebin/beam_block.beam +++ b/bootstrap/lib/compiler/ebin/beam_block.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bs.beam b/bootstrap/lib/compiler/ebin/beam_bs.beam Binary files differindex edbc6fd015..b624c01c96 100644 --- a/bootstrap/lib/compiler/ebin/beam_bs.beam +++ b/bootstrap/lib/compiler/ebin/beam_bs.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam Binary files differindex 087e0dcf84..9a3a7623af 100644 --- a/bootstrap/lib/compiler/ebin/beam_bsm.beam +++ b/bootstrap/lib/compiler/ebin/beam_bsm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam Binary files differindex c856c87a45..959137f06f 100644 --- a/bootstrap/lib/compiler/ebin/beam_clean.beam +++ b/bootstrap/lib/compiler/ebin/beam_clean.beam diff --git a/bootstrap/lib/compiler/ebin/beam_dead.beam b/bootstrap/lib/compiler/ebin/beam_dead.beam Binary files differindex bb72855294..7294026d65 100644 --- a/bootstrap/lib/compiler/ebin/beam_dead.beam +++ b/bootstrap/lib/compiler/ebin/beam_dead.beam diff --git a/bootstrap/lib/compiler/ebin/beam_dict.beam b/bootstrap/lib/compiler/ebin/beam_dict.beam Binary files differindex 913c0ec1fe..9c66f6d9f3 100644 --- a/bootstrap/lib/compiler/ebin/beam_dict.beam +++ b/bootstrap/lib/compiler/ebin/beam_dict.beam diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam Binary files differindex 1e6d90af35..256efdb750 100644 --- a/bootstrap/lib/compiler/ebin/beam_disasm.beam +++ b/bootstrap/lib/compiler/ebin/beam_disasm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_except.beam b/bootstrap/lib/compiler/ebin/beam_except.beam Binary files differindex b5f059596f..19b30319ab 100644 --- a/bootstrap/lib/compiler/ebin/beam_except.beam +++ b/bootstrap/lib/compiler/ebin/beam_except.beam diff --git a/bootstrap/lib/compiler/ebin/beam_flatten.beam b/bootstrap/lib/compiler/ebin/beam_flatten.beam Binary files differindex ebd383c76c..7fcbf5dcde 100644 --- a/bootstrap/lib/compiler/ebin/beam_flatten.beam +++ b/bootstrap/lib/compiler/ebin/beam_flatten.beam diff --git a/bootstrap/lib/compiler/ebin/beam_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam Binary files differindex 278f03351c..e51f1b179b 100644 --- a/bootstrap/lib/compiler/ebin/beam_jump.beam +++ b/bootstrap/lib/compiler/ebin/beam_jump.beam diff --git a/bootstrap/lib/compiler/ebin/beam_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam Binary files differindex 5e1235dca5..58c0b1c623 100644 --- a/bootstrap/lib/compiler/ebin/beam_peep.beam +++ b/bootstrap/lib/compiler/ebin/beam_peep.beam diff --git a/bootstrap/lib/compiler/ebin/beam_receive.beam b/bootstrap/lib/compiler/ebin/beam_receive.beam Binary files differindex e19d878513..c662b603a4 100644 --- a/bootstrap/lib/compiler/ebin/beam_receive.beam +++ b/bootstrap/lib/compiler/ebin/beam_receive.beam diff --git a/bootstrap/lib/compiler/ebin/beam_record.beam b/bootstrap/lib/compiler/ebin/beam_record.beam Binary files differindex 542bd13d20..2901d6c33f 100644 --- a/bootstrap/lib/compiler/ebin/beam_record.beam +++ b/bootstrap/lib/compiler/ebin/beam_record.beam diff --git a/bootstrap/lib/compiler/ebin/beam_reorder.beam b/bootstrap/lib/compiler/ebin/beam_reorder.beam Binary files differindex 9f1668c97f..d3d0b89a35 100644 --- a/bootstrap/lib/compiler/ebin/beam_reorder.beam +++ b/bootstrap/lib/compiler/ebin/beam_reorder.beam diff --git a/bootstrap/lib/compiler/ebin/beam_split.beam b/bootstrap/lib/compiler/ebin/beam_split.beam Binary files differindex d53a8a8b97..88b3f96d8c 100644 --- a/bootstrap/lib/compiler/ebin/beam_split.beam +++ b/bootstrap/lib/compiler/ebin/beam_split.beam diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam Binary files differindex 9025e3ca1a..9143b1615d 100644 --- a/bootstrap/lib/compiler/ebin/beam_trim.beam +++ b/bootstrap/lib/compiler/ebin/beam_trim.beam diff --git a/bootstrap/lib/compiler/ebin/beam_type.beam b/bootstrap/lib/compiler/ebin/beam_type.beam Binary files differindex ecebbdef66..d3ca9d07de 100644 --- a/bootstrap/lib/compiler/ebin/beam_type.beam +++ b/bootstrap/lib/compiler/ebin/beam_type.beam diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex adb835d20a..24aaf40e10 100644 --- a/bootstrap/lib/compiler/ebin/beam_utils.beam +++ b/bootstrap/lib/compiler/ebin/beam_utils.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex 6597bc7ad6..e87c1ed4ae 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/beam_z.beam b/bootstrap/lib/compiler/ebin/beam_z.beam Binary files differindex a95d070cff..03685931e3 100644 --- a/bootstrap/lib/compiler/ebin/beam_z.beam +++ b/bootstrap/lib/compiler/ebin/beam_z.beam diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam Binary files differindex 7315ab8100..c49aac27a0 100644 --- a/bootstrap/lib/compiler/ebin/cerl.beam +++ b/bootstrap/lib/compiler/ebin/cerl.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam Binary files differindex 4036eaf5a6..7ae6b03424 100644 --- a/bootstrap/lib/compiler/ebin/cerl_inline.beam +++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex 1cfe725032..27e0802959 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index 01e2c478d4..286b48ec23 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -19,7 +19,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "7.1.3"}, + {vsn, "7.1.4"}, {modules, [ beam_a, beam_asm, diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam Binary files differindex 023a804f36..a6f6a886ca 100644 --- a/bootstrap/lib/compiler/ebin/core_lint.beam +++ b/bootstrap/lib/compiler/ebin/core_lint.beam diff --git a/bootstrap/lib/compiler/ebin/core_parse.beam b/bootstrap/lib/compiler/ebin/core_parse.beam Binary files differindex b04a7b4496..d3085e14fb 100644 --- a/bootstrap/lib/compiler/ebin/core_parse.beam +++ b/bootstrap/lib/compiler/ebin/core_parse.beam diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam Binary files differindex 45cacc510c..57ed874762 100644 --- a/bootstrap/lib/compiler/ebin/core_pp.beam +++ b/bootstrap/lib/compiler/ebin/core_pp.beam diff --git a/bootstrap/lib/compiler/ebin/core_scan.beam b/bootstrap/lib/compiler/ebin/core_scan.beam Binary files differindex cd266e0f99..6195c3f759 100644 --- a/bootstrap/lib/compiler/ebin/core_scan.beam +++ b/bootstrap/lib/compiler/ebin/core_scan.beam diff --git a/bootstrap/lib/compiler/ebin/rec_env.beam b/bootstrap/lib/compiler/ebin/rec_env.beam Binary files differindex 60e1f0401c..bd0b9c004c 100644 --- a/bootstrap/lib/compiler/ebin/rec_env.beam +++ b/bootstrap/lib/compiler/ebin/rec_env.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_alias.beam b/bootstrap/lib/compiler/ebin/sys_core_alias.beam Binary files differindex 5794eeda81..3757572a10 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_alias.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_alias.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_bsm.beam b/bootstrap/lib/compiler/ebin/sys_core_bsm.beam Binary files differindex 2d2373a0ff..22d045a8a7 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_bsm.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_bsm.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam Binary files differindex 4a0c518337..b2ca054d45 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex e4a69a7dc8..df1daa74d7 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam b/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam Binary files differindex 50bd3e5096..346ddcb2a7 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_inline.beam b/bootstrap/lib/compiler/ebin/sys_core_inline.beam Binary files differindex a52196c764..b64e1be0ad 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_inline.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_inline.beam diff --git a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam Binary files differindex 0752765115..2dd8388c18 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex 17cedb8eb1..2e88f9c333 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 0bd3b5b8f1..01055394ce 100644 --- a/bootstrap/lib/compiler/ebin/v3_core.beam +++ b/bootstrap/lib/compiler/ebin/v3_core.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam Binary files differindex 654dd30b41..1a5f4eb193 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam Binary files differindex f90f26392c..57f30e63d8 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam Binary files differindex 46be5c8f54..f7b9037688 100644 --- a/bootstrap/lib/kernel/ebin/application_controller.beam +++ b/bootstrap/lib/kernel/ebin/application_controller.beam diff --git a/bootstrap/lib/kernel/ebin/application_master.beam b/bootstrap/lib/kernel/ebin/application_master.beam Binary files differindex 892d58a8b1..9547b5e159 100644 --- a/bootstrap/lib/kernel/ebin/application_master.beam +++ b/bootstrap/lib/kernel/ebin/application_master.beam diff --git a/bootstrap/lib/kernel/ebin/auth.beam b/bootstrap/lib/kernel/ebin/auth.beam Binary files differindex cb1b5fe5b2..41b47131c4 100644 --- a/bootstrap/lib/kernel/ebin/auth.beam +++ b/bootstrap/lib/kernel/ebin/auth.beam diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam Binary files differindex c823be3cc9..108b562bea 100644 --- a/bootstrap/lib/kernel/ebin/code.beam +++ b/bootstrap/lib/kernel/ebin/code.beam diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam Binary files differindex 08a234da78..bdc9dea570 100644 --- a/bootstrap/lib/kernel/ebin/code_server.beam +++ b/bootstrap/lib/kernel/ebin/code_server.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log.beam b/bootstrap/lib/kernel/ebin/disk_log.beam Binary files differindex 966a3c342f..48af9c8383 100644 --- a/bootstrap/lib/kernel/ebin/disk_log.beam +++ b/bootstrap/lib/kernel/ebin/disk_log.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log_1.beam b/bootstrap/lib/kernel/ebin/disk_log_1.beam Binary files differindex 984df219a4..bd20da839e 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_1.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_1.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log_server.beam b/bootstrap/lib/kernel/ebin/disk_log_server.beam Binary files differindex cc9057b149..c323958241 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_server.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_server.beam diff --git a/bootstrap/lib/kernel/ebin/dist_ac.beam b/bootstrap/lib/kernel/ebin/dist_ac.beam Binary files differindex 6fa25d71e9..c59c245f66 100644 --- a/bootstrap/lib/kernel/ebin/dist_ac.beam +++ b/bootstrap/lib/kernel/ebin/dist_ac.beam diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam Binary files differindex 518b43c3df..0c1804c2ca 100644 --- a/bootstrap/lib/kernel/ebin/dist_util.beam +++ b/bootstrap/lib/kernel/ebin/dist_util.beam diff --git a/bootstrap/lib/kernel/ebin/erl_boot_server.beam b/bootstrap/lib/kernel/ebin/erl_boot_server.beam Binary files differindex f63e1a94f2..226052b9ac 100644 --- a/bootstrap/lib/kernel/ebin/erl_boot_server.beam +++ b/bootstrap/lib/kernel/ebin/erl_boot_server.beam diff --git a/bootstrap/lib/kernel/ebin/erl_distribution.beam b/bootstrap/lib/kernel/ebin/erl_distribution.beam Binary files differindex 79fbb0bd49..8c8cba9068 100644 --- a/bootstrap/lib/kernel/ebin/erl_distribution.beam +++ b/bootstrap/lib/kernel/ebin/erl_distribution.beam diff --git a/bootstrap/lib/kernel/ebin/erl_epmd.beam b/bootstrap/lib/kernel/ebin/erl_epmd.beam Binary files differindex 97c2d27abc..da09ca6122 100644 --- a/bootstrap/lib/kernel/ebin/erl_epmd.beam +++ b/bootstrap/lib/kernel/ebin/erl_epmd.beam diff --git a/bootstrap/lib/kernel/ebin/error_handler.beam b/bootstrap/lib/kernel/ebin/error_handler.beam Binary files differindex 92bec1ead8..f1a466ee6c 100644 --- a/bootstrap/lib/kernel/ebin/error_handler.beam +++ b/bootstrap/lib/kernel/ebin/error_handler.beam diff --git a/bootstrap/lib/kernel/ebin/error_logger.beam b/bootstrap/lib/kernel/ebin/error_logger.beam Binary files differindex 8293d3c354..bc11d2eb54 100644 --- a/bootstrap/lib/kernel/ebin/error_logger.beam +++ b/bootstrap/lib/kernel/ebin/error_logger.beam diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam Binary files differindex ccc39d20a5..0145b2e3c9 100644 --- a/bootstrap/lib/kernel/ebin/erts_debug.beam +++ b/bootstrap/lib/kernel/ebin/erts_debug.beam diff --git a/bootstrap/lib/kernel/ebin/file.beam b/bootstrap/lib/kernel/ebin/file.beam Binary files differindex 65be0c61ae..7fa8c2a5c5 100644 --- a/bootstrap/lib/kernel/ebin/file.beam +++ b/bootstrap/lib/kernel/ebin/file.beam diff --git a/bootstrap/lib/kernel/ebin/file_io_server.beam b/bootstrap/lib/kernel/ebin/file_io_server.beam Binary files differindex 6dc1cd3e64..00c19eb71c 100644 --- a/bootstrap/lib/kernel/ebin/file_io_server.beam +++ b/bootstrap/lib/kernel/ebin/file_io_server.beam diff --git a/bootstrap/lib/kernel/ebin/file_server.beam b/bootstrap/lib/kernel/ebin/file_server.beam Binary files differindex f17b888898..4f1d53cb39 100644 --- a/bootstrap/lib/kernel/ebin/file_server.beam +++ b/bootstrap/lib/kernel/ebin/file_server.beam diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam Binary files differindex 7b5218d5c0..7597ed4a09 100644 --- a/bootstrap/lib/kernel/ebin/global.beam +++ b/bootstrap/lib/kernel/ebin/global.beam diff --git a/bootstrap/lib/kernel/ebin/global_group.beam b/bootstrap/lib/kernel/ebin/global_group.beam Binary files differindex f6e1cde0aa..9d119f0c96 100644 --- a/bootstrap/lib/kernel/ebin/global_group.beam +++ b/bootstrap/lib/kernel/ebin/global_group.beam diff --git a/bootstrap/lib/kernel/ebin/group.beam b/bootstrap/lib/kernel/ebin/group.beam Binary files differindex dd44980372..99bd4bf343 100644 --- a/bootstrap/lib/kernel/ebin/group.beam +++ b/bootstrap/lib/kernel/ebin/group.beam diff --git a/bootstrap/lib/kernel/ebin/group_history.beam b/bootstrap/lib/kernel/ebin/group_history.beam Binary files differindex 9d2b59b416..5e8390f36d 100644 --- a/bootstrap/lib/kernel/ebin/group_history.beam +++ b/bootstrap/lib/kernel/ebin/group_history.beam diff --git a/bootstrap/lib/kernel/ebin/heart.beam b/bootstrap/lib/kernel/ebin/heart.beam Binary files differindex e015f73351..bf849fb229 100644 --- a/bootstrap/lib/kernel/ebin/heart.beam +++ b/bootstrap/lib/kernel/ebin/heart.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex 5382210217..8ca0b915a2 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam Binary files differindex 2d92d7c17f..7790401681 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_sctp.beam b/bootstrap/lib/kernel/ebin/inet6_sctp.beam Binary files differindex 632e16bd1d..bea47a3591 100644 --- a/bootstrap/lib/kernel/ebin/inet6_sctp.beam +++ b/bootstrap/lib/kernel/ebin/inet6_sctp.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp.beam b/bootstrap/lib/kernel/ebin/inet6_tcp.beam Binary files differindex 300d4f3ad6..db0ead9cdd 100644 --- a/bootstrap/lib/kernel/ebin/inet6_tcp.beam +++ b/bootstrap/lib/kernel/ebin/inet6_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_udp.beam b/bootstrap/lib/kernel/ebin/inet6_udp.beam Binary files differindex 6335a596d1..abc4b650ae 100644 --- a/bootstrap/lib/kernel/ebin/inet6_udp.beam +++ b/bootstrap/lib/kernel/ebin/inet6_udp.beam diff --git a/bootstrap/lib/kernel/ebin/inet_config.beam b/bootstrap/lib/kernel/ebin/inet_config.beam Binary files differindex 1da234c245..257bfe46de 100644 --- a/bootstrap/lib/kernel/ebin/inet_config.beam +++ b/bootstrap/lib/kernel/ebin/inet_config.beam diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam Binary files differindex b6c52bff8c..155536239d 100644 --- a/bootstrap/lib/kernel/ebin/inet_db.beam +++ b/bootstrap/lib/kernel/ebin/inet_db.beam diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam Binary files differindex f90d24dbdf..12b7468fa6 100644 --- a/bootstrap/lib/kernel/ebin/inet_dns.beam +++ b/bootstrap/lib/kernel/ebin/inet_dns.beam diff --git a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam Binary files differindex d20c0ccc8d..387f03b8df 100644 --- a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam +++ b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam diff --git a/bootstrap/lib/kernel/ebin/inet_parse.beam b/bootstrap/lib/kernel/ebin/inet_parse.beam Binary files differindex 218a51d862..5949536932 100644 --- a/bootstrap/lib/kernel/ebin/inet_parse.beam +++ b/bootstrap/lib/kernel/ebin/inet_parse.beam diff --git a/bootstrap/lib/kernel/ebin/inet_res.beam b/bootstrap/lib/kernel/ebin/inet_res.beam Binary files differindex a2cacc3e07..a2d5924dd0 100644 --- a/bootstrap/lib/kernel/ebin/inet_res.beam +++ b/bootstrap/lib/kernel/ebin/inet_res.beam diff --git a/bootstrap/lib/kernel/ebin/inet_sctp.beam b/bootstrap/lib/kernel/ebin/inet_sctp.beam Binary files differindex c844e2ee34..5107eb63b8 100644 --- a/bootstrap/lib/kernel/ebin/inet_sctp.beam +++ b/bootstrap/lib/kernel/ebin/inet_sctp.beam diff --git a/bootstrap/lib/kernel/ebin/inet_tcp.beam b/bootstrap/lib/kernel/ebin/inet_tcp.beam Binary files differindex 55b65ada4e..304272a20d 100644 --- a/bootstrap/lib/kernel/ebin/inet_tcp.beam +++ b/bootstrap/lib/kernel/ebin/inet_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam Binary files differindex 603f26de67..4575ad2d9b 100644 --- a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam +++ b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam diff --git a/bootstrap/lib/kernel/ebin/inet_udp.beam b/bootstrap/lib/kernel/ebin/inet_udp.beam Binary files differindex 46ce14c110..317a0d4b51 100644 --- a/bootstrap/lib/kernel/ebin/inet_udp.beam +++ b/bootstrap/lib/kernel/ebin/inet_udp.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index 55445f83c6..4979bf69b5 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -22,7 +22,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "5.4"}, + {vsn, "5.4.1"}, {modules, [application, application_controller, application_master, @@ -57,6 +57,7 @@ inet_tcp_dist, kernel, kernel_config, + kernel_refc, local_tcp, local_udp, net, @@ -114,6 +115,7 @@ heart, init, kernel_config, + kernel_refc, kernel_sup, net_kernel, net_sup, diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam Binary files differindex 0a997bddd4..3b99f49822 100644 --- a/bootstrap/lib/kernel/ebin/kernel.beam +++ b/bootstrap/lib/kernel/ebin/kernel.beam diff --git a/bootstrap/lib/kernel/ebin/kernel_config.beam b/bootstrap/lib/kernel/ebin/kernel_config.beam Binary files differindex ffb06f2aef..85b517fe0f 100644 --- a/bootstrap/lib/kernel/ebin/kernel_config.beam +++ b/bootstrap/lib/kernel/ebin/kernel_config.beam diff --git a/bootstrap/lib/kernel/ebin/kernel_refc.beam b/bootstrap/lib/kernel/ebin/kernel_refc.beam Binary files differnew file mode 100644 index 0000000000..2fca33154c --- /dev/null +++ b/bootstrap/lib/kernel/ebin/kernel_refc.beam diff --git a/bootstrap/lib/kernel/ebin/net_adm.beam b/bootstrap/lib/kernel/ebin/net_adm.beam Binary files differindex f2eac80afe..79dad6cfa5 100644 --- a/bootstrap/lib/kernel/ebin/net_adm.beam +++ b/bootstrap/lib/kernel/ebin/net_adm.beam diff --git a/bootstrap/lib/kernel/ebin/net_kernel.beam b/bootstrap/lib/kernel/ebin/net_kernel.beam Binary files differindex f352e2c064..eea9fde3c6 100644 --- a/bootstrap/lib/kernel/ebin/net_kernel.beam +++ b/bootstrap/lib/kernel/ebin/net_kernel.beam diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam Binary files differindex 61ed6a107a..76894e9bc9 100644 --- a/bootstrap/lib/kernel/ebin/os.beam +++ b/bootstrap/lib/kernel/ebin/os.beam diff --git a/bootstrap/lib/kernel/ebin/pg2.beam b/bootstrap/lib/kernel/ebin/pg2.beam Binary files differindex 4d1a79a94c..8039120d20 100644 --- a/bootstrap/lib/kernel/ebin/pg2.beam +++ b/bootstrap/lib/kernel/ebin/pg2.beam diff --git a/bootstrap/lib/kernel/ebin/ram_file.beam b/bootstrap/lib/kernel/ebin/ram_file.beam Binary files differindex ca476c5f7d..d426a75ed9 100644 --- a/bootstrap/lib/kernel/ebin/ram_file.beam +++ b/bootstrap/lib/kernel/ebin/ram_file.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam b/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam Binary files differindex 62c28195a3..9060a2bffe 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam b/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam Binary files differindex 3090c454bf..dcda821d8e 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam b/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam Binary files differindex 1ed3abc73d..4c1df2bb57 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_list.beam b/bootstrap/lib/kernel/ebin/raw_file_io_list.beam Binary files differindex 283f3b892d..85deafd35a 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_list.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_list.beam diff --git a/bootstrap/lib/kernel/ebin/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam Binary files differindex abaec4bbd8..7be3630e48 100644 --- a/bootstrap/lib/kernel/ebin/rpc.beam +++ b/bootstrap/lib/kernel/ebin/rpc.beam diff --git a/bootstrap/lib/kernel/ebin/standard_error.beam b/bootstrap/lib/kernel/ebin/standard_error.beam Binary files differindex b35659983e..8c598615f8 100644 --- a/bootstrap/lib/kernel/ebin/standard_error.beam +++ b/bootstrap/lib/kernel/ebin/standard_error.beam diff --git a/bootstrap/lib/kernel/ebin/user.beam b/bootstrap/lib/kernel/ebin/user.beam Binary files differindex 006fd607c0..58bd43a18e 100644 --- a/bootstrap/lib/kernel/ebin/user.beam +++ b/bootstrap/lib/kernel/ebin/user.beam diff --git a/bootstrap/lib/kernel/ebin/user_drv.beam b/bootstrap/lib/kernel/ebin/user_drv.beam Binary files differindex d6bb443081..d2631be5af 100644 --- a/bootstrap/lib/kernel/ebin/user_drv.beam +++ b/bootstrap/lib/kernel/ebin/user_drv.beam diff --git a/bootstrap/lib/kernel/ebin/user_sup.beam b/bootstrap/lib/kernel/ebin/user_sup.beam Binary files differindex df6a0be44b..6aa34138c8 100644 --- a/bootstrap/lib/kernel/ebin/user_sup.beam +++ b/bootstrap/lib/kernel/ebin/user_sup.beam diff --git a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam Binary files differindex 40f3ecdfc7..b38ddd7288 100644 --- a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam +++ b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam Binary files differindex 904513df6b..68bf4904ce 100644 --- a/bootstrap/lib/stdlib/ebin/array.beam +++ b/bootstrap/lib/stdlib/ebin/array.beam diff --git a/bootstrap/lib/stdlib/ebin/base64.beam b/bootstrap/lib/stdlib/ebin/base64.beam Binary files differindex 8670e9cf7f..902d8edc6c 100644 --- a/bootstrap/lib/stdlib/ebin/base64.beam +++ b/bootstrap/lib/stdlib/ebin/base64.beam diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam Binary files differindex 9282e46c90..9b70424aae 100644 --- a/bootstrap/lib/stdlib/ebin/beam_lib.beam +++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/c.beam b/bootstrap/lib/stdlib/ebin/c.beam Binary files differindex b9be0ec3c8..fb24f24b98 100644 --- a/bootstrap/lib/stdlib/ebin/c.beam +++ b/bootstrap/lib/stdlib/ebin/c.beam diff --git a/bootstrap/lib/stdlib/ebin/calendar.beam b/bootstrap/lib/stdlib/ebin/calendar.beam Binary files differindex ec7237faeb..3b38655345 100644 --- a/bootstrap/lib/stdlib/ebin/calendar.beam +++ b/bootstrap/lib/stdlib/ebin/calendar.beam diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam Binary files differindex e104c135f3..7ffca2b7ee 100644 --- a/bootstrap/lib/stdlib/ebin/dets.beam +++ b/bootstrap/lib/stdlib/ebin/dets.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_server.beam b/bootstrap/lib/stdlib/ebin/dets_server.beam Binary files differindex 389140d14f..cfe0257a9f 100644 --- a/bootstrap/lib/stdlib/ebin/dets_server.beam +++ b/bootstrap/lib/stdlib/ebin/dets_server.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam Binary files differindex 458a7a964f..76b65ad011 100644 --- a/bootstrap/lib/stdlib/ebin/dets_utils.beam +++ b/bootstrap/lib/stdlib/ebin/dets_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam Binary files differindex 59ff4675bb..adcb52b007 100644 --- a/bootstrap/lib/stdlib/ebin/dets_v9.beam +++ b/bootstrap/lib/stdlib/ebin/dets_v9.beam diff --git a/bootstrap/lib/stdlib/ebin/dict.beam b/bootstrap/lib/stdlib/ebin/dict.beam Binary files differindex 72fd947f5e..b04ad73e70 100644 --- a/bootstrap/lib/stdlib/ebin/dict.beam +++ b/bootstrap/lib/stdlib/ebin/dict.beam diff --git a/bootstrap/lib/stdlib/ebin/digraph.beam b/bootstrap/lib/stdlib/ebin/digraph.beam Binary files differindex 62b7c6d2e6..606cf5c08b 100644 --- a/bootstrap/lib/stdlib/ebin/digraph.beam +++ b/bootstrap/lib/stdlib/ebin/digraph.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam Binary files differindex 6dd4f50887..807c7df5c7 100644 --- a/bootstrap/lib/stdlib/ebin/edlin.beam +++ b/bootstrap/lib/stdlib/ebin/edlin.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin_expand.beam b/bootstrap/lib/stdlib/ebin/edlin_expand.beam Binary files differindex db7a6780ca..68515c00a0 100644 --- a/bootstrap/lib/stdlib/ebin/edlin_expand.beam +++ b/bootstrap/lib/stdlib/ebin/edlin_expand.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex 117acec27f..66ddbaea09 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam b/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam Binary files differindex 8999166466..e6042b9715 100644 --- a/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam +++ b/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_anno.beam b/bootstrap/lib/stdlib/ebin/erl_anno.beam Binary files differindex 122f562563..710a82f1fa 100644 --- a/bootstrap/lib/stdlib/ebin/erl_anno.beam +++ b/bootstrap/lib/stdlib/ebin/erl_anno.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_bits.beam b/bootstrap/lib/stdlib/ebin/erl_bits.beam Binary files differindex 11ab24851e..5b2a46aec1 100644 --- a/bootstrap/lib/stdlib/ebin/erl_bits.beam +++ b/bootstrap/lib/stdlib/ebin/erl_bits.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_compile.beam b/bootstrap/lib/stdlib/ebin/erl_compile.beam Binary files differindex ed41f0347f..d40909b3cf 100644 --- a/bootstrap/lib/stdlib/ebin/erl_compile.beam +++ b/bootstrap/lib/stdlib/ebin/erl_compile.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex 72c9d51cf9..95de15156d 100644 --- a/bootstrap/lib/stdlib/ebin/erl_eval.beam +++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam Binary files differindex a22c1eac2f..9032984049 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex c194bda041..c6c62b3657 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam Binary files differindex 7f0e173b3d..6ac2e29240 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex b2104c97df..16843acd17 100644 --- a/bootstrap/lib/stdlib/ebin/erl_pp.beam +++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam Binary files differindex 982f377630..4bc9f7cbc3 100644 --- a/bootstrap/lib/stdlib/ebin/erl_scan.beam +++ b/bootstrap/lib/stdlib/ebin/erl_scan.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_tar.beam b/bootstrap/lib/stdlib/ebin/erl_tar.beam Binary files differindex 5ccd9e3bc5..f2c935dad1 100644 --- a/bootstrap/lib/stdlib/ebin/erl_tar.beam +++ b/bootstrap/lib/stdlib/ebin/erl_tar.beam diff --git a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam Binary files differindex 04d3fe7952..7cc374d4b6 100644 --- a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam +++ b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam diff --git a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam Binary files differindex 94368ffd53..a4b3321379 100644 --- a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam +++ b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam Binary files differindex 213393794d..5721d41a52 100644 --- a/bootstrap/lib/stdlib/ebin/escript.beam +++ b/bootstrap/lib/stdlib/ebin/escript.beam diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam Binary files differindex d82ec7d3c0..06576e533a 100644 --- a/bootstrap/lib/stdlib/ebin/ets.beam +++ b/bootstrap/lib/stdlib/ebin/ets.beam diff --git a/bootstrap/lib/stdlib/ebin/eval_bits.beam b/bootstrap/lib/stdlib/ebin/eval_bits.beam Binary files differindex fb695d86fe..76b1a2a2ae 100644 --- a/bootstrap/lib/stdlib/ebin/eval_bits.beam +++ b/bootstrap/lib/stdlib/ebin/eval_bits.beam diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam Binary files differindex e16f904d3c..22e7f2c2b4 100644 --- a/bootstrap/lib/stdlib/ebin/file_sorter.beam +++ b/bootstrap/lib/stdlib/ebin/file_sorter.beam diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam Binary files differindex 87810111b6..e632631389 100644 --- a/bootstrap/lib/stdlib/ebin/filelib.beam +++ b/bootstrap/lib/stdlib/ebin/filelib.beam diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam Binary files differindex 03de7c6152..7fff3a33cc 100644 --- a/bootstrap/lib/stdlib/ebin/filename.beam +++ b/bootstrap/lib/stdlib/ebin/filename.beam diff --git a/bootstrap/lib/stdlib/ebin/gb_sets.beam b/bootstrap/lib/stdlib/ebin/gb_sets.beam Binary files differindex 97405caca0..7b3b19efb8 100644 --- a/bootstrap/lib/stdlib/ebin/gb_sets.beam +++ b/bootstrap/lib/stdlib/ebin/gb_sets.beam diff --git a/bootstrap/lib/stdlib/ebin/gen.beam b/bootstrap/lib/stdlib/ebin/gen.beam Binary files differindex de761e2ccb..14d8f04cba 100644 --- a/bootstrap/lib/stdlib/ebin/gen.beam +++ b/bootstrap/lib/stdlib/ebin/gen.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex dd24351d71..f4b87ab26d 100644 --- a/bootstrap/lib/stdlib/ebin/gen_event.beam +++ b/bootstrap/lib/stdlib/ebin/gen_event.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam Binary files differindex 132b948434..566aa94342 100644 --- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam +++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam Binary files differindex 68f678ff03..6ec210dada 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_statem.beam b/bootstrap/lib/stdlib/ebin/gen_statem.beam Binary files differindex 05932db2f2..b2c88ce783 100644 --- a/bootstrap/lib/stdlib/ebin/gen_statem.beam +++ b/bootstrap/lib/stdlib/ebin/gen_statem.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib.beam b/bootstrap/lib/stdlib/ebin/io_lib.beam Binary files differindex bb018a3dbb..41fa869dde 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_format.beam b/bootstrap/lib/stdlib/ebin/io_lib_format.beam Binary files differindex a24adeab6d..e564659aa8 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_format.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_format.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex a51f7c896e..b2f489b702 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam diff --git a/bootstrap/lib/stdlib/ebin/lib.beam b/bootstrap/lib/stdlib/ebin/lib.beam Binary files differindex dc99df9c5f..649d4452ad 100644 --- a/bootstrap/lib/stdlib/ebin/lib.beam +++ b/bootstrap/lib/stdlib/ebin/lib.beam diff --git a/bootstrap/lib/stdlib/ebin/lists.beam b/bootstrap/lib/stdlib/ebin/lists.beam Binary files differindex c95243debf..5b91ffeca9 100644 --- a/bootstrap/lib/stdlib/ebin/lists.beam +++ b/bootstrap/lib/stdlib/ebin/lists.beam diff --git a/bootstrap/lib/stdlib/ebin/log_mf_h.beam b/bootstrap/lib/stdlib/ebin/log_mf_h.beam Binary files differindex 985a9502f5..b27db50f62 100644 --- a/bootstrap/lib/stdlib/ebin/log_mf_h.beam +++ b/bootstrap/lib/stdlib/ebin/log_mf_h.beam diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex d924a50d82..3113f71b58 100644 --- a/bootstrap/lib/stdlib/ebin/ms_transform.beam +++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam diff --git a/bootstrap/lib/stdlib/ebin/pool.beam b/bootstrap/lib/stdlib/ebin/pool.beam Binary files differindex c6b6e8314d..bc3b2a861c 100644 --- a/bootstrap/lib/stdlib/ebin/pool.beam +++ b/bootstrap/lib/stdlib/ebin/pool.beam diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam Binary files differindex 90659c9df9..191dc94be7 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/proplists.beam b/bootstrap/lib/stdlib/ebin/proplists.beam Binary files differindex b00ac13e9d..3750c1ddb3 100644 --- a/bootstrap/lib/stdlib/ebin/proplists.beam +++ b/bootstrap/lib/stdlib/ebin/proplists.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex 9f3daf5dc7..5b2d4bad4c 100644 --- a/bootstrap/lib/stdlib/ebin/qlc.beam +++ b/bootstrap/lib/stdlib/ebin/qlc.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam Binary files differindex e287e2002f..c9d329fe86 100644 --- a/bootstrap/lib/stdlib/ebin/qlc_pt.beam +++ b/bootstrap/lib/stdlib/ebin/qlc_pt.beam diff --git a/bootstrap/lib/stdlib/ebin/queue.beam b/bootstrap/lib/stdlib/ebin/queue.beam Binary files differindex ca0c6794ca..c4cce1f88d 100644 --- a/bootstrap/lib/stdlib/ebin/queue.beam +++ b/bootstrap/lib/stdlib/ebin/queue.beam diff --git a/bootstrap/lib/stdlib/ebin/rand.beam b/bootstrap/lib/stdlib/ebin/rand.beam Binary files differindex 7921ac2497..6574df6c6f 100644 --- a/bootstrap/lib/stdlib/ebin/rand.beam +++ b/bootstrap/lib/stdlib/ebin/rand.beam diff --git a/bootstrap/lib/stdlib/ebin/random.beam b/bootstrap/lib/stdlib/ebin/random.beam Binary files differindex dcb2b6850b..37f12f8a36 100644 --- a/bootstrap/lib/stdlib/ebin/random.beam +++ b/bootstrap/lib/stdlib/ebin/random.beam diff --git a/bootstrap/lib/stdlib/ebin/re.beam b/bootstrap/lib/stdlib/ebin/re.beam Binary files differindex 415ff7bb43..3f316c9a44 100644 --- a/bootstrap/lib/stdlib/ebin/re.beam +++ b/bootstrap/lib/stdlib/ebin/re.beam diff --git a/bootstrap/lib/stdlib/ebin/sets.beam b/bootstrap/lib/stdlib/ebin/sets.beam Binary files differindex b4a15dc9db..2337a8a8d9 100644 --- a/bootstrap/lib/stdlib/ebin/sets.beam +++ b/bootstrap/lib/stdlib/ebin/sets.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex 4df0c4f888..ca29384984 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/slave.beam b/bootstrap/lib/stdlib/ebin/slave.beam Binary files differindex 0cbd0067c0..f72a207e3e 100644 --- a/bootstrap/lib/stdlib/ebin/slave.beam +++ b/bootstrap/lib/stdlib/ebin/slave.beam diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam Binary files differindex 9f909e608b..ef540df4f2 100644 --- a/bootstrap/lib/stdlib/ebin/sofs.beam +++ b/bootstrap/lib/stdlib/ebin/sofs.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index a8abad00ea..d542c669f8 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -20,7 +20,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "3.4.2"}, + {vsn, "3.4.3"}, {modules, [array, base64, beam_lib, diff --git a/bootstrap/lib/stdlib/ebin/string.beam b/bootstrap/lib/stdlib/ebin/string.beam Binary files differindex ff5fab297d..670cd530e9 100644 --- a/bootstrap/lib/stdlib/ebin/string.beam +++ b/bootstrap/lib/stdlib/ebin/string.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex 66d9248765..61ae3c3de0 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam Binary files differindex 599e490e4c..800c167237 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam Binary files differindex 9781a563a7..abf6451cb0 100644 --- a/bootstrap/lib/stdlib/ebin/sys.beam +++ b/bootstrap/lib/stdlib/ebin/sys.beam diff --git a/bootstrap/lib/stdlib/ebin/timer.beam b/bootstrap/lib/stdlib/ebin/timer.beam Binary files differindex 7397379a29..7baece7eb2 100644 --- a/bootstrap/lib/stdlib/ebin/timer.beam +++ b/bootstrap/lib/stdlib/ebin/timer.beam diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam Binary files differindex a59453c666..b3b0a4637a 100644 --- a/bootstrap/lib/stdlib/ebin/unicode.beam +++ b/bootstrap/lib/stdlib/ebin/unicode.beam diff --git a/bootstrap/lib/stdlib/ebin/unicode_util.beam b/bootstrap/lib/stdlib/ebin/unicode_util.beam Binary files differindex 511b8aae79..12280f5e58 100644 --- a/bootstrap/lib/stdlib/ebin/unicode_util.beam +++ b/bootstrap/lib/stdlib/ebin/unicode_util.beam diff --git a/bootstrap/lib/stdlib/ebin/uri_string.beam b/bootstrap/lib/stdlib/ebin/uri_string.beam Binary files differindex fe4033a513..5880b38385 100644 --- a/bootstrap/lib/stdlib/ebin/uri_string.beam +++ b/bootstrap/lib/stdlib/ebin/uri_string.beam diff --git a/bootstrap/lib/stdlib/ebin/win32reg.beam b/bootstrap/lib/stdlib/ebin/win32reg.beam Binary files differindex 416ed15bfd..93f6458657 100644 --- a/bootstrap/lib/stdlib/ebin/win32reg.beam +++ b/bootstrap/lib/stdlib/ebin/win32reg.beam diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam Binary files differindex ea54e17a17..e6ba80cc7d 100644 --- a/bootstrap/lib/stdlib/ebin/zip.beam +++ b/bootstrap/lib/stdlib/ebin/zip.beam diff --git a/erts/configure.in b/erts/configure.in index 2f6043ee85..f15bb56435 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1356,12 +1356,16 @@ error ],[ AC_MSG_RESULT(no) ]) + +if test "$Z_LIB" != ""; then + AC_MSG_CHECKING(for zlib inflateGetDictionary presence) + AC_SEARCH_LIBS(inflateGetDictionary, [z], + AC_DEFINE(HAVE_ZLIB_INFLATEGETDICTIONARY, 1, + [Define if your zlib version defines inflateGetDictionary.])) +fi + LIBS=$zlib_save_LIBS -AC_MSG_CHECKING(for zlib inflateGetDictionary presence) -AC_SEARCH_LIBS(inflateGetDictionary, [z], - AC_DEFINE(HAVE_ZLIB_INFLATEGETDICTIONARY, 1, - [Define if your zlib version defines inflateGetDictionary.])) fi AC_SUBST(Z_LIB) diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index d7404fa3ce..24e0773e41 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -1444,11 +1444,14 @@ b</pre> the process to terminate, it has no return value. Example:</p> <pre> > <input>catch error(foobar).</input> -{'EXIT',{foobar,[{erl_eval,do_apply,5}, - {erl_eval,expr,5}, - {shell,exprs,6}, - {shell,eval_exprs,6}, - {shell,eval_loop,3}]}}</pre> +{'EXIT',{foobar,[{shell,apply_fun,3, + [{file,"shell.erl"},{line,906}]}, + {erl_eval,do_apply,6,[{file,"erl_eval.erl"},{line,677}]}, + {erl_eval,expr,5,[{file,"erl_eval.erl"},{line,430}]}, + {shell,exprs,7,[{file,"shell.erl"},{line,687}]}, + {shell,eval_exprs,7,[{file,"shell.erl"},{line,642}]}, + {shell,eval_loop,3,[{file,"shell.erl"},{line,627}]}]}} +</pre> </desc> </func> @@ -8963,7 +8966,7 @@ ok <c>erlang:now()</c>. This is also the default if no time stamp flag is specified. If <c>cpu_timestamp</c> has been enabled through - <seealso marker="erlang:trace/3"><c>erlang:trace/3</c></seealso>, + <seealso marker="#trace/3"><c>erlang:trace/3</c></seealso>, this also effects the time stamp produced in profiling messages when flag <c>timestamp</c> is enabled.</p> </item> diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 509aa2a84f..8f02d509a9 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -40,6 +40,7 @@ #include "erl_binary.h" #include "erl_thr_progress.h" #include "erl_nfunc_sched.h" +#include "beam_catches.h" #ifdef ARCH_64 # define HEXF "%016bpX" @@ -55,6 +56,7 @@ static int print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) static void print_bif_name(fmtfn_t to, void* to_arg, BifFunction bif); static BeamInstr* f_to_addr(BeamInstr* base, int op, BeamInstr* ap); static BeamInstr* f_to_addr_packed(BeamInstr* base, int op, Sint32* ap); +static void print_byte_string(fmtfn_t to, void *to_arg, byte* str, Uint bytes); BIF_RETTYPE erts_debug_same_2(BIF_ALIST_2) @@ -396,6 +398,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) BeamInstr args[8]; /* Arguments for this instruction. */ BeamInstr* ap; /* Pointer to arguments. */ BeamInstr* unpacked; /* Unpacked arguments */ + BeamInstr* first_arg; /* First argument */ start_prog = opc[op].pack; @@ -480,6 +483,8 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) ap = args; } + first_arg = ap; + /* * Print the name and all operands of the instructions. */ @@ -570,24 +575,60 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) } break; } + case op_i_make_fun_Wt: + if (*sign == 'W') { + ErlFunEntry* fe = (ErlFunEntry *) *ap; + ErtsCodeMFA* cmfa = find_function_from_pc(fe->address); + erts_print(to, to_arg, "%T:%T/%bpu", cmfa->module, + cmfa->function, cmfa->arity); + } else { + erts_print(to, to_arg, "%d", *ap); + } + break; + case op_i_bs_match_string_xfWW: + if (ap - first_arg < 3) { + erts_print(to, to_arg, "%d", *ap); + } else { + Uint bits = ap[-1]; + Uint bytes = (bits+7)/8; + byte* str = (byte *) *ap; + print_byte_string(to, to_arg, str, bytes); + } + break; + case op_bs_put_string_WW: + if (ap - first_arg == 0) { + erts_print(to, to_arg, "%d", *ap); + } else { + Uint bytes = ap[-1]; + byte* str = (byte *) ap[0]; + print_byte_string(to, to_arg, str, bytes); + } + break; default: erts_print(to, to_arg, "%d", *ap); } ap++; break; case 'f': /* Destination label */ - { - BeamInstr* target = f_to_addr(addr, op, ap); - ErtsCodeMFA* cmfa = find_function_from_pc(target); - if (!cmfa || erts_codemfa_to_code(cmfa) != target) { - erts_print(to, to_arg, "f(" HEXF ")", target); - } else { - erts_print(to, to_arg, "%T:%T/%bpu", cmfa->module, - cmfa->function, cmfa->arity); - } - ap++; - } - break; + switch (op) { + case op_catch_yf: + erts_print(to, to_arg, "f(" HEXF ")", catch_pc((BeamInstr)*ap)); + break; + default: + { + BeamInstr* target = f_to_addr(addr, op, ap); + ErtsCodeMFA* cmfa = find_function_from_pc(target); + if (!cmfa || erts_codemfa_to_code(cmfa) != target) { + erts_print(to, to_arg, "f(" HEXF ")", target); + } else { + erts_print(to, to_arg, "%T:%T/%bpu", cmfa->module, + cmfa->function, cmfa->arity); + } + ap++; + } + break; + } + break; case 'p': /* Pointer (to label) */ { BeamInstr* target = f_to_addr(addr, op, ap); @@ -848,6 +889,14 @@ static BeamInstr* f_to_addr_packed(BeamInstr* base, int op, Sint32* ap) return base - 1 + opc[op].adjust + *ap; } +static void print_byte_string(fmtfn_t to, void *to_arg, byte* str, Uint bytes) +{ + Uint i; + + for (i = 0; i < bytes; i++) { + erts_print(to, to_arg, "%02X", str[i]); + } +} /* * Dirty BIF testing. diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index e43f7fda2c..e242fe9140 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2017. All Rights Reserved. + * Copyright Ericsson AB 1996-2018. 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. @@ -40,6 +40,7 @@ #include "erl_zlib.h" #include "erl_map.h" #include "erl_process_dict.h" +#include "erl_unicode.h" #ifdef HIPE #include "hipe_bif0.h" @@ -1806,7 +1807,7 @@ read_line_table(LoaderState* stp) GetInt(stp, 2, n); GetString(stp, fname, n); - stp->fname[i] = erts_atom_put(fname, n, ERTS_ATOM_ENC_LATIN1, 1); + stp->fname[i] = erts_atom_put(fname, n, ERTS_ATOM_ENC_UTF8, 1); } } @@ -6254,8 +6255,7 @@ erts_build_mfa_item(FunctionInfo* fi, Eterm* hp, Eterm args, Eterm* mfa_p) file_term = buf_to_intlist(&hp, ".erl", 4, NIL); file_term = buf_to_intlist(&hp, (char*)ap->name, ap->len, file_term); } else { - Atom* ap = atom_tab(atom_val((fi->fname_ptr)[file-1])); - file_term = buf_to_intlist(&hp, (char*)ap->name, ap->len, NIL); + file_term = erts_atom_to_string(&hp, (fi->fname_ptr)[file-1]); } tuple = TUPLE2(hp, am_line, make_small(line)); @@ -6984,6 +6984,8 @@ int erts_commit_hipe_patch_load(Eterm hipe_magic_bin) hipe_stp->new_hipe_refs = NULL; hipe_stp->new_hipe_sdesc = NULL; + hipe_redirect_to_module(modp); + return 1; } diff --git a/erts/emulator/beam/beam_ranges.c b/erts/emulator/beam/beam_ranges.c index 01bda7f3c1..f0c9496341 100644 --- a/erts/emulator/beam/beam_ranges.c +++ b/erts/emulator/beam/beam_ranges.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012-2016. All Rights Reserved. + * Copyright Ericsson AB 2012-2018. 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. @@ -26,6 +26,7 @@ #include "erl_vm.h" #include "global.h" #include "beam_load.h" +#include "erl_unicode.h" typedef struct { BeamInstr* start; /* Pointer to start of module. */ @@ -341,8 +342,7 @@ lookup_loc(FunctionInfo* fi, const BeamInstr* pc, Atom* mod_atom = atom_tab(atom_val(fi->mfa->module)); fi->needed += 2*(mod_atom->len+4); } else { - Atom* ap = atom_tab(atom_val((fi->fname_ptr)[file-1])); - fi->needed += 2*ap->len; + fi->needed += 2*erts_atom_to_string_length((fi->fname_ptr)[file-1]); } return; } else { diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 0e5f7bb22b..f086c434ea 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -2244,20 +2244,15 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx) send_message: { ErtsProcLocks rp_locks = 0; - Sint res; if (p == rp) rp_locks |= ERTS_PROC_LOCK_MAIN; /* send to local process */ - res = erts_send_message(p, rp, &rp_locks, msg, 0); - if (erts_use_sender_punish) - res *= 4; - else - res = 0; + erts_send_message(p, rp, &rp_locks, msg, 0); erts_proc_unlock(rp, p == rp ? (rp_locks & ~ERTS_PROC_LOCK_MAIN) : rp_locks); - return res; + return 0; } } @@ -2312,8 +2307,8 @@ BIF_RETTYPE send_3(BIF_ALIST_3) result = do_send(p, to, msg, &ref, ctx); ERTS_MSACC_POP_STATE_M_X(); - if (result > 0) { - ERTS_VBUMP_REDS(p, result); + if (result >= 0) { + ERTS_VBUMP_REDS(p, 4); if (ERTS_IS_PROC_OUT_OF_REDS(p)) goto yield_return; ERTS_BIF_PREP_RET(retval, am_ok); @@ -2321,12 +2316,6 @@ BIF_RETTYPE send_3(BIF_ALIST_3) } switch (result) { - case 0: - /* May need to yield even though we do not bump reds here... */ - if (ERTS_IS_PROC_OUT_OF_REDS(p)) - goto yield_return; - ERTS_BIF_PREP_RET(retval, am_ok); - break; case SEND_NOCONNECT: if (ctx->connect) { ERTS_BIF_PREP_RET(retval, am_ok); @@ -2443,8 +2432,8 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) ERTS_MSACC_POP_STATE_M_X(); - if (result > 0) { - ERTS_VBUMP_REDS(p, result); + if (result >= 0) { + ERTS_VBUMP_REDS(p, 4); if (ERTS_IS_PROC_OUT_OF_REDS(p)) goto yield_return; ERTS_BIF_PREP_RET(retval, msg); @@ -2452,12 +2441,6 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) } switch (result) { - case 0: - /* May need to yield even though we do not bump reds here... */ - if (ERTS_IS_PROC_OUT_OF_REDS(p)) - goto yield_return; - ERTS_BIF_PREP_RET(retval, msg); - break; case SEND_NOCONNECT: ERTS_BIF_PREP_RET(retval, msg); break; diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 5eaf262cd8..c5cb268f09 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -2549,12 +2549,17 @@ int term_equals_2pow32(Eterm x) } } +static ERTS_INLINE int c2int_is_valid_char(byte ch, int base) { + if (base <= 10) + return (ch >= '0' && ch < ('0' + base)); + else + return (ch >= '0' && ch <= '9') + || (ch >= 'A' && ch < ('A' + base - 10)) + || (ch >= 'a' && ch < ('a' + base - 10)); +} + static ERTS_INLINE int c2int_is_invalid_char(byte ch, int base) { - return (ch < '0' - || (ch > ('0' + base - 1) - && !(base > 10 - && ((ch >= 'a' && ch < ('a' + base - 10)) - || (ch >= 'A' && ch < ('A' + base - 10)))))); + return !c2int_is_valid_char(ch, base); } static ERTS_INLINE byte c2int_digit_from_base(byte ch) { diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index ca3e48e205..d4db1a4188 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -60,14 +60,36 @@ erts_init_binary(void) } +static ERTS_INLINE +Eterm build_proc_bin(ErlOffHeap* ohp, Eterm* hp, Binary* bptr) +{ + ProcBin* pb = (ProcBin *) hp; + pb->thing_word = HEADER_PROC_BIN; + pb->size = bptr->orig_size; + pb->next = ohp->first; + ohp->first = (struct erl_off_heap_header*)pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + OH_OVERHEAD(ohp, pb->size / sizeof(Eterm)); + + return make_binary(pb); +} + +/** @brief Initiate a ProcBin for a full Binary. + * @param hp must point to PROC_BIN_SIZE available heap words. + */ +Eterm erts_build_proc_bin(ErlOffHeap* ohp, Eterm* hp, Binary* bptr) +{ + return build_proc_bin(ohp, hp, bptr); +} + /* * Create a brand new binary from scratch. */ - Eterm new_binary(Process *p, byte *buf, Uint len) { - ProcBin* pb; Binary* bptr; if (len <= ERL_ONHEAP_BIN_LIMIT) { @@ -88,23 +110,7 @@ new_binary(Process *p, byte *buf, Uint len) sys_memcpy(bptr->orig_bytes, buf, len); } - /* - * Now allocate the ProcBin on the heap. - */ - pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = len; - pb->next = MSO(p).first; - MSO(p).first = (struct erl_off_heap_header*)pb; - pb->val = bptr; - pb->bytes = (byte*) bptr->orig_bytes; - pb->flags = 0; - - /* - * Miscellaneous updates. Return the tagged binary. - */ - OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); - return make_binary(pb); + return build_proc_bin(&MSO(p), HAlloc(p, PROC_BIN_SIZE), bptr); } /* @@ -113,7 +119,6 @@ new_binary(Process *p, byte *buf, Uint len) Eterm erts_new_mso_binary(Process *p, byte *buf, Uint len) { - ProcBin* pb; Binary* bptr; /* @@ -124,23 +129,7 @@ Eterm erts_new_mso_binary(Process *p, byte *buf, Uint len) sys_memcpy(bptr->orig_bytes, buf, len); } - /* - * Now allocate the ProcBin on the heap. - */ - pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = len; - pb->next = MSO(p).first; - MSO(p).first = (struct erl_off_heap_header*)pb; - pb->val = bptr; - pb->bytes = (byte*) bptr->orig_bytes; - pb->flags = 0; - - /* - * Miscellaneous updates. Return the tagged binary. - */ - OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); - return make_binary(pb); + return build_proc_bin(&MSO(p), HAlloc(p, PROC_BIN_SIZE), bptr); } /* diff --git a/erts/emulator/beam/bs_instrs.tab b/erts/emulator/beam/bs_instrs.tab index 9f03b19731..b11903a47b 100644 --- a/erts/emulator/beam/bs_instrs.tab +++ b/erts/emulator/beam/bs_instrs.tab @@ -919,9 +919,23 @@ i_bs_get_integer(Fail, Live, FlagsAndUnit, Ms, Sz, Dst) { } i_bs_get_utf8(Ctx, Fail, Dst) { + Eterm result; ErlBinMatchBuffer* mb = ms_matchbuffer($Ctx); - Eterm result = erts_bs_get_utf8(mb); + if (mb->size - mb->offset < 8) { + $FAIL($Fail); + } + if (BIT_OFFSET(mb->offset) != 0) { + result = erts_bs_get_utf8(mb); + } else { + byte b = mb->base[BYTE_OFFSET(mb->offset)]; + if (b < 128) { + result = make_small(b); + mb->offset += 8; + } else { + result = erts_bs_get_utf8(mb); + } + } if (is_non_value(result)) { $FAIL($Fail); } diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 4cafa499a9..41c2ae08d3 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -2825,28 +2825,21 @@ BIF_RETTYPE binary_copy_trap(BIF_ALIST_2) BIF_TRAP2(&binary_copy_trap_export, BIF_P, BIF_ARG_1, BIF_ARG_2); } else { Binary *save; - ProcBin* pb; + Eterm resbin; Uint target_size = cbs->result->orig_size; while (pos < target_size) { memcpy(t+pos,cbs->source, size); pos += size; } - save = cbs->result; + save = cbs->result; cbs->result = NULL; cleanup_copy_bin_state(mb); /* now cbs is dead */ - pb = (ProcBin *) HAlloc(BIF_P, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = target_size; - pb->next = MSO(BIF_P).first; - MSO(BIF_P).first = (struct erl_off_heap_header*) pb; - pb->val = save; - pb->bytes = t; - pb->flags = 0; - - OH_OVERHEAD(&(MSO(BIF_P)), target_size / sizeof(Eterm)); - BUMP_REDS(BIF_P,(pos - opos) / BINARY_COPY_LOOP_FACTOR); - - BIF_RET(make_binary(pb)); + + resbin = erts_build_proc_bin(&MSO(BIF_P), + HAlloc(BIF_P, PROC_BIN_SIZE), + save); + BUMP_REDS(BIF_P,(pos - opos) / BINARY_COPY_LOOP_FACTOR); + BIF_RET(resbin); } } diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 52056023fd..903f54e2fb 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -4334,6 +4334,19 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) BIF_RET(res); } } + else if (ERTS_IS_ATOM_STR("binary", BIF_ARG_1)) { + Sint64 size; + if (term_to_Sint64(BIF_ARG_2, &size)) { + Binary* refbin = erts_bin_drv_alloc_fnf(size); + if (!refbin) + BIF_RET(am_false); + sys_memset(refbin->orig_bytes, 0, size); + BIF_RET(erts_build_proc_bin(&MSO(BIF_P), + HAlloc(BIF_P, PROC_BIN_SIZE), + refbin)); + } + } + } BIF_ERROR(BIF_P, BADARG); diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index f52eed41d5..4846ccd2d3 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -155,9 +155,6 @@ erts_atomic32_t erts_writing_erl_crash_dump; erts_tsd_key_t erts_is_crash_dumping_key; int erts_initialized = 0; - -int erts_use_sender_punish; - /* * Configurable parameters. */ @@ -758,8 +755,6 @@ early_init(int *argc, char **argv) /* erts_initialized = 0; - erts_use_sender_punish = 1; - erts_pre_early_init_cpu_topology(&max_reader_groups, &ncpu, &ncpuonln, @@ -1765,8 +1760,6 @@ erl_start(int argc, char **argv) erts_usage(); } } - else if (sys_strcmp("nsp", sub_param) == 0) - erts_use_sender_punish = 0; else if (has_prefix("tbt", sub_param)) { arg = get_arg(sub_param+3, argv[i+1], &i); res = erts_init_scheduler_bind_type_string(arg); diff --git a/erts/emulator/beam/erl_io_queue.c b/erts/emulator/beam/erl_io_queue.c index 40d69ea6b0..c93b5248d9 100644 --- a/erts/emulator/beam/erl_io_queue.c +++ b/erts/emulator/beam/erl_io_queue.c @@ -817,24 +817,15 @@ static Eterm iol2v_make_sub_bin(iol2v_state_t *state, Eterm bin_term, } static Eterm iol2v_promote_acc(iol2v_state_t *state) { - ProcBin *pb; - - state->acc = erts_bin_realloc(state->acc, state->acc_size); - - pb = (ProcBin*)HAlloc(state->process, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = state->acc_size; - pb->val = state->acc; - pb->bytes = (byte*)(state->acc)->orig_bytes; - pb->flags = 0; - pb->next = MSO(state->process).first; - OH_OVERHEAD(&(MSO(state->process)), pb->size / sizeof(Eterm)); - MSO(state->process).first = (struct erl_off_heap_header*)pb; + Eterm bin; + bin = erts_build_proc_bin(&MSO(state->process), + HAlloc(state->process, PROC_BIN_SIZE), + erts_bin_realloc(state->acc, state->acc_size)); state->acc_size = 0; state->acc = NULL; - return make_binary(pb); + return bin; } /* Destructively enqueues a term to the result list, saving us the hassle of diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 0a5fe026db..94ebf88b56 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1317,21 +1317,11 @@ Eterm enif_make_binary(ErlNifEnv* env, ErlNifBinary* bin) } else if (bin->ref_bin != NULL) { Binary* bptr = bin->ref_bin; - ProcBin* pb; Eterm bin_term; - /* !! Copy-paste from new_binary() !! */ - pb = (ProcBin *) alloc_heap(env, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = bptr->orig_size; - pb->next = MSO(env->proc).first; - MSO(env->proc).first = (struct erl_off_heap_header*) pb; - pb->val = bptr; - pb->bytes = (byte*) bptr->orig_bytes; - pb->flags = 0; - - OH_OVERHEAD(&(MSO(env->proc)), pb->size / sizeof(Eterm)); - bin_term = make_binary(pb); + bin_term = erts_build_proc_bin(&MSO(env->proc), + alloc_heap(env, PROC_BIN_SIZE), + bptr); if (erts_refc_read(&bptr->intern.refc, 1) == 1) { /* Total ownership transfer */ bin->ref_bin = NULL; diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index e5c7a9502b..604f0be127 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2017. All Rights Reserved. + * Copyright Ericsson AB 2008-2018. 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. @@ -1158,14 +1158,15 @@ static ERTS_INLINE int analyze_utf8(byte *source, Uint size, byte **err_pos, Uint *num_chars, int *left, Sint *num_latin1_chars, Uint max_chars) { + int res = ERTS_UTF8_OK; Uint latin1_count; int is_latin1; + Uint nchars = 0; *err_pos = source; if (num_latin1_chars) { is_latin1 = 1; latin1_count = 0; } - *num_chars = 0; while (size) { if (((*source) & ((byte) 0x80)) == 0) { source++; @@ -1174,11 +1175,13 @@ analyze_utf8(byte *source, Uint size, byte **err_pos, Uint *num_chars, int *left latin1_count++; } else if (((*source) & ((byte) 0xE0)) == 0xC0) { if (size < 2) { - return ERTS_UTF8_INCOMPLETE; + res = ERTS_UTF8_INCOMPLETE; + break; } if (((source[1] & ((byte) 0xC0)) != 0x80) || ((*source) < 0xC2) /* overlong */) { - return ERTS_UTF8_ERROR; + res = ERTS_UTF8_ERROR; + break; } if (num_latin1_chars) { latin1_count++; @@ -1189,16 +1192,19 @@ analyze_utf8(byte *source, Uint size, byte **err_pos, Uint *num_chars, int *left size -= 2; } else if (((*source) & ((byte) 0xF0)) == 0xE0) { if (size < 3) { - return ERTS_UTF8_INCOMPLETE; + res = ERTS_UTF8_INCOMPLETE; + break; } if (((source[1] & ((byte) 0xC0)) != 0x80) || ((source[2] & ((byte) 0xC0)) != 0x80) || (((*source) == 0xE0) && (source[1] < 0xA0)) /* overlong */ ) { - return ERTS_UTF8_ERROR; + res = ERTS_UTF8_ERROR; + break; } if ((((*source) & ((byte) 0xF)) == 0xD) && ((source[1] & 0x20) != 0)) { - return ERTS_UTF8_ERROR; + res = ERTS_UTF8_ERROR; + break; } source += 3; size -= 3; @@ -1206,37 +1212,47 @@ analyze_utf8(byte *source, Uint size, byte **err_pos, Uint *num_chars, int *left is_latin1 = 0; } else if (((*source) & ((byte) 0xF8)) == 0xF0) { if (size < 4) { - return ERTS_UTF8_INCOMPLETE; + res = ERTS_UTF8_INCOMPLETE; + break; } if (((source[1] & ((byte) 0xC0)) != 0x80) || ((source[2] & ((byte) 0xC0)) != 0x80) || ((source[3] & ((byte) 0xC0)) != 0x80) || (((*source) == 0xF0) && (source[1] < 0x90)) /* overlong */) { - return ERTS_UTF8_ERROR; + res = ERTS_UTF8_ERROR; + break; } if ((((*source) & ((byte)0x7)) > 0x4U) || ((((*source) & ((byte)0x7)) == 0x4U) && ((source[1] & ((byte)0x3F)) > 0xFU))) { - return ERTS_UTF8_ERROR; + res = ERTS_UTF8_ERROR; + break; } source += 4; size -= 4; if (num_latin1_chars) is_latin1 = 0; } else { - return ERTS_UTF8_ERROR; + res = ERTS_UTF8_ERROR; + break; } - ++(*num_chars); + ++nchars; *err_pos = source; - if (max_chars && size > 0 && *num_chars == max_chars) - return ERTS_UTF8_OK_MAX_CHARS; + if (max_chars && size > 0 && nchars == max_chars) { + res = ERTS_UTF8_OK_MAX_CHARS; + break; + } if (left && --(*left) <= 0 && size) { - return ERTS_UTF8_ANALYZE_MORE; + res = ERTS_UTF8_ANALYZE_MORE; + break; } } + + *num_chars = nchars; if (num_latin1_chars) *num_latin1_chars = is_latin1 ? latin1_count : -1; - return ERTS_UTF8_OK; + + return res; } int erts_analyze_utf8(byte *source, Uint size, @@ -1252,29 +1268,18 @@ int erts_analyze_utf8_x(byte *source, Uint size, return analyze_utf8(source, size, err_pos, num_chars, left, num_latin1_chars, max_chars); } -/* - * No errors should be able to occur - no overlongs, no malformed, no nothing - */ -static Eterm do_utf8_to_list(Process *p, Uint num, byte *bytes, Uint sz, - Uint left, - Uint *num_built, Uint *num_eaten, Eterm tail) +static ERTS_INLINE Eterm +make_list_from_utf8_buf(Eterm **hpp, Uint num, + byte *bytes, Uint sz, + Uint *num_built, Uint *num_eaten, + Eterm tail) { Eterm *hp; Eterm ret; + Uint left = num; byte *source, *ssource; Uint unipoint; - - ASSERT(num > 0); - if (left < num) { - if (left > 0) - num = left; - else - num = 1; - } - - *num_built = num; /* Always */ - - hp = HAlloc(p,num * 2); + hp = *hpp; ret = tail; source = bytes + sz; ssource = source; @@ -1302,20 +1307,97 @@ static Eterm do_utf8_to_list(Process *p, Uint num, byte *bytes, Uint sz, } ret = CONS(hp,make_small(unipoint),ret); hp += 2; - if (--num <= 0) { + if (--left <= 0) { break; } } + *hpp = hp; + *num_built = num; /* Always */ *num_eaten = (ssource - source); return ret; } +/* + * No errors should be able to occur - no overlongs, no malformed, no nothing + */ +static Eterm do_utf8_to_list(Process *p, Uint num, byte *bytes, Uint sz, + Uint left, + Uint *num_built, Uint *num_eaten, Eterm tail) +{ + Eterm *hp; + + ASSERT(num > 0); + if (left < num) { + if (left > 0) + num = left; + else + num = 1; + } + + hp = HAlloc(p,num * 2); + + return make_list_from_utf8_buf(&hp, num, bytes, sz, + num_built, num_eaten, + tail); +} Eterm erts_utf8_to_list(Process *p, Uint num, byte *bytes, Uint sz, Uint left, Uint *num_built, Uint *num_eaten, Eterm tail) { return do_utf8_to_list(p, num, bytes, sz, left, num_built, num_eaten, tail); } +Uint erts_atom_to_string_length(Eterm atom) +{ + Atom *ap; + + ASSERT(is_atom(atom)); + ap = atom_tab(atom_val(atom)); + + if (ap->latin1_chars >= 0) + return (Uint) ap->len; + else { + byte* err_pos; + Uint num_chars; +#ifdef DEBUG + int ares = +#endif + erts_analyze_utf8(ap->name, ap->len, &err_pos, &num_chars, NULL); + ASSERT(ares == ERTS_UTF8_OK); + + return num_chars; + } +} + +Eterm erts_atom_to_string(Eterm **hpp, Eterm atom) +{ + Atom *ap; + + ASSERT(is_atom(atom)); + ap = atom_tab(atom_val(atom)); + if (ap->latin1_chars >= 0) + return buf_to_intlist(hpp, (char*)ap->name, ap->len, NIL); + else { + Eterm res; + byte* err_pos; + Uint num_chars, num_built, num_eaten; +#ifdef DEBUG + Eterm *hp_start = *hpp; + int ares = +#endif + erts_analyze_utf8(ap->name, ap->len, &err_pos, &num_chars, NULL); + ASSERT(ares == ERTS_UTF8_OK); + + res = make_list_from_utf8_buf(hpp, num_chars, ap->name, ap->len, + &num_built, &num_eaten, NIL); + + ASSERT(num_built == num_chars); + ASSERT(num_eaten == ap->len); + ASSERT(*hpp - hp_start == 2*num_chars); + + return res; + } +} + static int is_candidate(Uint cp) { int index,pos; diff --git a/erts/emulator/beam/erl_unicode.h b/erts/emulator/beam/erl_unicode.h index e01eaa787e..31369fc8f9 100644 --- a/erts/emulator/beam/erl_unicode.h +++ b/erts/emulator/beam/erl_unicode.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2016. All Rights Reserved. + * Copyright Ericsson AB 2008-2018. 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,4 +21,7 @@ #ifndef _ERL_UNICODE_H #define _ERL_UNICODE_H +Uint erts_atom_to_string_length(Eterm atom); +Eterm erts_atom_to_string(Eterm **hpp, Eterm atom); + #endif /* _ERL_UNICODE_H */ diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 9cc5e71afa..b12a021e41 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -2032,23 +2032,14 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla level = context->s.ec.level; BUMP_REDS(p, (initial_reds - reds) / TERM_TO_BINARY_LOOP_FACTOR); if (level == 0 || real_size < 6) { /* We are done */ - ProcBin* pb; return_normal: context->s.ec.result_bin = NULL; context->alive = 0; - pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = real_size; - pb->next = MSO(p).first; - MSO(p).first = (struct erl_off_heap_header*)pb; - pb->val = result_bin; - pb->bytes = (byte*) result_bin->orig_bytes; - pb->flags = 0; - OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); if (context_b && erts_refc_read(&context_b->intern.refc,0) == 0) { erts_bin_free(context_b); } - return make_binary(pb); + return erts_build_proc_bin(&MSO(p), HAlloc(p, PROC_BIN_SIZE), + result_bin); } /* Continue with compression... */ /* To make absolutely sure that zlib does not barf on a reallocated context, @@ -2105,16 +2096,7 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla result_bin = erts_bin_realloc(context->s.cc.destination_bin, context->s.cc.dest_len+6); context->s.cc.destination_bin = NULL; - pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); - pb->thing_word = HEADER_PROC_BIN; - pb->size = context->s.cc.dest_len+6; - pb->next = MSO(p).first; - MSO(p).first = (struct erl_off_heap_header*)pb; - pb->val = result_bin; ASSERT(erts_refc_read(&result_bin->intern.refc, 1)); - pb->bytes = (byte*) result_bin->orig_bytes; - pb->flags = 0; - OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); erts_bin_free(context->s.cc.result_bin); context->s.cc.result_bin = NULL; context->alive = 0; @@ -2122,7 +2104,9 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla if (context_b && erts_refc_read(&context_b->intern.refc,0) == 0) { erts_bin_free(context_b); } - return make_binary(pb); + return erts_build_proc_bin(&MSO(p), + HAlloc(p, PROC_BIN_SIZE), + result_bin); } default: /* Compression error, revert to uncompressed binary (still in context) */ @@ -3584,18 +3568,9 @@ dec_term_atom_common: *objp = make_binary(hb); } else { Binary* dbin = erts_bin_nrml_alloc(n); - ProcBin* pb; - pb = (ProcBin *) hp; + + *objp = erts_build_proc_bin(factory->off_heap, hp, dbin); hp += PROC_BIN_SIZE; - pb->thing_word = HEADER_PROC_BIN; - pb->size = n; - pb->next = factory->off_heap->first; - factory->off_heap->first = (struct erl_off_heap_header*)pb; - OH_OVERHEAD(factory->off_heap, pb->size / sizeof(Eterm)); - pb->val = dbin; - pb->bytes = (byte*) dbin->orig_bytes; - pb->flags = 0; - *objp = make_binary(pb); if (ctx) { int n_limit = reds * B2T_MEMCPY_FACTOR; if (n > n_limit) { @@ -3635,18 +3610,9 @@ dec_term_atom_common: ep += n; } else { Binary* dbin = erts_bin_nrml_alloc(n); - ProcBin* pb; + Uint n_copy = n; - pb = (ProcBin *) hp; - pb->thing_word = HEADER_PROC_BIN; - pb->size = n; - pb->next = factory->off_heap->first; - factory->off_heap->first = (struct erl_off_heap_header*)pb; - OH_OVERHEAD(factory->off_heap, pb->size / sizeof(Eterm)); - pb->val = dbin; - pb->bytes = (byte*) dbin->orig_bytes; - pb->flags = 0; - bin = make_binary(pb); + bin = erts_build_proc_bin(factory->off_heap, hp, dbin); hp += PROC_BIN_SIZE; if (ctx) { int n_limit = reds * B2T_MEMCPY_FACTOR; @@ -3654,15 +3620,15 @@ dec_term_atom_common: ctx->state = B2TDecodeBinary; ctx->u.dc.remaining_n = n - n_limit; ctx->u.dc.remaining_bytes = dbin->orig_bytes + n_limit; - n = n_limit; + n_copy = n_limit; reds = 0; } - else + else { reds -= n / B2T_MEMCPY_FACTOR; + } } - sys_memcpy(dbin->orig_bytes, ep, n); - ep += n; - n = pb->size; + sys_memcpy(dbin->orig_bytes, ep, n_copy); + ep += n_copy; } if (bitsize == 8 || n == 0) { diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 09500c5bc0..86e2c351af 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -861,6 +861,7 @@ Eterm erts_new_heap_binary(Process *p, byte *buf, int len, byte** datap); Eterm erts_new_mso_binary(Process*, byte*, Uint); Eterm new_binary(Process*, byte*, Uint); Eterm erts_realloc_binary(Eterm bin, size_t size); +Eterm erts_build_proc_bin(ErlOffHeap*, Eterm*, Binary*); /* erl_bif_info.c */ @@ -1122,7 +1123,6 @@ extern int erts_no_line_info; extern Eterm erts_error_logger_warnings; extern int erts_initialized; extern int erts_compat_rel; -extern int erts_use_sender_punish; void erl_start(int, char**); void erts_usage(void); Eterm erts_preloaded(Process* p); diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab index b92152238e..f19027b1ec 100644 --- a/erts/emulator/beam/instrs.tab +++ b/erts/emulator/beam/instrs.tab @@ -936,3 +936,28 @@ build_stacktrace() { x(0) = build_stacktrace(c_p, x(0)); SWAPIN; } + +raw_raise() { + Eterm class = x(0); + Eterm value = x(1); + Eterm stacktrace = x(2); + + if (class == am_error) { + c_p->freason = EXC_ERROR & ~EXF_SAVETRACE; + c_p->fvalue = value; + c_p->ftrace = stacktrace; + goto find_func_info; + } else if (class == am_exit) { + c_p->freason = EXC_EXIT & ~EXF_SAVETRACE; + c_p->fvalue = value; + c_p->ftrace = stacktrace; + goto find_func_info; + } else if (class == am_throw) { + c_p->freason = EXC_THROWN & ~EXF_SAVETRACE; + c_p->fvalue = value; + c_p->ftrace = stacktrace; + goto find_func_info; + } else { + x(0) = am_badarg; + } +} diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 6158e9613a..2c1b7871c4 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -3384,24 +3384,11 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, if ((state & ERTS_PORT_SFLG_BINARY_IO) == 0) { listp = buf_to_intlist(&hp, buf, len, listp); } else if (buf != NULL) { - ProcBin* pb; - Binary* bptr; - - bptr = erts_bin_nrml_alloc(len); + Binary* bptr = erts_bin_nrml_alloc(len); sys_memcpy(bptr->orig_bytes, buf, len); - pb = (ProcBin *) hp; - pb->thing_word = HEADER_PROC_BIN; - pb->size = len; - pb->next = ohp->first; - ohp->first = (struct erl_off_heap_header*)pb; - pb->val = bptr; - pb->bytes = (byte*) bptr->orig_bytes; - pb->flags = 0; + listp = erts_build_proc_bin(ohp, hp, bptr); hp += PROC_BIN_SIZE; - - OH_OVERHEAD(ohp, pb->size / sizeof(Eterm)); - listp = make_binary(pb); } /* Prepend the header */ @@ -4204,17 +4191,9 @@ write_port_control_result(int control_flags, else { dbin = (ErlDrvBinary *) resp_bufp; if (dbin->orig_size > ERL_ONHEAP_BIN_LIMIT) { - ProcBin* pb = (ProcBin *) *hpp; + res = erts_build_proc_bin(ohp, *hpp, ErlDrvBinary2Binary(dbin)); *hpp += PROC_BIN_SIZE; - pb->thing_word = HEADER_PROC_BIN; - pb->size = dbin->orig_size; - pb->next = ohp->first; - ohp->first = (struct erl_off_heap_header *) pb; - pb->val = ErlDrvBinary2Binary(dbin); - pb->bytes = (byte*) dbin->orig_bytes; - pb->flags = 0; - OH_OVERHEAD(ohp, dbin->orig_size / sizeof(Eterm)); - return make_binary(pb); + return res; } resp_bufp = dbin->orig_bytes; resp_size = dbin->orig_size; @@ -5978,21 +5957,12 @@ driver_deliver_term(Port *prt, Eterm to, ErlDrvTermData* data, int len) mess = make_binary(hbp); } else { - ProcBin* pbp; + Eterm* hp; Binary* bp = erts_bin_nrml_alloc(size); ASSERT(bufp); sys_memcpy((void *) bp->orig_bytes, (void *) bufp, size); - pbp = (ProcBin *) erts_produce_heap(&factory, - PROC_BIN_SIZE, HEAP_EXTRA); - pbp->thing_word = HEADER_PROC_BIN; - pbp->size = size; - pbp->next = factory.off_heap->first; - factory.off_heap->first = (struct erl_off_heap_header*)pbp; - pbp->val = bp; - pbp->bytes = (byte*) bp->orig_bytes; - pbp->flags = 0; - OH_OVERHEAD(factory.off_heap, pbp->size / sizeof(Eterm)); - mess = make_binary(pbp); + hp = erts_produce_heap(&factory, PROC_BIN_SIZE, HEAP_EXTRA); + mess = erts_build_proc_bin(factory.off_heap, hp, bp); } ptr += 2; break; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index fd1b3b9c74..1f4a8eadb0 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -1584,3 +1584,4 @@ i_recv_set # build_stacktrace +raw_raise diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index 380031bf13..e477c4cdea 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -1771,7 +1771,8 @@ void hipe_redirect_to_module(Module* modp) struct hipe_mfa_info *p; struct hipe_ref_head* refh; - ERTS_LC_ASSERT(erts_thr_progress_is_blocking()); + ERTS_LC_ASSERT(erts_thr_progress_is_blocking() || + erts_is_multi_scheduling_blocked()); for (p = mod2mfa_get(modp); p; p = p->next_in_mod) { if (p->new_address) { diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab index 0380e8c795..6728e20123 100644 --- a/erts/emulator/hipe/hipe_bif0.tab +++ b/erts/emulator/hipe/hipe_bif0.tab @@ -109,6 +109,7 @@ atom suspend_0 atom gc_1 atom hipe_apply atom rethrow +atom raw_raise atom find_na_or_make_stub atom nonclosure_address atom atomic_inc diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index 0562d676ae..33b3cc1ee5 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -220,6 +220,7 @@ standard_bif_interface_1(nbif_bnot_1, bnot_1) standard_bif_interface_1(nbif_set_timeout, hipe_set_timeout) standard_bif_interface_1(nbif_conv_big_to_float, hipe_conv_big_to_float) standard_bif_interface_2(nbif_rethrow, hipe_rethrow) +standard_bif_interface_3(nbif_raw_raise, hipe_raw_raise) standard_bif_interface_3(nbif_find_na_or_make_stub, hipe_find_na_or_make_stub) standard_bif_interface_2(nbif_nonclosure_address, hipe_nonclosure_address) nocons_nofail_primop_interface_0(nbif_fclearerror_error, hipe_fclearerror_error) diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index ac1480d2ed..498b43ac6b 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -314,6 +314,32 @@ BIF_RETTYPE nbif_impl_hipe_rethrow(NBIF_ALIST_2) } } +/* Called via standard_bif_interface_3 */ +BIF_RETTYPE nbif_impl_hipe_raw_raise(NBIF_ALIST_3) +{ + Process *c_p = BIF_P; + Eterm class = BIF_ARG_1; + Eterm value = BIF_ARG_2; + Eterm stacktrace = BIF_ARG_3; + Eterm reason; + + if (class == am_error) { + c_p->fvalue = value; + reason = EXC_ERROR; + } else if (class == am_exit) { + c_p->fvalue = value; + reason = EXC_EXIT; + } else if (class == am_throw) { + c_p->fvalue = value; + reason = EXC_THROWN; + } else { + return am_badarg; + } + reason &= ~EXF_SAVETRACE; + c_p->ftrace = stacktrace; + BIF_ERROR(c_p, reason); +} + /* * Support for compiled binary syntax operations. */ diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h index 5711594b1e..ba42b126be 100644 --- a/erts/emulator/hipe/hipe_native_bif.h +++ b/erts/emulator/hipe/hipe_native_bif.h @@ -36,6 +36,7 @@ AEXTERN(int,nbif_suspend_msg,(void)); AEXTERN(int,nbif_suspend_msg_timeout,(void)); AEXTERN(Eterm,nbif_rethrow,(Process*, Eterm, Eterm)); +AEXTERN(Eterm,nbif_raw_raise,(Process*, Eterm, Eterm, Eterm)); AEXTERN(Eterm,nbif_set_timeout,(Process*, Eterm)); AEXTERN(Eterm,nbif_gc_1,(void)); @@ -82,6 +83,7 @@ void hipe_gc(Process*, Eterm); BIF_RETTYPE nbif_impl_hipe_set_timeout(NBIF_ALIST_1); void hipe_handle_exception(Process*); BIF_RETTYPE nbif_impl_hipe_rethrow(NBIF_ALIST_2); +BIF_RETTYPE nbif_impl_hipe_raw_raise(NBIF_ALIST_3); char *hipe_bs_allocate(int); Binary *hipe_bs_reallocate(Binary*, int); int hipe_bs_put_small_float(Process*, Eterm, Uint, byte*, unsigned, unsigned); diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h index d6fd10bdff..c5f10672f3 100644 --- a/erts/emulator/hipe/hipe_primops.h +++ b/erts/emulator/hipe/hipe_primops.h @@ -46,6 +46,7 @@ PRIMOP_LIST(am_clear_timeout, &nbif_clear_timeout) PRIMOP_LIST(am_select_msg, &nbif_select_msg) PRIMOP_LIST(am_set_timeout, &nbif_set_timeout) PRIMOP_LIST(am_rethrow, &nbif_rethrow) +PRIMOP_LIST(am_raw_raise, &nbif_raw_raise) PRIMOP_LIST(am_bs_get_integer_2, &nbif_bs_get_integer_2) diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c index 420138ff0a..96bdbacb9e 100644 --- a/erts/emulator/sys/common/erl_sys_common_misc.c +++ b/erts/emulator/sys/common/erl_sys_common_misc.c @@ -150,59 +150,50 @@ int sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, int compact) { - /* Note that some C compilers don't support "static const" propagation - * so we use a defines */ - #define SYS_DOUBLE_RND_CONST 0.55555555555555555 + #define SYS_DOUBLE_RND_CONST 0.5 #define FRAC_SIZE 52 #define EXP_SIZE 11 - #define EXP_MASK ((1ll << EXP_SIZE) - 1) + #define EXP_MASK (((Uint64)1 << EXP_SIZE) - 1) #define MAX_DECIMALS (sizeof(cs_sys_double_pow10) \ / sizeof(cs_sys_double_pow10[0])) - #define FRAC_MASK ((1ll << FRAC_SIZE) - 1) - #define FRAC_MASK2 ((1ll << (FRAC_SIZE + 1)) - 1) - #define MAX_FLOAT (1ll << (FRAC_SIZE+1)) + #define FRAC_MASK (((Uint64)1 << FRAC_SIZE) - 1) + #define FRAC_MASK2 (((Uint64)1 << (FRAC_SIZE + 1)) - 1) + #define MAX_FLOAT ((Uint64)1 << (FRAC_SIZE+1)) static const double cs_sys_double_pow10[] = { - SYS_DOUBLE_RND_CONST / 1ll, - SYS_DOUBLE_RND_CONST / 10ll, - SYS_DOUBLE_RND_CONST / 100ll, - SYS_DOUBLE_RND_CONST / 1000ll, - SYS_DOUBLE_RND_CONST / 10000ll, - SYS_DOUBLE_RND_CONST / 100000ll, - SYS_DOUBLE_RND_CONST / 1000000ll, - SYS_DOUBLE_RND_CONST / 10000000ll, - SYS_DOUBLE_RND_CONST / 100000000ll, - SYS_DOUBLE_RND_CONST / 1000000000ll, - SYS_DOUBLE_RND_CONST / 10000000000ll, - SYS_DOUBLE_RND_CONST / 100000000000ll, - SYS_DOUBLE_RND_CONST / 1000000000000ll, - SYS_DOUBLE_RND_CONST / 10000000000000ll, - SYS_DOUBLE_RND_CONST / 100000000000000ll, - SYS_DOUBLE_RND_CONST / 1000000000000000ll, - SYS_DOUBLE_RND_CONST / 10000000000000000ll, - SYS_DOUBLE_RND_CONST / 100000000000000000ll, - SYS_DOUBLE_RND_CONST / 1000000000000000000ll + SYS_DOUBLE_RND_CONST / 1e0, + SYS_DOUBLE_RND_CONST / 1e1, + SYS_DOUBLE_RND_CONST / 1e2, + SYS_DOUBLE_RND_CONST / 1e3, + SYS_DOUBLE_RND_CONST / 1e4, + SYS_DOUBLE_RND_CONST / 1e5, + SYS_DOUBLE_RND_CONST / 1e6, + SYS_DOUBLE_RND_CONST / 1e7, + SYS_DOUBLE_RND_CONST / 1e8, + SYS_DOUBLE_RND_CONST / 1e9, + SYS_DOUBLE_RND_CONST / 1e10, + SYS_DOUBLE_RND_CONST / 1e11, + SYS_DOUBLE_RND_CONST / 1e12, + SYS_DOUBLE_RND_CONST / 1e13, + SYS_DOUBLE_RND_CONST / 1e14, + SYS_DOUBLE_RND_CONST / 1e15, + SYS_DOUBLE_RND_CONST / 1e16, + SYS_DOUBLE_RND_CONST / 1e17, + SYS_DOUBLE_RND_CONST / 1e18 }; - long long mantissa, int_part = 0, frac_part = 0; - short exp; + Uint64 mantissa, int_part, frac_part; + int exp; + int fbits; int max; int neg; double fr; - union { long long L; double F; } x; + union { Uint64 L; double F; } x; char *p = buffer; if (decimals < 0) return -1; - /* Round the number to given decimal places. The number of 5's in the - * SYS_DOUBLE_RND_CONST constant is chosen such that adding any more 5's doesn't - * change the double precision of the number, i.e.: - * 1> term_to_binary(0.55555555555555555, [{minor_version, 1}]). - * <<131,70,63,225,199,28,113,199,28,114>> - * 2> term_to_binary(0.5555555555555555555, [{minor_version, 1}]). - * <<131,70,63,225,199,28,113,199,28,114>> - */ if (f >= 0) { neg = 0; fr = decimals < MAX_DECIMALS ? (f + cs_sys_double_pow10[decimals]) : f; @@ -233,7 +224,7 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, } exp -= EXP_MASK >> 1; - mantissa |= (1ll << FRAC_SIZE); + mantissa |= ((Uint64)1 << FRAC_SIZE); /* Don't bother with optimizing too large numbers or too large precision */ if (x.F > MAX_FLOAT || decimals >= MAX_DECIMALS) { @@ -248,11 +239,16 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, return p - buffer; } else if (exp >= FRAC_SIZE) { int_part = mantissa << (exp - FRAC_SIZE); + frac_part = 0; + fbits = FRAC_SIZE; /* not important as frac_part==0 */ } else if (exp >= 0) { - int_part = mantissa >> (FRAC_SIZE - exp); - frac_part = (mantissa << (exp + 1)) & FRAC_MASK2; + fbits = FRAC_SIZE - exp; + int_part = mantissa >> fbits; + frac_part = mantissa & (((Uint64)1 << fbits) -1); } else /* if (exp < 0) */ { - frac_part = (mantissa & FRAC_MASK2) >> -(exp + 1); + int_part = 0; + frac_part = mantissa; + fbits = FRAC_SIZE - exp; } if (!int_part) { @@ -262,9 +258,8 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, } else { int ret, i, n; while (int_part != 0) { - long long j = int_part / 10; - *p++ = (char)(int_part - ((j << 3) + (j << 1)) + '0'); - int_part = j; + *p++ = (char)((int_part % 10) + '0'); + int_part /= 10; } if (neg) *p++ = '-'; @@ -290,11 +285,22 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, max = decimals; for (i = 0; i < max; i++) { - /* frac_part *= 10; */ - frac_part = (frac_part << 3) + (frac_part << 1); - - *p++ = (char)((frac_part >> (FRAC_SIZE + 1)) + '0'); - frac_part &= FRAC_MASK2; + if (frac_part > (ERTS_UINT64_MAX/5)) { + frac_part >>= 3; + fbits -= 3; + } + + /* Multiply by 10 (5*2) to extract decimal digit as integer part */ + frac_part *= 5; + fbits--; + + if (fbits >= 64) { + *p++ = '0'; + } + else { + *p++ = (char)((frac_part >> fbits) + '0'); + frac_part &= ((Uint64)1 << fbits) - 1; + } } /* Delete trailing zeroes */ diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index dca600bc7b..661a2ee6c9 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2017. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -27,7 +27,8 @@ constant_pools/1,constant_refc_binaries/1, fake_literals/1, false_dependency/1,coverage/1,fun_confusion/1, - t_copy_literals/1, t_copy_literals_frags/1]). + t_copy_literals/1, t_copy_literals_frags/1, + erl_544/1]). -define(line_trace, 1). -include_lib("common_test/include/ct.hrl"). @@ -41,7 +42,8 @@ all() -> module_md5, constant_pools, constant_refc_binaries, fake_literals, false_dependency, - coverage, fun_confusion, t_copy_literals, t_copy_literals_frags]. + coverage, fun_confusion, t_copy_literals, t_copy_literals_frags, + erl_544]. init_per_suite(Config) -> erts_debug:set_internal_state(available_internal_state, true), @@ -918,6 +920,53 @@ reloader(Mod,Code,Time) -> reloader(Mod,Code,Time) end. +erl_544(Config) when is_list(Config) -> + case file:native_name_encoding() of + utf8 -> + {ok, CWD} = file:get_cwd(), + try + Mod = erl_544, + FileName = atom_to_list(Mod) ++ ".erl", + Priv = proplists:get_value(priv_dir, Config), + Data = proplists:get_value(data_dir, Config), + {ok, FileContent} = file:read_file(filename:join(Data, + FileName)), + Dir = filename:join(Priv, [16#2620,16#2620,16#2620]), + File = filename:join(Dir, FileName), + io:format("~ts~n", [File]), + ok = file:make_dir(Dir), + ok = file:set_cwd(Dir), + ok = file:write_file(File, [FileContent]), + {ok, Mod} = compile:file(File), + Res1 = (catch Mod:err()), + io:format("~p~n", [Res1]), + {'EXIT', {err, [{Mod, err, 0, Info1}|_]}} = Res1, + File = proplists:get_value(file, Info1), + Me = self(), + Go = make_ref(), + Tester = spawn_link(fun () -> + Mod:wait(Me, Go), + Mod:err() + end), + receive Go -> ok end, + Res2 = process_info(Tester, current_stacktrace), + io:format("~p~n", [Res2]), + {current_stacktrace, Stack} = Res2, + [{Mod, wait, 2, Info2}|_] = Stack, + File = proplists:get_value(file, Info2), + StackFun = fun(_, _, _) -> false end, + FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end, + Formated = + lib:format_stacktrace(1, Stack, StackFun, FormatFun), + true = is_list(Formated), + ok + after + ok = file:set_cwd(CWD) + end, + ok; + _Enc -> + {skipped, "Only run when native file name encoding is utf8"} + end. %% Utilities. diff --git a/erts/emulator/test/code_SUITE_data/erl_544.erl b/erts/emulator/test/code_SUITE_data/erl_544.erl new file mode 100644 index 0000000000..c93f3ef5bc --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/erl_544.erl @@ -0,0 +1,35 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. 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(erl_544). + +-export([err/0, wait/2]). + +err() -> + erlang:error(err). + +wait(Pid, Msg) -> + erlang:yield(), + Pid ! Msg, + receive + after infinity -> + ok + end, + err(). diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index 17555d63c6..592542405f 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -118,6 +118,7 @@ t_float(Config) when is_list(Config) -> %% Tests float_to_list/1, float_to_list/2, float_to_binary/1, float_to_binary/2 t_float_to_string(Config) when is_list(Config) -> + rand_seed(), test_fts("0.00000000000000000000e+00", 0.0), test_fts("2.50000000000000000000e+01", 25.0), test_fts("2.50000000000000000000e+00", 2.5), @@ -167,8 +168,8 @@ t_float_to_string(Config) when is_list(Config) -> test_fts("1.12300",1.123, [{decimals, 5}]), test_fts("1.123",1.123, [{decimals, 5}, compact]), test_fts("1.1234",1.1234,[{decimals, 6}, compact]), - test_fts("1.01",1.005, [{decimals, 2}]), - test_fts("-1.01",-1.005,[{decimals, 2}]), + test_fts("1.00",1.005, [{decimals, 2}]), %% 1.005 is really 1.0049999999... + test_fts("-1.00",-1.005,[{decimals, 2}]), test_fts("0.999",0.999, [{decimals, 3}]), test_fts("-0.999",-0.999,[{decimals, 3}]), test_fts("1.0",0.999, [{decimals, 2}, compact]), @@ -184,6 +185,9 @@ t_float_to_string(Config) when is_list(Config) -> test_fts("123000000000000000000.0",1.23e20, [{decimals, 10}, compact]), test_fts("1.2300000000e+20",1.23e20, [{scientific, 10}, compact]), test_fts("1.23000000000000000000e+20",1.23e20, []), + + fts_rand_float_decimals(1000), + ok. test_fts(Expect, Float) -> @@ -197,6 +201,49 @@ test_fts(Expect, Float, Args) -> BinExpect = float_to_binary(Float,Args). +rand_float_reasonable() -> + F = rand_float(), + case abs(F) > 1.0e238 of + true -> rand_float_reasonable(); + false -> F + end. + +fts_rand_float_decimals(0) -> ok; +fts_rand_float_decimals(N) -> + [begin + F0 = rand_float_reasonable(), + L0 = float_to_list(F0, [{decimals, D}]), + L1 = case D of + 0 -> L0 ++ ".0"; + _ -> L0 + end, + F1 = list_to_float(L1), + Diff = abs(F0-F1), + MaxDiff = max_diff_decimals(F0, D), + ok = case Diff =< MaxDiff of + true -> ok; + false -> + io:format("F0 = ~w ~w\n", [F0, <<F0/float>>]), + io:format("L1 = ~s\n", [L1]), + io:format("F1 = ~w ~w\n", [F1, <<F1/float>>]), + io:format("Diff = ~w, MaxDiff = ~w\n", [Diff, MaxDiff]), + error + end + end + || D <- lists:seq(0,15)], + + fts_rand_float_decimals(N-1). + +max_diff_decimals(F, D) -> + IntBits = floor(math:log2(abs(F))) + 1, + FracBits = (52 - IntBits), + Log10_2 = 0.3010299956639812, % math:log10(2) + MaxDec = floor(FracBits * Log10_2), + + Resolution = math:pow(2, IntBits - 53), + + (math:pow(10, -min(D,MaxDec)) / 2) + Resolution. + %% Tests list_to_float/1. t_string_to_float_safe(Config) when is_list(Config) -> @@ -331,18 +378,26 @@ t_trunc_and_friends(_Config) -> -18446744073709551616 = trunc_and_friends(-float(1 bsl 64)), %% Random. + rand_seed(), t_trunc_and_friends_rand(100), ok. +rand_seed() -> + rand:seed(exrop), + io:format("\n*** rand:export_seed() = ~w\n\n", [rand:export_seed()]), + ok. + +rand_float() -> + F0 = rand:uniform() * math:pow(10, 50*rand:normal()), + case rand:uniform() of + U when U < 0.5 -> -F0; + _ -> F0 + end. + t_trunc_and_friends_rand(0) -> ok; t_trunc_and_friends_rand(N) -> - F0 = rand:uniform() * math:pow(10, 50*rand:normal()), - F = case rand:uniform() of - U when U < 0.5 -> -F0; - _ -> F0 - end, - _ = trunc_and_friends(F), + _ = trunc_and_friends(rand_float()), t_trunc_and_friends_rand(N-1). trunc_and_friends(F) -> @@ -491,7 +546,7 @@ t_string_to_integer(Config) when is_list(Config) -> list_to_binary(Value),Base)), {'EXIT', {badarg, _}} = (catch erlang:list_to_integer(Value,Base)) - end,[{" 1",1},{" 1",37},{"2",2},{"C",11}, + end,[{" 1",1},{" 1",37},{"2",2},{"B",11},{"b",11},{":", 16}, {"1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111z",16}, {"1z111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111",16}, {"111z11111111",16}]), diff --git a/erts/lib_src/common/erl_printf_format.c b/erts/lib_src/common/erl_printf_format.c index 3daa066fd3..3302083288 100644 --- a/erts/lib_src/common/erl_printf_format.c +++ b/erts/lib_src/common/erl_printf_format.c @@ -331,7 +331,7 @@ static int fmt_double(fmtfn_t fn,void*arg,double val, char *bufp = sbuf; double dexp; int exp; - size_t max_size = 1; + size_t max_size = 2; /* including possible sign */ int size; int new_fmt = fmt; int fpe_was_unmasked; diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index f3c83b9949..278a485a01 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2454,7 +2454,7 @@ term_to_binary(_Term) -> Term :: term(), Options :: [compressed | {compressed, Level :: 0..9} | - {minor_version, Version :: 0..1} ]. + {minor_version, Version :: 0..2} ]. term_to_binary(_Term, _Options) -> erlang:nif_error(undefined). diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index b98a704e28..bfeffa969f 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -1355,8 +1355,8 @@ xref_export_all(_Config) -> [] -> ok; [_|_] -> - S = [io_lib:format("~p:~p/~p\n", [M,F,A]) || {M,F,A} <- Unused], - io:format("There are unused functions:\n\n~s\n", [S]), + Msg = [io_lib:format("~p:~p/~p\n", [M,F,A]) || {M,F,A} <- Unused], + io:format("There are unused functions:\n\n~s\n", [Msg]), ?t:fail(unused_functions) end. diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index 6f09dc4be4..7df2edd714 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -58,7 +58,8 @@ rename_instrs([{call_only,A,F}|Is]) -> rename_instrs([{call_ext_only,A,F}|Is]) -> [{call_ext,A,F},return|rename_instrs(Is)]; rename_instrs([{'%live',_}|Is]) -> - %% When compiling from old .S files. + %% Ignore old type of live annotation. Only happens when compiling + %% from very old .S files. rename_instrs(Is); rename_instrs([I|Is]) -> [rename_instr(I)|rename_instrs(Is)]; diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index fe1ce6f60b..39ae8d5347 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -23,25 +23,32 @@ -module(beam_block). -export([module/2]). --import(lists, [reverse/1,reverse/2,foldl/3,member/2]). +-import(lists, [reverse/1,reverse/2,member/2]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. -module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> - Fs = [function(F) || F <- Fs0], +module({Mod,Exp,Attr,Fs0,Lc}, Opts) -> + Blockify = not member(no_blockify, Opts), + Fs = [function(F, Blockify) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. -function({function,Name,Arity,CLabel,Is0}) -> +function({function,Name,Arity,CLabel,Is0}, Blockify) -> try %% Collect basic blocks and optimize them. - Is1 = blockify(Is0), - Is2 = embed_lines(Is1), + Is2 = case Blockify of + true -> + Is1 = blockify(Is0), + embed_lines(Is1); + false -> + Is0 + end, Is3 = beam_utils:anno_defs(Is2), Is4 = move_allocates(Is3), Is5 = beam_utils:live_opt(Is4), Is6 = opt_blocks(Is5), - Is = beam_utils:delete_live_annos(Is6), + Is7 = beam_utils:delete_annos(Is6), + Is = opt_allocs(Is7), %% Done. {function,Name,Arity,CLabel,Is} @@ -136,17 +143,16 @@ embed_lines([], Acc) -> Acc. opt_blocks([{block,Bl0}|Is]) -> %% The live annotation at the beginning is not useful. - [{'%live',_,_}|Bl] = Bl0, + [{'%anno',_}|Bl] = Bl0, [{block,opt_block(Bl)}|opt_blocks(Is)]; opt_blocks([I|Is]) -> [I|opt_blocks(Is)]; opt_blocks([]) -> []. opt_block(Is0) -> - Is = find_fixpoint(fun(Is) -> - opt_tuple_element(opt(Is)) - end, Is0), - opt_alloc(Is). + find_fixpoint(fun(Is) -> + opt_tuple_element(opt(Is)) + end, Is0). find_fixpoint(OptFun, Is0) -> case OptFun(Is0) of @@ -196,7 +202,7 @@ move_allocates([I|Is]) -> [I|move_allocates(Is)]; move_allocates([]) -> []. -move_allocates_1([{'%def',_}|Is], Acc) -> +move_allocates_1([{'%anno',_}|Is], Acc) -> move_allocates_1(Is, Acc); move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info}}|Acc]=Acc0) -> case alloc_may_pass(I) of @@ -240,10 +246,14 @@ opt([{set,_,_,{line,_}}=Line1, {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,0}}}=I2|Is]) when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg -> opt([Line2,I2,Line1,I1|Is]); +opt([{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,L}}}=I1, + {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,L}}}=I2|Is]) + when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg -> + opt([I2,I1|Is]); opt([{set,Ds0,Ss,Op}|Is0]) -> {Ds,Is} = opt_moves(Ds0, Is0), [{set,Ds,Ss,Op}|opt(Is)]; -opt([{'%live',_,_}=I|Is]) -> +opt([{'%anno',_}=I|Is]) -> [I|opt(Is)]; opt([]) -> []. @@ -411,31 +421,47 @@ eliminate_use_of_from_reg([I]=Is, From, _To, Acc) -> no end. +%% opt_allocs(Instructions) -> Instructions. Optimize allocate +%% instructions inside blocks. If safe, replace an allocate_zero +%% instruction with the slightly cheaper allocate instruction. + +opt_allocs(Is) -> + D = beam_utils:index_labels(Is), + opt_allocs_1(Is, D). + +opt_allocs_1([{block,Bl0}|Is], D) -> + Bl = opt_alloc(Bl0, {D,Is}), + [{block,Bl}|opt_allocs_1(Is, D)]; +opt_allocs_1([I|Is], D) -> + [I|opt_allocs_1(Is, D)]; +opt_allocs_1([], _) -> []. + %% opt_alloc(Instructions) -> Instructions' %% Optimises all allocate instructions. opt_alloc([{set,[],[],{alloc,Live0,Info0}}, - {set,[],[],{alloc,Live,Info}}|Is]) -> + {set,[],[],{alloc,Live,Info}}|Is], D) -> Live = Live0, %Assertion. Alloc = combine_alloc(Info0, Info), I = {set,[],[],{alloc,Live,Alloc}}, - opt_alloc([I|Is]); -opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is]) -> - [{set,[],[],opt_alloc(Is, Ns, Nh, R)}|Is]; -opt_alloc([I|Is]) -> [I|opt_alloc(Is)]; -opt_alloc([]) -> []. + opt_alloc([I|Is], D); +opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is], D) -> + [{set,[],[],opt_alloc(Is, D, Ns, Nh, R)}|Is]; +opt_alloc([I|Is], D) -> [I|opt_alloc(Is, D)]; +opt_alloc([], _) -> []. combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) -> {zero,Ns,beam_utils:combine_heap_needs(Nh1, Nh2),Init}. - + %% opt_alloc(Instructions, FrameSize, HeapNeed, LivingRegs) -> [Instr] %% Generates the optimal sequence of instructions for %% allocating and initalizing the stack frame and needed heap. -opt_alloc(_Is, nostack, Nh, LivingRegs) -> +opt_alloc(_Is, _D, nostack, Nh, LivingRegs) -> {alloc,LivingRegs,{nozero,nostack,Nh,[]}}; -opt_alloc(Is, Ns, Nh, LivingRegs) -> - InitRegs = init_yreg(Is, 0), +opt_alloc(Bl, {D,OuterIs}, Ns, Nh, LivingRegs) -> + Is = [{block,Bl}|OuterIs], + InitRegs = init_yregs(Ns, Is, D), case count_ones(InitRegs) of N when N*2 > Ns -> {alloc,LivingRegs,{nozero,Ns,Nh,gen_init(Ns, InitRegs)}}; @@ -451,19 +477,14 @@ gen_init(Fs, Regs, Y, Acc) when Regs band 1 =:= 0 -> gen_init(Fs, Regs, Y, Acc) -> gen_init(Fs, Regs bsr 1, Y+1, Acc). -%% init_yreg(Instructions, RegSet) -> RegSetInitialized -%% Calculate the set of initialized y registers. - -init_yreg([{set,_,_,{bif,_,_}}|_], Reg) -> Reg; -init_yreg([{set,_,_,{alloc,_,{gc_bif,_,_}}}|_], Reg) -> Reg; -init_yreg([{set,_,_,{alloc,_,{put_map,_,_}}}|_], Reg) -> Reg; -init_yreg([{set,Ds,_,_}|Is], Reg) -> init_yreg(Is, add_yregs(Ds, Reg)); -init_yreg(_Is, Reg) -> Reg. - -add_yregs(Ys, Reg) -> foldl(fun(Y, R0) -> add_yreg(Y, R0) end, Reg, Ys). - -add_yreg({y,Y}, Reg) -> Reg bor (1 bsl Y); -add_yreg(_, Reg) -> Reg. +init_yregs(Y, Is, D) when Y >= 0 -> + case beam_utils:is_killed({y,Y}, Is, D) of + true -> + (1 bsl Y) bor init_yregs(Y-1, Is, D); + false -> + init_yregs(Y-1, Is, D) + end; +init_yregs(_, _, _) -> 0. count_ones(Bits) -> count_ones(Bits, 0). count_ones(0, Acc) -> Acc; @@ -514,7 +535,7 @@ x_live([], Regs) -> Regs. %% Given a reversed instruction stream, determine the %% the registers that are defined. -defined_regs([{'%def',Def}|_], Regs) -> +defined_regs([{'%anno',{def,Def}}|_], Regs) -> Def bor Regs; defined_regs([{set,Ds,_,{alloc,Live,_}}|_], Regs) -> x_live(Ds, Regs bor ((1 bsl Live) - 1)); diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 9ea5a3eb92..9f3b9d788f 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -124,20 +124,21 @@ btb_opt_1([{test,bs_get_binary2,F,_,[Reg,{atom,all},U,Fs],Reg}=I0|Is], D, Acc0) end, btb_opt_1(Is, D, Acc) end; -btb_opt_1([{test,bs_get_binary2,F,_,[Ctx,{atom,all},U,Fs],Dst}=I0|Is], D, Acc0) -> - case btb_reaches_match(Is, [Ctx,Dst], D) of +btb_opt_1([{test,bs_get_binary2,F,_,[Ctx,{atom,all},U,Fs],Dst}=I0|Is0], D, Acc0) -> + case btb_reaches_match(Is0, [Ctx,Dst], D) of {error,Reason} -> Comment = btb_comment_no_opt(Reason, Fs), - btb_opt_1(Is, D, [Comment,I0|Acc0]); + btb_opt_1(Is0, D, [Comment,I0|Acc0]); {ok,MustSave} when U =:= 1 -> Comment = btb_comment_opt(Fs), - Acc1 = btb_gen_save(MustSave, Ctx, [Comment|Acc0]), - Acc = [{move,Ctx,Dst}|Acc1], + Acc = btb_gen_save(MustSave, Ctx, [Comment|Acc0]), + Is = prepend_move(Ctx, Dst, Is0), btb_opt_1(Is, D, Acc); {ok,MustSave} -> Comment = btb_comment_opt(Fs), Acc1 = btb_gen_save(MustSave, Ctx, [Comment|Acc0]), - Acc = [{move,Ctx,Dst},{test,bs_test_unit,F,[Ctx,U]}|Acc1], + Acc = [{test,bs_test_unit,F,[Ctx,U]}|Acc1], + Is = prepend_move(Ctx, Dst, Is0), btb_opt_1(Is, D, Acc) end; btb_opt_1([I|Is], D, Acc) -> @@ -150,6 +151,12 @@ btb_gen_save(true, Reg, Acc) -> [{bs_save2,Reg,{atom,start}}|Acc]; btb_gen_save(false, _, Acc) -> Acc. +prepend_move(Ctx, Dst, [{block,Bl0}|Is]) -> + Bl = [{set,[Dst],[Ctx],move}|Bl0], + [{block,Bl}|Is]; +prepend_move(Ctx, Dst, Is) -> + [{move,Ctx,Dst}|Is]. + %% btb_reaches_match([Instruction], [Register], D) -> %% {ok,MustSave}|{error,Reason} %% diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 22ba86fa38..50b76d7f29 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1088,6 +1088,8 @@ resolve_inst({get_map_elements,Args0},_,_,_) -> resolve_inst({build_stacktrace,[]},_,_,_) -> build_stacktrace; +resolve_inst({raw_raise,[]},_,_,_) -> + raw_raise; %% %% Catches instructions that are not yet handled. diff --git a/lib/compiler/src/beam_disasm.hrl b/lib/compiler/src/beam_disasm.hrl index 8cc0bcf99b..c3326c15a0 100644 --- a/lib/compiler/src/beam_disasm.hrl +++ b/lib/compiler/src/beam_disasm.hrl @@ -27,7 +27,7 @@ %% PROPER TYPES FOR THE SET OF BEAM INSTRUCTIONS. %% -type beam_instr() :: 'bs_init_writable' | 'build_stacktrace' - | 'fclearerror' | 'if_end' + | 'fclearerror' | 'if_end' | 'raw_raise' | 'remove_message' | 'return' | 'send' | 'timeout' | tuple(). %% XXX: Very underspecified - FIX THIS diff --git a/lib/compiler/src/beam_record.erl b/lib/compiler/src/beam_record.erl index db1053e48c..58a6de6775 100644 --- a/lib/compiler/src/beam_record.erl +++ b/lib/compiler/src/beam_record.erl @@ -71,7 +71,7 @@ rewrite([{test,test_arity,Fail,[Src,N]}=TA, I = {test,is_tagged_tuple,Fail,[Src,N,Atom]}, rewrite(Is, Idx, Def, [I|Acc]) end; -rewrite([{block,[{'%def',Def}|Bl]}|Is], Idx, _Def, Acc) -> +rewrite([{block,[{'%anno',{def,Def}}|Bl]}|Is], Idx, _Def, Acc) -> rewrite(Is, Idx, Def, [{block,Bl}|Acc]); rewrite([{label,L}=I|Is], Idx0, Def, Acc) -> Idx = beam_utils:index_label(L, Acc, Idx0), diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index e9f62a5765..3b6bf49961 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -40,7 +40,7 @@ function({function,Name,Arity,CLabel,Asm0}) -> Asm1 = beam_utils:live_opt(Asm0), Asm2 = opt(Asm1, [], tdb_new()), Asm3 = beam_utils:live_opt(Asm2), - Asm = beam_utils:delete_live_annos(Asm3), + Asm = beam_utils:delete_annos(Asm3), {function,Name,Arity,CLabel,Asm} catch Class:Error:Stack -> @@ -92,7 +92,7 @@ simplify_basic_1([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is], Ts0, A simplify_basic_1(Is, Ts, [I|Acc]); simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) -> case tdb_find(TupleReg, Ts0) of - {tuple,_,[Contents]} -> + {tuple,_,_,[Contents]} -> simplify_basic_1([{set,[D],[Contents],move}|Is0], Ts0, Acc); _ -> Ts = update(I, Ts0), @@ -113,9 +113,17 @@ simplify_basic_1([{test,is_integer,_,[R]}=I|Is], Ts, Acc) -> end; simplify_basic_1([{test,is_tuple,_,[R]}=I|Is], Ts, Acc) -> case tdb_find(R, Ts) of - {tuple,_,_} -> simplify_basic_1(Is, Ts, Acc); + {tuple,_,_,_} -> simplify_basic_1(Is, Ts, Acc); _ -> simplify_basic_1(Is, Ts, [I|Acc]) end; +simplify_basic_1([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Acc) -> + case tdb_find(R, Ts0) of + {tuple,exact_size,Arity,_} -> + simplify_basic_1(Is, Ts0, Acc); + _Other -> + Ts = update(I, Ts0), + simplify_basic_1(Is, Ts, [I|Acc]) + end; simplify_basic_1([{test,is_map,_,[R]}=I|Is], Ts0, Acc) -> case tdb_find(R, Ts0) of map -> simplify_basic_1(Is, Ts0, Acc); @@ -138,6 +146,14 @@ simplify_basic_1([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Acc0) - end, Ts = update(I, Ts0), simplify_basic_1(Is0, Ts, Acc); +simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0, Acc) -> + case tdb_find(R, Ts0) of + {tuple,exact_size,Arity,[Tag]} -> + simplify_basic_1(Is, Ts0, Acc); + _Other -> + Ts = update(I, Ts0), + simplify_basic_1(Is, Ts, [I|Acc]) + end; simplify_basic_1([{select,select_val,Reg,_,_}=I0|Is], Ts, Acc) -> I = case tdb_find(Reg, Ts) of {integer,Range} -> @@ -284,7 +300,7 @@ clearerror([], OrigIs) -> [{set,[],[],fclearerror}|OrigIs]. %% Combine two blocks and eliminate any move instructions that assign %% to registers that are killed later in the block. %% -merge_blocks(B1, [{'%live',_,_}|B2]) -> +merge_blocks(B1, [{'%anno',_}|B2]) -> merge_blocks_1(B1++[{set,[],[],stop_here}|B2]). merge_blocks_1([{set,[],_,stop_here}|Is]) -> Is; @@ -333,27 +349,17 @@ flt_need_heap_2({set,_,_,{put_tuple,_}}, H, Fl) -> {[],H+1,Fl}; flt_need_heap_2({set,_,_,put}, H, Fl) -> {[],H+1,Fl}; -%% Then the "neutral" instructions. We just pass them. -flt_need_heap_2({set,[{fr,_}],_,_}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,[],[],fclearerror}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,[],[],fcheckerror}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,{bif,_,_}}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,move}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,{get_tuple_element,_}}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,get_list}, H, Fl) -> - {[],H,Fl}; -flt_need_heap_2({set,_,_,{try_catch,_,_}}, H, Fl) -> - {[],H,Fl}; -%% All other instructions should cause the insertion of an allocation +%% The following instructions cause the insertion of an allocation %% instruction if needed. +flt_need_heap_2({set,_,_,{alloc,_,_}}, H, Fl) -> + {flt_alloc(H, Fl),0,0}; +flt_need_heap_2({set,_,_,{set_tuple_element,_}}, H, Fl) -> + {flt_alloc(H, Fl),0,0}; +flt_need_heap_2({'%anno',_}, H, Fl) -> + {flt_alloc(H, Fl),0,0}; +%% All other instructions are "neutral". We just pass them. flt_need_heap_2(_, H, Fl) -> - {flt_alloc(H, Fl),0,0}. + {[],H,Fl}. flt_alloc(0, 0) -> []; @@ -376,7 +382,7 @@ build_alloc(Words, Floats) -> {alloc,[{words,Words},{floats,Floats}]}. %% is not continous at an allocation function (e.g. if {x,0} and {x,2} %% are live, but not {x,1}). -flt_liveness([{'%live',_Live,Regs}=LiveInstr|Is]) -> +flt_liveness([{'%anno',{used,Regs}}=LiveInstr|Is]) -> flt_liveness_1(Is, Regs, [LiveInstr]). flt_liveness_1([{set,Ds,Ss,{alloc,Live0,Alloc}}|Is], Regs0, Acc) -> @@ -388,7 +394,7 @@ flt_liveness_1([{set,Ds,Ss,{alloc,Live0,Alloc}}|Is], Regs0, Acc) -> flt_liveness_1([{set,Ds,_,_}=I|Is], Regs0, Acc) -> Regs = x_live(Ds, Regs0), flt_liveness_1(Is, Regs, [I|Acc]); -flt_liveness_1([{'%live',_,_}], _Regs, Acc) -> +flt_liveness_1([{'%anno',_}], _Regs, Acc) -> reverse(Acc). init_regs(Live) -> @@ -412,13 +418,14 @@ x_live([], Regs) -> Regs. %% Update the type database to account for executing an instruction. %% %% First the cases for instructions inside basic blocks. -update({'%live',_,_}, Ts) -> Ts; +update({'%anno',_}, Ts) -> + Ts; update({set,[D],[S],move}, Ts) -> tdb_copy(S, D, Ts); update({set,[D],[{integer,I},Reg],{bif,element,_}}, Ts0) -> - tdb_update([{Reg,{tuple,I,[]}},{D,kill}], Ts0); + tdb_update([{Reg,{tuple,min_size,I,[]}},{D,kill}], Ts0); update({set,[D],[_Index,Reg],{bif,element,_}}, Ts0) -> - tdb_update([{Reg,{tuple,0,[]}},{D,kill}], Ts0); + tdb_update([{Reg,{tuple,min_size,0,[]}},{D,kill}], Ts0); update({set,[D],Args,{bif,N,_}}, Ts0) -> Ar = length(Args), BoolOp = erl_internal:new_type_test(N, Ar) orelse @@ -476,7 +483,7 @@ update({kill,D}, Ts) -> update({test,is_float,_Fail,[Src]}, Ts0) -> tdb_update([{Src,float}], Ts0); update({test,test_arity,_Fail,[Src,Arity]}, Ts0) -> - tdb_update([{Src,{tuple,Arity,[]}}], Ts0); + tdb_update([{Src,{tuple,exact_size,Arity,[]}}], Ts0); update({test,is_map,_Fail,[Src]}, Ts0) -> tdb_update([{Src,map}], Ts0); update({get_map_elements,_,Src,{list,Elems0}}, Ts0) -> @@ -490,12 +497,12 @@ update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) -> error -> Ts; {tuple_element,TupleReg,0} -> - tdb_update([{TupleReg,{tuple,1,[Atom]}}], Ts); + tdb_update([{TupleReg,{tuple,min_size,1,[Atom]}}], Ts); _ -> Ts end; update({test,is_record,_Fail,[Src,Tag,{integer,Arity}]}, Ts) -> - tdb_update([{Src,{tuple,Arity,[Tag]}}], Ts); + tdb_update([{Src,{tuple,exact_size,Arity,[Tag]}}], Ts); %% Binary matching @@ -537,7 +544,7 @@ update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) -> update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> Ts = tdb_kill_xregs(Ts0), case tdb_find({x,1}, Ts0) of - {tuple,Sz,_}=T0 -> + {tuple,SzKind,Sz,_}=T0 -> T = case tdb_find({x,0}, Ts0) of {integer,{I,I}} when I > 1 -> %% First element is not changed. The result @@ -546,7 +553,7 @@ update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> _ -> %% Position is 1 or unknown. May change the %% first element of the tuple. - {tuple,Sz,[]} + {tuple,SzKind,Sz,[]} end, tdb_update([{{x,0},T}], Ts); _ -> @@ -630,7 +637,7 @@ possibly_numeric(_) -> false. max_tuple_size(Reg, Ts) -> case tdb_find(Reg, Ts) of - {tuple,Sz,_} -> Sz; + {tuple,_,Sz,_} -> Sz; _Other -> 0 end. @@ -786,11 +793,12 @@ checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. %%% Routines for maintaining a type database. The type database %%% associates type information with registers. %%% -%%% {tuple,Size,First} means that the corresponding register contains a -%%% tuple with *at least* Size elements. An tuple with unknown -%%% size is represented as {tuple,0,[]}. First is either [] (meaning that -%%% the tuple's first element is unknown) or [FirstElement] (the contents -%%% of the first element). +%%% {tuple,min_size,Size,First} means that the corresponding register contains +%%% a tuple with *at least* Size elements (conversely, exact_size means that it +%%% contains a tuple with *exactly* Size elements). An tuple with unknown size +%%% is represented as {tuple,min_size,0,[]}. First is either [] (meaning that +%%% the tuple's first element is unknown) or [FirstElement] (the contents of +%%% the first element). %%% %%% 'float' means that the register contains a float. %%% @@ -834,7 +842,7 @@ tdb_copy(Literal, D, Ts) -> {literal,#{}} -> map; {literal,Tuple} when tuple_size(Tuple) >= 1 -> Lit = tag_literal(element(1, Tuple)), - {tuple,tuple_size(Tuple),[Lit]}; + {tuple,exact_size,tuple_size(Tuple),[Lit]}; _ -> term end, if @@ -856,14 +864,14 @@ tag_literal(Lit) -> {literal,Lit}. %% Updates a type database. If a 'kill' operation is given, the type %% information for that register will be removed from the database. %% A kill operation takes precedence over other operations for the same -%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5,[]}}] means that the +%% register (i.e. [{{x,0},kill},{{x,0},{tuple,min_size,5,[]}}] means that the %% the existing type information, if any, will be discarded, and the -%% the '{tuple,5,[]}' information ignored. +%% the '{tuple,min_size,5,[]}' information ignored. %% %% If NewInfo information is given and there exists information about %% the register, the old and new type information will be merged. -%% For instance, {tuple,5,_} and {tuple,10,_} will be merged to produce -%% {tuple,10,_}. +%% For instance, {tuple,min_size,5,_} and {tuple,min_size,10,_} will be merged +%% to produce {tuple,min_size,10,_}. tdb_update(Uis0, Ts0) -> Uis1 = filter(fun ({{x,_},_Op}) -> true; @@ -901,16 +909,20 @@ tdb_kill_xregs([]) -> []. remove_key(Key, [{Key,_Op}|Ops]) -> remove_key(Key, Ops); remove_key(_, Ops) -> Ops. - + merge_type_info(I, I) -> I; -merge_type_info({tuple,Sz1,Same}, {tuple,Sz2,Same}=Max) when Sz1 < Sz2 -> +merge_type_info({tuple,min_size,Sz1,Same}, {tuple,min_size,Sz2,Same}=Max) when Sz1 < Sz2 -> Max; -merge_type_info({tuple,Sz1,Same}=Max, {tuple,Sz2,Same}) when Sz1 > Sz2 -> +merge_type_info({tuple,min_size,Sz1,Same}=Max, {tuple,min_size,Sz2,Same}) when Sz1 > Sz2 -> Max; -merge_type_info({tuple,Sz1,[]}, {tuple,_Sz2,First}=Tuple2) -> - merge_type_info({tuple,Sz1,First}, Tuple2); -merge_type_info({tuple,_Sz1,First}=Tuple1, {tuple,Sz2,_}) -> - merge_type_info(Tuple1, {tuple,Sz2,First}); +merge_type_info({tuple,exact_size,_,Same}=Exact, {tuple,_,_,Same}) -> + Exact; +merge_type_info({tuple,_,_,Same},{tuple,exact_size,_,Same}=Exact) -> + Exact; +merge_type_info({tuple,SzKind1,Sz1,[]}, {tuple,_SzKind2,_Sz2,First}=Tuple2) -> + merge_type_info({tuple,SzKind1,Sz1,First}, Tuple2); +merge_type_info({tuple,_SzKind1,_Sz1,First}=Tuple1, {tuple,SzKind2,Sz2,_}) -> + merge_type_info(Tuple1, {tuple,SzKind2,Sz2,First}); merge_type_info(integer, {integer,_}=Int) -> Int; merge_type_info({integer,_}=Int, integer) -> @@ -928,7 +940,7 @@ verify_type({integer,{Min,Max}}) when is_integer(Min), is_integer(Max) -> ok; verify_type(map) -> ok; verify_type(nonempty_list) -> ok; -verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok; -verify_type({tuple,Sz,[_]}) when is_integer(Sz) -> ok; +verify_type({tuple,_,Sz,[]}) when is_integer(Sz) -> ok; +verify_type({tuple,_,Sz,[_]}) when is_integer(Sz) -> ok; verify_type({tuple_element,_,_}) -> ok; verify_type(float) -> ok. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 60221578bd..5333925589 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -25,7 +25,7 @@ is_not_used/3,usage/3, empty_label_index/0,index_label/3,index_labels/1,replace_labels/4, code_at/2,bif_to_test/3,is_pure_test/1, - live_opt/1,delete_live_annos/1,combine_heap_needs/2, + live_opt/1,delete_annos/1,combine_heap_needs/2, anno_defs/1, split_even/1 ]). @@ -95,7 +95,7 @@ is_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) -> X >= Live; is_killed_block(R, [{set,Ds,Ss,_Op}|Is]) -> not member(R, Ss) andalso (member(R, Ds) orelse is_killed_block(R, Is)); -is_killed_block(R, [{'%live',_,Regs}|Is]) -> +is_killed_block(R, [{'%anno',{used,Regs}}|Is]) -> case R of {x,X} when (Regs bsr X) band 1 =:= 0 -> true; _ -> is_killed_block(R, Is) @@ -118,6 +118,7 @@ is_killed(R, Is, D) -> St = #live{lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of {killed,_} -> true; + {exit_not_used,_} -> true; {_,_} -> false end. @@ -130,6 +131,7 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) -> St0 = #live{lbl=D,res=gb_trees:empty()}, case check_liveness_at(R, Lbl, St0) of {killed,_} -> true; + {exit_not_used,_} -> true; {_,_} -> false end. @@ -146,6 +148,7 @@ is_not_used(R, Is, D) -> St = #live{lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of {used,_} -> false; + {exit_not_used,_} -> false; {_,_} -> true end. @@ -267,7 +270,7 @@ is_pure_test({test,Op,_,Ops}) -> %% Go through the instruction sequence in reverse execution %% order, keep track of liveness and remove 'move' instructions %% whose destination is a register that will not be used. -%% Also insert {'%live',Live,Regs} annotations at the beginning +%% Also insert {used,Regs} annotations at the beginning %% and end of each block. -spec live_opt([instruction()]) -> [instruction()]. @@ -282,22 +285,22 @@ live_opt(Is0) -> Bef ++ [Fi|live_opt(reverse(Is), 0, D, [])]. -%% delete_live_annos([Instruction]) -> [Instruction]. -%% Delete all live annotations. +%% delete_annos([Instruction]) -> [Instruction]. +%% Delete all annotations. --spec delete_live_annos([instruction()]) -> [instruction()]. +-spec delete_annos([instruction()]) -> [instruction()]. -delete_live_annos([{block,Bl0}|Is]) -> - case delete_live_annos(Bl0) of - [] -> delete_live_annos(Is); - [_|_]=Bl -> [{block,Bl}|delete_live_annos(Is)] +delete_annos([{block,Bl0}|Is]) -> + case delete_annos(Bl0) of + [] -> delete_annos(Is); + [_|_]=Bl -> [{block,Bl}|delete_annos(Is)] end; -delete_live_annos([{'%live',_,_}|Is]) -> - delete_live_annos(Is); -delete_live_annos([I|Is]) -> - [I|delete_live_annos(Is)]; -delete_live_annos([]) -> []. - +delete_annos([{'%anno',_}|Is]) -> + delete_annos(Is); +delete_annos([I|Is]) -> + [I|delete_annos(Is)]; +delete_annos([]) -> []. + %% combine_heap_needs(HeapNeed1, HeapNeed2) -> HeapNeed %% Combine the heap need for two allocation instructions. @@ -309,11 +312,11 @@ delete_live_annos([]) -> []. combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) -> H1 + H2; combine_heap_needs(H1, H2) -> - combine_alloc_lists([H1,H2]). + {alloc,combine_alloc_lists([H1,H2])}. %% anno_defs(Instructions) -> Instructions' -%% Add {'%def',RegisterBitmap} annotations to the beginning of +%% Add {def,RegisterBitmap} annotations to the beginning of %% each block. Iff bit X is set in the the bitmap, it means %% that {x,X} is defined when the block is entered. @@ -347,6 +350,9 @@ split_even(Rs) -> split_even(Rs, [], []). %% %% killed - Reg is assigned or killed by an allocation instruction. %% not_used - the value of Reg is not used, but Reg must not be garbage +%% exit_not_used - the value of Reg is not used, but must not be garbage +%% because the stack will be scanned because an +%% exit BIF will raise an exception %% used - Reg is used check_liveness(R, [{block,Blk}|Is], St0) -> @@ -370,6 +376,8 @@ check_liveness(R, [{test,_,{f,Fail},As}|Is], St0) -> case check_liveness_at(R, Fail, St0) of {killed,St1} -> check_liveness(R, Is, St1); + {exit_not_used,St1} -> + check_liveness(R, Is, St1); {not_used,St1} -> not_used(check_liveness(R, Is, St1)); {used,_}=Used -> @@ -389,6 +397,8 @@ check_liveness(R, [{jump,{f,F}}|_], St) -> check_liveness_at(R, F, St); check_liveness(R, [{case_end,Used}|_], St) -> check_liveness_ret(R, Used, St); +check_liveness(R, [{try_case_end,Used}|_], St) -> + check_liveness_ret(R, Used, St); check_liveness(R, [{badmatch,Used}|_], St) -> check_liveness_ret(R, Used, St); check_liveness(_, [if_end|_], St) -> @@ -432,7 +442,7 @@ check_liveness(R, [{bs_init,_,_,Live,Ss,Dst}|Is], St) -> false -> if R =:= Dst -> {killed,St}; - true -> check_liveness(R, Is, St) + true -> not_used(check_liveness(R, Is, St)) end end end; @@ -466,7 +476,7 @@ check_liveness(R, [{call_ext,Live,_}=I|Is], St) -> %% We must make sure we don't check beyond this %% instruction or we will fall through into random %% unrelated code and get stuck in a loop. - {killed,St} + {exit_not_used,St} end end; check_liveness(R, [{call_fun,Live}|Is], St) -> @@ -514,16 +524,12 @@ check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) -> {x,_} -> {killed,St}; {y,_} -> not_used(check_liveness(R, Is, St)) end; -check_liveness({x,_}=R, [{'catch',_,_}|Is], St) -> - %% All x registers will be killed if an exception occurs. - %% Therefore we only need to check the liveness for the - %% instructions following the catch instruction. - check_liveness(R, Is, St); -check_liveness({x,_}=R, [{'try',_,_}|Is], St) -> - %% All x registers will be killed if an exception occurs. - %% Therefore we only need to check the liveness for the - %% instructions inside the 'try' block. - check_liveness(R, Is, St); +check_liveness(R, [{'catch'=Op,Y,Fail}|Is], St) -> + Set = {set,[Y],[],{try_catch,Op,Fail}}, + check_liveness(R, [{block,[Set]}|Is], St); +check_liveness(R, [{'try'=Op,Y,Fail}|Is], St) -> + Set = {set,[Y],[],{try_catch,Op,Fail}}, + check_liveness(R, [{block,[Set]}|Is], St); check_liveness(R, [{try_end,Y}|Is], St) -> case R of Y -> @@ -584,6 +590,12 @@ check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> check_liveness(R, [{put_map,F,Op,S,D,Live,{list,Puts}}|Is], St) -> Set = {set,[D],[S|Puts],{alloc,Live,{put_map,Op,F}}}, check_liveness(R, [{block,[Set]}||Is], St); +check_liveness(R, [{put_tuple,Ar,D}|Is], St) -> + Set = {set,[D],[],{put_tuple,Ar}}, + check_liveness(R, [{block,[Set]}||Is], St); +check_liveness(R, [{put_list,S1,S2,D}|Is], St) -> + Set = {set,[D],[S1,S2],put_list}, + check_liveness(R, [{block,[Set]}||Is], St); check_liveness(R, [{test_heap,N,Live}|Is], St) -> I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]}, check_liveness(R, [I|Is], St); @@ -597,6 +609,12 @@ check_liveness(R, [remove_message|Is], St) -> check_liveness(R, Is, St); check_liveness({x,X}, [build_stacktrace|_], St) when X > 0 -> {killed,St}; +check_liveness(R, [{recv_mark,_}|Is], St) -> + check_liveness(R, Is, St); +check_liveness(R, [{recv_set,_}|Is], St) -> + check_liveness(R, Is, St); +check_liveness(R, [{'%',_}|Is], St) -> + check_liveness(R, Is, St); check_liveness(_R, Is, St) when is_list(Is) -> %% Not implemented. Conservatively assume that the register is used. {used,St}. @@ -631,6 +649,7 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) -> {Res,St#live{res=gb_trees:insert(Lbl, Res, St#live.res)}} end. +not_used({exit_not_used,St}) -> {not_used,St}; not_used({killed,St}) -> {not_used,St}; not_used({_,_}=Res) -> Res. @@ -649,7 +668,7 @@ check_liveness_ret(_, _, St) -> {killed,St}. %% alloc_used - Used only in an allocate instruction %% used - Reg is explicitly used by an instruction %% -%% '%live' annotations are not allowed. +%% Annotations are not allowed. %% %% (Unknown instructions will cause an exception.) @@ -659,13 +678,30 @@ check_liveness_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St0) -> {killed,St0}; true -> case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of - {killed,St} -> {not_used,St}; {transparent,St} -> {alloc_used,St}; - {_,_}=Res -> Res + {_,_}=Res -> not_used(Res) end end; -check_liveness_block({y,_}=R, [{set,Ds,Ss,{alloc,_Live,Op}}|Is], St) -> - check_liveness_block_1(R, Ss, Ds, Op, Is, St); +check_liveness_block({y,_}=R, [{set,Ds,Ss,{alloc,_Live,Op}}|Is], St0) -> + case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of + {transparent,St} -> {alloc_used,St}; + {_,_}=Res -> not_used(Res) + end; +check_liveness_block({y,_}=R, [{set,Ds,Ss,{try_catch,_,Op}}|Is], St0) -> + case Ds of + [R] -> + {killed,St0}; + _ -> + case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of + {exit_not_used,St} -> + {used,St}; + {transparent,St} -> + %% Conservatively assumed that it is used. + {used,St}; + {_,_}=Res -> + Res + end + end; check_liveness_block(R, [{set,Ds,Ss,Op}|Is], St) -> check_liveness_block_1(R, Ss, Ds, Op, Is, St); check_liveness_block(_, [], St) -> {transparent,St}. @@ -681,6 +717,11 @@ check_liveness_block_1(R, Ss, Ds, Op, Is, St0) -> true -> {killed,St}; false -> check_liveness_block(R, Is, St) end; + {exit_not_used,St} -> + case member(R, Ds) of + true -> {exit_not_used,St}; + false -> check_liveness_block(R, Is, St) + end; {not_used,St} -> not_used(case member(R, Ds) of true -> {killed,St}; @@ -824,12 +865,14 @@ live_opt([{test,bs_start_match2,Fail,Live,[Src,_],_}=I|Is], _, D, Acc) -> %% Other instructions. live_opt([{block,Bl0}|Is], Regs0, D, Acc) -> - Live0 = {'%live',live_regs(Regs0),Regs0}, + Live0 = make_anno({used,Regs0}), {Bl,Regs} = live_opt_block(reverse(Bl0), Regs0, D, [Live0]), - Live = {'%live',live_regs(Regs),Regs}, + Live = make_anno({used,Regs}), live_opt(Is, Regs, D, [{block,[Live|Bl]}|Acc]); live_opt([build_stacktrace=I|Is], _, D, Acc) -> live_opt(Is, live_call(1), D, [I|Acc]); +live_opt([raw_raise=I|Is], _, D, Acc) -> + live_opt(Is, live_call(3), D, [I|Acc]); live_opt([{label,L}=I|Is], Regs, D0, Acc) -> D = gb_trees:insert(L, Regs, D0), live_opt(Is, Regs, D, [I|Acc]); @@ -871,7 +914,8 @@ live_opt([{test,_,Fail,Live,Ss,_}=I|Is], _, D, Acc) -> Regs1 = x_live(Ss, Regs0), Regs = live_join_label(Fail, D, Regs1), live_opt(Is, Regs, D, [I|Acc]); -live_opt([{select,_,Src,Fail,List}=I|Is], Regs0, D, Acc) -> +live_opt([{select,_,Src,Fail,List}=I|Is], _, D, Acc) -> + Regs0 = 0, Regs1 = x_live([Src], Regs0), Regs = live_join_labels([Fail|List], D, Regs1), live_opt(Is, Regs, D, [I|Acc]); @@ -894,6 +938,25 @@ live_opt([{get_map_elements,Fail,Src,{list,List}}=I|Is], Regs0, D, Acc) -> Regs1 = x_live([Src|Ss], x_dead(Ds, Regs0)), Regs = live_join_label(Fail, D, Regs1), live_opt(Is, Regs, D, [I|Acc]); +live_opt([{gc_bif,N,F,R,As,Dst}=I|Is], Regs0, D, Acc) -> + Bl = [{set,[Dst],As,{alloc,R,{gc_bif,N,F}}}], + {_,Regs} = live_opt_block(Bl, Regs0, D, []), + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{bif,N,F,As,Dst}=I|Is], Regs0, D, Acc) -> + Bl = [{set,[Dst],As,{bif,N,F}}], + {_,Regs} = live_opt_block(Bl, Regs0, D, []), + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{get_tuple_element,Src,Idx,Dst}=I|Is], Regs0, D, Acc) -> + Bl = [{set,[Dst],[Src],{get_tuple_element,Idx}}], + {_,Regs} = live_opt_block(Bl, Regs0, D, []), + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{move,Src,Dst}=I|Is], Regs0, D, Acc) -> + Regs = x_live([Src], x_dead([Dst], Regs0)), + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{put_map,F,Op,S,Dst,R,{list,Puts}}=I|Is], Regs0, D, Acc) -> + Bl = [{set,[Dst],[S|Puts],{alloc,R,{put_map,Op,F}}}], + {_,Regs} = live_opt_block(Bl, Regs0, D, []), + live_opt(Is, Regs, D, [I|Acc]); %% Transparent instructions - they neither use nor modify x registers. live_opt([{deallocate,_}=I|Is], Regs, D, Acc) -> @@ -910,6 +973,10 @@ live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{line,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); +live_opt([{'catch',_,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{'try',_,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); %% The following instructions can occur if the "compilation" has been %% started from a .S file using the 'from_asm' option. @@ -940,7 +1007,7 @@ live_opt_block([{set,Ds,Ss,Op0}|Is], Regs0, D, Acc) -> _ -> live_opt_block(Is, Regs, D, [I|Acc]) end; -live_opt_block([{'%live',_,_}|Is], Regs, D, Acc) -> +live_opt_block([{'%anno',_}|Is], Regs, D, Acc) -> live_opt_block(Is, Regs, D, Acc); live_opt_block([], Regs, _, Acc) -> {Acc,Regs}. @@ -1015,7 +1082,7 @@ defs([{bif,_,{f,Fail},_Src,Dst}=I|Is], Regs0, D) -> [I|defs(Is, Regs, update_regs(Fail, Regs0, D))]; defs([{block,Block0}|Is], Regs0, D0) -> {Block,Regs,D} = defs_list(Block0, Regs0, D0), - [{block,[{'%def',Regs0}|Block]}|defs(Is, Regs, D)]; + [{block,[make_anno({def,Regs0})|Block]}|defs(Is, Regs, D)]; defs([{bs_init,{f,L},_,_,_,Dst}=I|Is], Regs0, D) -> Regs = def_regs([Dst], Regs0), [I|defs(Is, Regs, update_regs(L, Regs, D))]; @@ -1077,6 +1144,8 @@ defs([{move,_,Dst}=I|Is], Regs0, D) -> defs([{put_map,{f,Fail},_,_,Dst,_,_}=I|Is], Regs0, D) -> Regs = def_regs([Dst], Regs0), [I|defs(Is, Regs, update_regs(Fail, Regs0, D))]; +defs([raw_raise=I|Is], _Regs, D) -> + [I|defs(Is, 1, D)]; defs([return=I|Is], _Regs, D) -> [I|defs_unreachable(Is, D)]; defs([{select,_,_Src,Fail,List}=I|Is], Regs, D0) -> @@ -1205,3 +1274,13 @@ update_regs(L, Regs0, D) -> all_defined(Live, Regs) -> All = (1 bsl Live) - 1, Regs band All =:= All. + +%%% +%%% Utilities. +%%% + +%% make_anno(Anno) -> WrappedAnno. +%% Wrap an annotation term. + +make_anno(Anno) -> + {'%anno',Anno}. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 2ad9747940..22ceef097c 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -524,15 +524,18 @@ valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) -> validate_src(Src, Vst), kill_state(Vst); +valfun_4(raw_raise=I, Vst) -> + call(I, 3, Vst); valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) -> validate_src(Src, Vst0), Vst = branch_state(Fail, Vst0), Type = bif_type(Op, Src, Vst), set_type_reg(Type, Dst, Vst); valfun_4({gc_bif,Op,{f,Fail},Live,Src,Dst}, #vst{current=St0}=Vst0) -> + verify_live(Live, Vst0), + verify_y_init(Vst0), St = kill_heap_allocation(St0), Vst1 = Vst0#vst{current=St}, - verify_live(Live, Vst1), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), validate_src(Src, Vst), @@ -686,6 +689,7 @@ valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), + verify_y_init(Vst0), if is_integer(Sz) -> ok; @@ -698,6 +702,7 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> set_type_reg(binary, Dst, Vst); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), + verify_y_init(Vst0), if is_integer(Sz) -> ok; @@ -710,6 +715,7 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> set_type_reg(binary, Dst, Vst); valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), + verify_y_init(Vst0), assert_term(Bits, Vst0), assert_term(Bin, Vst0), Vst1 = heap_alloc(Heap, Vst0), @@ -945,6 +951,7 @@ deallocate(#vst{current=St}=Vst) -> test_heap(Heap, Live, Vst0) -> verify_live(Live, Vst0), + verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), heap_alloc(Heap, Vst). diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 770aa2c6c1..1409c358c2 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -775,6 +775,8 @@ asm_passes() -> {iff,drecv,{listing,"recv"}}, {unless,no_record_opt,{pass,beam_record}}, {iff,drecord,{listing,"record"}}, + {unless,no_blk2,?pass(block2)}, + {iff,dblk2,{listing,"block2"}}, {unless,no_stack_trimming,{pass,beam_trim}}, {iff,dtrim,{listing,"trim"}}, {pass,beam_flatten}]}, @@ -1350,6 +1352,10 @@ v3_kernel(Code0, #compile{options=Opts,warnings=Ws0}=St) -> {ok,Code,St} end. +block2(Code0, #compile{options=Opts}=St) -> + {ok,Code} = beam_block:module(Code0, [no_blockify|Opts]), + {ok,Code,St}. + test_old_inliner(#compile{options=Opts}) -> %% The point of this test is to avoid loading the old inliner %% if we know that it will not be used. diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 397e478e1e..d59bb241a8 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -554,3 +554,13 @@ BEAM_FORMAT_NUMBER=0 ## Do a garbage collection if necessary to allocate space on the heap ## for the result. 160: build_stacktrace/0 + +## @spec raw_raise +## @doc This instruction works like the erlang:raise/3 BIF, except that the +## stacktrace in x(2) must be a raw stacktrace. +## x(0) is the class of the exception (error, exit, or throw), +## x(1) is the exception term, and x(2) is the raw stackframe. +## If x(0) is not a valid class, the instruction will not throw an +## exception, but store the atom 'badarg' in x(0) and execute the +## next instruction. +161: raw_raise/0 diff --git a/lib/compiler/src/sys_core_bsm.erl b/lib/compiler/src/sys_core_bsm.erl index 37e071fafa..65580f79e3 100644 --- a/lib/compiler/src/sys_core_bsm.erl +++ b/lib/compiler/src/sys_core_bsm.erl @@ -24,7 +24,7 @@ -export([module/2,format_error/1]). -include("core_parse.hrl"). --import(lists, [member/2,nth/2,reverse/1,usort/1]). +-import(lists, [member/2,reverse/1,usort/1]). -spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module()}. @@ -59,13 +59,6 @@ format_error(bin_opt_alias) -> format_error(bin_partition) -> "INFO: matching non-variables after a previous clause matching a variable " "will prevent delayed sub binary optimization"; -format_error(bin_left_var_used_in_guard) -> - "INFO: a variable to the left of the binary pattern is used in a guard; " - "will prevent delayed sub binary optimization"; -format_error(bin_argument_order) -> - "INFO: matching anything else but a plain variable to the left of " - "binary pattern will prevent delayed sub binary optimization; " - "SUGGEST changing argument order"; format_error(bin_var_used) -> "INFO: using a matched out sub binary will prevent " "delayed sub binary optimization"; @@ -96,46 +89,41 @@ bsm_an(#c_case{arg=#c_values{es=Es}}=Case) -> bsm_an(Other) -> {ok,Other}. -bsm_an_1(Vs, #c_case{clauses=Cs}=Case) -> - case bsm_leftmost(Cs) of - none -> {ok,Case}; - Pos -> bsm_an_2(Vs, Cs, Case, Pos) - end. - -bsm_an_2(Vs, Cs, Case, Pos) -> - case bsm_nonempty(Cs, Pos) of - true -> bsm_an_3(Vs, Cs, Case, Pos); - false -> {ok,Case} +bsm_an_1(Vs0, #c_case{clauses=Cs0}=Case) -> + case bsm_leftmost(Cs0) of + none -> + {ok,Case}; + 1 -> + bsm_an_2(Vs0, Cs0, Case); + Pos -> + Vs = move_from_col(Pos, Vs0), + Cs = [C#c_clause{pats=move_from_col(Pos, Ps)} || + #c_clause{pats=Ps}=C <- Cs0], + bsm_an_2(Vs, Cs, Case) end. -bsm_an_3(Vs, Cs, Case, Pos) -> +bsm_an_2(Vs, Cs, Case) -> try - bsm_ensure_no_partition(Cs, Pos), - {ok,bsm_do_an(Vs, Pos, Cs, Case)} + bsm_ensure_no_partition(Cs), + {ok,bsm_do_an(Vs, Cs, Case)} catch - throw:{problem,Where,What} -> - {ok,Case,{Where,What}} + throw:{problem,Where,What} -> + {ok,Case,{Where,What}} end. -bsm_do_an(Vs0, Pos, Cs0, Case) -> - case nth(Pos, Vs0) of - #c_var{name=Vname}=V0 -> - Cs = bsm_do_an_var(Vname, Pos, Cs0, []), - V = bsm_annotate_for_reuse(V0), - Bef = lists:sublist(Vs0, Pos-1), - Aft = lists:nthtail(Pos, Vs0), - case Bef ++ [V|Aft] of - [_] -> - Case#c_case{arg=V,clauses=Cs}; - Vs -> - Case#c_case{arg=#c_values{es=Vs},clauses=Cs} - end; - _ -> - Case - end. +move_from_col(Pos, L) -> + {First,[Col|Rest]} = lists:split(Pos - 1, L), + [Col|First] ++ Rest. -bsm_do_an_var(V, S, [#c_clause{pats=Ps,guard=G,body=B0}=C0|Cs], Acc) -> - case nth(S, Ps) of +bsm_do_an([#c_var{name=Vname}=V0|Vs0], Cs0, Case) -> + Cs = bsm_do_an_var(Vname, Cs0), + V = bsm_annotate_for_reuse(V0), + Vs = core_lib:make_values([V|Vs0]), + Case#c_case{arg=Vs,clauses=Cs}; +bsm_do_an(_Vs, _Cs, Case) -> Case. + +bsm_do_an_var(V, [#c_clause{pats=[P|_],guard=G,body=B0}=C0|Cs]) -> + case P of #c_var{name=VarName} -> case core_lib:is_var_used(V, G) of true -> bsm_problem(C0, orig_bin_var_used_in_guard); @@ -148,23 +136,23 @@ bsm_do_an_var(V, S, [#c_clause{pats=Ps,guard=G,body=B0}=C0|Cs], Acc) -> B1 = bsm_maybe_ctx_to_binary(VarName, B0), B = bsm_maybe_ctx_to_binary(V, B1), C = C0#c_clause{body=B}, - bsm_do_an_var(V, S, Cs, [C|Acc]); - #c_alias{}=P -> + [C|bsm_do_an_var(V, Cs)]; + #c_alias{} -> case bsm_could_match_binary(P) of false -> - bsm_do_an_var(V, S, Cs, [C0|Acc]); + [C0|bsm_do_an_var(V, Cs)]; true -> bsm_problem(C0, bin_opt_alias) end; - P -> + _ -> case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of false -> - bsm_do_an_var(V, S, Cs, [C0|Acc]); + [C0|bsm_do_an_var(V, Cs)]; true -> bsm_problem(C0, bin_var_used) end end; -bsm_do_an_var(_, _, [], Acc) -> reverse(Acc). +bsm_do_an_var(_, []) -> []. bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) -> Var#c_var{anno=[reuse_for_context|Anno]}. @@ -192,131 +180,82 @@ previous_ctx_to_binary(V, Core) -> end. %% bsm_leftmost(Cs) -> none | ArgumentNumber -%% Find the leftmost argument that does binary matching. Return -%% the number of the argument (1-N). +%% Find the leftmost argument that matches a nonempty binary. +%% Return either 'none' or the argument number (1-N). bsm_leftmost(Cs) -> bsm_leftmost_1(Cs, none). +bsm_leftmost_1([_|_], 1) -> + 1; bsm_leftmost_1([#c_clause{pats=Ps}|Cs], Pos) -> bsm_leftmost_2(Ps, Cs, 1, Pos); bsm_leftmost_1([], Pos) -> Pos. bsm_leftmost_2(_, Cs, Pos, Pos) -> bsm_leftmost_1(Cs, Pos); -bsm_leftmost_2([#c_binary{}|_], Cs, N, _) -> +bsm_leftmost_2([#c_binary{segments=[_|_]}|_], Cs, N, _) -> bsm_leftmost_1(Cs, N); bsm_leftmost_2([_|Ps], Cs, N, Pos) -> bsm_leftmost_2(Ps, Cs, N+1, Pos); bsm_leftmost_2([], Cs, _, Pos) -> bsm_leftmost_1(Cs, Pos). -%% bsm_nonempty(Cs, Pos) -> true|false -%% Check if at least one of the clauses matches a non-empty -%% binary in the given argument position. +%% bsm_ensure_no_partition(Cs) -> ok (exception if problem) +%% There must only be a single bs_start_match2 instruction if we +%% are to reuse the binary variable for the match context. +%% +%% To make sure that there is only a single bs_start_match2 +%% instruction, we will check for partitions such as: %% -bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) -> - case nth(Pos, Ps) of - #c_binary{segments=[_|_]} -> - true; - _ -> - bsm_nonempty(Cs, Pos) - end; -bsm_nonempty([], _ ) -> false. - -%% bsm_ensure_no_partition(Cs, Pos) -> ok (exception if problem) -%% We must make sure that matching is not partitioned between -%% variables like this: %% foo(<<...>>) -> ... %% foo(<Variable>) when ... -> ... -%% foo(<Any non-variable pattern>) -> -%% If there is such partition, we are not allowed to reuse the binary variable -%% for the match context. +%% foo(<Non-variable pattern>) -> %% -%% Also, arguments to the left of the argument that is matched -%% against a binary, are only allowed to be simple variables, not -%% used in guards. The reason is that we must know that the binary is -%% only matched in one place (i.e. there must be only one bs_start_match2 -%% instruction emitted). +%% If there is such partition, we reject the optimization. -bsm_ensure_no_partition(Cs, Pos) -> - bsm_ensure_no_partition_1(Cs, Pos, before). +bsm_ensure_no_partition(Cs) -> + bsm_ensure_no_partition_1(Cs, before). %% Loop through each clause. -bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], Pos, State0) -> - State = bsm_ensure_no_partition_2(Ps, Pos, G, simple_vars, State0), +bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], State0) -> + State = bsm_ensure_no_partition_2(Ps, G, State0), case State of 'after' -> - bsm_ensure_no_partition_after(Cs, Pos); + bsm_ensure_no_partition_after(Cs); _ -> ok end, - bsm_ensure_no_partition_1(Cs, Pos, State); -bsm_ensure_no_partition_1([], _, _) -> ok. + bsm_ensure_no_partition_1(Cs, State); +bsm_ensure_no_partition_1([], _) -> ok. -%% Loop through each pattern for this clause. -bsm_ensure_no_partition_2([#c_binary{}=Where|_], 1, _, Vstate, State) -> - case State of - before when Vstate =:= simple_vars -> within; - before -> bsm_problem(Where, Vstate); - within when Vstate =:= simple_vars -> within; - within -> bsm_problem(Where, Vstate) - end; -bsm_ensure_no_partition_2([#c_alias{}=Alias|_], 1, N, Vstate, State) -> +bsm_ensure_no_partition_2([#c_binary{}|_], _, _State) -> + within; +bsm_ensure_no_partition_2([#c_alias{}=Alias|_], N, State) -> %% Retrieve the real pattern that the alias refers to and check that. P = bsm_real_pattern(Alias), - bsm_ensure_no_partition_2([P], 1, N, Vstate, State); -bsm_ensure_no_partition_2([_|_], 1, _, _Vstate, before=State) -> + bsm_ensure_no_partition_2([P], N, State); +bsm_ensure_no_partition_2([_|_], _, before=State) -> %% No binary matching yet - therefore no partition. State; -bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) -> +bsm_ensure_no_partition_2([P|_], _, State) -> case bsm_could_match_binary(P) of false -> - %% If clauses can be freely arranged (Vstate =:= simple_vars), - %% a clause that cannot match a binary will not partition the clause. - %% Example: - %% - %% a(Var, <<>>) -> ... - %% a(Var, []) -> ... - %% a(Var, <<B>>) -> ... - %% - %% But if the clauses can't be freely rearranged, as in - %% - %% b(Var, <<X>>) -> ... - %% b(1, 2) -> ... - %% - %% we do have a problem. - %% - case Vstate of - simple_vars -> State; - _ -> bsm_problem(P, Vstate) - end; + State; true -> %% The pattern P *may* match a binary, so we must update the state. %% (P must be a variable.) - case State of - within -> 'after'; - 'after' -> 'after' - end - end; -bsm_ensure_no_partition_2([#c_var{name=V}|Ps], N, G, Vstate, S) -> - case core_lib:is_var_used(V, G) of - false -> - bsm_ensure_no_partition_2(Ps, N-1, G, Vstate, S); - true -> - bsm_ensure_no_partition_2(Ps, N-1, G, bin_left_var_used_in_guard, S) - end; -bsm_ensure_no_partition_2([_|Ps], N, G, _, S) -> - bsm_ensure_no_partition_2(Ps, N-1, G, bin_argument_order, S). + 'after' + end. -bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs], Pos) -> - case nth(Pos, Ps) of - #c_var{} -> - bsm_ensure_no_partition_after(Cs, Pos); - _ -> - bsm_problem(C, bin_partition) +bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs]) -> + case Ps of + [#c_var{}|_] -> + bsm_ensure_no_partition_after(Cs); + _ -> + bsm_problem(C, bin_partition) end; -bsm_ensure_no_partition_after([], _) -> ok. +bsm_ensure_no_partition_after([]) -> ok. bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P); bsm_could_match_binary(#c_cons{}) -> false; diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index e28d48acf5..a9bd363ee1 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -145,14 +145,9 @@ find_fixpoint(OptFun, Core0, Max) -> body(Body, Sub) -> body(Body, value, Sub). -body(#c_values{anno=A,es=Es0}, Ctxt, Sub) -> - Es1 = expr_list(Es0, Ctxt, Sub), - case Ctxt of - value -> - #c_values{anno=A,es=Es1}; - effect -> - make_effect_seq(Es1, Sub) - end; +body(#c_values{anno=A,es=Es0}, value, Sub) -> + Es1 = expr_list(Es0, value, Sub), + #c_values{anno=A,es=Es1}; body(E, Ctxt, Sub) -> ?ASSERT(verify_scope(E, Sub)), expr(E, Ctxt, Sub). @@ -313,9 +308,15 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) -> false -> %% Arg cannot be "values" here - only a single value %% make sense here. - case is_safe_simple(Arg, Sub) of - true -> B1; - false -> Seq0#c_seq{arg=Arg,body=B1} + case {Ctxt,is_safe_simple(Arg, Sub)} of + {effect,true} -> B1; + {effect,false} -> + case is_safe_simple(B1, Sub) of + true -> Arg; + false -> Seq0#c_seq{arg=Arg,body=B1} + end; + {value,true} -> B1; + {value,false} -> Seq0#c_seq{arg=Arg,body=B1} end end; expr(#c_let{}=Let0, Ctxt, Sub) -> @@ -379,10 +380,7 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> Case = Case1#c_case{arg=Arg2,clauses=Cs2}, warn_no_clause_match(Case1, Case), Expr = eval_case(Case, Sub), - case move_case_into_arg(Case, Sub) of - impossible -> Expr; - Other -> Other - end; + move_case_into_arg(Expr, Sub); Other -> expr(Other, Ctxt, Sub) end; @@ -2509,6 +2507,72 @@ are_all_failing_clauses(Cs) -> is_failing_clause(#c_clause{body=B}) -> will_fail(B). +%% opt_build_stacktrace(Let) -> Core. +%% If the stacktrace is *only* used in a call to erlang:raise/3, +%% there is no need to build a cooked stackframe using build_stacktrace/1. + +opt_build_stacktrace(#c_let{vars=[#c_var{name=Cooked}], + arg=#c_primop{name=#c_literal{val=build_stacktrace}, + args=[RawStk]}, + body=Body}=Let) -> + case Body of + #c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=raise}, + args=[Class,Exp,#c_var{name=Cooked}]} -> + %% The stacktrace is only used in a call to erlang:raise/3. + %% There is no need to build the stacktrace. Replace the + %% call to erlang:raise/3 with the the raw_raise/3 instruction, + %% which will use a raw stacktrace. + #c_primop{name=#c_literal{val=raw_raise}, + args=[Class,Exp,RawStk]}; + #c_let{vars=[#c_var{name=V}],arg=Arg,body=B0} when V =/= Cooked -> + case core_lib:is_var_used(Cooked, Arg) of + false -> + %% The built stacktrace is not used in the argument, + %% so we can sink the building of the stacktrace into + %% the body of the let. + B = opt_build_stacktrace(Let#c_let{body=B0}), + Body#c_let{body=B}; + true -> + Let + end; + #c_seq{arg=Arg,body=B0} -> + case core_lib:is_var_used(Cooked, Arg) of + false -> + %% The built stacktrace is not used in the argument, + %% so we can sink the building of the stacktrace into + %% the body of the sequence. + B = opt_build_stacktrace(Let#c_let{body=B0}), + Body#c_seq{body=B}; + true -> + Let + end; + #c_case{arg=Arg,clauses=Cs0} -> + case core_lib:is_var_used(Cooked, Arg) orelse + is_used_in_any_guard(Cooked, Cs0) of + false -> + %% The built stacktrace is not used in the argument, + %% so we can sink the building of the stacktrace into + %% each arm of the case. + Cs = [begin + B = opt_build_stacktrace(Let#c_let{body=B0}), + C#c_clause{body=B} + end || #c_clause{body=B0}=C <- Cs0], + Body#c_case{clauses=Cs}; + true -> + Let + end; + _ -> + Let + end; +opt_build_stacktrace(Expr) -> + Expr. + +is_used_in_any_guard(V, Cs) -> + any(fun(#c_clause{guard=G}) -> + core_lib:is_var_used(V, G) + end, Cs). + %% opt_case_in_let(Let) -> Let' %% Try to avoid building tuples that are immediately matched. %% A common pattern is: @@ -2664,53 +2728,94 @@ opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) -> %% Optimise let and add new substitutions. {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), BodySub = update_let_types(Vs, Args, Sub1), + Sub = Sub1#sub{v=[],s=cerl_sets:new()}, B = body(B0, Ctxt, BodySub), Arg = core_lib:make_values(Args), - opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1). + opt_simple_let_2(Let, Vs, Arg, B, B0, Sub). -opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> + +%% opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> Core. +%% Do final simplifications of the let. +%% +%% Note that the substitutions and scope in Sub have been cleared +%% and should not be used. + +opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) -> case {Vs0,Arg0,Body} of - {[#c_var{name=N1}],Arg1,#c_var{name=N2}} -> - case N1 =:= N2 of - true -> - %% let <Var> = Arg in <Var> ==> Arg - Arg1; - false -> - %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar - Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody), - #c_seq{arg=Arg,body=Body} - end; + {[#c_var{name=V}],Arg1,#c_var{name=V}} -> + %% let <Var> = Arg in <Var> ==> Arg + Arg1; {[],#c_values{es=[]},_} -> %% No variables left. Body; - {Vs,Arg1,#c_literal{}} -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), - case Ctxt of - effect -> - %% Throw away the literal body. - Arg; - value -> - %% Since the variable is not used in the body, we - %% can rewrite the let to a sequence. - %% let <Var> = Arg in Literal ==> seq Arg Literal - #c_seq{arg=Arg,body=Body} - end; - {Vs,Arg1,Body} -> - %% If none of the variables are used in the body, we can - %% rewrite the let to a sequence: - %% let <Var> = Arg in BodyWithoutVar ==> - %% seq Arg BodyWithoutVar - case is_any_var_used(Vs, Body) of - false -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), - #c_seq{arg=Arg,body=Body}; - true -> - Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body}, - opt_bool_case_in_let(Let1, Sub) + {[#c_var{name=V}=Var|Vars]=Vars0,Arg1,Body} -> + case core_lib:is_var_used(V, Body) of + false when Vars =:= [] -> + %% If the variable is not used in the body, we can + %% rewrite the let to a sequence: + %% let <Var> = Arg in BodyWithoutVar ==> + %% seq Arg BodyWithoutVar + Arg = maybe_suppress_warnings(Arg1, Var, PrevBody), + #c_seq{arg=Arg,body=Body}; + false -> + %% There are multiple values returned by the argument + %% and the first value is not used (this is a 'case' + %% with exported variables, but the return value is + %% ignored). We can remove the first variable and the + %% the first value returned from the 'let' argument. + Arg2 = remove_first_value(Arg1, Sub), + Let1 = Let0#c_let{vars=Vars,arg=Arg2,body=Body}, + post_opt_let(Let1, Sub); + true -> + Let1 = Let0#c_let{vars=Vars0,arg=Arg1,body=Body}, + post_opt_let(Let1, Sub) end end. -%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody) -> Arg' +%% post_opt_let(Let, Sub) +%% Final optimizations of the let. +%% +%% Note that the substitutions and scope in Sub have been cleared +%% and should not be used. + +post_opt_let(Let0, Sub) -> + Let1 = opt_bool_case_in_let(Let0, Sub), + opt_build_stacktrace(Let1). + + +%% remove_first_value(Core0, Sub) -> Core. +%% Core0 is an expression that returns at least two values. +%% Remove the first value returned from Core0. + +remove_first_value(#c_values{es=[V|Vs]}, Sub) -> + Values = core_lib:make_values(Vs), + case is_safe_simple(V, Sub) of + false -> + #c_seq{arg=V,body=Values}; + true -> + Values + end; +remove_first_value(#c_case{clauses=Cs0}=Core, Sub) -> + Cs = remove_first_value_cs(Cs0, Sub), + Core#c_case{clauses=Cs}; +remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core, Sub) -> + Cs = remove_first_value_cs(Cs0, Sub), + Act = remove_first_value(Act0, Sub), + Core#c_receive{clauses=Cs,action=Act}; +remove_first_value(#c_let{body=B}=Core, Sub) -> + Core#c_let{body=remove_first_value(B, Sub)}; +remove_first_value(#c_seq{body=B}=Core, Sub) -> + Core#c_seq{body=remove_first_value(B, Sub)}; +remove_first_value(#c_primop{}=Core, _Sub) -> + Core; +remove_first_value(#c_call{}=Core, _Sub) -> + Core. + +remove_first_value_cs(Cs, Sub) -> + [C#c_clause{body=remove_first_value(B, Sub)} || + #c_clause{body=B}=C <- Cs]. + +%% maybe_suppress_warnings(Arg, #c_var{}, PreviousBody) -> Arg' %% Try to suppress false warnings when a variable is not used. %% For instance, we don't expect a warning for useless building in: %% @@ -2721,12 +2826,12 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> %% referenced in the original unoptimized code. If they were, we will %% consider the warning false and suppress it. -maybe_suppress_warnings(Arg, Vs, PrevBody) -> +maybe_suppress_warnings(Arg, #c_var{name=V}, PrevBody) -> case should_suppress_warning(Arg) of true -> Arg; %Already suppressed. false -> - case is_any_var_used(Vs, PrevBody) of + case core_lib:is_var_used(V, PrevBody) of true -> suppress_warning([Arg]); false -> @@ -2815,7 +2920,7 @@ move_case_into_arg(#c_case{arg=#c_case{arg=OuterArg, Outer#c_case{arg=OuterArg, clauses=[OuterCa,OuterCb]}; false -> - impossible + Inner0 end; move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer, clauses=InnerClauses}=Inner, _Sub) -> @@ -2831,15 +2936,8 @@ move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer, %% Outer#c_seq{arg=OuterArg, body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}}; -move_case_into_arg(_, _) -> - impossible. - -is_any_var_used([#c_var{name=V}|Vs], Expr) -> - case core_lib:is_var_used(V, Expr) of - false -> is_any_var_used(Vs, Expr); - true -> true - end; -is_any_var_used([], _) -> false. +move_case_into_arg(Expr, _) -> + Expr. %%% %%% Retrieving information about types. diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 8f3399d133..a96d58a903 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1855,7 +1855,12 @@ internal_cg(guard_error, [ExitCall], _Rs, Le, Vdb, Bef, St) -> {Ms,_} = cg_call_args(As, Bef, Le#l.i, Vdb), Call = {call_ext,Arity,{extfunc,Mod,Name,Arity}}, Is = Ms++[line(Le),Call], - {Is,Bef,St}. + {Is,Bef,St}; +internal_cg(raw_raise=I, As, Rs, Le, Vdb, Bef, St) -> + %% This behaves like a function call. + {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), + Reg = load_vars(Rs, clear_regs(Int#sr.reg)), + {Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St}. %% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> %% {[Ainstr],StackReg,State}. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 7e1a432511..4bd5e8e2e1 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -40,7 +40,7 @@ map_and_binary/1,unsafe_branch_caching/1, bad_literals/1,good_literals/1,constant_propagation/1, parse_xml/1,get_payload/1,escape/1,num_slots_different/1, - check_bitstring_list/1,guard/1]). + beam_bsm/1,guard/1,is_ascii/1,non_opt_eq/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -73,7 +73,7 @@ groups() -> map_and_binary,unsafe_branch_caching, bad_literals,good_literals,constant_propagation,parse_xml, get_payload,escape,num_slots_different, - check_bitstring_list,guard]}]. + beam_bsm,guard,is_ascii,non_opt_eq]}]. init_per_suite(Config) -> @@ -801,7 +801,7 @@ multiple_uses_cmp(<<_:16>>, <<_:16>>) -> false. first_after(Data, Offset) -> case byte_size(Data) > Offset of false -> - {First, Rest} = {ok, ok}, + {_First, _Rest} = {ok, ok}, ok; true -> <<_:Offset/binary, Rest/binary>> = Data, @@ -1515,7 +1515,7 @@ is_next_char_whitespace(<<C/utf8,_/binary>>) -> {this_hdr = 17, ext_hdr_opts}). -get_payload(Config) -> +get_payload(_Config) -> <<3445:48>> = do_get_payload(#ext_header{ext_hdr_opts = <<3445:48>>}), {'EXIT',_} = (catch do_get_payload(#ext_header{})), ok. @@ -1574,10 +1574,22 @@ lgettext(<<"de">>, <<"navigation">>, <<"Results">>) -> lgettext(<<"de">>, <<"navigation">>, <<"Resources">>) -> {ok, <<"Ressourcen">>}. -%% Cover more code in beam_bsm. -check_bitstring_list(_Config) -> +%% Test more code in beam_bsm. +beam_bsm(_Config) -> true = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [1,0,1,1]), false = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [0]), + + true = bsm_validate_scheme(<<>>), + true = bsm_validate_scheme(<<5,10>>), + false = bsm_validate_scheme(<<5,10,11,12>>), + true = bsm_validate_scheme([]), + true = bsm_validate_scheme([5,10]), + false = bsm_validate_scheme([5,6,7]), + + <<1,2,3>> = bsm_must_save_and_not_save(<<1,2,3>>, []), + D = fun(N) -> 2*N end, + [2,4|<<3>>] = bsm_must_save_and_not_save(<<1,2,3>>, [D,D]), + ok. check_bitstring_list(<<H:1,T1/bitstring>>, [H|T2]) -> @@ -1587,8 +1599,32 @@ check_bitstring_list(<<>>, []) -> check_bitstring_list(_, _) -> false. +bsm_validate_scheme([]) -> true; +bsm_validate_scheme([H|T]) -> + case bsm_is_scheme(H) of + true -> bsm_validate_scheme(T); + false -> false + end; +bsm_validate_scheme(<<>>) -> true; +bsm_validate_scheme(<<H, Rest/binary>>) -> + case bsm_is_scheme(H) of + true -> bsm_validate_scheme(Rest); + false -> false + end. + +bsm_is_scheme(Int) -> + Int rem 5 =:= 0. + +%% NOT OPTIMIZED: different control paths use different positions in the binary +bsm_must_save_and_not_save(Bin, []) -> + Bin; +bsm_must_save_and_not_save(<<H,T/binary>>, [F|Fs]) -> + [F(H)|bsm_must_save_and_not_save(T, Fs)]; +bsm_must_save_and_not_save(<<>>, []) -> + []. + guard(_Config) -> - Tuple = id({a,b}), + _Tuple = id({a,b}), ok = guard_1(<<1,2,3>>, {1,2,3}), ok = guard_2(<<42>>, #{}), ok. @@ -1601,6 +1637,39 @@ guard_1(<<A,B,C>>, Tuple) when Tuple =:= {A,B,C} -> guard_2(<<_>>, Healing) when Healing#{[] => Healing} =:= #{[] => #{}} -> ok. +is_ascii(_Config) -> + true = do_is_ascii(<<>>), + true = do_is_ascii(<<"string">>), + false = do_is_ascii(<<1024/utf8>>), + {'EXIT',{function_clause,_}} = (catch do_is_ascii(<<$A,0:3>>)), + {'EXIT',{function_clause,_}} = (catch do_is_ascii(<<16#80,0:3>>)), + ok. + +do_is_ascii(<<>>) -> + true; +do_is_ascii(<<C,_/binary>>) when C >= 16#80 -> + %% This clause must fail to match if the size of the argument in + %% bits is not divisible by 8. Beware of unsafe optimizations. + false; +do_is_ascii(<<_, T/binary>>) -> + do_is_ascii(T). + +non_opt_eq(_Config) -> + true = non_opt_eq([], <<>>), + true = non_opt_eq([$a], <<$a>>), + false = non_opt_eq([$a], <<$b>>), + ok. + +%% An example from the Efficiency Guide. It used to be not optimized, +%% but now it can be optimized. + +non_opt_eq([H|T1], <<H,T2/binary>>) -> + non_opt_eq(T1, T2); +non_opt_eq([_|_], <<_,_/binary>>) -> + false; +non_opt_eq([], <<>>) -> + true. + check(F, R) -> R = F(). diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 262967d03d..4fd1f84569 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -27,7 +27,7 @@ multiple_aliases/1,redundant_boolean_clauses/1, mixed_matching_clauses/1,unnecessary_building/1, no_no_file/1,configuration/1,supplies/1, - redundant_stack_frame/1]). + redundant_stack_frame/1,export_from_case/1]). -export([foo/0,foo/1,foo/2,foo/3]). @@ -47,7 +47,7 @@ groups() -> multiple_aliases,redundant_boolean_clauses, mixed_matching_clauses,unnecessary_building, no_no_file,configuration,supplies, - redundant_stack_frame]}]. + redundant_stack_frame,export_from_case]}]. init_per_suite(Config) -> @@ -551,4 +551,38 @@ do_redundant_stack_frame(Map) -> end, {X, Y}. +%% Cover some clauses in sys_core_fold:remove_first_value/2. + +-record(export_from_case, {val}). + +export_from_case(_Config) -> + a = export_from_case_1(true), + b = export_from_case_1(false), + + R = #export_from_case{val=0}, + {ok,R} = export_from_case_2(false, R), + {ok,#export_from_case{val=42}} = export_from_case_2(true, R), + + ok. + +export_from_case_1(Bool) -> + case Bool of + true -> + id(42), + Result = a; + false -> + Result = b + end, + id(Result). + +export_from_case_2(Bool, Rec) -> + case Bool of + false -> + Result = Rec; + true -> + Result = Rec#export_from_case{val=42} + end, + {ok,Result}. + + id(I) -> I. diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 8cf7928cc4..d5a1dc642f 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -27,7 +27,7 @@ nested_horrid/1,last_call_optimization/1,bool/1, plain_catch_coverage/1,andalso_orelse/1,get_in_try/1, hockey/1,handle_info/1,catch_in_catch/1,grab_bag/1, - stacktrace/1,nested_stacktrace/1]). + stacktrace/1,nested_stacktrace/1,raise/1]). -include_lib("common_test/include/ct.hrl"). @@ -44,7 +44,7 @@ groups() -> nested_after,nested_horrid,last_call_optimization, bool,plain_catch_coverage,andalso_orelse,get_in_try, hockey,handle_info,catch_in_catch,grab_bag, - stacktrace,nested_stacktrace]}]. + stacktrace,nested_stacktrace,raise]}]. init_per_suite(Config) -> @@ -117,6 +117,16 @@ basic(Conf) when is_list(Conf) -> catch nisse -> erro end, + %% Unmatchable clauses. + try + throw(thrown) + catch + {a,b}={a,b,c} -> %Intentionally no match. + ok; + thrown -> + ok + end, + ok. after_call() -> @@ -1159,5 +1169,99 @@ nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> {caught1,S1,T2} end. +raise(_Config) -> + test_raise(fun() -> exit({exit,tuple}) end), + test_raise(fun() -> abs(id(x)) end), + test_raise(fun() -> throw({was,thrown}) end), + + badarg = bad_raise(fun() -> abs(id(x)) end), + + ok. + +bad_raise(Expr) -> + try + Expr() + catch + _:E:Stk -> + erlang:raise(bad_class, E, Stk) + end. + +test_raise(Expr) -> + test_raise_1(Expr), + test_raise_2(Expr), + test_raise_3(Expr). + +test_raise_1(Expr) -> + erase(exception), + try + do_test_raise_1(Expr) + catch + C:E:Stk -> + {C,E,Stk} = erase(exception) + end. + +do_test_raise_1(Expr) -> + try + Expr() + catch + C:E:Stk -> + %% Here the stacktrace must be built. + put(exception, {C,E,Stk}), + erlang:raise(C, E, Stk) + end. + +test_raise_2(Expr) -> + erase(exception), + try + do_test_raise_2(Expr) + catch + C:E:Stk -> + {C,E} = erase(exception), + try + Expr() + catch + _:_:S -> + [StkTop|_] = S, + [StkTop|_] = Stk + end + end. + +do_test_raise_2(Expr) -> + try + Expr() + catch + C:E:Stk -> + %% Here it is possible to replace erlang:raise/3 with + %% the raw_raise/3 instruction since the stacktrace is + %% not actually used. + put(exception, {C,E}), + erlang:raise(C, E, Stk) + end. + +test_raise_3(Expr) -> + try + do_test_raise_3(Expr) + catch + exit:{exception,C,E}:Stk -> + try + Expr() + catch + C:E:S -> + [StkTop|_] = S, + [StkTop|_] = Stk + end + end. + +do_test_raise_3(Expr) -> + try + Expr() + catch + C:E:Stk -> + %% Here it is possible to replace erlang:raise/3 with + %% the raw_raise/3 instruction since the stacktrace is + %% not actually used. + erlang:raise(exit, {exception,C,E}, Stk) + end. + id(I) -> I. diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 6957d25774..9a3ea07c97 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -179,6 +179,12 @@ # define HAVE_ECB_IVEC_BUG #endif +#define HAVE_RSA_SSLV23_PADDING +#if defined(HAS_LIBRESSL) \ + && LIBRESSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(2,6,1) +# undef HAVE_RSA_SSLV23_PADDING +#endif + #if defined(HAVE_CMAC) #include <openssl/cmac.h> #endif @@ -659,7 +665,9 @@ static ERL_NIF_TERM atom_rsa_oaep_md; static ERL_NIF_TERM atom_rsa_pad; /* backwards compatibility */ static ERL_NIF_TERM atom_rsa_padding; static ERL_NIF_TERM atom_rsa_pkcs1_pss_padding; +#ifdef HAVE_RSA_SSLV23_PADDING static ERL_NIF_TERM atom_rsa_sslv23_padding; +#endif static ERL_NIF_TERM atom_rsa_x931_padding; static ERL_NIF_TERM atom_rsa_pss_saltlen; static ERL_NIF_TERM atom_sha224; @@ -1064,7 +1072,9 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_rsa_pad = enif_make_atom(env,"rsa_pad"); /* backwards compatibility */ atom_rsa_padding = enif_make_atom(env,"rsa_padding"); atom_rsa_pkcs1_pss_padding = enif_make_atom(env,"rsa_pkcs1_pss_padding"); +#ifdef HAVE_RSA_SSLV23_PADDING atom_rsa_sslv23_padding = enif_make_atom(env,"rsa_sslv23_padding"); +#endif atom_rsa_x931_padding = enif_make_atom(env,"rsa_x931_padding"); atom_rsa_pss_saltlen = enif_make_atom(env,"rsa_pss_saltlen"); atom_sha224 = enif_make_atom(env,"sha224"); @@ -4449,8 +4459,10 @@ static int get_pkey_crypt_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NI opt->rsa_padding = RSA_PKCS1_PADDING; } else if (tpl_terms[1] == atom_rsa_pkcs1_oaep_padding) { opt->rsa_padding = RSA_PKCS1_OAEP_PADDING; +#ifdef HAVE_RSA_SSLV23_PADDING } else if (tpl_terms[1] == atom_rsa_sslv23_padding) { opt->rsa_padding = RSA_SSLV23_PADDING; +#endif } else if (tpl_terms[1] == atom_rsa_x931_padding) { opt->rsa_padding = RSA_X931_PADDING; } else if (tpl_terms[1] == atom_rsa_no_padding) { @@ -4516,7 +4528,10 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM #endif PKeyCryptOptions crypt_opt; ErlNifBinary in_bin, out_bin, tmp_bin; - size_t outlen, tmplen; + size_t outlen; +#ifdef HAVE_RSA_SSLV23_PADDING + size_t tmplen; +#endif int is_private = (argv[4] == atom_true), is_encrypt = (argv[5] == atom_true); int algo_init = 0; @@ -4596,6 +4611,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM if (crypt_opt.signature_md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, crypt_opt.signature_md) <= 0) goto badarg; +#ifdef HAVE_RSA_SSLV23_PADDING if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) { if (is_encrypt) { RSA *rsa = EVP_PKEY_get1_RSA(pkey); @@ -4607,9 +4623,11 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM in_bin = tmp_bin; } if (EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_NO_PADDING) <= 0) goto badarg; - } else { + } else +#endif + { if (EVP_PKEY_CTX_set_rsa_padding(ctx, crypt_opt.rsa_padding) <= 0) goto badarg; - } + } #ifdef HAVE_RSA_OAEP_MD if (crypt_opt.rsa_padding == RSA_PKCS1_OAEP_PADDING) { if (crypt_opt.rsa_oaep_md != NULL @@ -4728,6 +4746,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM #endif if ((i > 0) && argv[0] == atom_rsa && !is_encrypt) { +#ifdef HAVE_RSA_SSLV23_PADDING if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) { RSA *rsa = EVP_PKEY_get1_RSA(pkey); unsigned char *p; @@ -4745,6 +4764,7 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM i = 1; } } +#endif } if (tmp_bin.data != NULL) { diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 93cfea3c5e..384912f983 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -3117,7 +3117,10 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State, state__remove_added_warnings(OldState, NewState) -> #state{warnings = OldWarnings} = OldState, #state{warnings = NewWarnings} = NewState, - {NewWarnings -- OldWarnings, NewState#state{warnings = OldWarnings}}. + case NewWarnings =:= OldWarnings of + true -> {[], NewState}; + false -> {NewWarnings -- OldWarnings, NewState#state{warnings = OldWarnings}} + end. state__add_warnings(Warns, #state{warnings = Warnings} = State) -> State#state{warnings = Warns ++ Warnings}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/abs.erl b/lib/dialyzer/test/small_SUITE_data/src/abs.erl index 251e24cdfc..0e38c3dbb7 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/abs.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/abs.erl @@ -5,7 +5,7 @@ -export([t/0]). t() -> - Fs = [fun i1/0, fun i2/0, fun i3/0, fun i4/0, fun f1/0], + Fs = [fun i1/0, fun i2/0, fun i3/0, fun i4/0, fun f1/0, fun erl_551/0], _ = [catch F() || F <- Fs], ok. @@ -60,6 +60,13 @@ f1() -> f1(A) -> abs(A). +erl_551() -> + accept(9), + accept(-3). + +accept(Number) when abs(Number) >= 8 -> first; +accept(_Number) -> second. + -spec int() -> integer(). int() -> diff --git a/lib/dialyzer/test/small_SUITE_data/src/bsL.erl b/lib/dialyzer/test/small_SUITE_data/src/bsL.erl new file mode 100644 index 0000000000..b2fdc16324 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/bsL.erl @@ -0,0 +1,13 @@ +-module(bsL). + +-export([t/0]). + +%% Found in lib/observer/test/crashdump_helper.erl. + +t() -> + Size = 60, + <<H:16/unit:8>> = erlang:md5(<<Size:32>>), + true = H < 20, + true = H > 2, + Data = ((H bsl (8*150)) div (H+7919)), + <<Data:Size/unit:8>>. diff --git a/lib/dialyzer/test/small_SUITE_data/src/erl_tar_table.erl b/lib/dialyzer/test/small_SUITE_data/src/erl_tar_table.erl new file mode 100644 index 0000000000..2dc00d272a --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/erl_tar_table.erl @@ -0,0 +1,14 @@ +-module(erl_tar_table). + +%% OTP-14860, PR 1670. + +-export([t/0, v/0, x/0]). + +t() -> + {ok, ["file"]} = erl_tar:table("table.tar"). + +v() -> + {ok, [{_,_,_,_,_,_,_}]} = erl_tar:table("table.tar", [verbose]). + +x() -> + {ok, ["file"]} = erl_tar:table("table.tar", []). diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 462a1f9dcd..5fda857bf1 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -1885,7 +1885,8 @@ infinity_div(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> infinity_bsl(pos_inf, _) -> pos_inf; infinity_bsl(neg_inf, _) -> neg_inf; -infinity_bsl(Number, pos_inf) when is_integer(Number), Number >= 0 -> pos_inf; +infinity_bsl(0, pos_inf) -> 0; +infinity_bsl(Number, pos_inf) when is_integer(Number), Number > 0 -> pos_inf; infinity_bsl(Number, pos_inf) when is_integer(Number) -> neg_inf; infinity_bsl(Number, neg_inf) when is_integer(Number), Number >= 0 -> 0; infinity_bsl(Number, neg_inf) when is_integer(Number) -> -1; @@ -1974,9 +1975,11 @@ arith_abs(X1, Opaques) -> case infinity_geq(Min1, 0) of true -> {Min1, Max1}; false -> + NegMin1 = infinity_inv(Min1), + NegMax1 = infinity_inv(Max1), case infinity_geq(Max1, 0) of - true -> {0, infinity_inv(Min1)}; - false -> {infinity_inv(Max1), infinity_inv(Min1)} + true -> {0, max(NegMin1, Max1)}; + false -> {NegMax1, NegMin1} end end, t_from_range(NewMin, NewMax) diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 77a2a7401c..8a609ef911 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2351,6 +2351,8 @@ t_from_range(X, Y) -> -else. +t_from_range(pos_inf, pos_inf) -> ?integer_pos; +t_from_range(neg_inf, neg_inf) -> ?integer_neg; t_from_range(neg_inf, pos_inf) -> t_integer(); t_from_range(neg_inf, Y) when is_integer(Y), Y < 0 -> ?integer_neg; t_from_range(neg_inf, Y) when is_integer(Y), Y >= 0 -> t_integer(); @@ -2383,6 +2385,8 @@ t_from_range(pos_inf, neg_inf) -> t_none(). -spec t_from_range_unsafe(rng_elem(), rng_elem()) -> erl_type(). +t_from_range_unsafe(pos_inf, pos_inf) -> ?integer_pos; +t_from_range_unsafe(neg_inf, neg_inf) -> ?integer_neg; t_from_range_unsafe(neg_inf, pos_inf) -> t_integer(); t_from_range_unsafe(neg_inf, Y) -> ?int_range(neg_inf, Y); t_from_range_unsafe(X, pos_inf) -> ?int_range(X, pos_inf); diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 7ff9fd83eb..6e66ec057c 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -1164,6 +1164,12 @@ trans_fun([build_stacktrace|Instructions], Env) -> Vars = [mk_var({x,0})], %{x,0} is implict arg and dst [hipe_icode:mk_primop(Vars,build_stacktrace,Vars), trans_fun(Instructions, Env)]; +%%--- raw_raise --- +trans_fun([raw_raise|Instructions], Env) -> + Vars = [mk_var({x,0}),mk_var({x,1}),mk_var({x,2})], + Dst = [mk_var({x,0})], + [hipe_icode:mk_primop(Dst,raw_raise,Vars) | + trans_fun(Instructions, Env)]; %%-------------------------------------------------------------------- %%--- ERROR HANDLING --- %%-------------------------------------------------------------------- diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl index 941516e8b1..a1f1128124 100644 --- a/lib/hipe/icode/hipe_icode_primops.erl +++ b/lib/hipe/icode/hipe_icode_primops.erl @@ -236,6 +236,7 @@ fails({hipe_bs_primop, {bs_append, _, _, _, _}}) -> true; fails({hipe_bs_primop, {bs_private_append, _, _}}) -> true; fails({hipe_bs_primop, bs_init_writable}) -> true; fails(build_stacktrace) -> false; +fails(raw_raise) -> true; fails(#mkfun{}) -> false; fails(#unsafe_element{}) -> false; fails(#unsafe_update_element{}) -> false; @@ -735,6 +736,8 @@ type(Primop, Args) -> erl_types:t_any(); build_stacktrace -> erl_types:t_list(); + raw_raise -> + erl_types:t_atom(); {M, F, A} -> erl_bif_types:type(M, F, A, Args) end. @@ -909,6 +912,8 @@ type(Primop) -> %%% Other build_stacktrace -> erl_types:t_any(); + raw_raise -> + erl_types:t_any(); #closure_element{} -> erl_types:t_any(); redtest -> diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl index cf74c1eb5b..34b18acccd 100644 --- a/lib/hipe/icode/hipe_icode_range.erl +++ b/lib/hipe/icode/hipe_icode_range.erl @@ -1187,7 +1187,8 @@ basic_type(unsafe_tl) -> not_int; basic_type(#element{}) -> not_analysed; basic_type(#unsafe_element{}) -> not_analysed; basic_type(#unsafe_update_element{}) -> not_analysed; -basic_type(build_stacktrace) -> not_int. +basic_type(build_stacktrace) -> not_int; +basic_type(raw_raise) -> not_int. -spec analyse_bs_get_integer(integer(), integer(), boolean()) -> range_tuple(). diff --git a/lib/hipe/llvm/hipe_llvm.erl b/lib/hipe/llvm/hipe_llvm.erl index ccd40162cb..343ca94cb1 100644 --- a/lib/hipe/llvm/hipe_llvm.erl +++ b/lib/hipe/llvm/hipe_llvm.erl @@ -934,7 +934,7 @@ pp_ins(Dev, Ver, I) -> end, case call_is_tail(I) of true -> write(Dev, "tail "); - false -> ok + false -> write(Dev, "notail ") end, write(Dev, ["call ", call_cconv(I), " "]), pp_options(Dev, call_ret_attrs(I)), diff --git a/lib/hipe/rtl/hipe_rtl_primops.erl b/lib/hipe/rtl/hipe_rtl_primops.erl index d646b78a3d..ce5433379e 100644 --- a/lib/hipe/rtl/hipe_rtl_primops.erl +++ b/lib/hipe/rtl/hipe_rtl_primops.erl @@ -396,6 +396,8 @@ gen_primop({Op,Dst,Args,Cont,Fail}, IsGuard, ConstTab) -> [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)]; build_stacktrace -> [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)]; + raw_raise -> + [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)]; %% Only names listed above are accepted! MFA:s are not primops! _ -> diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl index d71b924d22..ba9c03d4ba 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl @@ -24,6 +24,7 @@ test() -> ok = test_bad_fun_call(), ok = test_guard_bif(), ok = test_eclectic(), + ok = test_raise(), ok. %%-------------------------------------------------------------------- @@ -579,3 +580,99 @@ my_add(A, B) -> my_abs(X) -> abs(X). + +test_raise() -> + test_raise(fun() -> exit({exit,tuple}) end), + test_raise(fun() -> abs(id(x)) end), + test_raise(fun() -> throw({was,thrown}) end), + + badarg = bad_raise(fun() -> abs(id(x)) end), + + ok. + +bad_raise(Expr) -> + try + Expr() + catch + _:E:Stk -> + erlang:raise(bad_class, E, Stk) + end. + +test_raise(Expr) -> + test_raise_1(Expr), + test_raise_2(Expr), + test_raise_3(Expr). + +test_raise_1(Expr) -> + erase(exception), + try + do_test_raise_1(Expr) + catch + C:E:Stk -> + {C,E,Stk} = erase(exception) + end. + +do_test_raise_1(Expr) -> + try + Expr() + catch + C:E:Stk -> + %% Here the stacktrace must be built. + put(exception, {C,E,Stk}), + erlang:raise(C, E, Stk) + end. + +test_raise_2(Expr) -> + erase(exception), + try + do_test_raise_2(Expr) + catch + C:E:Stk -> + {C,E} = erase(exception), + try + Expr() + catch + _:_:S -> + [StkTop|_] = S, + [StkTop|_] = Stk + end + end. + +do_test_raise_2(Expr) -> + try + Expr() + catch + C:E:Stk -> + %% Here it is possible to replace erlang:raise/3 with + %% the raw_raise/3 instruction since the stacktrace is + %% not actually used. + put(exception, {C,E}), + erlang:raise(C, E, Stk) + end. + +test_raise_3(Expr) -> + try + do_test_raise_3(Expr) + catch + exit:{exception,C,E}:Stk -> + try + Expr() + catch + C:E:S -> + [StkTop|_] = S, + [StkTop|_] = Stk + end + end. + +do_test_raise_3(Expr) -> + try + Expr() + catch + C:E:Stk -> + %% Here it is possible to replace erlang:raise/3 with + %% the raw_raise/3 instruction since the stacktrace is + %% not actually used. + erlang:raise(exit, {exception,C,E}, Stk) + end. + +id(I) -> I. diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl index b9e7d93570..aa85626857 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_construct.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -279,13 +279,22 @@ bad_floats() -> %% (incorrectly) signed. huge_binaries() -> - AlmostIllegal = id(<<0:(id((1 bsl 32)-8))>>), case erlang:system_info(wordsize) of - 4 -> huge_binaries_32(AlmostIllegal); + 4 -> + Old = erts_debug:set_internal_state(available_internal_state, true), + case erts_debug:set_internal_state(binary, (1 bsl 29)-1) of + false -> + io:format("\nNot enough memory to create 512Mb binary\n",[]); + Bin-> + huge_binaries_32(Bin) + end, + erts_debug:set_internal_state(available_internal_state, Old); + 8 -> ok end, garbage_collect(), id(<<0:(id((1 bsl 31)-1))>>), + garbage_collect(), id(<<0:(id((1 bsl 30)-1))>>), garbage_collect(), ok. diff --git a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c index b3a18e03d4..446b46ad82 100644 --- a/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c +++ b/lib/ic/test/c_client_erl_server_SUITE_data/c_client.c @@ -1365,8 +1365,8 @@ static int cmp_strRec(m_strRec *b1, m_strRec *b2) return 0; if (!cmp_str(b1->str6,b2->str6)) return 0; - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) if (b1->str7[i][j] != b2->str7[i][j]) return 0; for (j = 0; j < 3; j++) @@ -1579,8 +1579,8 @@ static void print_strRec(m_strRec* sr) fprintf(stdout, "\nboolean bb : %d\n",sr->bb); fprintf(stdout, "string str4 : %s\n",sr->str4); fprintf(stdout, "str7[2][3] :\n"); - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]); fprintf(stdout, "str5._length : %ld\n",sr->str5._length); for (j = 0; j < sr->str5._length; j++) diff --git a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c index 40c7328f03..d6a78d2481 100644 --- a/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c +++ b/lib/ic/test/c_client_erl_server_proto_SUITE_data/c_client.c @@ -1369,8 +1369,8 @@ static int cmp_strRec(m_strRec *b1, m_strRec *b2) return 0; if (!cmp_str(b1->str6,b2->str6)) return 0; - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) if (b1->str7[i][j] != b2->str7[i][j]) return 0; for (j = 0; j < 3; j++) @@ -1583,8 +1583,8 @@ static void print_strRec(m_strRec* sr) fprintf(stdout, "\nboolean bb : %d\n",sr->bb); fprintf(stdout, "string str4 : %s\n",sr->str4); fprintf(stdout, "str7[2][3] :\n"); - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]); fprintf(stdout, "str5._length : %ld\n",sr->str5._length); for (j = 0; j < sr->str5._length; j++) diff --git a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c index 33cfe71322..17ef21f4f4 100644 --- a/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c +++ b/lib/ic/test/c_client_erl_server_proto_tmo_SUITE_data/c_client.c @@ -1369,8 +1369,8 @@ static int cmp_strRec(m_strRec *b1, m_strRec *b2) return 0; if (!cmp_str(b1->str6,b2->str6)) return 0; - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) if (b1->str7[i][j] != b2->str7[i][j]) return 0; for (j = 0; j < 3; j++) @@ -1583,8 +1583,8 @@ static void print_strRec(m_strRec* sr) fprintf(stdout, "\nboolean bb : %d\n",sr->bb); fprintf(stdout, "string str4 : %s\n",sr->str4); fprintf(stdout, "str7[2][3] :\n"); - for (i = 0; i < 2; i++) - for (j = 0; j < 3; j++) + for (i = 0; i < 3; i++) + for (j = 0; j < 2; j++) fprintf(stdout, "str7[%d][%d]: %ld\n", i, j, sr->str7[i][j]); fprintf(stdout, "str5._length : %ld\n",sr->str5._length); for (j = 0; j < sr->str5._length; j++) diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 169a76463b..abb045b744 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -197,6 +197,9 @@ fe80::204:acff:fe17:bf38 <datatype> <name name="address_family"/> </datatype> + <datatype> + <name name="socket_protocol"/> + </datatype> </datatypes> <funcs> @@ -461,6 +464,61 @@ get_tcpi_sacked(Sock) -> </func> <func> + <name name="i" arity="0" /> + <name name="i" arity="1" /> + <name name="i" arity="2" /> + <fsummary>Displays information and statistics about sockets on the terminal</fsummary> + <desc> + <p> + Lists all TCP, UDP and SCTP sockets, including those that the Erlang runtime system uses as well as + those created by the application. + </p> + <p> + The following options are available: + </p> + + <taglist> + <tag><c>port</c></tag> + <item> + <p>The internal index of the port.</p> + </item> + <tag><c>module</c></tag> + <item> + <p>The callback module of the socket.</p> + </item> + <tag><c>recv</c></tag> + <item> + <p>Number of bytes received by the socket.</p> + </item> + <tag><c>sent</c></tag> + <item> + <p>Number of bytes sent from the socket.</p> + </item> + <tag><c>owner</c></tag> + <item> + <p>The socket owner process.</p> + </item> + <tag><c>local_address</c></tag> + <item> + <p>The local address of the socket.</p> + </item> + <tag><c>foreign_address</c></tag> + <item> + <p>The address and port of the other end of the connection.</p> + </item> + <tag><c>state</c></tag> + <item> + <p>The connection state.</p> + </item> + <tag><c>type</c></tag> + <item> + <p>STREAM or DGRAM or SEQPACKET.</p> + </item> + </taglist> + </desc> + </func> + + <func> <name name="ntoa" arity="1" /> <fsummary>Convert IPv6/IPV4 address to ASCII.</fsummary> <desc> @@ -1214,7 +1272,7 @@ inet:setopts(Sock,[{raw,6,8,<<30:32/native>>}]),]]></code> For one-to-many style sockets, the special value <c>0</c> is defined to mean that the returned addresses must be without any particular association. - How different SCTP implementations interprets this varies somewhat. + How different SCTP implementations interpret this varies somewhat. </p> </desc> </func> diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index e5ac031539..0762cebc94 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>1996</year><year>2017</year> + <year>1996</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -469,8 +469,12 @@ MaxT = TickTime + TickTime / 4</code> <item><c>ObjSuffix = string()</c></item> <item><c>SrcSuffix = string()</c></item> </list> - <p>Specifies a list of rules for use by <c>filelib:find_file/2</c> and - <c>filelib:find_source/2</c>. If this is set to some other value + <p>Specifies a list of rules for use by + <seealso marker="stdlib:filelib#find_file/2"> + <c>filelib:find_file/2</c></seealso> + <seealso marker="stdlib:filelib#find_source/2"> + <c>filelib:find_source/2</c></seealso> + If this is set to some other value than the empty list, it replaces the default rules. Rules can be simple pairs of directory suffixes, such as <c>{"ebin", "src"}</c>, which are used by <c>filelib:find_file/2</c>, or @@ -478,6 +482,16 @@ MaxT = TickTime + TickTime / 4</code> file name extensions, for example <c>[{".beam", ".erl", [{"ebin", "src"}]}</c>, which are used by <c>filelib:find_source/2</c>. Both kinds of rules can be mixed in the list.</p> + <p>The interpretation of <c>ObjDirSuffix</c> and <c>SrcDirSuffix</c> + is as follows: if the end of the directory name where an + object is located matches <c>ObjDirSuffix</c>, then the + name created by replacing <c>ObjDirSuffix</c> with + <c>SrcDirSuffix</c> is expanded by calling + <seealso marker="stdlib:filelib#wildcard/1"> + <c>filelib:wildcard/1</c></seealso>, and the first regular + file found among the matches is the source file. + </p> + </item> </taglist> </section> diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index 70cbf1c87c..99ea8dc384 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -266,7 +266,7 @@ inc_wrap_file(Log) -> Size :: dlog_size(), Reason :: no_such_log | nonode | {read_only_mode, Log} | {blocked_log, Log} - | {new_size_too_small, CurrentSize :: pos_integer()} + | {new_size_too_small, Log, CurrentSize :: pos_integer()} | {badarg, size} | {file_error, file:filename(), file_error()}. change_size(Log, NewSize) -> diff --git a/lib/kernel/src/erl_boot_server.erl b/lib/kernel/src/erl_boot_server.erl index 2a38266579..4ac945ce01 100644 --- a/lib/kernel/src/erl_boot_server.erl +++ b/lib/kernel/src/erl_boot_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -58,13 +58,11 @@ -define(single_addr_mask, {255, 255, 255, 255}). --type ip4_address() :: {0..255,0..255,0..255,0..255}. - --spec start(Slaves) -> {'ok', Pid} | {'error', What} when +-spec start(Slaves) -> {'ok', Pid} | {'error', Reason} when Slaves :: [Host], - Host :: atom(), + Host :: inet:ip_address() | inet:hostname(), Pid :: pid(), - What :: any(). + Reason :: {'badarg', Slaves}. start(Slaves) -> case check_arg(Slaves) of @@ -74,11 +72,11 @@ start(Slaves) -> {error, {badarg, Slaves}} end. --spec start_link(Slaves) -> {'ok', Pid} | {'error', What} when +-spec start_link(Slaves) -> {'ok', Pid} | {'error', Reason} when Slaves :: [Host], - Host :: atom(), + Host :: inet:ip_address() | inet:hostname(), Pid :: pid(), - What :: any(). + Reason :: {'badarg', Slaves}. start_link(Slaves) -> case check_arg(Slaves) of @@ -104,10 +102,10 @@ check_arg([], Result) -> check_arg(_, _Result) -> error. --spec add_slave(Slave) -> 'ok' | {'error', What} when +-spec add_slave(Slave) -> 'ok' | {'error', Reason} when Slave :: Host, - Host :: atom(), - What :: any(). + Host :: inet:ip_address() | inet:hostname(), + Reason :: {'badarg', Slave}. add_slave(Slave) -> case inet:getaddr(Slave, inet) of @@ -117,10 +115,10 @@ add_slave(Slave) -> {error, {badarg, Slave}} end. --spec delete_slave(Slave) -> 'ok' | {'error', What} when +-spec delete_slave(Slave) -> 'ok' | {'error', Reason} when Slave :: Host, - Host :: atom(), - What :: any(). + Host :: inet:ip_address() | inet:hostname(), + Reason :: {'badarg', Slave}. delete_slave(Slave) -> case inet:getaddr(Slave, inet) of @@ -130,7 +128,7 @@ delete_slave(Slave) -> {error, {badarg, Slave}} end. --spec add_subnet(Mask :: ip4_address(), Addr :: ip4_address()) -> +-spec add_subnet(Netmask :: inet:ip_address(), Addr :: inet:ip_address()) -> 'ok' | {'error', any()}. add_subnet(Mask, Addr) when is_tuple(Mask), is_tuple(Addr) -> @@ -141,14 +139,15 @@ add_subnet(Mask, Addr) when is_tuple(Mask), is_tuple(Addr) -> {error, empty_subnet} end. --spec delete_subnet(Mask :: ip4_address(), Addr :: ip4_address()) -> 'ok'. +-spec delete_subnet(Netmask :: inet:ip_address(), + Addr :: inet:ip_address()) -> 'ok'. delete_subnet(Mask, Addr) when is_tuple(Mask), is_tuple(Addr) -> gen_server:call(boot_server, {delete, {Mask, Addr}}). -spec which_slaves() -> Slaves when - Slaves :: [Host], - Host :: atom(). + Slaves :: [Slave], + Slave :: {Netmask :: inet:ip_address(), Address :: inet:ip_address()}. which_slaves() -> gen_server:call(boot_server, which). diff --git a/lib/kernel/src/group_history.erl b/lib/kernel/src/group_history.erl index 91f3663cc5..9745848992 100644 --- a/lib/kernel/src/group_history.erl +++ b/lib/kernel/src/group_history.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2017. All Rights Reserved. +%% Copyright Ericsson AB 2017-2018. 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. @@ -260,7 +260,7 @@ resize_log(Name, _OldSize, NewSize) -> ok -> show('$#erlang-history-resize-result', "ok~n", []); - {error, {new_size_too_small, _}} -> + {error, {new_size_too_small, _, _}} -> show('$#erlang-history-resize-result', "failed (new size is too small)~n", []), disable_history(); diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index f4c7c277ed..f8199fcf71 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -236,9 +236,10 @@ load_common(Mod, Bin, Beam, Architecture) -> lists:foreach(fun({FE, DestAddress}) -> hipe_bifs:set_native_address_in_fe(FE, DestAddress) end, erase(closures_to_patch)), - ok = hipe_bifs:commit_patch_load(LoaderState), set_beam_call_traps(FunDefs), - ok; + export_funs(FunDefs), + ok = hipe_bifs:commit_patch_load(LoaderState), + ok; BeamBinary when is_binary(BeamBinary) -> %% Find all closures in the code. [] = erase(closures_to_patch), %Clean up, assertion. diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index dc20c21c77..fe91b0d33e 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -72,7 +72,7 @@ %% timer interface -export([start_timer/1, timeout/1, timeout/2, stop_timer/1]). --export_type([address_family/0, hostent/0, hostname/0, ip4_address/0, +-export_type([address_family/0, socket_protocol/0, hostent/0, hostname/0, ip4_address/0, ip6_address/0, ip_address/0, port_number/0, local_address/0, socket_address/0, returned_non_ip_address/0, socket_setopt/0, socket_getopt/0, @@ -1452,11 +1452,14 @@ fdopen(Fd, Addr, Port, Opts, Protocol, Family, Type, Module) -> %% socket stat %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-spec i() -> ok. i() -> i(tcp), i(udp), i(sctp). +-spec i(socket_protocol()) -> ok. i(Proto) -> i(Proto, [port, module, recv, sent, owner, local_address, foreign_address, state, type]). +-spec i(socket_protocol(), [atom()]) -> ok. i(tcp, Fs) -> ii(tcp_sockets(), Fs, tcp); i(udp, Fs) -> diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index 7beaadb1d6..0709a6e766 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. diff --git a/lib/kernel/test/global_SUITE.erl b/lib/kernel/test/global_SUITE.erl index 0a7f73c344..0e7b7adc47 100644 --- a/lib/kernel/test/global_SUITE.erl +++ b/lib/kernel/test/global_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -3470,8 +3470,8 @@ start_procs(Parent, N1, N2, N3, Config) -> Pid6 = rpc:call(N3, ?MODULE, start_proc3, [test4]), assert_pid(Pid6), yes = global:register_name(test1, Pid3), - yes = global:register_name(test2, Pid4, {global, notify_all_name}), - yes = global:register_name(test3, Pid5, {global, random_notify_name}), + yes = global:register_name(test2, Pid4, fun global:notify_all_name/3), + yes = global:register_name(test3, Pid5, fun global:random_notify_name/3), Resolve = fun(Name, Pid1, Pid2) -> Parent ! {resolve_called, Name, node()}, {Min, Max} = minmax(Pid1, Pid2), @@ -3546,7 +3546,7 @@ start_proc_basic(Name) -> end. init_proc_basic(Parent, Name) -> - X = global:register_name(Name, self(), {?MODULE, fix_basic_name}), + X = global:register_name(Name, self(), fun ?MODULE:fix_basic_name/3), Parent ! {self(),X}, loop(). @@ -3791,15 +3791,6 @@ stop() -> test_server:stop_node(Node) end, nodes()). -dbg_logs(Name) -> dbg_logs(Name, ?NODES). - -dbg_logs(Name, Nodes) -> - lists:foreach(fun(N) -> - F = lists:concat([Name, ".log.", N, ".txt"]), - ok = sys:log_to_file({global_name_server, N}, F) - end, Nodes). - - %% Tests that locally loaded nodes do not loose contact with other nodes. global_lost_nodes(Config) when is_list(Config) -> Timeout = 60, diff --git a/lib/observer/include/etop.hrl b/lib/observer/include/etop.hrl index 002937e522..f8d370450b 100644 --- a/lib/observer/include/etop.hrl +++ b/lib/observer/include/etop.hrl @@ -18,4 +18,4 @@ %% %CopyrightEnd% %% --include("../../runtime_tools/include/observer_backend.hrl"). +-include_lib("runtime_tools/include/observer_backend.hrl"). diff --git a/lib/observer/src/cdv_detail_wx.erl b/lib/observer/src/cdv_detail_wx.erl index f6d282638a..6c4739042b 100644 --- a/lib/observer/src/cdv_detail_wx.erl +++ b/lib/observer/src/cdv_detail_wx.erl @@ -48,6 +48,7 @@ init([Id, Data, ParentFrame, Callback, App, Parent]) -> display_progress(ParentFrame,App), case Callback:get_details(Id, Data) of {ok,Details} -> + display_progress_pulse(Callback,Id), init(Id,ParentFrame,Callback,App,Parent,Details); {yes_no, Info, Fun} -> destroy_progress(App), @@ -69,8 +70,16 @@ display_progress(ParentFrame,cdv) -> "Reading data"); display_progress(_,_) -> ok. + +%% Display pulse while creating process detail page with much data +display_progress_pulse(cdv_proc_cb,Pid) -> + observer_lib:report_progress({ok,"Displaying data for "++Pid}), + observer_lib:report_progress({ok,start_pulse}); +display_progress_pulse(_,_) -> + ok. + destroy_progress(cdv) -> - observer_lib:destroy_progress_dialog(); + observer_lib:sync_destroy_progress_dialog(); destroy_progress(_) -> ok. diff --git a/lib/observer/src/cdv_info_wx.erl b/lib/observer/src/cdv_info_wx.erl index 7e416dd11a..07c28610e2 100644 --- a/lib/observer/src/cdv_info_wx.erl +++ b/lib/observer/src/cdv_info_wx.erl @@ -95,6 +95,10 @@ handle_cast(Msg, State) -> io:format("~p~p: Unhandled cast ~tp~n",[?MODULE, ?LINE, Msg]), {noreply, State}. +handle_event(#wx{obj=MoreEntry,event=#wxMouse{type=left_down},userData={more,More}}, State) -> + observer_lib:add_scroll_entries(MoreEntry,More), + {noreply, State}; + handle_event(#wx{event=#wxMouse{type=left_down},userData=Target}, State) -> cdv_virtual_list_wx:start_detail_win(Target), {noreply, State}; diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index f197e72b90..bba97624a7 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -1240,7 +1240,7 @@ all_procinfo(Fd,Fun,Proc,WS,LineHead) -> "Last calls" -> get_procinfo(Fd,Fun,Proc#proc{last_calls=get_last_calls(Fd)},WS); "Link list" -> - {Links,Monitors,MonitoredBy} = parse_link_list(bytes(Fd),[],[],[]), + {Links,Monitors,MonitoredBy} = get_link_list(Fd), get_procinfo(Fd,Fun,Proc#proc{links=Links, monitors=Monitors, mon_by=MonitoredBy},WS); @@ -1322,86 +1322,64 @@ get_last_calls(Fd,<<>>,Acc,Lines) -> lists:reverse(Lines,[byte_list_to_string(lists:reverse(Acc))]) end. -parse_link_list([SB|Str],Links,Monitors,MonitoredBy) when SB==$[; SB==$] -> - parse_link_list(Str,Links,Monitors,MonitoredBy); -parse_link_list("#Port"++_=Str,Links,Monitors,MonitoredBy) -> - {Link,Rest} = parse_port(Str), - parse_link_list(Rest,[Link|Links],Monitors,MonitoredBy); -parse_link_list("<"++_=Str,Links,Monitors,MonitoredBy) -> - {Link,Rest} = parse_pid(Str), - parse_link_list(Rest,[Link|Links],Monitors,MonitoredBy); -parse_link_list("{to,"++Str,Links,Monitors,MonitoredBy) -> - {Mon,Rest} = parse_monitor(Str), - parse_link_list(Rest,Links,[Mon|Monitors],MonitoredBy); -parse_link_list("{from,"++Str,Links,Monitors,MonitoredBy) -> - {Mon,Rest} = parse_monitor(Str), - parse_link_list(Rest,Links,Monitors,[Mon|MonitoredBy]); -parse_link_list(", "++Rest,Links,Monitors,MonitoredBy) -> - parse_link_list(Rest,Links,Monitors,MonitoredBy); -parse_link_list([],Links,Monitors,MonitoredBy) -> - {lists:reverse(Links),lists:reverse(Monitors),lists:reverse(MonitoredBy)}; -parse_link_list(Unexpected,Links,Monitors,MonitoredBy) -> - io:format("WARNING: found unexpected data in link list:~n~ts~n",[Unexpected]), - parse_link_list([],Links,Monitors,MonitoredBy). - - -parse_port(Str) -> - {Port,Rest} = parse_link(Str,[]), - {{Port,Port},Rest}. - -parse_pid(Str) -> - {Pid,Rest} = parse_link(Str,[]), - {{Pid,Pid},Rest}. - -parse_monitor("{"++Str) -> - %% Named process - {Name,Node,Rest1} = parse_name_node(Str,[]), - Pid = get_pid_from_name(Name,Node), - case parse_link(string:trim(Rest1,leading,","),[]) of - {Ref,"}"++Rest2} -> - %% Bug in break.c - prints an extra "}" for remote - %% nodes... thus the strip - {{Pid,"{"++Name++","++Node++"} ("++Ref++")"}, - string:trim(Rest2,leading,"}")}; - {Ref,[]} -> - {{Pid,"{"++Name++","++Node++"} ("++Ref++")"},[]} - end; -parse_monitor(Str) -> - case parse_link(Str,[]) of - {Pid,","++Rest1} -> - case parse_link(Rest1,[]) of - {Ref,"}"++Rest2} -> - {{Pid,Pid++" ("++Ref++")"},Rest2}; - {Ref,[]} -> - {{Pid,Pid++" ("++Ref++")"},[]} - end; - {Pid,[]} -> - {{Pid,Pid++" (unknown_ref)"},[]} +get_link_list(Fd) -> + case get_chunk(Fd) of + {ok,<<"[",Bin/binary>>} -> + #{links:=Links, + mons:=Monitors, + mon_by:=MonitoredBy} = + get_link_list(Fd,Bin,#{links=>[],mons=>[],mon_by=>[]}), + {lists:reverse(Links), + lists:reverse(Monitors), + lists:reverse(MonitoredBy)}; + eof -> + {[],[],[]} end. -parse_link(">"++Rest,Acc) -> - {lists:reverse(Acc,">"),Rest}; -parse_link([H|T],Acc) -> - parse_link(T,[H|Acc]); -parse_link([],Acc) -> - %% truncated - {lists:reverse(Acc),[]}. +get_link_list(Fd,<<NL:8,_/binary>>=Bin,Acc) when NL=:=$\r; NL=:=$\n-> + skip(Fd,Bin), + Acc; +get_link_list(Fd,Bin,Acc) -> + case binary:split(Bin,[<<", ">>,<<"]">>]) of + [Link,Rest] -> + get_link_list(Fd,Rest,get_link(Link,Acc)); + [Incomplete] -> + case get_chunk(Fd) of + {ok,More} -> + get_link_list(Fd,<<Incomplete/binary,More/binary>>,Acc); + eof -> + Acc + end + end. -parse_name_node(","++Rest,Name) -> - parse_name_node(Rest,Name,[]); -parse_name_node([H|T],Name) -> - parse_name_node(T,[H|Name]); -parse_name_node([],Name) -> - %% truncated - {lists:reverse(Name),[],[]}. - -parse_name_node("}"++Rest,Name,Node) -> - {lists:reverse(Name),lists:reverse(Node),Rest}; -parse_name_node([H|T],Name,Node) -> - parse_name_node(T,Name,[H|Node]); -parse_name_node([],Name,Node) -> - %% truncated - {lists:reverse(Name),lists:reverse(Node),[]}. +get_link(<<"#Port",_/binary>>=PortBin,#{links:=Links}=Acc) -> + PortStr = binary_to_list(PortBin), + Acc#{links=>[{PortStr,PortStr}|Links]}; +get_link(<<"<",_/binary>>=PidBin,#{links:=Links}=Acc) -> + PidStr = binary_to_list(PidBin), + Acc#{links=>[{PidStr,PidStr}|Links]}; +get_link(<<"{to,",Bin/binary>>,#{mons:=Monitors}=Acc) -> + Acc#{mons=>[parse_monitor(Bin)|Monitors]}; +get_link(<<"{from,",Bin/binary>>,#{mon_by:=MonitoredBy}=Acc) -> + Acc#{mon_by=>[parse_monitor(Bin)|MonitoredBy]}; +get_link(Unexpected,Acc) -> + io:format("WARNING: found unexpected data in link list:~n~ts~n",[Unexpected]), + Acc. + +parse_monitor(MonBin) -> + case binary:split(MonBin,[<<",">>,<<"{">>,<<"}">>],[global]) of + [PidBin,RefBin,<<>>] -> + PidStr = binary_to_list(PidBin), + RefStr = binary_to_list(RefBin), + {PidStr,PidStr++" ("++RefStr++")"}; + [<<>>,NameBin,NodeBin,<<>>,RefBin,<<>>] -> + %% Named process + NameStr = binary_to_list(NameBin), + NodeStr = binary_to_list(NodeBin), + PidStr = get_pid_from_name(NameStr,NodeStr), + RefStr = binary_to_list(RefBin), + {PidStr,"{"++NameStr++","++NodeStr++"} ("++RefStr++")"} + end. get_pid_from_name(Name,Node) -> case ets:lookup(cdv_reg_proc_table,cdv_dump_node_name) of @@ -2029,12 +2007,16 @@ all_modinfo(Fd,LM,LineHead,DecodeOpts) -> end. get_attribute(Fd, DecodeOpts) -> + Term = do_get_attribute(Fd, DecodeOpts), + io_lib:format("~tp~n",[Term]). + +do_get_attribute(Fd, DecodeOpts) -> Bytes = bytes(Fd, ""), try get_binary(Bytes, DecodeOpts) of {Bin,_} -> try binary_to_term(Bin) of Term -> - io_lib:format("~tp~n",[Term]) + Term catch _:_ -> {"WARNING: The term is probably truncated!", diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 52e6c3e52a..0678b64134 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -21,7 +21,8 @@ -export([get_wx_parent/1, display_info_dialog/2, display_yes_no_dialog/1, - display_progress_dialog/3, destroy_progress_dialog/0, + display_progress_dialog/3, + destroy_progress_dialog/0, sync_destroy_progress_dialog/0, wait_for_progress/0, report_progress/1, user_term/3, user_term_multiline/3, interval_dialog/4, start_timer/1, start_timer/2, stop_timer/1, timer_config/1, @@ -31,7 +32,8 @@ set_listctrl_col_size/2, create_status_bar/1, html_window/1, html_window/2, - make_obsbin/2 + make_obsbin/2, + add_scroll_entries/2 ]). -include_lib("wx/include/wx.hrl"). @@ -40,6 +42,8 @@ -define(SINGLE_LINE_STYLE, ?wxBORDER_NONE bor ?wxTE_READONLY bor ?wxTE_RICH2). -define(MULTI_LINE_STYLE, ?SINGLE_LINE_STYLE bor ?wxTE_MULTILINE). +-define(NUM_SCROLL_ITEMS,8). + -define(pulse_timeout,50). get_wx_parent(Window) -> @@ -397,17 +401,18 @@ get_box_info({Title, left, List}) -> {Title, ?wxALIGN_LEFT, List}; get_box_info({Title, right, List}) -> {Title, ?wxALIGN_RIGHT, List}. add_box(Panel, OuterBox, Cursor, Title, Proportion, {Format, List}) -> - Box = wxStaticBoxSizer:new(?wxVERTICAL, Panel, [{label, Title}]), + NumStr = " ("++integer_to_list(length(List))++")", + Box = wxStaticBoxSizer:new(?wxVERTICAL, Panel, [{label, Title ++ NumStr}]), Scroll = wxScrolledWindow:new(Panel), wxScrolledWindow:enableScrolling(Scroll,true,true), wxScrolledWindow:setScrollbars(Scroll,1,1,0,0), ScrollSizer = wxBoxSizer:new(?wxVERTICAL), wxScrolledWindow:setSizer(Scroll, ScrollSizer), wxWindow:setBackgroundStyle(Scroll, ?wxBG_STYLE_SYSTEM), - add_entries(Format, List, Scroll, ScrollSizer, Cursor), + Entries = add_entries(Format, List, Scroll, ScrollSizer, Cursor), wxSizer:add(Box,Scroll,[{proportion,1},{flag,?wxEXPAND}]), wxSizer:add(OuterBox,Box,[{proportion,Proportion},{flag,?wxEXPAND}]), - {Scroll,ScrollSizer,length(List)}. + {Scroll,ScrollSizer,length(Entries)}. add_entries(click, List, Scroll, ScrollSizer, Cursor) -> Add = fun(Link) -> @@ -415,7 +420,20 @@ add_entries(click, List, Scroll, ScrollSizer, Cursor) -> wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM), wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}]) end, - [Add(Link) || Link <- List]; + if length(List) > ?NUM_SCROLL_ITEMS -> + {List1,Rest} = lists:split(?NUM_SCROLL_ITEMS,List), + LinkEntries = [Add(Link) || Link <- List1], + NStr = integer_to_list(length(Rest)), + TC = link_entry2(Scroll, + {{more,{Rest,Scroll,ScrollSizer}},"more..."}, + Cursor, + "Click to see " ++ NStr ++ " more entries"), + wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM), + E = wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}]), + LinkEntries ++ [E]; + true -> + [Add(Link) || Link <- List] + end; add_entries(plain, List, Scroll, ScrollSizer, _) -> Add = fun(String) -> TC = wxStaticText:new(Scroll, ?wxID_ANY, String), @@ -423,6 +441,23 @@ add_entries(plain, List, Scroll, ScrollSizer, _) -> end, [Add(String) || String <- List]. +add_scroll_entries(MoreEntry,{List, Scroll, ScrollSizer}) -> + wx:batch( + fun() -> + wxSizer:remove(ScrollSizer,?NUM_SCROLL_ITEMS), + wxStaticText:destroy(MoreEntry), + Cursor = wxCursor:new(?wxCURSOR_HAND), + Add = fun(Link) -> + TC = link_entry(Scroll, Link, Cursor), + wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM), + wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}]) + end, + Entries = [Add(Link) || Link <- List], + wxCursor:destroy(Cursor), + wxSizer:layout(ScrollSizer), + wxSizer:setVirtualSizeHints(ScrollSizer,Scroll), + Entries + end). create_box(_Panel, {scroll_boxes,[]}) -> undefined; @@ -449,7 +484,7 @@ create_box(Panel, {scroll_boxes,Data}) -> {_,H} = wxWindow:getSize(Dummy), wxTextCtrl:destroy(Dummy), - MaxH = if MaxL > 8 -> 8*H; + MaxH = if MaxL > ?NUM_SCROLL_ITEMS -> ?NUM_SCROLL_ITEMS*H; true -> MaxL*H end, [wxWindow:setMinSize(B,{0,MaxH}) || {B,_,_} <- Boxes], @@ -504,20 +539,22 @@ create_box(Parent, Data) -> link_entry(Panel, Link) -> Cursor = wxCursor:new(?wxCURSOR_HAND), - TC = link_entry2(Panel, to_link(Link), Cursor), + TC = link_entry(Panel, Link, Cursor), wxCursor:destroy(Cursor), TC. link_entry(Panel, Link, Cursor) -> - link_entry2(Panel, to_link(Link), Cursor). + link_entry2(Panel,to_link(Link),Cursor). link_entry2(Panel,{Target,Str},Cursor) -> + link_entry2(Panel,{Target,Str},Cursor,"Click to see properties for " ++ Str). +link_entry2(Panel,{Target,Str},Cursor,ToolTipText) -> TC = wxStaticText:new(Panel, ?wxID_ANY, Str), wxWindow:setForegroundColour(TC,?wxBLUE), wxWindow:setCursor(TC, Cursor), wxWindow:connect(TC, left_down, [{userData,Target}]), wxWindow:connect(TC, enter_window), wxWindow:connect(TC, leave_window), - ToolTip = wxToolTip:new("Click to see properties for " ++ Str), + ToolTip = wxToolTip:new(ToolTipText), wxWindow:setToolTip(TC, ToolTip), TC. @@ -708,6 +745,11 @@ wait_for_progress() -> destroy_progress_dialog() -> report_progress(finish). +sync_destroy_progress_dialog() -> + Ref = erlang:monitor(process,?progress_handler), + destroy_progress_dialog(), + receive {'DOWN',Ref,process,_,_} -> ok end. + report_progress(Progress) -> case whereis(?progress_handler) of Pid when is_pid(Pid) -> @@ -787,9 +829,8 @@ progress_dialog_new(Parent,Title,Str) -> [{style,?wxDEFAULT_DIALOG_STYLE}]), Panel = wxPanel:new(Dialog), Sizer = wxBoxSizer:new(?wxVERTICAL), - Message = wxStaticText:new(Panel, 1, Str), - Gauge = wxGauge:new(Panel, 2, 100, [{size, {170, -1}}, - {style, ?wxGA_HORIZONTAL}]), + Message = wxStaticText:new(Panel, 1, Str,[{size,{220,-1}}]), + Gauge = wxGauge:new(Panel, 2, 100, [{style, ?wxGA_HORIZONTAL}]), SizerFlags = ?wxEXPAND bor ?wxLEFT bor ?wxRIGHT bor ?wxTOP, wxSizer:add(Sizer, Message, [{flag,SizerFlags},{border,15}]), wxSizer:add(Sizer, Gauge, [{flag, SizerFlags bor ?wxBOTTOM},{border,15}]), diff --git a/lib/observer/src/observer_port_wx.erl b/lib/observer/src/observer_port_wx.erl index 5908e99e36..f7ae07fb85 100644 --- a/lib/observer/src/observer_port_wx.erl +++ b/lib/observer/src/observer_port_wx.erl @@ -242,6 +242,10 @@ handle_event(#wx{id=?ID_REFRESH_INTERVAL}, Timer = observer_lib:interval_dialog(Grid, Timer0, 10, 5*60), {noreply, State#state{timer=Timer}}; +handle_event(#wx{obj=MoreEntry,event=#wxMouse{type=left_down},userData={more,More}}, State) -> + observer_lib:add_scroll_entries(MoreEntry,More), + {noreply, State}; + handle_event(#wx{event=#wxMouse{type=left_down}, userData=TargetPid}, State) -> observer ! {open_link, TargetPid}, {noreply, State}; diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index 2e5fe0bc1a..1c40afba46 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -27,7 +27,7 @@ handle_event/2, handle_cast/2]). -include_lib("wx/include/wx.hrl"). --include("../include/etop.hrl"). +-include("etop.hrl"). -include("observer_defs.hrl"). -include("etop_defs.hrl"). @@ -572,7 +572,8 @@ change_accum(true, S0) -> S0#holder{accum=true}; change_accum(false, S0=#holder{info=Info}) -> self() ! refresh, - S0#holder{accum=lists:sort(array:to_list(Info))}. + Accum = [{Pid, Reds} || #etop_proc_info{pid=Pid, reds=Reds} <- array:to_list(Info)], + S0#holder{accum=lists:sort(Accum)}. handle_update_old(#etop_info{procinfo=ProcInfo0}, S0=#holder{parent=Parent, sort=Sort=#sort{sort_key=KeyField}}) -> diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 4ce38e439d..6b761cb2ff 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -120,6 +120,10 @@ handle_event(#wx{id=?REFRESH}, #state{frame=Frame, pid=Pid, pages=Pages, expand_ end, {noreply, State}; +handle_event(#wx{obj=MoreEntry,event=#wxMouse{type=left_down},userData={more,More}}, State) -> + observer_lib:add_scroll_entries(MoreEntry,More), + {noreply, State}; + handle_event(#wx{event=#wxMouse{type=left_down}, userData=TargetPid}, State) -> observer ! {open_link, TargetPid}, {noreply, State}; @@ -253,8 +257,6 @@ init_stack_page(Parent, Pid) -> [Pid, current_stacktrace]) of {current_stacktrace,RawBt} -> - observer_wx:try_rpc(node(Pid), erlang, process_info, - [Pid, current_stacktrace]), wxListCtrl:deleteAllItems(LCtrl), wx:foldl(fun({M, F, A, Info}, Row) -> _Item = wxListCtrl:insertItem(LCtrl, Row, ""), diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl index e16f3cab6b..2e387f7e74 100644 --- a/lib/observer/src/observer_tv_wx.erl +++ b/lib/observer/src/observer_tv_wx.erl @@ -38,13 +38,13 @@ -define(ID_SYSTEM_TABLES, 406). -define(ID_TABLE_INFO, 407). -define(ID_SHOW_TABLE, 408). - --record(opt, {type=ets, - sys_hidden=true, - unread_hidden=true, - sort_key=2, - sort_incr=true - }). + +-record(opts, {type=ets, + sys_hidden=true, + unread_hidden=true}). + +-record(sort, {sort_incr=true, + sort_key=2}). -record(state, { @@ -52,9 +52,9 @@ grid, panel, node=node(), - opt=#opt{}, + opts=#opts{}, + holder, selected, - tabs, timer }). @@ -64,8 +64,18 @@ start_link(Notebook, Parent, Config) -> init([Notebook, Parent, Config]) -> Panel = wxPanel:new(Notebook), Sizer = wxBoxSizer:new(?wxVERTICAL), - Style = ?wxLC_REPORT bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES, - Grid = wxListCtrl:new(Panel, [{winid, ?GRID}, {style, Style}]), + + Opts=#opts{type=maps:get(type, Config, ets), + sys_hidden=maps:get(sys_hidden, Config, true), + unread_hidden=maps:get(unread_hidden, Config, true)}, + + Style = ?wxLC_REPORT bor ?wxLC_VIRTUAL bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES, + Self = self(), + Attrs = observer_lib:create_attrs(), + Holder = spawn_link(fun() -> init_table_holder(Self, Attrs) end), + CBs = [{onGetItemText, fun(_, Item,Col) -> get_row(Holder, Item, Col) end}, + {onGetItemAttr, fun(_, Item) -> get_attr(Holder, Item) end}], + Grid = wxListCtrl:new(Panel, [{winid, ?GRID}, {style, Style} | CBs]), wxSizer:add(Sizer, Grid, [{flag, ?wxEXPAND bor ?wxALL}, {proportion, 1}, {border, 5}]), wxWindow:setSizer(Panel, Sizer), @@ -95,38 +105,26 @@ init([Notebook, Parent, Config]) -> wxWindow:setFocus(Grid), {Panel, #state{grid=Grid, parent=Parent, panel=Panel, - timer=Config, - opt=#opt{type=maps:get(type, Config, ets), - sys_hidden=maps:get(sys_hidden, Config, true), - unread_hidden=maps:get(unread_hidden, Config, true)} - }}. + opts=Opts, timer=Config, holder=Holder}}. handle_event(#wx{id=?ID_REFRESH}, - State = #state{node=Node, grid=Grid, opt=Opt}) -> - Tables = get_tables(Node, Opt), - {Tabs,Sel} = update_grid(Grid, sel(State), Opt, Tables), - Sel =/= undefined andalso wxListCtrl:ensureVisible(Grid, Sel), - {noreply, State#state{tabs=Tabs, selected=Sel}}; + State = #state{holder=Holder, node=Node, opts=Opts}) -> + Tables = get_tables(Node, Opts), + Holder ! {refresh, Tables}, + {noreply, State}; handle_event(#wx{event=#wxList{type=command_list_col_click, col=Col}}, - State = #state{node=Node, grid=Grid, - opt=Opt0=#opt{sort_key=Key, sort_incr=Bool}}) -> - Opt = case col2key(Col) of - Key -> Opt0#opt{sort_incr=not Bool}; - NewKey -> Opt0#opt{sort_key=NewKey} - end, - Tables = get_tables(Node, Opt), - {Tabs,Sel} = update_grid(Grid, sel(State), Opt, Tables), - wxWindow:setFocus(Grid), - {noreply, State#state{opt=Opt, tabs=Tabs, selected=Sel}}; + State = #state{holder=Holder}) -> + Holder ! {sort, Col}, + {noreply, State}; -handle_event(#wx{id=Id}, State = #state{node=Node, grid=Grid, opt=Opt0}) +handle_event(#wx{id=Id}, State = #state{node=Node, holder=Holder, grid=Grid, opts=Opt0}) when Id >= ?ID_ETS, Id =< ?ID_SYSTEM_TABLES -> Opt = case Id of - ?ID_ETS -> Opt0#opt{type=ets}; - ?ID_MNESIA -> Opt0#opt{type=mnesia}; - ?ID_UNREADABLE -> Opt0#opt{unread_hidden= not Opt0#opt.unread_hidden}; - ?ID_SYSTEM_TABLES -> Opt0#opt{sys_hidden= not Opt0#opt.sys_hidden} + ?ID_ETS -> Opt0#opts{type=ets}; + ?ID_MNESIA -> Opt0#opts{type=mnesia}; + ?ID_UNREADABLE -> Opt0#opts{unread_hidden= not Opt0#opts.unread_hidden}; + ?ID_SYSTEM_TABLES -> Opt0#opts{sys_hidden= not Opt0#opts.sys_hidden} end, case get_tables2(Node, Opt) of Error = {error, _} -> @@ -135,9 +133,9 @@ handle_event(#wx{id=Id}, State = #state{node=Node, grid=Grid, opt=Opt0}) self() ! Error, {noreply, State}; Tables -> - {Tabs, Sel} = update_grid(Grid, sel(State), Opt, Tables), + Holder ! {refresh, Tables}, wxWindow:setFocus(Grid), - {noreply, State#state{opt=Opt, tabs=Tabs, selected=Sel}} + {noreply, State#state{opts=Opt}} end; handle_event(#wx{event=#wxSize{size={W,_}}}, State=#state{grid=Grid}) -> @@ -146,19 +144,18 @@ handle_event(#wx{event=#wxSize{size={W,_}}}, State=#state{grid=Grid}) -> handle_event(#wx{event=#wxList{type=command_list_item_activated, itemIndex=Index}}, - State=#state{grid=Grid, node=Node, opt=#opt{type=Type}, tabs=Tabs}) -> - Table = lists:nth(Index+1, Tabs), - case Table#tab.protection of - private -> - self() ! {error, "Table has 'private' protection and can not be read"}; - _ -> - observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]) + State=#state{holder=Holder, node=Node, opts=#opts{type=Type}, grid=Grid}) -> + case get_table(Holder, Index) of + #tab{protection=private} -> + self() ! {error, "Table has 'private' protection and can not be read"}; + #tab{}=Table -> + observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]); + _ -> ignore end, {noreply, State}; handle_event(#wx{event=#wxList{type=command_list_item_right_click}}, State=#state{panel=Panel}) -> - Menu = wxMenu:new(), wxMenu:append(Menu, ?ID_TABLE_INFO, "Table info"), wxMenu:append(Menu, ?ID_SHOW_TABLE, "Show Table Content"), @@ -167,32 +164,33 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click}}, {noreply, State}; handle_event(#wx{event=#wxList{type=command_list_item_selected, itemIndex=Index}}, - State) -> + State=#state{holder=Holder}) -> + Holder ! {selected, Index}, {noreply, State#state{selected=Index}}; handle_event(#wx{id=?ID_TABLE_INFO}, - State = #state{grid=Grid, node=Node, opt=#opt{type=Type}, tabs=Tabs, selected=Sel}) -> + State = #state{holder=Holder, grid=Grid, node=Node, opts=#opts{type=Type}, selected=Sel}) -> case Sel of undefined -> {noreply, State}; R when is_integer(R) -> - Table = lists:nth(Sel+1, Tabs), + Table = get_table(Holder, Sel), display_table_info(Grid, Node, Type, Table), {noreply, State} end; handle_event(#wx{id=?ID_SHOW_TABLE}, - State=#state{grid=Grid, node=Node, opt=#opt{type=Type}, tabs=Tabs, selected=Sel}) -> + State=#state{holder=Holder, grid=Grid, node=Node, opts=#opts{type=Type}, selected=Sel}) -> case Sel of undefined -> {noreply, State}; R when is_integer(R) -> - Table = lists:nth(Sel+1, Tabs), - case Table#tab.protection of - private -> + case get_table(Holder, R) of + #tab{protection=private} -> self() ! {error, "Table has 'private' protection and can not be read"}; - _ -> - observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]) + #tab{}=Table -> + observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]); + _ -> ignore end, {noreply, State} end; @@ -202,14 +200,14 @@ handle_event(#wx{id=?ID_REFRESH_INTERVAL}, Timer = observer_lib:interval_dialog(Grid, Timer0, 10, 5*60), {noreply, State#state{timer=Timer}}; -handle_event(Event, _State) -> - error({unhandled_event, Event}). +handle_event(_Event, State) -> + {noreply, State}. handle_sync_event(_Event, _Obj, _State) -> ok. -handle_call(get_config, _, #state{timer=Timer, opt=Opt}=State) -> - #opt{type=Type, sys_hidden=Sys, unread_hidden=Unread} = Opt, +handle_call(get_config, _, #state{timer=Timer, opts=Opt}=State) -> + #opts{type=Type, sys_hidden=Sys, unread_hidden=Unread} = Opt, Conf0 = observer_lib:timer_config(Timer), Conf = Conf0#{type=>Type, sys_hidden=>Sys, unread_hidden=>Unread}, {reply, Conf, State}; @@ -220,50 +218,68 @@ handle_call(Event, From, _State) -> handle_cast(Event, _State) -> error({unhandled_cast, Event}). -handle_info(refresh_interval, State = #state{node=Node, grid=Grid, opt=Opt, - tabs=OldTabs}) -> - case get_tables(Node, Opt) of - OldTabs -> - %% no change - {noreply, State}; - Tables -> - {Tabs, Sel} = update_grid(Grid, sel(State), Opt, Tables), - Sel =/= undefined andalso wxListCtrl:ensureVisible(Grid, Sel), - {noreply, State#state{tabs=Tabs, selected=Sel}} - end; +handle_info(refresh_interval, State = #state{holder=Holder, node=Node, opts=Opt}) -> + Tables = get_tables(Node, Opt), + Holder ! {refresh, Tables}, + {noreply, State}; -handle_info({active, Node}, State = #state{parent=Parent, grid=Grid, opt=Opt0, - timer=Timer0}) -> - {Tables, Opt} = case Opt0#opt.type =:= mnesia andalso get_tables2(Node, Opt0) of +handle_info({active, Node}, State = #state{parent=Parent, holder=Holder, grid=Grid, + opts=Opt0, timer=Timer0}) -> + {Tables, Opt} = case Opt0#opts.type =:= mnesia andalso get_tables2(Node, Opt0) of Ts when is_list(Ts) -> {Ts, Opt0}; _ -> % false or error getting mnesia tables - Opt1 = Opt0#opt{type=ets}, + Opt1 = Opt0#opts{type=ets}, {get_tables(Node, Opt1), Opt1} end, - {Tabs,Sel} = update_grid(Grid, sel(State), Opt, Tables), + Holder ! {refresh, Tables}, wxWindow:setFocus(Grid), create_menus(Parent, Opt), Timer = observer_lib:start_timer(Timer0, 10), - {noreply, State#state{node=Node, tabs=Tabs, timer=Timer, opt=Opt, selected=Sel}}; + {noreply, State#state{node=Node, timer=Timer, opts=Opt}}; handle_info(not_active, State = #state{timer = Timer0}) -> Timer = observer_lib:stop_timer(Timer0), {noreply, State#state{timer=Timer}}; -handle_info({error, Error}, #state{panel=Panel,opt=Opt}=State) -> +handle_info({error, Error}, #state{panel=Panel,opts=Opt}=State) -> Str = io_lib:format("ERROR: ~ts~n",[Error]), observer_lib:display_info_dialog(Panel,Str), - case Opt#opt.type of + case Opt#opts.type of mnesia -> wxMenuBar:check(observer_wx:get_menubar(), ?ID_ETS, true); _ -> ok end, - {noreply, State#state{opt=Opt#opt{type=ets}}}; + {noreply, State#state{opts=Opt#opts{type=ets}}}; + +handle_info({refresh, Min, Min}, State = #state{grid=Grid}) -> + wxListCtrl:setItemCount(Grid, Min+1), + wxListCtrl:refreshItem(Grid, Min), %% Avoid assert in wx below if Max is 0 + observer_wx:set_status(io_lib:format("Tables: ~w", [Min+1])), + {noreply, State}; +handle_info({refresh, Min, Max}, State = #state{grid=Grid}) -> + wxListCtrl:setItemCount(Grid, Max+1), + Max > 0 andalso wxListCtrl:refreshItems(Grid, Min, Max), + observer_wx:set_status(io_lib:format("Tables: ~w", [Max+1])), + {noreply, State}; + +handle_info({selected, New, Size}, #state{grid=Grid, selected=Old} = State) -> + if + is_integer(Old), Old < Size -> + wxListCtrl:setItemState(Grid, Old, 0, ?wxLIST_STATE_SELECTED); + true -> ignore + end, + if is_integer(New) -> + wxListCtrl:setItemState(Grid, New, 16#FFFF, ?wxLIST_STATE_SELECTED), + wxListCtrl:ensureVisible(Grid, New); + true -> ignore + end, + {noreply, State#state{selected=New}}; handle_info(_Event, State) -> {noreply, State}. -terminate(_Event, _State) -> +terminate(_Event, #state{holder=Holder}) -> + Holder ! stop, ok. code_change(_, _, State) -> @@ -271,7 +287,7 @@ code_change(_, _, State) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -create_menus(Parent, #opt{sys_hidden=Sys, unread_hidden=UnR, type=Type}) -> +create_menus(Parent, #opts{sys_hidden=Sys, unread_hidden=UnR, type=Type}) -> MenuEntries = [{"View", [#create_menu{id = ?ID_TABLE_INFO, text = "Table information\tCtrl-I"}, separator, @@ -298,7 +314,7 @@ get_tables(Node, Opts) -> Res -> Res end. -get_tables2(Node, #opt{type=Type, sys_hidden=Sys, unread_hidden=Unread}) -> +get_tables2(Node, #opts{type=Type, sys_hidden=Sys, unread_hidden=Unread}) -> Args = [Type, [{sys_hidden,Sys}, {unread_hidden,Unread}]], case rpc:call(Node, observer_backend, get_table_list, Args) of {badrpc, Error} -> @@ -386,49 +402,134 @@ list_to_strings([A]) -> integer_to_list(A); list_to_strings([A|B]) -> integer_to_list(A) ++ " ," ++ list_to_strings(B). -update_grid(Grid, Selected, Opt, Tables) -> - wx:batch(fun() -> update_grid2(Grid, Selected, Opt, Tables) end). - -update_grid2(Grid, {SelName,SelId}, #opt{sort_key=Sort,sort_incr=Dir}, Tables) -> - wxListCtrl:deleteAllItems(Grid), - Update = - fun(#tab{name = Name, id = Id, owner = Owner, size = Size, memory = Memory, - protection = Protection, reg_name = RegName}, - {Row, Sel}) -> - _Item = wxListCtrl:insertItem(Grid, Row, ""), - if (Row rem 2) =:= 0 -> - wxListCtrl:setItemBackgroundColour(Grid, Row, ?BG_EVEN); - true -> ignore - end, - if Protection == private -> - wxListCtrl:setItemTextColour(Grid, Row, {200,130,50}); - true -> ignore - end, - - lists:foreach(fun({_, ignore}) -> ignore; - ({Col, Val}) -> - wxListCtrl:setItem(Grid, Row, Col, observer_lib:to_str(Val)) - end, - [{0,Name}, {1,Size}, {2, Memory div 1024}, - {3,Owner}, {4,RegName}, {5,Id}]), - if SelName =:= Name, SelId =:= Id -> - wxListCtrl:setItemState(Grid, Row, 16#FFFF, ?wxLIST_STATE_SELECTED), - {Row+1, Row}; - true -> - wxListCtrl:setItemState(Grid, Row, 0, ?wxLIST_STATE_SELECTED), - {Row+1, Sel} - end - end, - ProcInfo = case Dir of - false -> lists:reverse(lists:keysort(Sort, Tables)); - true -> lists:keysort(Sort, Tables) - end, - {_, Sel} = lists:foldl(Update, {0, undefined}, ProcInfo), - {ProcInfo, Sel}. - -sel(#state{selected=Sel, tabs=Tabs}) -> - try lists:nth(Sel+1, Tabs) of - #tab{name=Name, id=Id} -> {Name, Id} - catch _:_ -> - {undefined, undefined} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Table holder needs to be in a separate process otherwise +%% the callback get_row/3 may deadlock if the process do +%% wx calls when callback is invoked. + +get_table(Table, Item) -> + get_row(Table, Item, all). + +get_row(Table, Item, Column) -> + Ref = erlang:monitor(process, Table), + Table ! {get_row, self(), Item, Column}, + receive + {'DOWN', Ref, _, _, _} -> ""; + {Table, Res} -> + erlang:demonitor(Ref), + Res end. + +get_attr(Table, Item) -> + Ref = erlang:monitor(process, Table), + Table ! {get_attr, self(), Item}, + receive + {'DOWN', Ref, _, _, _} -> wx:null(); + {Table, Res} -> + erlang:demonitor(Ref), + Res + end. + +-record(holder, {node, parent, pid, + tabs=array:new(), + sort=#sort{}, + attrs, + sel + }). + +init_table_holder(Parent, Attrs) -> + Parent ! refresh, + table_holder(#holder{node=node(), parent=Parent, attrs=Attrs}). + +table_holder(S0 = #holder{parent=Parent, tabs=Tabs0, sel=Sel0}) -> + receive + {get_attr, From, Row} -> + get_attr(From, Row, S0), + table_holder(S0); + {get_row, From, Row, Col} -> + get_row(From, Row, Col, Tabs0), + table_holder(S0); + {sort, Col} -> + STab = get_sel(Sel0, Tabs0), + Parent ! {refresh, 0, array:size(Tabs0)-1}, + S1 = sort(col2key(Col), S0), + Sel = sel_idx(STab, S1#holder.tabs), + Parent ! {selected, Sel, array:size(Tabs0)}, + table_holder(S1#holder{sel=Sel}); + {refresh, Tabs1} -> + STab = get_sel(Sel0, Tabs0), + Tabs = case S0#holder.sort of + #sort{sort_incr=false, sort_key=Col} -> + array:from_list(lists:reverse(lists:keysort(Col, Tabs1))); + #sort{sort_key=Col} -> + array:from_list(lists:keysort(Col, Tabs1)) + end, + Parent ! {refresh, 0, array:size(Tabs)-1}, + Sel = sel_idx(STab, Tabs), + Parent ! {selected, Sel,array:size(Tabs)}, + table_holder(S0#holder{tabs=Tabs, sel=Sel}); + {selected, Sel} -> + table_holder(S0#holder{sel=Sel}); + stop -> + ok; + What -> + io:format("Table holder got ~tp~n",[What]), + Parent ! {refresh, 0, array:size(Tabs0)-1}, + table_holder(S0) + end. + +get_sel(undefined, _Tabs) -> + undefined; +get_sel(Idx, Tabs) -> + array:get(Idx, Tabs). + +sel_idx(undefined, _Tabs) -> + undefined; +sel_idx(Tab, Tabs) -> + Find = fun(Idx, C, Acc) -> C =:= Tab andalso throw({found, Idx}), Acc end, + try array:foldl(Find, undefined, Tabs) + catch {found, Idx} -> Idx + end. + +sort(Col, #holder{sort=#sort{sort_key=Col, sort_incr=Incr}=S, tabs=Table0}=H) -> + Table = lists:reverse(array:to_list(Table0)), + H#holder{sort=S#sort{sort_incr=(not Incr)}, + tabs=array:from_list(Table)}; +sort(Col, #holder{sort=#sort{sort_incr=Incr}=S, tabs=Table0}=H) -> + Table = case Incr of + false -> lists:reverse(lists:keysort(Col, array:to_list(Table0))); + true -> lists:keysort(Col, array:to_list(Table0)) + end, + H#holder{sort=S#sort{sort_key=Col}, + tabs=array:from_list(Table)}. + +get_row(From, Row, Col, Table) -> + Object = array:get(Row, Table), + From ! {self(), get_col(Col, Object)}. + +get_col(all, Rec) -> + Rec; +get_col(2, #tab{}=Rec) -> %% Memory in kB + observer_lib:to_str(element(#tab.memory, Rec) div 1024); +get_col(Col, #tab{}=Rec) -> + case element(col2key(Col), Rec) of + ignore -> ""; + Val -> observer_lib:to_str(Val) + end; +get_col(_, _) -> + "". + +get_attr(From, Row, #holder{tabs=Tabs, attrs=Attrs}) -> + EvenOdd = case (Row rem 2) > 0 of + true -> Attrs#attrs.odd; + false -> Attrs#attrs.even + end, + What = try array:get(Row, Tabs) of + #tab{protection=private} -> + Attrs#attrs.deleted; + _ -> + EvenOdd + catch _ -> + EvenOdd + end, + From ! {self(), What}. diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index bb1755f530..b5e94a893a 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -83,6 +83,7 @@ n1_proc(Creator,_N2,Pid2,Port2,_L) -> link(OtherPid), % own node link(Pid2), % external node erlang:monitor(process,OtherPid), + erlang:monitor(process,init), % named process erlang:monitor(process,Pid2), code:load_file(?MODULE), diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 9fbd1a62a4..32773a779e 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -459,6 +459,27 @@ special(File,Procs) -> old_attrib=undefined, old_comp_info=undefined}=Mod2, ok; + ".trunc_mod" -> + ModName = atom_to_list(?helper_mod), + {ok,Mod=#loaded_mod{},[TW]} = + crashdump_viewer:loaded_mod_details(ModName), + "WARNING: The crash dump is truncated here."++_ = TW, + #loaded_mod{current_attrib=CA,current_comp_info=CCI, + old_attrib=OA,old_comp_info=OCI} = Mod, + case lists:all(fun(undefined) -> + true; + (S) when is_list(S) -> + io_lib:printable_unicode_list(lists:flatten(S)); + (_) -> false + end, + [CA,CCI,OA,OCI]) of + true -> + ok; + false -> + ct:fail({should_be_printable_strings_or_undefined, + {CA,CCI,OA,OCI}}) + end, + ok; ".trunc_bin1" -> %% This is 'full_dist' truncated after the first %% "=binary:" @@ -658,13 +679,32 @@ do_create_dumps(DataDir,Rel) -> CD5 = dump_with_size_limit_reached(DataDir,Rel,"trunc_bytes"), CD6 = dump_with_unicode_atoms(DataDir,Rel,"unicode"), CD7 = dump_with_maps(DataDir,Rel,"maps"), - TruncatedDumps = truncate_dump(CD1), - {[CD1,CD2,CD3,CD4,CD5,CD6,CD7|TruncatedDumps], DosDump}; + TruncDumpMod = truncate_dump_mod(CD1), + TruncatedDumpsBinary = truncate_dump_binary(CD1), + {[CD1,CD2,CD3,CD4,CD5,CD6,CD7,TruncDumpMod|TruncatedDumpsBinary], + DosDump}; _ -> {[CD1,CD2], DosDump} end. -truncate_dump(File) -> +truncate_dump_mod(File) -> + {ok,Bin} = file:read_file(File), + ModNameBin = atom_to_binary(?helper_mod,latin1), + NewLine = case os:type() of + {win32,_} -> <<"\r\n">>; + _ -> <<"\n">> + end, + RE = <<NewLine/binary,"=mod:",ModNameBin/binary, + NewLine/binary,"Current size: [0-9]*", + NewLine/binary,"Current attributes: ...">>, + {match,[{Pos,Len}]} = re:run(Bin,RE), + Size = Pos + Len, + <<Truncated:Size/binary,_/binary>> = Bin, + DumpName = filename:rootname(File) ++ ".trunc_mod", + file:write_file(DumpName,Truncated), + DumpName. + +truncate_dump_binary(File) -> {ok,Bin} = file:read_file(File), BinTag = <<"\n=binary:">>, Colon = <<":">>, diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl index 0db2c1ea77..fd4f93f662 100644 --- a/lib/observer/test/observer_SUITE.erl +++ b/lib/observer/test/observer_SUITE.erl @@ -113,7 +113,12 @@ appup_file(Config) when is_list(Config) -> basic(suite) -> []; basic(doc) -> [""]; basic(Config) when is_list(Config) -> - timer:send_after(100, "foobar"), %% Otherwise the timer server gets added to procs + %% Start these before + wx:new(), + wx:destroy(), + timer:send_after(100, "foobar"), + {foo, node@machine} ! dummy_msg, %% start distribution stuff + %% Otherwise ever lasting servers gets added to procs ProcsBefore = processes(), ProcInfoBefore = [{P,process_info(P)} || P <- ProcsBefore], NumProcsBefore = length(ProcsBefore), diff --git a/lib/public_key/asn1/PKCS-7.asn1 b/lib/public_key/asn1/PKCS-7.asn1 index e76f928acb..e9c188be39 100644 --- a/lib/public_key/asn1/PKCS-7.asn1 +++ b/lib/public_key/asn1/PKCS-7.asn1 @@ -124,7 +124,7 @@ SignerInfoAuthenticatedAttributes ::= CHOICE { -- Also defined in X.509 -- Redeclared here as a parameterized type -AlgorithmIdentifierPKSC-7 {ALGORITHM:IOSet} ::= SEQUENCE { +AlgorithmIdentifierPKCS-7 {ALGORITHM:IOSet} ::= SEQUENCE { algorithm ALGORITHM.&id({IOSet}), parameters ALGORITHM.&Type({IOSet}{@algorithm}) OPTIONAL } @@ -146,21 +146,21 @@ CRLSequence ::= SEQUENCE OF CertificateList ContentEncryptionAlgorithmIdentifier ::= - AlgorithmIdentifierPKSC-7 {{ContentEncryptionAlgorithms}} + AlgorithmIdentifierPKCS-7 {{ContentEncryptionAlgorithms}} ContentEncryptionAlgorithms ALGORITHM ::= { ... -- add any application-specific algorithms here } DigestAlgorithmIdentifier ::= - AlgorithmIdentifierPKSC-7 {{DigestAlgorithms}} + AlgorithmIdentifierPKCS-7 {{DigestAlgorithms}} DigestAlgorithms ALGORITHM ::= { ... -- add any application-specific algorithms here } DigestEncryptionAlgorithmIdentifier ::= - AlgorithmIdentifierPKSC-7 {{DigestEncryptionAlgorithms}} + AlgorithmIdentifierPKCS-7 {{DigestEncryptionAlgorithms}} DigestEncryptionAlgorithms ALGORITHM ::= { ... -- add any application-specific algorithms here @@ -182,7 +182,7 @@ IssuerAndSerialNumber ::= SEQUENCE { } KeyEncryptionAlgorithmIdentifier ::= - AlgorithmIdentifierPKSC-7 {{KeyEncryptionAlgorithms}} + AlgorithmIdentifierPKCS-7 {{KeyEncryptionAlgorithms}} KeyEncryptionAlgorithms ALGORITHM ::= { ... -- add any application-specific algorithms here diff --git a/lib/runtime_tools/src/system_information.erl b/lib/runtime_tools/src/system_information.erl index 92109c9a74..119d7cc3d4 100644 --- a/lib/runtime_tools/src/system_information.erl +++ b/lib/runtime_tools/src/system_information.erl @@ -75,43 +75,37 @@ load_report(file, File) -> load_report(data, from_file(File)); load_report(data, Report) -> ok = start_internal(), gen_server:call(?SERVER, {load_report, Report}, infinity). -report() -> [ - {init_arguments, init:get_arguments()}, - {code_paths, code:get_path()}, - {code, code()}, - {system_info, erlang_system_info()}, - {erts_compile_info, erlang:system_info(compile_info)}, - {beam_dynamic_libraries, get_dynamic_libraries()}, - {environment_erts, os_getenv_erts_specific()}, - {environment, [split_env(Env) || Env <- os:getenv()]}, - {sanity_check, sanity_check()} - ]. +report() -> + %% This is ugly but beats having to maintain two distinct implementations, + %% and we don't really care about memory use since it's internal and + %% undocumented. + {ok, Fd} = file:open([], [ram, read, write]), + to_fd(Fd), + {ok, _} = file:position(Fd, bof), + from_fd(Fd). -spec to_file(FileName) -> ok | {error, Reason} when FileName :: file:name_all(), Reason :: file:posix() | badarg | terminated | system_limit. to_file(File) -> - file:write_file(File, iolist_to_binary([ - io_lib:format("{system_information_version, ~p}.~n", [ - ?REPORT_FILE_VSN - ]), - io_lib:format("{system_information, ~p}.~n", [ - report() - ]) - ])). + case file:open(File, [raw, write, binary, delayed_write]) of + {ok, Fd} -> + try + to_fd(Fd) + after + file:close(Fd) + end; + {error, Reason} -> + {error, Reason} + end. from_file(File) -> - case file:consult(File) of - {ok, Data} -> - case get_value([system_information_version], Data) of - ?REPORT_FILE_VSN -> - get_value([system_information], Data); - Vsn -> - erlang:error({unknown_version, Vsn}) - end; - _ -> - erlang:error(bad_report_file) + {ok, Fd} = file:open(File, [raw, read]), + try + from_fd(Fd) + after + file:close(Fd) end. applications() -> applications([]). @@ -457,61 +451,151 @@ split_env([$=|Vs], Key) -> {lists:reverse(Key), Vs}; split_env([I|Vs], Key) -> split_env(Vs, [I|Key]); split_env([], KV) -> lists:reverse(KV). % should not happen. -%% get applications +from_fd(Fd) -> + try + [{system_information_version, "1.0"}, + {system_information, Data}] = consult_fd(Fd), + Data + catch + _:_ -> erlang:error(bad_report_file) + end. -code() -> - % order is important - get_code_from_paths(code:get_path()). +consult_fd(Fd) -> + consult_fd_1(Fd, [], {ok, []}). +consult_fd_1(Fd, Cont0, ReadResult) -> + Data = + case ReadResult of + {ok, Characters} -> Characters; + eof -> eof + end, + case erl_scan:tokens(Cont0, Data, 1) of + {done, {ok, Tokens, _}, Next} -> + {ok, Term} = erl_parse:parse_term(Tokens), + [Term | consult_fd_1(Fd, [], {ok, Next})]; + {more, Cont} -> + consult_fd_1(Fd, Cont, file:read(Fd, 1 bsl 20)); + {done, {eof, _}, eof} -> [] + end. -get_code_from_paths([]) -> []; -get_code_from_paths([Path|Paths]) -> - case is_application_path(Path) of - true -> - [{application, get_application_from_path(Path)}|get_code_from_paths(Paths)]; - false -> - [{code, [ - {path, Path}, - {modules, get_modules_from_path(Path)} - ]}|get_code_from_paths(Paths)] +%% +%% Dumps a system_information tuple to the given Fd, writing the term in chunks +%% to avoid eating too much memory on large systems. +%% + +to_fd(Fd) -> + EmitChunk = + fun(Format, Args) -> + ok = file:write(Fd, io_lib:format(Format, Args)) + end, + + EmitChunk("{system_information_version, ~p}.~n" + "{system_information,[" + "{init_arguments,~p}," + "{code_paths,~p},", + [?REPORT_FILE_VSN, + init:get_arguments(), + code:get_path()]), + + emit_code_info(EmitChunk), + + EmitChunk( "," %% Note the leading comma! + "{system_info,~p}," + "{erts_compile_info,~p}," + "{beam_dynamic_libraries,~p}," + "{environment_erts,~p}," + "{environment,~p}," + "{sanity_check,~p}" + "]}.~n", + [erlang_system_info(), + erlang:system_info(compile_info), + get_dynamic_libraries(), + os_getenv_erts_specific(), + [split_env(Env) || Env <- os:getenv()], + sanity_check()]). + +%% Emits all modules/applications in the *code path order* +emit_code_info(EmitChunk) -> + EmitChunk("{code, [", []), + comma_separated_foreach(EmitChunk, + fun(Path) -> + case is_application_path(Path) of + true -> emit_application_info(EmitChunk, Path); + false -> emit_code_path_info(EmitChunk, Path) + end + end, code:get_path()), + EmitChunk("]}", []). + +emit_application_info(EmitChunk, Path) -> + [Appfile|_] = filelib:wildcard(filename:join(Path, "*.app")), + case file:consult(Appfile) of + {ok, [{application, App, Info}]} -> + RtDeps = proplists:get_value(runtime_dependencies, Info, []), + Description = proplists:get_value(description, Info, []), + Version = proplists:get_value(vsn, Info, []), + + EmitChunk("{application, {~p,[" + "{description,~p}," + "{vsn,~p}," + "{path,~p}," + "{runtime_dependencies,~p},", + [App, Description, Version, Path, RtDeps]), + emit_module_info_from_path(EmitChunk, Path), + EmitChunk("]}}", []) end. +emit_code_path_info(EmitChunk, Path) -> + EmitChunk("{code, [" + "{path, ~p},", [Path]), + emit_module_info_from_path(EmitChunk, Path), + EmitChunk("]}", []). + +emit_module_info_from_path(EmitChunk, Path) -> + BeamFiles = filelib:wildcard(filename:join(Path, "*.beam")), + + EmitChunk("{modules, [", []), + comma_separated_foreach(EmitChunk, + fun(Beam) -> + emit_module_info(EmitChunk, Beam) + end, BeamFiles), + EmitChunk("]}", []). + +emit_module_info(EmitChunk, Beam) -> + %% FIXME: The next three calls load *all* significant chunks onto the heap, + %% which may cause us to run out of memory if there's a huge module in the + %% code path. + {ok,{Mod, Md5}} = beam_lib:md5(Beam), + + CompilerVersion = get_compiler_version(Beam), + Native = beam_is_native_compiled(Beam), + + Loaded = case code:is_loaded(Mod) of + false -> false; + _ -> true + end, + + EmitChunk("{~p,[" + "{loaded,~p}," + "{native,~p}," + "{compiler,~p}," + "{md5,~p}" + "]}", + [Mod, Loaded, Native, CompilerVersion, hexstring(Md5)]). + +comma_separated_foreach(_EmitChunk, _Fun, []) -> + ok; +comma_separated_foreach(_EmitChunk, Fun, [H]) -> + Fun(H); +comma_separated_foreach(EmitChunk, Fun, [H | T]) -> + Fun(H), + EmitChunk(",", []), + comma_separated_foreach(EmitChunk, Fun, T). + is_application_path(Path) -> case filelib:wildcard(filename:join(Path, "*.app")) of [] -> false; _ -> true end. -get_application_from_path(Path) -> - [Appfile|_] = filelib:wildcard(filename:join(Path, "*.app")), - case file:consult(Appfile) of - {ok, [{application, App, Info}]} -> - {App, [ - {description, proplists:get_value(description, Info, [])}, - {vsn, proplists:get_value(vsn, Info, [])}, - {path, Path}, - {runtime_dependencies, - proplists:get_value(runtime_dependencies, Info, [])}, - {modules, get_modules_from_path(Path)} - ]} - end. - -get_modules_from_path(Path) -> - [ - begin - {ok,{Mod, Md5}} = beam_lib:md5(Beam), - Loaded = case code:is_loaded(Mod) of - false -> false; - _ -> true - end, - {Mod, [ - {loaded, Loaded}, - {native, beam_is_native_compiled(Beam)}, - {compiler, get_compiler_version(Beam)}, - {md5, hexstring(Md5)} - ]} - end || Beam <- filelib:wildcard(filename:join(Path, "*.beam")) - ]. - hexstring(Bin) when is_binary(Bin) -> lists:flatten([io_lib:format("~2.16.0b", [V]) || <<V>> <= Bin]). diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 154894cda8..ad9efc4755 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -54,7 +54,7 @@ sha/1, sign/3, verify/5]). %%% For test suites --export([pack/3]). +-export([pack/3, adjust_algs_for_peer_version/2]). -export([decompress/2, decrypt_blocks/3, is_valid_mac/3 ]). % FIXME: remove -define(Estring(X), ?STRING((if is_binary(X) -> X; diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index a18383d148..21359a0386 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -37,6 +37,7 @@ MODULES= \ ssh_renegotiate_SUITE \ ssh_basic_SUITE \ ssh_bench_SUITE \ + ssh_compat_SUITE \ ssh_connection_SUITE \ ssh_engine_SUITE \ ssh_protocol_SUITE \ diff --git a/lib/ssh/test/ssh_compat_SUITE.erl b/lib/ssh/test/ssh_compat_SUITE.erl new file mode 100644 index 0000000000..74ab5aca3a --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE.erl @@ -0,0 +1,814 @@ +%% +%% %CopyrightBegin% +%% +%% 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. +%% 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(ssh_compat_SUITE). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("ssh/src/ssh_transport.hrl"). % #ssh_msg_kexinit{} +-include_lib("kernel/include/inet.hrl"). % #hostent{} +-include_lib("kernel/include/file.hrl"). % #file_info{} +-include("ssh_test_lib.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(USER,"sshtester"). +-define(PWD, "foobar"). +-define(DOCKER_PFX, "ssh_compat_suite-ssh"). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> + [%%{ct_hooks,[ts_install_cth]}, + {timetrap,{seconds,40}}]. + +all() -> + [{group,G} || G <- vers()]. + +groups() -> + [{G, [], tests()} || G <- vers()]. + +tests() -> + [login_with_password_otp_is_client, + login_with_password_otp_is_server, + login_with_keyboard_interactive_otp_is_client, + login_with_keyboard_interactive_otp_is_server, + login_with_all_public_keys_otp_is_client, + login_with_all_public_keys_otp_is_server, + all_algorithms_otp_is_client, + all_algorithms_otp_is_server + ]. + + + +vers() -> + try + %% Find all useful containers in such a way that undefined command, too low + %% priviliges, no containers and containers found give meaningful result: + L0 = ["REPOSITORY"++_|_] = string:tokens(os:cmd("docker images"), "\r\n"), + [["REPOSITORY","TAG"|_]|L1] = [string:tokens(E, " ") || E<-L0], + [list_to_atom(V) || [?DOCKER_PFX,V|_] <- L1] + of + Vs -> + lists:sort(Vs) + catch + error:{badmatch,_} -> + [] + end. + +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + ?CHECK_CRYPTO( + case os:find_executable("docker") of + false -> + {skip, "No docker"}; + _ -> + ssh:start(), + ct:log("Crypto info: ~p",[crypto:info_lib()]), + Config + end). + +end_per_suite(Config) -> + %% Remove all containers that are not running: +%%% os:cmd("docker rm $(docker ps -aq -f status=exited)"), + %% Remove dangling images: +%%% os:cmd("docker rmi $(docker images -f dangling=true -q)"), + Config. + + + +init_per_group(G, Config) -> + case lists:member(G, vers()) of + true -> + try start_docker(G) of + {ok,ID} -> + ct:log("==> ~p",[G]), + [Vssh|VsslRest] = string:tokens(atom_to_list(G), "-"), + Vssl = lists:flatten(lists:join($-,VsslRest)), + ct:comment("+++ ~s + ~s +++",[Vssh,Vssl]), + %% Find the algorithms that both client and server supports: + {IP,Port} = ip_port([{id,ID}]), + try common_algs([{id,ID}|Config], IP, Port) of + {ok, RemoteServerCommon, RemoteClientCommon} -> + [{ssh_version,Vssh},{ssl_version,Vssl}, + {id,ID}, + {common_server_algs,RemoteServerCommon}, + {common_client_algs,RemoteClientCommon} + |Config]; + Other -> + ct:log("Error in init_per_group: ~p",[Other]), + stop_docker(ID), + {fail, "Can't contact docker sshd"} + catch + Class:Exc -> + ST = erlang:get_stacktrace(), + ct:log("common_algs: ~p:~p~n~p",[Class,Exc,ST]), + stop_docker(ID), + {fail, "Failed during setup"} + end + catch + cant_start_docker -> + {skip, "Can't start docker"}; + + C:E -> + ST = erlang:get_stacktrace(), + ct:log("No ~p~n~p:~p~n~p",[G,C,E,ST]), + {skip, "Can't start docker"} + end; + + false -> + Config + end. + +end_per_group(_, Config) -> + catch stop_docker(proplists:get_value(id,Config)), + Config. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- +login_with_password_otp_is_client(Config) -> + {IP,Port} = ip_port(Config), + {ok,C} = ssh:connect(IP, Port, [{auth_methods,"password"}, + {user,?USER}, + {password,?PWD}, + {user_dir, new_dir(Config)}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + ssh:close(C). + +%%-------------------------------------------------------------------- +login_with_password_otp_is_server(Config) -> + {Server, Host, HostPort} = + ssh_test_lib:daemon(0, + [{auth_methods,"password"}, + {system_dir, setup_local_hostdir('ssh-rsa',Config)}, + {user_dir, new_dir(Config)}, + {user_passwords, [{?USER,?PWD}]}, + {failfun, fun ssh_test_lib:failfun/2} + ]), + R = exec_from_docker(Config, Host, HostPort, + "'lists:concat([\"Answer=\",1+2]).\r\n'", + [<<"Answer=3">>], + ""), + ssh:stop_daemon(Server), + R. + +%%-------------------------------------------------------------------- +login_with_keyboard_interactive_otp_is_client(Config) -> + {DockerIP,DockerPort} = ip_port(Config), + {ok,C} = ssh:connect(DockerIP, DockerPort, + [{auth_methods,"keyboard-interactive"}, + {user,?USER}, + {password,?PWD}, + {user_dir, new_dir(Config)}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + ssh:close(C). + +%%-------------------------------------------------------------------- +login_with_keyboard_interactive_otp_is_server(Config) -> + {Server, Host, HostPort} = + ssh_test_lib:daemon(0, + [{auth_methods,"keyboard-interactive"}, + {system_dir, setup_local_hostdir('ssh-rsa',Config)}, + {user_dir, new_dir(Config)}, + {user_passwords, [{?USER,?PWD}]}, + {failfun, fun ssh_test_lib:failfun/2} + ]), + R = exec_from_docker(Config, Host, HostPort, + "'lists:concat([\"Answer=\",1+3]).\r\n'", + [<<"Answer=4">>], + ""), + ssh:stop_daemon(Server), + R. + +%%-------------------------------------------------------------------- +login_with_all_public_keys_otp_is_client(Config) -> + CommonAlgs = [{public_key_from_host,A} + || {public_key,A} <- proplists:get_value(common_server_algs, Config)], + {DockerIP,DockerPort} = ip_port(Config), + chk_all_algos(CommonAlgs, Config, + fun(_Tag,Alg) -> + ssh:connect(DockerIP, DockerPort, + [{auth_methods, "publickey"}, + {user, ?USER}, + {user_dir, setup_remote_auth_keys_and_local_priv(Alg, Config)}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]) + end). + +%%-------------------------------------------------------------------- +login_with_all_public_keys_otp_is_server(Config) -> + CommonAlgs = [{public_key_to_host,A} + || {public_key,A} <- proplists:get_value(common_client_algs, Config)], + UserDir = new_dir(Config), + {Server, Host, HostPort} = + ssh_test_lib:daemon(0, + [{auth_methods, "publickey"}, + {system_dir, setup_local_hostdir('ssh-rsa',Config)}, + {user_dir, UserDir}, + {user_passwords, [{?USER,?PWD}]}, + {failfun, fun ssh_test_lib:failfun/2} + ]), + + R = chk_all_algos(CommonAlgs, Config, + fun(_Tag,Alg) -> + setup_remote_priv_and_local_auth_keys(Alg, clear_dir(UserDir), Config), + exec_from_docker(Config, Host, HostPort, + "'lists:concat([\"Answer=\",1+4]).\r\n'", + [<<"Answer=5">>], + "") + end), + ssh:stop_daemon(Server), + R. + +%%-------------------------------------------------------------------- +all_algorithms_otp_is_client(Config) -> + CommonAlgs = proplists:get_value(common_server_algs, Config), + {IP,Port} = ip_port(Config), + chk_all_algos(CommonAlgs, Config, + fun(Tag, Alg) -> + ssh:connect(IP, Port, [{user,?USER}, + {password,?PWD}, + {auth_methods, "password"}, + {user_dir, new_dir(Config)}, + {preferred_algorithms, [{Tag,[Alg]}]}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]) + end). + +%%-------------------------------------------------------------------- +all_algorithms_otp_is_server(Config) -> + CommonAlgs = proplists:get_value(common_client_algs, Config), + UserDir = setup_remote_priv_and_local_auth_keys('ssh-rsa', Config), + chk_all_algos(CommonAlgs, Config, + fun(Tag,Alg) -> + HostKeyAlg = case Tag of + public_key -> Alg; + _ -> 'ssh-rsa' + end, + {Server, Host, HostPort} = + ssh_test_lib:daemon(0, + [{preferred_algorithms, [{Tag,[Alg]}]}, + {system_dir, setup_local_hostdir(HostKeyAlg, Config)}, + {user_dir, UserDir}, + {user_passwords, [{?USER,?PWD}]}, + {failfun, fun ssh_test_lib:failfun/2} + ]), + R = exec_from_docker(Config, Host, HostPort, + "hi_there.\r\n", + [<<"hi_there">>], + ""), + ssh:stop_daemon(Server), + R + end). + +%%-------------------------------------------------------------------- +%% Utilities --------------------------------------------------------- +%%-------------------------------------------------------------------- +exec_from_docker(WhatEver, {0,0,0,0}, HostPort, Command, Expects, ExtraSshArg) -> + exec_from_docker(WhatEver, host_ip(), HostPort, Command, Expects, ExtraSshArg); + +exec_from_docker(Config, HostIP, HostPort, Command, Expects, ExtraSshArg) when is_binary(hd(Expects)), + is_list(Config) -> + {DockerIP,DockerPort} = ip_port(Config), + {ok,C} = ssh:connect(DockerIP, DockerPort, + [{user,?USER}, + {password,?PWD}, + {user_dir, new_dir(Config)}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + R = exec_from_docker(C, HostIP, HostPort, Command, Expects, ExtraSshArg), + ssh:close(C), + R; + +exec_from_docker(C, HostIP, HostPort, Command, Expects, ExtraSshArg) when is_binary(hd(Expects)) -> + SSH_from_docker = + lists:concat(["sshpass -p ",?PWD," ", + "/buildroot/ssh/bin/ssh -p ",HostPort," -o 'CheckHostIP=no' -o 'StrictHostKeyChecking=no' ", + ExtraSshArg," ", + inet_parse:ntoa(HostIP)," " + ]), + ExecCommand = SSH_from_docker ++ Command, + R = exec(C, ExecCommand), + case R of + {ok,{ExitStatus,Result}} when ExitStatus == 0 -> + case binary:match(Result, Expects) of + nomatch -> + ct:log("Result of~n ~s~nis~n ~p",[ExecCommand,R]), + {fail, "Bad answer"}; + _ -> + ok + end; + {ok,_} -> + ct:log("Result of~n ~s~nis~n ~p",[ExecCommand,R]), + {fail, "Exit status =/= 0"}; + _ -> + ct:log("Result of~n ~s~nis~n ~p",[ExecCommand,R]), + {fail, "Couldn't login to host"} + end. + + + + +exec(C, Cmd) -> + ct:log("~s",[Cmd]), + {ok,Ch} = ssh_connection:session_channel(C, 10000), + success = ssh_connection:exec(C, Ch, Cmd, 10000), + exec_result(C, Ch). + + +exec_result(C, Ch) -> + exec_result(C, Ch, undefined, <<>>). + +exec_result(C, Ch, ExitStatus, Acc) -> + receive + {ssh_cm,C,{closed,Ch}} -> + %%ct:log("CHAN ~p got *closed*",[Ch]), + {ok, {ExitStatus, Acc}}; + + {ssh_cm,C,{exit_status,Ch,ExStat}} when ExitStatus == undefined -> + %%ct:log("CHAN ~p got *exit status ~p*",[Ch,ExStat]), + exec_result(C, Ch, ExStat, Acc); + + {ssh_cm,C,{data,Ch,_,Data}=_X} when ExitStatus == undefined -> + %%ct:log("CHAN ~p got ~p",[Ch,_X]), + exec_result(C, Ch, ExitStatus, <<Acc/binary, Data/binary>>); + + _Other -> + %%ct:log("OTHER: ~p",[_Other]), + exec_result(C, Ch, ExitStatus, Acc) + + after 5000 -> + %%ct:log("NO MORE, received so far:~n~s",[Acc]), + {error, timeout} + end. + + +chk_all_algos(CommonAlgs, Config, DoTestFun) when is_function(DoTestFun,2) -> + ct:comment("~p algorithms",[length(CommonAlgs)]), + %% Check each algorithm + Failed = + lists:foldl( + fun({Tag,Alg}, FailedAlgos) -> + ct:log("Try ~p",[Alg]), + case DoTestFun(Tag,Alg) of + {ok,C} -> + ssh:close(C), + FailedAlgos; + ok -> + FailedAlgos; + Other -> + ct:log("FAILED! ~p ~p: ~p",[Tag,Alg,Other]), + [Alg|FailedAlgos] + end + end, [], CommonAlgs), + ct:pal("~s", [format_result_table_use_all_algos(Config, CommonAlgs, Failed)]), + case Failed of + [] -> + ok; + _ -> + {fail, Failed} + end. + +setup_local_hostdir(KeyAlg, Config) -> + setup_local_hostdir(KeyAlg, new_dir(Config), Config). +setup_local_hostdir(KeyAlg, HostDir, Config) -> + {ok, {Priv,Publ}} = host_priv_pub_keys(Config, KeyAlg), + %% Local private and public key + DstFile = filename:join(HostDir, dst_filename(host,KeyAlg)), + ok = file:write_file(DstFile, Priv), + ok = file:write_file(DstFile++".pub", Publ), + HostDir. + + +setup_remote_auth_keys_and_local_priv(KeyAlg, Config) -> + {IP,Port} = ip_port(Config), + setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, new_dir(Config), Config). + +setup_remote_auth_keys_and_local_priv(KeyAlg, UserDir, Config) -> + {IP,Port} = ip_port(Config), + setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, UserDir, Config). + +setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, Config) -> + setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, new_dir(Config), Config). + +setup_remote_auth_keys_and_local_priv(KeyAlg, IP, Port, UserDir, Config) -> + {ok, {Priv,Publ}} = user_priv_pub_keys(Config, KeyAlg), + %% Local private and public keys + DstFile = filename:join(UserDir, dst_filename(user,KeyAlg)), + ok = file:write_file(DstFile, Priv), + ok = file:write_file(DstFile++".pub", Publ), + %% Remote auth_methods with public key + {ok,Ch,Cc} = ssh_sftp:start_channel(IP, Port, [{user, ?USER }, + {password, ?PWD }, + {auth_methods, "password"}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + _ = ssh_sftp:make_dir(Ch, ".ssh"), + ok = ssh_sftp:write_file(Ch, ".ssh/authorized_keys", Publ), + ok = ssh_sftp:write_file_info(Ch, ".ssh/authorized_keys", #file_info{mode=8#700}), + ok = ssh_sftp:write_file_info(Ch, ".ssh", #file_info{mode=8#700}), + ok = ssh_sftp:stop_channel(Ch), + ok = ssh:close(Cc), + UserDir. + + +setup_remote_priv_and_local_auth_keys(KeyAlg, Config) -> + {IP,Port} = ip_port(Config), + setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, new_dir(Config), Config). + +setup_remote_priv_and_local_auth_keys(KeyAlg, UserDir, Config) -> + {IP,Port} = ip_port(Config), + setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, UserDir, Config). + +setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, Config) -> + setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, new_dir(Config), Config). + +setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, UserDir, Config) -> + {ok, {Priv,Publ}} = user_priv_pub_keys(Config, KeyAlg), + %% Local auth_methods with public key + AuthKeyFile = filename:join(UserDir, "authorized_keys"), + ok = file:write_file(AuthKeyFile, Publ), + %% Remote private and public key + {ok,Ch,Cc} = ssh_sftp:start_channel(IP, Port, [{user, ?USER }, + {password, ?PWD }, + {auth_methods, "password"}, + {silently_accept_hosts,true}, + {user_interaction,false} + ]), + _ = ssh_sftp:make_dir(Ch, ".ssh"), + DstFile = filename:join(".ssh", dst_filename(user,KeyAlg)), + ok = ssh_sftp:write_file(Ch, DstFile, Priv), + ok = ssh_sftp:write_file_info(Ch, DstFile, #file_info{mode=8#700}), + ok = ssh_sftp:write_file(Ch, DstFile++".pub", Publ), + ok = ssh_sftp:write_file_info(Ch, ".ssh", #file_info{mode=8#700}), + ok = ssh_sftp:stop_channel(Ch), + ok = ssh:close(Cc), + UserDir. + +user_priv_pub_keys(Config, KeyAlg) -> priv_pub_keys("users_keys", user, Config, KeyAlg). +host_priv_pub_keys(Config, KeyAlg) -> priv_pub_keys("host_keys", host, Config, KeyAlg). + +priv_pub_keys(KeySubDir, Type, Config, KeyAlg) -> + KeyDir = filename:join(proplists:get_value(data_dir,Config), KeySubDir), + {ok,Priv} = file:read_file(filename:join(KeyDir,src_filename(Type,KeyAlg))), + {ok,Publ} = file:read_file(filename:join(KeyDir,src_filename(Type,KeyAlg)++".pub")), + {ok, {Priv,Publ}}. + + +src_filename(user, 'ssh-rsa' ) -> "id_rsa"; +src_filename(user, 'rsa-sha2-256' ) -> "id_rsa"; +src_filename(user, 'rsa-sha2-512' ) -> "id_rsa"; +src_filename(user, 'ssh-dss' ) -> "id_dsa"; +src_filename(user, 'ecdsa-sha2-nistp256') -> "id_ecdsa256"; +src_filename(user, 'ecdsa-sha2-nistp384') -> "id_ecdsa384"; +src_filename(user, 'ecdsa-sha2-nistp521') -> "id_ecdsa521"; +src_filename(host, 'ssh-rsa' ) -> "ssh_host_rsa_key"; +src_filename(host, 'rsa-sha2-256' ) -> "ssh_host_rsa_key"; +src_filename(host, 'rsa-sha2-512' ) -> "ssh_host_rsa_key"; +src_filename(host, 'ssh-dss' ) -> "ssh_host_dsa_key"; +src_filename(host, 'ecdsa-sha2-nistp256') -> "ssh_host_ecdsa_key256"; +src_filename(host, 'ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key384"; +src_filename(host, 'ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key521". + +dst_filename(user, 'ssh-rsa' ) -> "id_rsa"; +dst_filename(user, 'rsa-sha2-256' ) -> "id_rsa"; +dst_filename(user, 'rsa-sha2-512' ) -> "id_rsa"; +dst_filename(user, 'ssh-dss' ) -> "id_dsa"; +dst_filename(user, 'ecdsa-sha2-nistp256') -> "id_ecdsa"; +dst_filename(user, 'ecdsa-sha2-nistp384') -> "id_ecdsa"; +dst_filename(user, 'ecdsa-sha2-nistp521') -> "id_ecdsa"; +dst_filename(host, 'ssh-rsa' ) -> "ssh_host_rsa_key"; +dst_filename(host, 'rsa-sha2-256' ) -> "ssh_host_rsa_key"; +dst_filename(host, 'rsa-sha2-512' ) -> "ssh_host_rsa_key"; +dst_filename(host, 'ssh-dss' ) -> "ssh_host_dsa_key"; +dst_filename(host, 'ecdsa-sha2-nistp256') -> "ssh_host_ecdsa_key"; +dst_filename(host, 'ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key"; +dst_filename(host, 'ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key". + + +format_result_table_use_all_algos(Config, CommonAlgs, Failed) -> + %% Write a nice table with the result + AlgHead = 'Algorithm', + AlgWidth = lists:max([length(atom_to_list(A)) || {_,A} <- CommonAlgs]), + {ResultTable,_} = + lists:mapfoldl( + fun({T,A}, Tprev) -> + Tag = case T of + Tprev -> ""; + _ -> io_lib:format('~s~n',[T]) + end, + {io_lib:format('~s ~*s ~s~n', + [Tag, -AlgWidth, A, + case lists:member(A,Failed) of + true -> "<<<< FAIL <<<<"; + false-> "(ok)" + end]), + T} + end, undefined, CommonAlgs), + + Vssh = proplists:get_value(ssh_version,Config,""), + Vssl = proplists:get_value(ssl_version,Config,""), + io_lib:format("~nResults, Peer versions: ~s and ~s~n" + "Tag ~*s Result~n" + "=====~*..=s=======~n~s" + ,[Vssh,Vssl, + -AlgWidth,AlgHead, + AlgWidth, "", ResultTable]). + + +start_docker(Ver) -> + Cmnd = lists:concat(["docker run -itd --rm -p 1234 ",?DOCKER_PFX,":",Ver]), + Id0 = os:cmd(Cmnd), + ct:log("Ver = ~p, Cmnd ~p~n-> ~p",[Ver,Cmnd,Id0]), + case is_docker_sha(Id0) of + true -> + Id = hd(string:tokens(Id0, "\n")), + IP = ip(Id), + Port = 1234, + {ok, {Ver,{IP,Port},Id}}; + false -> + throw(cant_start_docker) + end. + + +stop_docker({_Ver,_,Id}) -> + Cmnd = lists:concat(["docker kill ",Id]), + os:cmd(Cmnd). + +is_docker_sha(L) -> + lists:all(fun(C) when $a =< C,C =< $z -> true; + (C) when $0 =< C,C =< $9 -> true; + ($\n) -> true; + (_) -> false + end, L). + +ip_port(Config) -> + {_Ver,{IP,Port},_} = proplists:get_value(id,Config), + {IP,Port}. + +port_mapped_to(Id) -> + Cmnd = lists:concat(["docker ps --format \"{{.Ports}}\" --filter id=",Id]), + [_, PortStr | _] = string:tokens(os:cmd(Cmnd), ":->/"), + list_to_integer(PortStr). + +ip(Id) -> + Cmnd = lists:concat(["docker inspect --format='{{range .NetworkSettings.Networks}}{{.IPAddress}}{{end}}' ", + Id]), + IPstr0 = os:cmd(Cmnd), + ct:log("Cmnd ~p~n-> ~p",[Cmnd,IPstr0]), + IPstr = hd(string:tokens(IPstr0, "\n")), + {ok,IP} = inet:parse_address(IPstr), + IP. + +new_dir(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + SubDirName = integer_to_list(erlang:system_time()), + Dir = filename:join(PrivDir, SubDirName), + case file:read_file_info(Dir) of + {error,enoent} -> + ok = file:make_dir(Dir), + Dir; + _ -> + timer:sleep(25), + new_dir(Config) + end. + +clear_dir(Dir) -> + delete_all_contents(Dir), + {ok,[]} = file:list_dir(Dir), + Dir. + +delete_all_contents(Dir) -> + {ok,Fs} = file:list_dir(Dir), + lists:map(fun(F0) -> + F = filename:join(Dir, F0), + case filelib:is_file(F) of + true -> + file:delete(F); + false -> + case filelib:is_dir(F) of + true -> + delete_all_contents(F), + file:del_dir(F); + false -> + ct:log("Neither file nor dir: ~p",[F]) + end + end + end, Fs). + +common_algs(Config, IP, Port) -> + case remote_server_algs(IP, Port) of + {ok, {RemoteHelloBin, RemoteServerKexInit}} -> + case remote_client_algs(Config) of + {ok,{_Hello,RemoteClientKexInit}} -> + RemoteServerAlgs = kexint_msg2default_algorithms(RemoteServerKexInit), + Server = find_common_algs(RemoteServerAlgs, + use_algorithms(RemoteHelloBin)), + RemoteClientAlgs = kexint_msg2default_algorithms(RemoteClientKexInit), + Client = find_common_algs(RemoteClientAlgs, + use_algorithms(RemoteHelloBin)), + ct:log("Docker server algorithms:~n ~p~n~nDocker client algorithms:~n ~p", + [RemoteServerAlgs,RemoteClientAlgs]), + {ok, Server, Client}; + Other -> + Other + end; + Other -> + Other + end. + + +find_common_algs(Remote, Local) -> + [{T,V} || {T,Vs} <- ssh_test_lib:extract_algos( + ssh_test_lib:intersection(Remote, + Local)), + V <- Vs]. + + +use_algorithms(RemoteHelloBin) -> + MyAlgos = ssh:chk_algos_opts( + [{modify_algorithms, + [{append, + [{kex,['diffie-hellman-group1-sha1']} + ]} + ]} + ]), + ssh_transport:adjust_algs_for_peer_version(binary_to_list(RemoteHelloBin)++"\r\n", + MyAlgos). + +kexint_msg2default_algorithms(#ssh_msg_kexinit{kex_algorithms = Kex, + server_host_key_algorithms = PubKey, + encryption_algorithms_client_to_server = CipherC2S, + encryption_algorithms_server_to_client = CipherS2C, + mac_algorithms_client_to_server = MacC2S, + mac_algorithms_server_to_client = MacS2C, + compression_algorithms_client_to_server = CompC2S, + compression_algorithms_server_to_client = CompS2C + }) -> + [{kex, ssh_test_lib:to_atoms(Kex)}, + {public_key, ssh_test_lib:to_atoms(PubKey)}, + {cipher, [{client2server,ssh_test_lib:to_atoms(CipherC2S)}, + {server2client,ssh_test_lib:to_atoms(CipherS2C)}]}, + {mac, [{client2server,ssh_test_lib:to_atoms(MacC2S)}, + {server2client,ssh_test_lib:to_atoms(MacS2C)}]}, + {compression, [{client2server,ssh_test_lib:to_atoms(CompC2S)}, + {server2client,ssh_test_lib:to_atoms(CompS2C)}]}]. + + + +remote_server_algs(IP, Port) -> + case try_gen_tcp_connect(IP, Port, 5) of + {ok,S} -> + ok = gen_tcp:send(S, "SSH-2.0-CheckAlgs\r\n"), + receive_hello(S, <<>>); + {error,Error} -> + {error,Error} + end. + +try_gen_tcp_connect(IP, Port, N) when N>0 -> + case gen_tcp:connect(IP, Port, [binary]) of + {ok,S} -> + {ok,S}; + {error,_Error} when N>1 -> + receive after 1000 -> ok end, + try_gen_tcp_connect(IP, Port, N-1); + {error,Error} -> + {error,Error} + end; +try_gen_tcp_connect(_, _, _) -> + {error, "No contact"}. + + +remote_client_algs(Config) -> + Parent = self(), + Ref = make_ref(), + spawn( + fun() -> + {ok,Sl} = gen_tcp:listen(0, [binary]), + {ok,{IP,Port}} = inet:sockname(Sl), + Parent ! {addr,Ref,IP,Port}, + {ok,S} = gen_tcp:accept(Sl), + ok = gen_tcp:send(S, "SSH-2.0-CheckAlgs\r\n"), + Parent ! {Ref,receive_hello(S, <<>>)} + end), + receive + {addr,Ref,IP,Port} -> + spawn(fun() -> + exec_from_docker(Config, IP, Port, + "howdy.\r\n", + [<<"howdy">>], + "") + end), + receive + {Ref, Result} -> + Result + after 15000 -> + {error, timeout2} + end + after 15000 -> + {error, timeout1} + end. + + + +receive_hello(S, Ack) -> + %% The Ack is to collect bytes until the full message is received + receive + {tcp, S, Bin0} when is_binary(Bin0) -> + case binary:split(<<Ack/binary, Bin0/binary>>, [<<"\r\n">>,<<"\r">>,<<"\n">>]) of + [Hello = <<"SSH-2.0-",_/binary>>, NextPacket] -> + ct:log("Got 2.0 hello (~p), ~p bytes to next msg",[Hello,size(NextPacket)]), + {ok, {Hello, receive_kexinit(S, NextPacket)}}; + + [Hello = <<"SSH-1.99-",_/binary>>, NextPacket] -> + ct:comment("Old SSH ~s",["1.99"]), + ct:log("Got 1.99 hello (~p), ~p bytes to next msg",[Hello,size(NextPacket)]), + {ok, {Hello, receive_kexinit(S, NextPacket)}}; + + [Bin] when size(Bin) < 256 -> + ct:log("Got part of hello (~p chars):~n~s~n~s",[size(Bin),Bin, + [io_lib:format('~2.16.0b ',[C]) + || C <- binary_to_list(Bin0) + ] + ]), + receive_hello(S, Bin0); + + _ -> + ct:log("Bad hello string (line ~p, ~p chars):~n~s~n~s",[?LINE,size(Bin0),Bin0, + [io_lib:format('~2.16.0b ',[C]) + || C <- binary_to_list(Bin0) + ] + ]), + ct:fail("Bad hello string received") + end; + Other -> + ct:log("Bad hello string (line ~p):~n~p",[?LINE,Other]), + ct:fail("Bad hello string received") + + after 10000 -> + ct:log("Timeout waiting for hello!~n~s",[Ack]), + throw(timeout) + end. + + +receive_kexinit(_S, <<PacketLen:32, PaddingLen:8, PayloadAndPadding/binary>>) + when PacketLen < 5000, % heuristic max len to stop huge attempts if packet decodeing get out of sync + size(PayloadAndPadding) >= (PacketLen-1) % Need more bytes? + -> + ct:log("Has all ~p packet bytes",[PacketLen]), + PayloadLen = PacketLen - PaddingLen - 1, + <<Payload:PayloadLen/binary, _Padding:PaddingLen/binary>> = PayloadAndPadding, + ssh_message:decode(Payload); + +receive_kexinit(S, Ack) -> + ct:log("Has ~p bytes, need more",[size(Ack)]), + receive + {tcp, S, Bin0} when is_binary(Bin0) -> + receive_kexinit(S, <<Ack/binary, Bin0/binary>>); + Other -> + ct:log("Bad hello string (line ~p):~n~p",[?LINE,Other]), + ct:fail("Bad hello string received") + + after 10000 -> + ct:log("Timeout waiting for kexinit!~n~s",[Ack]), + throw(timeout) + end. + + + +host_ip() -> + {ok,Name} = inet:gethostname(), + {ok,#hostent{h_addr_list = [IP|_]}} = inet_res:gethostbyname(Name), + IP. + + diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-base-image b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-base-image new file mode 100755 index 0000000000..1cb7bf33e1 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-base-image @@ -0,0 +1,38 @@ +#!/bin/sh + +UBUNTU_VER=${1:-16.04} + +USER=sshtester +PWD=foobar + +docker build \ + -t ubuntubuildbase \ + --build-arg https_proxy=$HTTPS_PROXY \ + --build-arg http_proxy=$HTTP_PROXY \ + - <<EOF + + FROM ubuntu:$UBUNTU_VER + WORKDIR /buildroot + + # Prepare for installing OpenSSH + RUN apt-get update + RUN apt-get upgrade -y + RUN apt-get -y install apt-utils + RUN apt-get -y install build-essential zlib1g-dev + RUN apt-get -y install sudo iputils-ping tcptraceroute net-tools + RUN apt-get -y install sshpass expect + RUN apt-get -y install libpam0g-dev + + # A user for the tests + RUN (echo $PWD; echo $PWD; echo; echo; echo; echo; echo; echo ) | adduser $USER + RUN adduser $USER sudo + + # Prepare the privsep preauth environment for openssh + RUN mkdir -p /var/empty + RUN chown root:sys /var/empty + RUN chmod 755 /var/empty + RUN groupadd -f sshd + RUN ls /bin/false + RUN id -u sshd 2> /dev/null || useradd -g sshd -c 'sshd privsep' -d /var/empty -s /bin/false sshd + +EOF diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image new file mode 100755 index 0000000000..983c57b18b --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssh-image @@ -0,0 +1,71 @@ +#!/bin/sh + +# ./create-image openssh 7.3p1 openssl 1.0.2m + +set -x + +case $1 in + openssh) + FAMssh=openssh + VERssh=$2 + PFX=https://ftp.eu.openbsd.org/pub/OpenBSD/OpenSSH/portable/openssh- + SFX=.tar.gz + TMP=tmp.tar.gz + ;; + *) + echo "Unsupported: $1" + exit +esac + +FAMssl=$3 +VERssl=$4 + +VER=${FAMssh}${VERssh}-${FAMssl}${VERssl} + +# This way of fetching the tar-file separate from the docker commands makes +# http-proxy handling way easier. The wget command handles the $https_proxy +# variable while the docker command must have /etc/docker/something changed +# and the docker server restarted. That is not possible without root access. + +# Make a Dockerfile. This method simplifies env variable handling considerably: +cat - > TempDockerFile <<EOF + + FROM ssh_compat_suite-${FAMssl}:${VERssl} + + LABEL openssh-version=${VER} + + WORKDIR /buildroot + + COPY ${TMP} . + RUN tar xf ${TMP} + + # Build and install + + WORKDIR ${FAMssh}-${VERssh} + + # Probably VERY OpenSSH dependent...: + RUN ./configure --without-pie \ + --prefix=/buildroot/ssh \ + --with-ssl-dir=/buildroot/ssl \ + --with-pam + RUN make + RUN make install + RUN echo UsePAM yes >> /buildroot/ssh/etc/sshd_config + + RUN echo Built ${VER} + + # Start the daemon, but keep it in foreground to avoid killing the container + CMD /buildroot/ssh/sbin/sshd -D -p 1234 + +EOF + +# Fetch the tar file. This could be done in an "ADD ..." in the Dockerfile, +# but then we hit the proxy problem... +wget -O $TMP $PFX$VERssh$SFX + +# Build the image: +docker build -t ssh_compat_suite-ssh:$VER -f ./TempDockerFile . + +# Cleaning +rm -fr ./TempDockerFile $TMP + diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image new file mode 100755 index 0000000000..66f8358b8a --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create-ssl-image @@ -0,0 +1,61 @@ +#!/bin/sh + +# ./create-image openssl 1.0.2m + +case "$1" in + "openssl") + FAM=openssl + VER=$2 + PFX=https://www.openssl.org/source/openssl- + SFX=.tar.gz + TMP=tmp.tar.gz + ;; + "libressl") + FAM=libressl + VER=$2 + PFX=https://ftp.openbsd.org/pub/OpenBSD/LibreSSL/libressl- + SFX=.tar.gz + TMP=tmp.tar.gz + ;; + *) + echo No lib type + exit + ;; +esac + +# This way of fetching the tar-file separate from the docker commands makes +# http-proxy handling way easier. The wget command handles the $https_proxy +# variable while the docker command must have /etc/docker/something changed +# and the docker server restarted. That is not possible without root access. + +# Make a Dockerfile. This method simplifies env variable handling considerably: +cat - > TempDockerFile <<EOF + + FROM ubuntubuildbase + + LABEL version=$FAM-$VER + + WORKDIR /buildroot + + COPY ${TMP} . + RUN tar xf ${TMP} + + WORKDIR ${FAM}-${VER} + + RUN ./config --prefix=/buildroot/ssl + + RUN make + RUN make install + + RUN echo Built ${FAM}-${VER} +EOF + +# Fetch the tar file. This could be done in an "ADD ..." in the Dockerfile, +# but then we hit the proxy problem... +wget -O $TMP $PFX$VER$SFX + +# Build the image: +docker build -t ssh_compat_suite-$FAM:$VER -f ./TempDockerFile . + +# Cleaning +rm -fr ./TempDockerFile $TMP diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all new file mode 100755 index 0000000000..16b9c21d9f --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all @@ -0,0 +1,87 @@ +#!/bin/bash + +UBUNTU_VERSION=16.04 + +SSH_SSL_VERSIONS=(\ + openssh 4.4p1 openssl 0.9.8zh \ + openssh 4.5p1 openssl 0.9.8zh \ + openssh 5.0p1 openssl 0.9.8zh \ + openssh 6.2p2 openssl 0.9.8zh \ + openssh 6.3p1 openssl 0.9.8zh \ + \ + openssh 7.1p1 openssl 1.0.0t \ + \ + openssh 7.1p1 openssl 1.0.1p \ + \ + openssh 6.6p1 openssl 1.0.2n \ + openssh 7.1p1 openssl 1.0.2n \ + openssh 7.6p1 openssl 1.0.2n \ + ) + +if [ "x$1" == "x-b" ] +then + shift + SKIP_CREATE_BASE=true +fi + +WHAT_TO_DO=$1 + +function create_one_image () +{ + SSH_FAM=$1 + SSH_VER=$2 + SSL_FAM=$3 + SSL_VER=$4 + + [ "x$SKIP_CREATE_BASE" == "xtrue" ] || ./create-base-image || (echo "Create base failed." >&2; exit 1) + ./create-ssl-image $SSL_FAM $SSL_VER \ + || (echo "Create $SSL_FAM $SSL_VER failed." >&2; exit 2) + + ./create-ssh-image $SSH_FAM $SSH_VER $SSL_FAM $SSL_VER \ + || (echo "Create $SSH_FAM $SSH_VER on $SSL_FAM $SSL_VER failed." >&2; exit 3) +} + + +case ${WHAT_TO_DO} in + list) + ;; + listatoms) + PRE="[" + POST="]" + C=\' + COMMA=, + ;; + build_one) + if [ $# != 5 ] + then + echo "$0 build_one openssh SSH_ver openssl SSL_ver " && exit + else + create_one_image $2 $3 $4 $5 + exit + fi + ;; + build_all) + ;; + *) + echo "$0 [-b] list | listatoms | build_one openssh SSH_ver openssl SSL_ver | build_all" && exit + ;; +esac + + +echo -n $PRE +i=0 +while [ "x${SSH_SSL_VERSIONS[i]}" != "x" ] +do + case ${WHAT_TO_DO} in + list*) + [ $i -eq 0 ] || echo $COMMA + echo -n $C${SSH_SSL_VERSIONS[$i]}${SSH_SSL_VERSIONS[$(( $i + 1 ))]}-${SSH_SSL_VERSIONS[$(( $i + 2 ))]}${SSH_SSL_VERSIONS[$(( $i + 3 ))]}$C + ;; + build_all) + create_one_image ${SSH_SSL_VERSIONS[$i]} ${SSH_SSL_VERSIONS[$(( $i + 1 ))]} ${SSH_SSL_VERSIONS[$(( $i + 2 ))]} ${SSH_SSL_VERSIONS[$(( $i + 3 ))]} + ;; + esac + + i=$(( $i + 4 )) +done +echo $POST diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key new file mode 100644 index 0000000000..8b2354a7ea --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key @@ -0,0 +1,12 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBugIBAAKBgQDlXDEddxFbTtPsu2bRTbSONFVKMxe430iqBoXoKK2Gyhlqn7J8 +SRGlmvTN7T06+9iFqgJi+x+dlSJGlNEY/v67Z8C7rWfJynYuRier4TujLwP452RT +YrsnCq47pGJXHb9xAWr7UGMv85uDrECUiIdK4xIrwpW/gMb5zPSThDGNiwIVANts +B9nBX0NH/B0lXthVCg2jRSkpAoGAIS3vG8VmjQNYrGfdcdvQtGubFXs4jZJO6iDe +9u9/O95dcnH4ZIL4y3ZPHbw73dCKXFe5NlqI/POmn3MyFdpyqH5FTHWB/aAFrma6 +qo00F1mv83DkQCEfg6fwE/SaaBjDecr5I14hWOtocpYqlY1/x1aspahwK6NLPp/D +A4aAt78CgYAmNgr3dnHgMXrEsAeHswioAad3YLtnPvdFdHqd5j4oSbgKwFd7Xmyq +blfeQ6rRo8dmUF0rkUU8cn71IqbhpsCJQEZPt9WBlhHiY95B1ELKYHoHCbZA8qrZ +iEIcfwch85Da0/uzv4VE0UHTC0P3WRD3sZDfXd9dZLdc80n6ImYRpgIURgW8SZGj +X0mMkMJv/Ltdt0gYx60= +-----END DSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..9116493472 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_dsa_key.pub @@ -0,0 +1 @@ +ssh-dss AAAAB3NzaC1kc3MAAACBAOVcMR13EVtO0+y7ZtFNtI40VUozF7jfSKoGhegorYbKGWqfsnxJEaWa9M3tPTr72IWqAmL7H52VIkaU0Rj+/rtnwLutZ8nKdi5GJ6vhO6MvA/jnZFNiuycKrjukYlcdv3EBavtQYy/zm4OsQJSIh0rjEivClb+AxvnM9JOEMY2LAAAAFQDbbAfZwV9DR/wdJV7YVQoNo0UpKQAAAIAhLe8bxWaNA1isZ91x29C0a5sVeziNkk7qIN7273873l1ycfhkgvjLdk8dvDvd0IpcV7k2Woj886afczIV2nKofkVMdYH9oAWuZrqqjTQXWa/zcORAIR+Dp/AT9JpoGMN5yvkjXiFY62hyliqVjX/HVqylqHAro0s+n8MDhoC3vwAAAIAmNgr3dnHgMXrEsAeHswioAad3YLtnPvdFdHqd5j4oSbgKwFd7XmyqblfeQ6rRo8dmUF0rkUU8cn71IqbhpsCJQEZPt9WBlhHiY95B1ELKYHoHCbZA8qrZiEIcfwch85Da0/uzv4VE0UHTC0P3WRD3sZDfXd9dZLdc80n6ImYRpg== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256 b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256 new file mode 100644 index 0000000000..5ed2b361cc --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256 @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEILwQIf+Jul+oygeJn7cBSvn2LGqnW1ZfiHDQMDXZ96mooAoGCCqGSM49 +AwEHoUQDQgAEJUo0gCIhXEPJYvxec23IAjq7BjV1xw8deI8JV9vL5BMCZNhyj5Vt +NbFPbKPuL/Sikn8p4YP/5y336ug7szvYrg== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256.pub new file mode 100644 index 0000000000..240387d901 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key256.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBCVKNIAiIVxDyWL8XnNtyAI6uwY1dccPHXiPCVfby+QTAmTYco+VbTWxT2yj7i/0opJ/KeGD/+ct9+roO7M72K4= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384 b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384 new file mode 100644 index 0000000000..9d31d75cd5 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384 @@ -0,0 +1,6 @@ +-----BEGIN EC PRIVATE KEY----- +MIGkAgEBBDBw+P1sic2i41wTGQgjyUlBtxQfnY77L8TFcDngoRiVrbCugnDrioNo +JogqymWhSC+gBwYFK4EEACKhZANiAATwaqEp3vyLzfb08kqgIZLv/mAYJyGD+JMt +f11OswGs3uFkbHZOErFCgeLuBvarSTAFkOlMR9GZGaDEfcrPBTtvKj+jEaAvh6yr +JxS97rtwk2uadDMem2x4w9Ga4jw4S8E= +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384.pub new file mode 100644 index 0000000000..cca85bda72 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key384.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBPBqoSne/IvN9vTySqAhku/+YBgnIYP4ky1/XU6zAaze4WRsdk4SsUKB4u4G9qtJMAWQ6UxH0ZkZoMR9ys8FO28qP6MRoC+HrKsnFL3uu3CTa5p0Mx6bbHjD0ZriPDhLwQ== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521 b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521 new file mode 100644 index 0000000000..b698be1ec9 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521 @@ -0,0 +1,7 @@ +-----BEGIN EC PRIVATE KEY----- +MIHcAgEBBEIBtGVvyn7kGX7BfWAYHK2ZXmhWscTOV0J0mAfab0u0ZMw0id2a3O9s +sBjJoCqoAXTJ7d/OUw85qqQNDE5GDQpDFq6gBwYFK4EEACOhgYkDgYYABAHPWfUD +tQ/JmfwmmSdWWjGm94hFqwaivI4H43acDdd71+vods4rN2Yh3X7fSUvJkeOhXFOJ +yO9F+61ssKgS0a0nxQEvdXks3QyfKTPjYQuBUvY+AV/A4AskPBz731xCDmbYuWuh +RPekZ7d5bF0U0pGlExbX+naQJMSbJSdZrPM9993EmA== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521.pub new file mode 100644 index 0000000000..d181d30d69 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ecdsa_key521.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAHPWfUDtQ/JmfwmmSdWWjGm94hFqwaivI4H43acDdd71+vods4rN2Yh3X7fSUvJkeOhXFOJyO9F+61ssKgS0a0nxQEvdXks3QyfKTPjYQuBUvY+AV/A4AskPBz731xCDmbYuWuhRPekZ7d5bF0U0pGlExbX+naQJMSbJSdZrPM9993EmA== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key new file mode 100644 index 0000000000..84096298ca --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEpAIBAAKCAQEAuC6uxC0P8voYQCrwJzczo9iSiwsovPv4etd2BLnu8cKWdnjR +34tWvtguw2kO+iDyt4hFGGfDBQf2SXl+ZEsE2N1RlSp5A73me2byw/L4MreX2rbU +TwyNXF3TBvKb3Gbpx7PoiB9frcb9RCMxtypBvGQD6bx6h5UWKuSkYzARaRLv3kbB +swcqfrA3PfWybkIoaa2RO1Ca86u6K0v+a4r0OfRxTnghuakZkH6CD7+uU3irliPI +UFt2wTI/qWmnDrMFh4RffToHK0QZHXdkq4ama5kRZdZ0svSorxqkl8EWGPhReoUj +Yrz0bCNevSlDxHCxLi8epRxuv+AhZHW0YdMCCwIDAQABAoIBAHUyj1aZbfqolWHP +cL0jbSKnHqiHU0bd9sED9T8QqTEBJwj/3Fwop+wMV8VURol3CbsrZPwgmoHLDTa3 +rmtXKSBtxAns2tA8uDpxyaxSIQj0thYgHHyoehL6SNu06OSYP84pdp+XhyRm6KXA +11O7+dRMuAi1PCql/VMR5mCPJ6T5qWAVYHFyEBvMm4q5yYSRSPaAaZHC6WbEsxHN +jGzcyl3tvmOyN0+M7v0U86lQ+H2tSXH+nQg/Ig6hWgFGg8AYoos/9yUGOY+e9bUE +serYdsuiyxBfo4CgoSeDsjwNp1lAZ5UOrIDdRqK9C8jGVkHDzwfmmtczWXkVVzGZ +Bd05izECgYEA31yHzSA/umamyZAQbi/5psk1Fc5m6MzsgmJmB6jm7hUZ0EbpSV4C +6b1nOrk/IAtA12rvDHgWy0zpkJbC5b03C77RnBgTRgLQyolrcpLDJ47+Kxf/AHGk +m63KaCpwZEQ4f9ARBXySD/jNoW9gz5S6Xa3RnHOC70DsIIk5VOCjWk0CgYEA0xiM +Ay27PJcbAG/4tnjH8DZfHb8SULfnfUj8kMe3V2SDPDWbhY8zheo45wTBDRflFU5I +XyGmfuZ7PTTnFVrJz8ua3mAMOzkFn4MmdaRCX9XtuE4YWq3lFvxlrJvfXSjEL0km +8UwlhJMixaEPqFQjsKc9BHwWKRiKcF4zFQ1DybcCgYB46yfdhYLaj23lmqc6b6Bw +iWbCql2N1DqJj2l65hY2d5fk6C6s+EcNcOrsoJKq70yoEgzdrDlyz+11yBg0tU2S +fzgMkAAHG8kajHBts0QRK1kvzSrQe7VITjpQUAFOVpxbnTFJzhloqiHwLlKzremC +g3IBh4svqO7r4j32VDI61QKBgQCQL4gS872cWSncVp7vI/iNHtZBHy2HbNX1QVEi +Iwgb7U+mZIdh5roukhlj0l96bgPPVbUhJX7v1sX+vI/KikSmZk/V7IzuNrich5xR +ZmzfwOOqq8z+wyBjXuqjx6P9oca+9Zxf3L8Tmtx5WNW1CCOImfKXiZopX9XPgsgp +bPIMaQKBgQCql4uTSacSQ5s6rEEdvR+y6nTohF3zxhOQ+6xivm3Hf1mgTk40lQ+t +sr6HsSTv8j/ZbhhtaUUb2efro3pDztjlxXFvITar9ZDB2B4QMlpSsDR9UNk8xKGY +J9aYLr4fJC6J6VA7Wf0yq6LpjSXRH/2GeNtmMl5rFRsHt+VU7GZK9g== +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..4ac6e7b124 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_rsa_key.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC4Lq7ELQ/y+hhAKvAnNzOj2JKLCyi8+/h613YEue7xwpZ2eNHfi1a+2C7DaQ76IPK3iEUYZ8MFB/ZJeX5kSwTY3VGVKnkDveZ7ZvLD8vgyt5fattRPDI1cXdMG8pvcZunHs+iIH1+txv1EIzG3KkG8ZAPpvHqHlRYq5KRjMBFpEu/eRsGzByp+sDc99bJuQihprZE7UJrzq7orS/5rivQ59HFOeCG5qRmQfoIPv65TeKuWI8hQW3bBMj+paacOswWHhF99OgcrRBkdd2SrhqZrmRFl1nSy9KivGqSXwRYY+FF6hSNivPRsI169KUPEcLEuLx6lHG6/4CFkdbRh0wIL uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa new file mode 100644 index 0000000000..01a88acea2 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa @@ -0,0 +1,12 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQC97XncQDaa9PQYEWK7llBxZQ2suVYTz1eadw2HtY+Y8ZKdUBLd +9LUQ2lymUC9yq66rb5pBBR13k/9Zcbu8I0nafrZT4wJ4H0YGD6Ob5O4HR4EHjO5q +hgnMJ17e1XnzI31MW5xAuAHTLLClNvnG05T1jaU+tRAsVSCHin3+sOenowIVAMSe +ANBvw7fm5+Lw+ziOAHPjeYzRAoGBALkWCGpKmlJ65F3Y/RcownHQvsrDAllzKF/a +cSfriCVVP5qVZ3Ach28ZZ9BFEnRE2SKqVsyBAiceb/+ISlu8CqKEvvoNIMJAu5rU +MwZh+PeHN4ES6tWTwBGAwu84ke6N4BgV+6Q4qkcyywHsT5oU0EdVbn2zzAZw8c7v +BpbsJ1KsAoGABraHWqSFhaX4+GHmtKwXZFVRKh/4R6GR2LpkFzGm3Ixv+eo9K5CI +TjiBYiVMrWH23G1LiDuJyMGqHEnIef+sorNfNzdnwq+8qRCTS6mbpRXkUt9p1arJ +MIKmosS+GFhTN6Z85gCwC51S2EDC4GW7J4ViHKacr1FwJSw9RC9F+WsCFQCRJayH +P4vM1XUOVEeX7u04K1EAFg== +-----END DSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa.pub new file mode 100644 index 0000000000..30661d5adf --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_dsa.pub @@ -0,0 +1 @@ +ssh-dss AAAAB3NzaC1kc3MAAACBAL3tedxANpr09BgRYruWUHFlDay5VhPPV5p3DYe1j5jxkp1QEt30tRDaXKZQL3KrrqtvmkEFHXeT/1lxu7wjSdp+tlPjAngfRgYPo5vk7gdHgQeM7mqGCcwnXt7VefMjfUxbnEC4AdMssKU2+cbTlPWNpT61ECxVIIeKff6w56ejAAAAFQDEngDQb8O35ufi8Ps4jgBz43mM0QAAAIEAuRYIakqaUnrkXdj9FyjCcdC+ysMCWXMoX9pxJ+uIJVU/mpVncByHbxln0EUSdETZIqpWzIECJx5v/4hKW7wKooS++g0gwkC7mtQzBmH494c3gRLq1ZPAEYDC7ziR7o3gGBX7pDiqRzLLAexPmhTQR1VufbPMBnDxzu8GluwnUqwAAACABraHWqSFhaX4+GHmtKwXZFVRKh/4R6GR2LpkFzGm3Ixv+eo9K5CITjiBYiVMrWH23G1LiDuJyMGqHEnIef+sorNfNzdnwq+8qRCTS6mbpRXkUt9p1arJMIKmosS+GFhTN6Z85gCwC51S2EDC4GW7J4ViHKacr1FwJSw9RC9F+Ws= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa new file mode 100644 index 0000000000..60e8f6eb6e --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIC557KPgmq+pWOAh1L8DV8GWW0u7W5vz6mim3FFB1l8koAoGCCqGSM49 +AwEHoUQDQgAEC3J5fQ8+8xQso0lhBdoLdvD14oSsQiMuweXq+Dy2+4Mjdw2/bbw0 +CvbE2+KWNcgwxRLycNGcMCBdf/cOgNyGkA== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256 b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256 new file mode 100644 index 0000000000..60e8f6eb6e --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256 @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIC557KPgmq+pWOAh1L8DV8GWW0u7W5vz6mim3FFB1l8koAoGCCqGSM49 +AwEHoUQDQgAEC3J5fQ8+8xQso0lhBdoLdvD14oSsQiMuweXq+Dy2+4Mjdw2/bbw0 +CvbE2+KWNcgwxRLycNGcMCBdf/cOgNyGkA== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256.pub new file mode 100644 index 0000000000..b349d26da3 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa256.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBAtyeX0PPvMULKNJYQXaC3bw9eKErEIjLsHl6vg8tvuDI3cNv228NAr2xNviljXIMMUS8nDRnDAgXX/3DoDchpA= sshtester@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384 b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384 new file mode 100644 index 0000000000..ece6c8f284 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384 @@ -0,0 +1,6 @@ +-----BEGIN EC PRIVATE KEY----- +MIGkAgEBBDBdgJs/xThHiy/aY1ymtQ4B0URNnRCm8l2WZMFjua57+nvq4Duf+igN +pN/5p/+azLKgBwYFK4EEACKhZANiAATUw6pT/UW2HvTW6lL2BGY7NfUGEX285XVi +9AcTXH1K+TOekbGmcpSirlGzSb15Wycajpmaae5vAzH1nnvcVd3FYODVdDXTHgV/ +FeXQ+vaw7CZnEAKZsr8mjXRX3fEyO1E= +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384.pub new file mode 100644 index 0000000000..fd81e220f7 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa384.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBNTDqlP9RbYe9NbqUvYEZjs19QYRfbzldWL0BxNcfUr5M56RsaZylKKuUbNJvXlbJxqOmZpp7m8DMfWee9xV3cVg4NV0NdMeBX8V5dD69rDsJmcQApmyvyaNdFfd8TI7UQ== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521 b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521 new file mode 100644 index 0000000000..21c000ea03 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521 @@ -0,0 +1,7 @@ +-----BEGIN EC PRIVATE KEY----- +MIHbAgEBBEEhm0w3xcGILU8eP61mThVBwCJfyzrFktGf7cCa1ciL4YLsukd20Q3Z +yp0YcEDLcEm36CZGabgkEvblJ1Rx2lPTu6AHBgUrgQQAI6GBiQOBhgAEAYep8cX2 +7wUPw5pNYwFkWQXrJ2GSkmO8iHwkWJ6srRay/sF3WoPF/dyDVymFgirtsSTJ+D0u +ex4qphOOJxkd1Yf+ANHvDFN9LoBvbgtNLTRJlpuNLCdWQlt+mEnPMDGMV/HWHHiz +7/mWE+XUVIcQjhm5uv0ObI/wroZEurXMGEhTis3L +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521.pub new file mode 100644 index 0000000000..d9830da5de --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ecdsa521.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAGHqfHF9u8FD8OaTWMBZFkF6ydhkpJjvIh8JFierK0Wsv7Bd1qDxf3cg1cphYIq7bEkyfg9LnseKqYTjicZHdWH/gDR7wxTfS6Ab24LTS00SZabjSwnVkJbfphJzzAxjFfx1hx4s+/5lhPl1FSHEI4Zubr9DmyP8K6GRLq1zBhIU4rNyw== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa new file mode 100644 index 0000000000..2e50ac2304 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa @@ -0,0 +1,27 @@ +-----BEGIN RSA PRIVATE KEY----- +MIIEpQIBAAKCAQEA7+C3gLoflKybq4I+clbg2SWf6cXyHpnLNDnZeMvIbOz2X/Ce +XUm17DFeexTaVBs9Zq9WwDFOFkLQhbuXgpvB0shSY0nr+Em7InRM8AiRLxPe0txM +mFFhL+v083dYwgaJOo1PthNM/tGRZJu+0sQDqrmN7CusFHdZg2NTzTzbwWqPiuP/ +mf3o7W4CWqDTBzbYTgpWlH7vRZf9FYwT4on5YWzLA8TvO2TwBGTfTMK5nswH++iO +v4jKecoEwyBFMUSKqZ9UYHGw/kshHbltM65Ye/xjXEX0GxDdxu8ZyVKXd4acNbJJ +P0tcxN4GzKJiR6zNYwCzDhjqDEbM5qCGhShhgQIDAQABAoIBAQCucdGBP9mvmUcs +Fu+q3xttTztYGqfVMSrhtCA/BJOhA0K4ypegZ/Zw6gY3pBaSi6y/fEuuQSz0a2qR +lra8OOFflGa15hBA4/2/NKyu8swCXITy+1qIesYev43HcMePcolhl1qcorSfq2/8 +pnbDd+Diy0Y2thvSVmk2b4mF+/gkUx3CHLhgRMcxCHLG1VeqIfLf+pa0jIw94tZ5 +CoIoI096pDTsneO9xhh1QxWQRRFVqdf3Q9zyiBgJCggpX+1fVsbQejuEK4hKRBKx +SRPX/pX5aU+7+KSZ/DbtXGg1sCw9NUDFTIEV3UPmko4oWawNGv/CQAK80g3go28v +UnVf11BBAoGBAP2amIFp+Ps33A5eesT7g/NNkGqBEi5W37K8qzYJxqXJvH0xmpFo +8a3Je3PQRrzbTUJyISA6/XNnA62+bEvWiEXPiK3stQzNHoVz7ftCb19zgW4sLKRW +Qhjq7QsGeRrdksJnZ7ekfzOv658vHJPElS1MdPu2WWhiNvAjtmdyFQulAoGBAPIk +6831QAnCdp/ffH/K+cqV9vQYOFig8n4mQNNC+sLghrtZh9kbmTuuNKAhF56vdCCn +ABD/+RiLXKVsF0PvQ5g9wRLKaiJubXI7XEBemCCLhjtESxGpWEV8GalslUgE1cKs +d1pwSVjd0sYt0gOAf2VRhlbpSWhXA2xVll34xgetAoGAHaI089pYN7K9SgiMO/xP +3NxRZcCTSUrpdM9LClN2HOVH2zEyqI8kvnPuswfBXEwb6QnBCS0bdKKy8Vhw+yOk +ZNPtWrVwKoDFcj6rrlKDBRpQI3mR9doGezboYANvn04I2iKPIgxcuMNzuvQcWL/9 +1n86pDcYl3Pyi3kA1XGlN+kCgYEAz1boBxpqdDDsjGa8X1y5WUviAw8+KD3ghj5R +IdTnjbjeBUxbc38bTawUac0MQZexE0iMWQImFGs4sHkGzufwdErkqSdjjAoMc1T6 +4C9fifaOwO7wbLYZ3J2wB4/vn5RsSV6OcIVXeN2wXnvbqZ38+A+/vWnSrqJbTwdW +Uy7yup0CgYEA8M9vjpAoCr3XzNDwJyWRQcT7e+nRYUNDlXBl3jpQhHuJtnSnkoUv +HXYXEwvp8peycNzeVz5OwFVMzCH8OG4WiGN4Pmo0rDWHED/W7eIRHIitHGTzZ+Qw +gRxscoewblSLSkYMXidBLmQjr4U5bDBesRuGhm5NuLyMTa1f3Pc/90k= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa.pub new file mode 100644 index 0000000000..26e560d4f8 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_rsa.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDv4LeAuh+UrJurgj5yVuDZJZ/pxfIemcs0Odl4y8hs7PZf8J5dSbXsMV57FNpUGz1mr1bAMU4WQtCFu5eCm8HSyFJjSev4SbsidEzwCJEvE97S3EyYUWEv6/Tzd1jCBok6jU+2E0z+0ZFkm77SxAOquY3sK6wUd1mDY1PNPNvBao+K4/+Z/ejtbgJaoNMHNthOClaUfu9Fl/0VjBPiiflhbMsDxO87ZPAEZN9MwrmezAf76I6/iMp5ygTDIEUxRIqpn1RgcbD+SyEduW0zrlh7/GNcRfQbEN3G7xnJUpd3hpw1skk/S1zE3gbMomJHrM1jALMOGOoMRszmoIaFKGGB uabhnil@elxadlj3q32 diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index f317dfded4..3b0f01d1e8 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -42,9 +42,13 @@ TLS-1.1, and TLS-1.2.</item> <item>For security reasons SSL-2.0 is not supported.</item> <item>For security reasons SSL-3.0 is no longer supported by default, - but can be configured.</item> + but can be configured. (OTP 19) </item> + <item>For security reasons RSA key exchange cipher suites are no longer supported by default, + but can be configured. (OTP 21) </item> <item>For security reasons DES cipher suites are no longer supported by default, - but can be configured.</item> + but can be configured. (OTP 20) </item> + <item>For security reasons 3DES cipher suites are no longer supported by default, + but can be configured. (OTP 21) </item> <item> Renegotiation Indication Extension <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url> is supported </item> <item>Ephemeral Diffie-Hellman cipher suites are supported, diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 3b5a548f72..fb12a729b1 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -759,10 +759,12 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT} }. -next_dtls_record(Data, #state{protocol_buffers = #protocol_buffers{ +next_dtls_record(Data, StateName, #state{protocol_buffers = #protocol_buffers{ dtls_record_buffer = Buf0, dtls_cipher_texts = CT0} = Buffers} = State0) -> - case dtls_record:get_dtls_records(Data, Buf0) of + case dtls_record:get_dtls_records(Data, + acceptable_record_versions(StateName, State0), + Buf0) of {Records, Buf1} -> CT1 = CT0 ++ Records, next_record(State0#state{protocol_buffers = @@ -772,6 +774,11 @@ next_dtls_record(Data, #state{protocol_buffers = #protocol_buffers{ Alert end. +acceptable_record_versions(hello, _) -> + [dtls_record:protocol_version(Vsn) || Vsn <- ?ALL_DATAGRAM_SUPPORTED_VERSIONS]; +acceptable_record_versions(_, #state{negotiated_version = Version}) -> + [Version]. + dtls_handshake_events(Packets) -> lists:map(fun(Packet) -> {next_event, internal, {handshake, Packet}} @@ -829,7 +836,7 @@ handle_client_hello(#client_hello{client_version = ClientVersion} = Hello, %% raw data from socket, unpack records handle_info({Protocol, _, _, _, Data}, StateName, #state{data_tag = Protocol} = State0) -> - case next_dtls_record(Data, State0) of + case next_dtls_record(Data, StateName, State0) of {Record, State} -> next_event(StateName, Record, State); #alert{} = Alert -> diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index 2dcc6efc91..316de05532 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -30,7 +30,7 @@ -include("ssl_cipher.hrl"). %% Handling of incoming data --export([get_dtls_records/2, init_connection_states/2, empty_connection_state/1]). +-export([get_dtls_records/3, init_connection_states/2, empty_connection_state/1]). -export([save_current_connection_state/2, next_epoch/2, get_connection_state_by_epoch/3, replay_detect/2, init_connection_state_seq/2, current_connection_state_epoch/2]). @@ -163,17 +163,25 @@ current_connection_state_epoch(#{current_write := #{epoch := Epoch}}, Epoch. %%-------------------------------------------------------------------- --spec get_dtls_records(binary(), binary()) -> {[binary()], binary()} | #alert{}. +-spec get_dtls_records(binary(), [dtls_version()], binary()) -> {[binary()], binary()} | #alert{}. %% %% Description: Given old buffer and new data from UDP/SCTP, packs up a records %% and returns it as a list of tls_compressed binaries also returns leftover %% data %%-------------------------------------------------------------------- -get_dtls_records(Data, <<>>) -> - get_dtls_records_aux(Data, []); -get_dtls_records(Data, Buffer) -> - get_dtls_records_aux(list_to_binary([Buffer, Data]), []). - +get_dtls_records(Data, Versions, Buffer) -> + BinData = list_to_binary([Buffer, Data]), + case erlang:byte_size(BinData) of + N when N >= 3 -> + case assert_version(BinData, Versions) of + true -> + get_dtls_records_aux(BinData, []); + false -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end; + _ -> + get_dtls_records_aux(BinData, []) + end. %%==================================================================== %% Encoding DTLS records @@ -397,6 +405,8 @@ initial_connection_state(ConnectionEnd, BeastMitigation) -> client_verify_data => undefined, server_verify_data => undefined }. +assert_version(<<?BYTE(_), ?BYTE(MajVer), ?BYTE(MinVer), _/binary>>, Versions) -> + is_acceptable_version({MajVer, MinVer}, Versions). get_dtls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer), ?UINT16(Epoch), ?UINT48(SequenceNumber), @@ -431,15 +441,11 @@ get_dtls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer), epoch = Epoch, sequence_number = SequenceNumber, fragment = Data} | Acc]); -get_dtls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), +get_dtls_records_aux(<<?BYTE(_), ?BYTE(_MajVer), ?BYTE(_MinVer), ?UINT16(Length), _/binary>>, _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH -> ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); -get_dtls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc) - when Length0 > ?MAX_CIPHER_TEXT_LENGTH -> - ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); - get_dtls_records_aux(Data, Acc) -> case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of true -> diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index b0e38fb9ad..7c5cff3665 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -37,8 +37,8 @@ erl_suite_definition/1, cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6, suite/1, suites/1, all_suites/1, - 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, + ec_keyed_suites/0, chacha_suites/1, anonymous_suites/1, psk_suites/1, srp_suites/0, + rc4_suites/1, des_suites/1, rsa_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_mac_hash/4, is_stream_ciphersuite/1]). @@ -320,13 +320,28 @@ suites({_, Minor}) -> all_suites({3, _} = Version) -> suites(Version) - ++ anonymous_suites(Version) + ++ chacha_suites(Version) + ++ anonymous_suites(Version) ++ psk_suites(Version) ++ srp_suites() ++ rc4_suites(Version) - ++ des_suites(Version); + ++ des_suites(Version) + ++ rsa_suites(Version); all_suites(Version) -> dtls_v1:all_suites(Version). +%%-------------------------------------------------------------------- +-spec chacha_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. +%% +%% Description: Returns list of the chacha cipher suites, only supported +%% if explicitly set by user for now due to interop problems, proably need +%% to be fixed in crypto. +%%-------------------------------------------------------------------- +chacha_suites({3, _}) -> + [?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, + ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, + ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256]; +chacha_suites(_) -> + []. %%-------------------------------------------------------------------- -spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. @@ -334,7 +349,6 @@ all_suites(Version) -> %% Description: Returns a list of the anonymous cipher suites, only supported %% if explicitly set by user. Intended only for testing. %%-------------------------------------------------------------------- - anonymous_suites({3, N}) -> anonymous_suites(N); anonymous_suites({254, _} = Version) -> @@ -373,7 +387,6 @@ anonymous_suites(N) when N == 0; %%-------------------------------------------------------------------- psk_suites({3, N}) -> psk_suites(N); - psk_suites(N) when N >= 3 -> [ @@ -394,7 +407,6 @@ psk_suites(N) ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256, ?TLS_PSK_WITH_AES_128_CBC_SHA256 ] ++ psk_suites(0); - psk_suites(_) -> [?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA, ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA, @@ -430,7 +442,7 @@ srp_suites() -> ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA, ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA]. %%-------------------------------------------------------------------- --spec rc4_suites(Version::ssl_record:ssl_version()) -> [cipher_suite()]. +-spec rc4_suites(Version::ssl_record:ssl_version() | integer()) -> [cipher_suite()]. %% %% Description: Returns a list of the RSA|(ECDH/RSA)| (ECDH/ECDSA) %% with RC4 cipher suites, only supported if explicitly set by user. @@ -438,13 +450,15 @@ srp_suites() -> %% belonged to the user configured only category. %%-------------------------------------------------------------------- rc4_suites({3, 0}) -> + rc4_suites(0); +rc4_suites({3, Minor}) -> + rc4_suites(Minor) ++ rc4_suites(0); +rc4_suites(0) -> [?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5]; -rc4_suites({3, N}) when N =< 3 -> +rc4_suites(N) when N =< 3 -> [?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA, ?TLS_ECDHE_RSA_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_RC4_128_MD5, ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA, ?TLS_ECDH_RSA_WITH_RC4_128_SHA]. %%-------------------------------------------------------------------- @@ -456,9 +470,39 @@ rc4_suites({3, N}) when N =< 3 -> %%-------------------------------------------------------------------- des_suites(_)-> [?TLS_DHE_RSA_WITH_DES_CBC_SHA, - ?TLS_RSA_WITH_DES_CBC_SHA]. + ?TLS_RSA_WITH_DES_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 + ]. %%-------------------------------------------------------------------- +-spec rsa_suites(Version::ssl_record:ssl_version() | integer()) -> [cipher_suite()]. +%% +%% Description: Returns a list of the RSA key exchange +%% cipher suites, only supported if explicitly set by user. +%% Are not considered secure any more. +%%-------------------------------------------------------------------- +rsa_suites({3, 0}) -> + rsa_suites(0); +rsa_suites({3, Minor}) -> + rsa_suites(Minor) ++ rsa_suites(0); +rsa_suites(0) -> + [?TLS_RSA_WITH_AES_256_CBC_SHA, + ?TLS_RSA_WITH_AES_128_CBC_SHA, + ?TLS_RSA_WITH_3DES_EDE_CBC_SHA + ]; +rsa_suites(N) when N =< 3 -> + [ + ?TLS_RSA_WITH_AES_256_GCM_SHA384, + ?TLS_RSA_WITH_AES_256_CBC_SHA256, + ?TLS_RSA_WITH_AES_128_GCM_SHA256, + ?TLS_RSA_WITH_AES_128_CBC_SHA256 + ]. +%%-------------------------------------------------------------------- -spec suite_definition(cipher_suite()) -> erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. @@ -2301,7 +2345,7 @@ calc_mac_hash(Type, Version, MacSecret, SeqNo, Type, Length, PlainFragment). -is_stream_ciphersuite({_, rc4_128, _, _}) -> +is_stream_ciphersuite(#{cipher := rc4_128}) -> true; is_stream_ciphersuite(_) -> false. diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index cf2f3a2b62..2872ca9fe5 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -640,18 +640,34 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us flight_buffer = [] }. -next_tls_record(Data, #state{protocol_buffers = #protocol_buffers{tls_record_buffer = Buf0, - tls_cipher_texts = CT0} = Buffers} = State0) -> - case tls_record:get_tls_records(Data, Buf0) of +next_tls_record(Data, StateName, #state{protocol_buffers = + #protocol_buffers{tls_record_buffer = Buf0, + tls_cipher_texts = CT0} = Buffers} + = State0) -> + case tls_record:get_tls_records(Data, + acceptable_record_versions(StateName, State0), + Buf0) of {Records, Buf1} -> CT1 = CT0 ++ Records, next_record(State0#state{protocol_buffers = Buffers#protocol_buffers{tls_record_buffer = Buf1, tls_cipher_texts = CT1}}); #alert{} = Alert -> - Alert + handle_record_alert(Alert, State0) end. +acceptable_record_versions(hello, #state{ssl_options = #ssl_options{v2_hello_compatible = true}}) -> + [tls_record:protocol_version(Vsn) || Vsn <- ?ALL_AVAILABLE_VERSIONS ++ ['sslv2']]; +acceptable_record_versions(hello, _) -> + [tls_record:protocol_version(Vsn) || Vsn <- ?ALL_AVAILABLE_VERSIONS]; +acceptable_record_versions(_, #state{negotiated_version = Version}) -> + [Version]. +handle_record_alert(#alert{description = ?BAD_RECORD_MAC}, + #state{ssl_options = #ssl_options{v2_hello_compatible = true}}) -> + ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION); +handle_record_alert(Alert, _) -> + Alert. + tls_handshake_events(Packets) -> lists:map(fun(Packet) -> {next_event, internal, {handshake, Packet}} @@ -660,7 +676,7 @@ tls_handshake_events(Packets) -> %% raw data from socket, upack records handle_info({Protocol, _, Data}, StateName, #state{data_tag = Protocol} = State0) -> - case next_tls_record(Data, State0) of + case next_tls_record(Data, StateName, State0) of {Record, State} -> next_event(StateName, Record, State); #alert{} = Alert -> diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index ab179c1bf0..188ec6809d 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -32,7 +32,7 @@ -include("ssl_cipher.hrl"). %% Handling of incoming data --export([get_tls_records/2, init_connection_states/2]). +-export([get_tls_records/3, init_connection_states/2]). %% Encoding TLS records -export([encode_handshake/3, encode_alert_record/3, @@ -75,16 +75,25 @@ init_connection_states(Role, BeastMitigation) -> pending_write => Pending}. %%-------------------------------------------------------------------- --spec get_tls_records(binary(), binary()) -> {[binary()], binary()} | #alert{}. +-spec get_tls_records(binary(), [tls_version()], binary()) -> {[binary()], binary()} | #alert{}. %% %% and returns it as a list of tls_compressed binaries also returns leftover %% Description: Given old buffer and new data from TCP, packs up a records %% data %%-------------------------------------------------------------------- -get_tls_records(Data, <<>>) -> - get_tls_records_aux(Data, []); -get_tls_records(Data, Buffer) -> - get_tls_records_aux(list_to_binary([Buffer, Data]), []). +get_tls_records(Data, Versions, Buffer) -> + BinData = list_to_binary([Buffer, Data]), + case erlang:byte_size(BinData) of + N when N >= 3 -> + case assert_version(BinData, Versions) of + true -> + get_tls_records_aux(BinData, []); + false -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end; + _ -> + get_tls_records_aux(BinData, []) + end. %%==================================================================== %% Encoding @@ -385,6 +394,19 @@ initial_connection_state(ConnectionEnd, BeastMitigation) -> server_verify_data => undefined }. +assert_version(<<1:1, Length0:15, Data0:Length0/binary, _/binary>>, Versions) -> + case Data0 of + <<?BYTE(?CLIENT_HELLO), ?BYTE(Major), ?BYTE(Minor), _/binary>> -> + %% First check v2_hello_compatible mode is active + lists:member({2,0}, Versions) andalso + %% andalso we want to negotiate higher version + lists:member({Major, Minor}, Versions -- [{2,0}]); + _ -> + false + end; +assert_version(<<?BYTE(_), ?BYTE(MajVer), ?BYTE(MinVer), _/binary>>, Versions) -> + is_acceptable_version({MajVer, MinVer}, Versions). + get_tls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer), ?UINT16(Length), Data:Length/binary, Rest/binary>>, Acc) -> @@ -428,10 +450,9 @@ get_tls_records_aux(<<1:1, Length0:15, Data0:Length0/binary, Rest/binary>>, end; get_tls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), - ?UINT16(Length), _/binary>>, + ?UINT16(Length), _/binary>>, _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH -> ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); - get_tls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc) when Length0 > ?MAX_CIPHER_TEXT_LENGTH -> ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index a8fe119bf8..a31ab8d044 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -202,23 +202,13 @@ suites(Minor) when Minor == 1; Minor == 2 -> ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA, ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA, - ?TLS_RSA_WITH_AES_256_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_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_ECDH_RSA_WITH_AES_128_CBC_SHA ]; suites(3) -> [?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384, @@ -230,16 +220,10 @@ suites(3) -> ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384, ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384, - ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, - ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, - ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, - ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384, ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256, - ?TLS_RSA_WITH_AES_256_GCM_SHA384, - ?TLS_RSA_WITH_AES_256_CBC_SHA256, ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256, ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256, @@ -253,9 +237,7 @@ suites(3) -> ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, - ?TLS_RSA_WITH_AES_128_GCM_SHA256, - ?TLS_RSA_WITH_AES_128_CBC_SHA256 + ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256 %% not supported %% ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384, @@ -264,8 +246,6 @@ suites(3) -> %% ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256 ] ++ suites(2). - - signature_algs({3, 3}, HashSigns) -> CryptoSupports = crypto:supports(), Hashes = proplists:get_value(hashs, CryptoSupports), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 3b4ca40058..6d954a1d3f 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -213,6 +213,8 @@ cipher_tests() -> ciphers_rsa_signed_certs_openssl_names, ciphers_dsa_signed_certs, ciphers_dsa_signed_certs_openssl_names, + chacha_rsa_cipher_suites, + chacha_ecdsa_cipher_suites, anonymous_cipher_suites, psk_cipher_suites, psk_with_hint_cipher_suites, @@ -280,8 +282,11 @@ end_per_suite(_Config) -> init_per_group(GroupName, Config) when GroupName == basic_tls; GroupName == options_tls; + GroupName == options; GroupName == basic; - GroupName == options -> + GroupName == session; + GroupName == error_handling_tests_tls + -> ssl_test_lib:clean_tls_version(Config); init_per_group(GroupName, Config) -> case ssl_test_lib:is_tls_version(GroupName) andalso ssl_test_lib:sufficient_crypto_support(GroupName) of @@ -381,12 +386,12 @@ init_per_testcase(TestCase, Config) when TestCase == psk_cipher_suites; TestCase == anonymous_cipher_suites; TestCase == psk_anon_cipher_suites; TestCase == psk_anon_with_hint_cipher_suites; - TestCase == srp_cipher_suites, - TestCase == srp_anon_cipher_suites, - TestCase == srp_dsa_cipher_suites, - TestCase == des_rsa_cipher_suites, - TestCase == des_ecdh_rsa_cipher_suites, - TestCase == versions_option, + TestCase == srp_cipher_suites; + TestCase == srp_anon_cipher_suites; + TestCase == srp_dsa_cipher_suites; + TestCase == des_rsa_cipher_suites; + TestCase == des_ecdh_rsa_cipher_suites; + TestCase == versions_option; TestCase == tls_tcp_connect_big -> ssl_test_lib:ct_log_supported_protocol_versions(Config), ct:timetrap({seconds, 60}), @@ -427,6 +432,12 @@ init_per_testcase(rizzo_disabled, Config) -> ct:timetrap({seconds, 60}), rizzo_add_mitigation_option(disabled, Config); +init_per_testcase(TestCase, Config) when TestCase == no_reuses_session_server_restart_new_cert_file; + TestCase == no_reuses_session_server_restart_new_cert -> + ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), + ct:timetrap({seconds, 15}), + Config; + init_per_testcase(prf, Config) -> ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), ct:timetrap({seconds, 40}), @@ -655,7 +666,7 @@ connection_info(Config) when is_list(Config) -> {from, self()}, {mfa, {?MODULE, connection_info_result, []}}, {options, - [{ciphers,[{rsa, aes_128_cbc, sha}]} | + [{ciphers,[{dhe_rsa, aes_128_cbc, sha}]} | ClientOpts]}]), ct:log("Testcase ~p, Client ~p Server ~p ~n", @@ -663,7 +674,7 @@ connection_info(Config) when is_list(Config) -> Version = ssl_test_lib:protocol_version(Config), - ServerMsg = ClientMsg = {ok, {Version, {rsa, aes_128_cbc, sha}}}, + ServerMsg = ClientMsg = {ok, {Version, {dhe_rsa, aes_128_cbc, sha}}}, ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), @@ -1278,9 +1289,14 @@ cipher_suites() -> [{doc,"Test API function cipher_suites/0"}]. cipher_suites(Config) when is_list(Config) -> - MandatoryCipherSuite = {rsa,'3des_ede_cbc',sha}, - [_|_] = Suites = ssl:cipher_suites(), - true = lists:member(MandatoryCipherSuite, Suites), + MandatoryCipherSuiteTLS1_0TLS1_1 = {rsa,'3des_ede_cbc',sha}, + MandatoryCipherSuiteTLS1_0TLS1_2 = {rsa,'aes_128_cbc',sha} , + [_|_] = Suites = ssl:cipher_suites(), + AllSuites = ssl:cipher_suites(all), + %% The mandantory suites will no longer be supported by default + %% due to security reasons + true = lists:member(MandatoryCipherSuiteTLS1_0TLS1_1, AllSuites), + true = lists:member(MandatoryCipherSuiteTLS1_0TLS1_2, AllSuites), Suites = ssl:cipher_suites(erlang), [_|_] =ssl:cipher_suites(openssl). @@ -1289,7 +1305,7 @@ cipher_suites_mix() -> [{doc,"Test to have old and new cipher suites at the same time"}]. cipher_suites_mix(Config) when is_list(Config) -> - CipherSuites = [{ecdh_rsa,aes_128_cbc,sha256,sha256}, {rsa,aes_128_cbc,sha}], + CipherSuites = [{dhe_rsa,aes_128_cbc,sha256,sha256}, {dhe_rsa,aes_128_cbc,sha}], ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config), ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config), @@ -2357,7 +2373,24 @@ ciphers_dsa_signed_certs_openssl_names() -> ciphers_dsa_signed_certs_openssl_names(Config) when is_list(Config) -> Ciphers = ssl_test_lib:openssl_dsa_suites(), run_suites(Ciphers, Config, dsa). + +%%------------------------------------------------------------------- +chacha_rsa_cipher_suites()-> + [{doc,"Test the cacha with ECDSA signed certs ciphersuites"}]. +chacha_rsa_cipher_suites(Config) when is_list(Config) -> + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = [S || {KeyEx,_,_} = S <- ssl_test_lib:chacha_suites(NVersion), + KeyEx == ecdhe_rsa, KeyEx == dhe_rsa], + run_suites(Ciphers, Config, chacha_ecdsa). + %%------------------------------------------------------------------- +chacha_ecdsa_cipher_suites()-> + [{doc,"Test the cacha with ECDSA signed certs ciphersuites"}]. +chacha_ecdsa_cipher_suites(Config) when is_list(Config) -> + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = [S || {ecdhe_ecdsa,_,_} = S <- ssl_test_lib:chacha_suites(NVersion)], + run_suites(Ciphers, Config, chacha_rsa). +%%----------------------------------------------------------------- anonymous_cipher_suites()-> [{doc,"Test the anonymous ciphersuites"}]. anonymous_cipher_suites(Config) when is_list(Config) -> @@ -2437,14 +2470,15 @@ rc4_ecdsa_cipher_suites(Config) when is_list(Config) -> des_rsa_cipher_suites()-> [{doc, "Test the des_rsa ciphersuites"}]. des_rsa_cipher_suites(Config) when is_list(Config) -> - Ciphers = ssl_test_lib:des_suites(Config), + NVersion = tls_record:highest_protocol_version([]), + Ciphers = [S || {rsa,_,_} = S <- ssl_test_lib:des_suites(NVersion)], run_suites(Ciphers, Config, des_rsa). %------------------------------------------------------------------- des_ecdh_rsa_cipher_suites()-> [{doc, "Test ECDH rsa signed ciphersuites"}]. des_ecdh_rsa_cipher_suites(Config) when is_list(Config) -> NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = ssl_test_lib:des_suites(NVersion), + Ciphers = [S || {dhe_rsa,_,_} = S <- ssl_test_lib:des_suites(NVersion)], run_suites(Ciphers, Config, des_dhe_rsa). %%-------------------------------------------------------------------- @@ -3234,16 +3268,16 @@ tls_tcp_reuseaddr(Config) when is_list(Config) -> honor_server_cipher_order() -> [{doc,"Test API honor server cipher order."}]. honor_server_cipher_order(Config) when is_list(Config) -> - ClientCiphers = [{rsa, aes_128_cbc, sha}, {rsa, aes_256_cbc, sha}], - ServerCiphers = [{rsa, aes_256_cbc, sha}, {rsa, aes_128_cbc, sha}], -honor_cipher_order(Config, true, ServerCiphers, ClientCiphers, {rsa, aes_256_cbc, sha}). + ClientCiphers = [{dhe_rsa, aes_128_cbc, sha}, {dhe_rsa, aes_256_cbc, sha}], + ServerCiphers = [{dhe_rsa, aes_256_cbc, sha}, {dhe_rsa, aes_128_cbc, sha}], +honor_cipher_order(Config, true, ServerCiphers, ClientCiphers, {dhe_rsa, aes_256_cbc, sha}). honor_client_cipher_order() -> [{doc,"Test API honor server cipher order."}]. honor_client_cipher_order(Config) when is_list(Config) -> - ClientCiphers = [{rsa, aes_128_cbc, sha}, {rsa, aes_256_cbc, sha}], - ServerCiphers = [{rsa, aes_256_cbc, sha}, {rsa, aes_128_cbc, sha}], -honor_cipher_order(Config, false, ServerCiphers, ClientCiphers, {rsa, aes_128_cbc, sha}). + ClientCiphers = [{dhe_rsa, aes_128_cbc, sha}, {dhe_rsa, aes_256_cbc, sha}], + ServerCiphers = [{dhe_rsa, aes_256_cbc, sha}, {dhe_rsa, aes_128_cbc, sha}], +honor_cipher_order(Config, false, ServerCiphers, ClientCiphers, {dhe_rsa, aes_128_cbc, sha}). honor_cipher_order(Config, Honor, ServerCiphers, ClientCiphers, Expected) -> ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), @@ -4600,38 +4634,39 @@ client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == ecdh_rsa -> ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}. run_suites(Ciphers, Config, Type) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), Version = ssl_test_lib:protocol_version(Config), ct:log("Running cipher suites ~p~n", [Ciphers]), {ClientOpts, ServerOpts} = case Type of rsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), - ssl_test_lib:ssl_options(server_verification_opts, Config)}; + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_verification_opts, Config)]}; dsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), - ssl_test_lib:ssl_options(server_dsa_opts, Config)}; + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_dsa_opts, Config)]}; anonymous -> %% No certs in opts! {ssl_test_lib:ssl_options(client_verification_opts, Config), - [{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options([], Config)]}; psk -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_psk, Config)]}; psk_with_hint -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_psk_hint, Config) ]}; psk_anon -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_psk_anon, Config)]}; psk_anon_with_hint -> {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} | + [{ciphers, Ciphers} | ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]}; srp -> {ssl_test_lib:ssl_options(client_srp, Config), @@ -4644,7 +4679,8 @@ run_suites(Ciphers, Config, Type) -> ssl_test_lib:ssl_options(server_srp_dsa, Config)}; ecdsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), - ssl_test_lib:ssl_options(server_ecdsa_opts, Config)}; + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]}; ecdh_rsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}; @@ -4667,9 +4703,16 @@ run_suites(Ciphers, Config, Type) -> des_rsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_verification_opts, Config)]} + ssl_test_lib:ssl_options(server_verification_opts, Config)]}; + chacha_rsa -> + {ssl_test_lib:ssl_options(client_verification_opts, Config), + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_verification_opts, Config)]}; + chacha_ecdsa -> + {ssl_test_lib:ssl_options(client_verification_opts, Config), + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]} end, - Result = lists:map(fun(Cipher) -> cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end, ssl_test_lib:filter_suites(Ciphers, Version)), diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 03c3ed9be3..94d10b2f9b 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1024,15 +1024,26 @@ string_regex_filter(Str, Search) when is_list(Str) -> string_regex_filter(_Str, _Search) -> false. -anonymous_suites(Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:anonymous_suites(Version))]. - -psk_suites(Version) -> - [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:psk_suites(Version))]. - -psk_anon_suites(Version) -> - [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite)]. - +anonymous_suites({3,_ } = Version) -> + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:anonymous_suites(Version))]; +anonymous_suites(DTLSVersion) -> + Version = dtls_v1:corresponding_tls_version(DTLSVersion), + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:anonymous_suites(Version)), + not ssl_cipher:is_stream_ciphersuite(tuple_to_map(ssl_cipher:erl_suite_definition(S)))]. + +psk_suites({3,_ } = Version) -> + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:psk_suites(Version))]; +psk_suites(DTLSVersion) -> + Version = dtls_v1:corresponding_tls_version(DTLSVersion), + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:psk_suites(Version)), + not ssl_cipher:is_stream_ciphersuite(tuple_to_map(ssl_cipher:erl_suite_definition(S)))]. + +psk_anon_suites({3,_ } = Version) -> + [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite)]; +psk_anon_suites(DTLSVersion) -> + Version = dtls_v1:corresponding_tls_version(DTLSVersion), + [Suite || Suite <- psk_suites(Version), is_psk_anon_suite(Suite), + not ssl_cipher:is_stream_ciphersuite(tuple_to_map(Suite))]. srp_suites() -> [ssl_cipher:erl_suite_definition(Suite) || Suite <- @@ -1057,6 +1068,10 @@ srp_dss_suites() -> S <- [{srp_dss, '3des_ede_cbc', sha}, {srp_dss, aes_128_cbc, sha}, {srp_dss, aes_256_cbc, sha}]])]. + +chacha_suites(Version) -> + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:chacha_suites(Version))]. + rc4_suites(Version) -> [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:rc4_suites(Version))]. @@ -1335,8 +1350,9 @@ enough_openssl_crl_support(_) -> true. 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). +wait_for_openssl_server(_Port, dtls) -> + ok. %% No need to wait for DTLS over UDP server + %% client will retransmitt until it is up. do_wait_for_openssl_tls_server(_, 0) -> exit(failed_to_connect_to_openssl); @@ -1349,21 +1365,6 @@ do_wait_for_openssl_tls_server(Port, N) -> 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') -> @@ -1664,78 +1665,3 @@ hardcode_dsa_key(3) -> y = 48598545580251057979126570873881530215432219542526130654707948736559463436274835406081281466091739849794036308281564299754438126857606949027748889019480936572605967021944405048011118039171039273602705998112739400664375208228641666852589396502386172780433510070337359132965412405544709871654840859752776060358, x = 1457508827177594730669011716588605181448418352823}. -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 9118e4b7e3..33cdc325f4 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -201,11 +201,11 @@ init_per_testcase(expired_session, Config) -> init_per_testcase(TestCase, Config) when TestCase == ciphers_rsa_signed_certs; TestCase == ciphers_dsa_signed_certs -> - ct:timetrap({seconds, 60}), + ct:timetrap({seconds, 90}), special_init(TestCase, Config); init_per_testcase(TestCase, Config) -> - ct:timetrap({seconds, 20}), + ct:timetrap({seconds, 35}), special_init(TestCase, Config). special_init(TestCase, Config) @@ -1016,7 +1016,7 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> ct:log("Ports ~p~n", [[erlang:port_info(P) || P <- erlang:ports()]]), consume_port_exit(OpenSslPort), - ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}}), + ssl_test_lib:check_result(Server, {error, {tls_alert, "bad record mac"}}), process_flag(trap_exit, false). %%-------------------------------------------------------------------- ssl2_erlang_server_openssl_client_comp() -> diff --git a/lib/stdlib/doc/src/filelib.xml b/lib/stdlib/doc/src/filelib.xml index 5e631aac21..3b5be75bc0 100644 --- a/lib/stdlib/doc/src/filelib.xml +++ b/lib/stdlib/doc/src/filelib.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2003</year><year>2017</year> + <year>2003</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -296,7 +296,7 @@ filelib:wildcard("lib/**/*.{erl,hrl}")</code> for a file with the extension <c>.beam</c>, the default rule is to look for a file with a corresponding extension <c>.erl</c> by replacing the suffix <c>"ebin"</c> of the object directory path with - <c>"src"</c>. + <c>"src"</c> or <c>"src/*"</c>. The file search is done through <seealso marker="#find_file/3"><c>find_file/3</c></seealso>. The directory of the object file is always tried before any other directory specified diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml index d2608ad542..ce19f70df0 100644 --- a/lib/stdlib/doc/src/filename.xml +++ b/lib/stdlib/doc/src/filename.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2017</year> + <year>1997</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -399,15 +399,18 @@ true tuples <c>{<anno>BinSuffix</anno>, <anno>SourceSuffix</anno>}</c> and is interpreted as follows: if the end of the directory name where the object is located matches <c><anno>BinSuffix</anno></c>, then the - source code directory has the same name, but with - <c><anno>BinSuffix</anno></c> replaced by - <c><anno>SourceSuffix</anno></c>. <c><anno>Rules</anno></c> defaults + name created by replacing <c><anno>BinSuffix</anno></c> with + <c><anno>SourceSuffix</anno></c> is expanded by calling + <seealso marker="filelib#wildcard/1"> + <c>filelib:wildcard/1</c></seealso>. + If a regular file is found among the matches, the function + returns that location together with <c><anno>Options</anno></c>. + Otherwise the next rule is tried, and so on.</p> + <p><c><anno>Rules</anno></c> defaults to:</p> <code type="none"> -[{"", ""}, {"ebin", "src"}, {"ebin", "esrc"}]</code> - <p>If the source file is found in the resulting directory, the function - returns that location together with <c><anno>Options</anno></c>. - Otherwise the next rule is tried, and so on.</p> +[{"", ""}, {"ebin", "src"}, {"ebin", "esrc"}, + {"ebin", "src/*"}, {"ebin", "esrc/*"}]</code> <p>The function returns <c>{<anno>SourceFile</anno>, <anno>Options</anno>}</c> if it succeeds. <c><anno>SourceFile</anno></c> is the absolute path to the source diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index 4a824f073e..be0d64feba 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>2017</year> + <year>2016</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -543,7 +543,23 @@ handle_event(_, _, State, Data) -> <name name="event_type"/> <desc> <p> - External events are of three types: + There are 3 categories of events: + <seealso marker="#type-external_event_type">external</seealso>, + <seealso marker="#type-timeout_event_type">timeout</seealso>, + and <c>internal</c>. + </p> + <p> + <c>internal</c> events can only be generated by the + state machine itself through the state transition action + <seealso marker="#type-action"><c>next_event</c></seealso>. + </p> + </desc> + </datatype> + <datatype> + <name name="external_event_type"/> + <desc> + <p> + External events are of 3 types: <c>{call,<anno>From</anno>}</c>, <c>cast</c>, or <c>info</c>. <seealso marker="#call/2">Calls</seealso> (synchronous) and @@ -551,12 +567,17 @@ handle_event(_, _, State, Data) -> originate from the corresponding API functions. For calls, the event contains whom to reply to. Type <c>info</c> originates from regular process messages sent - to the <c>gen_statem</c>. The state machine - implementation can, in addition to the above, - generate - <seealso marker="#type-event_type"><c>events of types</c></seealso> - <c>timeout</c>, <c>{timeout,<anno>Name</anno>}</c>, - <c>state_timeout</c>, and <c>internal</c> to itself. + to the <c>gen_statem</c>. + </p> + </desc> + </datatype> + <datatype> + <name name="timeout_event_type"/> + <desc> + <p> + There are 3 types of timeout events that the state machine + can generate for itself with the corresponding + <seealso marker="#type-timeout_action">timeout_action()</seealso>s. </p> </desc> </datatype> @@ -1026,6 +1047,25 @@ handle_event(_, _, State, Data) -> for this state transition. </p> </item> + </taglist> + </desc> + </datatype> + <datatype> + <name name="timeout_action"/> + <desc> + <p> + These state transition actions can be invoked by + returning them from the + <seealso marker="#state callback">state callback</seealso>, from + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + or by giving them to + <seealso marker="#enter_loop/5"><c>enter_loop/5,6</c></seealso>. + </p> + <p> + These timeout actions sets timeout + <seealso marker="#type-transition_option">transition options</seealso>. + </p> + <taglist> <tag><c>Timeout</c></tag> <item> <p> diff --git a/lib/stdlib/doc/src/io.xml b/lib/stdlib/doc/src/io.xml index 64fcf4379f..72c774e6ef 100644 --- a/lib/stdlib/doc/src/io.xml +++ b/lib/stdlib/doc/src/io.xml @@ -257,8 +257,9 @@ ok</pre> \x{400} ok 5> <input>io:fwrite("~s~n",[[1024]]).</input> -** exception exit: {badarg,[{io,format,[<0.26.0>,"~s~n",[[1024]]]}, - ...</pre> +** exception error: bad argument + in function io:format/3 + called as io:format(<0.53.0>,"~s~n",[[1024]])</pre> </item> <tag><c>w</c></tag> <item> @@ -454,12 +455,9 @@ ok</pre> abc def 'abc def' {foo,1} A ok 2> <input>io:fwrite("~s", [65]).</input> -** exception exit: {badarg,[{io,format,[<0.22.0>,"~s","A"]}, - {erl_eval,do_apply,5}, - {shell,exprs,6}, - {shell,eval_exprs,6}, - {shell,eval_loop,3}]} - in function io:o_request/2</pre> +** exception error: bad argument + in function io:format/3 + called as io:format(<0.53.0>,"~s","A")</pre> <p>In this example, an attempt was made to output the single character 65 with the aid of the string formatting directive <c>"~s"</c>.</p> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index eafee346eb..4ee11383da 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -69,6 +69,9 @@ -type(non_local_function_handler() :: {value, nlfun_handler()} | none). +-define(STACKTRACE, + element(2, erlang:process_info(self(), current_stacktrace))). + %% exprs(ExpressionSeq, Bindings) %% exprs(ExpressionSeq, Bindings, LocalFuncHandler) %% exprs(ExpressionSeq, Bindings, LocalFuncHandler, ExternalFuncHandler) @@ -90,7 +93,7 @@ exprs(Exprs, Bs) -> ok -> exprs(Exprs, Bs, none, none, none); {error,{_Line,_Mod,Error}} -> - erlang:raise(error, Error, [{?MODULE,exprs,2}]) + erlang:raise(error, Error, ?STACKTRACE) end. -spec(exprs(Expressions, Bindings, LocalFunctionHandler) -> @@ -141,7 +144,7 @@ expr(E, Bs) -> ok -> expr(E, Bs, none, none, none); {error,{_Line,_Mod,Error}} -> - erlang:raise(error, Error, [{?MODULE,expr,2}]) + erlang:raise(error, Error, ?STACKTRACE) end. -spec(expr(Expression, Bindings, LocalFunctionHandler) -> @@ -182,7 +185,7 @@ check_command(Es, Bs) -> fun_data(F) when is_function(F) -> case erlang:fun_info(F, module) of - {module,erl_eval} -> + {module,?MODULE} -> case erlang:fun_info(F, env) of {env,[{FBs,_FLf,_FEf,FCs}]} -> {fun_data,FBs,FCs}; @@ -209,8 +212,8 @@ expr({var,_,V}, Bs, _Lf, _Ef, RBs) -> case binding(V, Bs) of {value,Val} -> ret_expr(Val, Bs, RBs); - unbound -> % Should not happen. - erlang:raise(error, {unbound,V}, stacktrace()) + unbound -> % Cannot not happen if checked by erl_lint + erlang:raise(error, {unbound,V}, ?STACKTRACE) end; expr({char,_,C}, Bs, _Lf, _Ef, RBs) -> ret_expr(C, Bs, RBs); @@ -236,13 +239,13 @@ expr({tuple,_,Es}, Bs0, Lf, Ef, RBs) -> {Vs,Bs} = expr_list(Es, Bs0, Lf, Ef), ret_expr(list_to_tuple(Vs), Bs, RBs); expr({record_field,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {undef_record,Name}, stacktrace()); + erlang:raise(error, {undef_record,Name}, ?STACKTRACE); expr({record_index,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {undef_record,Name}, stacktrace()); + erlang:raise(error, {undef_record,Name}, ?STACKTRACE); expr({record,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {undef_record,Name}, stacktrace()); + erlang:raise(error, {undef_record,Name}, ?STACKTRACE); expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {undef_record,Name}, stacktrace()); + erlang:raise(error, {undef_record,Name}, ?STACKTRACE); %% map expr({map,_,Binding,Es}, Bs0, Lf, Ef, RBs) -> @@ -281,7 +284,7 @@ expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) -> ret_expr(F, Bs, RBs); expr({'fun',_Line,{function,Name,Arity}}, _Bs0, _Lf, _Ef, _RBs) -> % R8 %% Don't know what to do... - erlang:raise(error, undef, [{erl_eval,Name,Arity}|stacktrace()]); + erlang:raise(error, undef, [{?MODULE,Name,Arity}|?STACKTRACE]); expr({'fun',Line,{clauses,Cs}} = Ex, Bs, Lf, Ef, RBs) -> %% Save only used variables in the function environment. %% {value,L,V} are hidden while lint finds used variables. @@ -326,7 +329,7 @@ expr({'fun',Line,{clauses,Cs}} = Ex, Bs, Lf, Ef, RBs) -> eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T], Info) end; _Other -> erlang:raise(error, {'argument_limit',{'fun',Line,Cs}}, - stacktrace()) + ?STACKTRACE) end, ret_expr(F, Bs, RBs); expr({named_fun,Line,Name,Cs} = Ex, Bs, Lf, Ef, RBs) -> @@ -378,7 +381,7 @@ expr({named_fun,Line,Name,Cs} = Ex, Bs, Lf, Ef, RBs) -> RF, Info) end; _Other -> erlang:raise(error, {'argument_limit',{named_fun,Line,Name,Cs}}, - stacktrace()) + ?STACKTRACE) end, ret_expr(F, Bs, RBs); expr({call,_,{remote,_,{atom,_,qlc},{atom,_,q}},[{lc,_,_E,_Qs}=LC | As0]}, @@ -422,25 +425,28 @@ expr({call,_,Func0,As0}, Bs0, Lf, Ef, RBs) -> % function or {Mod,Fun} {As,Bs2} = expr_list(As0, Bs1, Lf, Ef), case Func of {M,F} when is_atom(M), is_atom(F) -> - erlang:raise(error, {badfun,Func}, stacktrace()); + erlang:raise(error, {badfun,Func}, ?STACKTRACE); _ -> do_apply(Func, As, Bs2, Ef, RBs) end; expr({'catch',_,Expr}, Bs0, Lf, Ef, RBs) -> - Ref = make_ref(), - case catch {Ref,expr(Expr, Bs0, Lf, Ef, none)} of - {Ref,{value,V,Bs}} -> % Nothing was thrown (guaranteed). - ret_expr(V, Bs, RBs); - Other -> - ret_expr(Other, Bs0, RBs) + try expr(Expr, Bs0, Lf, Ef, none) of + {value,V,Bs} -> + ret_expr(V, Bs, RBs) + catch + throw:Term -> + ret_expr(Term, Bs0, RBs); + exit:Reason -> + ret_expr({'EXIT',Reason}, Bs0, RBs); + error:Reason:Stacktrace -> + ret_expr({'EXIT',{Reason,Stacktrace}}, Bs0, RBs) end; expr({match,_,Lhs,Rhs0}, Bs0, Lf, Ef, RBs) -> {value,Rhs,Bs1} = expr(Rhs0, Bs0, Lf, Ef, none), case match(Lhs, Rhs, Bs1) of {match,Bs} -> ret_expr(Rhs, Bs, RBs); - nomatch -> - erlang:raise(error, {badmatch,Rhs}, stacktrace()) + nomatch -> erlang:raise(error, {badmatch,Rhs}, ?STACKTRACE) end; expr({op,_,Op,A0}, Bs0, Lf, Ef, RBs) -> {value,A,Bs} = expr(A0, Bs0, Lf, Ef, none), @@ -452,7 +458,7 @@ expr({op,_,'andalso',L0,R0}, Bs0, Lf, Ef, RBs) -> {value,R,_} = expr(R0, Bs1, Lf, Ef, none), R; false -> false; - _ -> erlang:raise(error, {badarg,L}, stacktrace()) + _ -> erlang:raise(error, {badarg,L}, ?STACKTRACE) end, ret_expr(V, Bs1, RBs); expr({op,_,'orelse',L0,R0}, Bs0, Lf, Ef, RBs) -> @@ -462,7 +468,7 @@ expr({op,_,'orelse',L0,R0}, Bs0, Lf, Ef, RBs) -> false -> {value,R,_} = expr(R0, Bs1, Lf, Ef, none), R; - _ -> erlang:raise(error, {badarg,L}, stacktrace()) + _ -> erlang:raise(error, {badarg,L}, ?STACKTRACE) end, ret_expr(V, Bs1, RBs); expr({op,_,Op,L0,R0}, Bs0, Lf, Ef, RBs) -> @@ -474,7 +480,7 @@ expr({bin,_,Fs}, Bs0, Lf, Ef, RBs) -> {value,V,Bs} = eval_bits:expr_grp(Fs, Bs0, EvalFun), ret_expr(V, Bs, RBs); expr({remote,_,_,_}, _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, {badexpr,':'}, stacktrace()); + erlang:raise(error, {badexpr,':'}, ?STACKTRACE); expr({value,_,Val}, Bs, _Lf, _Ef, RBs) -> % Special case straight values. ret_expr(Val, Bs, RBs). @@ -570,7 +576,7 @@ local_func(Func, As, _Bs, {M,F,Eas}, _Ef, RBs) -> local_func2(apply(M, F, [Func,As|Eas]), RBs); %% Default unknown function handler to undefined function. local_func(Func, As0, _Bs0, none, _Ef, _RBs) -> - erlang:raise(error, undef, [{erl_eval,Func,length(As0)}|stacktrace()]). + erlang:raise(error, undef, [{?MODULE,Func,length(As0)}|?STACKTRACE]). local_func2({value,V,Bs}, RBs) -> ret_expr(V, Bs, RBs); @@ -637,7 +643,7 @@ do_apply(Func, As, Bs0, Ef, RBs) -> {{arity, Arity}, Arity} -> eval_fun(FCs, As, FBs, FLf, FEf, NRBs); _ -> - erlang:raise(error, {badarity,{Func,As}},stacktrace()) + erlang:raise(error, {badarity,{Func,As}},?STACKTRACE) end; {{env,[{FBs,FLf,FEf,FCs,FName}]},_} -> NRBs = if @@ -648,7 +654,7 @@ do_apply(Func, As, Bs0, Ef, RBs) -> {{arity, Arity}, Arity} -> eval_named_fun(FCs, As, FBs, FLf, FEf, FName, Func, NRBs); _ -> - erlang:raise(error, {badarity,{Func,As}},stacktrace()) + erlang:raise(error, {badarity,{Func,As}},?STACKTRACE) end; {no_env,none} when RBs =:= value -> %% Make tail recursive calls when possible. @@ -730,7 +736,7 @@ eval_generate([V|Rest], P, Bs0, Lf, Ef, CompFun, Acc) -> eval_generate([], _P, _Bs0, _Lf, _Ef, _CompFun, Acc) -> Acc; eval_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) -> - erlang:raise(error, {bad_generator,Term}, stacktrace()). + erlang:raise(error, {bad_generator,Term}, ?STACKTRACE). eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) -> Mfun = match_fun(Bs0), @@ -746,7 +752,7 @@ eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) -> Acc end; eval_b_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) -> - erlang:raise(error, {bad_generator,Term}, stacktrace()). + erlang:raise(error, {bad_generator,Term}, ?STACKTRACE). eval_filter(F, Bs0, Lf, Ef, CompFun, Acc) -> case erl_lint:is_guard_test(F) of @@ -760,7 +766,7 @@ eval_filter(F, Bs0, Lf, Ef, CompFun, Acc) -> {value,true,Bs1} -> CompFun(Bs1); {value,false,_} -> Acc; {value,V,_} -> - erlang:raise(error, {bad_filter,V}, stacktrace()) + erlang:raise(error, {bad_filter,V}, ?STACKTRACE) end end. @@ -816,7 +822,7 @@ eval_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, RBs) -> end; eval_fun([], As, _Bs, _Lf, _Ef, _RBs) -> erlang:raise(error, function_clause, - [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]). + [{?MODULE,'-inside-an-interpreted-fun-',As}|?STACKTRACE]). eval_named_fun(As, Fun, {Bs0,Lf,Ef,Cs,Name}) -> @@ -836,7 +842,7 @@ eval_named_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, Name, Fun, RBs) -> end; eval_named_fun([], As, _Bs, _Lf, _Ef, _Name, _Fun, _RBs) -> erlang:raise(error, function_clause, - [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]). + [{?MODULE,'-inside-an-interpreted-fun-',As}|?STACKTRACE]). %% expr_list(ExpressionList, Bindings) @@ -894,13 +900,13 @@ if_clauses([{clause,_,[],G,B}|Cs], Bs, Lf, Ef, RBs) -> false -> if_clauses(Cs, Bs, Lf, Ef, RBs) end; if_clauses([], _Bs, _Lf, _Ef, _RBs) -> - erlang:raise(error, if_clause, stacktrace()). + erlang:raise(error, if_clause, ?STACKTRACE). %% try_clauses(Body, CaseClauses, CatchClauses, AfterBody, Bindings, %% LocalFuncHandler, ExtFuncHandler, RBs) -%% When/if variable bindings between the different parts of a -%% try-catch expression are introduced this will have to be rewritten. + try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) -> + check_stacktrace_vars(Catches, Bs), try exprs(B, Bs, Lf, Ef, none) of {value,V,Bs1} when Cases =:= [] -> ret_expr(V, Bs1, RBs); @@ -909,23 +915,18 @@ try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) -> {B2,Bs2} -> exprs(B2, Bs2, Lf, Ef, RBs); nomatch -> - erlang:raise(error, {try_clause,V}, stacktrace()) + erlang:raise(error, {try_clause,V}, ?STACKTRACE) end catch - Class:Reason when Catches =:= [] -> - %% Rethrow - erlang:raise(Class, Reason, stacktrace()); - Class:Reason -> -%%% %% Set stacktrace -%%% try erlang:raise(Class, Reason, stacktrace()) -%%% catch _:_ -> ok -%%% end, - V = {Class,Reason,erlang:get_stacktrace()}, - case match_clause(Catches, [V],Bs, Lf, Ef) of + Class:Reason:Stacktrace when Catches =:= [] -> + erlang:raise(Class, Reason, Stacktrace); + Class:Reason:Stacktrace -> + V = {Class,Reason,Stacktrace}, + case match_clause(Catches, [V], Bs, Lf, Ef) of {B2,Bs2} -> exprs(B2, Bs2, Lf, Ef, RBs); nomatch -> - erlang:raise(Class, Reason, stacktrace()) + erlang:raise(Class, Reason, Stacktrace) end after if AB =:= [] -> @@ -935,6 +936,23 @@ try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs) -> end end. +check_stacktrace_vars([{clause,_,[{tuple,_,[_,_,STV]}],_,_}|Cs], Bs) -> + case STV of + {var,_,V} -> + case binding(V, Bs) of + {value, _} -> + erlang:raise(error, stacktrace_bound, ?STACKTRACE); + unbound -> + check_stacktrace_vars(Cs, Bs) + end; + _ -> + erlang:raise(error, + {illegal_stacktrace_variable,STV}, + ?STACKTRACE) + end; +check_stacktrace_vars([], _Bs) -> + ok. + %% case_clauses(Value, Clauses, Bindings, LocalFuncHandler, ExtFuncHandler, %% RBs) @@ -943,7 +961,7 @@ case_clauses(Val, Cs, Bs, Lf, Ef, RBs) -> {B, Bs1} -> exprs(B, Bs1, Lf, Ef, RBs); nomatch -> - erlang:raise(error, {case_clause,Val}, stacktrace()) + erlang:raise(error, {case_clause,Val}, ?STACKTRACE) end. %% @@ -1018,7 +1036,7 @@ guard0([G|Gs], Bs0, Lf, Ef) -> {value,false,_} -> false end; false -> - erlang:raise(error, guard_expr, stacktrace()) + erlang:raise(error, guard_expr, ?STACKTRACE) end; guard0([], _Bs, _Lf, _Ef) -> true. @@ -1073,7 +1091,7 @@ match(Pat, Term, Bs) -> match(Pat, Term, Bs, BBs) -> case catch match1(Pat, Term, Bs, BBs) of invalid -> - erlang:raise(error, {illegal_pattern,Pat}, stacktrace()); + erlang:raise(error, {illegal_pattern,Pat}, ?STACKTRACE); Other -> Other end. @@ -1254,7 +1272,7 @@ merge_bindings(Bs1, Bs2) -> case orddict:find(Name, Bs) of {ok,Val} -> Bs; %Already with SAME value {ok,V1} -> - erlang:raise(error, {badmatch,V1}, stacktrace()); + erlang:raise(error, {badmatch,V1}, ?STACKTRACE); error -> orddict:store(Name, Val, Bs) end end, Bs2, orddict:to_list(Bs1)). @@ -1264,7 +1282,7 @@ merge_bindings(Bs1, Bs2) -> %% fun (Name, Val, Bs) -> %% case orddict:find(Name, Bs) of %% {ok,Val} -> orddict:erase(Name, Bs); -%% {ok,V1} -> erlang:raise(error,{badmatch,V1},stacktrace()); +%% {ok,V1} -> erlang:raise(error,{badmatch,V1},?STACKTRACE); %% error -> Bs %% end %% end, Bs2, Bs1). @@ -1326,7 +1344,3 @@ ret_expr(_Old, New) -> New. line(Expr) -> element(2, Expr). - -%% {?MODULE,expr,3} is still the stacktrace, despite the -%% fact that expr() now takes two, three or four arguments... -stacktrace() -> [{?MODULE,expr,3}]. diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index 76f0b38108..5ee584d612 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -189,7 +189,7 @@ table(Name) -> %% Returns a list of names of the files in the tar file Name. %% Options accepted: compressed, verbose, cooked. -spec table(open_handle(), [compressed | verbose | cooked]) -> - {ok, [tar_entry()]} | {error, term()}. + {ok, [string() | tar_entry()]} | {error, term()}. table(Name, Opts) when is_list(Opts) -> foldl_read(Name, fun table1/4, [], table_opts(Opts)). diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl index 631faa3be5..bb86a65c72 100644 --- a/lib/stdlib/src/eval_bits.erl +++ b/lib/stdlib/src/eval_bits.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -25,6 +25,9 @@ -export([expr_grp/3,expr_grp/5,match_bits/6, match_bits/7,bin_gen/6]). +-define(STACKTRACE, + element(2, erlang:process_info(self(), current_stacktrace))). + %% Types used in this module: %% @type bindings(). An abstract structure for bindings between %% variables and values (the environment) @@ -93,9 +96,9 @@ eval_exp_field1(V, Size, Unit, Type, Endian, Sign) -> eval_exp_field(V, Size, Unit, Type, Endian, Sign) catch error:system_limit -> - error(system_limit); + erlang:raise(error, system_limit, ?STACKTRACE); error:_ -> - error(badarg) + erlang:raise(error, badarg, ?STACKTRACE) end. eval_exp_field(Val, Size, Unit, integer, little, signed) -> @@ -131,7 +134,7 @@ eval_exp_field(Val, all, Unit, binary, _, _) -> Size when Size rem Unit =:= 0 -> <<Val:Size/binary-unit:1>>; _ -> - error(badarg) + erlang:raise(error, badarg, ?STACKTRACE) end; eval_exp_field(Val, Size, Unit, binary, _, _) -> <<Val:(Size*Unit)/binary-unit:1>>. @@ -377,12 +380,12 @@ make_bit_type(Line, default, Type0) -> {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)}; {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)}; {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)}; - {error,Reason} -> error(Reason) + {error,Reason} -> erlang:raise(error, Reason, ?STACKTRACE) end; make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all' case erl_bits:set_bit_type(Size, Type0) of {ok,Size,Bt} -> {Size,erl_bits:as_list(Bt)}; - {error,Reason} -> error(Reason) + {error,Reason} -> erlang:raise(error, Reason, ?STACKTRACE) end. match_check_size(Mfun, Size, Bs) -> @@ -405,9 +408,3 @@ match_check_size(_, {value,_,_}, _Bs, _AllowAll) -> ok; %From the debugger. match_check_size(_, _, _Bs, _AllowAll) -> throw(invalid). - -%% error(Reason) -> exception thrown -%% Throw a nice-looking exception, similar to exceptions from erl_eval. -error(Reason) -> - erlang:raise(error, Reason, [{erl_eval,expr,3}]). - diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index 0f90b3fc33..de839be5cf 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. 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. @@ -582,17 +582,16 @@ default_search_rules() -> {"", ".c", c_source_search_rules()}, {"", ".in", basic_source_search_rules()}, %% plain old directory rules, backwards compatible - {"", ""}, - {"ebin","src"}, - {"ebin","esrc"} - ]. + {"", ""}] ++ erl_source_search_rules(). basic_source_search_rules() -> (erl_source_search_rules() ++ c_source_search_rules()). erl_source_search_rules() -> - [{"ebin","src"}, {"ebin","esrc"}]. + [{"ebin","src"}, {"ebin","esrc"}, + {"ebin",filename:join("src", "*")}, + {"ebin",filename:join("esrc", "*")}]. c_source_search_rules() -> [{"priv","c_src"}, {"priv","src"}, {"bin","c_src"}, {"bin","src"}, {"", "src"}]. @@ -672,8 +671,16 @@ try_dir_rule(Dir, Filename, From, To) -> Src = filename:join(NewDir, Filename), case is_regular(Src) of true -> {ok, Src}; - false -> error + false -> find_regular_file(wildcard(Src)) end; false -> error end. + +find_regular_file([]) -> + error; +find_regular_file([File|Files]) -> + case is_regular(File) of + true -> {ok, File}; + false -> find_regular_file(Files) + end. diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index a9b98911e2..73e4457bd0 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -125,7 +125,8 @@ | {'logfile', string()}. -type option() :: {'timeout', timeout()} | {'debug', [debug_flag()]} - | {'spawn_opt', [proc_lib:spawn_option()]}. + | {'spawn_opt', [proc_lib:spawn_option()]} + | {'hibernate_after', timeout()}. -type emgr_ref() :: atom() | {atom(), atom()} | {'global', atom()} | {'via', atom(), term()} | pid(). -type start_ret() :: {'ok', pid()} | {'error', term()}. diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 96a53426e2..8c7db65563 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -198,7 +198,7 @@ %%% start(Name, Mod, Args, Options) %%% start_link(Mod, Args, Options) %%% start_link(Name, Mod, Args, Options) where: -%%% Name ::= {local, atom()} | {global, atom()} | {via, atom(), term()} +%%% Name ::= {local, atom()} | {global, term()} | {via, atom(), term()} %%% Mod ::= atom(), callback module implementing the 'real' fsm %%% Args ::= term(), init arguments (to Mod:init/1) %%% Options ::= [{debug, [Flag]}] diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index cd6312855d..1a7736fc7e 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2016-2017. All Rights Reserved. +%% Copyright Ericsson AB 2016-2018. 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. @@ -78,9 +78,11 @@ -type data() :: term(). -type event_type() :: - {'call',From :: from()} | 'cast' | 'info' | - 'timeout' | {'timeout', Name :: term()} | 'state_timeout' | - 'internal'. + external_event_type() | timeout_event_type() | 'internal'. +-type external_event_type() :: + {'call',From :: from()} | 'cast' | 'info'. +-type timeout_event_type() :: + 'timeout' | {'timeout', Name :: term()} | 'state_timeout'. -type callback_mode_result() :: callback_mode() | [callback_mode() | state_enter()]. @@ -138,7 +140,9 @@ -type enter_action() :: 'hibernate' | % Set the hibernate option {'hibernate', Hibernate :: hibernate()} | - %% + timeout_action() | + reply_action(). +-type timeout_action() :: (Timeout :: event_timeout()) | % {timeout,Timeout} {'timeout', % Set the event_timeout option Time :: event_timeout(), EventContent :: term()} | @@ -159,9 +163,7 @@ {'state_timeout', % Set the state_timeout option Time :: state_timeout(), EventContent :: term(), - Options :: (timeout_option() | [timeout_option()])} | - %% - reply_action(). + Options :: (timeout_option() | [timeout_option()])}. -type reply_action() :: {'reply', % Reply to a caller From :: from(), Reply :: term()}. @@ -320,7 +322,13 @@ handle_event/4 % For callback_mode() =:= handle_event_function ]). + + %% Type validation functions +-compile( + {inline, + [callback_mode/1, state_enter/1, from/1, event_type/1]}). +%% callback_mode(CallbackMode) -> case CallbackMode of state_functions -> true; @@ -328,6 +336,14 @@ callback_mode(CallbackMode) -> _ -> false end. %% +state_enter(StateEnter) -> + case StateEnter of + state_enter -> + true; + _ -> + false + end. +%% from({Pid,_}) when is_pid(Pid) -> true; from(_) -> false. %% @@ -351,6 +367,48 @@ event_type(Type) -> STACKTRACE(), try throw(ok) catch _ -> erlang:get_stacktrace() end). +-define(not_sys_debug, []). +%% +%% This is a macro to only evaluate arguments if Debug =/= []. +%% Debug is evaluated multiple times. +-define( + sys_debug(Debug, NameState, Entry), + case begin Debug end of + ?not_sys_debug -> + begin Debug end; + _ -> + sys_debug(begin Debug end, begin NameState end, begin Entry end) + end). + +-record(state, + {callback_mode = undefined :: callback_mode() | undefined, + state_enter = false :: boolean(), + module :: atom(), + name :: atom(), + state :: term(), + data :: term(), + postponed = [] :: [{event_type(),term()}], + %% + timer_refs = #{} :: % timer ref => the timer's event type + #{reference() => timeout_event_type()}, + timer_types = #{} :: % timer's event type => timer ref + #{timeout_event_type() => reference()}, + cancel_timers = 0 :: non_neg_integer(), + %% 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 :: boolean(), + hibernate_after = infinity :: timeout()}). + +-record(trans_opts, + {hibernate = false, + postpone = false, + timeouts_r = [], + next_events_r = []}). + %%%========================================================================== %%% API @@ -422,6 +480,10 @@ stop(ServerRef, Reason, Timeout) -> %% Send an event to a state machine that arrives with type 'event' -spec cast(ServerRef :: server_ref(), Msg :: term()) -> ok. +cast(ServerRef, Msg) when is_pid(ServerRef) -> + send(ServerRef, wrap_cast(Msg)); +cast(ServerRef, Msg) when is_atom(ServerRef) -> + send(ServerRef, wrap_cast(Msg)); cast({global,Name}, Msg) -> try global:send(Name, wrap_cast(Msg)) of _ -> ok @@ -435,10 +497,6 @@ cast({via,RegMod,Name}, Msg) -> _:_ -> ok end; cast({Name,Node} = ServerRef, Msg) when is_atom(Name), is_atom(Node) -> - send(ServerRef, wrap_cast(Msg)); -cast(ServerRef, Msg) when is_atom(ServerRef) -> - send(ServerRef, wrap_cast(Msg)); -cast(ServerRef, Msg) when is_pid(ServerRef) -> send(ServerRef, wrap_cast(Msg)). %% Call a state machine (synchronous; a reply is expected) that @@ -455,73 +513,16 @@ call(ServerRef, Request) -> {'clean_timeout',T :: timeout()} | {'dirty_timeout',T :: timeout()}) -> Reply :: term(). +call(ServerRef, Request, infinity = T = Timeout) -> + call_dirty(ServerRef, Request, Timeout, T); +call(ServerRef, Request, {dirty_timeout, T} = Timeout) -> + call_dirty(ServerRef, Request, Timeout, T); +call(ServerRef, Request, {clean_timeout, T} = Timeout) -> + call_clean(ServerRef, Request, Timeout, T); +call(ServerRef, Request, {_, _} = Timeout) -> + erlang:error(badarg, [ServerRef,Request,Timeout]); call(ServerRef, Request, Timeout) -> - case parse_timeout(Timeout) of - {dirty_timeout,T} -> - try gen:call(ServerRef, '$gen_call', Request, T) of - {ok,Reply} -> - Reply - catch - Class:Reason -> - erlang:raise( - Class, - {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, - erlang:get_stacktrace()) - end; - {clean_timeout,T} -> - %% Call server through proxy process to dodge any late reply - Ref = make_ref(), - Self = self(), - Pid = spawn( - fun () -> - Self ! - try gen:call( - ServerRef, '$gen_call', Request, T) of - Result -> - {Ref,Result} - catch Class:Reason -> - {Ref,Class,Reason, - erlang:get_stacktrace()} - end - end), - Mref = monitor(process, Pid), - receive - {Ref,Result} -> - demonitor(Mref, [flush]), - case Result of - {ok,Reply} -> - Reply - end; - {Ref,Class,Reason,Stacktrace} -> - demonitor(Mref, [flush]), - erlang:raise( - Class, - {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, - Stacktrace); - {'DOWN',Mref,_,_,Reason} -> - %% There is a theoretical possibility that the - %% proxy process gets killed between try--of and ! - %% so this clause is in case of that - exit(Reason) - end; - Error when is_atom(Error) -> - erlang:error(Error, [ServerRef,Request,Timeout]) - end. - -parse_timeout(Timeout) -> - case Timeout of - {clean_timeout,_} -> - Timeout; - {dirty_timeout,_} -> - Timeout; - {_,_} -> - %% Be nice and throw a badarg for speling errors - badarg; - infinity -> - {dirty_timeout,infinity}; - T -> - {clean_timeout,T} - end. + call_clean(ServerRef, Request, Timeout, Timeout). %% Reply from a state machine callback to whom awaits in call/2 -spec reply([reply_action()] | reply_action()) -> ok. @@ -530,6 +531,7 @@ reply({reply,From,Reply}) -> reply(Replies) when is_list(Replies) -> replies(Replies). %% +-compile({inline, [reply/2]}). -spec reply(From :: from(), Reply :: term()) -> ok. reply({To,Tag}, Reply) when is_pid(To) -> Msg = {Tag,Reply}, @@ -579,9 +581,59 @@ enter_loop(Module, Opts, State, Data, Server, Actions) -> %%--------------------------------------------------------------------------- %% API helpers +-compile({inline, [wrap_cast/1]}). wrap_cast(Event) -> {'$gen_cast',Event}. +call_dirty(ServerRef, Request, Timeout, T) -> + try gen:call(ServerRef, '$gen_call', Request, T) of + {ok,Reply} -> + Reply + catch + Class:Reason -> + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + erlang:get_stacktrace()) + end. + +call_clean(ServerRef, Request, Timeout, T) -> + %% Call server through proxy process to dodge any late reply + Ref = make_ref(), + Self = self(), + Pid = spawn( + fun () -> + Self ! + try gen:call( + ServerRef, '$gen_call', Request, T) of + Result -> + {Ref,Result} + catch Class:Reason -> + {Ref,Class,Reason, + erlang:get_stacktrace()} + end + end), + Mref = monitor(process, Pid), + receive + {Ref,Result} -> + demonitor(Mref, [flush]), + case Result of + {ok,Reply} -> + Reply + end; + {Ref,Class,Reason,Stacktrace} -> + demonitor(Mref, [flush]), + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + Stacktrace); + {'DOWN',Mref,_,_,Reason} -> + %% There is a theoretical possibility that the + %% proxy process gets killed between try--of and ! + %% so this clause is in case of that + exit(Reason) + end. + replies([{reply,From,Reply}|Replies]) -> reply(From, Reply), replies(Replies); @@ -606,60 +658,28 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> %% The values should already have been type checked Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), - HibernateAfterTimeout = gen:hibernate_after(Opts), - Events = [], - P = [], + HibernateAfterTimeout = gen:hibernate_after(Opts), + Events = [], Event = {internal,init_state}, %% We enforce {postpone,false} to ensure that %% our fake Event gets discarded, thought it might get logged - NewActions = - if - is_list(Actions) -> - Actions ++ [{postpone,false}]; - 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, - module => Module, - name => Name, - state => State, - data => Data, - postponed => P, - %% - %% 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, - hibernate_after => HibernateAfterTimeout, - cancel_timers => CancelTimers - }, - NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), + NewActions = listify(Actions) ++ [{postpone,false}], + S = + #state{ + module = Module, + name = Name, + state = State, + data = Data, + hibernate_after = HibernateAfterTimeout}, + CallEnter = true, + NewDebug = ?sys_debug(Debug, {Name,State}, {enter,Event,State}), case call_callback_mode(S) of - {ok,NewS} -> + #state{} = NewS -> loop_event_actions( Parent, NewDebug, NewS, - Events, Event, State, Data, NewActions, true); - {Class,Reason,Stacktrace} -> + Events, Event, State, Data, #trans_opts{}, + NewActions, CallEnter); + [Class,Reason,Stacktrace] -> terminate( Class, Reason, Stacktrace, NewDebug, S, [Event|Events]) @@ -684,10 +704,8 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> proc_lib:init_ack(Starter, {error,Reason}), error_info( Class, Reason, Stacktrace, - #{name => Name, - callback_mode => undefined, - state_enter => false}, - [], [], undefined), + #state{name = Name}, + [], undefined), erlang:raise(Class, Reason, Stacktrace) end. @@ -717,10 +735,8 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> proc_lib:init_ack(Starter, {error,Error}), error_info( error, Error, ?STACKTRACE(), - #{name => Name, - callback_mode => undefined, - state_enter => false}, - [], [], undefined), + #state{name = Name}, + [], undefined), exit(Error) end. @@ -734,9 +750,10 @@ system_terminate(Reason, _Parent, Debug, S) -> terminate(exit, Reason, ?STACKTRACE(), Debug, S, []). system_code_change( - #{module := Module, - state := State, - data := Data} = S, + #state{ + module = Module, + state = State, + data = Data} = S, _Mod, OldVsn, Extra) -> case try Module:code_change(OldVsn, State, Data, Extra) @@ -746,29 +763,31 @@ system_code_change( of {ok,NewState,NewData} -> {ok, - S#{callback_mode := undefined, - state := NewState, - data := NewData}}; + S#state{ + callback_mode = undefined, + state = NewState, + data = NewData}}; {ok,_} = Error -> error({case_clause,Error}); Error -> Error end. -system_get_state(#{state := State, data := Data}) -> +system_get_state(#state{state = State, data = Data}) -> {ok,{State,Data}}. system_replace_state( StateFun, - #{state := State, - data := Data} = S) -> + #state{ + state = State, + data = Data} = S) -> {NewState,NewData} = Result = StateFun({State,Data}), - {ok,Result,S#{state := NewState, data := NewData}}. + {ok,Result,S#state{state = NewState, data = NewData}}. format_status( Opt, [PDict,SysState,Parent,Debug, - #{name := Name, postponed := P} = S]) -> + #state{name = Name, postponed = P} = S]) -> Header = gen:format_status_header("Status for state machine", Name), Log = sys:get_debug(log, Debug, []), [{header,Header}, @@ -787,6 +806,9 @@ format_status( %% them, not as the real erlang messages. Use trace for that. %%--------------------------------------------------------------------------- +sys_debug(Debug, NameState, Entry) -> + sys:handle_debug(Debug, fun print_event/3, NameState, Entry). + print_event(Dev, {in,Event}, {Name,State}) -> io:format( Dev, "*DBG* ~tp receive ~ts in state ~tp~n", @@ -819,15 +841,6 @@ event_string(Event) -> io_lib:format("~tw ~tp", [EventType,EventContent]) end. -sys_debug(Debug, #{name := Name}, State, Entry) -> - case Debug of - [] -> - Debug; - _ -> - sys:handle_debug( - Debug, fun print_event/3, {Name,State}, Entry) - end. - %%%========================================================================== %%% Internal callbacks @@ -842,14 +855,16 @@ 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 := true, cancel_timers := 0} = S) -> +loop(Parent, Debug, #state{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( @@ -857,17 +872,18 @@ loop_hibernate(Parent, Debug, S) -> {wakeup_from_hibernate,3}}). %% Entry point for wakeup_from_hibernate/3 -loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> +loop_receive( + Parent, Debug, #state{hibernate_after = HibernateAfterTimeout} = S) -> + %% receive Msg -> case Msg of {system,Pid,Req} -> - #{hibernate := Hibernate} = S, %% 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); + S#state.hibernate); {'EXIT',Parent,Reason} = EXIT -> %% EXIT is not a 2-tuple therefore %% not an event but this will stand out @@ -875,9 +891,9 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> Q = [EXIT], terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); {timeout,TimerRef,TimerMsg} -> - #{timer_refs := TimerRefs, - timer_types := TimerTypes, - hibernate := Hibernate} = S, + #state{ + timer_refs = TimerRefs, + timer_types = TimerTypes} = S, case TimerRefs of #{TimerRef := TimerType} -> %% We know of this timer; is it a running @@ -887,7 +903,6 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> #{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), @@ -895,11 +910,10 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> maps:remove(TimerType, TimerTypes), loop_receive_result( Parent, Debug, - S#{ - timer_refs := NewTimerRefs, - timer_types := NewTimerTypes}, - Hibernate, - Event); + S#state{ + timer_refs = NewTimerRefs, + timer_types = NewTimerTypes}, + TimerType, TimerMsg); _ -> %% This was a late timeout message %% from timer being cancelled, so @@ -909,14 +923,13 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> end; _ -> %% Not our timer; present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) + loop_receive_result(Parent, Debug, S, info, Msg) end; {cancel_timer,TimerRef,_} -> - #{timer_refs := TimerRefs, - cancel_timers := CancelTimers, - hibernate := Hibernate} = S, + #state{ + timer_refs = TimerRefs, + cancel_timers = CancelTimers, + hibernate = Hibernate} = S, case TimerRefs of #{TimerRef := _} -> %% We must have requested a cancel @@ -926,9 +939,9 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> maps:remove(TimerRef, TimerRefs), NewCancelTimers = CancelTimers - 1, NewS = - S#{ - timer_refs := NewTimerRefs, - cancel_timers := NewCancelTimers}, + S#state{ + timer_refs = NewTimerRefs, + cancel_timers = NewCancelTimers}, if Hibernate =:= true, NewCancelTimers =:= 0 -> %% No more cancel_timer msgs to expect; @@ -940,238 +953,631 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> _ -> %% Not our cancel_timer msg; %% present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) + loop_receive_result(Parent, Debug, S, info, Msg) end; _ -> %% External msg - #{hibernate := Hibernate} = S, - Event = - case Msg of - {'$gen_call',From,Request} -> - {{call,From},Request}; - {'$gen_cast',E} -> - {cast,E}; - _ -> - {info,Msg} - end, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) + case Msg of + {'$gen_call',From,Request} -> + loop_receive_result( + Parent, Debug, S, {call,From}, Request); + {'$gen_cast',Cast} -> + loop_receive_result(Parent, Debug, S, cast, Cast); + _ -> + loop_receive_result(Parent, Debug, S, info, Msg) + end end after HibernateAfterTimeout -> loop_hibernate(Parent, Debug, S) end. +loop_receive_result(Parent, ?not_sys_debug, S, Type, Content) -> + %% Here is the queue of not yet handled events created + Events = [], + loop_event(Parent, ?not_sys_debug, S, Events, Type, Content); loop_receive_result( - 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}), + Parent, Debug, #state{name = Name, state = State} = S, Type, Content) -> + NewDebug = sys_debug(Debug, {Name,State}, {in,{Type,Content}}), %% Here is the queue of not yet handled events created Events = [], - %% 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. + loop_event(Parent, NewDebug, S, Events, Type, Content). %% Entry point for handling an event, received or enqueued loop_event( + Parent, Debug, #state{hibernate = Hibernate} = S, + Events, Type, Content) -> + %% + case Hibernate of + true -> + %% + %% 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 + %% might rely on i.e collect garbage which + %% would have happened if we actually hibernated + %% and immediately was awakened. + %% + _ = garbage_collect(), + loop_event_state_function( + Parent, Debug, S, Events, Type, Content); + false -> + loop_event_state_function( + Parent, Debug, S, Events, Type, Content) + end. + +%% Call the state function +loop_event_state_function( Parent, Debug, - #{state := State, data := Data} = S, - Events, {Type,Content} = Event, Hibernate) -> + #state{state = State, data = Data} = S, + Events, Type, Content) -> + %% + %% The field 'hibernate' in S is now invalid and will be + %% restored when looping back to loop/3 or loop_event/6. %% - %% 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 - %% might rely on i.e collect garbage which - %% would have happened if we actually hibernated - %% and immediately was awakened - Hibernate andalso garbage_collect(), + Event = {Type,Content}, + TransOpts = false, case call_state_function(S, Type, Content, State, Data) of - {ok,Result,NewS} -> - {NextState,NewData,Actions,EnterCall} = - parse_event_result( - true, Debug, NewS, - Events, Event, State, Data, Result), - loop_event_actions( - Parent, Debug, NewS, - Events, Event, NextState, NewData, Actions, EnterCall); - {Class,Reason,Stacktrace} -> + {Result, NewS} -> + loop_event_result( + Parent, Debug, NewS, + Events, Event, State, Data, TransOpts, Result); + [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, - 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, EnterCall -> - loop_event_enter( - Parent, NewDebug, S, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR); - true -> - loop_event_result( - Parent, NewDebug, S, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR) - end; - {Class,Reason,Stacktrace} -> +%% Make a state enter call to the state function +loop_event_state_enter( + Parent, Debug, #state{state = PrevState} = S, + Events, Event, NextState, NewData, TransOpts) -> + %% + case call_state_function(S, enter, PrevState, NextState, NewData) of + {Result, NewS} -> + loop_event_result( + Parent, Debug, NewS, + Events, Event, NextState, NewData, TransOpts, Result); + [Class,Reason,Stacktrace] -> terminate( - Class, Reason, Stacktrace, Debug, S, - [Event|Events]) + Class, Reason, Stacktrace, Debug, S, [Event|Events]) end. -loop_event_enter( - 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} -> - 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, - hibernate := Hibernate}, - [Event|Events]) +%% Process the result from the state function. +%% When TransOpts =:= false it was a state function call, +%% otherwise it is an option tuple and it was a state enter call. +%% +loop_event_result( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, Result) -> + %% + case Result of + {next_state,State,NewData} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + [], false); + {next_state,NextState,NewData} + when TransOpts =:= false -> + loop_event_actions( + Parent, Debug, S, + Events, Event, NextState, NewData, TransOpts, + [], true); + {next_state,State,NewData,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + Actions, false); + {next_state,NextState,NewData,Actions} + when TransOpts =:= false -> + loop_event_actions( + Parent, Debug, S, + Events, Event, NextState, NewData, TransOpts, + Actions, true); + %% + {keep_state,NewData} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + [], false); + {keep_state,NewData,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + Actions, false); + %% + keep_state_and_data -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, + [], false); + {keep_state_and_data,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, + Actions, false); + %% + {repeat_state,NewData} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + [], true); + {repeat_state,NewData,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + Actions, true); + %% + repeat_state_and_data -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, + [], true); + {repeat_state_and_data,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, + Actions, true); + %% + stop -> + terminate( + exit, normal, ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]); + {stop,Reason} -> + terminate( + exit, Reason, ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]); + {stop,Reason,NewData} -> + terminate( + exit, Reason, ?STACKTRACE(), Debug, + S#state{ + state = State, data = NewData, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]); + %% + {stop_and_reply,Reason,Replies} -> + reply_then_terminate( + exit, Reason, ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events], Replies); + {stop_and_reply,Reason,Replies,NewData} -> + reply_then_terminate( + exit, Reason, ?STACKTRACE(), Debug, + S#state{ + state = State, data = NewData, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events], Replies); + %% + _ -> + terminate( + error, + {bad_return_from_state_function,Result}, + ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]) end. -loop_event_enter_actions( - Parent, Debug, #{state_enter := StateEnter} = S, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR, - Actions, EnterCall) -> - case - parse_enter_actions( - Debug, S, NextState, Actions, Hibernate, TimeoutsR) - of - {ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} -> - 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, - hibernate := Hibernate}, - [Event|Events]) +-compile({inline, [hibernate_in_trans_opts/1]}). +hibernate_in_trans_opts(false) -> + (#trans_opts{})#trans_opts.hibernate; +hibernate_in_trans_opts(#trans_opts{hibernate = Hibernate}) -> + Hibernate. + +%% Ensure that Actions are a list +loop_event_actions( + Parent, Debug, S, + Events, Event, NextState, NewerData, TransOpts, + Actions, CallEnter) -> + loop_event_actions_list( + Parent, Debug, S, + Events, Event, NextState, NewerData, TransOpts, + listify(Actions), CallEnter). + +%% Process actions from the state function +loop_event_actions_list( + Parent, Debug, #state{state_enter = StateEnter} = S, + Events, Event, NextState, NewerData, TransOpts, + Actions, CallEnter) -> + %% + case parse_actions(TransOpts, Debug, S, Actions) of + {NewDebug,NewTransOpts} + when StateEnter, CallEnter -> + loop_event_state_enter( + Parent, NewDebug, S, + Events, Event, NextState, NewerData, NewTransOpts); + {NewDebug,NewTransOpts} -> + loop_event_done( + Parent, NewDebug, S, + Events, Event, NextState, NewerData, NewTransOpts); + [Class,Reason,Stacktrace,NewDebug] -> + terminate( + Class, Reason, Stacktrace, NewDebug, + S#state{ + state = NextState, + data = NewerData, + hibernate = TransOpts#trans_opts.hibernate}, + [Event|Events]) end. -loop_event_result( +parse_actions(false, Debug, S, Actions) -> + parse_actions(true, Debug, S, Actions, #trans_opts{}); +parse_actions(TransOpts, Debug, S, Actions) -> + parse_actions(false, Debug, S, Actions, TransOpts). +%% +parse_actions(_StateCall, Debug, _S, [], TransOpts) -> + {Debug,TransOpts}; +parse_actions(StateCall, Debug, S, [Action|Actions], TransOpts) -> + case Action of + %% Actual actions + {reply,From,Reply} -> + parse_actions_reply( + StateCall, Debug, S, Actions, TransOpts, From, Reply); + %% + %% Actions that set options + {hibernate,NewHibernate} when is_boolean(NewHibernate) -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{hibernate = NewHibernate}); + hibernate -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{hibernate = true}); + %% + {postpone,NewPostpone} when not NewPostpone orelse StateCall -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{postpone = NewPostpone}); + postpone when StateCall -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{postpone = true}); + %% + {next_event,Type,Content} -> + parse_actions_next_event( + StateCall, Debug, S, Actions, TransOpts, Type, Content); + %% + _ -> + parse_actions_timeout( + StateCall, Debug, S, Actions, TransOpts, Action) + end. + +parse_actions_reply( + StateCall, ?not_sys_debug, S, Actions, TransOpts, + From, Reply) -> + %% + case from(From) of + true -> + reply(From, Reply), + parse_actions(StateCall, ?not_sys_debug, S, Actions, TransOpts); + false -> + [error, + {bad_action_from_state_function,{reply,From,Reply}}, + ?STACKTRACE(), + ?not_sys_debug] + end; +parse_actions_reply( + StateCall, Debug, #state{name = Name, state = State} = S, + Actions, TransOpts, From, Reply) -> + %% + case from(From) of + true -> + reply(From, Reply), + NewDebug = sys_debug(Debug, {Name,State}, {out,Reply,From}), + parse_actions(StateCall, NewDebug, S, Actions, TransOpts); + false -> + [error, + {bad_action_from_state_function,{reply,From,Reply}}, + ?STACKTRACE(), + Debug] + end. + +parse_actions_next_event( + StateCall, ?not_sys_debug, S, + Actions, TransOpts, Type, Content) -> + case event_type(Type) of + true when StateCall -> + NextEventsR = TransOpts#trans_opts.next_events_r, + parse_actions( + StateCall, ?not_sys_debug, S, Actions, + TransOpts#trans_opts{ + next_events_r = [{Type,Content}|NextEventsR]}); + _ -> + [error, + {bad_action_from_state_function,{next_events,Type,Content}}, + ?STACKTRACE(), + ?not_sys_debug] + end; +parse_actions_next_event( + StateCall, Debug, #state{name = Name, state = State} = S, + Actions, TransOpts, Type, Content) -> + case event_type(Type) of + true when StateCall -> + NewDebug = sys_debug(Debug, {Name,State}, {in,{Type,Content}}), + NextEventsR = TransOpts#trans_opts.next_events_r, + parse_actions( + StateCall, NewDebug, S, Actions, + TransOpts#trans_opts{ + next_events_r = [{Type,Content}|NextEventsR]}); + _ -> + [error, + {bad_action_from_state_function,{next_events,Type,Content}}, + ?STACKTRACE(), + Debug] + end. + +parse_actions_timeout( + StateCall, Debug, S, Actions, TransOpts, + {TimerType,Time,TimerMsg,TimerOpts} = AbsoluteTimeout) -> + %% + case classify_timer(Time, listify(TimerOpts)) of + absolute -> + parse_actions_timeout_add( + StateCall, Debug, S, Actions, + TransOpts, AbsoluteTimeout); + relative -> + RelativeTimeout = {TimerType,Time,TimerMsg}, + parse_actions_timeout_add( + StateCall, Debug, S, Actions, + TransOpts, RelativeTimeout); + badarg -> + [error, + {bad_action_from_state_function,AbsoluteTimeout}, + ?STACKTRACE(), + Debug] + end; +parse_actions_timeout( + StateCall, Debug, S, Actions, TransOpts, + {_,Time,_} = RelativeTimeout) -> + case classify_timer(Time, []) of + relative -> + parse_actions_timeout_add( + StateCall, Debug, S, Actions, + TransOpts, RelativeTimeout); + badarg -> + [error, + {bad_action_from_state_function,RelativeTimeout}, + ?STACKTRACE(), + Debug] + end; +parse_actions_timeout( + StateCall, Debug, S, Actions, TransOpts, + Timeout) -> + case classify_timer(Timeout, []) of + relative -> + parse_actions_timeout_add( + StateCall, Debug, S, Actions, TransOpts, Timeout); + badarg -> + [error, + {bad_action_from_state_function,Timeout}, + ?STACKTRACE(), + Debug] + end. + +parse_actions_timeout_add( + StateCall, Debug, S, Actions, + #trans_opts{timeouts_r = TimeoutsR} = TransOpts, Timeout) -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{timeouts_r = [Timeout|TimeoutsR]}). + +%% Do the state transition +loop_event_done( + Parent, ?not_sys_debug, + #state{postponed = P} = S, + Events, Event, NextState, NewData, + #trans_opts{ + postpone = Postpone, hibernate = Hibernate, + timeouts_r = [], next_events_r = []}) -> + %% + %% Optimize the simple cases + %% i.e no timer changes, no inserted events and no debug, + %% by duplicate stripped down code + %% + %% Fast path + %% + case Postpone of + true -> + loop_event_done_fast( + Parent, Hibernate, + S, + Events, [Event|P], NextState, NewData); + false -> + loop_event_done_fast( + Parent, Hibernate, + S, + Events, P, NextState, NewData) + end; +loop_event_done( Parent, Debug_0, - #{state := State, postponed := P_0, - timer_refs := TimerRefs_0, timer_types := TimerTypes_0, - cancel_timers := CancelTimers_0} = S_0, + #state{ + state = State, postponed = P_0, + timer_refs = TimerRefs_0, timer_types = TimerTypes_0, + cancel_timers = CancelTimers_0} = S, Events_0, Event_0, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR) -> + #trans_opts{ + hibernate = Hibernate, timeouts_r = TimeoutsR, + postpone = Postpone, next_events_r = NextEventsR}) -> %% %% All options have been collected and next_events are buffered. %% Do the actual state transition. %% - {Debug_1,P_1} = % Move current event to postponed if Postpone + %% Full feature path + %% + [Debug_1|P_1] = % Move current event to postponed if Postpone case Postpone of true -> - {sys_debug(Debug_0, S_0, State, {postpone,Event_0,State}), - [Event_0|P_0]}; + [?sys_debug( + Debug_0, + {S#state.name,State}, + {postpone,Event_0,State}), + Event_0|P_0]; false -> - {sys_debug(Debug_0, S_0, State, {consume,Event_0,State}), - P_0} + [?sys_debug( + Debug_0, + {S#state.name,State}, + {consume,Event_0,State})|P_0] end, - {Events_1,P_2,{TimerTypes_1,CancelTimers_1}} = - %% Move all postponed events to queue and cancel the - %% state timeout if the state changes + {Events_2,P_2,Timers_2} = + %% Move all postponed events to queue, + %% cancel the event timer, + %% and cancel the state timeout if the state changes if NextState =:= State -> - {Events_0,P_1,{TimerTypes_0,CancelTimers_0}}; + {Events_0,P_1, + cancel_timer_by_type( + timeout, {TimerTypes_0,CancelTimers_0})}; true -> {lists:reverse(P_1, Events_0), [], cancel_timer_by_type( - state_timeout, TimerTypes_0, CancelTimers_0)} - %% The state timer is removed from TimerTypes_1 - %% but remains in TimerRefs_0 until we get + state_timeout, + cancel_timer_by_type( + timeout, {TimerTypes_0,CancelTimers_0}))} + %% The state timer is removed from TimerTypes + %% but remains in TimerRefs until we get %% the cancel_timer msg end, - {TimerRefs_2,TimerTypes_2,CancelTimers_2,TimeoutEvents} = - %% Stop and start non-event timers - parse_timers(TimerRefs_0, TimerTypes_1, CancelTimers_1, TimeoutsR), + {TimerRefs_3,{TimerTypes_3,CancelTimers_3},TimeoutEvents} = + %% Stop and start timers + parse_timers(TimerRefs_0, Timers_2, TimeoutsR), %% Place next events last in reversed queue - Events_2R = lists:reverse(Events_1, NextEventsR), - %% Enqueue immediate timeout events and start event timer - 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] -> + Events_3R = lists:reverse(Events_2, NextEventsR), + %% Enqueue immediate timeout events + Events_4R = prepend_timeout_events(TimeoutEvents, Events_3R), + loop_event_done( + Parent, Debug_1, + S#state{ + state = NextState, + data = NewData, + postponed = P_2, + timer_refs = TimerRefs_3, + timer_types = TimerTypes_3, + cancel_timers = CancelTimers_3, + hibernate = Hibernate}, + lists:reverse(Events_4R)). + +%% Fast path +%% +loop_event_done_fast( + Parent, Hibernate, + #state{ + state = NextState, + timer_types = #{timeout := _} = TimerTypes, + cancel_timers = CancelTimers} = S, + Events, P, NextState, NewData) -> + %% + %% Same state, event timeout active + %% + loop_event_done_fast( + Parent, Hibernate, S, + Events, P, NextState, NewData, + cancel_timer_by_type( + timeout, {TimerTypes,CancelTimers})); +loop_event_done_fast( + Parent, Hibernate, + #state{state = NextState} = S, + Events, P, NextState, NewData) -> + %% + %% Same state + %% + loop_event_done( + Parent, ?not_sys_debug, + S#state{ + data = NewData, + postponed = P, + hibernate = Hibernate}, + Events); +loop_event_done_fast( + Parent, Hibernate, + #state{ + timer_types = #{timeout := _} = TimerTypes, + cancel_timers = CancelTimers} = S, + Events, P, NextState, NewData) -> + %% + %% State change, event timeout active + %% + loop_event_done_fast( + Parent, Hibernate, S, + lists:reverse(P, Events), [], NextState, NewData, + cancel_timer_by_type( + state_timeout, + cancel_timer_by_type( + timeout, {TimerTypes,CancelTimers}))); +loop_event_done_fast( + Parent, Hibernate, + #state{ + timer_types = #{state_timeout := _} = TimerTypes, + cancel_timers = CancelTimers} = S, + Events, P, NextState, NewData) -> + %% + %% State change, state timeout active + %% + loop_event_done_fast( + Parent, Hibernate, S, + lists:reverse(P, Events), [], NextState, NewData, + cancel_timer_by_type( + state_timeout, + cancel_timer_by_type( + timeout, {TimerTypes,CancelTimers}))); +loop_event_done_fast( + Parent, Hibernate, + #state{} = S, + Events, P, NextState, NewData) -> + %% + %% State change, no timeout to automatically cancel + %% + loop_event_done( + Parent, ?not_sys_debug, + S#state{ + state = NextState, + data = NewData, + postponed = [], + hibernate = Hibernate}, + lists:reverse(P, Events)). +%% +%% Fast path +%% +loop_event_done_fast( + Parent, Hibernate, S, + Events, P, NextState, NewData, + {TimerTypes,CancelTimers}) -> + %% + loop_event_done( + Parent, ?not_sys_debug, + S#state{ + state = NextState, + data = NewData, + postponed = P, + timer_types = TimerTypes, + cancel_timers = CancelTimers, + hibernate = Hibernate}, + Events). + +loop_event_done(Parent, Debug, S, Q) -> + case Q of + [] -> + %% Get a new event + loop(Parent, Debug, S); + [{Type,Content}|Events] -> %% Loop until out of enqueued events - loop_event(Parent, Debug_1, S_1, Events, Event, Hibernate) + loop_event(Parent, Debug, S, Events, Type, Content) end. %%--------------------------------------------------------------------------- %% Server loop helpers -call_callback_mode(#{module := Module} = S) -> +call_callback_mode(#state{module = Module} = S) -> try Module:callback_mode() of CallbackMode -> callback_mode_result(S, CallbackMode) @@ -1179,58 +1585,45 @@ call_callback_mode(#{module := Module} = S) -> CallbackMode -> callback_mode_result(S, CallbackMode); Class:Reason -> - {Class,Reason,erlang:get_stacktrace()} + [Class,Reason,erlang:get_stacktrace()] end. callback_mode_result(S, CallbackMode) -> - case - parse_callback_mode( - if - is_atom(CallbackMode) -> - [CallbackMode]; - true -> - CallbackMode - end, undefined, false) - of - {undefined,_} -> - {error, - {bad_return_from_callback_mode,CallbackMode}, - ?STACKTRACE()}; - {CBMode,StateEnter} -> - {ok, - S#{ - callback_mode := CBMode, - state_enter := StateEnter}} - end. - -parse_callback_mode([], CBMode, StateEnter) -> - {CBMode,StateEnter}; -parse_callback_mode([H|T], CBMode, StateEnter) -> + callback_mode_result( + S, CallbackMode, listify(CallbackMode), undefined, false). +%% +callback_mode_result(_S, CallbackMode, [], undefined, _StateEnter) -> + [error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE()]; +callback_mode_result(S, _CallbackMode, [], CBMode, StateEnter) -> + S#state{callback_mode = CBMode, state_enter = StateEnter}; +callback_mode_result(S, CallbackMode, [H|T], CBMode, StateEnter) -> case callback_mode(H) of true -> - parse_callback_mode(T, H, StateEnter); + callback_mode_result(S, CallbackMode, T, H, StateEnter); false -> - case H of - state_enter -> - parse_callback_mode(T, CBMode, true); - _ -> - {undefined,StateEnter} + case state_enter(H) of + true -> + callback_mode_result(S, CallbackMode, T, CBMode, true); + false -> + [error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE()] end - end; -parse_callback_mode(_, _CBMode, StateEnter) -> - {undefined,StateEnter}. + end. call_state_function( - #{callback_mode := undefined} = S, Type, Content, State, Data) -> + #state{callback_mode = undefined} = S, Type, Content, State, Data) -> case call_callback_mode(S) of - {ok,NewS} -> + #state{} = NewS -> call_state_function(NewS, Type, Content, State, Data); Error -> Error end; call_state_function( - #{callback_mode := CallbackMode, module := Module} = S, + #state{callback_mode = CallbackMode, module = Module} = S, Type, Content, State, Data) -> try case CallbackMode of @@ -1241,333 +1634,108 @@ call_state_function( end of Result -> - {ok,Result,S} + {Result,S} catch Result -> - {ok,Result,S}; + {Result,S}; Class:Reason -> - {Class,Reason,erlang:get_stacktrace()} - end. - - -%% Interpret all callback return variants -parse_event_result( - AllowStateChange, Debug, S, - Events, Event, State, Data, Result) -> - case Result of - stop -> - terminate( - exit, normal, ?STACKTRACE(), Debug, - S#{state := State, data := Data}, - [Event|Events]); - {stop,Reason} -> - terminate( - exit, Reason, ?STACKTRACE(), Debug, - S#{state := State, data := Data}, - [Event|Events]); - {stop,Reason,NewData} -> - terminate( - exit, Reason, ?STACKTRACE(), Debug, - S#{state := State, data := NewData}, - [Event|Events]); - %% - {stop_and_reply,Reason,Replies} -> - reply_then_terminate( - exit, Reason, ?STACKTRACE(), Debug, - S#{state := State, data := Data}, - [Event|Events], Replies); - {stop_and_reply,Reason,Replies,NewData} -> - reply_then_terminate( - exit, Reason, ?STACKTRACE(), Debug, - S#{state := State, data := NewData}, - [Event|Events], Replies); - %% - {next_state,State,NewData} -> - {State,NewData,[],false}; - {next_state,NextState,NewData} when AllowStateChange -> - {NextState,NewData,[],true}; - {next_state,State,NewData,Actions} -> - {State,NewData,Actions,false}; - {next_state,NextState,NewData,Actions} when AllowStateChange -> - {NextState,NewData,Actions,true}; - %% - {keep_state,NewData} -> - {State,NewData,[],false}; - {keep_state,NewData,Actions} -> - {State,NewData,Actions,false}; - keep_state_and_data -> - {State,Data,[],false}; - {keep_state_and_data,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#{state := State, data := Data}, - [Event|Events]) - end. - - -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 = [infinity], %% Will cancel event timer - Postpone = false, - NextEventsR = [], - parse_actions( - Debug, S, State, listify(Actions), - Hibernate, TimeoutsR, Postpone, NextEventsR). -%% -parse_actions( - Debug, _S, _State, [], - Hibernate, TimeoutsR, Postpone, NextEventsR) -> - {ok,Debug,Hibernate,TimeoutsR,Postpone,NextEventsR}; -parse_actions( - Debug, S, State, [Action|Actions], - Hibernate, TimeoutsR, Postpone, NextEventsR) -> - case Action of - %% Actual actions - {reply,From,Reply} -> - case from(From) of - true -> - NewDebug = do_reply(Debug, S, State, From, Reply), - parse_actions( - NewDebug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR); - false -> - {error, - {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 -> - NewHibernate = true, - parse_actions( - Debug, S, State, Actions, - NewHibernate, TimeoutsR, Postpone, NextEventsR); - %% - {postpone,NewPostpone} - when is_boolean(NewPostpone), Postpone =/= forbidden -> - parse_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR, NewPostpone, NextEventsR); - postpone when Postpone =/= forbidden -> - NewPostpone = true, - parse_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR, NewPostpone, NextEventsR); - %% - {next_event,Type,Content} -> - case event_type(Type) of - true when NextEventsR =/= forbidden -> - NewDebug = - sys_debug(Debug, S, State, {in,{Type,Content}}), - parse_actions( - NewDebug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, - [{Type,Content}|NextEventsR]); - _ -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()} - end; - %% - {{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); - {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); - {state_timeout,_,_} = Timeout -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - {state_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) + [Class,Reason,erlang:get_stacktrace()] end. -parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout) -> - case Timeout of - {TimerType,Time,TimerMsg,TimerOpts} -> - case validate_timer_args(Time, listify(TimerOpts)) of - true -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], - Postpone, NextEventsR); - false -> - NewTimeout = {TimerType,Time,TimerMsg}, - parse_actions( - Debug, S, State, Actions, - Hibernate, [NewTimeout|TimeoutsR], - Postpone, NextEventsR); - error -> - {error, - {bad_action_from_state_function,Timeout}, - ?STACKTRACE()} - end; - {_,Time,_} -> - case validate_timer_args(Time, []) of - false -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], - Postpone, NextEventsR); - error -> - {error, - {bad_action_from_state_function,Timeout}, - ?STACKTRACE()} - end; - Time -> - case validate_timer_args(Time, []) of - false -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], - Postpone, NextEventsR); - error -> - {error, - {bad_action_from_state_function,Timeout}, - ?STACKTRACE()} - end - end. -validate_timer_args(Time, Opts) -> - validate_timer_args(Time, Opts, false). +%% -> absolute | relative | badarg +classify_timer(Time, Opts) -> + classify_timer(Time, Opts, false). %% -validate_timer_args(Time, [], true) when is_integer(Time) -> - true; -validate_timer_args(Time, [], false) when is_integer(Time), Time >= 0 -> - false; -validate_timer_args(infinity, [], Abs) -> - Abs; -validate_timer_args(Time, [{abs,Abs}|Opts], _) when is_boolean(Abs) -> - validate_timer_args(Time, Opts, Abs); -validate_timer_args(_, [_|_], _) -> - error. +classify_timer(Time, [], Abs) -> + case Abs of + true when + is_integer(Time); + Time =:= infinity -> + absolute; + false when + is_integer(Time), 0 =< Time; + Time =:= infinity -> + relative; + _ -> + badarg + end; +classify_timer(Time, [{abs,Abs}|Opts], _) when is_boolean(Abs) -> + classify_timer(Time, Opts, Abs); +classify_timer(_, Opts, _) when is_list(Opts) -> + badarg. %% 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, CancelTimers, TimeoutsR) -> - parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR, #{}, []). +parse_timers(TimerRefs, Timers, TimeoutsR) -> + parse_timers(TimerRefs, Timers, TimeoutsR, #{}, []). %% parse_timers( - TimerRefs, TimerTypes, CancelTimers, [], _Seen, TimeoutEvents) -> - {TimerRefs,TimerTypes,CancelTimers,TimeoutEvents}; + TimerRefs, Timers, [], _Seen, TimeoutEvents) -> + %% + {TimerRefs,Timers,TimeoutEvents}; parse_timers( - TimerRefs, TimerTypes, CancelTimers, [Timeout|TimeoutsR], - Seen, TimeoutEvents) -> + TimerRefs, Timers, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> + %% case Timeout of {TimerType,Time,TimerMsg,TimerOpts} -> %% Absolute timer parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, TimerType, Time, TimerMsg, listify(TimerOpts)); %% Relative timers below {TimerType,0,TimerMsg} -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, TimerType, zero, TimerMsg, []); {TimerType,Time,TimerMsg} -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, TimerType, Time, TimerMsg, []); 0 -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, timeout, zero, 0, []); Time -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, timeout, Time, Time, []) end. parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, TimerType, Time, TimerMsg, TimerOpts) -> case Seen of #{TimerType := _} -> %% Type seen before - ignore parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents); + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents); #{} -> %% Unseen type - handle NewSeen = Seen#{TimerType => true}, case Time of infinity -> %% Cancel any running timer - {NewTimerTypes,NewCancelTimers} = - cancel_timer_by_type( - TimerType, TimerTypes, CancelTimers), parse_timers( - TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, - NewSeen, TimeoutEvents); + TimerRefs, cancel_timer_by_type(TimerType, Timers), + TimeoutsR, NewSeen, TimeoutEvents); zero -> %% Cancel any running timer - {NewTimerTypes,NewCancelTimers} = - cancel_timer_by_type( - TimerType, TimerTypes, CancelTimers), %% Handle zero time timeouts later - TimeoutEvent = {TimerType,TimerMsg}, parse_timers( - TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, - NewSeen, [TimeoutEvent|TimeoutEvents]); + TimerRefs, cancel_timer_by_type(TimerType, Timers), + TimeoutsR, NewSeen, + [{TimerType,TimerMsg}|TimeoutEvents]); _ -> %% (Re)start the timer TimerRef = erlang:start_timer( Time, self(), TimerMsg, TimerOpts), - case TimerTypes of - #{TimerType := OldTimerRef} -> + case Timers of + {#{TimerType := OldTimerRef} = TimerTypes, + CancelTimers} -> %% Cancel the running timer cancel_timer(OldTimerRef), NewCancelTimers = CancelTimers + 1, @@ -1575,17 +1743,17 @@ parse_timers( %% both TimerRefs and TimerTypes parse_timers( TimerRefs#{TimerRef => TimerType}, - TimerTypes#{TimerType => TimerRef}, - NewCancelTimers, TimeoutsR, - NewSeen, TimeoutEvents); - #{} -> + {TimerTypes#{TimerType => TimerRef}, + NewCancelTimers}, + TimeoutsR, NewSeen, TimeoutEvents); + {#{} = TimerTypes,CancelTimers} -> %% Insert the new timer into %% both TimerRefs and TimerTypes parse_timers( TimerRefs#{TimerRef => TimerType}, - TimerTypes#{TimerType => TimerRef}, - CancelTimers, TimeoutsR, - NewSeen, TimeoutEvents) + {TimerTypes#{TimerType => TimerRef}, + CancelTimers}, + TimeoutsR, NewSeen, TimeoutEvents) end end end. @@ -1607,6 +1775,8 @@ prepend_timeout_events([], EventsR) -> prepend_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) -> prepend_timeout_events(TimeoutEvents, [TimeoutEvent]); prepend_timeout_events([{timeout,_}|TimeoutEvents], EventsR) -> + %% Ignore since there are other events in queue + %% so they have cancelled the event timeout 0. prepend_timeout_events(TimeoutEvents, EventsR); prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) -> %% Just prepend all others @@ -1617,23 +1787,28 @@ prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) -> %%--------------------------------------------------------------------------- %% Server helpers -reply_then_terminate( - Class, Reason, Stacktrace, Debug, - #{state := State} = S, Q, Replies) -> +reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, Replies) -> do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, - S, Q, listify(Replies), State). + Class, Reason, Stacktrace, Debug, S, Q, listify(Replies)). %% do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, [], _State) -> + Class, Reason, Stacktrace, Debug, S, Q, []) -> terminate(Class, Reason, Stacktrace, Debug, S, Q); do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, [R|Rs], State) -> + Class, Reason, Stacktrace, Debug, S, Q, [R|Rs]) -> case R of {reply,{_To,_Tag}=From,Reply} -> - NewDebug = do_reply(Debug, S, State, From, Reply), + reply(From, Reply), + NewDebug = + ?sys_debug( + Debug, + begin + #state{name = Name, state = State} = S, + {Name,State} + end, + {out,Reply,From}), do_reply_then_terminate( - Class, Reason, Stacktrace, NewDebug, S, Q, Rs, State); + Class, Reason, Stacktrace, NewDebug, S, Q, Rs); _ -> terminate( error, @@ -1642,14 +1817,9 @@ do_reply_then_terminate( Debug, S, Q) end. -do_reply(Debug, S, State, From, Reply) -> - reply(From, Reply), - sys_debug(Debug, S, State, {out,Reply,From}). - - terminate( Class, Reason, Stacktrace, Debug, - #{module := Module, state := State, data := Data, postponed := P} = S, + #state{module = Module, state = State, data = Data} = S, Q) -> case erlang:function_exported(Module, terminate, 3) of true -> @@ -1660,7 +1830,7 @@ terminate( C:R -> ST = erlang:get_stacktrace(), error_info( - C, R, ST, S, Q, P, + C, R, ST, S, Q, format_status(terminate, get(), S)), sys:print_log(Debug), erlang:raise(C, R, ST) @@ -1671,14 +1841,14 @@ terminate( _ = case Reason of normal -> - sys_debug(Debug, S, State, {terminate,Reason}); + terminate_sys_debug(Debug, S, State, Reason); shutdown -> - sys_debug(Debug, S, State, {terminate,Reason}); + terminate_sys_debug(Debug, S, State, Reason); {shutdown,_} -> - sys_debug(Debug, S, State, {terminate,Reason}); + terminate_sys_debug(Debug, S, State, Reason); _ -> error_info( - Class, Reason, Stacktrace, S, Q, P, + Class, Reason, Stacktrace, S, Q, format_status(terminate, get(), S)), sys:print_log(Debug) end, @@ -1689,12 +1859,18 @@ terminate( erlang:raise(Class, Reason, Stacktrace) end. +terminate_sys_debug(Debug, S, State, Reason) -> + ?sys_debug(Debug, {S#state.name,State}, {terminate,Reason}). + + error_info( Class, Reason, Stacktrace, - #{name := Name, - callback_mode := CallbackMode, - state_enter := StateEnter}, - Q, P, FmtData) -> + #state{ + name = Name, + callback_mode = CallbackMode, + state_enter = StateEnter, + postponed = P}, + Q, FmtData) -> {FixedReason,FixedStacktrace} = case Stacktrace of [{M,F,Args,_}|ST] @@ -1775,7 +1951,7 @@ error_info( %% Call Module:format_status/2 or return a default value format_status( Opt, PDict, - #{module := Module, state := State, data := Data}) -> + #state{module = Module, state = State, data = Data}) -> case erlang:function_exported(Module, format_status, 2) of true -> try Module:format_status(Opt, [PDict,State,Data]) @@ -1800,6 +1976,7 @@ format_status_default(Opt, State, Data) -> [{data,[{"State",StateData}]}] end. +-compile({inline, [listify/1]}). listify(Item) when is_list(Item) -> Item; listify(Item) -> @@ -1813,14 +1990,16 @@ listify(Item) -> %% %% Remove the timer from TimerTypes. %% When we get the cancel_timer msg we remove it from TimerRefs. -cancel_timer_by_type(TimerType, TimerTypes, CancelTimers) -> +-compile({inline, [cancel_timer_by_type/2]}). +cancel_timer_by_type(TimerType, {TimerTypes,CancelTimers} = TT_CT) -> case TimerTypes of #{TimerType := TimerRef} -> - cancel_timer(TimerRef), + ok = erlang:cancel_timer(TimerRef, [{async,true}]), {maps:remove(TimerType, TimerTypes),CancelTimers + 1}; #{} -> - {TimerTypes,CancelTimers} + TT_CT end. +-compile({inline, [cancel_timer/1]}). cancel_timer(TimerRef) -> ok = erlang:cancel_timer(TimerRef, [{async,true}]). diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 3c8430b820..cacd9f2524 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -149,7 +149,7 @@ fread(Chars, Format) -> -spec fread(Continuation, CharSpec, Format) -> Return when Continuation :: continuation() | [], - CharSpec :: string() | eof, + CharSpec :: string() | 'eof', Format :: string(), Return :: {'more', Continuation1 :: continuation()} | {'done', Result, LeftOverChars :: string()}, diff --git a/lib/stdlib/src/io_lib_fread.erl b/lib/stdlib/src/io_lib_fread.erl index 983e8d4566..319bff484e 100644 --- a/lib/stdlib/src/io_lib_fread.erl +++ b/lib/stdlib/src/io_lib_fread.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -38,7 +38,7 @@ -spec fread(Continuation, String, Format) -> Return when Continuation :: io_lib:continuation() | [], - String :: string(), + String :: string() | 'eof', Format :: string(), Return :: {'more', Continuation1 :: io_lib:continuation()} | {'done', Result, LeftOverChars :: string()}, diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/lib.erl index a7980cc294..51e0c3f77e 100644 --- a/lib/stdlib/src/lib.erl +++ b/lib/stdlib/src/lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -551,7 +551,7 @@ format_stacktrace1(S0, Stack0, PF, SF, Enc) -> format_stacktrace2(S, Stack, 1, PF, Enc). format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF, Enc) when is_integer(A) -> - [io_lib:fwrite(<<"~s~s ~ts ~s">>, + [io_lib:fwrite(<<"~s~s ~ts ~ts">>, [sep(N, S), origin(N, M, F, A), mfa_to_string(M, F, A, Enc), location(L)]) @@ -573,7 +573,7 @@ location(L) -> Line = proplists:get_value(line, L), if File =/= undefined, Line =/= undefined -> - io_lib:format("(~s, line ~w)", [File, Line]); + io_lib:format("(~ts, line ~w)", [File, Line]); true -> "" end. diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 212b143b1d..ad4984b64c 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -701,7 +701,9 @@ exprs([E0|Es], Bs1, RT, Lf, Ef, Bs0, W) -> {W,V0}; true -> case result_will_be_saved() of true -> V0; - false -> ignored + false -> + erlang:garbage_collect(), + ignored end end, {{value,V,Bs,get()},Bs}; diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index 1f966411c5..0c578acf21 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -38,7 +38,9 @@ -export_type([dbg_opt/0]). --type name() :: pid() | atom() | {'global', atom()}. +-type name() :: pid() | atom() + | {'global', term()} + | {'via', module(), term()}. -type system_event() :: {'in', Msg :: _} | {'in', Msg :: _, From :: _} | {'out', Msg :: _, To :: _} diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 915f478dfa..9123bf2f28 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2017. All Rights Reserved. +%% Copyright Ericsson AB 1998-2018. 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. @@ -551,8 +551,8 @@ otp_8130(Config) when is_list(Config) -> "t() -> " " L = \"{ 34 , \\\"1\\\\x{AAA}\\\" , \\\"34\\\" , X . a , $\\\\x{AAA} }\", " " R = ?M({34,\"1\\x{aaa}\",\"34\",X.a,$\\x{aaa}})," - " Lt = erl_scan:string(L, 1, [unicode])," - " Rt = erl_scan:string(R, 1, [unicode])," + " Lt = erl_scan:string(L, 1)," + " Rt = erl_scan:string(R, 1)," " Lt = Rt, ok. ">>, ok}, diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index c3ef4eb051..8eb85cab8e 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-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. @@ -41,6 +41,7 @@ otp_8133/1, otp_10622/1, otp_13228/1, + otp_14826/1, funs/1, try_catch/1, eval_expr_5/1, @@ -57,6 +58,7 @@ -export([count_down/2, count_down_fun/0, do_apply/2, local_func/3, local_func_value/2]). +-export([simple/0]). -ifdef(STANDALONE). -define(config(A,B),config(A,B)). @@ -83,7 +85,7 @@ all() -> pattern_expr, match_bin, guard_3, guard_4, guard_5, lc, simple_cases, unary_plus, apply_atom, otp_5269, otp_6539, otp_6543, otp_6787, otp_6977, otp_7550, - otp_8133, otp_10622, otp_13228, + otp_8133, otp_10622, otp_13228, otp_14826, funs, try_catch, eval_expr_5, zero_width, eep37, eep43]. @@ -988,6 +990,173 @@ otp_13228(_Config) -> EFH = {value, fun({io, fwrite}, [atom]) -> io_fwrite end}, {value, worked, []} = parse_and_run("foo(io:fwrite(atom)).", LFH, EFH). +%% OTP-14826: more accurate stacktrace. +otp_14826(_Config) -> + backtrace_check("fun(P) when is_pid(P) -> true end(a).", + function_clause, + [{erl_eval,'-inside-an-interpreted-fun-',[a],[]}, + {erl_eval,eval_fun,6}, + ?MODULE]), + backtrace_check("B.", + {unbound_var, 'B'}, + [{erl_eval,expr,2}, ?MODULE]), + backtrace_check("B.", + {unbound, 'B'}, + [{erl_eval,expr,5}, ?MODULE], + none, none), + backtrace_check("1/0.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + backtrace_catch("catch 1/0.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + check(fun() -> catch exit(foo) end, + "catch exit(foo).", + {'EXIT', foo}), + check(fun() -> catch throw(foo) end, + "catch throw(foo).", + foo), + backtrace_check("try 1/0 after foo end.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + backtrace_catch("catch (try 1/0 after foo end).", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + backtrace_catch("try catch 1/0 after foo end.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + backtrace_check("try a of b -> bar after foo end.", + {try_clause,a}, + [{erl_eval,try_clauses,8}]), + check(fun() -> X = try foo:bar() catch A:B:C -> {A,B} end, X end, + "try foo:bar() catch A:B:C -> {A,B} end.", + {error, undef}), + backtrace_check("C = 4, try foo:bar() catch A:B:C -> {A,B,C} end.", + stacktrace_bound, + [{erl_eval,check_stacktrace_vars,2}, + {erl_eval,try_clauses,8}], + none, none), + backtrace_catch("catch (try a of b -> bar after foo end).", + {try_clause,a}, + [{erl_eval,try_clauses,8}]), + backtrace_check("try 1/0 catch exit:a -> foo end.", + badarith, + [{erlang,'/',[1,0],[]}, + {erl_eval,do_apply,6}]), + Es = [{'try',1,[{call,1,{remote,1,{atom,1,foo},{atom,1,bar}},[]}], + [], + [{clause,1,[{tuple,1,[{var,1,'A'},{var,1,'B'},{atom,1,'C'}]}], + [],[{tuple,1,[{var,1,'A'},{var,1,'B'},{atom,1,'C'}]}]}],[]}], + try + erl_eval:exprs(Es, [], none, none), + ct:fail(stacktrace_variable) + catch + error:{illegal_stacktrace_variable,{atom,1,'C'}}:S -> + [{erl_eval,check_stacktrace_vars,2,_}, + {erl_eval,try_clauses,8,_}|_] = S + end, + backtrace_check("{1,1} = {A = 1, A = 2}.", + {badmatch, 1}, + [erl_eval, {lists,foldl,3}]), + backtrace_check("case a of a when foo:bar() -> x end.", + guard_expr, + [{erl_eval,guard0,4}], none, none), + backtrace_check("case a of foo() -> ok end.", + {illegal_pattern,{call,1,{atom,1,foo},[]}}, + [{erl_eval,match,4}], none, none), + backtrace_check("case a of b -> ok end.", + {case_clause,a}, + [{erl_eval,case_clauses,6}, ?MODULE]), + backtrace_check("if a =:= b -> ok end.", + if_clause, + [{erl_eval,if_clauses,5}, ?MODULE]), + backtrace_check("fun A(b) -> ok end(a).", + function_clause, + [{erl_eval,'-inside-an-interpreted-fun-',[a],[]}, + {erl_eval,eval_named_fun,8}, + ?MODULE]), + backtrace_check("[A || A <- a].", + {bad_generator, a}, + [{erl_eval,eval_generate,7}, {erl_eval, eval_lc, 6}]), + backtrace_check("<< <<A>> || <<A>> <= a>>.", + {bad_generator, a}, + [{erl_eval,eval_b_generate,7}, {erl_eval, eval_bc, 6}]), + backtrace_check("[A || A <- [1], begin a end].", + {bad_filter, a}, + [{erl_eval,eval_filter,6}, {erl_eval, eval_generate, 7}]), + fun() -> + {'EXIT', {{badarity, {_Fun, []}}, BT}} = + (catch parse_and_run("fun(A) -> A end().")), + check_backtrace([{erl_eval,do_apply,5}, ?MODULE], BT) + end(), + fun() -> + {'EXIT', {{badarity, {_Fun, []}}, BT}} = + (catch parse_and_run("fun F(A) -> A end().")), + check_backtrace([{erl_eval,do_apply,5}, ?MODULE], BT) + end(), + backtrace_check("foo().", + undef, + [{erl_eval,foo,0},{erl_eval,local_func,6}], + none, none), + backtrace_check("a orelse false.", + {badarg, a}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("a andalso false.", + {badarg, a}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("t = u.", + {badmatch, u}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("{math,sqrt}(2).", + {badfun, {math,sqrt}}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("erl_eval_SUITE:simple().", + simple, + [{?MODULE,simple1,0},{?MODULE,simple,0},erl_eval]), + Args = [{integer,1,I} || I <- lists:seq(1, 30)], + backtrace_check("fun(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18," + "19,20,21,22,23,24,25,26,27,28,29,30) -> a end.", + {argument_limit, + {'fun',1,[{clause,1,Args,[],[{atom,1,a}]}]}}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("fun F(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18," + "19,20,21,22,23,24,25,26,27,28,29,30) -> a end.", + {argument_limit, + {named_fun,1,'F',[{clause,1,Args,[],[{atom,1,a}]}]}}, + [{erl_eval,expr,5}, ?MODULE]), + backtrace_check("#r{}.", + {undef_record,r}, + [{erl_eval,expr,5}, ?MODULE], + none, none), + %% eval_bits + backtrace_check("<<100:8/bitstring>>.", + badarg, + [{eval_bits,eval_exp_field1,6}, + eval_bits,eval_bits,erl_eval]), + backtrace_check("<<100:8/foo>>.", + {undefined_bittype,foo}, + [{eval_bits,make_bit_type,3},eval_bits, + eval_bits,erl_eval], + none, none), + backtrace_check("B = <<\"foo\">>, <<B/binary-unit:7>>.", + badarg, + [{eval_bits,eval_exp_field1,6}, + eval_bits,eval_bits,erl_eval], + none, none), + ok. + +simple() -> + A = simple1(), + {A}. + +simple1() -> + erlang:error(simple). + %% Simple cases, just to cover some code. funs(Config) when is_list(Config) -> do_funs(none, none), @@ -1488,6 +1657,43 @@ error_check(String, Result, LFH, EFH) -> ct:fail({eval, Other, Result}) end. +backtrace_check(String, Result, Backtrace) -> + case catch parse_and_run(String) of + {'EXIT', {Result, BT}} -> + check_backtrace(Backtrace, BT); + Other -> + ct:fail({eval, Other, Result}) + end. + +backtrace_check(String, Result, Backtrace, LFH, EFH) -> + case catch parse_and_run(String, LFH, EFH) of + {'EXIT', {Result, BT}} -> + check_backtrace(Backtrace, BT); + Other -> + ct:fail({eval, Other, Result}) + end. + +backtrace_catch(String, Result, Backtrace) -> + case parse_and_run(String) of + {value, {'EXIT', {Result, BT}}, _Bindings} -> + check_backtrace(Backtrace, BT); + Other -> + ct:fail({eval, Other, Result}) + end. + +check_backtrace([B1|Backtrace], [B2|BT]) -> + case {B1, B2} of + {M, {M,_,_,_}} -> + ok; + {{M,F,A}, {M,F,A,_}} -> + ok; + {B, B} -> + ok + end, + check_backtrace(Backtrace, BT); +check_backtrace([], _) -> + ok. + eval_string(String) -> {value, Result, _} = parse_and_run(String), Result. @@ -1499,8 +1705,8 @@ parse_and_run(String) -> parse_and_run(String, LFH, EFH) -> {ok,Tokens,_} = erl_scan:string(String), - {ok, [Expr]} = erl_parse:parse_exprs(Tokens), - erl_eval:expr(Expr, [], LFH, EFH). + {ok, Exprs} = erl_parse:parse_exprs(Tokens), + erl_eval:exprs(Exprs, [], LFH, EFH). no_final_dot(S) -> case lists:reverse(S) of diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 5efffc6a5c..e40f5e9a5d 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2017. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -3982,8 +3982,9 @@ non_latin1_module(Config) -> do_non_latin1_module(Mod) -> File = atom_to_list(Mod) ++ ".erl", - Forms = [{attribute,1,file,{File,1}}, - {attribute,1,module,Mod}, + L1 = erl_anno:new(1), + Forms = [{attribute,L1,file,{File,1}}, + {attribute,L1,module,Mod}, {eof,2}], error = compile:forms(Forms), {error,_,[]} = compile:forms(Forms, [return]), diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 808ba9b4c1..dda8d0a12e 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2017. All Rights Reserved. +%% Copyright Ericsson AB 2006-2018. 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. @@ -1262,7 +1262,7 @@ parse_forms(Chars) -> parse_forms2([], _Cont, _Line, Forms) -> lists:reverse(Forms); parse_forms2(String, Cont0, Line, Forms) -> - case erl_scan:tokens(Cont0, String, Line, [unicode]) of + case erl_scan:tokens(Cont0, String, Line) of {done, {ok, Tokens, EndLine}, Chars} -> {ok, Form} = erl_parse:parse_form(Tokens), parse_forms2(Chars, [], EndLine, [Form | Forms]); @@ -1303,7 +1303,7 @@ parse_and_pp_expr(String, Indent, Options) -> erl_pp:expr(parse_expr(StringDot), Indent, Options). parse_expr(Chars) -> - {ok, Tokens, _} = erl_scan:string(Chars, 1, [unicode]), + {ok, Tokens, _} = erl_scan:string(Chars, 1), {ok, [Expr]} = erl_parse:parse_exprs(Tokens), Expr. diff --git a/lib/stdlib/test/escript_SUITE_data/unicode1 b/lib/stdlib/test/escript_SUITE_data/unicode1 index 351bb785e5..8dc9d450b8 100755 --- a/lib/stdlib/test/escript_SUITE_data/unicode1 +++ b/lib/stdlib/test/escript_SUITE_data/unicode1 @@ -8,7 +8,7 @@ main(_) -> _D = erlang:system_flag(backtrace_depth, 0), A = <<"\x{aaa}"/utf8>>, S = lists:flatten(io_lib:format("~p/~p.", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B). diff --git a/lib/stdlib/test/escript_SUITE_data/unicode2 b/lib/stdlib/test/escript_SUITE_data/unicode2 index 495188f6f0..d0195b036c 100755 --- a/lib/stdlib/test/escript_SUITE_data/unicode2 +++ b/lib/stdlib/test/escript_SUITE_data/unicode2 @@ -8,7 +8,7 @@ main(_) -> _D = erlang:system_flag(backtrace_depth, 0), A = <<"\x{aa}">>, S = lists:flatten(io_lib:format("~p/~p.", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B). diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 930cea347f..7403d52881 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2017. All Rights Reserved. +%% Copyright Ericsson AB 2005-2018. 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. @@ -26,7 +26,7 @@ wildcard_one/1,wildcard_two/1,wildcard_errors/1, fold_files/1,otp_5960/1,ensure_dir_eexist/1,ensure_dir_symlink/1, wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1, - find_source/1]). + find_source/1, find_source_subdir/1]). -import(lists, [foreach/2]). @@ -49,7 +49,7 @@ all() -> [wildcard_one, wildcard_two, wildcard_errors, fold_files, otp_5960, ensure_dir_eexist, ensure_dir_symlink, wildcard_symlink, is_file_symlink, file_props_symlink, - find_source]. + find_source, find_source_subdir]. groups() -> []. @@ -567,16 +567,18 @@ find_source(Config) when is_list(Config) -> [{".erl",".yrl",[{"",""}]}]), {ok, ParserErl} = filelib:find_source(code:which(core_parse)), + ParserErlName = filename:basename(ParserErl), + ParserErlDir = filename:dirname(ParserErl), {ok, ParserYrl} = filelib:find_source(ParserErl), "lry." ++ _ = lists:reverse(ParserYrl), - {ok, ParserYrl} = filelib:find_source(ParserErl, + {ok, ParserYrl} = filelib:find_source(ParserErlName, ParserErlDir, [{".beam",".erl",[{"ebin","src"}]}, {".erl",".yrl",[{"",""}]}]), %% find_source automatically checks the local directory regardless of rules {ok, ParserYrl} = filelib:find_source(ParserErl), - {ok, ParserYrl} = filelib:find_source(ParserErl, - [{".beam",".erl",[{"ebin","src"}]}]), + {ok, ParserYrl} = filelib:find_source(ParserErlName, ParserErlDir, + [{".erl",".yrl",[{"ebin","src"}]}]), %% find_file does not check the local directory unless in the rules ParserYrlName = filename:basename(ParserYrl), @@ -590,3 +592,24 @@ find_source(Config) when is_list(Config) -> {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir), {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir, []), ok. + +find_source_subdir(Config) when is_list(Config) -> + BeamFile = code:which(inets), % Located in lib/inets/src/inets_app/ + BeamName = filename:basename(BeamFile), + BeamDir = filename:dirname(BeamFile), + SrcName = filename:basename(BeamFile, ".beam") ++ ".erl", + + {ok, SrcFile} = filelib:find_source(BeamName, BeamDir), + SrcName = filename:basename(SrcFile), + + {error, not_found} = + filelib:find_source(BeamName, BeamDir, + [{".beam",".erl",[{"ebin","src"}]}]), + {ok, SrcFile} = + filelib:find_source(BeamName, BeamDir, + [{".beam",".erl", + [{"ebin",filename:join("src", "*")}]}]), + + {ok, SrcFile} = filelib:find_file(SrcName, BeamDir), + + ok. diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index 86cf58566b..41ee3246f5 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -389,7 +389,7 @@ stop10(_Config) -> Dir = filename:dirname(code:which(?MODULE)), rpc:call(Node,code,add_path,[Dir]), {ok, Pid} = rpc:call(Node,gen_fsm,start,[{global,to_stop},?MODULE,[],[]]), - global:sync(), + ok = global:sync(), ok = gen_fsm:stop({global,to_stop}), false = rpc:call(Node,erlang,is_process_alive,[Pid]), {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})), @@ -1005,7 +1005,7 @@ undef_in_terminate(Config) when is_list(Config) -> State = {undef_in_terminate, {?MODULE, terminate}}, {ok, FSM} = gen_fsm:start(?MODULE, {state_data, State}, []), try - gen_fsm:stop(FSM), + ok = gen_fsm:stop(FSM), ct:fail(failed) catch exit:{undef, [{?MODULE, terminate, _, _}|_]} -> @@ -1201,7 +1201,7 @@ timeout({timeout,Ref,{timeout,Time}}, {From,Ref}) -> Cref = gen_fsm:start_timer(Time, cancel), Time4 = Time*4, receive after Time4 -> ok end, - gen_fsm:cancel_timer(Cref), + _= gen_fsm:cancel_timer(Cref), {next_state, timeout, {From,Ref2}}; timeout({timeout,Ref2,ok},{From,Ref2}) -> gen_fsm:reply(From, ok), diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 2bc220fef2..e29195e895 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. 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. @@ -347,7 +347,7 @@ stop10(_Config) -> Dir = filename:dirname(code:which(?MODULE)), rpc:call(Node,code,add_path,[Dir]), {ok, Pid} = rpc:call(Node,gen_server,start,[{global,to_stop},?MODULE,[],[]]), - global:sync(), + ok = global:sync(), ok = gen_server:stop({global,to_stop}), false = rpc:call(Node,erlang,is_process_alive,[Pid]), {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})), @@ -509,7 +509,7 @@ start_node(Name) -> %% After starting a slave, it takes a little while until global knows %% about it, even if nodes() includes it, so we make sure that global %% knows about it before registering something on all nodes. - global:sync(), + ok = global:sync(), N. call_remote1(Config) when is_list(Config) -> @@ -647,7 +647,7 @@ cast_fast(Config) when is_list(Config) -> cast_fast_messup() -> %% Register a false node: hopp@hostname unregister(erl_epmd), - erl_epmd:start_link(), + {ok, _} = erl_epmd:start_link(), {ok,S} = gen_tcp:listen(0, []), {ok,P} = inet:port(S), {ok,_Creation} = erl_epmd:register_node(hopp, P), @@ -1351,7 +1351,7 @@ do_call_with_huge_message_queue() -> {Time,ok} = tc(fun() -> calls(10000, Pid) end), - [self() ! {msg,N} || N <- lists:seq(1, 500000)], + _ = [self() ! {msg,N} || N <- lists:seq(1, 500000)], erlang:garbage_collect(), {NewTime,ok} = tc(fun() -> calls(10000, Pid) end), io:format("Time for empty message queue: ~p", [Time]), @@ -1476,7 +1476,7 @@ undef_in_terminate(Config) when is_list(Config) -> State = {undef_in_terminate, {oc_server, terminate}}, {ok, Server} = gen_server:start(?MODULE, {state, State}, []), try - gen_server:stop(Server), + ok = gen_server:stop(Server), ct:fail(failed) catch exit:{undef, [{oc_server, terminate, [], _}|_]} -> @@ -1674,7 +1674,7 @@ handle_cast({From,delayed_cast,T}, _State) -> handle_cast(hibernate_now, _State) -> {noreply, [], hibernate}; handle_cast(hibernate_later, _State) -> - timer:send_after(1000,self(),hibernate_now), + {ok, _} = timer:send_after(1000,self(),hibernate_now), {noreply, []}; handle_cast({call_undef_fun, Mod, Fun}, State) -> Mod:Fun(), diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index 5b9daecfd3..c747db475a 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -21,7 +21,7 @@ -include_lib("common_test/include/ct.hrl"). --compile(export_all). +-compile([export_all, nowarn_export_all]). -behaviour(gen_statem). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 13929bdbb6..45363c0592 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2017. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -714,7 +714,7 @@ p(Term, D) -> rp(Term, 1, 80, D). p(Term, Col, Ll, D) -> - rp(Term, Col, Ll, D, no_fun). + rp(Term, Col, Ll, D, none). rp(Term, Col, Ll, D) -> rp(Term, Col, Ll, D, fun rfd/2). @@ -724,6 +724,8 @@ rp(Term, Col, Ll, D) -> rp(Term, Col, Ll, D, RF) -> rp(Term, Col, Ll, D, ?MAXCS, RF). +rp(Term, Col, Ll, D, M, none) -> + rp(Term, Col, Ll, D, M, fun(_, _) -> no end); rp(Term, Col, Ll, D, M, RF) -> %% io:format("~n~n*** Col = ~p Ll = ~p D = ~p~n~p~n-->~n", %% [Col, Ll, D, Term]), diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 217e8cc252..ca85314775 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2017. All Rights Reserved. +%% Copyright Ericsson AB 2004-2018. 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. @@ -561,9 +561,10 @@ otp_5226(Config) when is_list(Config) -> otp_5327(Config) when is_list(Config) -> "exception error: bad argument" = comm_err(<<"<<\"hej\":default>>.">>), + L1 = erl_anno:new(1), <<"abc">> = - erl_parse:normalise({bin,1,[{bin_element,1,{string,1,"abc"}, - default,default}]}), + erl_parse:normalise({bin,L1,[{bin_element,L1,{string,L1,"abc"}, + default,default}]}), [<<"abc">>] = scan(<<"<<(<<\"abc\">>):3/binary>>.">>), [<<"abc">>] = scan(<<"<<(<<\"abc\">>)/binary>>.">>), "exception error: bad argument" = @@ -576,9 +577,9 @@ otp_5327(Config) when is_list(Config) -> comm_err(<<"<<10:default>>.">>), [<<98,1:1>>] = scan(<<"<<3:3,5:6>>.">>), {'EXIT',{badarg,_}} = - (catch erl_parse:normalise({bin,1,[{bin_element,1,{integer,1,17}, - {atom,1,all}, - default}]})), + (catch erl_parse:normalise({bin,L1,[{bin_element,L1,{integer,L1,17}, + {atom,L1,all}, + default}]})), [<<-20/signed>>] = scan(<<"<<-20/signed>> = <<-20>>.">>), [<<-300:16/signed>>] = scan(<<"<<-300:16/signed>> = <<-300:16>>.">>), @@ -2784,7 +2785,7 @@ otp_10302(Config) when is_list(Config) -> <<"begin A = <<\"\\xaa\">>, S = lists:flatten(io_lib:format(\"~p/~p.\", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B) @@ -2797,7 +2798,7 @@ otp_10302(Config) when is_list(Config) -> <<"io:setopts([{encoding,utf8}]). A = <<\"\\xaa\">>, S = lists:flatten(io_lib:format(\"~p/~p.\", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B).">>, @@ -2809,7 +2810,7 @@ otp_10302(Config) when is_list(Config) -> <<"begin A = [1089], S = lists:flatten(io_lib:format(\"~tp/~tp.\", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B) @@ -2821,7 +2822,7 @@ otp_10302(Config) when is_list(Config) -> <<"io:setopts([{encoding,utf8}]). A = [1089], S = lists:flatten(io_lib:format(\"~tp/~tp.\", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B).">>, @@ -2940,7 +2941,7 @@ otp_14296(Config) when is_list(Config) -> end(), fun() -> - Port = open_port({spawn, "ls"}, [line]), + Port = open_port({spawn, "ls"}, [{line,1}]), KnownPort = erlang:port_to_list(Port), S = KnownPort ++ ".", R = KnownPort ++ ".\n", @@ -3012,7 +3013,7 @@ scan(B) -> scan(t(B), F). scan(S0, F) -> - case erl_scan:tokens([], S0, 1, [unicode]) of + case erl_scan:tokens([], S0, 1) of {done,{ok,Ts,_},S} -> [F(Ts) | scan(S, F)]; _Else -> diff --git a/lib/stdlib/test/stdlib.spec b/lib/stdlib/test/stdlib.spec index 1adec67ac9..9c625091a8 100644 --- a/lib/stdlib/test/stdlib.spec +++ b/lib/stdlib/test/stdlib.spec @@ -1,3 +1,4 @@ {suites,"../stdlib_test",all}. -{skip_groups,"../stdlib_test",stdlib_bench_SUITE,[base64,gen_server,unicode], +{skip_groups,"../stdlib_test",stdlib_bench_SUITE, + [base64,gen_server,gen_statem,unicode], "Benchmark only"}. diff --git a/lib/stdlib/test/stdlib_bench.spec b/lib/stdlib/test/stdlib_bench.spec index f82f1ab9b3..7a0da811a0 100644 --- a/lib/stdlib/test/stdlib_bench.spec +++ b/lib/stdlib/test/stdlib_bench.spec @@ -5,5 +5,6 @@ {skip_suites,"../stdlib_test",string_SUITE, "bench only"}. {suites,"../stdlib_test",[stdlib_bench_SUITE]}. -{skip_groups,"../stdlib_test",stdlib_bench_SUITE,[gen_server_comparison], +{skip_groups,"../stdlib_test",stdlib_bench_SUITE, + [gen_server_comparison,gen_statem_comparison], "Not a benchmark"}. diff --git a/lib/stdlib/test/stdlib_bench_SUITE.erl b/lib/stdlib/test/stdlib_bench_SUITE.erl index cc7e070dbd..294898a932 100644 --- a/lib/stdlib/test/stdlib_bench_SUITE.erl +++ b/lib/stdlib/test/stdlib_bench_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2017. All Rights Reserved. +%% Copyright Ericsson AB 2012-2018. 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,8 @@ suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. all() -> [{group,unicode},{group,base64}, - {group,gen_server},{group,gen_server_comparison}]. + {group,gen_server},{group,gen_statem}, + {group,gen_server_comparison},{group,gen_statem_comparison}]. groups() -> [{unicode,[{repeat,5}], @@ -44,20 +45,39 @@ groups() -> encode_list, encode_list_to_string, mime_binary_decode, mime_binary_decode_to_string, mime_list_decode, mime_list_decode_to_string]}, - {gen_server, [{repeat,5}], - [simple, simple_timer, simple_mon, simple_timer_mon, - generic, generic_timer]}, + {gen_server, [{repeat,5}], cases(gen_server)}, + {gen_statem, [{repeat,3}], cases(gen_statem)}, {gen_server_comparison, [], [single_small, single_medium, single_big, sched_small, sched_medium, sched_big, - multi_small, multi_medium, multi_big]}]. + multi_small, multi_medium, multi_big]}, + {gen_statem_comparison, [], + [single_small, single_big, + sched_small, sched_big, + multi_small, multi_big]}]. -init_per_group(GroupName, Config) when GroupName =:= gen_server; - GroupName =:= gen_server_comparison -> - DataDir = ?config(data_dir, Config), - Files = filelib:wildcard(filename:join(DataDir, "{simple,generic}*.erl")), - _ = [{ok, _} = compile:file(File) || File <- Files], - Config; +cases(gen_server) -> + [simple, simple_timer, simple_mon, simple_timer_mon, + generic, generic_timer]; +cases(gen_statem) -> + [generic, generic_fsm, generic_fsm_transit, + generic_statem, generic_statem_transit, + generic_statem_complex]. + +init_per_group(gen_server, Config) -> + compile_servers(Config), + [{benchmark_suite,"stdlib_gen_server"}|Config]; +init_per_group(gen_statem, Config) -> + compile_servers(Config), + [{benchmark_suite,"stdlib_gen_statem"}|Config]; +init_per_group(gen_server_comparison, Config) -> + compile_servers(Config), + [{cases,cases(gen_server)}, + {benchmark_suite,"stdlib_gen_server"}|Config]; +init_per_group(gen_statem_comparison, Config) -> + compile_servers(Config), + [{cases,cases(gen_statem)}, + {benchmark_suite,"stdlib_gen_statem"}|Config]; init_per_group(_GroupName, Config) -> Config. @@ -77,23 +97,33 @@ end_per_testcase(_Func, _Conf) -> ok. +compile_servers(Config) -> + DataDir = ?config(data_dir, Config), + Files = filelib:wildcard(filename:join(DataDir, "{simple,generic}*.erl")), + _ = [{ok, _} = compile:file(File) || File <- Files], + ok. + +comment(Value) -> + C = lists:flatten(io_lib:format("~p", [Value])), + {comment, C}. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -define(REPEAT_NORM, 5). norm_nfc_list(Config) -> Bin = norm_data(Config), {_N, Mean, _Stddev, Res} = unicode_util_SUITE:time_count(nfc, list, Bin, ?REPEAT_NORM), - report(1000.0*Res / Mean). + comment(report(1000.0*Res / Mean)). norm_nfc_deep_l(Config) -> Bin = norm_data(Config), {_N, Mean, _Stddev, Res} = unicode_util_SUITE:time_count(nfc, deep_l, Bin, ?REPEAT_NORM), - report(1000.0*Res / Mean). + comment(report(1000.0*Res / Mean)). norm_nfc_binary(Config) -> Bin = norm_data(Config), {_N, Mean, _Stddev, Res} = unicode_util_SUITE:time_count(nfc, binary, Bin, ?REPEAT_NORM), - report(1000.0*Res / Mean). + comment(report(1000.0*Res / Mean)). string_lexemes_list(Config) -> @@ -102,7 +132,7 @@ string_lexemes_list(Config) -> Bin = norm_data(Config), Fun = fun(Str) -> string:nth_lexeme(Str, 200000, [$;,$\n,$\r]), 200000 end, {_N, Mean, _Stddev, Res} = string_SUITE:time_func(Fun, list, Bin, 15), - report(1000.0*Res / Mean). + comment(report(1000.0*Res / Mean)). string_lexemes_binary(Config) -> %% Use nth_lexeme instead of lexemes to avoid building a result of @@ -110,7 +140,7 @@ string_lexemes_binary(Config) -> Bin = norm_data(Config), Fun = fun(Str) -> string:nth_lexeme(Str, 200000, [$;,$\n,$\r]), 200000 end, {_N, Mean, _Stddev, Res} = string_SUITE:time_func(Fun, binary, Bin, ?REPEAT_NORM), - report(1000.0*Res / Mean). + comment(report(1000.0*Res / Mean)). %%% report(Tps) -> @@ -128,40 +158,40 @@ norm_data(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% decode_binary(_Config) -> - test(decode, encoded_binary()). + comment(test(decode, encoded_binary())). decode_binary_to_string(_Config) -> - test(decode_to_string, encoded_binary()). + comment(test(decode_to_string, encoded_binary())). decode_list(_Config) -> - test(decode, encoded_list()). + comment(test(decode, encoded_list())). decode_list_to_string(_Config) -> - test(decode_to_string, encoded_list()). + comment(test(decode_to_string, encoded_list())). encode_binary(_Config) -> - test(encode, binary()). + comment(test(encode, binary())). encode_binary_to_string(_Config) -> - test(encode_to_string, binary()). + comment(test(encode_to_string, binary())). encode_list(_Config) -> - test(encode, list()). + comment(test(encode, list())). encode_list_to_string(_Config) -> - test(encode_to_string, list()). + comment(test(encode_to_string, list())). mime_binary_decode(_Config) -> - test(mime_decode, encoded_binary()). + comment(test(mime_decode, encoded_binary())). mime_binary_decode_to_string(_Config) -> - test(mime_decode_to_string, encoded_binary()). + comment(test(mime_decode_to_string, encoded_binary())). mime_list_decode(_Config) -> - test(mime_decode, encoded_list()). + comment(test(mime_decode, encoded_list())). mime_list_decode_to_string(_Config) -> - test(mime_decode_to_string, encoded_list()). + comment(test(mime_decode_to_string, encoded_list())). -define(SIZE, 10000). -define(N, 1000). @@ -223,152 +253,208 @@ mbb(N, Acc) -> lists:reverse(Acc, B). simple(Config) when is_list(Config) -> - do_tests(simple, single_small). + comment(do_tests(simple, single_small, Config)). simple_timer(Config) when is_list(Config) -> - do_tests(simple_timer, single_small). + comment(do_tests(simple_timer, single_small, Config)). simple_mon(Config) when is_list(Config) -> - do_tests(simple_mon, single_small). + comment(do_tests(simple_mon, single_small, Config)). simple_timer_mon(Config) when is_list(Config) -> - do_tests(simple_timer_mon, single_small). + comment(do_tests(simple_timer_mon, single_small, Config)). generic(Config) when is_list(Config) -> - do_tests(generic, single_small). + comment(do_tests(generic, single_small, Config)). generic_timer(Config) when is_list(Config) -> - do_tests(generic_timer, single_small). + comment(do_tests(generic_timer, single_small, Config)). + +generic_statem(Config) when is_list(Config) -> + comment(do_tests(generic_statem, single_small, Config)). + +generic_statem_transit(Config) when is_list(Config) -> + comment(do_tests(generic_statem_transit, single_small, Config)). + +generic_statem_complex(Config) when is_list(Config) -> + comment(do_tests(generic_statem_complex, single_small, Config)). + +generic_fsm(Config) when is_list(Config) -> + comment(do_tests(generic_fsm, single_small, Config)). + +generic_fsm_transit(Config) when is_list(Config) -> + comment(do_tests(generic_fsm_transit, single_small, Config)). single_small(Config) when is_list(Config) -> - comparison(single_small). + comparison(?config(cases, Config), single_small, Config). single_medium(Config) when is_list(Config) -> - comparison(single_medium). + comparison(?config(cases, Config), single_medium, Config). single_big(Config) when is_list(Config) -> - comparison(single_big). + comparison(?config(cases, Config), single_big, Config). sched_small(Config) when is_list(Config) -> - comparison(sched_small). + comparison(?config(cases, Config), sched_small, Config). sched_medium(Config) when is_list(Config) -> - comparison(sched_medium). + comparison(?config(cases, Config), sched_medium, Config). sched_big(Config) when is_list(Config) -> - comparison(sched_big). + comparison(?config(cases, Config), sched_big, Config). multi_small(Config) when is_list(Config) -> - comparison(multi_small). + comparison(?config(cases, Config), multi_small, Config). multi_medium(Config) when is_list(Config) -> - comparison(multi_medium). + comparison(?config(cases, Config), multi_medium, Config). multi_big(Config) when is_list(Config) -> - comparison(multi_big). - -comparison(Kind) -> - Simple0 = do_tests(simple, Kind), - SimpleTimer0 = do_tests(simple_timer, Kind), - SimpleMon0 = do_tests(simple_mon, Kind), - SimpleTimerMon0 = do_tests(simple_timer_mon, Kind), - Generic0 = do_tests(generic, Kind), - GenericTimer0 = do_tests(generic_timer, Kind), - %% Normalize - Simple = norm(Simple0, Simple0), - SimpleTimer = norm(SimpleTimer0, Simple0), - SimpleMon = norm(SimpleMon0, Simple0), - SimpleTimerMon = norm(SimpleTimerMon0, Simple0), - Generic = norm(Generic0, Simple0), - GenericTimer = norm(GenericTimer0, Simple0), - {Parallelism, _N, Message} = bench_params(Kind), + comparison(?config(cases, Config), multi_big, Config). + +comparison(Cases, Kind, Config) -> + Cases = ?config(cases, Config), + [RefResult|_] = Results = + [do_tests(Case, Kind, Config) || Case <- Cases], + Normalized = [norm(Result, RefResult) || Result <- Results], + {Parallelism, Message} = bench_params(Kind), Wordsize = erlang:system_info(wordsize), MSize = Wordsize * erts_debug:flat_size(Message), What = io_lib:format("#parallel gen_server instances: ~.4w, " "message flat size: ~.5w bytes", [Parallelism, MSize]), - C = io_lib:format("~s: " - "Simple: ~s Simple+Timer: ~s " - "Simple+Monitor: ~s Simple+Timer+Monitor: ~s " - "Generic: ~s Generic+Timer: ~s", - [What, Simple, SimpleTimer, SimpleMon, SimpleTimerMon, - Generic, GenericTimer]), + Format = + lists:flatten( + ["~s: "] ++ + [[atom_to_list(Case),": ~s "] || Case <- Cases]), + C = lists:flatten(io_lib:format(Format, [What] ++ Normalized)), {comment, C}. norm(T, Ref) -> - io_lib:format("~.2f", [T/Ref]). + try Ref / T of + Norm -> + io_lib:format("~.2f", [Norm]) + catch error:badarith -> + "---" + end. + +-define(MAX_TIME_SECS, 3). % s +-define(MAX_TIME, 1000 * ?MAX_TIME_SECS). % ms +-define(CALLS_PER_LOOP, 5). -do_tests(Test, ParamSet) -> +do_tests(Test, ParamSet, Config) -> + BenchmarkSuite = ?config(benchmark_suite, Config), {Client, ServerMod} = bench(Test), - {Parallelism, N, Message} = bench_params(ParamSet), - Fun = create_clients(N, Message, ServerMod, Client, Parallelism), - Time = run_test(Fun), - TimesPerTest = 5, - PerSecond = Parallelism * TimesPerTest * round((1000 * N) / Time), - ct_event:notify(#event{name = benchmark_data, - data = [{suite,"stdlib_gen_server"}, - {value,PerSecond}]}), - Time. + {Parallelism, Message} = bench_params(ParamSet), + Fun = create_clients(Message, ServerMod, Client, Parallelism), + {TotalLoops, AllPidTime} = run_test(Fun), + PerSecond = ?CALLS_PER_LOOP * round((1000 * TotalLoops) / AllPidTime), + ct_event:notify( + #event{ + name = benchmark_data, + data = [{suite,BenchmarkSuite},{value,PerSecond}]}), + PerSecond. + +-define(COUNTER, n). -simple_client(0, _, _P) -> - ok; simple_client(N, M, P) -> + put(?COUNTER, N), _ = simple_server:reply(P, M), _ = simple_server:reply(P, M), _ = simple_server:reply(P, M), _ = simple_server:reply(P, M), _ = simple_server:reply(P, M), - simple_client(N-1, M, P). + simple_client(N+1, M, P). -simple_client_timer(0, _, _P) -> - ok; simple_client_timer(N, M, P) -> + put(?COUNTER, N), _ = simple_server_timer:reply(P, M), _ = simple_server_timer:reply(P, M), _ = simple_server_timer:reply(P, M), _ = simple_server_timer:reply(P, M), _ = simple_server_timer:reply(P, M), - simple_client_timer(N-1, M, P). + simple_client_timer(N+1, M, P). -simple_client_mon(0, _, _P) -> - ok; simple_client_mon(N, M, P) -> + put(?COUNTER, N), _ = simple_server_mon:reply(P, M), _ = simple_server_mon:reply(P, M), _ = simple_server_mon:reply(P, M), _ = simple_server_mon:reply(P, M), _ = simple_server_mon:reply(P, M), - simple_client_mon(N-1, M, P). + simple_client_mon(N+1, M, P). -simple_client_timer_mon(0, _, _P) -> - ok; simple_client_timer_mon(N, M, P) -> + put(?COUNTER, N), _ = simple_server_timer_mon:reply(P, M), _ = simple_server_timer_mon:reply(P, M), _ = simple_server_timer_mon:reply(P, M), _ = simple_server_timer_mon:reply(P, M), _ = simple_server_timer_mon:reply(P, M), - simple_client_timer_mon(N-1, M, P). + simple_client_timer_mon(N+1, M, P). -generic_client(0, _, _P) -> - ok; generic_client(N, M, P) -> + put(?COUNTER, N), _ = generic_server:reply(P, M), _ = generic_server:reply(P, M), _ = generic_server:reply(P, M), _ = generic_server:reply(P, M), _ = generic_server:reply(P, M), - generic_client(N-1, M, P). + generic_client(N+1, M, P). -generic_timer_client(0, _, _P) -> - ok; generic_timer_client(N, M, P) -> + put(?COUNTER, N), _ = generic_server_timer:reply(P, M), _ = generic_server_timer:reply(P, M), _ = generic_server_timer:reply(P, M), _ = generic_server_timer:reply(P, M), _ = generic_server_timer:reply(P, M), - generic_timer_client(N-1, M, P). + generic_timer_client(N+1, M, P). + +generic_statem_client(N, M, P) -> + put(?COUNTER, N), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + generic_statem_client(N+1, M, P). + +generic_statem_transit_client(N, M, P) -> + put(?COUNTER, N), + _ = generic_statem:transit(P, M), + _ = generic_statem:transit(P, M), + _ = generic_statem:transit(P, M), + _ = generic_statem:transit(P, M), + _ = generic_statem:transit(P, M), + generic_statem_transit_client(N+1, M, P). + +generic_statem_complex_client(N, M, P) -> + put(?COUNTER, N), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + generic_statem_complex_client(N+1, M, P). + +generic_fsm_client(N, M, P) -> + put(?COUNTER, N), + _ = generic_fsm:reply(P, M), + _ = generic_fsm:reply(P, M), + _ = generic_fsm:reply(P, M), + _ = generic_fsm:reply(P, M), + _ = generic_fsm:reply(P, M), + generic_fsm_client(N+1, M, P). + +generic_fsm_transit_client(N, M, P) -> + put(?COUNTER, N), + _ = generic_fsm:transit(P, M), + _ = generic_fsm:transit(P, M), + _ = generic_fsm:transit(P, M), + _ = generic_fsm:transit(P, M), + _ = generic_fsm:transit(P, M), + generic_fsm_transit_client(N+1, M, P). bench(simple) -> {fun simple_client/3, simple_server}; @@ -381,18 +467,28 @@ bench(simple_timer_mon) -> bench(generic) -> {fun generic_client/3, generic_server}; bench(generic_timer) -> - {fun generic_timer_client/3, generic_server_timer}. - -%% -> {Parallelism, NumberOfMessages, MessageTerm} -bench_params(single_small) -> {1, 700000, small()}; -bench_params(single_medium) -> {1, 350000, medium()}; -bench_params(single_big) -> {1, 70000, big()}; -bench_params(sched_small) -> {parallelism(), 200000, small()}; -bench_params(sched_medium) -> {parallelism(), 100000, medium()}; -bench_params(sched_big) -> {parallelism(), 20000, big()}; -bench_params(multi_small) -> {400, 2000, small()}; -bench_params(multi_medium) -> {400, 1000, medium()}; -bench_params(multi_big) -> {400, 200, big()}. + {fun generic_timer_client/3, generic_server_timer}; +bench(generic_statem) -> + {fun generic_statem_client/3, generic_statem}; +bench(generic_statem_transit) -> + {fun generic_statem_transit_client/3, generic_statem}; +bench(generic_statem_complex) -> + {fun generic_statem_complex_client/3, generic_statem_complex}; +bench(generic_fsm) -> + {fun generic_fsm_client/3, generic_fsm}; +bench(generic_fsm_transit) -> + {fun generic_fsm_transit_client/3, generic_fsm}. + +%% -> {Parallelism, MessageTerm} +bench_params(single_small) -> {1, small()}; +bench_params(single_medium) -> {1, medium()}; +bench_params(single_big) -> {1, big()}; +bench_params(sched_small) -> {parallelism(), small()}; +bench_params(sched_medium) -> {parallelism(), medium()}; +bench_params(sched_big) -> {parallelism(), big()}; +bench_params(multi_small) -> {400, small()}; +bench_params(multi_medium) -> {400, medium()}; +bench_params(multi_big) -> {400, big()}. small() -> small. @@ -409,19 +505,38 @@ parallelism() -> _ -> 1 end. -create_clients(N, M, ServerMod, Client, Parallel) -> +create_clients(M, ServerMod, Client, Parallel) -> fun() -> State = term, ServerPid = ServerMod:start(State), - PidRefs = [spawn_monitor(fun() -> Client(N, M, ServerPid) end) || + PidRefs = [spawn_monitor(fun() -> Client(0, M, ServerPid) end) || _ <- lists:seq(1, Parallel)], - _ = [receive {'DOWN', Ref, _, _, _} -> ok end || - {_Pid, Ref} <- PidRefs], - ok = ServerMod:stop(ServerPid) + timer:sleep(?MAX_TIME), + try + AllPidsN = collect(PidRefs, []), + TotalLoops = lists:sum(AllPidsN), + TotalLoops + after + ok = ServerMod:stop(ServerPid) + end end. +collect([], Result) -> + Result; +collect([{Pid, Ref}|PidRefs], Result) -> + N = case erlang:process_info(Pid, dictionary) of + {dictionary, Dict} -> + {?COUNTER, N0} = lists:keyfind(?COUNTER, 1, Dict), + N0; + undefined -> % Process did not start in ?MAX_TIME_SECS. + 0 + end, + exit(Pid, kill), + receive {'DOWN', Ref, _, _, _} -> ok end, + collect(PidRefs, [N|Result]). + run_test(Test) -> {T1, _} = statistics(runtime), - Test(), + Result = Test(), {T2, _} = statistics(runtime), - T2 - T1. + {Result, T2 - T1}. diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl new file mode 100644 index 0000000000..50f7df7a2a --- /dev/null +++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl @@ -0,0 +1,59 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017-2018. 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(generic_fsm). + +-export([start/1, reply/2, transit/2, stop/1]). + +-export([init/1, terminate/3]). +-export([state1/3, state2/3]). + +-behaivour(gen_fsm). + + +%% API + +start(Data) -> + {ok, Pid} = gen_fsm:start(?MODULE, Data, []), + Pid. + +stop(P) -> + ok = gen_fsm:stop(P). + +reply(S, M) -> + gen_fsm:sync_send_event(S, {reply, M}, infinity). + +transit(S, M) -> + gen_fsm:sync_send_event(S, {transit, M}, infinity). + +%% Implementation + +init(Data) -> + {ok, state1, Data}. + +terminate(_Reason, _State, _Data) -> + ok. + +state1({reply, M}, _From, Data) -> + {reply, M, ?FUNCTION_NAME, Data}; +state1({transit, M}, _From, Data) -> + {reply, M, state2, Data}. + +state2({transit, M}, _From, Data) -> + {reply, M, state1, Data}. diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl new file mode 100644 index 0000000000..2e0491f060 --- /dev/null +++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl @@ -0,0 +1,58 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017-2018. 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(generic_statem). + +-export([start/1, reply/2, transit/2, stop/1]). + +-export([callback_mode/0, init/1]). +-export([state1/3, state2/3]). + +-behaviour(gen_statem). + +%% API + +start(Data) -> + {ok, Pid} = gen_statem:start(?MODULE, Data, []), + Pid. + +stop(P) -> + ok = gen_statem:stop(P). + +reply(S, M) -> + gen_statem:call(S, {reply, M}, infinity). + +transit(S, M) -> + gen_statem:call(S, {transit, M}, infinity). + +%% Implementation + +callback_mode() -> + state_functions. + +init(Data) -> + {ok, state1, Data}. + +state1({call, From}, {reply, M}, Data) -> + {keep_state, Data, {reply, From, M}}; +state1({call, From}, {transit, M}, Data) -> + {next_state, state2, Data, {reply, From, M}}. + +state2({call, From}, {transit, M}, Data) -> + {next_state, state1, Data, {reply, From, M}}. diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem_complex.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem_complex.erl new file mode 100644 index 0000000000..983227d281 --- /dev/null +++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem_complex.erl @@ -0,0 +1,66 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017-2018. 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(generic_statem_complex). + +-export([start/1, reply/2, stop/1]). + +-export([callback_mode/0, init/1]). +-export([state1/3, state2/3, state3/3]). + +-behaviour(gen_statem). + +%% API + +start(Data) -> + {ok, Pid} = gen_statem:start(?MODULE, Data, []), + Pid. + +stop(P) -> + ok = gen_statem:stop(P). + +reply(S, M) -> + gen_statem:call(S, {reply, M}, infinity). + +%% Implementation + +callback_mode() -> + [state_functions,state_enter]. + +init(Data) -> + {ok, state1, Data}. + +state1(enter, _, Data) -> + {keep_state, Data, + {state_timeout, 5000, t1}}; +state1({call, _From}, {reply, _M}, Data) -> + {next_state, state2, Data, + [postpone,{next_event,internal,e}]}. + +state2(enter, _, _Data) -> + keep_state_and_data; +state2(internal, e, Data) -> + {next_state, state3, Data}. + +state3(enter, _, Data) -> + {keep_state, Data, + {state_timeout, 5000, t3}}; +state3({call, From}, {reply, M}, Data) -> + {next_state, state1, Data, + {reply, From, M}}. diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index f03f326278..60a15c8e3f 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -780,8 +780,7 @@ lay_2(Node, Ctxt) -> '_' -> beside(D1, beside(text(":"), D2)); _ -> - D3 = lay(erl_syntax:class_qualifier_stacktrace(Node), - Ctxt1), + D3 = lay(Stacktrace, Ctxt1), beside(D1, beside(beside(text(":"), D2), beside(text(":"), D3))) end; diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index ed552b73df..b816c0699c 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -3895,7 +3895,9 @@ fold_try_clause({clause, Pos, [P], Guard, Body}) -> unfold_try_clauses(Cs) -> [unfold_try_clause(C) || C <- Cs]. -unfold_try_clause({clause, Pos, [{tuple, _, [{atom, _, throw}, V, _]}], +unfold_try_clause({clause, Pos, [{tuple, _, [{atom, _, throw}, + V, + [{var, _, '_'}]]}], Guard, Body}) -> {clause, Pos, [V], Guard, Body}; unfold_try_clause({clause, Pos, [{tuple, _, [C, V, Stacktrace]}], @@ -7761,8 +7763,9 @@ subtrees(T) -> catch_expr -> [[catch_expr_body(T)]]; class_qualifier -> - [[class_qualifier_argument(T)], - [class_qualifier_body(T)]]; + [[class_qualifier_argument(T)], + [class_qualifier_body(T)], + [class_qualifier_stacktrace(T)]]; clause -> case clause_guard(T) of none -> @@ -7983,6 +7986,7 @@ make_tree(block_expr, [B]) -> block_expr(B); make_tree(case_expr, [[A], C]) -> case_expr(A, C); make_tree(catch_expr, [[B]]) -> catch_expr(B); make_tree(class_qualifier, [[A], [B]]) -> class_qualifier(A, B); +make_tree(class_qualifier, [[A], [B], [C]]) -> class_qualifier(A, B, C); make_tree(clause, [P, B]) -> clause(P, none, B); make_tree(clause, [P, [G], B]) -> clause(P, G, B); make_tree(cond_expr, [C]) -> cond_expr(C); diff --git a/system/doc/design_principles/statem.xml b/system/doc/design_principles/statem.xml index a0611a46da..5be2981f62 100644 --- a/system/doc/design_principles/statem.xml +++ b/system/doc/design_principles/statem.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2016</year><year>2017</year> + <year>2016</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -1679,8 +1679,8 @@ handle_event( {next_state, {open,LockButton}, Data, [{reply,From,ok}]}; [Digit|Rest] -> % Incomplete - {keep_state, Data#{remaining := Rest, 30000}, - [{reply,From,ok}]}; + {keep_state, Data#{remaining := Rest}, + [{reply,From,ok}, 30000]}; [_|_] -> % Wrong {keep_state, Data#{remaining := Code}, [{reply,From,ok}]} diff --git a/system/doc/getting_started/seq_prog.xml b/system/doc/getting_started/seq_prog.xml index 6b7e1cd24f..2b0750ff80 100644 --- a/system/doc/getting_started/seq_prog.xml +++ b/system/doc/getting_started/seq_prog.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2016</year> + <year>2003</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -271,11 +271,12 @@ convert(N, centimeter) -> {'EXIT',{function_clause,[{tut2,convert, [3,miles], [{file,"tut2.erl"},{line,4}]}, - {erl_eval,do_apply,5,[{file,"erl_eval.erl"},{line,482}]}, - {shell,exprs,7,[{file,"shell.erl"},{line,666}]}, - {shell,eval_exprs,7,[{file,"shell.erl"},{line,621}]}, - {shell,eval_loop,3,[{file,"shell.erl"},{line,606}]}]}}</pre> - + {erl_eval,do_apply,6, + [{file,"erl_eval.erl"},{line,677}]}, + {shell,exprs,7,[{file,"shell.erl"},{line,687}]}, + {shell,eval_exprs,7,[{file,"shell.erl"},{line,642}]}, + {shell,eval_loop,3, + [{file,"shell.erl"},{line,627}]}]}}</pre> </section> <section> |