aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--OTP_VERSION2
-rw-r--r--bootstrap/bin/start.bootbin5263 -> 5251 bytes
-rw-r--r--bootstrap/bin/start_clean.bootbin5263 -> 5251 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_asm.beambin11676 -> 11676 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_block.beambin15284 -> 15348 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_flatten.beambin3108 -> 3148 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_split.beambin2392 -> 2444 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_utils.beambin13476 -> 13716 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_validator.beambin36240 -> 36256 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl.beambin32416 -> 32408 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl_inline.beambin39100 -> 39188 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl_trees.beambin20368 -> 20392 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/compiler.app2
-rw-r--r--bootstrap/lib/compiler/ebin/compiler.appup2
-rw-r--r--bootstrap/lib/compiler/ebin/core_lint.beambin12820 -> 13664 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_pp.beambin13196 -> 13196 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_pre_expand.beambin14244 -> 14972 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_codegen.beambin54516 -> 55940 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_core.beambin54256 -> 56264 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_kernel.beambin47460 -> 47584 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/application.beambin4524 -> 4572 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/hipe_unified_loader.beambin13508 -> 13516 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_dns.beambin19812 -> 19768 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/kernel.app2
-rw-r--r--bootstrap/lib/kernel/ebin/kernel.appup8
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_eval.beambin30744 -> 30732 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_internal.beambin5236 -> 5824 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_lint.beambin89824 -> 90728 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_parse.beambin75012 -> 75936 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_pp.beambin26656 -> 27184 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/filelib.beambin8076 -> 8072 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/filename.beambin12436 -> 12512 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen.beambin4048 -> 4292 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_event.beambin18320 -> 19252 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_fsm.beambin15724 -> 16864 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_server.beambin17456 -> 18452 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/otp_internal.beambin10172 -> 10112 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/pg.beambin2096 -> 0 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/proc_lib.beambin9812 -> 10460 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/stdlib.app3
-rw-r--r--bootstrap/lib/stdlib/ebin/stdlib.appup10
-rw-r--r--bootstrap/lib/stdlib/ebin/supervisor.beambin23432 -> 23484 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/supervisor_bridge.beambin2824 -> 2864 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/sys.beambin8372 -> 8620 bytes
-rw-r--r--erts/doc/src/erl.xml6
-rw-r--r--erts/doc/src/erlang.xml22
-rw-r--r--erts/emulator/Makefile.in11
-rw-r--r--erts/emulator/beam/atom.names2
-rw-r--r--erts/emulator/beam/beam_emu.c42
-rw-r--r--erts/emulator/beam/beam_load.c60
-rw-r--r--erts/emulator/beam/beam_load.h8
-rw-r--r--erts/emulator/beam/bif.c13
-rw-r--r--erts/emulator/beam/bif.h3
-rw-r--r--erts/emulator/beam/bif.tab11
-rw-r--r--erts/emulator/beam/binary.c7
-rw-r--r--erts/emulator/beam/copy.c2
-rw-r--r--erts/emulator/beam/dist.c2
-rw-r--r--erts/emulator/beam/erl_alloc.types2
-rw-r--r--erts/emulator/beam/erl_bif_binary.c4
-rw-r--r--erts/emulator/beam/erl_bif_info.c5
-rw-r--r--erts/emulator/beam/erl_binary.h34
-rw-r--r--erts/emulator/beam/erl_bits.c10
-rw-r--r--erts/emulator/beam/erl_db_hash.h4
-rw-r--r--erts/emulator/beam/erl_gc.c3
-rw-r--r--erts/emulator/beam/erl_gc.h35
-rw-r--r--erts/emulator/beam/erl_init.c8
-rw-r--r--erts/emulator/beam/erl_nif.c3
-rw-r--r--erts/emulator/beam/erl_printf_term.c86
-rw-r--r--erts/emulator/beam/erl_process.c2
-rw-r--r--erts/emulator/beam/erl_process.h6
-rw-r--r--erts/emulator/beam/erl_process_dict.c52
-rw-r--r--erts/emulator/beam/erl_vm.h2
-rw-r--r--erts/emulator/beam/external.c12
-rw-r--r--erts/emulator/beam/global.h18
-rw-r--r--erts/emulator/beam/io.c7
-rw-r--r--erts/emulator/beam/utils.c3
-rw-r--r--erts/emulator/drivers/unix/ttsl_drv.c166
-rw-r--r--erts/emulator/drivers/win32/ttsl_drv.c16
-rw-r--r--erts/emulator/hipe/hipe_amd64.c59
-rw-r--r--erts/emulator/hipe/hipe_amd64_asm.m450
-rw-r--r--erts/emulator/hipe/hipe_amd64_bifs.m42
-rw-r--r--erts/emulator/hipe/hipe_amd64_glue.S7
-rw-r--r--erts/emulator/hipe/hipe_arm.c16
-rw-r--r--erts/emulator/hipe/hipe_arm_asm.m412
-rw-r--r--erts/emulator/hipe/hipe_arm_bifs.m41
-rw-r--r--erts/emulator/hipe/hipe_arm_glue.S9
-rw-r--r--erts/emulator/hipe/hipe_bif0.c232
-rw-r--r--erts/emulator/hipe/hipe_debug.c4
-rw-r--r--erts/emulator/hipe/hipe_gc.c3
-rw-r--r--erts/emulator/hipe/hipe_mkliterals.c5
-rw-r--r--erts/emulator/hipe/hipe_mode_switch.c66
-rw-r--r--erts/emulator/hipe/hipe_mode_switch.h53
-rw-r--r--erts/emulator/hipe/hipe_native_bif.c3
-rw-r--r--erts/emulator/hipe/hipe_ppc.c34
-rw-r--r--erts/emulator/hipe/hipe_ppc_asm.m427
-rw-r--r--erts/emulator/hipe/hipe_ppc_bifs.m41
-rw-r--r--erts/emulator/hipe/hipe_ppc_glue.S9
-rw-r--r--erts/emulator/hipe/hipe_process.h9
-rw-r--r--erts/emulator/hipe/hipe_risc_stack.c4
-rw-r--r--erts/emulator/hipe/hipe_sparc.c8
-rw-r--r--erts/emulator/hipe/hipe_sparc_asm.m413
-rw-r--r--erts/emulator/hipe/hipe_sparc_bifs.m41
-rw-r--r--erts/emulator/hipe/hipe_sparc_glue.S11
-rw-r--r--erts/emulator/hipe/hipe_stack.h11
-rw-r--r--erts/emulator/hipe/hipe_x86.c32
-rw-r--r--erts/emulator/hipe/hipe_x86_asm.m420
-rw-r--r--erts/emulator/hipe/hipe_x86_bifs.m41
-rw-r--r--erts/emulator/hipe/hipe_x86_glue.S7
-rw-r--r--erts/emulator/hipe/hipe_x86_stack.c4
-rw-r--r--erts/emulator/sys/unix/sys.c253
-rw-r--r--erts/emulator/sys/win32/sys.c114
-rw-r--r--erts/emulator/test/module_info_SUITE.erl22
-rw-r--r--erts/emulator/test/port_SUITE.erl6
-rw-r--r--erts/emulator/valgrind/suppress.patched.3.6.05
-rw-r--r--erts/emulator/valgrind/suppress.standard5
-rw-r--r--erts/epmd/src/epmd.c4
-rw-r--r--erts/etc/unix/cerl.src6
-rw-r--r--erts/etc/unix/etp-commands.in23
-rw-r--r--erts/lib_src/Makefile.in6
-rw-r--r--erts/preloaded/ebin/erl_prim_loader.beambin56292 -> 56328 bytes
-rw-r--r--erts/preloaded/ebin/erlang.beambin97972 -> 98168 bytes
-rw-r--r--erts/preloaded/ebin/erts_internal.beambin4164 -> 4176 bytes
-rw-r--r--erts/preloaded/ebin/init.beambin48808 -> 48780 bytes
-rw-r--r--erts/preloaded/ebin/otp_ring0.beambin1468 -> 1460 bytes
-rw-r--r--erts/preloaded/ebin/prim_eval.beambin1340 -> 1340 bytes
-rw-r--r--erts/preloaded/ebin/prim_file.beambin44904 -> 44892 bytes
-rw-r--r--erts/preloaded/ebin/prim_inet.beambin73128 -> 73128 bytes
-rw-r--r--erts/preloaded/ebin/prim_zip.beambin23440 -> 23424 bytes
-rw-r--r--erts/preloaded/ebin/zlib.beambin13188 -> 13176 bytes
-rw-r--r--erts/preloaded/src/erlang.erl10
-rw-r--r--erts/test/erlc_SUITE_data/src/start_ok.script2
-rw-r--r--erts/test/upgrade_SUITE.erl5
-rw-r--r--erts/vsn.mk2
-rw-r--r--lib/common_test/doc/src/ct_master_chapter.xml2
-rw-r--r--lib/common_test/src/Makefile5
-rw-r--r--lib/common_test/src/ct_netconfc.erl49
-rw-r--r--lib/common_test/src/ct_release_test.erl847
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE.erl31
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl200
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl147
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.erl166
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.hrl14
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE_data/ns.erl14
-rw-r--r--lib/compiler/src/beam_block.erl3
-rw-r--r--lib/compiler/src/beam_flatten.erl3
-rw-r--r--lib/compiler/src/beam_split.erl3
-rw-r--r--lib/compiler/src/beam_type.erl20
-rw-r--r--lib/compiler/src/beam_utils.erl14
-rw-r--r--lib/compiler/src/beam_validator.erl4
-rw-r--r--lib/compiler/src/cerl.erl4
-rw-r--r--lib/compiler/src/cerl_inline.erl36
-rw-r--r--lib/compiler/src/cerl_trees.erl4
-rw-r--r--lib/compiler/src/compile.erl5
-rw-r--r--lib/compiler/src/core_lint.erl102
-rw-r--r--lib/compiler/src/core_pp.erl4
-rw-r--r--lib/compiler/src/sys_pre_expand.erl53
-rw-r--r--lib/compiler/src/v3_codegen.erl73
-rw-r--r--lib/compiler/src/v3_core.erl432
-rw-r--r--lib/compiler/src/v3_kernel.erl61
-rw-r--r--lib/compiler/src/v3_kernel.hrl2
-rw-r--r--lib/compiler/test/Makefile2
-rw-r--r--lib/compiler/test/compilation_SUITE.erl2
-rw-r--r--lib/compiler/test/compile_SUITE.erl2
-rw-r--r--lib/compiler/test/error_SUITE.erl25
-rw-r--r--lib/compiler/test/map_SUITE.erl376
-rw-r--r--lib/compiler/test/warnings_SUITE.erl4
-rw-r--r--lib/crypto/c_src/crypto.c276
-rw-r--r--lib/crypto/doc/src/crypto.xml33
-rw-r--r--lib/crypto/src/crypto.erl44
-rw-r--r--lib/crypto/test/crypto_SUITE.erl300
-rw-r--r--lib/debugger/test/map_SUITE.erl487
-rw-r--r--lib/dialyzer/src/dialyzer_behaviours.erl10
-rw-r--r--lib/dialyzer/src/dialyzer_codeserver.erl4
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl20
-rw-r--r--lib/dialyzer/src/dialyzer_dataflow.erl3
-rw-r--r--lib/dialyzer/src/dialyzer_plt.erl8
-rw-r--r--lib/dialyzer/src/dialyzer_succ_typings.erl9
-rw-r--r--lib/dialyzer/src/dialyzer_utils.erl43
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/behaviour_info2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_bad_format_status.erl12
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_format_status.erl13
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/predef2.erl56
-rw-r--r--lib/edoc/src/edoc_data.erl37
-rw-r--r--lib/edoc/src/edoc_layout.erl25
-rw-r--r--lib/edoc/src/edoc_specs.erl5
-rw-r--r--lib/edoc/src/edoc_tags.erl6
-rw-r--r--lib/edoc/src/edoc_types.erl61
-rw-r--r--lib/erl_docgen/src/docgen_otp_specs.erl2
-rw-r--r--lib/hipe/cerl/erl_types.erl150
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl3
-rw-r--r--lib/kernel/doc/src/pg2.xml10
-rw-r--r--lib/kernel/src/group.erl148
-rw-r--r--lib/kernel/src/kernel.appup.src6
-rw-r--r--lib/kernel/src/user_drv.erl131
-rw-r--r--lib/kernel/test/pdict_SUITE.erl33
-rw-r--r--lib/observer/test/crashdump_viewer_SUITE.erl37
-rw-r--r--lib/reltool/test/reltool_server_SUITE.erl7
-rw-r--r--lib/sasl/src/sasl.appup.src6
-rw-r--r--lib/sasl/test/test_lib.hrl4
-rw-r--r--lib/ssh/src/ssh_cli.erl51
-rw-r--r--lib/ssl/doc/src/ssl.xml2
-rw-r--r--lib/ssl/doc/src/ssl_app.xml6
-rw-r--r--lib/ssl/doc/src/ssl_session_cache_api.xml20
-rw-r--r--lib/ssl/src/dtls_record.erl62
-rw-r--r--lib/ssl/src/ssl.erl4
-rw-r--r--lib/ssl/src/ssl_cipher.erl449
-rw-r--r--lib/ssl/src/ssl_cipher.hrl96
-rw-r--r--lib/ssl/src/ssl_handshake.erl5
-rw-r--r--lib/ssl/src/ssl_manager.erl109
-rw-r--r--lib/ssl/src/ssl_record.erl40
-rw-r--r--lib/ssl/src/ssl_record.hrl5
-rw-r--r--lib/ssl/src/ssl_session_cache.erl10
-rw-r--r--lib/ssl/src/tls_record.erl62
-rw-r--r--lib/ssl/src/tls_v1.erl25
-rw-r--r--lib/ssl/test/Makefile3
-rw-r--r--lib/ssl/test/ssl.spec3
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl4
-rw-r--r--lib/ssl/test/ssl_bench.spec1
-rw-r--r--lib/ssl/test/ssl_bench_SUITE.erl366
-rw-r--r--lib/ssl/test/ssl_cipher_SUITE.erl16
-rw-r--r--lib/ssl/test/ssl_session_cache_SUITE.erl57
-rw-r--r--lib/ssl/test/ssl_test_lib.erl57
-rw-r--r--lib/stdlib/doc/src/Makefile1
-rw-r--r--lib/stdlib/doc/src/binary.xml4
-rw-r--r--lib/stdlib/doc/src/gen_event.xml35
-rw-r--r--lib/stdlib/doc/src/gen_fsm.xml44
-rw-r--r--lib/stdlib/doc/src/gen_server.xml39
-rw-r--r--lib/stdlib/doc/src/pg.xml114
-rw-r--r--lib/stdlib/doc/src/proc_lib.xml36
-rw-r--r--lib/stdlib/doc/src/ref_man.xml1
-rw-r--r--lib/stdlib/doc/src/specs.xml1
-rw-r--r--lib/stdlib/doc/src/sys.xml11
-rw-r--r--lib/stdlib/src/Makefile1
-rw-r--r--lib/stdlib/src/erl_eval.erl2
-rw-r--r--lib/stdlib/src/erl_internal.erl55
-rw-r--r--lib/stdlib/src/erl_lint.erl655
-rw-r--r--lib/stdlib/src/erl_parse.yrl20
-rw-r--r--lib/stdlib/src/erl_pp.erl19
-rw-r--r--lib/stdlib/src/filename.erl6
-rw-r--r--lib/stdlib/src/gen.erl113
-rw-r--r--lib/stdlib/src/gen_event.erl18
-rw-r--r--lib/stdlib/src/gen_fsm.erl14
-rw-r--r--lib/stdlib/src/gen_server.erl37
-rw-r--r--lib/stdlib/src/otp_internal.erl2
-rw-r--r--lib/stdlib/src/pg.erl187
-rw-r--r--lib/stdlib/src/proc_lib.erl52
-rw-r--r--lib/stdlib/src/stdlib.app.src1
-rw-r--r--lib/stdlib/src/stdlib.appup.src6
-rw-r--r--lib/stdlib/src/sys.erl25
-rw-r--r--lib/stdlib/test/erl_eval_SUITE.erl24
-rw-r--r--lib/stdlib/test/erl_internal_SUITE.erl65
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl469
-rw-r--r--lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl6
-rw-r--r--lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour2.erl6
-rw-r--r--lib/stdlib/test/erl_lint_SUITE_data/callback1.erl6
-rw-r--r--lib/stdlib/test/erl_lint_SUITE_data/callback2.erl6
-rw-r--r--lib/stdlib/test/erl_lint_SUITE_data/callback3.erl8
-rw-r--r--lib/stdlib/test/erl_lint_SUITE_data/predef.erl4
-rw-r--r--lib/stdlib/test/erl_pp_SUITE.erl19
-rw-r--r--lib/stdlib/test/filelib_SUITE.erl3
-rw-r--r--lib/stdlib/test/filename_SUITE.erl114
-rw-r--r--lib/stdlib/test/gen_event_SUITE.erl4
-rw-r--r--lib/stdlib/test/gen_fsm_SUITE.erl104
-rw-r--r--lib/stdlib/test/gen_server_SUITE.erl107
-rw-r--r--lib/stdlib/test/proc_lib_SUITE.erl93
-rw-r--r--lib/stdlib/test/stdlib_SUITE.erl33
-rw-r--r--lib/stdlib/test/sys_SUITE.erl16
-rw-r--r--lib/stdlib/test/sys_sp1.erl14
-rw-r--r--lib/stdlib/test/sys_sp2.erl33
-rw-r--r--lib/syntax_tools/src/erl_syntax.erl26
-rw-r--r--lib/typer/src/typer.erl2
-rw-r--r--lib/wx/src/wx_object.erl55
-rw-r--r--lib/wx/test/wx_event_SUITE.erl7
-rw-r--r--lib/wx/test/wx_obj_test.erl18
-rw-r--r--make/run_make.mk2
-rw-r--r--system/doc/design_principles/distributed_applications.xml2
-rw-r--r--system/doc/design_principles/spec_proc.xml76
-rw-r--r--system/doc/reference_manual/modules.xml18
-rw-r--r--system/doc/tutorial/distribution.xml1
279 files changed, 7974 insertions, 2892 deletions
diff --git a/OTP_VERSION b/OTP_VERSION
index 9f09b58414..1fbc0d2431 100644
--- a/OTP_VERSION
+++ b/OTP_VERSION
@@ -1 +1 @@
-17.4-rc0
+18.0-rc0
diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot
index c497fe37fc..7e93eb7f7a 100644
--- a/bootstrap/bin/start.boot
+++ b/bootstrap/bin/start.boot
Binary files differ
diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot
index c497fe37fc..7e93eb7f7a 100644
--- a/bootstrap/bin/start_clean.boot
+++ b/bootstrap/bin/start_clean.boot
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam
index f58fdd7171..0758874641 100644
--- a/bootstrap/lib/compiler/ebin/beam_asm.beam
+++ b/bootstrap/lib/compiler/ebin/beam_asm.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam
index 11482a1451..0eca719d0d 100644
--- a/bootstrap/lib/compiler/ebin/beam_block.beam
+++ b/bootstrap/lib/compiler/ebin/beam_block.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_flatten.beam b/bootstrap/lib/compiler/ebin/beam_flatten.beam
index 35dae78125..de1a719a4e 100644
--- a/bootstrap/lib/compiler/ebin/beam_flatten.beam
+++ b/bootstrap/lib/compiler/ebin/beam_flatten.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_split.beam b/bootstrap/lib/compiler/ebin/beam_split.beam
index 1d12f2cf1d..e99c0a69b9 100644
--- a/bootstrap/lib/compiler/ebin/beam_split.beam
+++ b/bootstrap/lib/compiler/ebin/beam_split.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam
index 8507db5454..659bb08d48 100644
--- a/bootstrap/lib/compiler/ebin/beam_utils.beam
+++ b/bootstrap/lib/compiler/ebin/beam_utils.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam
index 07225dc8b1..ba1ea73dc4 100644
--- a/bootstrap/lib/compiler/ebin/beam_validator.beam
+++ b/bootstrap/lib/compiler/ebin/beam_validator.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam
index 0f0670c9ae..5e1c698ae8 100644
--- a/bootstrap/lib/compiler/ebin/cerl.beam
+++ b/bootstrap/lib/compiler/ebin/cerl.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam
index 2f7f220ebd..7328f75f34 100644
--- a/bootstrap/lib/compiler/ebin/cerl_inline.beam
+++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam
index 1338631c23..f36cc31458 100644
--- a/bootstrap/lib/compiler/ebin/cerl_trees.beam
+++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app
index f12713417f..5f15db4437 100644
--- a/bootstrap/lib/compiler/ebin/compiler.app
+++ b/bootstrap/lib/compiler/ebin/compiler.app
@@ -18,7 +18,7 @@
{application, compiler,
[{description, "ERTS CXC 138 10"},
- {vsn, "5.0.1"},
+ {vsn, "5.0.2"},
{modules, [
beam_a,
beam_asm,
diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup
index e73b9aa60c..bde95b1878 100644
--- a/bootstrap/lib/compiler/ebin/compiler.appup
+++ b/bootstrap/lib/compiler/ebin/compiler.appup
@@ -15,7 +15,7 @@
%% under the License.
%%
%% %CopyrightEnd%
-{"5.0",
+{"5.0.2",
[{<<".*">>,[{restart_application, compiler}]}],
[{<<".*">>,[{restart_application, compiler}]}]
}.
diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam
index e172ec6af7..9f83408bae 100644
--- a/bootstrap/lib/compiler/ebin/core_lint.beam
+++ b/bootstrap/lib/compiler/ebin/core_lint.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam
index e6e60fb658..cb02293c1d 100644
--- a/bootstrap/lib/compiler/ebin/core_pp.beam
+++ b/bootstrap/lib/compiler/ebin/core_pp.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam
index c0c537f623..96f22d0970 100644
--- a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam
+++ b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam
index 3670fd206c..822c7e34e6 100644
--- a/bootstrap/lib/compiler/ebin/v3_codegen.beam
+++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam
index 5da654686a..f492d3428c 100644
--- a/bootstrap/lib/compiler/ebin/v3_core.beam
+++ b/bootstrap/lib/compiler/ebin/v3_core.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam
index 1e549a41c7..b56f507f47 100644
--- a/bootstrap/lib/compiler/ebin/v3_kernel.beam
+++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam
index 6946d17545..ba3a5ef81d 100644
--- a/bootstrap/lib/kernel/ebin/application.beam
+++ b/bootstrap/lib/kernel/ebin/application.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam
index b24c850af3..e6141fd7f1 100644
--- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam
+++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam
index 9fd86024e0..41486bed9a 100644
--- a/bootstrap/lib/kernel/ebin/inet_dns.beam
+++ b/bootstrap/lib/kernel/ebin/inet_dns.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app
index e60b36e1e7..1b39f7df07 100644
--- a/bootstrap/lib/kernel/ebin/kernel.app
+++ b/bootstrap/lib/kernel/ebin/kernel.app
@@ -21,7 +21,7 @@
{application, kernel,
[
{description, "ERTS CXC 138 10"},
- {vsn, "3.0.2"},
+ {vsn, "3.0.3"},
{modules, [application,
application_controller,
application_master,
diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup
index fda418ae8a..02cf129b42 100644
--- a/bootstrap/lib/kernel/ebin/kernel.appup
+++ b/bootstrap/lib/kernel/ebin/kernel.appup
@@ -15,11 +15,9 @@
%% under the License.
%%
%% %CopyrightEnd%
-{"3.0",
+{"3.0.3",
%% Up from - max one major revision back
- [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17
- {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16
+ [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17
%% Down to - max one major revision back
- [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17
- {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16
+ [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17
}.
diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam
index 95454c885a..15f0e940fd 100644
--- a/bootstrap/lib/stdlib/ebin/erl_eval.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam
index b851ca484e..d3e41be66b 100644
--- a/bootstrap/lib/stdlib/ebin/erl_internal.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam
index 8ae35899d0..9c6c4be617 100644
--- a/bootstrap/lib/stdlib/ebin/erl_lint.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam
index 998bb0b209..ddef03db31 100644
--- a/bootstrap/lib/stdlib/ebin/erl_parse.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam
index ff196f3a45..cb6bd2056c 100644
--- a/bootstrap/lib/stdlib/ebin/erl_pp.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam
index 9fc7dd79cb..ab3600c2f2 100644
--- a/bootstrap/lib/stdlib/ebin/filelib.beam
+++ b/bootstrap/lib/stdlib/ebin/filelib.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam
index 4c64d477aa..551e2d3f01 100644
--- a/bootstrap/lib/stdlib/ebin/filename.beam
+++ b/bootstrap/lib/stdlib/ebin/filename.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gen.beam b/bootstrap/lib/stdlib/ebin/gen.beam
index 6f15e461f6..b9f4b6a6d7 100644
--- a/bootstrap/lib/stdlib/ebin/gen.beam
+++ b/bootstrap/lib/stdlib/ebin/gen.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam
index d45e508d22..4359a69f03 100644
--- a/bootstrap/lib/stdlib/ebin/gen_event.beam
+++ b/bootstrap/lib/stdlib/ebin/gen_event.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam
index 1eee773838..d04466bf92 100644
--- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam
+++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam
index cb9421b7c5..7a7b4ad0f0 100644
--- a/bootstrap/lib/stdlib/ebin/gen_server.beam
+++ b/bootstrap/lib/stdlib/ebin/gen_server.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam
index 23b140aeb5..670943aad3 100644
--- a/bootstrap/lib/stdlib/ebin/otp_internal.beam
+++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/pg.beam b/bootstrap/lib/stdlib/ebin/pg.beam
deleted file mode 100644
index 31f30461d8..0000000000
--- a/bootstrap/lib/stdlib/ebin/pg.beam
+++ /dev/null
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam
index 368d3e39a0..55cfff4680 100644
--- a/bootstrap/lib/stdlib/ebin/proc_lib.beam
+++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app
index 8cbf23e958..968f2e4d2f 100644
--- a/bootstrap/lib/stdlib/ebin/stdlib.app
+++ b/bootstrap/lib/stdlib/ebin/stdlib.app
@@ -19,7 +19,7 @@
%%
{application, stdlib,
[{description, "ERTS CXC 138 10"},
- {vsn, "2.1.1"},
+ {vsn, "2.2"},
{modules, [array,
base64,
beam_lib,
@@ -77,7 +77,6 @@
orddict,
ordsets,
otp_internal,
- pg,
pool,
proc_lib,
proplists,
diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup
index d4db0c865e..541b1925e5 100644
--- a/bootstrap/lib/stdlib/ebin/stdlib.appup
+++ b/bootstrap/lib/stdlib/ebin/stdlib.appup
@@ -15,11 +15,11 @@
%% under the License.
%%
%% %CopyrightEnd%
-{"2.0",
+{"2.2",
%% Up from - max one major revision back
- [{<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17
- {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16
+ [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3
+ {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0
%% Down to - max one major revision back
- [{<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17
- {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16
+ [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3
+ {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0
}.
diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam
index 40d9b28a18..c2f7d78ec2 100644
--- a/bootstrap/lib/stdlib/ebin/supervisor.beam
+++ b/bootstrap/lib/stdlib/ebin/supervisor.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam
index 54d7385738..d4b8cab555 100644
--- a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam
+++ b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam
index 1413b822f2..a569f8003f 100644
--- a/bootstrap/lib/stdlib/ebin/sys.beam
+++ b/bootstrap/lib/stdlib/ebin/sys.beam
Binary files differ
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index d11f6b0c6d..16000191dc 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -1145,9 +1145,9 @@
<tag><marker id="+secio"><c>+secio true|false</c></marker></tag>
<item>
<p>Enable or disable eager check I/O scheduling. The default
- is currently <c>false</c>, but will most likely be changed
- to <c>true</c> in OTP 18. The behaviour before this flag
- was introduced corresponds to <c>+secio false</c>.</p>
+ is currently <c>true</c>. The default was changed from <c>false</c>
+ to <c>true</c> as of erts version 7.0. The behaviour before this
+ flag was introduced corresponds to <c>+secio false</c>.</p>
<p>The flag effects when schedulers will check for I/O
operations possible to execute, and when such I/O operations
will execute. As the name of the parameter implies,
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 111756407f..226f2c0150 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -1252,10 +1252,11 @@ true
<fsummary>Check if a function is exported and loaded</fsummary>
<desc>
<p>Returns <c>true</c> if the module <c><anno>Module</anno></c> is loaded
- and contains an exported function <c><anno>Function</anno>/<anno>Arity</anno></c>;
- otherwise <c>false</c>.</p>
- <p>Returns <c>false</c> for any BIF (functions implemented in C
- rather than in Erlang).</p>
+ and contains an exported function <c><anno>Function</anno>/<anno>Arity</anno></c>,
+ or if there is a BIF (a built-in function implemented in C)
+ with the given name; otherwise returns <c>false</c>.</p>
+ <note><p>This function used to return false for built-in
+ functions before the 18.0 release.</p></note>
</desc>
</func>
<func>
@@ -1376,6 +1377,19 @@ true
</desc>
</func>
<func>
+ <name name="get_keys" arity="0"/>
+ <fsummary>Return a list of all keys from the process dictionary</fsummary>
+ <desc>
+ <p>Returns a list of keys all keys present in the process dictionary.</p>
+ <pre>
+> <input>put(dog, {animal,1}),</input>
+<input>put(cow, {animal,2}),</input>
+<input>put(lamb, {animal,3}),</input>
+<input>get_keys().</input>
+[dog,cow,lamb]</pre>
+ </desc>
+ </func>
+ <func>
<name name="get_keys" arity="1"/>
<fsummary>Return a list of keys from the process dictionary</fsummary>
<desc>
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index 7145824f91..53fc7bd713 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -112,18 +112,24 @@ NO_INLINE_FUNCTIONS=true
else
ifeq ($(TYPE),lcnt)
-PURIFY =
+PURIFY =
TYPEMARKER = .lcnt
TYPE_FLAGS = @CFLAGS@ -DERTS_ENABLE_LOCK_COUNT
else
ifeq ($(TYPE),frmptr)
-PURIFY =
+PURIFY =
OMIT_OMIT_FP=yes
TYPEMARKER = .frmptr
TYPE_FLAGS = @CFLAGS@ -DERTS_FRMPTR
else
+ifeq ($(TYPE),icount)
+PURIFY =
+TYPEMARKER = .icount
+TYPE_FLAGS = @CFLAGS@ -DERTS_OPCODE_COUNTER_SUPPORT
+else
+
# If type isn't one of the above, it *is* opt type...
override TYPE=opt
PURIFY =
@@ -138,6 +144,7 @@ endif
endif
endif
endif
+endif
comma:=,
space:=
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 5d06a32941..721a1ff219 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -279,7 +279,6 @@ atom http httph https http_response http_request http_header http_eoh http_error
atom id
atom if_clause
atom ignore
-atom imports
atom in
atom in_exiting
atom inactive
@@ -335,6 +334,7 @@ atom max
atom maximum
atom max_tables max_processes
atom mbuf_size
+atom md5
atom memory
atom memory_internal
atom memory_types
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 8bfb7d2ad2..e9f5fd798b 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -241,10 +241,6 @@ BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */
void** beam_ops;
#endif
-#ifndef ERTS_SMP /* Not supported with smp emulator */
-extern int count_instructions;
-#endif
-
#define SWAPIN \
HTOP = HEAP_TOP(c_p); \
E = c_p->stop
@@ -1163,14 +1159,15 @@ void process_main(void)
Eterm (*arith_func)(Process* p, Eterm* reg, Uint live);
-#ifndef NO_JUMP_TABLE
- static void* opcodes[] = { DEFINE_OPCODES };
#ifdef ERTS_OPCODE_COUNTER_SUPPORT
static void* counting_opcodes[] = { DEFINE_COUNTING_OPCODES };
-#endif
+#else
+#ifndef NO_JUMP_TABLE
+ static void* opcodes[] = { DEFINE_OPCODES };
#else
int Go;
#endif
+#endif
Uint temp_bits; /* Temporary used by BsSkipBits2 & BsGetInteger2 */
@@ -3782,8 +3779,6 @@ get_map_elements_fail:
* Allocate the binary struct itself.
*/
bptr = erts_bin_nrml_alloc(num_bytes);
- bptr->flags = 0;
- bptr->orig_size = num_bytes;
erts_refc_init(&bptr->refc, 1);
erts_current_bin = (byte *) bptr->orig_bytes;
@@ -3883,8 +3878,6 @@ get_map_elements_fail:
* Allocate the binary struct itself.
*/
bptr = erts_bin_nrml_alloc(tmp_arg1);
- bptr->flags = 0;
- bptr->orig_size = tmp_arg1;
erts_refc_init(&bptr->refc, 1);
erts_current_bin = (byte *) bptr->orig_bytes;
@@ -4987,14 +4980,14 @@ get_map_elements_fail:
* ... remainder of original BEAM code
*/
ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI));
- c_p->hipe.ncallee = (void(*)(void)) I[-4];
+ c_p->hipe.u.ncallee = (void(*)(void)) I[-4];
cmd = HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8);
++hipe_trap_count;
goto L_hipe_mode_switch;
}
OpCase(hipe_trap_call_closure): {
ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI));
- c_p->hipe.ncallee = (void(*)(void)) I[-4];
+ c_p->hipe.u.ncallee = (void(*)(void)) I[-4];
cmd = HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8);
++hipe_trap_count;
goto L_hipe_mode_switch;
@@ -5028,7 +5021,10 @@ get_map_elements_fail:
case HIPE_MODE_SWITCH_RES_RETURN:
ASSERT(is_value(reg[0]));
MoveReturn(reg[0], r(0));
- case HIPE_MODE_SWITCH_RES_CALL:
+ case HIPE_MODE_SWITCH_RES_CALL_EXPORTED:
+ c_p->i = c_p->hipe.u.callee_exp->addressv[erts_active_code_ix()];
+ /*fall through*/
+ case HIPE_MODE_SWITCH_RES_CALL_BEAM:
SET_I(c_p->i);
r(0) = reg[0];
Dispatch();
@@ -5145,22 +5141,16 @@ get_map_elements_fail:
#ifndef NO_JUMP_TABLE
#ifdef ERTS_OPCODE_COUNTER_SUPPORT
-
/* Are tables correctly generated by beam_makeops? */
ASSERT(sizeof(counting_opcodes) == sizeof(opcodes));
-
- if (count_instructions) {
#ifdef DEBUG
- counting_opcodes[op_catch_end_y] = LabelAddr(lb_catch_end_y);
+ counting_opcodes[op_catch_end_y] = LabelAddr(lb_catch_end_y);
#endif
- counting_opcodes[op_i_func_info_IaaI] = LabelAddr(lb_i_func_info_IaaI);
- beam_ops = counting_opcodes;
- }
- else
-#endif /* #ifndef ERTS_OPCODE_COUNTER_SUPPORT */
- {
- beam_ops = opcodes;
- }
+ counting_opcodes[op_i_func_info_IaaI] = LabelAddr(lb_i_func_info_IaaI);
+ beam_ops = counting_opcodes;
+#else /* #ifndef ERTS_OPCODE_COUNTER_SUPPORT */
+ beam_ops = opcodes;
+#endif /* ERTS_OPCODE_COUNTER_SUPPORT */
#endif /* NO_JUMP_TABLE */
em_call_error_handler = OpCode(call_error_handler);
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index cfc6146b0a..07654f6d5c 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -245,7 +245,7 @@ typedef struct {
/*
* This structure contains all information about the module being loaded.
*/
-
+#define MD5_SIZE 16
typedef struct LoaderState {
/*
* The current logical file within the binary.
@@ -292,7 +292,7 @@ typedef struct LoaderState {
StringPatch* string_patches; /* Linked list of position into string table to patch. */
BeamInstr catches; /* Linked list of catch_yf instructions. */
unsigned loaded_size; /* Final size of code when loaded. */
- byte mod_md5[16]; /* MD5 for module code. */
+ byte mod_md5[MD5_SIZE]; /* MD5 for module code. */
int may_load_nif; /* true if NIFs may later be loaded for this module */
int on_load; /* Index in the code for the on_load function
* (or 0 if there is no on_load function)
@@ -528,6 +528,7 @@ static Eterm exported_from_module(Process* p, Eterm mod);
static Eterm functions_in_module(Process* p, Eterm mod);
static Eterm attributes_for_module(Process* p, Eterm mod);
static Eterm compilation_info_for_module(Process* p, Eterm mod);
+static Eterm md5_of_module(Process* p, Eterm mod);
static Eterm native_addresses(Process* p, Eterm mod);
int patch_funentries(Eterm Patchlist);
int patch(Eterm Addresses, Uint fe);
@@ -648,6 +649,7 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader,
stp->code[MI_COMPILE_PTR] = 0;
stp->code[MI_COMPILE_SIZE] = 0;
stp->code[MI_COMPILE_SIZE_ON_HEAP] = 0;
+ stp->code[MI_MD5_PTR] = 0;
/*
* Read the atom table.
@@ -4042,7 +4044,7 @@ freeze_code(LoaderState* stp)
}
size = (stp->ci * sizeof(BeamInstr)) +
(stp->total_literal_size * sizeof(Eterm)) +
- strtab_size + attr_size + compile_size + line_size;
+ strtab_size + attr_size + compile_size + MD5_SIZE + line_size;
/*
* Move the code to its final location.
@@ -4251,11 +4253,20 @@ freeze_code(LoaderState* stp)
code[MI_COMPILE_SIZE_ON_HEAP] = decoded_size;
}
CHKBLK(ERTS_ALC_T_CODE,code);
+ {
+ byte* md5_sum = str_table + strtab_size + attr_size + compile_size;
+ CHKBLK(ERTS_ALC_T_CODE,code);
+ sys_memcpy(md5_sum, stp->mod_md5, MD5_SIZE);
+ CHKBLK(ERTS_ALC_T_CODE,code);
+ code[MI_MD5_PTR] = (BeamInstr) md5_sum;
+ CHKBLK(ERTS_ALC_T_CODE,code);
+ }
+ CHKBLK(ERTS_ALC_T_CODE,code);
/*
* Make sure that we have not overflowed the allocated code space.
*/
- ASSERT(str_table + strtab_size + attr_size + compile_size ==
+ ASSERT(str_table + strtab_size + attr_size + compile_size + MD5_SIZE ==
((byte *) code) + size);
/*
@@ -5107,10 +5118,11 @@ erts_module_info_0(Process* p, Eterm module)
hp += 3; \
list = CONS(hp, tup, list)
+ BUILD_INFO(am_md5);
BUILD_INFO(am_compile);
BUILD_INFO(am_attributes);
- BUILD_INFO(am_imports);
BUILD_INFO(am_exports);
+ BUILD_INFO(am_module);
#undef BUILD_INFO
return list;
}
@@ -5120,8 +5132,8 @@ erts_module_info_1(Process* p, Eterm module, Eterm what)
{
if (what == am_module) {
return module;
- } else if (what == am_imports) {
- return NIL;
+ } else if (what == am_md5) {
+ return md5_of_module(p, module);
} else if (what == am_exports) {
return exported_from_module(p, module);
} else if (what == am_functions) {
@@ -5310,7 +5322,7 @@ attributes_for_module(Process* p, /* Process whose heap to use. */
Eterm result = NIL;
Eterm* end;
- if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) {
+ if (is_not_atom(mod)) {
return THE_NON_VALUE;
}
@@ -5349,7 +5361,7 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */
Eterm result = NIL;
Eterm* end;
- if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) {
+ if (is_not_atom(mod)) {
return THE_NON_VALUE;
}
@@ -5372,6 +5384,33 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */
}
/*
+ * Returns the MD5 checksum for a module
+ *
+ * Returns a tagged term, or 0 on error.
+ */
+
+Eterm
+md5_of_module(Process* p, /* Process whose heap to use. */
+ Eterm mod) /* Tagged atom for module. */
+{
+ Module* modp;
+ BeamInstr* code;
+ Eterm res = NIL;
+
+ if (is_not_atom(mod)) {
+ return THE_NON_VALUE;
+ }
+
+ modp = erts_get_module(mod, erts_active_code_ix());
+ if (modp == NULL) {
+ return THE_NON_VALUE;
+ }
+ code = modp->curr.code;
+ res = new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE);
+ return res;
+}
+
+/*
* Build a single {M,F,A,Loction} item to be part of
* a stack trace.
*/
@@ -5547,7 +5586,7 @@ code_module_md5_1(BIF_ALIST_1)
res = am_undefined;
goto done;
}
- res = new_binary(p, stp->mod_md5, sizeof(stp->mod_md5));
+ res = new_binary(p, stp->mod_md5, MD5_SIZE);
done:
erts_free_aligned_binary_bytes(temp_alloc);
@@ -5943,6 +5982,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
code[MI_LITERALS_END] = 0;
code[MI_LITERALS_OFF_HEAP] = 0;
code[MI_ON_LOAD_FUNCTION_PTR] = 0;
+ code[MI_MD5_PTR] = 0;
ci = MI_FUNCTIONS + n + 1;
/*
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index bd22b0c4de..0e3ca0bdb0 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -91,7 +91,6 @@ extern Uint erts_total_code_size;
#define MI_LITERALS_END 8
#define MI_LITERALS_OFF_HEAP 9
-
/*
* Pointer to the on_load function (or NULL if none).
*/
@@ -103,6 +102,11 @@ extern Uint erts_total_code_size;
#define MI_LINE_TABLE 11
/*
+ * Pointer to the module MD5 sum (16 bytes)
+ */
+#define MI_MD5_PTR 12
+
+/*
* Start of function pointer table. This table contains pointers to
* all functions in the module plus an additional pointer just beyond
* the end of the last function.
@@ -111,7 +115,7 @@ extern Uint erts_total_code_size;
* this table.
*/
-#define MI_FUNCTIONS 12
+#define MI_FUNCTIONS 13
/*
* Layout of the line table.
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index a5be8e1529..12a1ecd50e 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -28,7 +28,9 @@
#include "global.h"
#include "erl_process.h"
#include "error.h"
+#define ERL_WANT_HIPE_BIF_WRAPPER__
#include "bif.h"
+#undef ERL_WANT_HIPE_BIF_WRAPPER__
#include "big.h"
#include "dist.h"
#include "erl_version.h"
@@ -3994,16 +3996,19 @@ BIF_RETTYPE halt_2(BIF_ALIST_2)
BIF_RETTYPE function_exported_3(BIF_ALIST_3)
{
+ int arity;
if (is_not_atom(BIF_ARG_1) ||
is_not_atom(BIF_ARG_2) ||
is_not_small(BIF_ARG_3)) {
BIF_ERROR(BIF_P, BADARG);
}
- if (erts_find_function(BIF_ARG_1, BIF_ARG_2, signed_val(BIF_ARG_3),
- erts_active_code_ix()) == NULL) {
- BIF_RET(am_false);
+ arity = signed_val(BIF_ARG_3);
+ if (erts_find_function(BIF_ARG_1, BIF_ARG_2, arity,
+ erts_active_code_ix()) != NULL ||
+ erts_is_builtin(BIF_ARG_1, BIF_ARG_2, arity)) {
+ BIF_RET(am_true);
}
- BIF_RET(am_true);
+ BIF_RET(am_false);
}
/**********************************************************************/
diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h
index 72c55ccb55..7b69b39511 100644
--- a/erts/emulator/beam/bif.h
+++ b/erts/emulator/beam/bif.h
@@ -465,6 +465,8 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p,
Eterm args[],
int nargs);
+#ifdef ERL_WANT_HIPE_BIF_WRAPPER__
+
#ifndef HIPE
#define HIPE_WRAPPER_BIF_DISABLE_GC(BIF_NAME, ARITY)
@@ -509,6 +511,7 @@ BIF_RETTYPE hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (Process* c_p, \
#endif
+#endif /* ERL_WANT_HIPE_BIF_WRAPPER__ */
#include "erl_bif_table.h"
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index e68b8e6274..55ac778475 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -578,7 +578,7 @@ bif io:printable_range/0
bif os:unsetenv/1
#
-# New in R17A
+# New in 17.0
#
bif re:inspect/2
@@ -601,9 +601,16 @@ bif maps:values/1
bif erts_internal:cmp_term/2
#
-# New in 17.1.
+# New in 17.1
#
+
bif erlang:fun_info_mfa/1
+
+# New in 18.0
+#
+
+bif erlang:get_keys/0
+
#
# Obsolete
#
diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c
index f50d484576..cc0b3b9b6c 100644
--- a/erts/emulator/beam/binary.c
+++ b/erts/emulator/beam/binary.c
@@ -26,7 +26,9 @@
#include "global.h"
#include "erl_process.h"
#include "error.h"
+#define ERL_WANT_HIPE_BIF_WRAPPER__
#include "bif.h"
+#undef ERL_WANT_HIPE_BIF_WRAPPER__
#include "big.h"
#include "erl_binary.h"
#include "erl_bits.h"
@@ -83,8 +85,6 @@ new_binary(Process *p, byte *buf, Uint len)
* Allocate the binary struct itself.
*/
bptr = erts_bin_nrml_alloc(len);
- bptr->flags = 0;
- bptr->orig_size = len;
erts_refc_init(&bptr->refc, 1);
if (buf != NULL) {
sys_memcpy(bptr->orig_bytes, buf, len);
@@ -122,8 +122,6 @@ Eterm erts_new_mso_binary(Process *p, byte *buf, int len)
* Allocate the binary struct itself.
*/
bptr = erts_bin_nrml_alloc(len);
- bptr->flags = 0;
- bptr->orig_size = len;
erts_refc_init(&bptr->refc, 1);
if (buf != NULL) {
sys_memcpy(bptr->orig_bytes, buf, len);
@@ -177,7 +175,6 @@ erts_realloc_binary(Eterm bin, size_t size)
} else { /* REFC */
ProcBin* pb = (ProcBin *) bval;
Binary* newbin = erts_bin_realloc(pb->val, size);
- newbin->orig_size = size;
pb->val = newbin;
pb->size = size;
pb->bytes = (byte*) newbin->orig_bytes;
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index 50548850eb..0010f6a440 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -21,6 +21,8 @@
# include "config.h"
#endif
+#define ERL_WANT_GC_INTERNALS__
+
#include "sys.h"
#include "erl_vm.h"
#include "global.h"
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index ec07ddcd9c..dcbbb857da 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -622,9 +622,7 @@ alloc_dist_obuf(Uint size)
ErtsDistOutputBuf *obuf;
Uint obuf_size = sizeof(ErtsDistOutputBuf)+sizeof(byte)*(size-1);
Binary *bin = erts_bin_drv_alloc(obuf_size);
- bin->flags = BIN_FLAG_DRV;
erts_refc_init(&bin->refc, 1);
- bin->orig_size = (SWord) obuf_size;
obuf = (ErtsDistOutputBuf *) &bin->orig_bytes[0];
#ifdef DEBUG
obuf->dbg_pattern = ERTS_DIST_OUTPUT_BUF_DBG_PATTERN;
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 21434eb117..61def65235 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -415,6 +415,8 @@ type CS_PROG_PATH LONG_LIVED SYSTEM cs_prog_path
type ENVIRONMENT TEMPORARY SYSTEM environment
type PUTENV_STR SYSTEM SYSTEM putenv_string
type PRT_REP_EXIT STANDARD SYSTEM port_report_exit
+type SYS_BLOCKING STANDARD SYSTEM sys_blocking
+type SYS_WRITE_BUF TEMPORARY SYSTEM sys_write_buf
+endif
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index 3bf78adce7..bd0d7c71cc 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -32,7 +32,9 @@
#include "global.h"
#include "erl_process.h"
#include "error.h"
+#define ERL_WANT_HIPE_BIF_WRAPPER__
#include "bif.h"
+#undef ERL_WANT_HIPE_BIF_WRAPPER__
#include "big.h"
#include "erl_binary.h"
#include "erl_bits.h"
@@ -2424,8 +2426,6 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en)
}
cbs->result = erts_bin_nrml_alloc(target_size); /* Always offheap
if trapping */
- cbs->result->flags = 0;
- cbs->result->orig_size = target_size;
erts_refc_init(&(cbs->result->refc), 1);
t = (byte *) cbs->result->orig_bytes; /* No offset or anything */
pos = 0;
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 61e4469600..e92842c7d1 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -115,6 +115,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE
#ifdef ERTS_ENABLE_LOCK_COUNT
" [lock-counting]"
#endif
+#ifdef ERTS_OPCODE_COUNTER_SUPPORT
+ " [instruction-counting]"
+#endif
#ifdef PURIFY
" [purify-compiled]"
#endif
@@ -2300,7 +2303,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
for (i = num_instructions-1; i >= 0; i--) {
res = erts_bld_cons(hpp, hszp,
erts_bld_tuple(hpp, hszp, 2,
- erts_atom_put(opc[i].name,
+ erts_atom_put((byte *)opc[i].name,
strlen(opc[i].name),
ERTS_ATOM_ENC_LATIN1,
1),
diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h
index 06dfeb1260..8d264d166e 100644
--- a/erts/emulator/beam/erl_binary.h
+++ b/erts/emulator/beam/erl_binary.h
@@ -231,41 +231,58 @@ erts_free_aligned_binary_bytes(byte* buf)
# define CHICKEN_PAD (sizeof(void*) - 1)
#endif
+/* Caller must initialize 'refc'
+*/
ERTS_GLB_INLINE Binary *
erts_bin_drv_alloc_fnf(Uint size)
{
Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD;
- void *res;
+ Binary *res;
+
if (bsize < size) /* overflow */
return NULL;
res = erts_alloc_fnf(ERTS_ALC_T_DRV_BINARY, bsize);
ERTS_CHK_BIN_ALIGNMENT(res);
- return (Binary *) res;
+ if (res) {
+ res->orig_size = size;
+ res->flags = BIN_FLAG_DRV;
+ }
+ return res;
}
+/* Caller must initialize 'refc'
+*/
ERTS_GLB_INLINE Binary *
erts_bin_drv_alloc(Uint size)
{
Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD;
- void *res;
+ Binary *res;
+
if (bsize < size) /* overflow */
erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, size);
res = erts_alloc(ERTS_ALC_T_DRV_BINARY, bsize);
ERTS_CHK_BIN_ALIGNMENT(res);
- return (Binary *) res;
+ res->orig_size = size;
+ res->flags = BIN_FLAG_DRV;
+ return res;
}
+/* Caller must initialize 'refc'
+*/
ERTS_GLB_INLINE Binary *
erts_bin_nrml_alloc(Uint size)
{
Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD;
- void *res;
+ Binary *res;
+
if (bsize < size) /* overflow */
erts_alloc_enomem(ERTS_ALC_T_BINARY, size);
res = erts_alloc(ERTS_ALC_T_BINARY, bsize);
ERTS_CHK_BIN_ALIGNMENT(res);
- return (Binary *) res;
+ res->orig_size = size;
+ res->flags = 0;
+ return res;
}
ERTS_GLB_INLINE Binary *
@@ -280,6 +297,8 @@ erts_bin_realloc_fnf(Binary *bp, Uint size)
return NULL;
nbp = erts_realloc_fnf(type, (void *) bp, bsize);
ERTS_CHK_BIN_ALIGNMENT(nbp);
+ if (nbp)
+ nbp->orig_size = size;
return nbp;
}
@@ -297,6 +316,7 @@ erts_bin_realloc(Binary *bp, Uint size)
if (!nbp)
erts_realloc_enomem(type, bp, bsize);
ERTS_CHK_BIN_ALIGNMENT(nbp);
+ nbp->orig_size = size;
return nbp;
}
@@ -329,4 +349,4 @@ erts_create_magic_binary(Uint size, void (*destructor)(Binary *))
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
-#endif
+#endif /* !__ERL_BINARY_H */
diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c
index 73765772c8..71d31c01aa 100644
--- a/erts/emulator/beam/erl_bits.c
+++ b/erts/emulator/beam/erl_bits.c
@@ -1299,7 +1299,6 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term,
if (binp->orig_size < pb->size) {
Uint new_size = 2*pb->size;
binp = erts_bin_realloc(binp, new_size);
- binp->orig_size = new_size;
pb->val = binp;
pb->bytes = (byte *) binp->orig_bytes;
}
@@ -1371,8 +1370,6 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term,
* Allocate the binary data struct itself.
*/
bptr = erts_bin_nrml_alloc(bin_size);
- bptr->flags = 0;
- bptr->orig_size = bin_size;
erts_refc_init(&bptr->refc, 1);
erts_current_bin = (byte *) bptr->orig_bytes;
@@ -1475,7 +1472,6 @@ erts_bs_private_append(Process* p, Eterm bin, Eterm build_size_term, Uint unit)
* is safe to reallocate it.
*/
binp = erts_bin_realloc(binp, new_size);
- binp->orig_size = new_size;
pb->val = binp;
pb->bytes = (byte *) binp->orig_bytes;
} else {
@@ -1488,8 +1484,6 @@ erts_bs_private_append(Process* p, Eterm bin, Eterm build_size_term, Uint unit)
* binary and copy the contents of the old binary into it.
*/
Binary* bptr = erts_bin_nrml_alloc(new_size);
- bptr->flags = 0;
- bptr->orig_size = new_size;
erts_refc_init(&bptr->refc, 1);
sys_memcpy(bptr->orig_bytes, binp->orig_bytes, binp->orig_size);
pb->flags |= PB_IS_WRITABLE | PB_ACTIVE_WRITER;
@@ -1537,8 +1531,6 @@ erts_bs_init_writable(Process* p, Eterm sz)
* Allocate the binary data struct itself.
*/
bptr = erts_bin_nrml_alloc(bin_size);
- bptr->flags = 0;
- bptr->orig_size = bin_size;
erts_refc_init(&bptr->refc, 1);
/*
@@ -1585,9 +1577,7 @@ erts_emasculate_writable_binary(ProcBin* pb)
/* Our allocators are 8 byte aligned, i.e., shrinking with
less than 8 bytes will have no real effect */
if (unused >= 8) {
- Uint new_size = pb->size;
binp = erts_bin_realloc(binp, pb->size);
- binp->orig_size = new_size;
pb->val = binp;
pb->bytes = (byte *) binp->orig_bytes;
}
diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h
index 908cec11d4..e68081a5b1 100644
--- a/erts/emulator/beam/erl_db_hash.h
+++ b/erts/emulator/beam/erl_db_hash.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1998-2013. All Rights Reserved.
+ * Copyright Ericsson AB 1998-2014. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -42,7 +42,7 @@ typedef struct hash_db_term {
typedef struct db_table_hash_fine_locks {
union {
erts_smp_rwmtx_t lck;
- byte _cache_line_alignment[64];
+ byte _cache_line_alignment[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_smp_rwmtx_t))];
}lck_vec[DB_HASH_LOCK_CNT];
} DbTableHashFineLocks;
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 0db42d4325..5f78a7b532 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -20,6 +20,8 @@
# include "config.h"
#endif
+#define ERL_WANT_GC_INTERNALS__
+
#include "sys.h"
#include "erl_vm.h"
#include "global.h"
@@ -2400,7 +2402,6 @@ sweep_off_heap(Process *p, int fullsweep)
}
pb->val = erts_bin_realloc(pb->val, new_size);
- pb->val->orig_size = new_size;
pb->bytes = (byte *) pb->val->orig_bytes;
}
}
diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h
index 5203dda263..bf0496c112 100644
--- a/erts/emulator/beam/erl_gc.h
+++ b/erts/emulator/beam/erl_gc.h
@@ -20,10 +20,12 @@
#ifndef __ERL_GC_H__
#define __ERL_GC_H__
-#include "erl_map.h"
+#if defined(ERL_WANT_GC_INTERNALS__) || defined(ERTS_DO_INCL_GLB_INLINE_FUNC_DEF)
/* GC declarations shared by beam/erl_gc.c and hipe/hipe_gc.c */
+#include "erl_map.h"
+
#if defined(DEBUG) && !ERTS_GLB_INLINE_INCL_FUNC_DEF
# define HARDDEBUG 1
#endif
@@ -67,8 +69,6 @@ do { \
#define in_area(ptr,start,nbytes) \
((UWord)((char*)(ptr) - (char*)(start)) < (nbytes))
-extern Uint erts_test_long_gc_sleep;
-
#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG)
int within(Eterm *ptr, Process *p);
#endif
@@ -97,4 +97,33 @@ ERTS_GLB_INLINE Eterm follow_moved(Eterm term)
}
#endif
+#endif /* ERL_GC_C__ || HIPE_GC_C__ */
+
+/*
+ * Global exported
+ */
+
+extern Uint erts_test_long_gc_sleep;
+
+typedef struct {
+ Uint64 reclaimed;
+ Uint64 garbage_cols;
+} ErtsGCInfo;
+
+void erts_gc_info(ErtsGCInfo *gcip);
+void erts_init_gc(void);
+int erts_garbage_collect(struct process*, int, Eterm*, int);
+void erts_garbage_collect_hibernate(struct process* p);
+Eterm erts_gc_after_bif_call(struct process* p, Eterm result, Eterm* regs, Uint arity);
+void erts_garbage_collect_literals(struct process* p, Eterm* literals,
+ Uint lit_size,
+ struct erl_off_heap_header* oh);
+Uint erts_next_heap_size(Uint, Uint);
+Eterm erts_heap_sizes(struct process* p);
+
+void erts_offset_off_heap(struct erl_off_heap*, Sint, Eterm*, Eterm*);
+void erts_offset_heap_ptr(Eterm*, Uint, Sint, Eterm*, Eterm*);
+void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*);
+void erts_free_heap_frags(struct process* p);
+
#endif /* __ERL_GC_H__ */
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index 61f8385efc..77445ef1ff 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -161,9 +161,6 @@ int H_MIN_SIZE; /* The minimum heap grain */
int BIN_VH_MIN_SIZE; /* The minimum binary virtual*/
Uint32 erts_debug_flags; /* Debug flags. */
-#ifdef ERTS_OPCODE_COUNTER_SUPPORT
-int count_instructions;
-#endif
int erts_backtrace_depth; /* How many functions to show in a backtrace
* in error codes.
*/
@@ -1900,11 +1897,6 @@ erl_start(int argc, char **argv)
if (argv[i][2] == 0) { /* -c: documented option */
erts_disable_tolerant_timeofday = 1;
}
-#ifdef ERTS_OPCODE_COUNTER_SUPPORT
- else if (argv[i][2] == 'i') { /* -ci: undcoumented option*/
- count_instructions = 1;
- }
-#endif
break;
case 'W':
arg = get_arg(argv[i]+2, argv[i+1], &i);
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index ede5f335dc..3708133f40 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -551,9 +551,7 @@ int enif_alloc_binary(size_t size, ErlNifBinary* bin)
if (refbin == NULL) {
return 0; /* The NIF must take action */
}
- refbin->flags = BIN_FLAG_DRV; /* BUGBUG: Flag? */
erts_refc_init(&refbin->refc, 1);
- refbin->orig_size = (SWord) size;
bin->size = size;
bin->data = (unsigned char*) refbin->orig_bytes;
@@ -573,7 +571,6 @@ int enif_realloc_binary(ErlNifBinary* bin, size_t size)
if (!newbin) {
return 0;
}
- newbin->orig_size = size;
bin->ref_bin = newbin;
bin->data = (unsigned char*) newbin->orig_bytes;
bin->size = size;
diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c
index d18760dc43..1a0c7a9fc9 100644
--- a/erts/emulator/beam/erl_printf_term.c
+++ b/erts/emulator/beam/erl_printf_term.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2013. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2014. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -25,6 +25,7 @@
#include "sys.h"
#include "big.h"
#include "erl_map.h"
+#include "erl_binary.h"
#define PRINT_CHAR(CNT, FN, ARG, C) \
do { \
@@ -138,6 +139,25 @@ is_printable_string(Eterm list, Eterm* base)
return 0;
}
+static int is_printable_ascii(byte* bytep, Uint bytesize, Uint bitoffs)
+{
+ if (!bitoffs) {
+ while (bytesize--) {
+ if (*bytep < ' ' || *bytep >= 127)
+ return 0;
+ bytep++;
+ }
+ } else {
+ while (bytesize--) {
+ byte octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs));
+ if (octet < ' ' || octet >= 127)
+ return 0;
+ bytep++;
+ }
+ }
+ return 1;
+}
+
/* print a atom doing what quoting is necessary */
static int print_atom_name(fmtfn_t fn, void* arg, Eterm atom, long *dcount)
{
@@ -446,13 +466,65 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount,
PRINT_STRING(res, fn, arg, "#MatchState");
}
else {
- ProcBin* pb = (ProcBin *) binary_val(wobj);
- if (pb->size == 1)
- PRINT_STRING(res, fn, arg, "<<1 byte>>");
- else {
+ byte* bytep;
+ Uint bytesize = binary_size_rel(obj,obj_base);
+ Uint bitoffs;
+ Uint bitsize;
+ byte octet;
+ ERTS_GET_BINARY_BYTES_REL(obj, bytep, bitoffs, bitsize, obj_base);
+
+ if (bitsize || !bytesize
+ || !is_printable_ascii(bytep, bytesize, bitoffs)) {
+ int is_first = 1;
PRINT_STRING(res, fn, arg, "<<");
- PRINT_UWORD(res, fn, arg, 'u', 0, 1, (ErlPfUWord) pb->size);
- PRINT_STRING(res, fn, arg, " bytes>>");
+ while (bytesize) {
+ if (is_first)
+ is_first = 0;
+ else
+ PRINT_CHAR(res, fn, arg, ',');
+ if (bitoffs)
+ octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs));
+ else
+ octet = bytep[0];
+ PRINT_UWORD(res, fn, arg, 'u', 0, 1, octet);
+ ++bytep;
+ --bytesize;
+ }
+ if (bitsize) {
+ Uint bits = bitoffs + bitsize;
+ octet = bytep[0];
+ if (bits < 8)
+ octet >>= 8 - bits;
+ else if (bits > 8) {
+ bits -= 8; /* bits in last byte */
+ octet <<= bits;
+ octet |= bytep[1] >> (8 - bits);
+ }
+ octet &= (1 << bitsize) - 1;
+ if (is_first)
+ is_first = 0;
+ else
+ PRINT_CHAR(res, fn, arg, ',');
+ PRINT_UWORD(res, fn, arg, 'u', 0, 1, octet);
+ PRINT_CHAR(res, fn, arg, ':');
+ PRINT_UWORD(res, fn, arg, 'u', 0, 1, bitsize);
+ }
+ PRINT_STRING(res, fn, arg, ">>");
+ }
+ else {
+ PRINT_STRING(res, fn, arg, "<<\"");
+ while (bytesize) {
+ if (bitoffs)
+ octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs));
+ else
+ octet = bytep[0];
+ if (octet == '"')
+ PRINT_CHAR(res, fn, arg, '\\');
+ PRINT_CHAR(res, fn, arg, octet);
+ ++bytep;
+ --bytesize;
+ }
+ PRINT_STRING(res, fn, arg, "\">>");
}
}
break;
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index e5bb1203c8..7b272885a7 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -152,7 +152,7 @@ extern BeamInstr beam_continue_exit[];
/* Eager check I/O not supported on OSE yet. */
int erts_eager_check_io = 0;
#else
-int erts_eager_check_io = 0;
+int erts_eager_check_io = 1;
#endif
int erts_sched_compact_load;
int erts_sched_balance_util = 0;
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 27a3a3553b..3d08be25ff 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -58,6 +58,7 @@ typedef struct process Process;
#include "external.h"
#include "erl_mseg.h"
#include "erl_async.h"
+#include "erl_gc.h"
#ifdef HIPE
#include "hipe_process.h"
@@ -489,11 +490,6 @@ typedef struct {
} ErtsSchedWallTime;
typedef struct {
- Uint64 reclaimed;
- Uint64 garbage_cols;
-} ErtsGCInfo;
-
-typedef struct {
int sched;
erts_aint32_t aux_work;
} ErtsDelayedAuxWorkWakeupJob;
diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c
index 23e5bf737f..3ce707efda 100644
--- a/erts/emulator/beam/erl_process_dict.c
+++ b/erts/emulator/beam/erl_process_dict.c
@@ -82,6 +82,7 @@
static void pd_hash_erase(Process *p, Eterm id, Eterm *ret);
static void pd_hash_erase_all(Process *p);
static Eterm pd_hash_get_keys(Process *p, Eterm value);
+static Eterm pd_hash_get_all_keys(Process *p, ProcDict *pd);
static Eterm pd_hash_get_all(Process *p, ProcDict *pd);
static Eterm pd_hash_put(Process *p, Eterm id, Eterm value);
@@ -275,6 +276,16 @@ BIF_RETTYPE get_1(BIF_ALIST_1)
BIF_RET(ret);
}
+BIF_RETTYPE get_keys_0(BIF_ALIST_0)
+{
+ Eterm ret;
+
+ PD_CHECK(BIF_P->dictionary);
+ ret = pd_hash_get_all_keys(BIF_P,BIF_P->dictionary);
+ PD_CHECK(BIF_P->dictionary);
+ BIF_RET(ret);
+}
+
BIF_RETTYPE get_keys_1(BIF_ALIST_1)
{
Eterm ret;
@@ -412,6 +423,47 @@ Eterm erts_pd_hash_get(Process *p, Eterm id)
return am_undefined;
}
+#define PD_GET_TKEY(Dst,Src) \
+do { \
+ ASSERT(is_tuple((Src))); \
+ ASSERT(arityval(*((Eterm*)tuple_val((Src)))) == 2); \
+ (Dst) = ((Eterm*)tuple_val((Src)))[1]; \
+} while(0)
+
+static Eterm pd_hash_get_all_keys(Process *p, ProcDict *pd) {
+ Eterm* hp;
+ Eterm res = NIL;
+ Eterm tmp, tmp2;
+ unsigned int i;
+ unsigned int num;
+
+ if (pd == NULL) {
+ return res;
+ }
+
+ num = HASH_RANGE(pd);
+ hp = HAlloc(p, pd->numElements * 2);
+
+ for (i = 0; i < num; ++i) {
+ tmp = ARRAY_GET(pd, i);
+ if (is_boxed(tmp)) {
+ PD_GET_TKEY(tmp,tmp);
+ res = CONS(hp, tmp, res);
+ hp += 2;
+ } else if (is_list(tmp)) {
+ while (tmp != NIL) {
+ tmp2 = TCAR(tmp);
+ PD_GET_TKEY(tmp2,tmp2);
+ res = CONS(hp, tmp2, res);
+ hp += 2;
+ tmp = TCDR(tmp);
+ }
+ }
+ }
+ return res;
+}
+#undef PD_GET_TKEY
+
static Eterm pd_hash_get_keys(Process *p, Eterm value)
{
Eterm *hp;
diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h
index b7de8208ad..78d98229d8 100644
--- a/erts/emulator/beam/erl_vm.h
+++ b/erts/emulator/beam/erl_vm.h
@@ -20,8 +20,6 @@
#ifndef __ERL_VM_H__
#define __ERL_VM_H__
-/* #define ERTS_OPCODE_COUNTER_SUPPORT */
-
/* FORCE_HEAP_FRAGS:
* Debug provocation to make HAlloc always create heap fragments (if allowed)
* even if there is room on heap.
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index 9b9b4b2a62..48e717bb6f 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -36,7 +36,9 @@
#include "erl_process.h"
#include "error.h"
#include "external.h"
+#define ERL_WANT_HIPE_BIF_WRAPPER__
#include "bif.h"
+#undef ERL_WANT_HIPE_BIF_WRAPPER__
#include "big.h"
#include "dist.h"
#include "erl_binary.h"
@@ -1899,8 +1901,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
}
result_bin = erts_bin_nrml_alloc(size);
- result_bin->flags = 0;
- result_bin->orig_size = size;
erts_refc_init(&result_bin->refc, 0);
result_bin->orig_bytes[0] = VERSION_MAGIC;
/* Next state immediately, no need to export context */
@@ -1925,7 +1925,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
}
real_size = endp - bytes;
result_bin = erts_bin_realloc(context->s.ec.result_bin,real_size);
- result_bin->orig_size = real_size;
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 */
@@ -1962,8 +1961,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
context->s.cc.result_bin = result_bin;
result_bin = erts_bin_nrml_alloc(real_size);
- result_bin->flags = 0;
- result_bin->orig_size = real_size;
erts_refc_init(&result_bin->refc, 0);
result_bin->orig_bytes[0] = VERSION_MAGIC;
@@ -2005,7 +2002,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla
erl_zlib_deflate_finish(&(context->s.cc.stream));
result_bin = erts_bin_realloc(context->s.cc.destination_bin,
context->s.cc.dest_len+6);
- result_bin->orig_size = 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;
@@ -3387,8 +3383,6 @@ dec_term_atom_common:
} else {
Binary* dbin = erts_bin_nrml_alloc(n);
ProcBin* pb;
- dbin->flags = 0;
- dbin->orig_size = n;
erts_refc_init(&dbin->refc, 1);
pb = (ProcBin *) hp;
hp += PROC_BIN_SIZE;
@@ -3441,8 +3435,6 @@ dec_term_atom_common:
Binary* dbin = erts_bin_nrml_alloc(n);
ProcBin* pb;
- dbin->flags = 0;
- dbin->orig_size = n;
erts_refc_init(&dbin->refc, 1);
pb = (ProcBin *) hp;
pb->thing_word = HEADER_PROC_BIN;
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 891046a8b5..da9f029a9f 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -41,6 +41,7 @@
#include "error.h"
#include "erl_utils.h"
#include "erl_port.h"
+#include "erl_gc.h"
struct enif_environment_t /* ErlNifEnv */
{
@@ -809,23 +810,6 @@ void MD5Init(MD5_CTX *);
void MD5Update(MD5_CTX *, unsigned char *, unsigned int);
void MD5Final(unsigned char [16], MD5_CTX *);
-/* ggc.c */
-
-void erts_gc_info(ErtsGCInfo *gcip);
-void erts_init_gc(void);
-int erts_garbage_collect(Process*, int, Eterm*, int);
-void erts_garbage_collect_hibernate(Process* p);
-Eterm erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity);
-void erts_garbage_collect_literals(Process* p, Eterm* literals,
- Uint lit_size,
- struct erl_off_heap_header* oh);
-Uint erts_next_heap_size(Uint, Uint);
-Eterm erts_heap_sizes(Process* p);
-
-void erts_offset_off_heap(ErlOffHeap *, Sint, Eterm*, Eterm*);
-void erts_offset_heap_ptr(Eterm*, Uint, Sint, Eterm*, Eterm*);
-void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*);
-void erts_free_heap_frags(Process* p);
/* io.c */
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index 9ae973e108..4d262ff022 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -3153,8 +3153,6 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to,
Binary* bptr;
bptr = erts_bin_nrml_alloc(len);
- bptr->flags = 0;
- bptr->orig_size = len;
erts_refc_init(&bptr->refc, 1);
sys_memcpy(bptr->orig_bytes, buf, len);
@@ -5506,8 +5504,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len)
ProcBin* pbp;
Binary* bp = erts_bin_nrml_alloc(size);
ASSERT(bufp);
- bp->flags = 0;
- bp->orig_size = (SWord) size;
erts_refc_init(&bp->refc, 1);
sys_memcpy((void *) bp->orig_bytes, (void *) bufp, size);
pbp = (ProcBin *) hp;
@@ -5999,9 +5995,7 @@ driver_alloc_binary(ErlDrvSizeT size)
bin = erts_bin_drv_alloc_fnf((Uint) size);
if (!bin)
return NULL; /* The driver write must take action */
- bin->flags = BIN_FLAG_DRV;
erts_refc_init(&bin->refc, 1);
- bin->orig_size = (SWord) size;
return Binary2ErlDrvBinary(bin);
}
@@ -6031,7 +6025,6 @@ ErlDrvBinary* driver_realloc_binary(ErlDrvBinary* bin, ErlDrvSizeT size)
if (!newbin)
return NULL;
- newbin->orig_size = size;
return Binary2ErlDrvBinary(newbin);
}
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index f20e6e5665..9b3ee5cc65 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -49,6 +49,9 @@
#include "beam_bp.h"
#include "erl_ptab.h"
#include "erl_check_io.h"
+#ifdef HIPE
+# include "hipe_mode_switch.h"
+#endif
#undef M_TRIM_THRESHOLD
#undef M_TOP_PAD
diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c
index 491e0a090e..be2fee1f25 100644
--- a/erts/emulator/drivers/unix/ttsl_drv.c
+++ b/erts/emulator/drivers/unix/ttsl_drv.c
@@ -32,6 +32,10 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*);
#ifdef HAVE_TERMCAP /* else make an empty driver that can not be opened */
+#ifndef WANT_NONBLOCKING
+#define WANT_NONBLOCKING
+#endif
+
#include "sys.h"
#include <ctype.h>
#include <stdlib.h>
@@ -39,6 +43,7 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*);
#include <string.h>
#include <signal.h>
#include <fcntl.h>
+#include <limits.h>
#include <locale.h>
#include <unistd.h>
#include <termios.h>
@@ -57,6 +62,14 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*);
#include <langinfo.h>
#endif
+#if defined IOV_MAX
+#define MAXIOV IOV_MAX
+#elif defined UIO_MAXIOV
+#define MAXIOV UIO_MAXIOV
+#else
+#define MAXIOV 16
+#endif
+
#define TRUE 1
#define FALSE 0
@@ -80,12 +93,15 @@ static volatile int cols_needs_update = FALSE;
#define OP_INSC 2
#define OP_DELC 3
#define OP_BEEP 4
+#define OP_PUTC_SYNC 5
/* Control op */
#define CTRL_OP_GET_WINSIZE 100
#define CTRL_OP_GET_UNICODE_STATE 101
#define CTRL_OP_SET_UNICODE_STATE 102
-
+/* We use 1024 as the buf size as that was the default buf size of FILE streams
+ on all platforms that I checked. */
+#define TTY_BUFFSIZE 1024
static int lbuf_size = BUFSIZ;
static Uint32 *lbuf; /* The current line buffer */
@@ -113,13 +129,19 @@ static int lpos; /* The current "cursor position" in the line buf
/* Main interface functions. */
static void ttysl_stop(ErlDrvData);
static void ttysl_from_erlang(ErlDrvData, char*, ErlDrvSizeT);
+static void ttysl_to_tty(ErlDrvData, ErlDrvEvent);
+static void ttysl_flush_tty(ErlDrvData);
static void ttysl_from_tty(ErlDrvData, ErlDrvEvent);
static void ttysl_stop_select(ErlDrvEvent, void*);
static Sint16 get_sint16(char*);
static ErlDrvPort ttysl_port;
static int ttysl_fd;
-static FILE *ttysl_out;
+static int ttysl_terminate = 0;
+static int ttysl_send_ok = 0;
+static ErlDrvBinary *putcbuf;
+static int putcpos;
+static int putclen;
/* Functions that work on the line buffer. */
static int start_lbuf(void);
@@ -201,22 +223,22 @@ struct erl_drv_entry ttsl_driver_entry = {
IF_IMPL(ttysl_stop),
IF_IMPL(ttysl_from_erlang),
IF_IMPL(ttysl_from_tty),
- NULL,
- "tty_sl",
- NULL,
- NULL,
+ IF_IMPL(ttysl_to_tty),
+ "tty_sl", /* driver_name */
+ NULL, /* finish */
+ NULL, /* handle */
IF_IMPL(ttysl_control),
NULL, /* timeout */
NULL, /* outputv */
NULL, /* ready_async */
- NULL, /* flush */
+ IF_IMPL(ttysl_flush_tty),
NULL, /* call */
NULL, /* event */
ERL_DRV_EXTENDED_MARKER,
ERL_DRV_EXTENDED_MAJOR_VERSION,
ERL_DRV_EXTENDED_MINOR_VERSION,
0, /* ERL_DRV_FLAGs */
- NULL,
+ NULL, /* handle2 */
NULL, /* process_exit */
IF_IMPL(ttysl_stop_select)
};
@@ -296,8 +318,7 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf)
return ERL_DRV_ERROR_GENERAL;
}
- /* Open the terminal and set the terminal */
- ttysl_out = fdopen(ttysl_fd, "w");
+ SET_NONBLOCKING(ttysl_fd);
#ifdef PRIMITIVE_UTF8_CHECK
setlocale(LC_CTYPE, ""); /* Set international environment,
@@ -400,12 +421,14 @@ static void ttysl_stop(ErlDrvData ttysl_data)
stop_lbuf();
stop_termcap();
tty_reset(ttysl_fd);
- driver_select(ttysl_port, (ErlDrvEvent)(UWord)ttysl_fd, ERL_DRV_READ|ERL_DRV_USE, 0);
+ driver_select(ttysl_port, (ErlDrvEvent)(UWord)ttysl_fd,
+ ERL_DRV_WRITE|ERL_DRV_READ|ERL_DRV_USE, 0);
sys_sigset(SIGCONT, SIG_DFL);
sys_sigset(SIGWINCH, SIG_DFL);
}
ttysl_port = (ErlDrvPort)-1;
ttysl_fd = -1;
+ ttysl_terminate = 0;
/* return TRUE; */
}
@@ -650,10 +673,26 @@ static int check_buf_size(byte *s, int n)
static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT count)
{
+ ErlDrvSizeT sz;
+
+ sz = driver_sizeq(ttysl_port);
+
+ putclen = count > TTY_BUFFSIZE ? TTY_BUFFSIZE : count;
+ putcbuf = driver_alloc_binary(putclen);
+ putcpos = 0;
+
if (lpos > MAXSIZE)
put_chars((byte*)"\n", 1);
switch (buf[0]) {
+ case OP_PUTC_SYNC:
+ /* Using sync means that we have to send an ok to the
+ controlling process for each command call. We delay
+ sending ok if the driver queue exceeds a certain size.
+ We do not set ourselves as a busy port, as this
+ could be very bad for user_drv, if it gets blocked on
+ the port_command. */
+ /* fall through */
case OP_PUTC:
DEBUGLOG(("OP: Putc(%lu)",(unsigned long) count-1));
if (check_buf_size((byte*)buf+1, count-1) == 0)
@@ -678,10 +717,104 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun
/* Unknown op, just ignore. */
break;
}
- fflush(ttysl_out);
+
+ driver_enq_bin(ttysl_port,putcbuf,0,putcpos);
+
+ if (sz == 0) {
+ for (;;) {
+ int written, qlen;
+ SysIOVec *iov;
+
+ iov = driver_peekq(ttysl_port,&qlen);
+ if (iov)
+ written = writev(ttysl_fd, iov, qlen > MAXIOV ? MAXIOV : qlen);
+ else
+ written = 0;
+ if (written < 0) {
+ if (errno == EAGAIN) {
+ driver_select(ttysl_port,(ErlDrvEvent)(long)ttysl_fd,
+ ERL_DRV_USE|ERL_DRV_WRITE,1);
+ break;
+ } else {
+ /* we ignore all other errors */
+ break;
+ }
+ } else {
+ if (driver_deq(ttysl_port, written) == 0)
+ break;
+ }
+ }
+ }
+
+ if (buf[0] == OP_PUTC_SYNC) {
+ if (driver_sizeq(ttysl_port) > TTY_BUFFSIZE && !ttysl_terminate) {
+ /* We delay sending the ack until the buffer has been consumed */
+ ttysl_send_ok = 1;
+ } else {
+ ErlDrvTermData spec[] = {
+ ERL_DRV_PORT, driver_mk_port(ttysl_port),
+ ERL_DRV_ATOM, driver_mk_atom("ok"),
+ ERL_DRV_TUPLE, 2
+ };
+ ASSERT(ttysl_send_ok == 0);
+ erl_drv_output_term(driver_mk_port(ttysl_port), spec,
+ sizeof(spec) / sizeof(spec[0]));
+ }
+ }
+
return; /* TRUE; */
}
+static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) {
+ for (;;) {
+ int written, qlen;
+ SysIOVec *iov;
+ ErlDrvSizeT sz;
+
+ iov = driver_peekq(ttysl_port,&qlen);
+ if (iov)
+ written = writev(ttysl_fd, iov, qlen > MAXIOV ? MAXIOV : qlen);
+ else
+ written = 0;
+ if (written < 0) {
+ if (errno == EAGAIN) {
+ break;
+ } else {
+ /* we ignore all other errors */
+ }
+ } else {
+ sz = driver_deq(ttysl_port, written);
+ if (sz < TTY_BUFFSIZE && ttysl_send_ok) {
+ ErlDrvTermData spec[] = {
+ ERL_DRV_PORT, driver_mk_port(ttysl_port),
+ ERL_DRV_ATOM, driver_mk_atom("ok"),
+ ERL_DRV_TUPLE, 2
+ };
+ ttysl_send_ok = 0;
+ erl_drv_output_term(driver_mk_port(ttysl_port), spec,
+ sizeof(spec) / sizeof(spec[0]));
+ }
+ if (sz == 0) {
+ driver_select(ttysl_port,(ErlDrvEvent)(long)ttysl_fd,
+ ERL_DRV_WRITE,0);
+ if (ttysl_terminate)
+ /* flush has been called, which means we should terminate
+ when queue is empty. This will not send any exit
+ message */
+ driver_failure_atom(ttysl_port, "normal");
+ break;
+ }
+ }
+ }
+
+ return;
+}
+
+static void ttysl_flush_tty(ErlDrvData ttysl_data) {
+ ttysl_terminate = 1;
+ return;
+}
+
static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd)
{
byte b[1024];
@@ -1070,7 +1203,14 @@ static int write_buf(Uint32 *s, int n)
/* The basic procedure for outputting one character. */
static int outc(int c)
{
- return (int)putc(c, ttysl_out);
+ putcbuf->orig_bytes[putcpos++] = c;
+ if (putcpos == putclen) {
+ driver_enq_bin(ttysl_port,putcbuf,0,putclen);
+ putcpos = 0;
+ putclen = TTY_BUFFSIZE;
+ putcbuf = driver_alloc_binary(BUFSIZ);
+ }
+ return 1;
}
static int move_cursor(int from, int to)
diff --git a/erts/emulator/drivers/win32/ttsl_drv.c b/erts/emulator/drivers/win32/ttsl_drv.c
index 502cb58dfa..851c336a11 100644
--- a/erts/emulator/drivers/win32/ttsl_drv.c
+++ b/erts/emulator/drivers/win32/ttsl_drv.c
@@ -46,6 +46,7 @@ static int rows; /* Number of rows available. */
#define OP_INSC 2
#define OP_DELC 3
#define OP_BEEP 4
+#define OP_PUTC_SYNC 5
/* Control op */
#define CTRL_OP_GET_WINSIZE 100
@@ -458,6 +459,7 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun
switch (buf[0]) {
case OP_PUTC:
+ case OP_PUTC_SYNC:
DEBUGLOG(("OP: Putc(%I64u)",(unsigned long long)count-1));
if (check_buf_size((byte*)buf+1, count-1) == 0)
return;
@@ -481,6 +483,20 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun
/* Unknown op, just ignore. */
break;
}
+
+ if (buf[0] == OP_PUTC_SYNC) {
+ /* On windows we do a blocking write to the tty so we just
+ send the ack immidiately. If at some point in the future
+ someone has a problem with tty output being blocking
+ this has to be changed. */
+ ErlDrvTermData spec[] = {
+ ERL_DRV_PORT, driver_mk_port(ttysl_port),
+ ERL_DRV_ATOM, driver_mk_atom("ok"),
+ ERL_DRV_TUPLE, 2
+ };
+ erl_drv_output_term(driver_mk_port(ttysl_port), spec,
+ sizeof(spec) / sizeof(spec[0]));
+ }
return;
}
diff --git a/erts/emulator/hipe/hipe_amd64.c b/erts/emulator/hipe/hipe_amd64.c
index b5dff06987..16c597e7b4 100644
--- a/erts/emulator/hipe/hipe_amd64.c
+++ b/erts/emulator/hipe/hipe_amd64.c
@@ -224,18 +224,19 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *
return alloc_code(nrbytes);
}
-/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2()
- and hipe_bif0.c:hipe_make_stub() */
-void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
+
+/* Make stub for native code calling exported beam function.
+*/
+void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
{
/*
* This creates a native code stub with the following contents:
*
- * movq $Address, P_BEAM_IP(%ebp) %% Actually two movl
+ * movq $Address, P_CALLEE_EXP(%ebp) %% Actually two movl
* movb $Arity, P_ARITY(%ebp)
* jmp callemu
*
- * The stub has variable size, depending on whether the P_BEAM_IP
+ * The stub has variable size, depending on whether the P_CALLEE_EXP
* and P_ARITY offsets fit in 8-bit signed displacements or not.
* The rel32 offset in the final jmp depends on its actual location,
* which also depends on the size of the previous instructions.
@@ -248,49 +249,49 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
codeSize = /* 23, 26, 29, or 32 bytes */
23 + /* 23 when all offsets are 8-bit */
- (P_BEAM_IP >= 128 ? 3 : 0) +
- ((P_BEAM_IP + 4) >= 128 ? 3 : 0) +
+ (P_CALLEE_EXP >= 128 ? 3 : 0) +
+ ((P_CALLEE_EXP + 4) >= 128 ? 3 : 0) +
(P_ARITY >= 128 ? 3 : 0);
codep = code = alloc_code(codeSize);
- /* movl $beamAddress, P_BEAM_IP(%ebp); 3 or 6 bytes, plus 4 */
+ /* movl $callee_exp, P_CALLEE_EXP(%ebp); 3 or 6 bytes, plus 4 */
codep[0] = 0xc7;
-#if P_BEAM_IP >= 128
+#if P_CALLEE_EXP >= 128
codep[1] = 0x85; /* disp32[EBP] */
- codep[2] = P_BEAM_IP & 0xFF;
- codep[3] = (P_BEAM_IP >> 8) & 0xFF;
- codep[4] = (P_BEAM_IP >> 16) & 0xFF;
- codep[5] = (P_BEAM_IP >> 24) & 0xFF;
+ codep[2] = P_CALLEE_EXP & 0xFF;
+ codep[3] = (P_CALLEE_EXP >> 8) & 0xFF;
+ codep[4] = (P_CALLEE_EXP >> 16) & 0xFF;
+ codep[5] = (P_CALLEE_EXP >> 24) & 0xFF;
codep += 6;
#else
codep[1] = 0x45; /* disp8[EBP] */
- codep[2] = P_BEAM_IP;
+ codep[2] = P_CALLEE_EXP;
codep += 3;
#endif
- codep[0] = ((unsigned long)beamAddress ) & 0xFF;
- codep[1] = ((unsigned long)beamAddress >> 8) & 0xFF;
- codep[2] = ((unsigned long)beamAddress >> 16) & 0xFF;
- codep[3] = ((unsigned long)beamAddress >> 24) & 0xFF;
+ codep[0] = ((unsigned long)callee_exp ) & 0xFF;
+ codep[1] = ((unsigned long)callee_exp >> 8) & 0xFF;
+ codep[2] = ((unsigned long)callee_exp >> 16) & 0xFF;
+ codep[3] = ((unsigned long)callee_exp >> 24) & 0xFF;
codep += 4;
- /* movl (shl 32 $beamAddress), P_BEAM_IP+4(%ebp); 3 or 6 bytes, plus 4 */
+ /* movl (shl 32 $callee_exp), P_CALLEE_EXP+4(%ebp); 3 or 6 bytes, plus 4 */
codep[0] = 0xc7;
-#if P_BEAM_IP+4 >= 128
+#if P_CALLEE_EXP+4 >= 128
codep[1] = 0x85; /* disp32[EBP] */
- codep[2] = (P_BEAM_IP+4) & 0xFF;
- codep[3] = ((P_BEAM_IP+4) >> 8) & 0xFF;
- codep[4] = ((P_BEAM_IP+4) >> 16) & 0xFF;
- codep[5] = ((P_BEAM_IP+4) >> 24) & 0xFF;
+ codep[2] = (P_CALLEE_EXP+4) & 0xFF;
+ codep[3] = ((P_CALLEE_EXP+4) >> 8) & 0xFF;
+ codep[4] = ((P_CALLEE_EXP+4) >> 16) & 0xFF;
+ codep[5] = ((P_CALLEE_EXP+4) >> 24) & 0xFF;
codep += 6;
#else
codep[1] = 0x45; /* disp8[EBP] */
- codep[2] = (P_BEAM_IP+4);
+ codep[2] = (P_CALLEE_EXP+4);
codep += 3;
#endif
- codep[0] = ((unsigned long)beamAddress >> 32) & 0xFF;
- codep[1] = ((unsigned long)beamAddress >> 40) & 0xFF;
- codep[2] = ((unsigned long)beamAddress >> 48) & 0xFF;
- codep[3] = ((unsigned long)beamAddress >> 56) & 0xFF;
+ codep[0] = ((unsigned long)callee_exp >> 32) & 0xFF;
+ codep[1] = ((unsigned long)callee_exp >> 40) & 0xFF;
+ codep[2] = ((unsigned long)callee_exp >> 48) & 0xFF;
+ codep[3] = ((unsigned long)callee_exp >> 56) & 0xFF;
codep += 4;
/* movb $beamArity, P_ARITY(%ebp); 3 or 6 bytes */
diff --git a/erts/emulator/hipe/hipe_amd64_asm.m4 b/erts/emulator/hipe/hipe_amd64_asm.m4
index 7c81040b8b..b4b3c073ab 100644
--- a/erts/emulator/hipe/hipe_amd64_asm.m4
+++ b/erts/emulator/hipe/hipe_amd64_asm.m4
@@ -33,7 +33,35 @@ define(HEAP_LIMIT_IN_REGISTER,0)dnl global for HL
define(SIMULATE_NSP,0)dnl change to 1 to simulate call/ret insns
`#define AMD64_LEAF_WORDS 'LEAF_WORDS
-`#define LEAF_WORDS 'LEAF_WORDS
+`#define LEAF_WORDS 'LEAF_WORDS
+`#define AMD64_NR_ARG_REGS 'NR_ARG_REGS
+`#define NR_ARG_REGS 'NR_ARG_REGS
+
+`#define AMD64_HP_IN_REGISTER 'HP_IN_REGISTER
+`#if AMD64_HP_IN_REGISTER'
+`#define AMD64_HEAP_POINTER 15'
+define(HP,%r15)dnl Only change this together with above
+`#endif'
+
+`#define AMD64_FCALLS_IN_REGISTER 'FCALLS_IN_REGISTER
+`#if AMD64_FCALLS_IN_REGISTER'
+`#define AMD64_FCALLS_REGISTER 11'
+define(FCALLS,%r11)dnl This goes together with line above
+`#endif'
+
+`#define AMD64_HEAP_LIMIT_IN_REGISTER 'HEAP_LIMIT_IN_REGISTER
+`#if AMD64_HEAP_LIMIT_IN_REGISTER'
+`#define AMD64_HEAP_LIMIT_REGISTER 12'
+define(HEAP_LIMIT,%r12)dnl Change this together with line above
+`#endif'
+
+`#define AMD64_SIMULATE_NSP 'SIMULATE_NSP
+
+
+`#ifdef ASM'
+/*
+ * Only assembler stuff from here on (when included from *.S)
+ */
/*
* Workarounds for Darwin.
@@ -63,33 +91,24 @@ ifelse(OPSYS,darwin,``
*/
`#define P %rbp'
-`#define AMD64_HP_IN_REGISTER 'HP_IN_REGISTER
`#if AMD64_HP_IN_REGISTER
-#define AMD64_HEAP_POINTER 15'
-define(HP,%r15)dnl Only change this together with above
-`#define SAVE_HP movq 'HP`, P_HP(P)
+#define SAVE_HP movq 'HP`, P_HP(P)
#define RESTORE_HP movq P_HP(P), 'HP`
#else
#define SAVE_HP /*empty*/
#define RESTORE_HP /*empty*/
#endif'
-`#define AMD64_FCALLS_IN_REGISTER 'FCALLS_IN_REGISTER
`#if AMD64_FCALLS_IN_REGISTER
-#define AMD64_FCALLS_REGISTER 11'
-define(FCALLS,%r11)dnl This goes together with line above
-`#define SAVE_FCALLS movq 'FCALLS`, P_FCALLS(P)
+#define SAVE_FCALLS movq 'FCALLS`, P_FCALLS(P)
#define RESTORE_FCALLS movq P_FCALLS(P), 'FCALLS`
#else
#define SAVE_FCALLS /*empty*/
#define RESTORE_FCALLS /*empty*/
#endif'
-`#define AMD64_HEAP_LIMIT_IN_REGISTER 'HEAP_LIMIT_IN_REGISTER
`#if AMD64_HEAP_LIMIT_IN_REGISTER
-#define AMD64_HEAP_LIMIT_REGISTER 12'
-define(HEAP_LIMIT,%r12)dnl Change this together with line above
-`#define RESTORE_HEAP_LIMIT movq P_HP_LIMIT(P), 'HEAP_LIMIT`
+#define RESTORE_HEAP_LIMIT movq P_HP_LIMIT(P), 'HEAP_LIMIT`
#else
#define RESTORE_HEAP_LIMIT /*empty*/
#endif'
@@ -99,7 +118,6 @@ define(NSP,%rsp)dnl
`#define SAVE_CSP movq %rsp, P_CSP(P)
#define RESTORE_CSP movq P_CSP(P), %rsp'
-`#define AMD64_SIMULATE_NSP 'SIMULATE_NSP
/*
* Context switching macros.
@@ -132,8 +150,6 @@ define(NSP,%rsp)dnl
/*
* Argument (parameter) registers.
*/
-`#define AMD64_NR_ARG_REGS 'NR_ARG_REGS
-`#define NR_ARG_REGS 'NR_ARG_REGS
define(defarg,`define(ARG$1,`$2')dnl
#`define ARG'$1 $2'
@@ -263,4 +279,6 @@ define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl
`/* #define NBIF_RET_3 'NBIF_RET(3)` */'
`/* #define NBIF_RET_5 'NBIF_RET(5)` */'
+`#endif /* ASM */'
+
`#endif /* HIPE_AMD64_ASM_H */'
diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4
index a3219c7586..7a4bb30447 100644
--- a/erts/emulator/hipe/hipe_amd64_bifs.m4
+++ b/erts/emulator/hipe/hipe_amd64_bifs.m4
@@ -18,7 +18,7 @@ changecom(`/*', `*/')dnl
* %CopyrightEnd%
*/
-
+#`define ASM'
include(`hipe/hipe_amd64_asm.m4')
#`include' "config.h"
#`include' "hipe_literals.h"
diff --git a/erts/emulator/hipe/hipe_amd64_glue.S b/erts/emulator/hipe/hipe_amd64_glue.S
index 8816906870..955f7362b4 100644
--- a/erts/emulator/hipe/hipe_amd64_glue.S
+++ b/erts/emulator/hipe/hipe_amd64_glue.S
@@ -17,10 +17,9 @@
* %CopyrightEnd%
*/
-
+#define ASM
#include "hipe_amd64_asm.h"
#include "hipe_literals.h"
-#define ASM
#include "hipe_mode_switch.h"
/*
@@ -109,7 +108,7 @@ ASYM(nbif_return):
* stub (hipe_x86_loader.erl) which should look as follows:
*
* stub for f/N:
- * movq $<f's BEAM code address>, P_BEAM_IP(P)
+ * movq $<f's export entry address>, P_CALLEE_EXP(P)
* movb $<N>, P_ARITY(P)
* jmp nbif_callemu
*
@@ -119,7 +118,7 @@ ASYM(nbif_return):
GLOBAL(ASYM(nbif_callemu))
ASYM(nbif_callemu):
STORE_ARG_REGS
- movl $HIPE_MODE_SWITCH_RES_CALL, %eax
+ movl $HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %eax
jmp .suspend_exit
/*
diff --git a/erts/emulator/hipe/hipe_arm.c b/erts/emulator/hipe/hipe_arm.c
index 3db3ffe9b1..165eb543c8 100644
--- a/erts/emulator/hipe/hipe_arm.c
+++ b/erts/emulator/hipe/hipe_arm.c
@@ -260,9 +260,9 @@ int hipe_patch_insn(void *address, Uint32 value, Eterm type)
return 0;
}
-/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2()
- and hipe_bif0.c:hipe_make_stub() */
-void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
+/* Make stub for native code calling exported beam function
+*/
+void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
{
unsigned int *code;
unsigned int *tramp_callemu;
@@ -272,9 +272,9 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
* Native code calls BEAM via a stub looking as follows:
*
* mov r0, #beamArity
- * ldr r8, [pc,#0] // beamAddress
+ * ldr r8, [pc,#0] // callee_exp
* b nbif_callemu
- * .long beamAddress
+ * .long callee_exp
*
* I'm using r0 and r8 since they aren't used for
* parameter passing in native code. The branch to
@@ -292,12 +292,12 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
/* mov r0, #beamArity */
code[0] = 0xE3A00000 | (beamArity & 0xFF);
- /* ldr r8, [pc,#0] // beamAddress */
+ /* ldr r8, [pc,#0] // callee_exp */
code[1] = 0xE59F8000;
/* b nbif_callemu */
code[2] = 0xEA000000 | (callemu_offset & 0x00FFFFFF);
- /* .long beamAddress */
- code[3] = (unsigned int)beamAddress;
+ /* .long callee_exp */
+ code[3] = (unsigned int)callee_exp;
hipe_flush_icache_range(code, 4*sizeof(int));
diff --git a/erts/emulator/hipe/hipe_arm_asm.m4 b/erts/emulator/hipe/hipe_arm_asm.m4
index 85dc84973d..b2e3f83d1e 100644
--- a/erts/emulator/hipe/hipe_arm_asm.m4
+++ b/erts/emulator/hipe/hipe_arm_asm.m4
@@ -29,6 +29,14 @@ define(LEAF_WORDS,16)dnl number of stack words for leaf functions
define(NR_ARG_REGS,3)dnl admissible values are 0 to 6, inclusive
`#define ARM_LEAF_WORDS 'LEAF_WORDS
+`#define ARM_NR_ARG_REGS 'NR_ARG_REGS
+`#define NR_ARG_REGS 'NR_ARG_REGS
+
+
+`#ifdef ASM'
+/*
+ * Only assembler stuff from here on (when included from *.S)
+ */
/*
* Reserved registers.
@@ -77,8 +85,6 @@ define(NR_ARG_REGS,3)dnl admissible values are 0 to 6, inclusive
/*
* Argument (parameter) registers.
*/
-`#define ARM_NR_ARG_REGS 'NR_ARG_REGS
-`#define NR_ARG_REGS 'NR_ARG_REGS
define(defarg,`define(ARG$1,`$2')dnl
#`define ARG'$1 $2'
@@ -195,4 +201,6 @@ define(QUICK_CALL_RET,`NBIF_POP_N(eval(RET_POP($2)))b $1')dnl
`/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */'
`/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */'
+`#endif /* ASM */'
+
`#endif /* HIPE_ARM_ASM_H */'
diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4
index bd8bc5ab6b..57e51bb8b1 100644
--- a/erts/emulator/hipe/hipe_arm_bifs.m4
+++ b/erts/emulator/hipe/hipe_arm_bifs.m4
@@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl
*/
+#`define ASM'
include(`hipe/hipe_arm_asm.m4')
#`include' "config.h"
#`include' "hipe_literals.h"
diff --git a/erts/emulator/hipe/hipe_arm_glue.S b/erts/emulator/hipe/hipe_arm_glue.S
index 2e2b8604a6..069cb4512e 100644
--- a/erts/emulator/hipe/hipe_arm_glue.S
+++ b/erts/emulator/hipe/hipe_arm_glue.S
@@ -17,10 +17,9 @@
* %CopyrightEnd%
*/
-
+#define ASM
#include "hipe_arm_asm.h"
#include "hipe_literals.h"
-#define ASM
#include "hipe_mode_switch.h"
.text
@@ -135,7 +134,7 @@ hipe_arm_throw_to_native:
* which should look as follows:
*
* stub for f/N:
- * <set r8 to f's BEAM code address>
+ * <set r8 to f's export entry address>
* <set r0 to N>
* b nbif_callemu
*
@@ -143,10 +142,10 @@ hipe_arm_throw_to_native:
*/
.global nbif_callemu
nbif_callemu:
- str r8, [P, #P_BEAM_IP]
+ str r8, [P, #P_CALLEE_EXP]
str r0, [P, #P_ARITY]
STORE_ARG_REGS
- mov r0, #HIPE_MODE_SWITCH_RES_CALL
+ mov r0, #HIPE_MODE_SWITCH_RES_CALL_EXPORTED
b .suspend_exit
/*
diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c
index c9eee2acf2..9eb0b88ced 100644
--- a/erts/emulator/hipe/hipe_bif0.c
+++ b/erts/emulator/hipe/hipe_bif0.c
@@ -89,25 +89,6 @@ static Eterm address_to_term(const void *address, Process *p)
/*
* BIFs for reading and writing memory. Used internally by HiPE.
*/
-#if 0 /* XXX: unused */
-BIF_RETTYPE hipe_bifs_read_u8_1(BIF_ALIST_1)
-{
- unsigned char *address = term_to_address(BIF_ARG_1);
- if (!address)
- BIF_ERROR(BIF_P, BADARG);
- BIF_RET(make_small(*address));
-}
-#endif
-
-#if 0 /* XXX: unused */
-BIF_RETTYPE hipe_bifs_read_u32_1(BIF_ALIST_1)
-{
- Uint32 *address = term_to_address(BIF_ARG_1);
- if (!address || !hipe_word32_address_ok(address))
- BIF_ERROR(BIF_P, BADARG);
- BIF_RET(Uint_to_term(*address, BIF_P));
-}
-#endif
BIF_RETTYPE hipe_bifs_write_u8_2(BIF_ALIST_2)
{
@@ -120,22 +101,6 @@ BIF_RETTYPE hipe_bifs_write_u8_2(BIF_ALIST_2)
BIF_RET(NIL);
}
-#if 0 /* XXX: unused */
-BIF_RETTYPE hipe_bifs_write_s32_2(BIF_ALIST_2)
-{
- Sint32 *address;
- Sint value;
-
- address = term_to_address(BIF_ARG_1);
- if (!address || !hipe_word32_address_ok(address))
- BIF_ERROR(BIF_P, BADARG);
- if (!term_to_Sint32(BIF_ARG_2, &value))
- BIF_ERROR(BIF_P, BADARG);
- *address = value;
- BIF_RET(NIL);
-}
-#endif
-
BIF_RETTYPE hipe_bifs_write_u32_2(BIF_ALIST_2)
{
Uint32 *address;
@@ -639,33 +604,6 @@ BIF_RETTYPE hipe_bifs_fun_to_address_1(BIF_ALIST_1)
BIF_RET(address_to_term(pc, BIF_P));
}
-static void *hipe_get_emu_address(Eterm m, Eterm f, unsigned int arity, int is_remote)
-{
- void *address = NULL;
- if (!is_remote)
- address = hipe_find_emu_address(m, f, arity);
- if (!address) {
- /* if not found, stub it via the export entry */
- /* no lock needed around erts_export_get_or_make_stub() */
- Export *export_entry = erts_export_get_or_make_stub(m, f, arity);
- address = export_entry->addressv[erts_active_code_ix()];
- }
- return address;
-}
-
-#if 0 /* XXX: unused */
-BIF_RETTYPE hipe_bifs_get_emu_address_1(BIF_ALIST_1)
-{
- struct mfa mfa;
- void *address;
-
- if (!term_to_mfa(BIF_ARG_1, &mfa))
- BIF_ERROR(BIF_P, BADARG);
- address = hipe_get_emu_address(mfa.mod, mfa.fun, mfa.ari);
- BIF_RET(address_to_term(address, BIF_P));
-}
-#endif
-
BIF_RETTYPE hipe_bifs_set_native_address_3(BIF_ALIST_3)
{
Eterm *pc;
@@ -713,33 +651,6 @@ BIF_RETTYPE hipe_bifs_set_native_address_3(BIF_ALIST_3)
BIF_RET(am_false);
}
-#if 0 /* XXX: unused */
-/*
- * hipe_bifs_address_to_fun(Address)
- * - Address is the address of the start of a emu function's code
- * - returns {Module, Function, Arity}
- */
-BIF_RETTYPE hipe_bifs_address_to_fun_1(BIF_ALIST_1)
-{
- Eterm *pc;
- Eterm *funcinfo;
- Eterm *hp;
-
- pc = term_to_address(BIF_ARG_1);
- if (!pc)
- BIF_ERROR(BIF_P, BADARG);
- funcinfo = find_function_from_pc(pc);
- if (!funcinfo)
- BIF_RET(am_false);
- hp = HAlloc(BIF_P, 4);
- hp[0] = make_arityval(3);
- hp[1] = funcinfo[0];
- hp[2] = funcinfo[1];
- hp[3] = make_small(funcinfo[2]);
- BIF_RET(make_tuple(hp));
-}
-#endif
-
BIF_RETTYPE hipe_bifs_enter_sdesc_1(BIF_ALIST_1)
{
struct sdesc *sdesc;
@@ -948,37 +859,6 @@ BIF_RETTYPE hipe_bifs_primop_address_1(BIF_ALIST_1)
BIF_RET(address_to_term(primop->address, BIF_P));
}
-#if 0 /* XXX: unused */
-/*
- * hipe_bifs_gbif_address(F,A) -> address or false
- */
-#define GBIF_LIST(ATOM,ARY,CFUN) extern Eterm gbif_##CFUN(void);
-#include "hipe_gbif_list.h"
-#undef GBIF_LIST
-
-BIF_RETTYPE hipe_bifs_gbif_address_2(BIF_ALIST_2)
-{
- Uint arity;
- void *address;
-
- if (is_not_atom(BIF_ARG_1) || is_not_small(BIF_ARG_2))
- BIF_RET(am_false); /* error or false, does it matter? */
- arity = signed_val(BIF_ARG_2);
- /* XXX: replace with a hash table later */
- do { /* trick to let us use 'break' instead of 'goto' */
-#define GBIF_LIST(ATOM,ARY,CFUN) if (BIF_ARG_1 == ATOM && arity == ARY) { address = CFUN; break; }
-#include "hipe_gbif_list.h"
-#undef GBIF_LIST
- printf("\r\n%s: guard BIF ", __FUNCTION__);
- fflush(stdout);
- erts_printf("%T", BIF_ARG_1);
- printf("/%lu isn't listed in hipe_gbif_list.h\r\n", arity);
- BIF_RET(am_false);
- } while (0);
- BIF_RET(address_to_term(address, BIF_P));
-}
-#endif
-
BIF_RETTYPE hipe_bifs_atom_to_word_1(BIF_ALIST_1)
{
if (is_not_atom(BIF_ARG_1))
@@ -1028,77 +908,6 @@ void hipe_emulate_fpe(Process* p)
}
#endif
-#if 0 /* XXX: unused */
-/*
- * At least parts of this should be inlined in native code.
- * The rest could be made a primop used by both the emulator and
- * native code...
- */
-BIF_RETTYPE hipe_bifs_make_fun_3(BIF_ALIST_3)
-{
- Eterm free_vars;
- Eterm mod;
- Eterm *tp;
- Uint index;
- Uint uniq;
- Uint num_free;
- Eterm tmp_var;
- Uint *tmp_ptr;
- unsigned needed;
- ErlFunThing *funp;
- Eterm *hp;
- int i;
-
- if (is_not_list(BIF_ARG_1) && is_not_nil(BIF_ARG_1))
- BIF_ERROR(BIF_P, BADARG);
- free_vars = BIF_ARG_1;
-
- if (is_not_atom(BIF_ARG_2))
- BIF_ERROR(BIF_P, BADARG);
- mod = BIF_ARG_2;
-
- if (is_not_tuple(BIF_ARG_3) ||
- (arityval(*tuple_val(BIF_ARG_3)) != 3))
- BIF_ERROR(BIF_P, BADARG);
- tp = tuple_val(BIF_ARG_3);
-
- if (term_to_Uint(tp[1], &index) == 0)
- BIF_ERROR(BIF_P, BADARG);
- if (term_to_Uint(tp[2], &uniq) == 0)
- BIF_ERROR(BIF_P, BADARG);
- if (term_to_Uint(tp[3], &num_free) == 0)
- BIF_ERROR(BIF_P, BADARG);
-
- needed = ERL_FUN_SIZE + num_free;
- funp = (ErlFunThing *) HAlloc(BIF_P, needed);
- hp = funp->env;
-
- funp->thing_word = HEADER_FUN;
-
- /* Need a ErlFunEntry *fe
- * fe->refc++;
- * funp->fe = fe;
- */
-
- funp->num_free = num_free;
- funp->creator = BIF_P->id;
- for (i = 0; i < num_free; i++) {
- if (is_nil(free_vars))
- BIF_ERROR(BIF_P, BADARG);
- tmp_ptr = list_val(free_vars);
- tmp_var = CAR(tmp_ptr);
- free_vars = CDR(tmp_ptr);
- *hp++ = tmp_var;
- }
- if (is_not_nil(free_vars))
- BIF_ERROR(BIF_P, BADARG);
-
- funp->next = MSO(BIF_P).funs;
- MSO(BIF_P).funs = funp;
-
- BIF_RET(make_fun(funp));
-}
-#endif
/*
* args: Module, {Uniq, Index, BeamAddress}
@@ -1163,22 +972,6 @@ BIF_RETTYPE hipe_bifs_set_native_address_in_fe_2(BIF_ALIST_2)
BIF_RET(am_true);
}
-#if 0 /* XXX: unused */
-BIF_RETTYPE hipe_bifs_make_native_stub_2(BIF_ALIST_2)
-{
- void *beamAddress;
- Uint beamArity;
- void *stubAddress;
-
- if ((beamAddress = term_to_address(BIF_ARG_1)) == 0 ||
- is_not_small(BIF_ARG_2) ||
- (beamArity = unsigned_val(BIF_ARG_2)) >= 256)
- BIF_ERROR(BIF_P, BADARG);
- stubAddress = hipe_make_native_stub(beamAddress, beamArity);
- BIF_RET(address_to_term(stubAddress, BIF_P));
-}
-#endif
-
/*
* MFA info hash table:
* - maps MFA to native code entry point
@@ -1323,16 +1116,6 @@ static inline struct hipe_mfa_info *hipe_mfa_info_table_get_locked(Eterm m, Eter
return NULL;
}
-#if 0 /* XXX: unused */
-void *hipe_mfa_find_na(Eterm m, Eterm f, unsigned int arity)
-{
- const struct hipe_mfa_info *p;
-
- p = hipe_mfa_info_table_get(m, f, arity);
- return p ? p->address : NULL;
-}
-#endif
-
static struct hipe_mfa_info *hipe_mfa_info_table_put_locked(Eterm m, Eterm f, unsigned int arity)
{
unsigned long h;
@@ -1490,18 +1273,13 @@ void hipe_mfa_save_orig_beam_op(Eterm mod, Eterm fun, unsigned int ari, Eterm *p
static void *hipe_make_stub(Eterm m, Eterm f, unsigned int arity, int is_remote)
{
- void *BEAMAddress;
+ Export *export_entry;
void *StubAddress;
-#if 0
- if (is_not_atom(m) || is_not_atom(f) || arity > 255)
- return NULL;
-#endif
- BEAMAddress = hipe_get_emu_address(m, f, arity, is_remote);
- StubAddress = hipe_make_native_stub(BEAMAddress, arity);
-#if 0
- hipe_mfa_set_na(m, f, arity, StubAddress);
-#endif
+ ASSERT(is_remote);
+
+ export_entry = erts_export_get_or_make_stub(m, f, arity);
+ StubAddress = hipe_make_native_stub(export_entry, arity);
return StubAddress;
}
diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c
index 32694a8f97..61406b92af 100644
--- a/erts/emulator/hipe/hipe_debug.c
+++ b/erts/emulator/hipe/hipe_debug.c
@@ -172,8 +172,10 @@ void hipe_print_pcb(Process *p)
printf("P: 0x%0*lx\r\n", 2*(int)sizeof(long), (unsigned long)p);
printf("-----------------------------------------------\r\n");
printf("Offset| Name | Value | *Value |\r\n");
+#undef U
#define U(n,x) \
printf(" % 4d | %s | 0x%0*lx | |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x)
+#undef P
#define P(n,x) \
printf(" % 4d | %s | 0x%0*lx | 0x%0*lx |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x, 2*(int)sizeof(long), p->x ? (unsigned long)*(p->x) : -1UL)
@@ -231,7 +233,7 @@ void hipe_print_pcb(Process *p)
U("nsp ", hipe.nsp);
U("nstack ", hipe.nstack);
U("nstend ", hipe.nstend);
- U("ncallee ", hipe.ncallee);
+ U("ncallee ", hipe.u.ncallee);
hipe_arch_print_pcb(&p->hipe);
#endif /* HIPE */
#undef U
diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c
index 86c4068072..b10263f6e2 100644
--- a/erts/emulator/hipe/hipe_gc.c
+++ b/erts/emulator/hipe/hipe_gc.c
@@ -22,6 +22,9 @@
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
+
+#define ERL_WANT_GC_INTERNALS__
+
#include "global.h"
#include "erl_gc.h"
diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c
index 0e287908b1..ed355ce264 100644
--- a/erts/emulator/hipe/hipe_mkliterals.c
+++ b/erts/emulator/hipe/hipe_mkliterals.c
@@ -498,8 +498,8 @@ static const struct rts_param rts_params[] = {
{ 38, "P_ARG4", 1, offsetof(struct process, def_arg_reg[4]) },
{ 39, "P_ARG5", 1, offsetof(struct process, def_arg_reg[5]) },
{ 40, "P_NSP", 1, offsetof(struct process, hipe.nsp) },
- { 41, "P_NCALLEE", 1, offsetof(struct process, hipe.ncallee) },
- { 42, "P_CLOSURE", 1, offsetof(struct process, hipe.closure) },
+ { 41, "P_NCALLEE", 1, offsetof(struct process, hipe.u.ncallee) },
+ { 42, "P_CLOSURE", 1, offsetof(struct process, hipe.u.closure) },
{ 43, "P_NSP_LIMIT", 1, offsetof(struct process, hipe.nstack) },
{ 44, "P_CSP",
#if defined(__i386__) || defined(__x86_64__)
@@ -524,6 +524,7 @@ static const struct rts_param rts_params[] = {
},
{ 49, "P_MSG_FIRST", 1, offsetof(struct process, msg.first) },
{ 50, "P_MSG_SAVE", 1, offsetof(struct process, msg.save) },
+ { 51, "P_CALLEE_EXP", 1, offsetof(struct process, hipe.u.callee_exp) },
};
#define NR_PARAMS ARRAY_SIZE(rts_params)
diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c
index 1ae1d17b7f..8c73312d45 100644
--- a/erts/emulator/hipe/hipe_mode_switch.c
+++ b/erts/emulator/hipe/hipe_mode_switch.c
@@ -140,7 +140,6 @@ void hipe_check_pcb(Process *p, const char *file, unsigned line)
#endif /* HIPE_DEBUG > 0 */
/* ensure that at least nwords words are available on the native stack */
-static void hipe_check_nstack(Process *p, unsigned nwords);
#if defined(__sparc__)
#include "hipe_sparc_glue.h"
@@ -159,7 +158,7 @@ static void hipe_check_nstack(Process *p, unsigned nwords);
Uint hipe_beam_pc_return[1]; /* needed in hipe_debug.c */
Uint hipe_beam_pc_throw[1]; /* needed in hipe_debug.c */
Uint hipe_beam_pc_resume[1]; /* needed by hipe_set_timeout() */
-static Eterm hipe_beam_catch_throw;
+Eterm hipe_beam_catch_throw;
void hipe_mode_switch_init(void)
{
@@ -185,22 +184,6 @@ void hipe_set_call_trap(Uint *bfun, void *nfun, int is_closure)
bfun[-4] = (Uint)nfun;
}
-void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsigned arity)
-{
- if (!hipe_bifcall_from_native_is_recursive(p))
- return;
-
- /* ensure that at least 2 words are available on the BEAM stack */
- if ((p->stop - 2) < p->htop) {
- DPRINTF("calling gc to reserve BEAM stack size");
- p->fcalls -= erts_garbage_collect(p, 2, reg, arity);
- ASSERT(!((p->stop - 2) < p->htop));
- }
- p->stop -= 2;
- p->stop[0] = NIL;
- p->stop[1] = hipe_beam_catch_throw;
-}
-
static __inline__ void
hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity)
{
@@ -223,15 +206,6 @@ hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity)
p->cp = hipe_beam_pc_return;
}
-void hipe_unreserve_beam_trap_frame(Process *p)
-{
- if (!hipe_bifcall_from_native_is_recursive(p))
- return;
-
- ASSERT(p->stop[0] == NIL && p->stop[1] == hipe_beam_catch_throw);
- p->stop += 2;
-}
-
static __inline__ void hipe_pop_beam_trap_frame(Process *p)
{
ASSERT(p->stop[1] == hipe_beam_catch_throw);
@@ -265,14 +239,14 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
/* BEAM calls a native code function */
unsigned arity = cmd >> 8;
- /* p->hipe.ncallee set in beam_emu */
+ /* p->hipe.u.ncallee set in beam_emu */
if (p->cp == hipe_beam_pc_return) {
/* Native called BEAM, which now tailcalls native. */
hipe_pop_beam_trap_frame(p);
result = hipe_tailcall_to_native(p, arity, reg);
break;
}
- DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity);
+ DPRINTF("calling %#lx/%u", (long)p->hipe.u.ncallee, arity);
result = hipe_call_to_native(p, arity, reg);
break;
}
@@ -290,18 +264,18 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
arity -= funp->num_free; /* arity == #formals */
reg[arity] = fun;
++arity; /* correct for having added the closure */
- /* HIPE_ASSERT(p->hipe.ncallee == (void(*)(void))funp->native_address); */
+ /* HIPE_ASSERT(p->hipe.u.ncallee == (void(*)(void))funp->native_address); */
/* just like a normal call from now on */
- /* p->hipe.ncallee set in beam_emu */
+ /* p->hipe.u.ncallee set in beam_emu */
if (p->cp == hipe_beam_pc_return) {
/* Native called BEAM, which now tailcalls native. */
hipe_pop_beam_trap_frame(p);
result = hipe_tailcall_to_native(p, arity, reg);
break;
}
- DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity);
+ DPRINTF("calling %#lx/%u", (long)p->hipe.u.ncallee, arity);
result = hipe_call_to_native(p, arity, reg);
break;
}
@@ -404,13 +378,13 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
if (is_recursive)
hipe_push_beam_trap_frame(p, reg, p->arity);
- result = HIPE_MODE_SWITCH_RES_CALL;
+ result = HIPE_MODE_SWITCH_RES_CALL_BEAM;
break;
}
- case HIPE_MODE_SWITCH_RES_CALL: {
+ case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: {
/* Native code calls or tailcalls BEAM.
*
- * p->i is the callee's BEAM code
+ * p->hipe.u.callee_exp is the callee's export entry
* p->arity is the callee's arity
* p->def_arg_reg[] contains the register parameters
* p->hipe.nsp[] contains the stacked parameters
@@ -430,15 +404,15 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
* F(A1, ..., AN, FV1, ..., FVM, Closure)
* (Where Ai is argument i and FVj is free variable j)
*
- * p->hipe.closure contains the closure
+ * p->hipe.u.closure contains the closure
* p->def_arg_reg[] contains the register parameters
* p->hipe.nsp[] contains the stacked parameters
*/
ErlFunThing *closure;
unsigned num_free, arity, i, is_recursive;
- HIPE_ASSERT(is_fun(p->hipe.closure));
- closure = (ErlFunThing*)fun_val(p->hipe.closure);
+ HIPE_ASSERT(is_fun(p->hipe.u.closure));
+ closure = (ErlFunThing*)fun_val(p->hipe.u.closure);
num_free = closure->num_free;
arity = closure->fe->arity;
@@ -468,10 +442,10 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
p->i = closure->fe->address;
/* Change result code to the faster plain CALL type. */
- result = HIPE_MODE_SWITCH_RES_CALL;
+ result = HIPE_MODE_SWITCH_RES_CALL_BEAM;
}
/* Append the closure as the last parameter. Don't increment arity. */
- reg[arity] = p->hipe.closure;
+ reg[arity] = p->hipe.u.closure;
if (is_recursive) {
/* BEAM called native, which now calls BEAM.
@@ -549,7 +523,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
}
}
HIPE_CHECK_PCB(p);
- result = HIPE_MODE_SWITCH_RES_CALL;
+ result = HIPE_MODE_SWITCH_RES_CALL_BEAM;
p->def_arg_reg[3] = result;
return p;
}
@@ -577,7 +551,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[])
address = hipe_get_remote_na(mfa[0], mfa[1], arity);
if (!address)
goto do_apply_fail;
- p->hipe.ncallee = (void(*)(void)) address;
+ p->hipe.u.ncallee = (void(*)(void)) address;
result = hipe_tailcall_to_native(p, arity, reg);
goto do_return_from_native;
do_apply_fail:
@@ -607,7 +581,6 @@ static unsigned hipe_next_nstack_size(unsigned size)
}
#if 0 && defined(HIPE_NSTACK_GROWS_UP)
-#define hipe_nstack_avail(p) ((p)->hipe.nstend - (p)->hipe.nsp)
void hipe_inc_nstack(Process *p)
{
Eterm *old_nstack = p->hipe.nstack;
@@ -631,7 +604,6 @@ void hipe_inc_nstack(Process *p)
#endif
#if defined(HIPE_NSTACK_GROWS_DOWN)
-#define hipe_nstack_avail(p) ((unsigned)((p)->hipe.nsp - (p)->hipe.nstack))
void hipe_inc_nstack(Process *p)
{
unsigned old_size = p->hipe.nstend - p->hipe.nstack;
@@ -663,12 +635,6 @@ void hipe_empty_nstack(Process *p)
p->hipe.nstend = NULL;
}
-static void hipe_check_nstack(Process *p, unsigned nwords)
-{
- while (hipe_nstack_avail(p) < nwords)
- hipe_inc_nstack(p);
-}
-
void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free)
{
unsigned arity;
diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h
index 06721e3c04..b8de12fcbb 100644
--- a/erts/emulator/hipe/hipe_mode_switch.h
+++ b/erts/emulator/hipe/hipe_mode_switch.h
@@ -31,7 +31,7 @@
/* result codes for beam_emu <- hipe_mode_switch() return */
#define HIPE_MODE_SWITCH_RES_RETURN 4
-#define HIPE_MODE_SWITCH_RES_CALL 5
+#define HIPE_MODE_SWITCH_RES_CALL_EXPORTED 5
#define HIPE_MODE_SWITCH_RES_THROW 6
/* additional result codes for hipe_mode_switch() <- native return */
@@ -45,6 +45,8 @@
#define HIPE_MODE_SWITCH_RES_APPLY 13 /* mode_switch <- native */
+#define HIPE_MODE_SWITCH_RES_CALL_BEAM 14
+
#ifndef ASM
#include "error.h"
@@ -59,13 +61,58 @@ void hipe_empty_nstack(Process *p);
void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free);
Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s);
-void hipe_reserve_beam_trap_frame(Process*, Eterm reg[], unsigned arity);
-void hipe_unreserve_beam_trap_frame(Process*);
+ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process*, Eterm reg[], unsigned arity);
+ERTS_GLB_INLINE void hipe_unreserve_beam_trap_frame(Process*);
extern Uint hipe_beam_pc_return[];
extern Uint hipe_beam_pc_throw[];
extern Uint hipe_beam_pc_resume[];
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+
+#include "erl_gc.h"
+#include "hipe_stack.h"
+
+#if defined(__sparc__)
+#include "hipe_sparc_glue.h"
+#elif defined(__i386__)
+#include "hipe_x86_glue.h"
+#elif defined(__x86_64__)
+#include "hipe_amd64_glue.h"
+#elif defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__)
+#include "hipe_ppc_glue.h"
+#elif defined(__arm__)
+#include "hipe_arm_glue.h"
+#endif
+
+extern Eterm hipe_beam_catch_throw;
+
+ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsigned arity)
+{
+ if (!hipe_bifcall_from_native_is_recursive(p))
+ return;
+
+ /* ensure that at least 2 words are available on the BEAM stack */
+ if ((p->stop - 2) < p->htop) {
+ p->fcalls -= erts_garbage_collect(p, 2, reg, arity);
+ ASSERT(!((p->stop - 2) < p->htop));
+ }
+ p->stop -= 2;
+ p->stop[0] = NIL;
+ p->stop[1] = hipe_beam_catch_throw;
+}
+
+ERTS_GLB_INLINE void hipe_unreserve_beam_trap_frame(Process *p)
+{
+ if (!hipe_bifcall_from_native_is_recursive(p))
+ return;
+
+ ASSERT(p->stop[0] == NIL && p->stop[1] == hipe_beam_catch_throw);
+ p->stop += 2;
+}
+
+#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */
+
#endif /* ASM */
#endif /* HIPE_MODE_SWITCH_H */
diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c
index 7d343dd91e..7e8632b50d 100644
--- a/erts/emulator/hipe/hipe_native_bif.c
+++ b/erts/emulator/hipe/hipe_native_bif.c
@@ -330,8 +330,6 @@ char *hipe_bs_allocate(int len)
Binary *bptr;
bptr = erts_bin_nrml_alloc(len);
- bptr->flags = 0;
- bptr->orig_size = len;
erts_smp_atomic_init_nob(&bptr->refc, 1);
return bptr->orig_bytes;
}
@@ -341,7 +339,6 @@ Binary *hipe_bs_reallocate(Binary* oldbptr, int newsize)
Binary *bptr;
bptr = erts_bin_realloc(oldbptr, newsize);
- bptr->orig_size = newsize;
return bptr;
}
diff --git a/erts/emulator/hipe/hipe_ppc.c b/erts/emulator/hipe/hipe_ppc.c
index 2d8fd61e1e..4dc26cdbc8 100644
--- a/erts/emulator/hipe/hipe_ppc.c
+++ b/erts/emulator/hipe/hipe_ppc.c
@@ -285,7 +285,7 @@ int hipe_patch_insn(void *address, Uint64 value, Eterm type)
}
}
-void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
+void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
{
unsigned int *code;
@@ -294,16 +294,16 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
code = alloc_stub(7);
- /* addis r12,0,beamAddress@highest */
- code[0] = 0x3d800000 | (((unsigned long)beamAddress >> 48) & 0xffff);
- /* ori r12,r12,beamAddress@higher */
- code[1] = 0x618c0000 | (((unsigned long)beamAddress >> 32) & 0xffff);
+ /* addis r12,0,callee_exp@highest */
+ code[0] = 0x3d800000 | (((unsigned long)callee_exp >> 48) & 0xffff);
+ /* ori r12,r12,callee_exp@higher */
+ code[1] = 0x618c0000 | (((unsigned long)callee_exp >> 32) & 0xffff);
/* sldi r12,r12,32 (rldicr r12,r12,32,31) */
code[2] = 0x798c07c6;
- /* oris r12,r12,beamAddress@h */
- code[3] = 0x658c0000 | (((unsigned long)beamAddress >> 16) & 0xffff);
- /* ori r12,r12,beamAddress@l */
- code[4] = 0x618c0000 | ((unsigned long)beamAddress & 0xffff);
+ /* oris r12,r12,callee_exp@h */
+ code[3] = 0x658c0000 | (((unsigned long)callee_exp >> 16) & 0xffff);
+ /* ori r12,r12,callee_exp@l */
+ code[4] = 0x618c0000 | ((unsigned long)callee_exp & 0xffff);
/* addi r0,0,beamArity */
code[5] = 0x38000000 | (beamArity & 0x7FFF);
/* ba nbif_callemu */
@@ -355,18 +355,16 @@ int hipe_patch_insn(void *address, Uint32 value, Eterm type)
return 0;
}
-/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2()
- and hipe_bif0.c:hipe_make_stub() */
-void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
+void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
{
unsigned int *code;
/*
* Native code calls BEAM via a stub looking as follows:
*
- * addi r12,0,beamAddress@l
+ * addi r12,0,callee_exp@l
* addi r0,0,beamArity
- * addis r12,r12,beamAddress@ha
+ * addis r12,r12,callee_exp@ha
* ba nbif_callemu
*
* I'm using r0 and r12 since the standard SVR4 ABI allows
@@ -384,12 +382,12 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
code = alloc_stub(4);
- /* addi r12,0,beamAddress@l */
- code[0] = 0x39800000 | ((unsigned long)beamAddress & 0xFFFF);
+ /* addi r12,0,callee_exp@l */
+ code[0] = 0x39800000 | ((unsigned long)callee_exp & 0xFFFF);
/* addi r0,0,beamArity */
code[1] = 0x38000000 | (beamArity & 0x7FFF);
- /* addis r12,r12,beamAddress@ha */
- code[2] = 0x3D8C0000 | at_ha((unsigned long)beamAddress);
+ /* addis r12,r12,callee_exp@ha */
+ code[2] = 0x3D8C0000 | at_ha((unsigned long)callee_exp);
/* ba nbif_callemu */
code[3] = 0x48000002 | (unsigned long)&nbif_callemu;
diff --git a/erts/emulator/hipe/hipe_ppc_asm.m4 b/erts/emulator/hipe/hipe_ppc_asm.m4
index 343402f9f0..4a1caa1543 100644
--- a/erts/emulator/hipe/hipe_ppc_asm.m4
+++ b/erts/emulator/hipe/hipe_ppc_asm.m4
@@ -23,6 +23,22 @@ changecom(`/*', `*/')dnl
#define HIPE_PPC_ASM_H'
/*
+ * Tunables.
+ */
+define(LEAF_WORDS,16)dnl number of stack words for leaf functions
+define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive
+
+`#define PPC_LEAF_WORDS 'LEAF_WORDS
+`#define PPC_NR_ARG_REGS 'NR_ARG_REGS
+`#define NR_ARG_REGS 'NR_ARG_REGS
+
+
+`#ifdef ASM'
+/*
+ * Only assembler stuff from here on (when included from *.S)
+ */
+
+/*
* Handle 32 vs 64-bit.
*/
ifelse(ARCH,ppc64,`
@@ -53,13 +69,6 @@ define(WSIZE,4)dnl
`#define STORE 'STORE
`#define CMPI 'CMPI
-/*
- * Tunables.
- */
-define(LEAF_WORDS,16)dnl number of stack words for leaf functions
-define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive
-
-`#define PPC_LEAF_WORDS 'LEAF_WORDS
/*
* Workarounds for Darwin.
@@ -193,8 +202,6 @@ NAME: \
/*
* Argument (parameter) registers.
*/
-`#define PPC_NR_ARG_REGS 'NR_ARG_REGS
-`#define NR_ARG_REGS 'NR_ARG_REGS
define(defarg,`define(ARG$1,`$2')dnl
#`define ARG'$1 $2'
@@ -309,4 +316,6 @@ define(QUICK_CALL_RET,`NBIF_POP_N(eval(RET_POP($2)))b $1')dnl
`/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */'
`/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */'
+`#endif /* ASM */'
+
`#endif /* HIPE_PPC_ASM_H */'
diff --git a/erts/emulator/hipe/hipe_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4
index 7cc2b5c7b6..f53b79b52e 100644
--- a/erts/emulator/hipe/hipe_ppc_bifs.m4
+++ b/erts/emulator/hipe/hipe_ppc_bifs.m4
@@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl
*/
+#`define ASM'
include(`hipe/hipe_ppc_asm.m4')
#`include' "config.h"
#`include' "hipe_literals.h"
diff --git a/erts/emulator/hipe/hipe_ppc_glue.S b/erts/emulator/hipe/hipe_ppc_glue.S
index 6f0217c738..c48fb150af 100644
--- a/erts/emulator/hipe/hipe_ppc_glue.S
+++ b/erts/emulator/hipe/hipe_ppc_glue.S
@@ -17,10 +17,9 @@
* %CopyrightEnd%
*/
-
+#define ASM
#include "hipe_ppc_asm.h"
#include "hipe_literals.h"
-#define ASM
#include "hipe_mode_switch.h"
.text
@@ -296,7 +295,7 @@ CSYM(hipe_ppc_throw_to_native):
* which should look as follows:
*
* stub for f/N:
- * <set r12 to f's BEAM code address>
+ * <set r12 to f's export entry address>
* <set r0 to N>
* b nbif_callemu
*
@@ -312,10 +311,10 @@ CSYM(hipe_ppc_throw_to_native):
*/
GLOBAL(ASYM(nbif_callemu))
ASYM(nbif_callemu):
- STORE r12, P_BEAM_IP(P)
+ STORE r12, P_CALLEE_EXP(P)
STORE r0, P_ARITY(P)
STORE_ARG_REGS
- li r3, HIPE_MODE_SWITCH_RES_CALL
+ li r3, HIPE_MODE_SWITCH_RES_CALL_EXPORTED
b .suspend_exit
/*
diff --git a/erts/emulator/hipe/hipe_process.h b/erts/emulator/hipe/hipe_process.h
index 4ee99d78a2..86655ad42c 100644
--- a/erts/emulator/hipe/hipe_process.h
+++ b/erts/emulator/hipe/hipe_process.h
@@ -23,14 +23,17 @@
#define HIPE_PROCESS_H
#include "erl_alloc.h"
+#include "export.h"
struct hipe_process_state {
Eterm *nsp; /* Native stack pointer. */
Eterm *nstack; /* Native stack block start. */
Eterm *nstend; /* Native stack block end (start+size). */
- /* XXX: ncallee and closure could share space in a union */
- void (*ncallee)(void); /* Native code callee (label) to invoke. */
- Eterm closure; /* Used to pass a closure from native code. */
+ union {
+ void (*ncallee)(void); /* Native code callee (label) to invoke. */
+ Eterm closure; /* Used to pass a closure from native code. */
+ Export* callee_exp; /* Used to pass export entry from native code */
+ }u;
Eterm *nstgraylim; /* Gray/white stack boundary. */
Eterm *nstblacklim; /* Black/gray stack boundary. Must exist if
graylim exists. Ignored if no graylim. */
diff --git a/erts/emulator/hipe/hipe_risc_stack.c b/erts/emulator/hipe/hipe_risc_stack.c
index 1183856c7e..bea3a0fecd 100644
--- a/erts/emulator/hipe/hipe_risc_stack.c
+++ b/erts/emulator/hipe/hipe_risc_stack.c
@@ -226,7 +226,7 @@ void (*hipe_handle_stack_trap(Process *p))(void)
* The native stack MUST contain a stack frame as it appears on
* entry to a function (actuals, caller's frame, caller's return address).
* p->hipe.narity MUST contain the arity (number of actuals).
- * On exit, p->hipe.ncallee is set to the handler's PC and p->hipe.nsp
+ * On exit, p->hipe.u.ncallee is set to the handler's PC and p->hipe.nsp
* is set to its SP (low address of its stack frame).
*/
void hipe_find_handler(Process *p)
@@ -254,7 +254,7 @@ void hipe_find_handler(Process *p)
if ((exnra = sdesc_exnra(sdesc)) != 0 &&
(p->catches >= 0 ||
exnra == (unsigned long)&nbif_fail)) {
- p->hipe.ncallee = (void(*)(void)) exnra;
+ p->hipe.u.ncallee = (void(*)(void)) exnra;
p->hipe.nsp = nsp;
p->hipe.narity = 0;
/* update the gray/white boundary if we threw past it */
diff --git a/erts/emulator/hipe/hipe_sparc.c b/erts/emulator/hipe/hipe_sparc.c
index 49d4da7bab..2052aa8498 100644
--- a/erts/emulator/hipe/hipe_sparc.c
+++ b/erts/emulator/hipe/hipe_sparc.c
@@ -204,9 +204,7 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *
return alloc_code(nrbytes);
}
-/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2()
- and hipe_bif0.c:hipe_make_stub() */
-void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
+void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
{
unsigned int *code;
unsigned int callEmuOffset;
@@ -215,11 +213,11 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
code = alloc_code(5*sizeof(int));
/* sethi %hi(Address), %i4 */
- code[0] = 0x39000000 | (((unsigned int)beamAddress >> 10) & 0x3FFFFF);
+ code[0] = 0x39000000 | (((unsigned int)callee_exp >> 10) & 0x3FFFFF);
/* or %g0, %o7, %i3 ! mov %o7, %i3 */
code[1] = 0xB610000F;
/* or %i4, %lo(Address), %i4 */
- code[2] = 0xB8172000 | ((unsigned int)beamAddress & 0x3FF);
+ code[2] = 0xB8172000 | ((unsigned int)callee_exp & 0x3FF);
/* call callemu */
callEmuOffset = (char*)nbif_callemu - (char*)&code[3];
code[3] = (1 << 30) | ((callEmuOffset >> 2) & 0x3FFFFFFF);
diff --git a/erts/emulator/hipe/hipe_sparc_asm.m4 b/erts/emulator/hipe/hipe_sparc_asm.m4
index 227d10ed80..c3c3bcb74a 100644
--- a/erts/emulator/hipe/hipe_sparc_asm.m4
+++ b/erts/emulator/hipe/hipe_sparc_asm.m4
@@ -29,6 +29,14 @@ define(LEAF_WORDS,16)dnl number of stack words for leaf functions
define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive
`#define SPARC_LEAF_WORDS 'LEAF_WORDS
+`#define SPARC_NR_ARG_REGS 'NR_ARG_REGS
+`#define NR_ARG_REGS 'NR_ARG_REGS
+
+
+`#ifdef ASM'
+/*
+ * Only assembler stuff from here on (when included from *.S)
+ */
/*
* Reserved registers.
@@ -80,9 +88,6 @@ define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive
/*
* Argument (parameter) registers.
*/
-`#define SPARC_NR_ARG_REGS 'NR_ARG_REGS
-`#define NR_ARG_REGS 'NR_ARG_REGS
-
define(defarg,`define(ARG$1,`$2')dnl
#`define ARG'$1 $2'
)dnl
@@ -210,4 +215,6 @@ define(QUICK_CALL_RET,`ba $1; NBIF_POP_N(eval(RET_POP($2)))')dnl
`/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */'
`/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */'
+`#endif /* ASM */'
+
`#endif /* HIPE_SPARC_ASM_H */'
diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4
index ca5af45d58..2bfe3a4646 100644
--- a/erts/emulator/hipe/hipe_sparc_bifs.m4
+++ b/erts/emulator/hipe/hipe_sparc_bifs.m4
@@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl
*/
+#`define ASM'
include(`hipe/hipe_sparc_asm.m4')
#`include' "config.h"
#`include' "hipe_literals.h"
diff --git a/erts/emulator/hipe/hipe_sparc_glue.S b/erts/emulator/hipe/hipe_sparc_glue.S
index 44bdf1bc7e..6c8c841194 100644
--- a/erts/emulator/hipe/hipe_sparc_glue.S
+++ b/erts/emulator/hipe/hipe_sparc_glue.S
@@ -18,10 +18,9 @@
* %CopyrightEnd%
*/
-
+#define ASM
#include "hipe_sparc_asm.h"
#include "hipe_literals.h"
-#define ASM
#include "hipe_mode_switch.h"
.section ".text"
@@ -155,9 +154,9 @@ hipe_sparc_throw_to_native:
* which should look as follows:
*
* stub for f/N:
- * sethi %hi(f's BEAM code address), TEMP_ARG0
+ * sethi %hi(f's export entry address), TEMP_ARG0
* mov RA, TEMP_RA ! because the call below clobbers RA (%o7)
- * or TEMP_ARG0, %lo(f's BEAM code address), TEMP_ARG0
+ * or TEMP_ARG0, %lo(f's export entry address), TEMP_ARG0
* call nbif_callemu ! clobbers RA!
* mov N, TEMP_ARG1 ! delay slot: TEMP_ARG1 := ARITY
*
@@ -165,12 +164,12 @@ hipe_sparc_throw_to_native:
*/
.global nbif_callemu
nbif_callemu:
- st TEMP_ARG0, [P+P_BEAM_IP]
+ st TEMP_ARG0, [P+P_CALLEE_EXP]
st TEMP_ARG1, [P+P_ARITY]
st TEMP_RA, [P+P_NRA]
STORE_ARG_REGS
ba .flush_exit
- mov HIPE_MODE_SWITCH_RES_CALL, %o0
+ mov HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %o0
/*
* nbif_apply
diff --git a/erts/emulator/hipe/hipe_stack.h b/erts/emulator/hipe/hipe_stack.h
index 66f9f04c73..4cfdb54dd8 100644
--- a/erts/emulator/hipe/hipe_stack.h
+++ b/erts/emulator/hipe/hipe_stack.h
@@ -108,12 +108,23 @@ extern int hipe_fill_stacktrace(Process*, int, Eterm**);
#if 0 && defined(HIPE_NSTACK_GROWS_UP)
#define hipe_nstack_start(p) ((p)->hipe.nstack)
#define hipe_nstack_used(p) ((p)->hipe.nsp - (p)->hipe.nstack)
+#define hipe_nstack_avail(p) ((p)->hipe.nstend - (p)->hipe.nsp)
#endif
#if defined(HIPE_NSTACK_GROWS_DOWN)
#define hipe_nstack_start(p) ((p)->hipe.nsp)
#define hipe_nstack_used(p) ((p)->hipe.nstend - (p)->hipe.nsp)
+#define hipe_nstack_avail(p) ((unsigned)((p)->hipe.nsp - (p)->hipe.nstack))
#endif
+/* ensure that at least nwords words are available on the native stack */
+static __inline__ void hipe_check_nstack(Process *p, unsigned nwords)
+{
+ extern void hipe_inc_nstack(Process *p);
+
+ while (hipe_nstack_avail(p) < nwords)
+ hipe_inc_nstack(p);
+}
+
/*
* GC support procedures
*/
diff --git a/erts/emulator/hipe/hipe_x86.c b/erts/emulator/hipe/hipe_x86.c
index 327c74e9aa..314f6b597c 100644
--- a/erts/emulator/hipe/hipe_x86.c
+++ b/erts/emulator/hipe/hipe_x86.c
@@ -182,18 +182,16 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *
return alloc_code(nrbytes);
}
-/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2()
- and hipe_bif0.c:hipe_make_stub() */
-void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
+void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity)
{
/*
* This creates a native code stub with the following contents:
*
- * movl $Address, P_BEAM_IP(%ebp)
+ * movl $Address, P_CALLEE_EXP(%ebp)
* movb $Arity, P_ARITY(%ebp)
* jmp callemu
*
- * The stub has variable size, depending on whether the P_BEAM_IP
+ * The stub has variable size, depending on whether the P_CALLEE_EXP
* and P_ARITY offsets fit in 8-bit signed displacements or not.
* The rel32 offset in the final jmp depends on its actual location,
* which also depends on the size of the previous instructions.
@@ -206,28 +204,28 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity)
codeSize = /* 16, 19, or 22 bytes */
16 + /* 16 when both offsets are 8-bit */
- (P_BEAM_IP >= 128 ? 3 : 0) +
+ (P_CALLEE_EXP >= 128 ? 3 : 0) +
(P_ARITY >= 128 ? 3 : 0);
codep = code = alloc_code(codeSize);
- /* movl $beamAddress, P_BEAM_IP(%ebp); 3 or 6 bytes, plus 4 */
+ /* movl $beamAddress, P_CALLEE_EXP(%ebp); 3 or 6 bytes, plus 4 */
codep[0] = 0xc7;
-#if P_BEAM_IP >= 128
+#if P_CALLEE_EXP >= 128
codep[1] = 0x85; /* disp32[EBP] */
- codep[2] = P_BEAM_IP & 0xFF;
- codep[3] = (P_BEAM_IP >> 8) & 0xFF;
- codep[4] = (P_BEAM_IP >> 16) & 0xFF;
- codep[5] = (P_BEAM_IP >> 24) & 0xFF;
+ codep[2] = P_CALLEE_EXP & 0xFF;
+ codep[3] = (P_CALLEE_EXP >> 8) & 0xFF;
+ codep[4] = (P_CALLEE_EXP >> 16) & 0xFF;
+ codep[5] = (P_CALLEE_EXP >> 24) & 0xFF;
codep += 6;
#else
codep[1] = 0x45; /* disp8[EBP] */
- codep[2] = P_BEAM_IP;
+ codep[2] = P_CALLEE_EXP;
codep += 3;
#endif
- codep[0] = ((unsigned int)beamAddress) & 0xFF;
- codep[1] = ((unsigned int)beamAddress >> 8) & 0xFF;
- codep[2] = ((unsigned int)beamAddress >> 16) & 0xFF;
- codep[3] = ((unsigned int)beamAddress >> 24) & 0xFF;
+ codep[0] = ((unsigned int)callee_exp) & 0xFF;
+ codep[1] = ((unsigned int)callee_exp >> 8) & 0xFF;
+ codep[2] = ((unsigned int)callee_exp >> 16) & 0xFF;
+ codep[3] = ((unsigned int)callee_exp >> 24) & 0xFF;
codep += 4;
/* movb $beamArity, P_ARITY(%ebp); 3 or 6 bytes */
diff --git a/erts/emulator/hipe/hipe_x86_asm.m4 b/erts/emulator/hipe/hipe_x86_asm.m4
index 020ccf8d4b..39c5cb1044 100644
--- a/erts/emulator/hipe/hipe_x86_asm.m4
+++ b/erts/emulator/hipe/hipe_x86_asm.m4
@@ -33,6 +33,18 @@ define(SIMULATE_NSP,0)dnl change to 1 to simulate call/ret insns
`#define X86_LEAF_WORDS 'LEAF_WORDS
`#define LEAF_WORDS 'LEAF_WORDS
+`#define X86_NR_ARG_REGS 'NR_ARG_REGS
+`#define NR_ARG_REGS 'NR_ARG_REGS
+
+`#define X86_HP_IN_ESI 'HP_IN_ESI
+`#define X86_SIMULATE_NSP 'SIMULATE_NSP
+
+
+`#ifdef ASM'
+/*
+ * Only assembler stuff from here on (when included from *.S)
+ */
+
/*
* Workarounds for Darwin.
*/
@@ -60,7 +72,6 @@ ifelse(OPSYS,darwin,``
*/
`#define P %ebp'
-`#define X86_HP_IN_ESI 'HP_IN_ESI
`#if X86_HP_IN_ESI
#define SAVE_HP movl %esi, P_HP(P)
#define RESTORE_HP movl P_HP(P), %esi
@@ -73,7 +84,6 @@ ifelse(OPSYS,darwin,``
#define SAVE_CSP movl %esp, P_CSP(P)
#define RESTORE_CSP movl P_CSP(P), %esp'
-`#define X86_SIMULATE_NSP 'SIMULATE_NSP
/*
* Context switching macros.
@@ -100,12 +110,10 @@ ifelse(OPSYS,darwin,``
SAVE_CACHED_STATE; \
SWITCH_ERLANG_TO_C_QUICK'
+
/*
* Argument (parameter) registers.
*/
-`#define X86_NR_ARG_REGS 'NR_ARG_REGS
-`#define NR_ARG_REGS 'NR_ARG_REGS
-
ifelse(eval(NR_ARG_REGS >= 1),0,,
``#define ARG0 %eax
'')dnl
@@ -282,4 +290,6 @@ define(LOAD_CALLER_SAVE,`LAR_N(eval(NR_CALLER_SAVE-1))')dnl
`#define STORE_CALLER_SAVE 'STORE_CALLER_SAVE
`#define LOAD_CALLER_SAVE 'LOAD_CALLER_SAVE
+`#endif /* ASM */'
+
`#endif /* HIPE_X86_ASM_H */'
diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4
index dd6980f555..a0f16efa33 100644
--- a/erts/emulator/hipe/hipe_x86_bifs.m4
+++ b/erts/emulator/hipe/hipe_x86_bifs.m4
@@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl
*/
+#`define ASM'
include(`hipe/hipe_x86_asm.m4')
#`include' "config.h"
#`include' "hipe_literals.h"
diff --git a/erts/emulator/hipe/hipe_x86_glue.S b/erts/emulator/hipe/hipe_x86_glue.S
index 88b86f4de7..9d38eaaafd 100644
--- a/erts/emulator/hipe/hipe_x86_glue.S
+++ b/erts/emulator/hipe/hipe_x86_glue.S
@@ -18,10 +18,9 @@
* %CopyrightEnd%
*/
-
+#define ASM
#include "hipe_x86_asm.h"
#include "hipe_literals.h"
-#define ASM
#include "hipe_mode_switch.h"
/*
@@ -104,7 +103,7 @@ ASYM(nbif_return):
* stub (hipe_x86_loader.erl) which should look as follows:
*
* stub for f/N:
- * movl $<f's BEAM code address>, P_BEAM_IP(P)
+ * movl $<f's export entry address>, P_CALLEE_EXP(P)
* movb $<N>, P_ARITY(P)
* jmp nbif_callemu
*
@@ -114,7 +113,7 @@ ASYM(nbif_return):
GLOBAL(ASYM(nbif_callemu))
ASYM(nbif_callemu):
STORE_ARG_REGS
- movl $HIPE_MODE_SWITCH_RES_CALL, %eax
+ movl $HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %eax
jmp .suspend_exit
/*
diff --git a/erts/emulator/hipe/hipe_x86_stack.c b/erts/emulator/hipe/hipe_x86_stack.c
index 9ad3fa9d31..7f1c2f7d41 100644
--- a/erts/emulator/hipe/hipe_x86_stack.c
+++ b/erts/emulator/hipe/hipe_x86_stack.c
@@ -209,7 +209,7 @@ void (*hipe_handle_stack_trap(Process *p))(void)
* The native stack MUST contain a stack frame as it appears on
* entry to a function (return address, actuals, caller's frame).
* p->hipe.narity MUST contain the arity (number of actuals).
- * On exit, p->hipe.ncallee is set to the handler's PC and p->hipe.nsp
+ * On exit, p->hipe.u.ncallee is set to the handler's PC and p->hipe.nsp
* is set to its SP (low address of its stack frame).
*/
void hipe_find_handler(Process *p)
@@ -240,7 +240,7 @@ void hipe_find_handler(Process *p)
if ((exnra = sdesc_exnra(sdesc)) != 0 &&
(p->catches >= 0 ||
exnra == (unsigned long)nbif_fail)) {
- p->hipe.ncallee = (void(*)(void)) exnra;
+ p->hipe.u.ncallee = (void(*)(void)) exnra;
p->hipe.nsp = nsp;
p->hipe.narity = 0;
/* update the gray/white boundary if we threw past it */
diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c
index 0d677d5f34..5de0c281c4 100644
--- a/erts/emulator/sys/unix/sys.c
+++ b/erts/emulator/sys/unix/sys.c
@@ -34,6 +34,7 @@
#include <termios.h>
#include <ctype.h>
#include <sys/utsname.h>
+#include <sys/select.h>
#ifdef ISC32
#include <sys/bsdtypes.h>
@@ -91,8 +92,10 @@ static erts_smp_rwmtx_t environ_rwmtx;
# else
# define CHLDWTHR 0
# endif
+# define FDBLOCK 1
#else
# define CHLDWTHR 0
+# define FDBLOCK 0
#endif
/*
* [OTP-3906]
@@ -121,6 +124,15 @@ struct ErtsSysReportExit_ {
#endif
};
+/* Used by the fd driver iff the fd could not be set to non-blocking */
+typedef struct ErtsSysBlocking_ {
+ ErlDrvPDL pdl;
+ int res;
+ int err;
+ unsigned int pkey;
+} ErtsSysBlocking;
+
+
/* This data is shared by these drivers - initialized by spawn_init() */
static struct driver_data {
ErlDrvPort port_num;
@@ -129,6 +141,8 @@ static struct driver_data {
int pid;
int alive;
int status;
+ int terminating;
+ ErtsSysBlocking *blocking;
} *driver_data; /* indexed by fd */
static ErtsSysReportExit *report_exit_list;
@@ -1108,11 +1122,16 @@ void fini_getenv_state(GETENV_STATE *state)
/* Driver interfaces */
static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*);
static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*);
+#if FDBLOCK
+static void fd_async(void *);
+static void fd_ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data);
+#endif
static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT,
char **, ErlDrvSizeT);
static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*);
static int spawn_init(void);
static void fd_stop(ErlDrvData);
+static void fd_flush(ErlDrvData);
static void stop(ErlDrvData);
static void ready_input(ErlDrvData, ErlDrvEvent);
static void ready_output(ErlDrvData, ErlDrvEvent);
@@ -1157,8 +1176,12 @@ struct erl_drv_entry fd_driver_entry = {
fd_control,
NULL,
outputv,
- NULL, /* ready_async */
- NULL, /* flush */
+#if FDBLOCK
+ fd_ready_async, /* ready_async */
+#else
+ NULL,
+#endif
+ fd_flush, /* flush */
NULL, /* call */
NULL, /* event */
ERL_DRV_EXTENDED_MARKER,
@@ -1212,13 +1235,28 @@ static RETSIGTYPE onchld(int signum)
#endif
}
+static int set_blocking_data(struct driver_data *dd) {
+
+ dd->blocking = erts_alloc(ERTS_ALC_T_SYS_BLOCKING, sizeof(ErtsSysBlocking));
+
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, sizeof(ErtsSysBlocking));
+
+ dd->blocking->pdl = driver_pdl_create(dd->port_num);
+ dd->blocking->res = 0;
+ dd->blocking->err = 0;
+ dd->blocking->pkey = driver_async_port_key(dd->port_num);
+
+ return 1;
+}
+
static int set_driver_data(ErlDrvPort port_num,
int ifd,
int ofd,
int packet_bytes,
int read_write,
int exit_status,
- int pid)
+ int pid,
+ int is_blocking)
{
Port *prt;
ErtsSysReportExit *report_exit;
@@ -1250,8 +1288,13 @@ static int set_driver_data(ErlDrvPort port_num,
driver_data[ifd].pid = pid;
driver_data[ifd].alive = 1;
driver_data[ifd].status = 0;
+ driver_data[ifd].terminating = 0;
+ driver_data[ifd].blocking = NULL;
if (read_write & DO_WRITE) {
driver_data[ifd].ofd = ofd;
+ if (is_blocking && FDBLOCK)
+ if (!set_blocking_data(driver_data+ifd))
+ return -1;
if (ifd != ofd)
driver_data[ofd] = driver_data[ifd]; /* structure copy */
} else { /* DO_READ only */
@@ -1267,6 +1310,11 @@ static int set_driver_data(ErlDrvPort port_num,
driver_data[ofd].pid = pid;
driver_data[ofd].alive = 1;
driver_data[ofd].status = 0;
+ driver_data[ofd].terminating = 0;
+ driver_data[ofd].blocking = NULL;
+ if (is_blocking && FDBLOCK)
+ if (!set_blocking_data(driver_data+ofd))
+ return -1;
return(ofd);
}
}
@@ -1276,6 +1324,7 @@ static int spawn_init()
int i;
#if CHLDWTHR
erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER;
+
thr_opts.detached = 0;
thr_opts.suggested_stack_size = 0; /* Smallest possible */
#endif
@@ -1755,7 +1804,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op
}
res = set_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes,
- opts->read_write, opts->exit_status, pid);
+ opts->read_write, opts->exit_status, pid, 0);
/* Don't unblock SIGCHLD until now, since the call above must
first complete putting away the info about our new subprocess. */
unblock_signals();
@@ -1840,6 +1889,7 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name,
SysDriverOpts* opts)
{
ErlDrvData res;
+ int non_blocking = 0;
if (((opts->read_write & DO_READ) && opts->ifd >= max_files) ||
((opts->read_write & DO_WRITE) && opts->ofd >= max_files))
@@ -1912,6 +1962,20 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name,
* case - it can be called with any old pre-existing file descriptors,
* the relations between which (if they're even two) we can only guess
* at - still, we try our best...
+ *
+ * Added note OTP 18: Some systems seem to use stdout/stderr to log data
+ * using unix pipes, so we cannot allow the system to block on a write.
+ * Therefore we use an async thread to write the data to fd's that could
+ * not be set to non-blocking. When no async threads are available we
+ * fall back on the old behaviour.
+ *
+ * Also the guarantee about what is delivered to the OS has changed.
+ * Pre 18 the fd driver did no flushing of data before terminating.
+ * Now it does. This is because we want to be able to guarantee that things
+ * such as escripts and friends really have outputted all data before
+ * terminating. This could potentially block the termination of the system
+ * for a very long time, but if the user wants to terminate fast she should
+ * use erlang:halt with flush=false.
*/
if (opts->read_write & DO_READ) {
@@ -1934,6 +1998,7 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name,
imagine a scenario where setting non-blocking mode
here would cause problems - go ahead and do it. */
+ non_blocking = 1;
SET_NONBLOCKING(opts->ofd);
} else { /* output fd is a tty, input fd isn't */
@@ -1976,6 +2041,7 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name,
(nfd = open(tty, O_WRONLY)) != -1) {
dup2(nfd, opts->ofd);
close(nfd);
+ non_blocking = 1;
SET_NONBLOCKING(opts->ofd);
}
}
@@ -1984,8 +2050,9 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name,
}
CHLD_STAT_LOCK;
res = (ErlDrvData)(long)set_driver_data(port_num, opts->ifd, opts->ofd,
- opts->packet_bytes,
- opts->read_write, 0, -1);
+ opts->packet_bytes,
+ opts->read_write, 0, -1,
+ !non_blocking);
CHLD_STAT_UNLOCK;
return res;
}
@@ -2011,14 +2078,30 @@ static void nbio_stop_fd(ErlDrvPort prt, int fd)
SET_BLOCKING(fd);
}
-static void fd_stop(ErlDrvData fd) /* Does not close the fds */
+static void fd_stop(ErlDrvData ev) /* Does not close the fds */
{
int ofd;
+ int fd = (int)(long)ev;
+ ErlDrvPort prt = driver_data[fd].port_num;
- nbio_stop_fd(driver_data[(int)(long)fd].port_num, (int)(long)fd);
- ofd = driver_data[(int)(long)fd].ofd;
- if (ofd != (int)(long)fd && ofd != -1)
- nbio_stop_fd(driver_data[(int)(long)fd].port_num, (int)(long)ofd);
+#if FDBLOCK
+ if (driver_data[fd].blocking) {
+ erts_free(ERTS_ALC_T_SYS_BLOCKING,driver_data[fd].blocking);
+ driver_data[fd].blocking = NULL;
+ erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*sizeof(ErtsSysBlocking));
+ }
+#endif
+
+ nbio_stop_fd(prt, fd);
+ ofd = driver_data[fd].ofd;
+ if (ofd != fd && ofd != -1)
+ nbio_stop_fd(prt, ofd);
+}
+
+static void fd_flush(ErlDrvData fd)
+{
+ if (!driver_data[(int)(long)fd].terminating)
+ driver_data[(int)(long)fd].terminating = 1;
}
static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name,
@@ -2041,8 +2124,8 @@ static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name,
CHLD_STAT_LOCK;
res = (ErlDrvData)(long)set_driver_data(port_num, fd, fd,
- opts->packet_bytes,
- opts->read_write, 0, -1);
+ opts->packet_bytes,
+ opts->read_write, 0, -1, 0);
CHLD_STAT_UNLOCK;
return res;
}
@@ -2079,6 +2162,7 @@ static void stop(ErlDrvData fd)
}
}
+/* used by fd_driver */
static void outputv(ErlDrvData e, ErlIOVec* ev)
{
int fd = (int)(long)e;
@@ -2104,12 +2188,21 @@ static void outputv(ErlDrvData e, ErlIOVec* ev)
ev->iov[0].iov_base = lbp;
ev->iov[0].iov_len = pb;
ev->size += pb;
+
+ if (driver_data[fd].blocking && FDBLOCK)
+ driver_pdl_lock(driver_data[fd].blocking->pdl);
+
if ((sz = driver_sizeq(ix)) > 0) {
driver_enqv(ix, ev, 0);
+
+ if (driver_data[fd].blocking && FDBLOCK)
+ driver_pdl_unlock(driver_data[fd].blocking->pdl);
+
if (sz + ev->size >= (1 << 13))
set_busy_port(ix, 1);
}
- else {
+ else if (!driver_data[fd].blocking || !FDBLOCK) {
+ /* We try to write directly if the fd in non-blocking */
int vsize = ev->vsize > MAX_VSIZE ? MAX_VSIZE : ev->vsize;
n = writev(ofd, (const void *) (ev->iov), vsize);
@@ -2125,10 +2218,22 @@ static void outputv(ErlDrvData e, ErlIOVec* ev)
driver_enqv(ix, ev, n); /* n is the skip value */
driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1);
}
+#if FDBLOCK
+ else {
+ if (ev->size != 0) {
+ driver_enqv(ix, ev, 0);
+ driver_pdl_unlock(driver_data[fd].blocking->pdl);
+ driver_async(ix, &driver_data[fd].blocking->pkey,
+ fd_async, driver_data+fd, NULL);
+ } else {
+ driver_pdl_unlock(driver_data[fd].blocking->pdl);
+ }
+ }
+#endif
/* return 0;*/
}
-
+/* Used by spawn_driver and vanilla driver */
static void output(ErlDrvData e, char* buf, ErlDrvSizeT len)
{
int fd = (int)(long)e;
@@ -2191,6 +2296,23 @@ static int port_inp_failure(ErlDrvPort port_num, int ready_fd, int res)
ASSERT(res <= 0);
(void) driver_select(port_num, ready_fd, ERL_DRV_READ|ERL_DRV_WRITE, 0);
clear_fd_data(ready_fd);
+
+ if (driver_data[ready_fd].blocking && FDBLOCK) {
+ driver_pdl_lock(driver_data[ready_fd].blocking->pdl);
+ if (driver_sizeq(driver_data[ready_fd].port_num) > 0) {
+ driver_pdl_unlock(driver_data[ready_fd].blocking->pdl);
+ /* We have stuff in the output queue, so we just
+ set the state to terminating and wait for fd_async_ready
+ to terminate the port */
+ if (res == 0)
+ driver_data[ready_fd].terminating = 2;
+ else
+ driver_data[ready_fd].terminating = -err;
+ return 0;
+ }
+ driver_pdl_unlock(driver_data[ready_fd].blocking->pdl);
+ }
+
if (res == 0) {
if (driver_data[ready_fd].report_exit) {
CHLD_STAT_LOCK;
@@ -2241,6 +2363,7 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd)
port_num = driver_data[fd].port_num;
packet_bytes = driver_data[fd].packet_bytes;
+
if (packet_bytes == 0) {
byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF,
ERTS_SYS_READ_BUF_SZ);
@@ -2364,6 +2487,8 @@ static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd)
if ((iv = (struct iovec*) driver_peekq(ix, &vsize)) == NULL) {
driver_select(ix, ready_fd, ERL_DRV_WRITE, 0);
+ if (driver_data[fd].terminating)
+ driver_failure_atom(driver_data[fd].port_num,"normal");
return; /* 0; */
}
vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize;
@@ -2389,6 +2514,82 @@ static void stop_select(ErlDrvEvent fd, void* _)
close((int)fd);
}
+#if FDBLOCK
+
+static void
+fd_async(void *async_data)
+{
+ int res;
+ struct driver_data *dd = (struct driver_data*)async_data;
+ SysIOVec *iov0;
+ SysIOVec *iov;
+ int iovlen;
+ int iovcnt;
+ int p;
+ /* much of this code is stolen from efile_drv:invoke_writev */
+ driver_pdl_lock(dd->blocking->pdl);
+ iov0 = driver_peekq(dd->port_num, &iovlen);
+ /* Calculate iovcnt */
+ for (p = 0, iovcnt = 0; iovcnt < iovlen;
+ p += iov0[iovcnt++].iov_len)
+ ;
+ iov = erts_alloc_fnf(ERTS_ALC_T_SYS_WRITE_BUF,
+ sizeof(SysIOVec)*iovcnt);
+ if (!iov) {
+ res = -1;
+ errno = ENOMEM;
+ erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov);
+ driver_pdl_unlock(dd->blocking->pdl);
+ } else {
+ memcpy(iov,iov0,iovcnt*sizeof(SysIOVec));
+ driver_pdl_unlock(dd->blocking->pdl);
+
+ res = writev(dd->ofd, iov, iovlen);
+
+ erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov);
+ }
+ dd->blocking->res = res;
+ dd->blocking->err = errno;
+}
+
+void fd_ready_async(ErlDrvData drv_data,
+ ErlDrvThreadData thread_data) {
+ struct driver_data *dd = (struct driver_data *)thread_data;
+ ErlDrvPort port_num = dd->port_num;
+
+ ASSERT(dd->blocking);
+ ASSERT(dd == (driver_data + (int)(long)drv_data));
+
+ if (dd->blocking->res > 0) {
+ driver_pdl_lock(dd->blocking->pdl);
+ if (driver_deq(port_num, dd->blocking->res) == 0) {
+ driver_pdl_unlock(dd->blocking->pdl);
+ set_busy_port(port_num, 0);
+ if (dd->terminating) {
+ /* The port is has been ordered to terminate
+ from either fd_flush or port_inp_failure */
+ if (dd->terminating == 1)
+ driver_failure_atom(port_num, "normal");
+ else if (dd->terminating == 2)
+ driver_failure_eof(port_num);
+ else if (dd->terminating < 0)
+ driver_failure_posix(port_num, -dd->terminating);
+ return; /* -1; */
+ }
+ } else {
+ driver_pdl_unlock(dd->blocking->pdl);
+ /* still data left to write in queue */
+ driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL);
+ return /* 0; */;
+ }
+ } else if (dd->blocking->res < 0) {
+ driver_failure_posix(port_num, dd->blocking->err);
+ return; /* -1; */
+ }
+ return; /* 0; */
+}
+
+#endif
void erts_do_break_handling(void)
{
@@ -2658,18 +2859,30 @@ void sys_preload_end(Preload* p)
/* Nothing */
}
-/* Read a key from console (?) */
-
+/* Read a key from console, used by break.c
+ Here we assume that all schedulers are stopped so that erl_poll
+ does not interfere with the select below.
+*/
int sys_get_key(fd)
int fd;
{
- int c;
+ int c, ret;
unsigned char rbuf[64];
+ fd_set fds;
fflush(stdout); /* Flush query ??? */
- if ((c = read(fd,rbuf,64)) <= 0) {
- return c;
+ FD_ZERO(&fds);
+ FD_SET(fd,&fds);
+
+ ret = select(fd+1, &fds, NULL, NULL, NULL);
+
+ if (ret == 1) {
+ do {
+ c = read(fd,rbuf,64);
+ } while (c < 0 && errno == EAGAIN);
+ if (c <= 0)
+ return c;
}
return rbuf[0];
diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c
index 0ded6b274e..ae44c8424f 100644
--- a/erts/emulator/sys/win32/sys.c
+++ b/erts/emulator/sys/win32/sys.c
@@ -1392,39 +1392,46 @@ int parse_command(wchar_t* cmd){
return i;
}
-static BOOL need_quotes(wchar_t *str)
-{
- int in_quote = 0;
- int backslashed = 0;
- int naked_space = 0;
- while (*str != L'\0') {
- switch (*str) {
- case L'\\' :
- backslashed = !backslashed;
- break;
- case L'"':
- if (backslashed) {
- backslashed=0;
- } else {
- in_quote = !in_quote;
- }
- break;
- case L' ':
- backslashed = 0;
- if (!(backslashed || in_quote)) {
- naked_space++;
- }
- break;
- default:
- backslashed = 0;
+/*
+ * Translating of command line arguments to correct format. In the examples
+ * below the '' are not part of the actual string.
+ * 'io:format("hello").' -> 'io:format(\"hello\").'
+ * 'io:format("is anybody in there?").' -> '"io:format(\"is anybody in there?\")."'
+ * 'Just nod if you can hear me.' -> '"Just nod if you can hear me."'
+ * 'Is there ""anyone at home?' -> '"Is there \"\"anyone at home?"'
+ * 'Relax."' -> 'Relax.\"'
+ *
+ * If new == NULL we just calculate the length.
+ *
+ * The reason for having to quote all of the is becasue CreateProcessW removes
+ * one level of escaping since it takes a single long command line rather
+ * than the argument chunks that unix uses.
+ */
+static int escape_and_quote(wchar_t *str, wchar_t *new, BOOL *quoted) {
+ int i, j = 0;
+ if (new == NULL)
+ *quoted = FALSE;
+ else if (*quoted)
+ new[j++] = L'"';
+ for ( i = 0; str[i] != L'\0'; i++,j++) {
+ if (str[i] == L' ' && new == NULL && *quoted == FALSE) {
+ *quoted = TRUE;
+ j++;
+ }
+ /* check if we have to escape quotes */
+ if (str[i] == L'"') {
+ if (new) new[j] = L'\\';
+ j++;
}
- ++str;
+ if (new) new[j] = str[i];
}
- return (naked_space > 0);
+ if (*quoted) {
+ if (new) new[j] = L'"';
+ j++;
+ }
+ return j;
}
-
-
/*
*----------------------------------------------------------------------
@@ -1585,31 +1592,24 @@ create_child_process
wcscpy(appname, execPath);
}
if (argv == NULL) {
- BOOL orig_need_q = need_quotes(execPath);
+ BOOL orig_need_q;
wchar_t *ptr;
- int ocl = wcslen(execPath);
+ int ocl = escape_and_quote(execPath, NULL, &orig_need_q);
if (run_cmd) {
newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP,
- (ocl + ((orig_need_q) ? 3 : 1)
- + 11)*sizeof(wchar_t));
+ (ocl + 1 + 11)*sizeof(wchar_t));
memcpy(newcmdline,L"cmd.exe /c ",11*sizeof(wchar_t));
ptr = newcmdline + 11;
} else {
newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP,
- (ocl + ((orig_need_q) ? 3 : 1))*sizeof(wchar_t));
+ (ocl + 1)*sizeof(wchar_t));
ptr = (wchar_t *) newcmdline;
}
- if (orig_need_q) {
- *ptr++ = L'"';
- }
- memcpy(ptr,execPath,ocl*sizeof(wchar_t));
- ptr += ocl;
- if (orig_need_q) {
- *ptr++ = L'"';
- }
- *ptr = L'\0';
+ ptr += escape_and_quote(execPath, ptr, &orig_need_q);
+ ptr[0] = L'\0';
} else {
- int sum = 1; /* '\0' */
+ int sum = 0;
+ BOOL *qte = NULL;
wchar_t **ar = argv;
wchar_t *n;
wchar_t *save_arg0 = NULL;
@@ -1620,11 +1620,13 @@ create_child_process
if (run_cmd) {
sum += 11; /* cmd.exe /c */
}
+
+ while (*ar != NULL) ar++;
+ qte = erts_alloc(ERTS_ALC_T_TMP, (ar - argv)*sizeof(BOOL));
+
+ ar = argv;
while (*ar != NULL) {
- sum += wcslen(*ar);
- if (need_quotes(*ar)) {
- sum += 2; /* quotes */
- }
+ sum += escape_and_quote(*ar,NULL,qte+(ar - argv));
sum++; /* space */
++ar;
}
@@ -1636,26 +1638,18 @@ create_child_process
n += 11;
}
while (*ar != NULL) {
- int q = need_quotes(*ar);
- sum = wcslen(*ar);
- if (q) {
- *n++ = L'"';
- }
- memcpy(n,*ar,sum*sizeof(wchar_t));
- n += sum;
- if (q) {
- *n++ = L'"';
- }
+ n += escape_and_quote(*ar,n,qte+(ar - argv));
*n++ = L' ';
++ar;
}
- *(n-1) = L'\0';
+ *(n-1) = L'\0'; /* overwrite last space with '\0' */
if (save_arg0 != NULL) {
argv[0] = save_arg0;
}
+ erts_free(ERTS_ALC_T_TMP, qte);
}
- DEBUGF(("Creating child process: %s, createFlags = %d\n", newcmdline, createFlags));
+ DEBUGF((stderr,"Creating child process: %S, createFlags = %d\n", newcmdline, createFlags));
ok = CreateProcessW((wchar_t *) appname,
(wchar_t *) newcmdline,
NULL,
diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl
index 8a63d9fe3e..f3986f0c4f 100644
--- a/erts/emulator/test/module_info_SUITE.erl
+++ b/erts/emulator/test/module_info_SUITE.erl
@@ -24,7 +24,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
- exports/1,functions/1,native/1]).
+ exports/1,functions/1,native/1,info/1]).
%%-compile(native).
@@ -52,8 +52,8 @@ end_per_group(_GroupName, Config) ->
Config.
-modules() ->
- [exports, functions, native].
+modules() ->
+ [exports, functions, native, info].
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
Dog = ?t:timetrap(?t:minutes(3)),
@@ -122,6 +122,22 @@ native_proj({Name,Arity,Addr}) ->
native_filter(Set) ->
sofs:no_elements(Set) =/= 1.
+%% Test that the module info of this module is correct. Use
+%% erlang:get_module_info(?MODULE) to avoid compiler optimization tricks.
+info(Config) when is_list(Config) ->
+ Info = erlang:get_module_info(?MODULE),
+ All = all_exported(),
+ {ok,{?MODULE,MD5}} = beam_lib:md5(code:which(?MODULE)),
+ {module, ?MODULE} = lists:keyfind(module, 1, Info),
+ {md5, MD5} = lists:keyfind(md5, 1, Info),
+ {exports, Exports} = lists:keyfind(exports, 1, Info),
+ All = lists:sort(Exports),
+ {attributes, Attrs} = lists:keyfind(attributes, 1, Info),
+ {vsn,_} = lists:keyfind(vsn, 1, Attrs),
+ {compile, Compile} = lists:keyfind(compile, 1, Info),
+ {options,_} = lists:keyfind(options, 1, Compile),
+ ok.
+
%% Helper functions (local).
add_arity(L) ->
diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl
index 8792f25d76..1bb4cb3637 100644
--- a/erts/emulator/test/port_SUITE.erl
+++ b/erts/emulator/test/port_SUITE.erl
@@ -1407,6 +1407,12 @@ spawn_executable(Config) when is_list(Config) ->
run_echo_args(SpaceDir,[ExactFile2,"hello world","dlrow olleh"]),
[ExactFile2,"hello world","dlrow olleh"] =
run_echo_args(SpaceDir,[binary, ExactFile2,"hello world","dlrow olleh"]),
+
+ [ExactFile2,"hello \"world\"","\"dlrow\" olleh"] =
+ run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]),
+ [ExactFile2,"hello \"world\"","\"dlrow\" olleh"] =
+ run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]),
+
[ExactFile2] = run_echo_args(SpaceDir,[default]),
[ExactFile2,"hello world","dlrow olleh"] =
run_echo_args(SpaceDir,[switch_order,ExactFile2,"hello world",
diff --git a/erts/emulator/valgrind/suppress.patched.3.6.0 b/erts/emulator/valgrind/suppress.patched.3.6.0
index b3507bdba7..f79e3ff634 100644
--- a/erts/emulator/valgrind/suppress.patched.3.6.0
+++ b/erts/emulator/valgrind/suppress.patched.3.6.0
@@ -273,6 +273,11 @@ obj:*/ssleay.*
fun:AES_cbc_encrypt
...
}
+{
+ crypto RC4 can do harmless word aligned read past end of input
+ Memcheck:Addr8
+ fun:RC4
+}
{
erts_bits_init_state; Why is this needed?
diff --git a/erts/emulator/valgrind/suppress.standard b/erts/emulator/valgrind/suppress.standard
index a4da31a61d..b3c77119fb 100644
--- a/erts/emulator/valgrind/suppress.standard
+++ b/erts/emulator/valgrind/suppress.standard
@@ -260,6 +260,11 @@ obj:*/ssleay.*
fun:AES_cbc_encrypt
...
}
+{
+ crypto RC4 can do harmless word aligned read past end of input
+ Memcheck:Addr8
+ fun:RC4
+}
{
Prebuilt constant terms in os_info_init (PossiblyLost)
diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c
index 9630e0cdf0..0823dcaa4e 100644
--- a/erts/epmd/src/epmd.c
+++ b/erts/epmd/src/epmd.c
@@ -345,7 +345,7 @@ static void run_daemon(EpmdVars *g)
inform it of that the log is closed. */
closelog();
- /* These chouldn't be needed but for safety... */
+ /* These shouldn't be needed but for safety... */
open("/dev/null", O_RDONLY); /* Order is important! */
open("/dev/null", O_WRONLY);
@@ -386,7 +386,7 @@ static void run_daemon(EpmdVars *g)
close(1);
close(2);
- /* These chouldn't be needed but for safety... */
+ /* These shouldn't be needed but for safety... */
open("nul", O_RDONLY);
open("nul", O_WRONLY);
diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src
index 78fefbea55..aa51eabfc5 100644
--- a/erts/etc/unix/cerl.src
+++ b/erts/etc/unix/cerl.src
@@ -43,6 +43,7 @@
# -gcov Run emulator compiled for gcov
# -valgrind Run emulator compiled for valgrind
# -lcnt Run emulator compiled for lock counting
+# -icount Run emulator compiled for instruction counting
# -nox Unset the DISPLAY variable to disable us of X Windows
#
# FIXME For GDB you can also set the break point using "-break FUNCTION".
@@ -180,6 +181,11 @@ while [ $# -gt 0 ]; do
cargs="$cargs -frmptr"
TYPE=.frmptr
;;
+ "-icount")
+ shift
+ cargs="$cargs -icount"
+ TYPE=.icount
+ ;;
"-dump")
shift
GDB=dump
diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in
index e22771c582..1a723ad936 100644
--- a/erts/etc/unix/etp-commands.in
+++ b/erts/etc/unix/etp-commands.in
@@ -1065,8 +1065,8 @@ define etp-cp-1
set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2
end
if $etp_cp_p
- # 12 = MI_FUNCTIONS
- set $etp_cp_low = (Eterm**)($etp_cp_p->start + 12)
+ # 13 = MI_FUNCTIONS
+ set $etp_cp_low = (Eterm**)($etp_cp_p->start + 13)
# 0 = MI_NUM_FUNCTIONS
set $etp_cp_high = $etp_cp_low +$etp_cp_p->start[0]
set $etp_cp_p = 0
@@ -3481,11 +3481,13 @@ end
define etp-carrier-blocks
set $etp_crr = (Carrier_t*) $arg0
set $etp_alc = (Allctr_t*)($etp_crr->allctr.counter & ~7)
+ set $etp_crr_end = ((char*)$etp_crr + ($etp_crr->chdr & ~7) - (sizeof(void*) & ~8))
set $etp_blk = (Block_t*) ((char*)$etp_crr + $etp_alc->mbc_header_size)
set $etp_prev_blk = 0
set $etp_error_cnt = 0
set $etp_ablk_cnt = 0
set $etp_fblk_cnt = 0
+ set $etp_aborted = 0
if $argc == 2
set $etp_be_silent = $arg1
@@ -3532,14 +3534,21 @@ define etp-carrier-blocks
end
set $etp_prev_blk = $etp_blk
set $etp_blk = (Block_t*) ((char*)$etp_blk + $etp_blk_sz)
+ if $etp_blk < (Block_t*) ((char*)$etp_prev_blk + $etp_alc->min_block_size) || $etp_blk >= $etp_crr_end
+ printf "ERROR: Invalid size of block at %#lx. ABORTING\n", $etp_prev_blk
+ set $etp_aborted = 1
+ loop_break
+ end
end
- if ((char*)$etp_blk + $etp_blk_sz) != ((char*)$etp_crr + ($etp_crr->chdr & ~7))
- printf "ERROR: Last block not at end of carrier\n"
- set $etp_error_cnt = $etp_error_cnt + 1
+ if !$etp_aborted
+ if ((char*)$etp_blk + $etp_blk_sz) != $etp_crr_end
+ printf "ERROR: Last block not at end of carrier\n"
+ set $etp_error_cnt = $etp_error_cnt + 1
+ end
+ printf "Allocated blocks: %u\n", $etp_ablk_cnt
+ printf "Free blocks: %u\n", $etp_fblk_cnt
end
- printf "Allocated blocks: %u\n", $etp_ablk_cnt
- printf "Free blocks: %u\n", $etp_fblk_cnt
if $etp_error_cnt
printf "%u ERRORs reported above\n", $etp-error-cnt
end
diff --git a/erts/lib_src/Makefile.in b/erts/lib_src/Makefile.in
index b680c03b1d..d0ebab49d8 100644
--- a/erts/lib_src/Makefile.in
+++ b/erts/lib_src/Makefile.in
@@ -92,6 +92,11 @@ CFLAGS += -DERTS_FRMPTR
OMIT_OMIT_FP=yes
PRE_LD=
else
+ifeq ($(TYPE),icount)
+TYPE_SUFFIX = .icount
+CFLAGS += -DERTS_OPCODE_COUNTER_SUPPORT
+PRE_LD=
+else
override TYPE=opt
OMIT_FP=true
TYPE_SUFFIX=
@@ -105,6 +110,7 @@ endif
endif
endif
endif
+endif
OPSYS=@OPSYS@
sol2CFLAGS=
diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam
index 001c9c76ed..c8ec111e57 100644
--- a/erts/preloaded/ebin/erl_prim_loader.beam
+++ b/erts/preloaded/ebin/erl_prim_loader.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index 1893dd84ac..d0f9907709 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index b467633a4d..ba45e4e011 100644
--- a/erts/preloaded/ebin/erts_internal.beam
+++ b/erts/preloaded/ebin/erts_internal.beam
Binary files differ
diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam
index 915a2d1aef..26f779500c 100644
--- a/erts/preloaded/ebin/init.beam
+++ b/erts/preloaded/ebin/init.beam
Binary files differ
diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam
index df1bf932a3..4d22d8bace 100644
--- a/erts/preloaded/ebin/otp_ring0.beam
+++ b/erts/preloaded/ebin/otp_ring0.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam
index 95b4bbca2d..efc8347b6e 100644
--- a/erts/preloaded/ebin/prim_eval.beam
+++ b/erts/preloaded/ebin/prim_eval.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam
index 5e4fc5ba84..6c49b5185e 100644
--- a/erts/preloaded/ebin/prim_file.beam
+++ b/erts/preloaded/ebin/prim_file.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam
index 9d9a4886d9..f58ee4b4d5 100644
--- a/erts/preloaded/ebin/prim_inet.beam
+++ b/erts/preloaded/ebin/prim_inet.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam
index d98b0275f4..73be297bbb 100644
--- a/erts/preloaded/ebin/prim_zip.beam
+++ b/erts/preloaded/ebin/prim_zip.beam
Binary files differ
diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam
index 0744bdb21d..193cebdc31 100644
--- a/erts/preloaded/ebin/zlib.beam
+++ b/erts/preloaded/ebin/zlib.beam
Binary files differ
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index 4ba623d921..83a38da26b 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -93,7 +93,7 @@
float_to_list/1, float_to_list/2]).
-export([fun_info/2, fun_info_mfa/1, fun_to_list/1, function_exported/3]).
-export([garbage_collect/0, garbage_collect/1, garbage_collect/2]).
--export([garbage_collect_message_area/0, get/0, get/1, get_keys/1]).
+-export([garbage_collect_message_area/0, get/0, get/1, get_keys/0, get_keys/1]).
-export([get_module_info/1, get_stacktrace/0, group_leader/0]).
-export([group_leader/2, halt/0, halt/1, halt/2, hash/2, hibernate/3]).
-export([insert_element/3]).
@@ -931,6 +931,12 @@ get() ->
get(_Key) ->
erlang:nif_error(undefined).
+%% get_keys/0
+-spec get_keys() -> [Key] when
+ Key :: term().
+get_keys() ->
+ erlang:nif_error(undefined).
+
%% get_keys/1
-spec get_keys(Val) -> [Key] when
Val :: term(),
@@ -1651,7 +1657,7 @@ element(_N, _Tuple) ->
%% Not documented
-spec erlang:get_module_info(Module, Item) -> ModuleInfo when
Module :: atom(),
- Item :: module | imports | exports | functions | attributes | compile | native_addresses,
+ Item :: module | imports | exports | functions | attributes | compile | native_addresses | md5,
ModuleInfo :: atom() | [] | [{atom(), arity()}] | [{atom(), term()}] | [{atom(), arity(), integer()}].
get_module_info(_Module, _Item) ->
erlang:nif_error(undefined).
diff --git a/erts/test/erlc_SUITE_data/src/start_ok.script b/erts/test/erlc_SUITE_data/src/start_ok.script
index 4cd89f0439..7ef97dc3f3 100644
--- a/erts/test/erlc_SUITE_data/src/start_ok.script
+++ b/erts/test/erlc_SUITE_data/src/start_ok.script
@@ -52,7 +52,6 @@
shell_default,
timer,
gen_fsm,
- pg,
unix,
dict,
pool,
@@ -156,7 +155,6 @@
{timer,1},
{gen_fsm,1},
{io_lib_pretty,1},
- {pg,1},
{slave,1},
{unix,1},
{dict,1},
diff --git a/erts/test/upgrade_SUITE.erl b/erts/test/upgrade_SUITE.erl
index d5a920e03d..7b3bc1b063 100644
--- a/erts/test/upgrade_SUITE.erl
+++ b/erts/test/upgrade_SUITE.erl
@@ -237,7 +237,10 @@ do_upgrade(FromVsn,FromApps,ToRel,ToApps,InstallDir) ->
[{"OTP upgrade test",FromVsn,_,permanent}] =
rpc:call(Node,release_handler,which_releases,[]),
- {ok,ToVsn} = rpc:call(Node,release_handler,unpack_release,[ToRel]),
+ ToRelName = filename:basename(ToRel),
+ copy_file(ToRel++".tar.gz",
+ filename:join([InstallDir,releases,ToRelName++".tar.gz"])),
+ {ok,ToVsn} = rpc:call(Node,release_handler,unpack_release,[ToRelName]),
[{"OTP upgrade test",ToVsn,_,unpacked},
{"OTP upgrade test",FromVsn,_,permanent}] =
rpc:call(Node,release_handler,which_releases,[]),
diff --git a/erts/vsn.mk b/erts/vsn.mk
index b6a38f9361..ab98bd4a17 100644
--- a/erts/vsn.mk
+++ b/erts/vsn.mk
@@ -17,7 +17,7 @@
# %CopyrightEnd%
#
-VSN = 6.2
+VSN = 7.0
# Port number 4365 in 4.2
# Port number 4366 in 4.3
diff --git a/lib/common_test/doc/src/ct_master_chapter.xml b/lib/common_test/doc/src/ct_master_chapter.xml
index 37a0805055..adfe79e41a 100644
--- a/lib/common_test/doc/src/ct_master_chapter.xml
+++ b/lib/common_test/doc/src/ct_master_chapter.xml
@@ -198,7 +198,7 @@
<section>
<title>Automatic startup of test target nodes</title>
<marker id="ct_slave"></marker>
- <p>Is is possible to automatically start, and perform initial actions, on
+ <p>It is possible to automatically start, and perform initial actions, on
test target nodes by using the test specification term <c>init</c>.</p>
<p>Currently, two sub-terms are supported, <c>node_start</c> and <c>eval</c>.</p>
<p>Example:</p>
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile
index 8d74546880..2723b066f0 100644
--- a/lib/common_test/src/Makefile
+++ b/lib/common_test/src/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2003-2013. All Rights Reserved.
+# Copyright Ericsson AB 2003-2014. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -75,7 +75,8 @@ MODULES= \
ct_conn_log_h \
cth_conn_log \
ct_groups \
- ct_property_test
+ ct_property_test \
+ ct_release_test
TARGET_MODULES= $(MODULES:%=$(EBIN)/%)
BEAM_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl
index a3861dc745..2f66c7613c 100644
--- a/lib/common_test/src/ct_netconfc.erl
+++ b/lib/common_test/src/ct_netconfc.erl
@@ -190,6 +190,7 @@
get_config/4,
edit_config/3,
edit_config/4,
+ edit_config/5,
delete_config/2,
delete_config/3,
copy_config/3,
@@ -678,15 +679,39 @@ get_config(Client, Source, Filter, Timeout) ->
%%----------------------------------------------------------------------
%% @spec edit_config(Client, Target, Config) -> Result
-%% @equiv edit_config(Client, Target, Config, infinity)
+%% @equiv edit_config(Client, Target, Config, [], infinity)
edit_config(Client, Target, Config) ->
edit_config(Client, Target, Config, ?DEFAULT_TIMEOUT).
%%----------------------------------------------------------------------
--spec edit_config(Client, Target, Config, Timeout) -> Result when
+-spec edit_config(Client, Target, Config, OptParamsOrTimeout) -> Result when
Client :: client(),
Target :: netconf_db(),
Config :: simple_xml(),
+ OptParamsOrTimeout :: [simple_xml()] | timeout(),
+ Result :: ok | {error,error_reason()}.
+%% @doc
+%%
+%% If `OptParamsOrTimeout' is a timeout value, then this is
+%% equivalent to {@link edit_config/5. edit_config(Client, Target,
+%% Config, [], Timeout)}.
+%%
+%% If `OptParamsOrTimeout' is a list of simple XML, then this is
+%% equivalent to {@link edit_config/5. edit_config(Client, Target,
+%% Config, OptParams, infinity)}.
+%%
+%% @end
+edit_config(Client, Target, Config, Timeout) when ?is_timeout(Timeout) ->
+ edit_config(Client, Target, Config, [], Timeout);
+edit_config(Client, Target, Config, OptParams) when is_list(OptParams) ->
+ edit_config(Client, Target, Config, OptParams, ?DEFAULT_TIMEOUT).
+
+%%----------------------------------------------------------------------
+-spec edit_config(Client, Target, Config, OptParams, Timeout) -> Result when
+ Client :: client(),
+ Target :: netconf_db(),
+ Config :: simple_xml(),
+ OptParams :: [simple_xml()],
Timeout :: timeout(),
Result :: ok | {error,error_reason()}.
%% @doc Edit configuration data.
@@ -695,10 +720,20 @@ edit_config(Client, Target, Config) ->
%% include `:candidate' or `:startup' in its list of
%% capabilities.
%%
+%% `OptParams' can be used for specifying optional parameters
+%% (`default-operation', `test-option' or `error-option') that will be
+%% added to the `edit-config' request. The value must be a list
+%% containing valid simple XML, for example
+%%
+%% ```
+%% [{'default-operation', ["none"]},
+%% {'error-option', ["rollback-on-error"]}]
+%%'''
+%%
%% @end
%%----------------------------------------------------------------------
-edit_config(Client, Target, Config, Timeout) ->
- call(Client, {send_rpc_op, edit_config, [Target,Config], Timeout}).
+edit_config(Client, Target, Config, OptParams, Timeout) ->
+ call(Client, {send_rpc_op, edit_config, [Target,Config,OptParams], Timeout}).
%%----------------------------------------------------------------------
@@ -1086,6 +1121,7 @@ handle_msg({get_event_streams=Op,Streams,Timeout}, From, State) ->
SimpleXml = encode_rpc_operation(get,[Filter]),
do_send_rpc(Op, SimpleXml, Timeout, From, State).
+%% @private
handle_msg({ssh_cm, CM, {data, Ch, _Type, Data}}, State) ->
ssh_connection:adjust_window(CM,Ch,size(Data)),
handle_data(Data, State);
@@ -1234,8 +1270,8 @@ encode_rpc_operation(get,[Filter]) ->
{get,filter(Filter)};
encode_rpc_operation(get_config,[Source,Filter]) ->
{'get-config',[{source,[Source]}] ++ filter(Filter)};
-encode_rpc_operation(edit_config,[Target,Config]) ->
- {'edit-config',[{target,[Target]},{config,[Config]}]};
+encode_rpc_operation(edit_config,[Target,Config,OptParams]) ->
+ {'edit-config',[{target,[Target]}] ++ OptParams ++ [{config,[Config]}]};
encode_rpc_operation(delete_config,[Target]) ->
{'delete-config',[{target,[Target]}]};
encode_rpc_operation(copy_config,[Target,Source]) ->
@@ -1707,6 +1743,7 @@ log(#connection{host=Host,port=Port,name=Name},Action,Data) ->
%% Log callback - called from the error handler process
+%% @private
format_data(How,Data) ->
%% Assuming that the data is encoded as UTF-8. If it is not, then
%% the printout might be wrong, but the format function will not
diff --git a/lib/common_test/src/ct_release_test.erl b/lib/common_test/src/ct_release_test.erl
new file mode 100644
index 0000000000..eb9e9c832f
--- /dev/null
+++ b/lib/common_test/src/ct_release_test.erl
@@ -0,0 +1,847 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%-----------------------------------------------------------------
+%% @doc EXPERIMENTAL support for testing of upgrade.
+%%
+%% This is a library module containing support for test of release
+%% related activities in one or more applications. Currenty it
+%% supports upgrade only.
+%%
+%% == Configuration ==
+%%
+%% In order to find version numbers of applications to upgrade from,
+%% `{@module}' needs to access and start old OTP
+%% releases. A `common_test' configuration file can be used for
+%% specifying the location of such releases, for example:
+%%
+%% ```
+%% %% old-rels.cfg
+%% {otp_releases,[{r16b,"/path/to/R16B03-1/bin/erl"},
+%% {'17',"/path/to/17.3/bin/erl"}]}.'''
+%%
+%% The configuration file should preferably point out the latest patch
+%% level on each major release.
+%%
+%% If no such configuration file is given, {@link init/1} will return
+%% `{skip,Reason}' and any attempt at running {@link upgrade/4}
+%% will fail.
+%%
+%% == Callback functions ==
+%%
+%% The following functions should be exported from a {@module}
+%% callback module.
+%%
+%% All callback functions are called on the node where the upgrade is
+%% executed.
+%%
+%% <dl>
+%% <dt>Module:upgrade_init(State) -> NewState</dt>
+%% <dd>Types:
+%%
+%% <b><c>State = NewState = cb_state()</c></b>
+%%
+%% Initialyze system before upgrade test starts.
+%%
+%% This function is called before the upgrade is started. All
+%% applications given in {@link upgrade/4} are already started by
+%% the boot script, so this callback is intended for additional
+%% initialization, if necessary.
+%%
+%% Example:
+%%
+%% ```
+%% upgrade_init(State) ->
+%% open_connection(State).'''
+%% </dd>
+%%
+%% <dt>Module:upgrade_upgraded(State) -> NewState</dt>
+%% <dd>Types:
+%%
+%% <b><c>State = NewState = cb_state()</c></b>
+%%
+%% Check that upgrade was successful.
+%%
+%% This function is called after the release_handler has
+%% successfully unpacked and installed the new release, and it has
+%% been made permanent. It allows application specific checks to
+%% ensure that the upgrade was successful.
+%%
+%% Example:
+%%
+%% ```
+%% upgrade_upgraded(State) ->
+%% check_connection_still_open(State).'''
+%% </dd>
+%%
+%% <dt>Module:upgrade_downgraded(State) -> NewState</dt>
+%% <dd>Types:
+%%
+%% <b><c>State = NewState = cb_state()</c></b>
+%%
+%% Check that downgrade was successful.
+%%
+%% This function is called after the release_handler has
+%% successfully re-installed the original release, and it has been
+%% made permanent. It allows application specific checks to ensure
+%% that the downgrade was successful.
+%%
+%% Example:
+%%
+%% ```
+%% upgrade_init(State) ->
+%% check_connection_closed(State).'''
+%% </dd>
+%% </dl>
+%% @end
+%%-----------------------------------------------------------------
+-module(ct_release_test).
+
+-export([init/1, upgrade/4, cleanup/1]).
+
+-include_lib("kernel/include/file.hrl").
+
+%%-----------------------------------------------------------------
+-define(testnode, otp_upgrade).
+-define(exclude_apps, [hipe, typer, dialyzer]). % never include these apps
+
+%%-----------------------------------------------------------------
+-type config() :: [{atom(),term()}].
+-type cb_state() :: term().
+
+-callback upgrade_init(cb_state()) -> cb_state().
+-callback upgrade_upgraded(cb_state()) -> cb_state().
+-callback upgrade_downgraded(cb_state()) -> cb_state().
+
+%%-----------------------------------------------------------------
+-spec init(Config) -> Result when
+ Config :: config(),
+ Result :: config() | SkipOrFail,
+ SkipOrFail :: {skip,Reason} | {fail,Reason}.
+%% @doc Initialize `{@module}'.
+%%
+%% This function can be called from any of the
+%% `init_per_*' functions in the test suite. It updates
+%% the given `Config' with data that will be
+%% used by future calls to other functions in this module. The
+%% returned configuration must therefore also be returned from
+%% the calling `init_per_*'.
+%%
+%% If the initialization fails, e.g. if a required release can
+%% not be found, the function returns `{skip,Reason}'. In
+%% this case the other test support functions in this mudule
+%% can not be used.
+%%
+%% Example:
+%%
+%% ```
+%% init_per_suite(Config) ->
+%% ct_release_test:init(Config).'''
+%%
+init(Config) ->
+ try init_upgrade_test() of
+ {Major,Minor} ->
+ [{release_test,[{major,Major},{minor,Minor}]} | Config]
+ catch throw:Thrown ->
+ Thrown
+ end.
+
+%%-----------------------------------------------------------------
+-spec upgrade(App,Level,Callback,Config) -> any() when
+ App :: atom(),
+ Level :: minor | major,
+ Callback :: {module(),InitState},
+ InitState :: cb_state(),
+ Config :: config();
+ (Apps,Level,Callback,Config) -> any() when
+ Apps :: [App],
+ App :: atom(),
+ Level :: minor | major,
+ Callback :: {module(),InitState},
+ InitState :: cb_state(),
+ Config :: config().
+%% @doc Test upgrade of the given application(s).
+%%
+%% This function can be called from a test case. It requires that
+%% `Config' has been initialized by calling {@link
+%% init/1} prior to this, for example from `init_per_suite/1'.
+%%
+%% Upgrade tests are performed as follows:
+%%
+%% <ol>
+%% <li>Figure out which OTP release to test upgrade
+%% from. Start a node running that release and find the
+%% application versions on that node. Terminate the
+%% node.</li>
+%% <li>Figure out all dependencies for the applications under
+%% test.</li>
+%% <li>Create a release containing the core
+%% applications `kernel', `stdlib' and `sasl'
+%% in addition to the application(s) under test and all
+%% dependencies of these. The versions of the applications
+%% under test will be the ones found on the OTP release to
+%% upgrade from. The versions of all other applications will
+%% be those found on the current node, i.e. the common_test
+%% node. This is the "From"-release.</li>
+%% <li>Create another release containing the same
+%% applications as in the previous step, but with all
+%% application versions taken from the current node. This is
+%% the "To"-release.</li>
+%% <li>Install the "From"-release and start a new node
+%% running this release.</li>
+%% <li>Perform the upgrade test and allow customized
+%% control by using callbacks:
+%% <ol>
+%% <li>Callback: `upgrade_init/1'</li>
+%% <li>Unpack the new release</li>
+%% <li>Install the new release</li>
+%% <li>Callback: `upgrade_upgraded/1'</li>
+%% <li>Install the original release</li>
+%% <li>Callback: `upgrade_downgraded/1'</li>
+%% </ol>
+%% </li>
+%% </ol>
+%%
+%% `App' or `Apps'
+%% specifies the applications under test, i.e. the applications
+%% which shall be upgraded. All other applications that are
+%% included have the same releases in the "From"- and
+%% "To"-releases and will therefore not be upgraded.
+%%
+%% `Level' specifies which OTP release to
+%% pick the "From" versions from.
+%% <dl>
+%% <dt>major</dt>
+%% <dd>From verions are picked from the previous major
+%% release. For example, if the test is run on an OTP-17
+%% node, `{@module}' will pick the application
+%% "From" versions from an OTP installation running OTP
+%% R16B.</dd>
+%%
+%% <dt>minor</dt>
+%% <dd>From verions are picked from the current major
+%% release. For example, if the test is run on an OTP-17
+%% node, `{@module}' will pick the application
+%% "From" versions from an OTP installation running an
+%% earlier patch level of OTP-17.</dd>
+%% </dl>
+%%
+%% The application "To" versions are allways picked from the
+%% current node, i.e. the common_test node.
+%%
+%% `Callback' specifies the module (normally the
+%% test suite) which implements the {@section Callback functions}, and
+%% the initial value of the `State' variable used in these
+%% functions.
+%%
+%% `Config' is the input argument received
+%% in the test case function.
+%%
+%% Example:
+%%
+%% ```
+%% minor_upgrade(Config) ->
+%% ct_release_test:upgrade(ssl,minor,{?MODULE,[]},Config).
+%% '''
+%%
+upgrade(App,Level,Callback,Config) when is_atom(App) ->
+ upgrade([App],Level,Callback,Config);
+upgrade(Apps,Level,Callback,Config) ->
+ Dir = proplists:get_value(priv_dir,Config),
+ CreateDir = filename:join([Dir,Level,create]),
+ InstallDir = filename:join([Dir,Level,install]),
+ ok = filelib:ensure_dir(filename:join(CreateDir,"*")),
+ ok = filelib:ensure_dir(filename:join(InstallDir,"*")),
+ try upgrade(Apps,Level,Callback,CreateDir,InstallDir,Config) of
+ ok ->
+ %%rm_rf(CreateDir),
+ Tars = filelib:wildcard(filename:join(CreateDir,"*.tar.gz")),
+ _ = [file:delete(Tar) || Tar <- Tars],
+ rm_rf(InstallDir),
+ ok
+ catch throw:{fail,Reason} ->
+ ct:fail(Reason);
+ throw:{skip,Reason} ->
+ rm_rf(CreateDir),
+ rm_rf(InstallDir),
+ {skip,Reason}
+ after
+ %% Brutally kill all nodes that erroneously survived the test.
+ %% Note, we will not reach this if the test fails with a
+ %% timetrap timeout in the test suite! Thus we can have
+ %% hanging nodes...
+ Nodes = nodes(),
+ [rpc:call(Node,erlang,halt,[]) || Node <- Nodes]
+ end.
+
+%%-----------------------------------------------------------------
+-spec cleanup(Config) -> Result when
+ Config :: config(),
+ Result :: config().
+%% @doc Clean up after tests.
+%%
+%% This function shall be called from the `end_per_*' function
+%% complementing the `init_per_*' function where {@link init/1}
+%% is called.
+%%
+%% It cleans up after the test, for example kills hanging
+%% nodes.
+%%
+%% Example:
+%%
+%% ```
+%% end_per_suite(Config) ->
+%% ct_release_test:cleanup(Config).'''
+%%
+cleanup(Config) ->
+ Nodes = [node_name(?testnode)|nodes()],
+ [rpc:call(Node,erlang,halt,[]) || Node <- Nodes],
+ Config.
+
+%%-----------------------------------------------------------------
+init_upgrade_test() ->
+ %% Check that a real release is running, not e.g. cerl
+ ok = application:ensure_started(sasl),
+ case release_handler:which_releases() of
+ [{_,_,[],_}] ->
+ %% Fake release, no applications
+ throw({skip, "Need a real release running to create other releases"});
+ _ ->
+ Major = init_upgrade_test(major),
+ Minor = init_upgrade_test(minor),
+ {Major,Minor}
+ end.
+
+init_upgrade_test(Level) ->
+ {FromVsn,ToVsn} = get_rels(Level),
+ OldRel =
+ case test_server:is_release_available(FromVsn) of
+ true ->
+ {release,FromVsn};
+ false ->
+ case ct:get_config({otp_releases,list_to_atom(FromVsn)}) of
+ undefined ->
+ false;
+ Prog0 ->
+ case os:find_executable(Prog0) of
+ false ->
+ false;
+ Prog ->
+ {prog,Prog}
+ end
+ end
+ end,
+ case OldRel of
+ false ->
+ ct:log("Release ~p is not available."
+ " Upgrade on '~p' level can not be tested.",
+ [FromVsn,Level]),
+ undefined;
+ _ ->
+ init_upgrade_test(FromVsn,ToVsn,OldRel)
+ end.
+
+get_rels(major) ->
+ %% Given that the current major release is X, then this is an
+ %% upgrade from major release X-1 to the current release.
+ Current = erlang:system_info(otp_release),
+ PreviousMajor = previous_major(Current),
+ {PreviousMajor,Current};
+get_rels(minor) ->
+ %% Given that this is a (possibly) patched version of major
+ %% release X, then this is an upgrade from major release X to the
+ %% current release.
+ CurrentMajor = erlang:system_info(otp_release),
+ Current = CurrentMajor++"_patched",
+ {CurrentMajor,Current}.
+
+init_upgrade_test(FromVsn,ToVsn,OldRel) ->
+ OtpRel = list_to_atom("otp-"++FromVsn),
+ ct:log("Starting node to fetch application versions to upgrade from"),
+ {ok,Node} = test_server:start_node(OtpRel,peer,[{erl,[OldRel]}]),
+ {Apps,Path} = fetch_all_apps(Node),
+ test_server:stop_node(Node),
+ {FromVsn,ToVsn,Apps,Path}.
+
+fetch_all_apps(Node) ->
+ Paths = rpc:call(Node,code,get_path,[]),
+ %% Find all possible applications in the path
+ AppFiles =
+ lists:flatmap(
+ fun(P) ->
+ filelib:wildcard(filename:join(P,"*.app"))
+ end,
+ Paths),
+ %% Figure out which version of each application is running on this
+ %% node. Using application:load and application:get_key instead of
+ %% reading the .app files since there might be multiple versions
+ %% of a .app file and we only want the one that is actually
+ %% running.
+ AppVsns =
+ lists:flatmap(
+ fun(F) ->
+ A = list_to_atom(filename:basename(filename:rootname(F))),
+ _ = rpc:call(Node,application,load,[A]),
+ case rpc:call(Node,application,get_key,[A,vsn]) of
+ {ok,V} -> [{A,V}];
+ _ -> []
+ end
+ end,
+ AppFiles),
+ ErtsVsn = rpc:call(Node, erlang, system_info, [version]),
+ {[{erts,ErtsVsn}|AppVsns], Paths}.
+
+
+%%-----------------------------------------------------------------
+upgrade(Apps,Level,Callback,CreateDir,InstallDir,Config) ->
+ ct:log("Test upgrade of the following applications: ~p",[Apps]),
+ ct:log(".rel files and start scripts are created in:~n~ts",[CreateDir]),
+ ct:log("The release is installed in:~n~ts",[InstallDir]),
+ case proplists:get_value(release_test,Config) of
+ undefined ->
+ throw({fail,"ct_release_test:init/1 not run"});
+ RTConfig ->
+ case proplists:get_value(Level,RTConfig) of
+ undefined ->
+ throw({skip,"Old release not available"});
+ Data ->
+ {FromVsn,FromRel,FromAppsVsns} =
+ target_system(Apps, CreateDir, InstallDir, Data),
+ {ToVsn,ToRel,ToAppsVsns} =
+ upgrade_system(Apps, FromRel, CreateDir,
+ InstallDir, Data),
+ ct:log("Upgrade from: OTP-~ts, ~p",[FromVsn, FromAppsVsns]),
+ ct:log("Upgrade to: OTP-~ts, ~p",[ToVsn, ToAppsVsns]),
+ do_upgrade(Callback, FromVsn, FromAppsVsns, ToRel,
+ ToAppsVsns, InstallDir)
+ end
+ end.
+
+%%% This is similar to sasl/examples/src/target_system.erl, but with
+%%% the following adjustments:
+%%% - add a log directory
+%%% - use an own 'start' script
+%%% - chmod 'start' and 'start_erl'
+target_system(Apps,CreateDir,InstallDir,{FromVsn,_,AllAppsVsns,Path}) ->
+ RelName0 = "otp-"++FromVsn,
+
+ AppsVsns = [{A,V} || {A,V} <- AllAppsVsns, lists:member(A,Apps)],
+ {RelName,ErtsVsn} = create_relfile(AppsVsns,CreateDir,RelName0,FromVsn),
+
+ %% Create .script and .boot
+ ok = systools(make_script,[RelName,[{path,Path}]]),
+
+ %% Create base tar file - i.e. erts and all apps
+ ok = systools(make_tar,[RelName,[{erts,code:root_dir()},
+ {path,Path}]]),
+
+ %% Unpack the tar to complete the installation
+ erl_tar:extract(RelName ++ ".tar.gz", [{cwd, InstallDir}, compressed]),
+
+ %% Add bin and log dirs
+ BinDir = filename:join([InstallDir, "bin"]),
+ file:make_dir(BinDir),
+ file:make_dir(filename:join(InstallDir,"log")),
+
+ %% Delete start scripts - they will be added later
+ ErtsBinDir = filename:join([InstallDir, "erts-" ++ ErtsVsn, "bin"]),
+ file:delete(filename:join([ErtsBinDir, "erl"])),
+ file:delete(filename:join([ErtsBinDir, "start"])),
+ file:delete(filename:join([ErtsBinDir, "start_erl"])),
+
+ %% Copy .boot to bin/start.boot
+ copy_file(RelName++".boot",filename:join([BinDir, "start.boot"])),
+
+ %% Copy scripts from erts-xxx/bin to bin
+ copy_file(filename:join([ErtsBinDir, "epmd"]),
+ filename:join([BinDir, "epmd"]), [preserve]),
+ copy_file(filename:join([ErtsBinDir, "run_erl"]),
+ filename:join([BinDir, "run_erl"]), [preserve]),
+ copy_file(filename:join([ErtsBinDir, "to_erl"]),
+ filename:join([BinDir, "to_erl"]), [preserve]),
+
+ %% create start_erl.data, sys.config and start.src
+ StartErlData = filename:join([InstallDir, "releases", "start_erl.data"]),
+ write_file(StartErlData, io_lib:fwrite("~s ~s~n", [ErtsVsn, FromVsn])),
+ SysConfig = filename:join([InstallDir, "releases", FromVsn, "sys.config"]),
+ write_file(SysConfig, "[]."),
+ StartSrc = filename:join(ErtsBinDir,"start.src"),
+ write_file(StartSrc,start_script()),
+ ok = file:change_mode(StartSrc,8#0755),
+
+ %% Make start_erl executable
+ %% (this has been fixed in OTP 17 - it is now installed with
+ %% $INSTALL_SCRIPT instead of $INSTALL_DATA and should therefore
+ %% be executable from the start)
+ ok = file:change_mode(filename:join(ErtsBinDir,"start_erl.src"),8#0755),
+
+ %% Substitute variables in erl.src, start.src and start_erl.src
+ %% (.src found in erts-xxx/bin - result stored in bin)
+ subst_src_scripts(["erl", "start", "start_erl"], ErtsBinDir, BinDir,
+ [{"FINAL_ROOTDIR", InstallDir}, {"EMU", "beam"}],
+ [preserve]),
+
+ %% Create RELEASES
+ RelFile = filename:join([InstallDir, "releases",
+ filename:basename(RelName) ++ ".rel"]),
+ release_handler:create_RELEASES(InstallDir, RelFile),
+
+ {FromVsn, RelName,AppsVsns}.
+
+systools(Func,Args) ->
+ case apply(systools,Func,Args) of
+ ok ->
+ ok;
+ error ->
+ throw({fail,{systools,Func,Args}})
+ end.
+
+%%% This is a copy of $ROOT/erts-xxx/bin/start.src, modified to add
+%%% sname and heart
+start_script() ->
+ ["#!/bin/sh\n"
+ "ROOTDIR=%FINAL_ROOTDIR%\n"
+ "\n"
+ "if [ -z \"$RELDIR\" ]\n"
+ "then\n"
+ " RELDIR=$ROOTDIR/releases\n"
+ "fi\n"
+ "\n"
+ "START_ERL_DATA=${1:-$RELDIR/start_erl.data}\n"
+ "\n"
+ "$ROOTDIR/bin/run_erl -daemon /tmp/ $ROOTDIR/log \"exec $ROOTDIR/bin/start_erl $ROOTDIR $RELDIR $START_ERL_DATA -sname ",atom_to_list(?testnode)," -heart\"\n"].
+
+%%% Create a release containing the current (the test node) OTP
+%%% release, including relup to allow upgrade from an earlier OTP
+%%% release.
+upgrade_system(Apps, FromRel, CreateDir, InstallDir, {_,ToVsn,_,_}) ->
+ ct:log("Generating release to upgrade to."),
+
+ RelName0 = "otp-"++ToVsn,
+
+ AppsVsns = get_vsns(Apps),
+ {RelName,_} = create_relfile(AppsVsns,CreateDir,RelName0,ToVsn),
+ FromPath = filename:join([InstallDir,lib,"*",ebin]),
+
+ ok = systools(make_script,[RelName]),
+ ok = systools(make_relup,[RelName,[FromRel],[FromRel],
+ [{path,[FromPath]},
+ {outdir,CreateDir}]]),
+ SysConfig = filename:join([CreateDir, "sys.config"]),
+ write_file(SysConfig, "[]."),
+
+ ok = systools(make_tar,[RelName,[{erts,code:root_dir()}]]),
+
+ {ToVsn, RelName,AppsVsns}.
+
+%%% Start a new node running the release from target_system/6
+%%% above. Then upgrade to the system from upgrade_system/6.
+do_upgrade({Cb,InitState},FromVsn,FromAppsVsns,ToRel,ToAppsVsns,InstallDir) ->
+ ct:log("Upgrade test attempting to start node.~n"
+ "If test fails, logs can be found in:~n~ts",
+ [filename:join(InstallDir,log)]),
+ Start = filename:join([InstallDir,bin,start]),
+ {ok,Node} = start_node(Start,FromVsn,FromAppsVsns),
+
+ ct:log("Node started: ~p",[Node]),
+ State1 = do_callback(Node,Cb,upgrade_init,InitState),
+
+ [{"OTP upgrade test",FromVsn,_,permanent}] =
+ rpc:call(Node,release_handler,which_releases,[]),
+ ToRelName = filename:basename(ToRel),
+ copy_file(ToRel++".tar.gz",
+ filename:join([InstallDir,releases,ToRelName++".tar.gz"])),
+ ct:log("Unpacking new release"),
+ {ok,ToVsn} = rpc:call(Node,release_handler,unpack_release,[ToRelName]),
+ [{"OTP upgrade test",ToVsn,_,unpacked},
+ {"OTP upgrade test",FromVsn,_,permanent}] =
+ rpc:call(Node,release_handler,which_releases,[]),
+ ct:log("Installing new release"),
+ case rpc:call(Node,release_handler,install_release,[ToVsn]) of
+ {ok,FromVsn,_} ->
+ ok;
+ {continue_after_restart,FromVsn,_} ->
+ ct:log("Waiting for node restart")
+ end,
+ %% even if install_release returned {ok,...} there might be an
+ %% emulator restart (instruction restart_emulator), so we must
+ %% always make sure the node is running.
+ wait_node_up(current,ToVsn,ToAppsVsns),
+
+ [{"OTP upgrade test",ToVsn,_,current},
+ {"OTP upgrade test",FromVsn,_,permanent}] =
+ rpc:call(Node,release_handler,which_releases,[]),
+ ct:log("Permanenting new release"),
+ ok = rpc:call(Node,release_handler,make_permanent,[ToVsn]),
+ [{"OTP upgrade test",ToVsn,_,permanent},
+ {"OTP upgrade test",FromVsn,_,old}] =
+ rpc:call(Node,release_handler,which_releases,[]),
+
+ State2 = do_callback(Node,Cb,upgrade_upgraded,State1),
+
+ ct:log("Re-installing old release"),
+ case rpc:call(Node,release_handler,install_release,[FromVsn]) of
+ {ok,FromVsn,_} ->
+ ok;
+ {continue_after_restart,FromVsn,_} ->
+ ct:log("Waiting for node restart")
+ end,
+ %% even if install_release returned {ok,...} there might be an
+ %% emulator restart (instruction restart_emulator), so we must
+ %% always make sure the node is running.
+ wait_node_up(current,FromVsn,FromAppsVsns),
+
+ [{"OTP upgrade test",ToVsn,_,permanent},
+ {"OTP upgrade test",FromVsn,_,current}] =
+ rpc:call(Node,release_handler,which_releases,[]),
+ ct:log("Permanenting old release"),
+ ok = rpc:call(Node,release_handler,make_permanent,[FromVsn]),
+ [{"OTP upgrade test",ToVsn,_,old},
+ {"OTP upgrade test",FromVsn,_,permanent}] =
+ rpc:call(Node,release_handler,which_releases,[]),
+
+ _State3 = do_callback(Node,Cb,upgrade_downgraded,State2),
+
+ ct:log("Terminating node ~p",[Node]),
+ erlang:monitor_node(Node,true),
+ _ = rpc:call(Node,init,stop,[]),
+ receive {nodedown,Node} -> ok end,
+ ct:log("Node terminated"),
+
+ ok.
+
+do_callback(Node,Mod,Func,State) ->
+ Dir = filename:dirname(code:which(Mod)),
+ _ = rpc:call(Node,code,add_path,[Dir]),
+ ct:log("Calling ~p:~p/1",[Mod,Func]),
+ R = rpc:call(Node,Mod,Func,[State]),
+ ct:log("~p:~p/1 returned: ~p",[Mod,Func,R]),
+ case R of
+ {badrpc,Error} ->
+ test_server:fail({test_upgrade_callback,Mod,Func,State,Error});
+ NewState ->
+ NewState
+ end.
+
+%%% Library functions
+previous_major("17") ->
+ "r16b";
+previous_major(Rel) ->
+ integer_to_list(list_to_integer(Rel)-1).
+
+create_relfile(AppsVsns,CreateDir,RelName0,RelVsn) ->
+ UpgradeAppsVsns = [{A,V,restart_type(A)} || {A,V} <- AppsVsns],
+
+ CoreAppVsns0 = get_vsns([kernel,stdlib,sasl]),
+ CoreAppVsns =
+ [{A,V,restart_type(A)} || {A,V} <- CoreAppVsns0,
+ false == lists:keymember(A,1,AppsVsns)],
+
+ Apps = [App || {App,_} <- AppsVsns],
+ StartDepsVsns = get_start_deps(Apps,CoreAppVsns),
+ StartApps = [StartApp || {StartApp,_,_} <- StartDepsVsns] ++ Apps,
+
+ {RuntimeDepsVsns,_} = get_runtime_deps(StartApps,StartApps,[],[]),
+
+ AllAppsVsns0 = StartDepsVsns ++ UpgradeAppsVsns ++ RuntimeDepsVsns,
+
+ %% Should test tools really be included? Some library functions
+ %% here could be used by callback, but not everything since
+ %% processes of these applications will not be running.
+ TestToolAppsVsns0 = get_vsns([test_server,common_test]),
+ TestToolAppsVsns =
+ [{A,V,none} || {A,V} <- TestToolAppsVsns0,
+ false == lists:keymember(A,1,AllAppsVsns0)],
+
+ AllAppsVsns1 = AllAppsVsns0 ++ TestToolAppsVsns,
+ AllAppsVsns = [AV || AV={A,_,_} <- AllAppsVsns1,
+ false == lists:member(A,?exclude_apps)],
+
+ ErtsVsn = erlang:system_info(version),
+
+ %% Create the .rel file
+ RelContent = {release,{"OTP upgrade test",RelVsn},{erts,ErtsVsn},AllAppsVsns},
+ RelName = filename:join(CreateDir,RelName0),
+ RelFile = RelName++".rel",
+ {ok,Fd} = file:open(RelFile,[write,{encoding,utf8}]),
+ io:format(Fd,"~tp.~n",[RelContent]),
+ ok = file:close(Fd),
+ {RelName,ErtsVsn}.
+
+get_vsns(Apps) ->
+ [begin
+ _ = application:load(A),
+ {ok,V} = application:get_key(A,vsn),
+ {A,V}
+ end || A <- Apps].
+
+get_start_deps([App|Apps],Acc) ->
+ _ = application:load(App),
+ {ok,StartDeps} = application:get_key(App,applications),
+ StartDepsVsns =
+ [begin
+ _ = application:load(StartApp),
+ {ok,StartVsn} = application:get_key(StartApp,vsn),
+ {StartApp,StartVsn,restart_type(StartApp)}
+ end || StartApp <- StartDeps,
+ false == lists:keymember(StartApp,1,Acc)],
+ DepsStartDeps = get_start_deps(StartDeps,Acc ++ StartDepsVsns),
+ get_start_deps(Apps,DepsStartDeps);
+get_start_deps([],Acc) ->
+ Acc.
+
+get_runtime_deps([App|Apps],StartApps,Acc,Visited) ->
+ case lists:member(App,Visited) of
+ true ->
+ get_runtime_deps(Apps,StartApps,Acc,Visited);
+ false ->
+ %% runtime_dependencies should be possible to read with
+ %% application:get_key/2, but still isn't so we need to
+ %% read the .app file...
+ AppFile = code:where_is_file(atom_to_list(App) ++ ".app"),
+ {ok,[{application,App,Attrs}]} = file:consult(AppFile),
+ RuntimeDeps =
+ lists:flatmap(
+ fun(Str) ->
+ [RuntimeAppStr,_] = string:tokens(Str,"-"),
+ RuntimeApp = list_to_atom(RuntimeAppStr),
+ case {lists:keymember(RuntimeApp,1,Acc),
+ lists:member(RuntimeApp,StartApps)} of
+ {false,false} when RuntimeApp=/=erts ->
+ [RuntimeApp];
+ _ ->
+ []
+ end
+ end,
+ proplists:get_value(runtime_dependencies,Attrs,[])),
+ RuntimeDepsVsns =
+ [begin
+ _ = application:load(RuntimeApp),
+ {ok,RuntimeVsn} = application:get_key(RuntimeApp,vsn),
+ {RuntimeApp,RuntimeVsn,none}
+ end || RuntimeApp <- RuntimeDeps],
+ {DepsRuntimeDeps,NewVisited} =
+ get_runtime_deps(RuntimeDeps,StartApps,Acc++RuntimeDepsVsns,[App|Visited]),
+ get_runtime_deps(Apps,StartApps,DepsRuntimeDeps,NewVisited)
+ end;
+get_runtime_deps([],_,Acc,Visited) ->
+ {Acc,Visited}.
+
+restart_type(App) when App==kernel; App==stdlib; App==sasl ->
+ permanent;
+restart_type(_) ->
+ temporary.
+
+copy_file(Src, Dest) ->
+ copy_file(Src, Dest, []).
+
+copy_file(Src, Dest, Opts) ->
+ {ok,_} = file:copy(Src, Dest),
+ case lists:member(preserve, Opts) of
+ true ->
+ {ok, FileInfo} = file:read_file_info(Src),
+ file:write_file_info(Dest, FileInfo);
+ false ->
+ ok
+ end.
+
+write_file(FName, Conts) ->
+ Enc = file:native_name_encoding(),
+ {ok, Fd} = file:open(FName, [write]),
+ file:write(Fd, unicode:characters_to_binary(Conts,Enc,Enc)),
+ file:close(Fd).
+
+%% Substitute all occurrences of %Var% for Val in the given scripts
+subst_src_scripts(Scripts, SrcDir, DestDir, Vars, Opts) ->
+ lists:foreach(fun(Script) ->
+ subst_src_script(Script, SrcDir, DestDir,
+ Vars, Opts)
+ end, Scripts).
+
+subst_src_script(Script, SrcDir, DestDir, Vars, Opts) ->
+ subst_file(filename:join([SrcDir, Script ++ ".src"]),
+ filename:join([DestDir, Script]),
+ Vars, Opts).
+
+subst_file(Src, Dest, Vars, Opts) ->
+ {ok, Bin} = file:read_file(Src),
+ Conts = binary_to_list(Bin),
+ NConts = subst(Conts, Vars),
+ write_file(Dest, NConts),
+ case lists:member(preserve, Opts) of
+ true ->
+ {ok, FileInfo} = file:read_file_info(Src),
+ file:write_file_info(Dest, FileInfo);
+ false ->
+ ok
+ end.
+
+subst(Str, [{Var,Val}|Vars]) ->
+ subst(re:replace(Str,"%"++Var++"%",Val,[{return,list}]),Vars);
+subst(Str, []) ->
+ Str.
+
+%%% Start a node by executing the given start command. This node will
+%%% be used for upgrade.
+start_node(Start,ExpVsn,ExpAppsVsns) ->
+ Port = open_port({spawn_executable, Start}, []),
+ unlink(Port),
+ erlang:port_close(Port),
+ wait_node_up(permanent,ExpVsn,ExpAppsVsns).
+
+wait_node_up(ExpStatus,ExpVsn,ExpAppsVsns) ->
+ Node = node_name(?testnode),
+ wait_node_up(Node,ExpStatus,ExpVsn,lists:keysort(1,ExpAppsVsns),60).
+
+wait_node_up(Node,ExpStatus,ExpVsn,ExpAppsVsns,0) ->
+ test_server:fail({node_not_started,app_check_failed,ExpVsn,ExpAppsVsns,
+ rpc:call(Node,release_handler,which_releases,[ExpStatus]),
+ rpc:call(Node,application,which_applications,[])});
+wait_node_up(Node,ExpStatus,ExpVsn,ExpAppsVsns,N) ->
+ case {rpc:call(Node,release_handler,which_releases,[ExpStatus]),
+ rpc:call(Node, application, which_applications, [])} of
+ {[{_,ExpVsn,_,_}],Apps} when is_list(Apps) ->
+ case [{A,V} || {A,_,V} <- lists:keysort(1,Apps),
+ lists:keymember(A,1,ExpAppsVsns)] of
+ ExpAppsVsns ->
+ {ok,Node};
+ _ ->
+ timer:sleep(2000),
+ wait_node_up(Node,ExpStatus,ExpVsn,ExpAppsVsns,N-1)
+ end;
+ _ ->
+ timer:sleep(2000),
+ wait_node_up(Node,ExpStatus,ExpVsn,ExpAppsVsns,N-1)
+ end.
+
+node_name(Sname) ->
+ {ok,Host} = inet:gethostname(),
+ list_to_atom(atom_to_list(Sname) ++ "@" ++ Host).
+
+rm_rf(Dir) ->
+ case file:read_file_info(Dir) of
+ {ok, #file_info{type = directory}} ->
+ {ok, Content} = file:list_dir_all(Dir),
+ [rm_rf(filename:join(Dir,C)) || C <- Content],
+ ok=file:del_dir(Dir),
+ ok;
+ {ok, #file_info{}} ->
+ ok=file:delete(Dir);
+ _ ->
+ ok
+ end.
diff --git a/lib/common_test/test/ct_netconfc_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE.erl
index c89a4cdabe..2959f77087 100644
--- a/lib/common_test/test/ct_netconfc_SUITE.erl
+++ b/lib/common_test/test/ct_netconfc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2009-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -63,7 +63,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[
- default
+ netconfc1_SUITE,
+ netconfc_remote_SUITE
].
%%--------------------------------------------------------------------
@@ -72,14 +73,21 @@ all() ->
%%%-----------------------------------------------------------------
%%%
-default(Config) when is_list(Config) ->
+netconfc1_SUITE(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
Suite = filename:join(DataDir, "netconfc1_SUITE"),
CfgFile = filename:join(DataDir, "netconfc1.cfg"),
{Opts,ERPid} = setup([{suite,Suite},{config,CfgFile},
- {label,default}], Config),
+ {label,netconfc1_SUITE}], Config),
- ok = execute(default, Opts, ERPid, Config).
+ ok = execute(netconfc1_SUITE, Opts, ERPid, Config).
+
+netconfc_remote_SUITE(Config) when is_list(Config) ->
+ DataDir = ?config(data_dir, Config),
+ Suite = filename:join(DataDir, "netconfc_remote_SUITE"),
+ {Opts,ERPid} = setup([{suite,Suite},{label,netconfc_remote_SUITE}], Config),
+
+ ok = execute(netconfc_remote_SUITE, Opts, ERPid, Config).
%%%-----------------------------------------------------------------
@@ -112,16 +120,15 @@ reformat(Events, EH) ->
%%%-----------------------------------------------------------------
%%% TEST EVENTS
%%%-----------------------------------------------------------------
-events_to_check(default,Config) ->
- {module,_} = code:load_abs(filename:join(?config(data_dir,Config),
- netconfc1_SUITE)),
- TCs = netconfc1_SUITE:all(),
- code:purge(netconfc1_SUITE),
- code:delete(netconfc1_SUITE),
+events_to_check(Suite,Config) ->
+ {module,_} = code:load_abs(filename:join(?config(data_dir,Config),Suite)),
+ TCs = Suite:all(),
+ code:purge(Suite),
+ code:delete(Suite),
OneTest =
[{?eh,start_logging,{'DEF','RUNDIR'}}] ++
- [{?eh,tc_done,{netconfc1_SUITE,TC,ok}} || TC <- TCs] ++
+ [{?eh,tc_done,{Suite,TC,ok}} || TC <- TCs] ++
[{?eh,stop_logging,[]}],
%% 2 tests (ct:run_test + script_start) is default
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
index 2bcfeeec0c..332e54d1a7 100644
--- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
+++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
@@ -1,7 +1,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -30,25 +30,10 @@
-module(netconfc1_SUITE).
-include_lib("common_test/include/ct.hrl").
-include_lib("common_test/src/ct_netconfc.hrl").
--include_lib("public_key/include/public_key.hrl").
+-include("netconfc_test_lib.hrl").
-compile(export_all).
-%% Default timetrap timeout (set in init_per_testcase).
--define(default_timeout, ?t:minutes(1)).
-
--define(NS,ns).
--define(LOCALHOST, "127.0.0.1").
--define(SSH_PORT, 2060).
-
--define(DEFAULT_SSH_OPTS,[{ssh,?LOCALHOST},
- {port,?SSH_PORT},
- {user,"xxx"},
- {password,"xxx"}]).
--define(DEFAULT_SSH_OPTS(Dir), ?DEFAULT_SSH_OPTS++[{user_dir,Dir}]).
-
--define(ok,ok).
-
suite() ->
[{ct_hooks, [{cth_conn_log,
[{ct_netconfc,[{log_type,html}, %will be overwritten by config
@@ -91,6 +76,7 @@ all() ->
get_config,
get_config_xpath,
edit_config,
+ edit_config_opt_params,
copy_config,
delete_config,
lock,
@@ -136,8 +122,8 @@ end_per_testcase(_Case, Config) ->
init_per_suite(Config) ->
case catch {crypto:start(), ssh:start()} of
{ok, ok} ->
- {ok, _} = get_id_keys(Config),
- make_dsa_files(Config),
+ {ok, _} = netconfc_test_lib:get_id_keys(Config),
+ netconfc_test_lib:make_dsa_files(Config),
Server = ?NS:start(?config(data_dir,Config)),
[{server,Server}|Config];
_ ->
@@ -148,7 +134,7 @@ end_per_suite(Config) ->
?NS:stop(?config(server,Config)),
ssh:stop(),
crypto:stop(),
- remove_id_keys(Config),
+ netconfc_test_lib:remove_id_keys(Config),
Config.
hello(Config) ->
@@ -415,6 +401,18 @@ edit_config(Config) ->
?ok = ct_netconfc:close_session(Client),
ok.
+edit_config_opt_params(Config) ->
+ DataDir = ?config(data_dir,Config),
+ {ok,Client} = open_success(DataDir),
+ ?NS:expect_reply({'edit-config',{'default-operation',"none"}},ok),
+ ?ok = ct_netconfc:edit_config(Client,running,
+ {server,[{xmlns,"myns"}],
+ [{name,["myserver"]}]},
+ [{'default-operation',["none"]}]),
+ ?NS:expect_do_reply('close-session',close,ok),
+ ?ok = ct_netconfc:close_session(Client),
+ ok.
+
copy_config(Config) ->
DataDir = ?config(data_dir,Config),
{ok,Client} = open_success(DataDir),
@@ -1001,165 +999,3 @@ pad(I) when I<10 ->
"0"++integer_to_list(I);
pad(I) ->
integer_to_list(I).
-
-
-%%%-----------------------------------------------------------------
-%%% BEGIN SSH key management
-%% copy private keys to given dir from ~/.ssh
-get_id_keys(Config) ->
- DstDir = ?config(priv_dir, Config),
- SrcDir = filename:join(os:getenv("HOME"), ".ssh"),
- RsaOk = copyfile(SrcDir, DstDir, "id_rsa"),
- DsaOk = copyfile(SrcDir, DstDir, "id_dsa"),
- case {RsaOk, DsaOk} of
- {{ok, _}, {ok, _}} -> {ok, both};
- {{ok, _}, _} -> {ok, rsa};
- {_, {ok, _}} -> {ok, dsa};
- {Error, _} -> Error
- end.
-
-%% Remove later on. Use make_dsa_files instead.
-remove_id_keys(Config) ->
- Dir = ?config(priv_dir, Config),
- file:delete(filename:join(Dir, "id_rsa")),
- file:delete(filename:join(Dir, "id_dsa")).
-
-
-make_dsa_files(Config) ->
- make_dsa_files(Config, rfc4716_public_key).
-make_dsa_files(Config, Type) ->
- {DSA, EncodedKey} = gen_dsa(128, 20),
- PKey = DSA#'DSAPrivateKey'.y,
- P = DSA#'DSAPrivateKey'.p,
- Q = DSA#'DSAPrivateKey'.q,
- G = DSA#'DSAPrivateKey'.g,
- Dss = #'Dss-Parms'{p=P, q=Q, g=G},
- {ok, Hostname} = inet:gethostname(),
- {ok, {A, B, C, D}} = inet:getaddr(Hostname, inet),
- IP = lists:concat([A, ".", B, ".", C, ".", D]),
- Attributes = [], % Could be [{comment,"user@" ++ Hostname}],
- HostNames = [{hostnames,[IP, IP]}],
- PublicKey = [{{PKey, Dss}, Attributes}],
- KnownHosts = [{{PKey, Dss}, HostNames}],
-
- KnownHostsEnc = public_key:ssh_encode(KnownHosts, known_hosts),
- KnownHosts = public_key:ssh_decode(KnownHostsEnc, known_hosts),
-
- PublicKeyEnc = public_key:ssh_encode(PublicKey, Type),
-
- SystemTmpDir = ?config(data_dir, Config),
- filelib:ensure_dir(SystemTmpDir),
- file:make_dir(SystemTmpDir),
-
- DSAFile = filename:join(SystemTmpDir, "ssh_host_dsa_key.pub"),
- file:delete(DSAFile),
-
- DSAPrivateFile = filename:join(SystemTmpDir, "ssh_host_dsa_key"),
- file:delete(DSAPrivateFile),
-
- KHFile = filename:join(SystemTmpDir, "known_hosts"),
- file:delete(KHFile),
-
- PemBin = public_key:pem_encode([EncodedKey]),
-
- file:write_file(DSAFile, PublicKeyEnc),
- file:write_file(KHFile, KnownHostsEnc),
- file:write_file(DSAPrivateFile, PemBin),
- ok.
-
-
-%%--------------------------------------------------------------------
-%% @doc Creates a dsa key (OBS: for testing only)
-%% the sizes are in bytes
-%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()}
-%% @end
-%%--------------------------------------------------------------------
-gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) ->
- Key = gen_dsa2(LSize, NSize),
- {Key, encode_key(Key)}.
-
-encode_key(Key = #'DSAPrivateKey'{}) ->
- Der = public_key:der_encode('DSAPrivateKey', Key),
- {'DSAPrivateKey', Der, not_encrypted}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% DSA key generation (OBS: for testing only)
-%% See http://en.wikipedia.org/wiki/Digital_Signature_Algorithm
-%% and the fips_186-3.pdf
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-gen_dsa2(LSize, NSize) ->
- Q = prime(NSize), %% Choose N-bit prime Q
- X0 = prime(LSize),
- P0 = prime((LSize div 2) +1),
-
- %% Choose L-bit prime modulus P such that p-1 is a multiple of q.
- case dsa_search(X0 div (2*Q*P0), P0, Q, 1000) of
- error ->
- gen_dsa2(LSize, NSize);
- P ->
- G = crypto:mod_pow(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q.
- %% such that This may be done by setting g = h^(p-1)/q mod p, commonly h=2 is used.
-
- X = prime(20), %% Choose x by some random method, where 0 < x < q.
- Y = crypto:mod_pow(G, X, P), %% Calculate y = g^x mod p.
-
- #'DSAPrivateKey'{version=0, p = P, q = Q,
- g = crypto:bytes_to_integer(G), y = crypto:bytes_to_integer(Y), x = X}
- end.
-
-%% See fips_186-3.pdf
-dsa_search(T, P0, Q, Iter) when Iter > 0 ->
- P = 2*T*Q*P0 + 1,
- case is_prime(P, 50) of
- true -> P;
- false -> dsa_search(T+1, P0, Q, Iter-1)
- end;
-dsa_search(_,_,_,_) ->
- error.
-
-
-%%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-prime(ByteSize) ->
- Rand = odd_rand(ByteSize),
- prime_odd(Rand, 0).
-
-prime_odd(Rand, N) ->
- case is_prime(Rand, 50) of
- true ->
- Rand;
- false ->
- prime_odd(Rand+2, N+1)
- end.
-
-%% see http://en.wikipedia.org/wiki/Fermat_primality_test
-is_prime(_, 0) -> true;
-is_prime(Candidate, Test) ->
- CoPrime = odd_rand(10000, Candidate),
- Result = crypto:mod_pow(CoPrime, Candidate, Candidate) ,
- is_prime(CoPrime, crypto:bytes_to_integer(Result), Candidate, Test).
-
-is_prime(CoPrime, CoPrime, Candidate, Test) ->
- is_prime(Candidate, Test-1);
-is_prime(_,_,_,_) ->
- false.
-
-odd_rand(Size) ->
- Min = 1 bsl (Size*8-1),
- Max = (1 bsl (Size*8))-1,
- odd_rand(Min, Max).
-
-odd_rand(Min,Max) ->
- Rand = crypto:rand_uniform(Min,Max),
- case Rand rem 2 of
- 0 ->
- Rand + 1;
- _ ->
- Rand
- end.
-
-copyfile(SrcDir, DstDir, Fn) ->
- file:copy(filename:join(SrcDir, Fn),
- filename:join(DstDir, Fn)).
-
-%%% END SSH key management
-%%%-----------------------------------------------------------------
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl
new file mode 100644
index 0000000000..7a44d148dd
--- /dev/null
+++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl
@@ -0,0 +1,147 @@
+%%--------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%----------------------------------------------------------------------
+-module(netconfc_remote_SUITE).
+-include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/src/ct_netconfc.hrl").
+-include("netconfc_test_lib.hrl").
+
+-compile(export_all).
+
+suite() ->
+ [{ct_hooks, [{cth_conn_log,[{ct_netconfc,[{log_type,html}]}]}]}].
+
+all() ->
+ case os:find_executable("ssh") of
+ false ->
+ {skip, "SSH not installed on host"};
+ _ ->
+ [remote_crash
+ ]
+ end.
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+init_per_testcase(Case, Config) ->
+ stop_node(Case),
+ Dog = test_server:timetrap(?default_timeout),
+ [{watchdog, Dog}|Config].
+
+end_per_testcase(Case, Config) ->
+ stop_node(Case),
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+stop_node(Case) ->
+ {ok,Host} = inet:gethostname(),
+ Node = list_to_atom("nc_" ++ atom_to_list(Case)++ "@" ++ Host),
+ rpc:call(Node,erlang,halt,[]).
+
+
+init_per_suite(Config) ->
+ case {crypto:start(),ssh:start()} of
+ {ok,ok} ->
+ {ok, _} = netconfc_test_lib:get_id_keys(Config),
+ netconfc_test_lib:make_dsa_files(Config),
+ Config;
+ _ ->
+ {skip, "Crypto and/or SSH could not be started locally!"}
+ end.
+
+end_per_suite(Config) ->
+ ssh:stop(),
+ crypto:stop(),
+ netconfc_test_lib:remove_id_keys(Config),
+ Config.
+
+%% This test case is related to seq12645
+%% Running the netconf server in a remote node, test that the client
+%% process terminates if the remote node goes down.
+remote_crash(Config) ->
+ {ok,Node} = ct_slave:start(nc_remote_crash),
+ Pa = filename:dirname(code:which(?NS)),
+ true = rpc:call(Node,code,add_patha,[Pa]),
+
+ case {rpc:call(Node,crypto,start,[]),rpc:call(Node,ssh,start,[])} of
+ {ok,ok} ->
+ Server = rpc:call(Node,?NS,start,[?config(data_dir,Config)]),
+ remote_crash(Node,Config);
+ _ ->
+ {skip, "Crypto and/or SSH could not be started remote!"}
+ end.
+
+remote_crash(Node,Config) ->
+ DataDir = ?config(data_dir,Config),
+ {ok,Client} = open_success(Node,DataDir),
+
+ ns(Node,expect_reply,[{'create-subscription',[stream]},ok]),
+ ?ok = ct_netconfc:create_subscription(Client),
+
+ true = erlang:is_process_alive(Client),
+ Ref = erlang:monitor(process,Client),
+ rpc:call(Node,erlang,halt,[]), % take the node down as brutally as possible
+ receive {'DOWN',Ref,process,Client,_} ->
+ ok
+ after 10000 ->
+ ct:fail(client_still_alive)
+ end.
+
+%%%-----------------------------------------------------------------
+
+break(_Config) ->
+ test_server:break("break test case").
+
+%%%-----------------------------------------------------------------
+%% Open a netconf session which is not specified in a config file
+open_success(Node,Dir) ->
+ open_success(Node,Dir,[]).
+
+%% Open a netconf session which is not specified in a config file, and
+%% give som extra options in addition to the test defaults.
+open_success(Node,Dir,ExtraOpts) when is_list(Dir), is_list(ExtraOpts) ->
+ ns(Node,hello,[1]), % tell server to send hello with session id 1
+ ns(Node,expect,[hello]), % tell server to expect a hello message from client
+ open(Dir,ExtraOpts);
+
+%% Open a named netconf session which is not specified in a config file
+open_success(Node,KeyOrName,Dir) when is_atom(KeyOrName), is_list(Dir) ->
+ ns(Node,hello,[1]),
+ ns(Node,expect,[hello]),
+ ct_netconfc:open(KeyOrName,?DEFAULT_SSH_OPTS(Dir)).
+
+open(Dir) ->
+ open(Dir,[]).
+open(Dir,ExtraOpts) ->
+ Opts = lists:ukeymerge(1,lists:keysort(1,ExtraOpts),
+ lists:keysort(1,?DEFAULT_SSH_OPTS(Dir))),
+ ct_netconfc:open(Opts).
+
+%%%-----------------------------------------------------------------
+%%% Call server on remote node
+ns(Node,Func,Args) ->
+ rpc:call(Node,?NS,Func,Args).
+
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.erl
new file mode 100644
index 0000000000..e058bc7600
--- /dev/null
+++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.erl
@@ -0,0 +1,166 @@
+-module(netconfc_test_lib).
+
+-export([get_id_keys/1, remove_id_keys/1, make_dsa_files/1]).
+-include_lib("common_test/include/ct.hrl").
+-include_lib("public_key/include/public_key.hrl").
+
+%%%-----------------------------------------------------------------
+%%% BEGIN SSH key management
+%% copy private keys to given dir from ~/.ssh
+get_id_keys(Config) ->
+ DstDir = ?config(priv_dir, Config),
+ SrcDir = filename:join(os:getenv("HOME"), ".ssh"),
+ RsaOk = copyfile(SrcDir, DstDir, "id_rsa"),
+ DsaOk = copyfile(SrcDir, DstDir, "id_dsa"),
+ case {RsaOk, DsaOk} of
+ {{ok, _}, {ok, _}} -> {ok, both};
+ {{ok, _}, _} -> {ok, rsa};
+ {_, {ok, _}} -> {ok, dsa};
+ {Error, _} -> Error
+ end.
+
+%% Remove later on. Use make_dsa_files instead.
+remove_id_keys(Config) ->
+ Dir = ?config(priv_dir, Config),
+ file:delete(filename:join(Dir, "id_rsa")),
+ file:delete(filename:join(Dir, "id_dsa")).
+
+
+make_dsa_files(Config) ->
+ make_dsa_files(Config, rfc4716_public_key).
+make_dsa_files(Config, Type) ->
+ {DSA, EncodedKey} = gen_dsa(128, 20),
+ PKey = DSA#'DSAPrivateKey'.y,
+ P = DSA#'DSAPrivateKey'.p,
+ Q = DSA#'DSAPrivateKey'.q,
+ G = DSA#'DSAPrivateKey'.g,
+ Dss = #'Dss-Parms'{p=P, q=Q, g=G},
+ {ok, Hostname} = inet:gethostname(),
+ {ok, {A, B, C, D}} = inet:getaddr(Hostname, inet),
+ IP = lists:concat([A, ".", B, ".", C, ".", D]),
+ Attributes = [], % Could be [{comment,"user@" ++ Hostname}],
+ HostNames = [{hostnames,[IP, IP]}],
+ PublicKey = [{{PKey, Dss}, Attributes}],
+ KnownHosts = [{{PKey, Dss}, HostNames}],
+
+ KnownHostsEnc = public_key:ssh_encode(KnownHosts, known_hosts),
+ KnownHosts = public_key:ssh_decode(KnownHostsEnc, known_hosts),
+
+ PublicKeyEnc = public_key:ssh_encode(PublicKey, Type),
+
+ SystemTmpDir = ?config(data_dir, Config),
+ filelib:ensure_dir(SystemTmpDir),
+ file:make_dir(SystemTmpDir),
+
+ DSAFile = filename:join(SystemTmpDir, "ssh_host_dsa_key.pub"),
+ file:delete(DSAFile),
+
+ DSAPrivateFile = filename:join(SystemTmpDir, "ssh_host_dsa_key"),
+ file:delete(DSAPrivateFile),
+
+ KHFile = filename:join(SystemTmpDir, "known_hosts"),
+ file:delete(KHFile),
+
+ PemBin = public_key:pem_encode([EncodedKey]),
+
+ file:write_file(DSAFile, PublicKeyEnc),
+ file:write_file(KHFile, KnownHostsEnc),
+ file:write_file(DSAPrivateFile, PemBin),
+ ok.
+
+
+%%--------------------------------------------------------------------
+%% @doc Creates a dsa key (OBS: for testing only)
+%% the sizes are in bytes
+%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()}
+%% @end
+%%--------------------------------------------------------------------
+gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) ->
+ Key = gen_dsa2(LSize, NSize),
+ {Key, encode_key(Key)}.
+
+encode_key(Key = #'DSAPrivateKey'{}) ->
+ Der = public_key:der_encode('DSAPrivateKey', Key),
+ {'DSAPrivateKey', Der, not_encrypted}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% DSA key generation (OBS: for testing only)
+%% See http://en.wikipedia.org/wiki/Digital_Signature_Algorithm
+%% and the fips_186-3.pdf
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+gen_dsa2(LSize, NSize) ->
+ Q = prime(NSize), %% Choose N-bit prime Q
+ X0 = prime(LSize),
+ P0 = prime((LSize div 2) +1),
+
+ %% Choose L-bit prime modulus P such that p-1 is a multiple of q.
+ case dsa_search(X0 div (2*Q*P0), P0, Q, 1000) of
+ error ->
+ gen_dsa2(LSize, NSize);
+ P ->
+ G = crypto:mod_pow(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q.
+ %% such that This may be done by setting g = h^(p-1)/q mod p, commonly h=2 is used.
+
+ X = prime(20), %% Choose x by some random method, where 0 < x < q.
+ Y = crypto:mod_pow(G, X, P), %% Calculate y = g^x mod p.
+
+ #'DSAPrivateKey'{version=0, p = P, q = Q,
+ g = crypto:bytes_to_integer(G), y = crypto:bytes_to_integer(Y), x = X}
+ end.
+
+%% See fips_186-3.pdf
+dsa_search(T, P0, Q, Iter) when Iter > 0 ->
+ P = 2*T*Q*P0 + 1,
+ case is_prime(P, 50) of
+ true -> P;
+ false -> dsa_search(T+1, P0, Q, Iter-1)
+ end;
+dsa_search(_,_,_,_) ->
+ error.
+
+
+%%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+prime(ByteSize) ->
+ Rand = odd_rand(ByteSize),
+ prime_odd(Rand, 0).
+
+prime_odd(Rand, N) ->
+ case is_prime(Rand, 50) of
+ true ->
+ Rand;
+ false ->
+ prime_odd(Rand+2, N+1)
+ end.
+
+%% see http://en.wikipedia.org/wiki/Fermat_primality_test
+is_prime(_, 0) -> true;
+is_prime(Candidate, Test) ->
+ CoPrime = odd_rand(10000, Candidate),
+ Result = crypto:mod_pow(CoPrime, Candidate, Candidate) ,
+ is_prime(CoPrime, crypto:bytes_to_integer(Result), Candidate, Test).
+
+is_prime(CoPrime, CoPrime, Candidate, Test) ->
+ is_prime(Candidate, Test-1);
+is_prime(_,_,_,_) ->
+ false.
+
+odd_rand(Size) ->
+ Min = 1 bsl (Size*8-1),
+ Max = (1 bsl (Size*8))-1,
+ odd_rand(Min, Max).
+
+odd_rand(Min,Max) ->
+ Rand = crypto:rand_uniform(Min,Max),
+ case Rand rem 2 of
+ 0 ->
+ Rand + 1;
+ _ ->
+ Rand
+ end.
+
+copyfile(SrcDir, DstDir, Fn) ->
+ file:copy(filename:join(SrcDir, Fn),
+ filename:join(DstDir, Fn)).
+
+%%% END SSH key management
+%%%-----------------------------------------------------------------
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.hrl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.hrl
new file mode 100644
index 0000000000..dcaad5ba93
--- /dev/null
+++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.hrl
@@ -0,0 +1,14 @@
+%% Default timetrap timeout (set in init_per_testcase).
+-define(default_timeout, ?t:minutes(1)).
+
+-define(NS,ns). % netconf server module
+-define(LOCALHOST, "127.0.0.1").
+-define(SSH_PORT, 2060).
+
+-define(DEFAULT_SSH_OPTS,[{ssh,?LOCALHOST},
+ {port,?SSH_PORT},
+ {user,"xxx"},
+ {password,"xxx"}]).
+-define(DEFAULT_SSH_OPTS(Dir), ?DEFAULT_SSH_OPTS++[{user_dir,Dir}]).
+
+-define(ok,ok).
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl
index fb0734d48e..f7c7b891bb 100644
--- a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl
+++ b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl
@@ -1,7 +1,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2012-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -382,6 +382,7 @@ event({startElement,_,Name,_,Attrs},[ignore,{se,Name,As}|Match]) ->
event({startPrefixMapping,_,Ns},[{ns,Ns}|Match]) -> Match;
event({startPrefixMapping,_,Ns},[ignore,{ns,Ns}|Match]) -> Match;
event({endPrefixMapping,_},Match) -> Match;
+event({characters,Chs},[{characters,Chs}|Match]) -> Match;
event({endElement,_,Name,_},[{ee,Name}|Match]) -> Match;
event({endElement,_,Name,_},[ignore,{ee,Name}|Match]) -> Match;
event(endDocument,Match) when Match==[]; Match==[ignore] -> ok;
@@ -471,14 +472,17 @@ capabilities(no_caps) ->
%%% expect_do_reply/3.
%%%
%%% match(term()) -> [Match].
-%%% Match = ignore | {se,Name} | {se,Name,Attrs} | {ee,Name} | {ns,Namespace}
+%%% Match = ignore | {se,Name} | {se,Name,Attrs} | {ee,Name} |
+%%% {ns,Namespace} | {characters,Chs}
%%% Name = string()
+%%% Chs = string()
%%% Attrs = [{atom(),string()}]
%%% Namespace = string()
%%%
%%% 'se' means start element, 'ee' means end element - i.e. to match
%%% an XML element you need one 'se' entry and one 'ee' entry with the
-%%% same name in the match list.
+%%% same name in the match list. 'characters' can be used for matching
+%%% character data (cdata) inside an element.
match(hello) ->
[ignore,{se,"hello"},ignore,{ee,"hello"},ignore];
match('close-session') ->
@@ -487,6 +491,10 @@ match('close-session') ->
match('edit-config') ->
[ignore,{se,"rpc"},{se,"edit-config"},{se,"target"},ignore,{ee,"target"},
{se,"config"},ignore,{ee,"config"},{ee,"edit-config"},{ee,"rpc"},ignore];
+match({'edit-config',{'default-operation',DO}}) ->
+ [ignore,{se,"rpc"},{se,"edit-config"},{se,"target"},ignore,{ee,"target"},
+ {se,"default-operation"},{characters,DO},{ee,"default-operation"},
+ {se,"config"},ignore,{ee,"config"},{ee,"edit-config"},{ee,"rpc"},ignore];
match('get') ->
match({get,subtree});
match({'get',FilterType}) ->
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 7a30c68593..5626aa34ab 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -155,7 +155,8 @@ collect(remove_message) -> {set,[],[],remove_message};
collect({put_map,F,Op,S,D,R,{list,Puts}}) ->
{set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}};
collect({get_map_elements,F,S,{list,Gets}}) ->
- {set,Gets,[S],{get_map_elements,F}};
+ {Ss,Ds} = beam_utils:spliteven(Gets),
+ {set,Ds,[S|Ss],{get_map_elements,F}};
collect({'catch',R,L}) -> {set,[R],[],{'catch',L}};
collect(fclearerror) -> {set,[],[],fclearerror};
collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror};
diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl
index 46835bece1..05d067dc48 100644
--- a/lib/compiler/src/beam_flatten.erl
+++ b/lib/compiler/src/beam_flatten.erl
@@ -63,7 +63,8 @@ norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I};
norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2};
norm({set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}) ->
{put_map,F,Op,S,D,R,{list,Puts}};
-norm({set,Gets,[S],{get_map_elements,F}}) ->
+norm({set,Ds,[S|Ss],{get_map_elements,F}}) ->
+ Gets = beam_utils:joineven(Ss,Ds),
{get_map_elements,F,S,{list,Gets}};
norm({set,[],[],remove_message}) -> remove_message;
norm({set,[],[],fclearerror}) -> fclearerror;
diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl
index 688bba9a94..f5dba314ae 100644
--- a/lib/compiler/src/beam_split.erl
+++ b/lib/compiler/src/beam_split.erl
@@ -53,8 +53,9 @@ split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is],
Bl, Acc) when Lbl =/= 0 ->
split_block(Is, [], [{put_map,Fail,Op,S,D,R,{list,Puts}}|
make_block(Bl, Acc)]);
-split_block([{set,Gets,[S],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc)
+split_block([{set,Ds,[S|Ss],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc)
when Lbl =/= 0 ->
+ Gets = beam_utils:joineven(Ss,Ds),
split_block(Is, [], [{get_map_elements,Fail,S,{list,Gets}}|make_block(Bl, Acc)]);
split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) ->
split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]);
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index 58c0f765ae..cdddad4153 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -106,6 +106,20 @@ simplify_basic_1([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Acc) ->
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);
+ _Other ->
+ Ts = update(I, Ts0),
+ simplify_basic_1(Is, Ts, [I|Acc])
+ end;
+simplify_basic_1([{test,is_nonempty_list,_,[R]}=I|Is], Ts0, Acc) ->
+ case tdb_find(R, Ts0) of
+ nonempty_list -> simplify_basic_1(Is, Ts0, Acc);
+ _Other ->
+ Ts = update(I, Ts0),
+ simplify_basic_1(Is, Ts, [I|Acc])
+ end;
simplify_basic_1([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Acc0) ->
Acc = case tdb_find(R, Ts0) of
{atom,_}=Atom -> Acc0;
@@ -402,6 +416,10 @@ 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);
+update({test,is_map,_Fail,[Src]}, Ts0) ->
+ tdb_update([{Src,map}], Ts0);
+update({test,is_nonempty_list,_Fail,[Src]}, Ts0) ->
+ tdb_update([{Src,nonempty_list}], Ts0);
update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) ->
case tdb_find(Reg, Ts) of
error ->
@@ -710,6 +728,8 @@ merge_type_info(NewType, _) ->
verify_type(NewType),
NewType.
+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_element,_,_}) -> ok;
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index 8ca368c167..e82ba82d38 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -26,6 +26,8 @@
code_at/2,bif_to_test/3,is_pure_test/1,
live_opt/1,delete_live_annos/1,combine_heap_needs/2]).
+-export([joineven/2,spliteven/1]).
+
-import(lists, [member/2,sort/1,reverse/1,splitwith/2]).
-record(live,
@@ -832,3 +834,15 @@ x_live([_|Rs], Regs) -> x_live(Rs, Regs);
x_live([], Regs) -> Regs.
is_live(X, Regs) -> ((Regs bsr X) band 1) =:= 1.
+
+%% spliteven/1
+%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]}
+spliteven(Rs) -> spliteven(Rs,[],[]).
+spliteven([],Ss,Ds) -> {reverse(Ss),reverse(Ds)};
+spliteven([S,D|Rs],Ss,Ds) ->
+ spliteven(Rs,[S|Ss],[D|Ds]).
+
+%% joineven/1
+%% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6]
+joineven([],[]) -> [];
+joineven([S|Ss],[D|Ds]) -> [S,D|joineven(Ss,Ds)].
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 9d5563d13b..0acc7a227f 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -1123,7 +1123,9 @@ assert_freg_set(Fr, _) -> error({bad_source,Fr}).
%%% Maps
%% ensure that a list of literals has a strict
-%% ascending term order (also meaning unique literals)
+%% ascending term order (also meaning unique literals).
+%% Single item lists may have registers.
+assert_strict_literal_termorder([_]) -> ok;
assert_strict_literal_termorder(Ls) ->
Vs = lists:map(fun (L) -> get_literal(L) end, Ls),
case check_strict_value_termorder(Vs) of
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 9d6768b157..7a2c3d70de 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -3063,10 +3063,12 @@ pat_vars(Node, Vs) ->
map ->
pat_list_vars(map_es(Node), Vs);
map_pair ->
- pat_list_vars([map_pair_op(Node),map_pair_key(Node),map_pair_val(Node)],Vs);
+ %% map_pair_key is not a pattern var, excluded
+ pat_list_vars([map_pair_op(Node),map_pair_val(Node)],Vs);
binary ->
pat_list_vars(binary_segments(Node), Vs);
bitstr ->
+ %% bitstr_size is not a pattern var, excluded
pat_vars(bitstr_val(Node), Vs);
alias ->
pat_vars(alias_pat(Node), [alias_var(Node) | Vs])
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index 75740e8b9d..f8489a800b 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -1341,23 +1341,23 @@ i_bitstr(E, Ren, Env, S) ->
S3 = count_size(weight(bitstr), S2),
{update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}.
-i_map(E, Ctx, Ren, Env, S) ->
+i_map(E, Ctx, Ren, Env, S0) ->
%% Visit the segments for value.
- {M1, S1} = i(map_arg(E), value, Ren, Env, S),
+ {M1, S1} = i(map_arg(E), value, Ren, Env, S0),
{Es, S2} = mapfoldl(fun (E, S) ->
i_map_pair(E, Ctx, Ren, Env, S)
end, S1, map_es(E)),
S3 = count_size(weight(map), S2),
{update_c_map(E, M1,Es), S3}.
-i_map_pair(E, Ctx, Ren, Env, S) ->
- %% It is not necessary to visit the Op and Key fields,
- %% since these are always literals.
- {Val, S1} = i(map_pair_val(E), Ctx, Ren, Env, S),
+i_map_pair(E, Ctx, Ren, Env, S0) ->
+ %% It is not necessary to visit the Op field
+ %% since it is always a literal.
+ {Key, S1} = i(map_pair_key(E), value, Ren, Env, S0),
+ {Val, S2} = i(map_pair_val(E), Ctx, Ren, Env, S1),
Op = map_pair_op(E),
- Key = map_pair_key(E),
- S2 = count_size(weight(map_pair), S1),
- {update_c_map_pair(E, Op, Key, Val), S2}.
+ S3 = count_size(weight(map_pair), S2),
+ {update_c_map_pair(E, Op, Key, Val), S3}.
%% This is a simplified version of `i_pattern', for lists of parameter
@@ -1420,15 +1420,11 @@ i_pattern(E, Ren, Env, Ren0, Env0, S) ->
S2 = count_size(weight(binary), S1),
{update_c_binary(E, Es), S2};
map ->
- %% map patterns should not have args
- M = map_arg(E),
-
{Es, S1} = mapfoldl(fun (E, S) ->
i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S)
- end,
- S, map_es(E)),
+ end, S, map_es(E)),
S2 = count_size(weight(map), S1),
- {update_c_map(E, M, Es), S2};
+ {update_c_map(E, map_arg(E), Es), S2};
_ ->
case is_literal(E) of
true ->
@@ -1464,12 +1460,12 @@ i_bitstr_pattern(E, Ren, Env, Ren0, Env0, S) ->
i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) ->
%% It is not necessary to visit the Op it is always a literal.
- %% Same goes for Key
- {Val, S1} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S),
+ %% Key is an expression
+ {Key, S1} = i(map_pair_key(E), value, Ren0, Env0, S),
+ {Val, S2} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S1),
Op = map_pair_op(E), %% should be 'exact' literal
- Key = map_pair_key(E),
- S2 = count_size(weight(map_pair), S1),
- {update_c_map_pair(E, Op, Key, Val), S2}.
+ S3 = count_size(weight(map_pair), S2),
+ {update_c_map_pair(E, Op, Key, Val), S3}.
%% ---------------------------------------------------------------------
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index e53bdd4efb..b93da8e97f 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -520,9 +520,9 @@ variables(T, S) ->
tuple ->
vars_in_list(tuple_es(T), S);
map ->
- vars_in_list(map_es(T), S);
+ vars_in_list([map_arg(T)|map_es(T)], S);
map_pair ->
- vars_in_list([map_pair_op(T),map_pair_key(T), map_pair_val(T)], S);
+ vars_in_list([map_pair_op(T),map_pair_key(T),map_pair_val(T)], S);
'let' ->
Vs = variables(let_body(T), S),
Vs1 = var_list_names(let_vars(T)),
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index c7d91070f6..f347438509 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -431,11 +431,6 @@ pass(from_core) ->
{".core",[?pass(parse_core)|core_passes()]};
pass(from_asm) ->
{".S",[?pass(beam_consult_asm)|asm_passes()]};
-pass(asm) ->
- %% TODO: remove 'asm' in 18.0
- io:format("compile:file/2 option 'asm' has been deprecated and will be~n"
- "removed in the 18.0 release. Use 'from_asm' instead.~n"),
- pass(from_asm);
pass(from_beam) ->
{".beam",[?pass(read_beam_file)|binary_passes()]};
pass(_) -> none.
diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl
index 25df33a287..c0e2bdaba0 100644
--- a/lib/compiler/src/core_lint.erl
+++ b/lib/compiler/src/core_lint.erl
@@ -33,9 +33,6 @@
%% Values only as multiple values/variables/patterns.
%% Return same number of values as requested
%% Correct number of arguments
-%%
-%% Checks to add:
-%%
%% Consistency of values/variables
%% Consistency of function return values/calls.
%%
@@ -211,7 +208,7 @@ functions(Fs, Def, St0) ->
function({#c_var{name={_,_}},B}, Def, St) ->
%% Body must be a fun!
case B of
- #c_fun{} -> expr(B, Def, any, St);
+ #c_fun{} -> expr(B, Def, 1, St);
_ -> add_error({illegal_expr,St#lint.func}, St)
end.
@@ -247,40 +244,42 @@ gbody(E, Def, Rt, St0) ->
false -> St1
end.
-gexpr(#c_var{name=N}, Def, _Rt, St) when is_atom(N); is_integer(N) ->
- expr_var(N, Def, St);
-gexpr(#c_literal{}, _Def, _Rt, St) -> St;
-gexpr(#c_cons{hd=H,tl=T}, Def, _Rt, St) ->
- gexpr_list([H,T], Def, St);
-gexpr(#c_tuple{es=Es}, Def, _Rt, St) ->
- gexpr_list(Es, Def, St);
-gexpr(#c_map{es=Es}, Def, _Rt, St) ->
- gexpr_list(Es, Def, St);
-gexpr(#c_map_pair{key=K,val=V}, Def, _Rt, St) ->
- gexpr_list([K,V], Def, St);
-gexpr(#c_binary{segments=Ss}, Def, _Rt, St) ->
- gbitstr_list(Ss, Def, St);
+gexpr(#c_var{name=N}, Def, Rt, St) when is_atom(N); is_integer(N) ->
+ return_match(Rt, 1, expr_var(N, Def, St));
+gexpr(#c_literal{}, _Def, Rt, St) ->
+ return_match(Rt, 1, St);
+gexpr(#c_cons{hd=H,tl=T}, Def, Rt, St) ->
+ return_match(Rt, 1, gexpr_list([H,T], Def, St));
+gexpr(#c_tuple{es=Es}, Def, Rt, St) ->
+ return_match(Rt, 1, gexpr_list(Es, Def, St));
+gexpr(#c_map{es=Es}, Def, Rt, St) ->
+ return_match(Rt, 1, gexpr_list(Es, Def, St));
+gexpr(#c_map_pair{key=K,val=V}, Def, Rt, St) ->
+ return_match(Rt, 1, gexpr_list([K,V], Def, St));
+gexpr(#c_binary{segments=Ss}, Def, Rt, St) ->
+ return_match(Rt, 1, gbitstr_list(Ss, Def, St));
gexpr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) ->
- St1 = gexpr(Arg, Def, any, St0), %Ignore values
- gbody(B, Def, Rt, St1);
+ St1 = gexpr(Arg, Def, 1, St0),
+ return_match(Rt, 1, gbody(B, Def, Rt, St1));
gexpr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) ->
St1 = gbody(Arg, Def, let_varcount(Vs), St0), %This is a guard body
{Lvs,St2} = variable_list(Vs, St1),
gbody(B, union(Lvs, Def), Rt, St2);
gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record},
args=[Arg,#c_literal{val=Tag},#c_literal{val=Size}]},
- Def, 1, St) when is_atom(Tag), is_integer(Size) ->
- gexpr(Arg, Def, 1, St);
+ Def, Rt, St) when is_atom(Tag), is_integer(Size) ->
+ return_match(Rt, 1, gexpr(Arg, Def, 1, St));
gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}},
- _Def, 1, St) ->
- add_error({illegal_guard,St#lint.func}, St);
+ _Def, Rt, St) ->
+ return_match(Rt, 1, add_error({illegal_guard,St#lint.func}, St));
gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As},
- Def, 1, St) when is_atom(Name) ->
+ Def, Rt, St0) when is_atom(Name) ->
+ St1 = return_match(Rt, 1, St0),
case is_guard_bif(Name, length(As)) of
true ->
- gexpr_list(As, Def, St);
+ gexpr_list(As, Def, St1);
false ->
- add_error({illegal_guard,St#lint.func}, St)
+ add_error({illegal_guard,St1#lint.func}, St1)
end;
gexpr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) ->
gexpr_list(As, Def, St0);
@@ -319,23 +318,25 @@ is_guard_bif(Name, Arity) ->
%% expr(Expr, Defined, RetCount, State) -> State.
-expr(#c_var{name={_,_}=FA}, Def, _Rt, St) ->
- expr_fname(FA, Def, St);
-expr(#c_var{name=N}, Def, _Rt, St) -> expr_var(N, Def, St);
-expr(#c_literal{}, _Def, _Rt, St) -> St;
-expr(#c_cons{hd=H,tl=T}, Def, _Rt, St) ->
- expr_list([H,T], Def, St);
-expr(#c_tuple{es=Es}, Def, _Rt, St) ->
- expr_list(Es, Def, St);
-expr(#c_map{es=Es}, Def, _Rt, St) ->
- expr_list(Es, Def, St);
-expr(#c_map_pair{key=K,val=V},Def,_Rt,St) ->
- expr_list([K,V],Def,St);
-expr(#c_binary{segments=Ss}, Def, _Rt, St) ->
- bitstr_list(Ss, Def, St);
+expr(#c_var{name={_,_}=FA}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_fname(FA, Def, St));
+expr(#c_var{name=N}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_var(N, Def, St));
+expr(#c_literal{}, _Def, Rt, St) ->
+ return_match(Rt, 1, St);
+expr(#c_cons{hd=H,tl=T}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_list([H,T], Def, St));
+expr(#c_tuple{es=Es}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_list(Es, Def, St));
+expr(#c_map{es=Es}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_list(Es, Def, St));
+expr(#c_map_pair{key=K,val=V}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_list([K,V], Def, St));
+expr(#c_binary{segments=Ss}, Def, Rt, St) ->
+ return_match(Rt, 1, bitstr_list(Ss, Def, St));
expr(#c_fun{vars=Vs,body=B}, Def, Rt, St0) ->
{Vvs,St1} = variable_list(Vs, St0),
- return_match(Rt, 1, body(B, union(Vvs, Def), any, St1));
+ return_match(Rt, 1, body(B, union(Vvs, Def), 1, St1));
expr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) ->
St1 = expr(Arg, Def, 1, St0),
body(B, Def, Rt, St1);
@@ -361,15 +362,26 @@ expr(#c_receive{clauses=Cs,timeout=T,action=A}, Def, Rt, St0) ->
St1 = expr(T, Def, 1, St0),
St2 = body(A, Def, Rt, St1),
clauses(Cs, Def, 1, Rt, St2);
-expr(#c_apply{op=Op,args=As}, Def, _Rt, St0) ->
+expr(#c_apply{op=Op,args=As}, Def, Rt, St0) ->
St1 = apply_op(Op, Def, length(As), St0),
- expr_list(As, Def, St1);
+ return_match(Rt, 1, expr_list(As, Def, St1));
+expr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As},
+ Def, Rt, St0) when is_atom(Name) ->
+ St1 = expr_list(As, Def, St0),
+ case erl_bifs:is_exit_bif(erlang, Name, length(As)) of
+ true -> St1;
+ false -> return_match(Rt, 1, St1)
+ end;
expr(#c_call{module=M,name=N,args=As}, Def, _Rt, St0) ->
St1 = expr(M, Def, 1, St0),
St2 = expr(N, Def, 1, St1),
expr_list(As, Def, St2);
-expr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) ->
- expr_list(As, Def, St0);
+expr(#c_primop{name=#c_literal{val=A},args=As}, Def, Rt, St0) when is_atom(A) ->
+ St1 = expr_list(As, Def, St0),
+ case A of
+ match_fail -> St1;
+ _ -> return_match(Rt, 1, St1)
+ end;
expr(#c_catch{body=B}, Def, Rt, St) ->
return_match(Rt, 1, body(B, Def, 1, St));
expr(#c_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Def, Rt, St0) ->
diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl
index 83412ecdd7..03801a9b6d 100644
--- a/lib/compiler/src/core_pp.erl
+++ b/lib/compiler/src/core_pp.erl
@@ -125,8 +125,8 @@ format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) ->
_ -> assoc
end,
Cpairs = [#c_map_pair{op=#c_literal{val=Op},
- key=#c_literal{val=V},
- val=#c_literal{val=K}} || {K,V} <- Pairs],
+ key=#c_literal{val=K},
+ val=#c_literal{val=V}} || {K,V} <- Pairs],
format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt);
format_1(#c_var{name={I,A}}, _) ->
[core_atom(I),$/,integer_to_list(A)];
diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index 761ae8409c..f99307c865 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -33,12 +33,15 @@
-include("../include/erl_bits.hrl").
+-type fa() :: {atom(), arity()}.
+
-record(expand, {module=[], %Module name
exports=[], %Exports
imports=[], %Imports
compile=[], %Compile flags
attributes=[], %Attributes
callbacks=[], %Callbacks
+ optional_callbacks=[] :: [fa()], %Optional callbacks
defined, %Defined functions (gb_set)
vcount=0, %Variable counter
func=[], %Current function
@@ -99,7 +102,21 @@ define_functions(Forms, #expand{defined=Predef}=St) ->
module_attrs(#expand{attributes=Attributes}=St) ->
Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes],
Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs],
- {Attrs,St#expand{callbacks=Callbacks}}.
+ OptionalCallbacks = get_optional_callbacks(Attrs),
+ {Attrs,St#expand{callbacks=Callbacks,
+ optional_callbacks=OptionalCallbacks}}.
+
+get_optional_callbacks(Attrs) ->
+ L = [O ||
+ {attribute, _, optional_callbacks, O} <- Attrs,
+ is_fa_list(O)],
+ lists:append(L).
+
+is_fa_list([{FuncName, Arity}|L])
+ when is_atom(FuncName), is_integer(Arity), Arity >= 0 ->
+ is_fa_list(L);
+is_fa_list([]) -> true;
+is_fa_list(_) -> false.
module_predef_funcs(St) ->
{Mpf1,St1}=module_predef_func_beh_info(St),
@@ -108,19 +125,24 @@ module_predef_funcs(St) ->
module_predef_func_beh_info(#expand{callbacks=[]}=St) ->
{[], St};
-module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined,
+module_predef_func_beh_info(#expand{callbacks=Callbacks,
+ optional_callbacks=OptionalCallbacks,
+ defined=Defined,
exports=Exports}=St) ->
PreDef=[{behaviour_info,1}],
PreExp=PreDef,
- {[gen_beh_info(Callbacks)],
+ {[gen_beh_info(Callbacks, OptionalCallbacks)],
St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined),
exports=union(from_list(PreExp), Exports)}}.
-gen_beh_info(Callbacks) ->
+gen_beh_info(Callbacks, OptionalCallbacks) ->
List = make_list(Callbacks),
+ OptionalList = make_optional_list(OptionalCallbacks),
{function,0,behaviour_info,1,
[{clause,0,[{atom,0,callbacks}],[],
- [List]}]}.
+ [List]},
+ {clause,0,[{atom,0,optional_callbacks}],[],
+ [OptionalList]}]}.
make_list([]) -> {nil,0};
make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) ->
@@ -130,6 +152,14 @@ make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) ->
{integer,0,Arity}]},
make_list(Rest)}.
+make_optional_list([]) -> {nil,0};
+make_optional_list([{Name,Arity}|Rest]) ->
+ {cons,0,
+ {tuple,0,
+ [{atom,0,Name},
+ {integer,0,Arity}]},
+ make_optional_list(Rest)}.
+
module_predef_funcs_mod_info(St) ->
PreDef = [{module_info,0},{module_info,1}],
PreExp = PreDef,
@@ -232,9 +262,18 @@ pattern({map,Line,Ps}, St0) ->
{TPs,St1} = pattern_list(Ps, St0),
{{map,Line,TPs},St1};
pattern({map_field_exact,Line,K0,V0}, St0) ->
- {K,St1} = expr(K0, St0),
+ %% Key should be treated as an expression
+ %% but since expressions are not allowed yet,
+ %% process it through pattern .. and handle assoc
+ %% (normalise unary op integer -> integer)
+ {K,St1} = pattern(K0, St0),
{V,St2} = pattern(V0, St1),
{{map_field_exact,Line,K,V},St2};
+pattern({map_field_assoc,Line,K0,V0}, St0) ->
+ %% when keys are Maps
+ {K,St1} = pattern(K0, St0),
+ {V,St2} = pattern(V0, St1),
+ {{map_field_assoc,Line,K,V},St2};
%%pattern({struct,Line,Tag,Ps}, St0) ->
%% {TPs,TPsvs,St1} = pattern_list(Ps, St0),
%% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1};
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 47a357c23d..8c1a0c08ac 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -210,7 +210,7 @@ need_heap_0([], H, Acc) ->
need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H) ->
{need_heap_need(I, H),0};
-need_heap_1(#l{ke={set,_,{map,_,_}},i=I}, H) ->
+need_heap_1(#l{ke={set,_,{map,_,_,_}},i=I}, H) ->
{need_heap_need(I, H),0};
need_heap_1(#l{ke={set,_,Val}}, H) ->
%% Just pass through adding to needed heap.
@@ -643,10 +643,6 @@ select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
[{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis];
select_val_cg(tuple, R, Vls, Tf, Vf, Sis) ->
[{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis];
-select_val_cg(map, R, [_Val,{f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) ->
- [{test,is_map,{f,Fail},[R]}|Sis];
-select_val_cg(map, R, [_Val,{f,Lbl}|_], Tf, _Vf, [{label,Lbl}|Sis]) ->
- [{test,is_map,{f,Tf},[R]}|Sis];
select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) ->
[{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis];
select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
@@ -947,27 +943,34 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) ->
%% Assume keys are term-sorted
Rsrc = fetch_var(Src, Bef),
- {{HasKs,GetVs},Aft} = lists:foldr(fun
- ({map_pair,Key,{var,V}},{{HasKsi,GetVsi},Int0}) ->
+ {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} = lists:foldr(fun
+ ({map_pair,{var,K},{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
case vdb_find(V, Vdb) of
{V,_,L} when L =< I ->
- {{[Key|HasKsi],GetVsi},Int0};
+ RK = fetch_var(K,Int0),
+ {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0};
_Other ->
Reg1 = put_reg(V, Int0#sr.reg),
Int1 = Int0#sr{reg=Reg1},
- {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi]},Int1}
+ RK = fetch_var(K,Int0),
+ RV = fetch_reg(V,Reg1),
+ {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1}
+ end;
+ ({map_pair,Key,{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
+ case vdb_find(V, Vdb) of
+ {V,_,L} when L =< I ->
+ {{[Key|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0};
+ _Other ->
+ Reg1 = put_reg(V, Int0#sr.reg),
+ Int1 = Int0#sr{reg=Reg1},
+ {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi],HasVarVsi,GetVarVsi},Int1}
end
- end, {{[],[]},Bef}, Vs),
-
- Code = case {HasKs,GetVs} of
- {HasKs,[]} ->
- [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}}];
- {[],GetVs} ->
- [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}}];
- {HasKs,GetVs} ->
- [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}},
- {get_map_elements, {f,Fail},Rsrc,{list,GetVs}}]
- end,
+ end, {{[],[],[],[]},Bef}, Vs),
+
+ Code = [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}} || HasKs =/= []] ++
+ [{test,has_map_fields,{f,Fail},Rsrc,{list,[K]}} || K <- HasVarKs] ++
+ [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}} || GetVs =/= []] ++
+ [{get_map_elements, {f,Fail},Rsrc,{list,[K,V]}} || [K,V] <- GetVarVs],
{Code, Aft, St}.
@@ -1504,9 +1507,39 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef,
%% Now generate the complete code for constructing the binary.
Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a),
{Sis++Code,Aft,St};
+% Map single variable key
+set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef,
+ #cg{in_catch=InCatch,bfail=Bfail}=St) ->
+
+ Fail = {f,Bfail},
+ {Sis,Int0} =
+ case InCatch of
+ true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb);
+ false -> {[],Bef}
+ end,
+ SrcReg = cg_reg_arg(Map,Int0),
+ Line = line(Le#l.a),
+
+ List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)],
+
+ Live = max_reg(Bef#sr.reg),
+ Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)},
+ Aft = clear_dead(Int1, Le#l.i, Vdb),
+ Target = fetch_reg(R, Int1#sr.reg),
+
+ I = case Op of
+ assoc -> put_map_assoc;
+ exact -> put_map_exact
+ end,
+ {Sis++[Line]++[{I,Fail,SrcReg,Target,Live,{list,List}}],Aft,St};
+
+% Map (possibly) multiple literal keys
set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef,
#cg{in_catch=InCatch,bfail=Bfail}=St) ->
+ %% assert key literals
+ [] = [Var||{map_pair,{var,_}=Var,_} <- Es],
+
Fail = {f,Bfail},
{Sis,Int0} =
case InCatch of
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 83cf76f241..3d9fc3a609 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -78,7 +78,7 @@
-import(ordsets, [add_element/2,del_element/2,is_element/2,
union/1,union/2,intersection/2,subtract/2]).
-import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1,
- ann_c_map/2, ann_c_map/3]).
+ ann_c_map/3]).
-include("core_parse.hrl").
@@ -169,60 +169,81 @@ form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) ->
attribute({attribute,Line,Name,Val}) ->
{#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}.
+%% function_dump(module_info,_,_,_) -> ok;
+%% function_dump(Name,Arity,Format,Terms) ->
+%% io:format("~w/~w " ++ Format,[Name,Arity]++Terms),
+%% ok.
+
function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) ->
- %%ok = io:fwrite("~p - ", [{Name,Arity}]),
St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]},
{B0,St1} = body(Cs0, Name, Arity, St0),
- %%ok = io:fwrite("1", []),
- %%ok = io:fwrite("~w:~p~n", [?LINE,B0]),
+ %% ok = function_dump(Name,Arity,"body:~n~p~n",[B0]),
{B1,St2} = ubody(B0, St1),
- %%ok = io:fwrite("2", []),
- %%ok = io:fwrite("~w:~p~n", [?LINE,B1]),
+ %% ok = function_dump(Name,Arity,"ubody:~n~p~n",[B1]),
{B2,#core{ws=Ws}} = cbody(B1, St2),
- %%ok = io:fwrite("3~n", []),
- %%ok = io:fwrite("~w:~p~n", [?LINE,B2]),
+ %% ok = function_dump(Name,Arity,"cbody:~n~p~n",[B2]),
{{#c_var{name={Name,Arity}},B2},Ws}.
body(Cs0, Name, Arity, St0) ->
Anno = lineno_anno(element(2, hd(Cs0)), St0),
{Args,St1} = new_vars(Anno, Arity, St0),
- {Cs1,St2} = clauses(Cs0, St1),
- {Ps,St3} = new_vars(Arity, St2), %Need new variables here
- Fc = function_clause(Ps, Anno, {Name,Arity}),
- {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}.
+ case clauses(Cs0, St1) of
+ {Cs1,[],St2} ->
+ {Ps,St3} = new_vars(Arity, St2), %Need new variables here
+ Fc = function_clause(Ps, Anno, {Name,Arity}),
+ {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3};
+ {Cs1,Eps,St2} ->
+ %% We have pre-expressions from patterns and
+ %% these needs to be letified before matching
+ %% since only bound variables are allowed
+ AnnoGen = #a{anno=[compiler_generated]},
+ {Ps1,St3} = new_vars(Arity, St2), %Need new variables here
+ Fc1 = function_clause(Ps1, Anno, {Name,Arity}),
+ {Ps2,St4} = new_vars(Arity, St3), %Need new variables here
+ Fc2 = function_clause(Ps2, Anno, {Name,Arity}),
+ Case = #icase{anno=AnnoGen,args=Args,
+ clauses=Cs1,
+ fc=Fc2},
+ {#ifun{anno=#a{anno=Anno},id=[],vars=Args,
+ clauses=[#iclause{anno=AnnoGen,pats=Ps1,
+ guard=[#c_literal{val=true}],
+ body=Eps ++ [Case]}],
+ fc=Fc1},St4}
+ end.
%% clause(Clause, State) -> {Cclause,State} | noclause.
%% clauses([Clause], State) -> {[Cclause],State}.
%% Convert clauses. Trap bad pattern aliases and remove clause from
%% clause list.
-clauses([C0|Cs0], St0) ->
+clauses([C0|Cs0],St0) ->
case clause(C0, St0) of
- {noclause,St} -> clauses(Cs0, St);
- {C,St1} ->
- {Cs,St2} = clauses(Cs0, St1),
- {[C|Cs],St2}
+ {noclause,_,St} -> clauses(Cs0,St);
+ {C,Eps1,St1} ->
+ {Cs,Eps2,St2} = clauses(Cs0, St1),
+ {[C|Cs],Eps1++Eps2,St2}
end;
-clauses([], St) -> {[],St}.
+clauses([],St) -> {[],[],St}.
clause({clause,Lc,H0,G0,B0}, St0) ->
try head(H0, St0) of
- H1 ->
- {G1,St1} = guard(G0, St0),
- {B1,St2} = exprs(B0, St1),
- Anno = lineno_anno(Lc, St2),
- {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},St2}
+ {H1,Eps,St1} ->
+ {G1,St2} = guard(G0, St1),
+ {B1,St3} = exprs(B0, St2),
+ Anno = lineno_anno(Lc, St3),
+ {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},Eps,St3}
catch
throw:nomatch ->
St = add_warning(Lc, nomatch, St0),
- {noclause,St} %Bad pattern
+ {noclause,[],St} %Bad pattern
end.
clause_arity({clause,_,H0,_,_}) -> length(H0).
-%% head([P], State) -> [P].
+%% head([P], State) -> {[P],[Cexpr],State}.
-head(Ps, St) -> pattern_list(Ps, St).
+head(Ps, St) ->
+ pattern_list(Ps, St).
%% guard([Expr], State) -> {[Cexpr],State}.
%% Build an explict and/or tree of guard alternatives, then traverse
@@ -514,22 +535,7 @@ expr({tuple,L,Es0}, St0) ->
A = record_anno(L, St1),
{annotate_tuple(A, Es1, St1),Eps,St1};
expr({map,L,Es0}, St0) ->
- % erl_lint should make sure only #{ K => V } are allowed
- % in map construction.
- try map_pair_list(Es0, St0) of
- {Es1,Eps,St1} ->
- A = lineno_anno(L, St1),
- {ann_c_map(A,Es1),Eps,St1}
- catch
- throw:{bad_map,Warning} ->
- St = add_warning(L, Warning, St0),
- LineAnno = lineno_anno(L, St),
- As = [#c_literal{anno=LineAnno,val=badarg}],
- {#icall{anno=#a{anno=LineAnno}, %Must have an #a{}
- module=#c_literal{anno=LineAnno,val=erlang},
- name=#c_literal{anno=LineAnno,val=error},
- args=As},[],St}
- end;
+ map_build_pair_chain(#c_literal{val=#{}},Es0,lineno_anno(L,St0),St0);
expr({map,L,M0,Es0}, St0) ->
try expr_map(M0,Es0,lineno_anno(L, St0),St0) of
{_,_,_}=Res -> Res
@@ -562,26 +568,26 @@ expr({block,_,Es0}, St0) ->
{E1,Eps,St2} = expr(last(Es0), St1),
{E1,Es1 ++ Eps,St2};
expr({'if',L,Cs0}, St0) ->
- {Cs1,St1} = clauses(Cs0, St0),
+ {Cs1,Ceps,St1} = clauses(Cs0, St0),
Lanno = lineno_anno(L, St1),
Fc = fail_clause([], Lanno, #c_literal{val=if_clause}),
- {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},[],St1};
+ {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},Ceps,St1};
expr({'case',L,E0,Cs0}, St0) ->
{E1,Eps,St1} = novars(E0, St0),
- {Cs1,St2} = clauses(Cs0, St1),
+ {Cs1,Ceps,St2} = clauses(Cs0, St1),
{Fpat,St3} = new_var(St2),
Lanno = lineno_anno(L, St2),
Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=case_clause},Fpat])),
- {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps,St3};
+ {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps++Ceps,St3};
expr({'receive',L,Cs0}, St0) ->
- {Cs1,St1} = clauses(Cs0, St0),
- {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1}, [], St1};
+ {Cs1,Ceps,St1} = clauses(Cs0, St0),
+ {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1},Ceps, St1};
expr({'receive',L,Cs0,Te0,Tes0}, St0) ->
{Te1,Teps,St1} = novars(Te0, St0),
{Tes1,St2} = exprs(Tes0, St1),
- {Cs1,St3} = clauses(Cs0, St2),
+ {Cs1,Ceps,St3} = clauses(Cs0, St2),
{#ireceive2{anno=#a{anno=lineno_anno(L, St3)},
- clauses=Cs1,timeout=Te1,action=Tes1},Teps,St3};
+ clauses=Cs1,timeout=Te1,action=Tes1},Teps++Ceps,St3};
expr({'try',L,Es0,[],Ecs,[]}, St0) ->
%% 'try ... catch ... end'
{Es1,St1} = exprs(Es0, St0),
@@ -595,7 +601,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) ->
%% 'try ... of ... catch ... end'
{Es1,St1} = exprs(Es0, St0),
{V,St2} = new_var(St1), %This name should be arbitrary
- {Cs1,St3} = clauses(Cs0, St2),
+ {Cs1,Ceps,St3} = clauses(Cs0, St2),
{Fpat,St4} = new_var(St3),
Lanno = lineno_anno(L, St4),
Fc = fail_clause([Fpat], Lanno,
@@ -604,7 +610,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) ->
{#itry{anno=#a{anno=lineno_anno(L, St5)},args=Es1,
vars=[V],body=[#icase{anno=#a{anno=Lanno},args=[V],clauses=Cs1,fc=Fc}],
evars=Evs,handler=Hs},
- [],St5};
+ Ceps,St5};
expr({'try',L,Es0,[],[],As0}, St0) ->
%% 'try ... after ... end'
{Es1,St1} = exprs(Es0, St0),
@@ -673,24 +679,24 @@ expr({match,L,P0,E0}, St0) ->
{var,_,'_'} -> St0#core{wanted=false};
_ -> St0
end,
- {E2,Eps,St2} = novars(E1, St1),
+ {E2,Eps1,St2} = novars(E1, St1),
St3 = St2#core{wanted=St0#core.wanted},
- P2 = try
- pattern(P1, St3)
+ {P2,Eps2,St4} = try
+ pattern(P1, St3)
catch
throw:Thrown ->
- Thrown
+ {Thrown,[],St3}
end,
- {Fpat,St4} = new_var(St3),
- Lanno = lineno_anno(L, St4),
+ {Fpat,St5} = new_var(St4),
+ Lanno = lineno_anno(L, St5),
Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])),
case P2 of
nomatch ->
- St = add_warning(L, nomatch, St4),
+ St = add_warning(L, nomatch, St5),
{#icase{anno=#a{anno=Lanno},
- args=[E2],clauses=[],fc=Fc},Eps,St};
+ args=[E2],clauses=[],fc=Fc},Eps1++Eps2,St};
Other when not is_atom(Other) ->
- {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4}
+ {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5}
end;
expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) ->
%% Optimise '++' here because of the list comprehension algorithm.
@@ -772,44 +778,77 @@ expr_map(M0,Es0,A,St0) ->
Fc = fail_clause([Fpat], A, #c_literal{val=badarg}),
{#icase{anno=#a{anno=A},args=[M1],clauses=Cs,fc=Fc},Mps,St3};
{_,_} ->
- {Es1,Eps,St2} = map_pair_list(Es0, St1),
- {ann_c_map(A,M1,Es1),Mps++Eps,St2}
+ {M2,Eps,St2} = map_build_pair_chain(M1,Es0,A,St1),
+ {M2,Mps++Eps,St2}
end;
false -> throw({bad_map,bad_map})
end.
+%% Group continuous literal blocks and single variables, i.e.
+%% M0#{ a := 1, b := V1, K1 := V2, K2 := 42}
+%% becomes equivalent to
+%% M1 = M0#{ a := 1, b := V1 },
+%% M2 = M1#{ K1 := V1 },
+%% M3 = M2#{ K2 := 42 }
+
+map_build_pair_chain(M,Es,A,St) ->
+ %% hack, remove iset if only literal
+ case map_build_pair_chain(M,Es,A,St,[]) of
+ {_,[#iset{arg=#c_literal{}=Val}],St1} -> {Val,[],St1};
+ Normal -> Normal
+ end.
+
+map_build_pair_chain(M0,[],_,St,Mps) ->
+ {M0,Mps,St};
+map_build_pair_chain(M0,Es0,A,St0,Mps) ->
+ % group continuous literal blocks
+ % Anno = #a{anno=[compiler_generated]},
+ % order is important, we need to reverse the literals
+ case map_pair_block(Es0,[],[],St0) of
+ {{CesL,EspL},{[],[]},Es1,St1} ->
+ {MVar,St2} = new_var(St1),
+ Pre = [#iset{var=MVar, arg=ann_c_map(A,M0,reverse(CesL))}],
+ map_build_pair_chain(MVar,Es1,A,St2,Mps++EspL++Pre);
+ {{[],[]},{CesV,EspV},Es1,St1} ->
+ {MVar,St2} = new_var(St1),
+ Pre = [#iset{var=MVar, arg=#c_map{arg=M0,es=CesV, anno=A}}],
+ map_build_pair_chain(MVar,Es1,A,St2,Mps ++ EspV++Pre);
+ {{CesL,EspL},{CesV,EspV},Es1,St1} ->
+ {MVarL,St2} = new_var(St1),
+ {MVarV,St3} = new_var(St2),
+ Pre = [#iset{var=MVarL, arg=ann_c_map(A,M0,reverse(CesL))},
+ #iset{var=MVarV, arg=#c_map{arg=MVarL,es=CesV,anno=A}}],
+ map_build_pair_chain(MVarV,Es1,A,St3,Mps++EspL++EspV++Pre)
+ end.
+
+map_pair_block([{Op,L,K0,V0}|Es],Ces,Esp,St0) ->
+ {K,Ep0,St1} = safe(K0, St0),
+ {V,Ep1,St2} = safe(V0, St1),
+ A = lineno_anno(L, St2),
+ Pair0 = map_op_to_c_map_pair(Op),
+ Pair1 = Pair0#c_map_pair{anno=A,key=K,val=V},
+ case cerl:is_literal(K) of
+ true ->
+ map_pair_block(Es,[Pair1|Ces],Ep0 ++ Ep1 ++ Esp,St2);
+ false ->
+ {{Ces,Esp},{[Pair1],Ep0++Ep1},Es,St2}
+ end;
+map_pair_block([],Ces,Esp,St) ->
+ {{Ces,Esp},{[],[]},[],St}.
+
+map_op_to_c_map_pair(map_field_assoc) -> #c_map_pair{op=#c_literal{val=assoc}};
+map_op_to_c_map_pair(map_field_exact) -> #c_map_pair{op=#c_literal{val=exact}}.
+
is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true;
-is_valid_map_src(#c_map{}) -> true;
is_valid_map_src(#c_var{}) -> true;
is_valid_map_src(_) -> false.
-map_pair_list(Es, St) ->
- foldr(fun
- ({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) ->
- {K,Ep0,St1} = safe(K0, St0),
- ok = ensure_valid_map_key(K),
- {V,Ep1,St2} = safe(V0, St1),
- A = lineno_anno(L, St2),
- Pair = #c_map_pair{op=#c_literal{val=assoc},anno=A,key=K,val=V},
- {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2};
- ({map_field_exact,L,K0,V0}, {Ces,Esp,St0}) ->
- {K,Ep0,St1} = safe(K0, St0),
- ok = ensure_valid_map_key(K),
- {V,Ep1,St2} = safe(V0, St1),
- A = lineno_anno(L, St2),
- Pair = #c_map_pair{op=#c_literal{val=exact},anno=A,key=K,val=V},
- {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2}
- end, {[],[],St}, Es).
-
-ensure_valid_map_key(#c_literal{}) -> ok;
-ensure_valid_map_key(_) -> throw({bad_map,bad_map_key}).
-
%% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}.
try_exception(Ecs0, St0) ->
%% Note that Tag is not needed for rethrow - it is already in Info.
{Evs,St1} = new_vars(3, St0), % Tag, Value, Info
- {Ecs1,St2} = clauses(Ecs0, St1),
+ {Ecs1,Ceps,St2} = clauses(Ecs0, St1),
[_,Value,Info] = Evs,
Ec = #iclause{anno=#a{anno=[compiler_generated]},
pats=[c_tuple(Evs)],guard=[#c_literal{val=true}],
@@ -817,15 +856,15 @@ try_exception(Ecs0, St0) ->
name=#c_literal{val=raise},
args=[Info,Value]}]},
Hs = [#icase{anno=#a{},args=[c_tuple(Evs)],clauses=Ecs1,fc=Ec}],
- {Evs,Hs,St2}.
+ {Evs,Ceps++Hs,St2}.
try_after(As, St0) ->
%% See above.
- {Evs,St1} = new_vars(3, St0), % Tag, Value, Info
+ {Evs,St1} = new_vars(3, St0), % Tag, Value, Info
[_,Value,Info] = Evs,
- B = As ++ [#iprimop{anno=#a{}, %Must have an #a{}
- name=#c_literal{val=raise},
- args=[Info,Value]}],
+ B = As ++ [#iprimop{anno=#a{}, % Must have an #a{}
+ name=#c_literal{val=raise},
+ args=[Info,Value]}],
Ec = #iclause{anno=#a{anno=[compiler_generated]},
pats=[c_tuple(Evs)],guard=[#c_literal{val=true}],
body=B},
@@ -959,7 +998,7 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) ->
fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) ->
Arity = clause_arity(hd(Cs0)),
- {Cs1,St1} = clauses(Cs0, St0),
+ {Cs1,Ceps,St1} = clauses(Cs0, St0),
{Args,St2} = new_vars(Arity, St1),
{Ps,St3} = new_vars(Arity, St2), %Need new variables here
Anno = lineno_anno(L, St3),
@@ -967,7 +1006,7 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) ->
Fun = #ifun{anno=#a{anno=Anno},
id=[{id,Id}], %We KNOW!
vars=Args,clauses=Cs1,fc=Fc,name=NameInfo},
- {Fun,[],St3}.
+ {Fun,Ceps,St3}.
%% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}.
%% This TQ from Simon PJ pp 127-138.
@@ -1181,7 +1220,7 @@ is_generator(_) -> false.
generator(Line, {generate,Lg,P0,E}, Gs, St0) ->
LA = lineno_anno(Line, St0),
GA = lineno_anno(Lg, St0),
- {Head,St1} = list_gen_pattern(P0, Line, St0),
+ {Head,Ceps,St1} = list_gen_pattern(P0, Line, St0),
{[Tail,Skip],St2} = new_vars(2, St1),
{Cg,St3} = lc_guard_tests(Gs, St2),
{AccPat,SkipPat} = case Head of
@@ -1202,24 +1241,25 @@ generator(Line, {generate,Lg,P0,E}, Gs, St0) ->
end,
{Ce,Pre,St4} = safe(E, St3),
Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat,
- tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Pre,Ce}},
+ tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Ceps++Pre,Ce}},
{Gen,St4};
generator(Line, {b_generate,Lg,P,E}, Gs, St0) ->
LA = lineno_anno(Line, St0),
GA = lineno_anno(Lg, St0),
- Cp = #c_binary{segments=Segs} = pattern(P, St0),
+ {Cp = #c_binary{segments=Segs},[],St1} = pattern(P, St0),
+
%% The function append_tail_segment/2 keeps variable patterns as-is, making
%% it possible to have the same skip clause removal as with list generators.
- {AccSegs,Tail,TailSeg,St1} = append_tail_segment(Segs, St0),
+ {AccSegs,Tail,TailSeg,St2} = append_tail_segment(Segs, St1),
AccPat = Cp#c_binary{segments=AccSegs},
- {Cg,St2} = lc_guard_tests(Gs, St1),
- {SkipSegs,St3} = emasculate_segments(AccSegs, St2),
+ {Cg,St3} = lc_guard_tests(Gs, St2),
+ {SkipSegs,St4} = emasculate_segments(AccSegs, St3),
SkipPat = Cp#c_binary{segments=SkipSegs},
- {Ce,Pre,St4} = safe(E, St3),
+ {Ce,Pre,St5} = safe(E, St4),
Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat,
tail=Tail,tail_pat=#c_binary{anno=LA,segments=[TailSeg]},
arg={Pre,Ce}},
- {Gen,St4}.
+ {Gen,St5}.
append_tail_segment(Segs, St0) ->
{Var,St} = new_var(St0),
@@ -1248,9 +1288,9 @@ lc_guard_tests(Gs0, St0) ->
list_gen_pattern(P0, Line, St) ->
try
- {pattern(P0, St),St}
+ pattern(P0,St)
catch
- nomatch -> {nomatch,add_warning(Line, nomatch, St)}
+ nomatch -> {nomatch,[],add_warning(Line, nomatch, St)}
end.
%%%
@@ -1473,6 +1513,18 @@ force_novars(#ibinary{}=Bin, St) -> {Bin,[],St};
force_novars(Ce, St) ->
force_safe(Ce, St).
+
+%% safe_pattern_expr(Expr, State) -> {Cexpr,[PreExpr],State}.
+%% only literals and variables are safe expressions in patterns
+safe_pattern_expr(E,St0) ->
+ case safe(E,St0) of
+ {#c_var{},_,_}=Safe -> Safe;
+ {#c_literal{},_,_}=Safe -> Safe;
+ {Ce,Eps,St1} ->
+ {V,St2} = new_var(St1),
+ {V,Eps++[#iset{var=V,arg=Ce}],St2}
+ end.
+
%% safe(Expr, State) -> {Safe,[PreExpr],State}.
%% Generate an internal safe expression. These are simples without
%% binaries which can fail. At this level we do not need to do a
@@ -1547,84 +1599,109 @@ fold_match({match,L,P0,E0}, P) ->
{{match,L,P0,P1},E1};
fold_match(E, P) -> {P,E}.
-%% pattern(Pattern, State) -> CorePat.
+%% pattern(Pattern, State) -> {CorePat,[PreExp],State}.
%% Transform a pattern by removing line numbers. We also normalise
%% aliases in patterns to standard form, {alias,Pat,[Var]}.
-
-pattern({var,L,V}, St) -> #c_var{anno=lineno_anno(L, St),name=V};
-pattern({char,L,C}, St) -> #c_literal{anno=lineno_anno(L, St),val=C};
-pattern({integer,L,I}, St) -> #c_literal{anno=lineno_anno(L, St),val=I};
-pattern({float,L,F}, St) -> #c_literal{anno=lineno_anno(L, St),val=F};
-pattern({atom,L,A}, St) -> #c_literal{anno=lineno_anno(L, St),val=A};
-pattern({string,L,S}, St) -> #c_literal{anno=lineno_anno(L, St),val=S};
-pattern({nil,L}, St) -> #c_literal{anno=lineno_anno(L, St),val=[]};
+%%
+%% In patterns we may have expressions
+%% 1) Binaries -> #c_bitstr{size=Expr}
+%% 2) Maps -> #c_map_pair{key=Expr}
+%%
+%% Both of these may generate pre-expressions since only bound variables
+%% or literals are allowed for these in core patterns.
+%%
+%% Therefor, we need to drag both the state and the collection of pre-expression
+%% around in the whole pattern transformation tree.
+
+pattern({var,L,V}, St) -> {#c_var{anno=lineno_anno(L, St),name=V},[],St};
+pattern({char,L,C}, St) -> {#c_literal{anno=lineno_anno(L, St),val=C},[],St};
+pattern({integer,L,I}, St) -> {#c_literal{anno=lineno_anno(L, St),val=I},[],St};
+pattern({float,L,F}, St) -> {#c_literal{anno=lineno_anno(L, St),val=F},[],St};
+pattern({atom,L,A}, St) -> {#c_literal{anno=lineno_anno(L, St),val=A},[],St};
+pattern({string,L,S}, St) -> {#c_literal{anno=lineno_anno(L, St),val=S},[],St};
+pattern({nil,L}, St) -> {#c_literal{anno=lineno_anno(L, St),val=[]},[],St};
pattern({cons,L,H,T}, St) ->
- annotate_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St), St);
+ {Ph,Eps1,St1} = pattern(H, St),
+ {Pt,Eps2,St2} = pattern(T, St1),
+ {annotate_cons(lineno_anno(L, St), Ph, Pt, St2),Eps1++Eps2,St2};
pattern({tuple,L,Ps}, St) ->
- annotate_tuple(record_anno(L, St), pattern_list(Ps, St), St);
-pattern({map,L,Ps}, St) ->
- #c_map{anno=lineno_anno(L, St), es=pattern_map_pairs(Ps, St)};
+ {Ps1,Eps,St1} = pattern_list(Ps,St),
+ {annotate_tuple(record_anno(L, St), Ps1, St),Eps,St1};
+pattern({map,L,Pairs}, St0) ->
+ {Ps,Eps,St1} = pattern_map_pairs(Pairs, St0),
+ {#c_map{anno=lineno_anno(L, St1), es=Ps},Eps,St1};
pattern({bin,L,Ps}, St) ->
%% We don't create a #ibinary record here, since there is
%% no need to hold any used/new annotations in a pattern.
- #c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)};
+ {#c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)},[],St};
pattern({match,_,P1,P2}, St) ->
- pat_alias(pattern(P1, St), pattern(P2, St)).
+ {Cp1,Eps1,St1} = pattern(P1,St),
+ {Cp2,Eps2,St2} = pattern(P2,St1),
+ {pat_alias(Cp1,Cp2),Eps1++Eps2,St2}.
%% pattern_map_pairs([MapFieldExact],State) -> [#c_map_pairs{}]
pattern_map_pairs(Ps, St) ->
- %% check literal key uniqueness (dict is needed)
- %% pattern all pairs
- {CMapPairs, Kdb} = lists:mapfoldl(fun
- (P,Kdbi) ->
- #c_map_pair{key=Ck,val=Cv} = CMapPair = pattern_map_pair(P,St),
- K = core_lib:literal_value(Ck),
- case dict:find(K,Kdbi) of
- {ok, Vs} ->
- {CMapPair, dict:store(K,[Cv|Vs],Kdbi)};
- _ ->
- {CMapPair, dict:store(K,[Cv],Kdbi)}
+ %% check literal key uniqueness
+ %% - guaranteed via aliasing map pairs
+ %% pattern all pairs in two steps
+ %% 1) Construct Core Pattern
+ %% 2) Alias Keys in Core Pattern
+ {CMapPairs, {Eps,St1}} = lists:mapfoldl(fun
+ (P,{EpsM,Sti0}) ->
+ {CMapPair,EpsP,Sti1} = pattern_map_pair(P,Sti0),
+ {CMapPair, {EpsM++EpsP,Sti1}}
+ end, {[],St}, Ps),
+ {pat_alias_map_pairs(CMapPairs,[]),Eps,St1}.
+
+%% remove cluddering annotations
+pattern_map_clean_key(#c_literal{val=V}) -> {literal,V};
+pattern_map_clean_key(#c_var{name=V}) -> {var,V}.
+
+pat_alias_map_pairs(Ps1,Ps2) ->
+ Ps = Ps1 ++ Ps2,
+ F = fun(#c_map_pair{key=Ck,val=Cv},Dbi) ->
+ K = pattern_map_clean_key(Ck),
+ case dict:find(K,Dbi) of
+ {ok,Cvs} -> dict:store(K,[Cv|Cvs],Dbi);
+ _ -> dict:store(K,[Cv],Dbi)
end
- end, dict:new(), Ps),
- pattern_alias_map_pairs(CMapPairs,Kdb,dict:new(),St).
-
-pattern_alias_map_pairs([],_,_,_) -> [];
-pattern_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Kset,St) ->
- %% alias same keys if needed
- K = core_lib:literal_value(Ck),
- case dict:find(K,Kset) of
- {ok,processed} ->
- pattern_alias_map_pairs(Pairs,Kdb,Kset,St);
- _ ->
+ end,
+ Kdb = lists:foldl(F,dict:new(),Ps),
+ pat_alias_map_pairs(Ps,Kdb,sets:new()).
+
+pat_alias_map_pairs([],_,_) -> [];
+pat_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Set) ->
+ K = pattern_map_clean_key(Ck),
+ case sets:is_element(K,Set) of
+ true ->
+ pat_alias_map_pairs(Pairs,Kdb,Set);
+ false ->
Cvs = dict:fetch(K,Kdb),
- Cv = pattern_alias_map_pair_patterns(Cvs),
- Kset1 = dict:store(K, processed, Kset),
- [Pair#c_map_pair{val=Cv}|pattern_alias_map_pairs(Pairs,Kdb,Kset1,St)]
+ Cv = pat_alias_map_pair_values(Cvs),
+ Set1 = sets:add_element(K,Set),
+ [Pair#c_map_pair{val=Cv}|pat_alias_map_pairs(Pairs,Kdb,Set1)]
end.
-pattern_alias_map_pair_patterns([Cv]) -> Cv;
-pattern_alias_map_pair_patterns([Cv1,Cv2|Cvs]) ->
- pattern_alias_map_pair_patterns([pat_alias(Cv1,Cv2)|Cvs]).
-
-pattern_map_pair({map_field_exact,L,K,V}, St) ->
- case expr(K,St) of
- {#c_literal{}=Key,_,_} ->
- #c_map_pair{anno=lineno_anno(L, St),
- op=#c_literal{val=exact},
- key=Key,
- val=pattern(V, St)};
- _ ->
- %% this will throw a cryptic error message
- %% but it is better than nothing
- throw(nomatch)
- end.
+pat_alias_map_pair_values([Cv]) -> Cv;
+pat_alias_map_pair_values([Cv1,Cv2|Cvs]) ->
+ pat_alias_map_pair_values([pat_alias(Cv1,Cv2)|Cvs]).
+
+pattern_map_pair({map_field_exact,L,K,V}, St0) ->
+ {Ck,EpsK,St1} = safe_pattern_expr(K,St0),
+ {Cv,EpsV,St2} = pattern(V, St1),
+ {#c_map_pair{anno=lineno_anno(L,St2),
+ op=#c_literal{val=exact},
+ key=Ck,
+ val=Cv},EpsK++EpsV,St2}.
%% pat_bin([BinElement], State) -> [BinSeg].
pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps].
-pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}, St) ->
- #c_bitstr{val=pattern(Term, St),size=pattern(Size, St),
+pat_segment({bin_element,_,Val,Size,[Type,{unit,Unit}|Flags]}, St) ->
+ {Pval,[],St1} = pattern(Val,St),
+ {Psize,[],_St2} = pattern(Size,St1),
+ #c_bitstr{val=Pval,size=Psize,
unit=#c_literal{val=Unit},
type=#c_literal{val=Type},
flags=#c_literal{val=Flags}}.
@@ -1634,6 +1711,8 @@ pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}, St) ->
pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2};
pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1};
+
+%% alias cons
pat_alias(#c_cons{}=Cons, #c_literal{anno=A,val=[H|T]}=S) ->
pat_alias(Cons, ann_c_cons_skel(A, #c_literal{anno=A,val=H},
S#c_literal{val=T}));
@@ -1642,6 +1721,8 @@ pat_alias(#c_literal{anno=A,val=[H|T]}=S, #c_cons{}=Cons) ->
S#c_literal{val=T}), Cons);
pat_alias(#c_cons{anno=Anno,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) ->
ann_c_cons(Anno, pat_alias(H1, H2), pat_alias(T1, T2));
+
+%% alias tuples
pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_literal{val=T}) when is_tuple(T) ->
Es2 = [#c_literal{val=E} || E <- tuple_to_list(T)],
ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
@@ -1650,6 +1731,12 @@ pat_alias(#c_literal{anno=Anno,val=T}, #c_tuple{es=Es2}) when is_tuple(T) ->
ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_tuple{es=Es2}) ->
ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
+
+%% alias maps
+%% There are no literals in maps patterns (patterns are always abstract)
+pat_alias(#c_map{es=Es1}=M,#c_map{es=Es2}) ->
+ M#c_map{es=pat_alias_map_pairs(Es1,Es2)};
+
pat_alias(#c_alias{var=V1,pat=P1},
#c_alias{var=V2,pat=P2}) ->
if V1 =:= V2 -> #c_alias{var=V1,pat=pat_alias(P1, P2)};
@@ -1672,9 +1759,15 @@ pat_alias_list([A1|A1s], [A2|A2s]) ->
pat_alias_list([], []) -> [];
pat_alias_list(_, _) -> throw(nomatch).
-%% pattern_list([P], State) -> [P].
+%% pattern_list([P], State) -> {[P],Exprs,St}
+
+pattern_list([P0|Ps0], St0) ->
+ {P1,Eps,St1} = pattern(P0, St0),
+ {Ps1,Epsl,St2} = pattern_list(Ps0, St1),
+ {[P1|Ps1], Eps ++ Epsl, St2};
+pattern_list([], St) ->
+ {[],[],St}.
-pattern_list(Ps, St) -> [pattern(P, St) || P <- Ps].
%% make_vars([Name]) -> [{Var,Name}].
@@ -1974,9 +2067,14 @@ upattern(#c_tuple{es=Es0}=Tuple, Ks, St0) ->
upattern(#c_map{es=Es0}=Map, Ks, St0) ->
{Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0),
{Map#c_map{es=Es1},Esg,Esv,Eus,St1};
-upattern(#c_map_pair{op=#c_literal{val=exact},val=V0}=MapPair, Ks, St0) ->
- {V,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0),
- {MapPair#c_map_pair{val=V},Vg,Vv,Vu,St1};
+upattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,Ks,St0) ->
+ {V,Vg,Vn,Vu,St1} = upattern(V0, Ks, St0),
+ % A variable key must be considered used here
+ Ku = case K0 of
+ #c_var{name=Name} -> [Name];
+ _ -> []
+ end,
+ {Pair#c_map_pair{val=V},Vg,Vn,union(Ku,Vu),St1};
upattern(#c_binary{segments=Es0}=Bin, Ks, St0) ->
{Es1,Esg,Esv,Eus,St1} = upat_bin(Es0, Ks, St0),
{Bin#c_binary{segments=Es1},Esg,Esv,Eus,St1};
@@ -2347,8 +2445,6 @@ format_error(nomatch) ->
"pattern cannot possibly match";
format_error(bad_binary) ->
"binary construction will fail because of a type mismatch";
-format_error(bad_map_key) ->
- "map construction will fail because of none literal key (large binaries are not literals)";
format_error(bad_map) ->
"map construction will fail because of a type mismatch".
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 40d2f72b4c..6504351c02 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -527,9 +527,9 @@ map_split_pairs(A, Var, Ces, Sub, St0) ->
Pairs0 = [{Op,K,V} || #c_map_pair{op=#c_literal{val=Op},key=K,val=V} <- Ces],
{Pairs,Esp,St1} = foldr(fun
({Op,K0,V0}, {Ops,Espi,Sti0}) when Op =:= assoc; Op =:= exact ->
- {K,[],Sti1} = expr(K0, Sub, Sti0),
- {V,Ep,Sti2} = atomic(V0, Sub, Sti1),
- {[{Op,K,V}|Ops],Ep ++ Espi,Sti2}
+ {K,Eps1,Sti1} = atomic(K0, Sub, Sti0),
+ {V,Eps2,Sti2} = atomic(V0, Sub, Sti1),
+ {[{Op,K,V}|Ops],Eps1 ++ Eps2 ++ Espi,Sti2}
end, {[],[],St0}, Pairs0),
case map_group_pairs(Pairs) of
@@ -577,11 +577,12 @@ map_key_is_used(K,Used) ->
dict:find(map_key_clean(K),Used).
%% Be explicit instead of using set_kanno(K,[])
-map_key_clean(#k_literal{val=V}) -> {k_literal,V};
-map_key_clean(#k_int{val=V}) -> {k_int,V};
-map_key_clean(#k_float{val=V}) -> {k_float,V};
-map_key_clean(#k_atom{val=V}) -> {k_atom,V};
-map_key_clean(#k_nil{}) -> k_nil.
+map_key_clean(#k_var{name=V}) -> {var,V};
+map_key_clean(#k_literal{val=V}) -> {lit,V};
+map_key_clean(#k_int{val=V}) -> {lit,V};
+map_key_clean(#k_float{val=V}) -> {lit,V};
+map_key_clean(#k_atom{val=V}) -> {lit,V};
+map_key_clean(#k_nil{}) -> {lit,[]}.
%% call_type(Module, Function, Arity) -> call | bif | apply | error.
@@ -757,23 +758,22 @@ flatten_alias(#c_alias{var=V,pat=P}) ->
flatten_alias(Pat) -> {[],Pat}.
pattern_map_pairs(Ces0, Isub, Osub0, St0) ->
- %% It is assumed that all core keys are literals
- %% It is later assumed that these keys are term sorted
- %% so we need to sort them here
- Ces1 = lists:sort(fun
- (#c_map_pair{key=CkA},#c_map_pair{key=CkB}) ->
- A = core_lib:literal_value(CkA),
- B = core_lib:literal_value(CkB),
- erts_internal:cmp_term(A,B) < 0
- end, Ces0),
%% pattern the pair keys and values as normal
{Kes,{Osub1,St1}} = lists:mapfoldl(fun
(#c_map_pair{anno=A,key=Ck,val=Cv},{Osubi0,Sti0}) ->
- {Kk,Osubi1,Sti1} = pattern(Ck, Isub, Osubi0, Sti0),
- {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi1, Sti1),
+ {Kk,[],Sti1} = expr(Ck, Isub, Sti0),
+ {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi0, Sti1),
{#k_map_pair{anno=A,key=Kk,val=Kv},{Osubi2,Sti2}}
- end, {Osub0, St0}, Ces1),
- {Kes,Osub1,St1}.
+ end, {Osub0, St0}, Ces0),
+ %% It is later assumed that these keys are term sorted
+ %% so we need to sort them here
+ Kes1 = lists:sort(fun
+ (#k_map_pair{key=KkA},#k_map_pair{key=KkB}) ->
+ A = map_key_clean(KkA),
+ B = map_key_clean(KkB),
+ erts_internal:cmp_term(A,B) < 0
+ end, Kes),
+ {Kes1,Osub1,St1}.
pattern_bin(Es, Isub, Osub0, St0) ->
{Kbin,{_,Osub},St} = pattern_bin_1(Es, Isub, Osub0, St0),
@@ -1550,13 +1550,11 @@ arg_val(Arg, C) ->
{set_kanno(S, []),U,T,Fs}
end;
#k_map{op=exact,es=Es} ->
- Keys = [begin
- #k_map_pair{key=#k_literal{val=Key}} = Pair,
- Key
- end || Pair <- Es],
- %% multiple keys may have the same name
- %% do not use ordsets
- lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Keys)
+ lists:sort(fun(A,B) ->
+ %% on the form K :: {'lit' | 'var', term()}
+ %% lit < var as intended
+ erts_internal:cmp_term(A,B) < 0
+ end, [map_key_clean(Key) || #k_map_pair{key=Key} <- Es])
end.
%% ubody_used_vars(Expr, State) -> [UsedVar]
@@ -1943,6 +1941,7 @@ lit_list_vars(Ps) ->
%% pat_vars(Pattern) -> {[UsedVarName],[NewVarName]}.
%% Return variables in a pattern. All variables are new variables
%% except those in the size field of binary segments.
+%% and map_pair keys
pat_vars(#k_var{name=N}) -> {[],[N]};
%%pat_vars(#k_char{}) -> {[],[]};
@@ -1967,8 +1966,10 @@ pat_vars(#k_tuple{es=Es}) ->
pat_list_vars(Es);
pat_vars(#k_map{es=Es}) ->
pat_list_vars(Es);
-pat_vars(#k_map_pair{val=V}) ->
- pat_vars(V).
+pat_vars(#k_map_pair{key=K,val=V}) ->
+ {U1,New} = pat_vars(V),
+ {[], U2} = pat_vars(K),
+ {union(U1,U2),New}.
pat_list_vars(Ps) ->
foldl(fun (P, {Used0,New0}) ->
diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl
index ab66445f73..b008285d9f 100644
--- a/lib/compiler/src/v3_kernel.hrl
+++ b/lib/compiler/src/v3_kernel.hrl
@@ -38,7 +38,7 @@
-record(k_nil, {anno=[]}).
-record(k_tuple, {anno=[],es}).
--record(k_map, {anno=[],var,op,es}).
+-record(k_map, {anno=[],var=#k_literal{val=#{}},op,es}).
-record(k_map_pair, {anno=[],key,val}).
-record(k_cons, {anno=[],hd,tl}).
-record(k_binary, {anno=[],segs}).
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index 0b56a49cd6..892a401c75 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -108,7 +108,7 @@ RELSYSDIR = $(RELEASE_PATH)/compiler_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +clint
+ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +clint +clint0
EBIN = .
diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl
index f7b1dbdddf..8711f35e8e 100644
--- a/lib/compiler/test/compilation_SUITE.erl
+++ b/lib/compiler/test/compilation_SUITE.erl
@@ -436,7 +436,7 @@ self_compile_1(Config, Prefix, Opts) ->
%% Compile the compiler. (In this node to get better coverage.)
?line CompA = make_compiler_dir(Priv, Prefix++"compiler_a"),
?line VsnA = Version ++ ".0",
- ?line compile_compiler(compiler_src(), CompA, VsnA, [clint|Opts]),
+ compile_compiler(compiler_src(), CompA, VsnA, [clint0,clint|Opts]),
%% Compile the compiler again using the newly compiled compiler.
%% (In another node because reloading the compiler would disturb cover.)
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 8cb7d1b55b..128291dc67 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -365,7 +365,7 @@ listings_big(Config) when is_list(Config) ->
?line do_listing(Big, TargetDir, dkern, ".kernel"),
?line Target = filename:join(TargetDir, big),
- ?line {ok,big} = compile:file(Target, [asm,{outdir,TargetDir}]),
+ {ok,big} = compile:file(Target, [from_asm,{outdir,TargetDir}]),
%% Cleanup.
?line ok = file:delete(Target ++ ".beam"),
diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl
index bd877bb528..0d23f12fb5 100644
--- a/lib/compiler/test/error_SUITE.erl
+++ b/lib/compiler/test/error_SUITE.erl
@@ -23,7 +23,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
head_mismatch_line/1,warnings_as_errors/1, bif_clashes/1,
- transforms/1,forbidden_maps/1,bad_utf8/1]).
+ transforms/1,maps_warnings/1,bad_utf8/1]).
%% Used by transforms/1 test case.
-export([parse_transform/2]).
@@ -37,7 +37,7 @@ all() ->
groups() ->
[{p,test_lib:parallel(),
[head_mismatch_line,warnings_as_errors,bif_clashes,
- transforms,forbidden_maps,bad_utf8]}].
+ transforms,maps_warnings,bad_utf8]}].
init_per_suite(Config) ->
Config.
@@ -241,17 +241,30 @@ parse_transform(_, _) ->
error(too_bad).
-forbidden_maps(Config) when is_list(Config) ->
- Ts1 = [{map_illegal_use_of_pattern,
+maps_warnings(Config) when is_list(Config) ->
+ Ts1 = [{map_ok_use_of_pattern,
<<"
- -export([t/0]).
+ -export([t/1]).
+ t(K) ->
+ #{K := 1 = V} = id(#{<<\"hi all\">> => 1}),
+ V.
+ id(I) -> I.
+ ">>,
+ [return],
+ []},
+ {map_illegal_use_of_pattern,
+ <<"
+ -export([t/0,t/2]).
+ t(K,#{ K := V }) -> V.
t() ->
V = 32,
#{<<\"hi\",V,\"all\">> := 1} = id(#{<<\"hi all\">> => 1}).
id(I) -> I.
">>,
[return],
- {error,[{5,erl_lint,{illegal_map_key_variable,'V'}}], []}}],
+ {error,[{3,erl_lint,{unbound_var,'K'}},
+ {6,erl_lint,illegal_map_key}],[]}}
+ ],
[] = run2(Config, Ts1),
ok.
diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
index 403b7e8405..75efce9d7b 100644
--- a/lib/compiler/test/map_SUITE.erl
+++ b/lib/compiler/test/map_SUITE.erl
@@ -21,6 +21,7 @@
]).
-export([
+ %% literals
t_build_and_match_literals/1,
t_update_literals/1,t_match_and_update_literals/1,
t_update_map_expressions/1,
@@ -32,6 +33,15 @@
t_map_size/1,
t_build_and_match_aliasing/1,
+ %% variables
+ t_build_and_match_variables/1,
+ t_update_assoc_variables/1,t_update_exact_variables/1,
+ t_nested_pattern_expressions/1,
+ t_guard_update_variables/1,
+ t_guard_sequence_variables/1,
+ t_guard_sequence_mixed/1,
+ t_frequency_table/1,
+
%% warnings
t_warn_useless_build/1,
t_warn_pair_key_overloaded/1,
@@ -52,6 +62,7 @@
suite() -> [].
all() -> [
+ %% literals
t_build_and_match_literals,
t_update_literals, t_match_and_update_literals,
t_update_map_expressions,
@@ -62,6 +73,15 @@ all() -> [
t_map_size,
t_build_and_match_aliasing,
+ %% variables
+ t_build_and_match_variables,
+ t_update_assoc_variables,t_update_exact_variables,
+ t_nested_pattern_expressions,
+ t_guard_update_variables,
+ t_guard_sequence_variables,
+ t_guard_sequence_mixed,
+ t_frequency_table,
+
%% warnings
t_warn_useless_build,
t_warn_pair_key_overloaded,
@@ -73,6 +93,7 @@ all() -> [
t_build_and_match_nil,
t_build_and_match_structure,
+
%% errors in 17.0-rc1
t_update_values,
t_expand_map_update,
@@ -119,6 +140,11 @@ t_build_and_match_literals(Config) when is_list(Config) ->
%% nil key
#{[]:=ok,1:=2} = id(#{[]=>ok,1=>2}),
+ #{1:=2,[]:=ok,1:=2} = id(#{[]=>ok,1=>2}),
+
+ %% pseudo literals
+ #{ -3 := yep } = id(#{ -3 => yep }),
+ #{ <<0:358>> := "three" } = id(#{<<0:358>> =>"three"}),
%% error case
{'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))),
@@ -126,10 +152,10 @@ t_build_and_match_literals(Config) when is_list(Config) ->
{'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))),
{'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))),
{'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))),
- {'EXIT',{badarg,_}} = (catch id(#{<<0:258>> =>"three"})),
{'EXIT',{{badmatch,_},_}} = (catch (#{#{"a"=>42} := 3}=id(#{#{"a"=>3}=>42}))),
ok.
+
t_build_and_match_aliasing(Config) when is_list(Config) ->
M1 = id(#{a=>1,b=>2,c=>3,d=>4}),
#{c:=C1=_=_=C2} = M1,
@@ -143,6 +169,19 @@ t_build_and_match_aliasing(Config) when is_list(Config) ->
M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}),
#{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2,
#{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2,
+
+ #{a:=A1,a:=A1,a:=A1,b:=B1,b:=B1} = #{a:=A1,a:=A1,a:=A1,b:=B1,b:=B1,b:=2} = M1,
+ #{"a":=A3,"b":=B3} = #{"a":=A3,"a":=A3} = #{"b":=B3,"b":=2} = M2,
+
+ #{"a":=1,"b":=2,"c":=3,"d":=4} = #{"a":=A4,"b":=B4} = #{"a":=A4,"a":=A4} = #{"b":=B4,"d":=4} = M2,
+ #{"a":=A5,"b":=B5} = #{"a":=A5,"a":=A5} = #{"b":=B5,"d":=4} = #{"a":=1,"b":=2,"c":=3,"d":=4} = M2,
+ #{"a":=_,"b":=_} = #{"a":=_,"a":=_} = #{"b":=_,"d":=4} = #{"a":=1,"b":=2,"c":=3,"d":=4} = M2,
+
+ M3 = id(#{<<12:300>>=>1,<<13:300>>=>2}),
+ #{<<12:300>> := V1, <<13:300>> := V2} = #{<<13:300>> := V2, <<12:300>> := V1} = M3,
+ #{<<12:300>> := 1, <<13:300>> := 2} = #{<<13:300>> := _, <<12:300>> := _} = M3,
+ #{<<13:300>> := _, <<12:300>> := _} = #{<<12:300>> := 1, <<13:300>> := 2} = M3,
+
ok.
t_map_size(Config) when is_list(Config) ->
@@ -241,11 +280,14 @@ t_update_assoc(Config) when is_list(Config) ->
#{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2,
M2 = M0#{3.0:=wrong,3.0=>new},
+ % Can't handle directly yet
+ Bin = <<0:257>>,
+ #{ Bin := val } = id(M0#{<<0:257>> => val}), %% binary limitation
+
%% Errors cases.
BadMap = id(badmap),
{'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}),
{'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}),
- {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> => val}), %% limitation
ok.
t_update_exact(Config) when is_list(Config) ->
@@ -281,8 +323,10 @@ t_update_values(Config) when is_list(Config) ->
V0 = id(1337),
M0 = #{ a => 1, val => V0},
V1 = get_val(M0),
- M1 = M0#{ val := [V0,V1], "wazzup" => 42 },
+ M1 = id(M0#{ val := [V0,V1], "wazzup" => 42 }),
[1337, {some_val, 1337}] = get_val(M1),
+ M2 = id(M1#{ <<42:333>> => 1337 }),
+ {bin_key,1337} = get_val(M2),
N = 110,
List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)],
@@ -308,6 +352,7 @@ t_export(Config) when is_list(Config) ->
check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok.
+get_val(#{ <<42:333>> := V }) -> {bin_key, V};
get_val(#{ "wazzup" := _, val := V}) -> V;
get_val(#{ val := V }) -> {some_val, V}.
@@ -437,7 +482,10 @@ guard_receive_loop() ->
t_list_comprehension(Config) when is_list(Config) ->
- [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]],
+ [#{k:=1},#{k:=2},#{k:=3}] = id([#{k=>I} || I <- [1,2,3]]),
+ Ls = id([#{<<2:301>> => I, "wat" => I + 1} || I <- [1,2,3]]),
+ [#{<<2:301>>:=1,"wat":=2},#{<<2:301>>:=2,"wat":=3},#{<<2:301>>:=3,"wat":=4}] = Ls,
+ [{1,2},{2,3},{3,4}] = id([{I2,I1} || #{"wat" := I1, <<2:301>> := I2} <- Ls]),
ok.
t_guard_fun(Config) when is_list(Config) ->
@@ -601,5 +649,325 @@ t_build_and_match_structure(Config) when is_list(Config) ->
end,
ok.
+%% simple build and match variables
+t_build_and_match_variables(Config) when is_list(Config) ->
+ K0 = id(#{}),
+ K1 = id(1), V1 = id(a),
+ K2 = id(2), V2 = id(b),
+ K3 = id(3), V3 = id("c"),
+ K4 = id("4"), V4 = id("d"),
+ K5 = id(<<"5">>), V5 = id(<<"e">>),
+ K6 = id({"6",7}), V6 = id("f"),
+ K7 = id(#{ "a" => 3 }),
+ #{K1:=V1} = id(#{K1=>V1}),
+ #{K1:=V1,K2:=V2} = id(#{K1=>V1,K2=>V2}),
+ #{K1:=V1,K2:=V2,K3:=V3} = id(#{K1=>V1,K2=>V2,K3=>V3}),
+ #{K1:=V1,K2:=V2,K3:=V3,K4:=V4} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4}),
+ #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5}),
+ #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5,K6:=V6} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5,K6=>V6}),
+
+ #{K5:=X,K5:=X=3,K4:=4} = id(#{K5=>3,K4=>4}),
+ #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{K5=>3,K4=>4}),
+ #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{<<"5">>=>3,K4=>4}),
+
+ #{ K4:=#{ K3:=#{K1:=V1, K2:=V2}}, K5:=V5} =
+ id(#{ K5=>V5, K4=>#{ K3=>#{K2 => V2, K1 => V1}}}),
+ #{ K4 := #{ K5 := Res }, K6 := Res} = id(#{K4=>#{K5 => 99}, K6 => 99}),
+
+ %% has keys
+ #{a :=_,b :=_,K1:=_,K2:=_,K3:=V3,K4:=ResKey,K4:=ResKey,"4":=ResKey,"4":="ok"} =
+ id(#{ a=>1, b=>1, K1=>V1, K2=>V2, K3=>V3, K4=>"nope", "4"=>"ok" }),
+
+ %% function
+ ok = match_function_map_neg_keys(#{ -1 => a, -2 => b, -3 => c }),
+
+ %% map key
+ #{ K0 := 42 } = id(#{ K0 => 42 }),
+ #{ K7 := 42 } = id(#{ K7 => 42 }),
+
+ %% nil key
+ KNIL = id([]),
+ #{KNIL:=ok,1:=2} = id(#{KNIL=>ok,1=>2}),
+
+ Bin = <<0:258>>,
+ #{ Bin := "three" } = id(#{<<0:258>> =>"three"}),
+
+ %% error case
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3,x:=2} = id(#{K5=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=2} = id(#{K5=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id({a,b,c}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(#{K6=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(K7))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K7:=3} = id(#{K7=>42}))),
+ ok.
+
+
+match_function_map_neg_keys(#{ -1 := a, -2 := b, -3 := c }) -> ok.
+
+t_update_assoc_variables(Config) when is_list(Config) ->
+ K1 = id(1),
+ K2 = id(2),
+ K3 = id(3.0),
+ K4 = id(4),
+ K5 = id(5),
+ K6 = id(2.0),
+
+ M0 = #{K1=>a,K2=>b,K3=>c,K4=>d,K5=>e},
+
+ M1 = M0#{K1=>42,K2=>100,K4=>[a,b,c]},
+ #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1,
+ #{1:=42,2:=b,4:=d,5:=e,2.0:=100,K3:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,K6=>100,4.0=>[a,b,c]},
+
+ M2 = M0#{K3=>new},
+ #{1:=a,2:=b,K3:=new,4:=d,5:=e} = M2,
+ M2 = M0#{3.0:=wrong,K3=>new},
+
+ #{ <<0:258>> := val } = id(M0#{<<0:258>> => val}), %% binary limitation
+
+ %% Errors cases.
+ BadMap = id(badmap),
+ {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}),
+ {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}),
+ ok.
+
+t_update_exact_variables(Config) when is_list(Config) ->
+ K1 = id(1),
+ K2 = id(2),
+ K3 = id(3.0),
+ K4 = id(4),
+
+ M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}),
+
+ M1 = M0#{K1:=42,K2:=100,K4:=[a,b,c]},
+ #{1:=42,2:=100,3.0:=c,K4:=[a,b,c],5:=e} = M1,
+ M1 = M0#{K1:=wrong,1:=also_wrong,K1=>42,2=>wrong,K2:=100,4:=[a,b,c]},
+
+ M2 = M0#{K3:=new},
+ #{1:=a,K2:=b,3.0:=new,K4:=d,5:=e} = M2,
+ M2 = M0#{3.0=>wrong,K3:=new},
+ true = M2 =/= M0#{3=>right,3.0:=new},
+ #{ 3 := right, 3.0 := new } = M0#{3=>right,K3:=new},
+
+ M3 = id(#{ 1 => val}),
+ #{1 := update2,1.0 := new_val4} = M3#{
+ 1.0 => new_val1, K1 := update, K1=> update3,
+ K1 := update2, 1.0 := new_val2, 1.0 => new_val3,
+ 1.0 => new_val4 },
+
+ #{ "wat" := 3, 2 := a } = id(#{ "wat" => 1, K2 => 2 }#{ K2 := a, "wat" := 3 }),
+
+ %% Errors cases.
+ {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })),
+ {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}),
+ {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}),
+ {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}),
+ {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}),
+ {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting:=val}),
+ {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation
+ ok.
+
+t_nested_pattern_expressions(Config) when is_list(Config) ->
+ K1 = id("hello"),
+ %K2 = id({ok}),
+ [_,_,#{ <<"hi">> := wat, K1 := 42 }|_] = id([k,k,#{<<"hi">> => wat, K1 => 42}]),
+ [_,_,#{ -1 := wat, K1 := 42 }|_] = id([k,k,#{-1 => wat, K1 => 42}]),
+ [_,_,{#{ -1 := #{ {-3,<<0:300>>} := V1 }, K1 := 42 },3}|_] = id([k,k,{#{-1 => #{{-3,<<0:300>>}=>"hi"}, K1 => 42},3}]),
+ "hi" = V1,
+ %[k,#{ {-1,K1,[]} := {wat,K1}, K2 := 42 }|_] = id([k,#{{-1,K1,[]} => {wat,K1}, K2 => 42}]),
+ %[k,#{ [-1,K2,[]] := {wat,K1}, K1 := 42 }|_] = id([k,#{[-1,K2,[]] => {wat,K1}, K1 => 42}]),
+
+ M0 = id(#{ <<33:333>> => 1, <<332:333>> => ok, a => ok, wat => yep, watzor => ok }),
+ F0 = map_nested_pattern_funs(M0),
+ F1 = F0(wat),
+ F2 = F1(watzor),
+ {yep,ok} = F2(M0),
+ ok.
+
+map_nested_pattern_funs(M) ->
+ K0 = id(a),
+ fun(K1) ->
+ case M of
+ #{ K0 := ok, K1 := yep, <<33:333>> := 1 } ->
+ fun(K2) ->
+ case M of
+ #{ K2 := ok, K1 := yep, <<33:333>> := 1 } ->
+ fun
+ (#{ <<332:333>> := ok, K1 := V1, K2 := V2 }) ->
+ {V1,V2}
+ end
+ end
+ end
+ end
+ end.
+
+t_guard_update_variables(Config) when is_list(Config) ->
+ error = map_guard_update_variables(n,#{},#{}),
+ first = map_guard_update_variables(x,#{}, #{x=>first}),
+ second = map_guard_update_variables(x,#{y=>old}, #{x=>second,y=>old}),
+ third = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>third,y=>old}),
+ fourth = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>4,y=>new}),
+ ok.
+
+map_guard_update_variables(K,M1,M2) when M1#{K=>first} =:= M2 -> first;
+map_guard_update_variables(K,M1,M2) when M1#{K=>second} =:= M2 -> second;
+map_guard_update_variables(K,M1,M2) when M1#{K:=third} =:= M2 -> third;
+map_guard_update_variables(K,M1,M2) when M1#{K:=4,y=>new} =:= M2 -> fourth;
+map_guard_update_variables(_,_,_) -> error.
+
+t_guard_sequence_variables(Config) when is_list(Config) ->
+ {1,"a"} = map_guard_sequence_var_1(a,#{seq=>1,a=>id("a"),b=>no}),
+ {2,"b"} = map_guard_sequence_var_1(b,#{seq=>2,b=>id("b"),a=>no}),
+ {3,"c"} = map_guard_sequence_var_1(a,#{seq=>3,a=>id("c"),b=>no}),
+ {4,"d"} = map_guard_sequence_var_1(b,#{seq=>4,b=>id("d"),a=>no}),
+ {4,4} = map_guard_sequence_var_1(seq,#{seq=>4}),
+ {4,4,y} = map_guard_sequence_var_1(seq,#{seq=>4,b=>id("d"),a=>y}),
+ {5,"d"} = map_guard_sequence_var_1(b,#{seq=>5,b=>id("d"),a=>y}),
+
+ %% error case
+ {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_var_1("a",#{seq=>4,val=>id("e")})),
+ ok.
+
+
+map_guard_sequence_var_1(K,M) ->
+ case M of
+ #{seq:=1=Seq, K:=Val} -> {Seq,Val};
+ #{seq:=2=Seq, K:=Val} -> {Seq,Val};
+ #{seq:=3=Seq, K:=Val} -> {Seq,Val};
+ #{K:=4=Seq, K:=Val1,a:=Val2} -> {Seq,Val1,Val2};
+ #{seq:=4=Seq, K:=Val} -> {Seq,Val};
+ #{K:=4=Seq, K:=Val} -> {Seq,Val};
+ #{seq:=5=Seq, K:=Val} -> {Seq,Val}
+ end.
+
+
+t_guard_sequence_mixed(Config) when is_list(Config) ->
+ M0 = id(#{ a=>1, b=>1, c=>1, d=>1, e=>1, f=>1, g=>1, h=>1 }),
+ M1 = id(M0#{ d := 3 }),
+ 1 = map_guard_sequence_mixed(a,d,M1),
+ M2 = id(M1#{ b := 2, d := 4, h := 2 }),
+ 2 = map_guard_sequence_mixed(a,d,M2),
+ M3 = id(M2#{ b := 3, e := 5, g := 3 }),
+ 3 = map_guard_sequence_mixed(a,e,M3),
+ M4 = id(M3#{ c := 4, e := 6, h := 1 }),
+ 4 = map_guard_sequence_mixed(a,e,M4),
+ M5 = id(M4#{ c := 5, f := 7, g := 2 }),
+ 5 = map_guard_sequence_mixed(a,f,M5),
+ M6 = id(M5#{ c := 6, f := 8, h := 3 }),
+ 6 = map_guard_sequence_mixed(a,f,M6),
+
+ %% error case
+ {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_mixed(a,b,M0)),
+ ok.
+
+map_guard_sequence_mixed(K1,K2,M) ->
+ case M of
+ #{ K1 := 1, b := 1, K2 := 3, g := 1} -> 1;
+ #{ K1 := 1, b := 2, K2 := 4, h := 2} -> 2;
+ #{ K1 := 1, b := 3, K2 := 5, g := 3} -> 3;
+ #{ K1 := 1, c := 4, K2 := 6, h := 1} -> 4;
+ #{ K1 := 1, c := 5, K2 := 7, g := 2} -> 5;
+ #{ K1 := 1, c := 6, K2 := 8, h := 3} -> 6
+ end.
+
+
+
+t_frequency_table(Config) when is_list(Config) ->
+ random:seed({13,1337,54}), % pseudo random
+ N = 100000,
+ Ts = rand_terms(N),
+ #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}),
+ ok = check_frequency(Ts,Tf),
+ ok.
+
+
+frequency_table([T|Ts], M) ->
+ case M of
+ #{ n := N, tf := #{ T := C } = F } ->
+ frequency_table(Ts,M#{ n := N + 1, tf := F#{ T := C + 1 }});
+ #{ n := N, tf := F } ->
+ frequency_table(Ts,M#{ n := N + 1, tf := F#{ T => 1 }})
+ end;
+frequency_table([], M) -> M.
+
+
+check_frequency(Ts,Tf) ->
+ check_frequency(Ts,Tf,dict:new()).
+
+check_frequency([T|Ts],Tf,D) ->
+ case dict:find(T,D) of
+ error -> check_frequency(Ts,Tf,dict:store(T,1,D));
+ {ok,C} -> check_frequency(Ts,Tf,dict:store(T,C+1,D))
+ end;
+check_frequency([],Tf,D) ->
+ validate_frequency(dict:to_list(D),Tf).
+
+validate_frequency([{T,C}|Fs],Tf) ->
+ case Tf of
+ #{ T := C } -> validate_frequency(Fs,Tf);
+ _ -> error
+ end;
+validate_frequency([], _) -> ok.
+
+
+%% aux
+
+rand_terms(0) -> [];
+rand_terms(N) -> [rand_term()|rand_terms(N-1)].
+
+rand_term() ->
+ case random:uniform(6) of
+ 1 -> rand_binary();
+ 2 -> rand_number();
+ 3 -> rand_atom();
+ 4 -> rand_tuple();
+ 5 -> rand_list();
+ 6 -> rand_map()
+ end.
+
+rand_binary() ->
+ case random:uniform(3) of
+ 1 -> <<>>;
+ 2 -> <<"hi">>;
+ 3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">>
+ end.
+
+rand_number() ->
+ case random:uniform(3) of
+ 1 -> random:uniform(5);
+ 2 -> float(random:uniform(5));
+ 3 -> 1 bsl (63 + random:uniform(3))
+ end.
+
+rand_atom() ->
+ case random:uniform(3) of
+ 1 -> hi;
+ 2 -> some_atom;
+ 3 -> some_other_atom
+ end.
+
+
+rand_tuple() ->
+ case random:uniform(3) of
+ 1 -> {ok, rand_term()}; % careful
+ 2 -> {1, 2, 3};
+ 3 -> {<<"yep">>, 1337}
+ end.
+
+rand_list() ->
+ case random:uniform(3) of
+ 1 -> "hi";
+ 2 -> [1,rand_term()]; % careful
+ 3 -> [improper|list]
+ end.
+
+rand_map() ->
+ case random:uniform(3) of
+ 1 -> #{ hi => 3 };
+ 2 -> #{ wat => rand_term(), other => 3 }; % careful
+ 3 -> #{ hi => 42, other => 42, yet_anoter => 1337 }
+ end.
+
+
+
%% Use this function to avoid compile-time evaluation of an expression.
id(I) -> I.
diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl
index 0637041873..be0348a92d 100644
--- a/lib/compiler/test/warnings_SUITE.erl
+++ b/lib/compiler/test/warnings_SUITE.erl
@@ -601,7 +601,7 @@ maps(Config) when is_list(Config) ->
">>,
[],
{warnings,[{3,v3_core,bad_map}]}},
- {bad_map_literal_key,
+ {ok_map_literal_key,
<<"
t() ->
V = id(1),
@@ -614,7 +614,7 @@ maps(Config) when is_list(Config) ->
id(I) -> I.
">>,
[],
- {warnings,[{6,v3_core,nomatch}]}}],
+ []}],
run(Config, Ts),
ok.
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index e7215eeb64..a42de9adb1 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -54,6 +54,10 @@
#include <openssl/evp.h>
#include <openssl/hmac.h>
+#if OPENSSL_VERSION_NUMBER >= 0x1000000fL
+#include <openssl/modes.h>
+#endif
+
#include "crypto_callback.h"
#if OPENSSL_VERSION_NUMBER >= 0x00908000L && !defined(OPENSSL_NO_SHA224) && defined(NID_sha224)\
@@ -85,13 +89,32 @@
# define HAVE_AES_IGE
#endif
+#if OPENSSL_VERSION_NUMBER >= 0x1000100fL
+# define HAVE_GCM
+#endif
+
+#if defined(NID_chacha20) && !defined(OPENSSL_NO_CHACHA) && !defined(OPENSSL_NO_POLY1305)
+# define HAVE_CHACHA20_POLY1305
+#endif
+
#if defined(HAVE_EC)
#include <openssl/ec.h>
#include <openssl/ecdh.h>
#include <openssl/ecdsa.h>
#endif
+#if defined(HAVE_CHACHA20_POLY1305)
+#include <openssl/chacha.h>
+#include <openssl/poly1305.h>
+#if !defined(CHACHA20_NONCE_LEN)
+# define CHACHA20_NONCE_LEN 8
+#endif
+#if !defined(POLY1305_TAG_LEN)
+# define POLY1305_TAG_LEN 16
+#endif
+
+#endif
#ifdef VALGRIND
# include <valgrind/memcheck.h>
@@ -257,6 +280,11 @@ static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF
static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+
+static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
/* helpers */
static void init_algorithms_types(ErlNifEnv*);
@@ -387,7 +415,15 @@ static ErlNifFunc nif_funcs[] = {
{"ecdsa_verify_nif", 5, ecdsa_verify_nif},
{"ecdh_compute_key_nif", 3, ecdh_compute_key_nif},
- {"rand_seed_nif", 1, rand_seed_nif}
+ {"rand_seed_nif", 1, rand_seed_nif},
+
+ {"aes_gcm_encrypt", 4, aes_gcm_encrypt},
+ {"aes_gcm_decrypt", 5, aes_gcm_decrypt},
+
+ {"chacha20_poly1305_encrypt", 4, chacha20_poly1305_encrypt},
+ {"chacha20_poly1305_decrypt", 5, chacha20_poly1305_decrypt}
+
+
};
ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload)
@@ -725,7 +761,7 @@ static ERL_NIF_TERM algo_hash[8]; /* increase when extending the list */
static int algo_pubkey_cnt;
static ERL_NIF_TERM algo_pubkey[3]; /* increase when extending the list */
static int algo_cipher_cnt;
-static ERL_NIF_TERM algo_cipher[2]; /* increase when extending the list */
+static ERL_NIF_TERM algo_cipher[4]; /* increase when extending the list */
static void init_algorithms_types(ErlNifEnv* env)
{
@@ -763,6 +799,12 @@ static void init_algorithms_types(ErlNifEnv* env)
#ifdef HAVE_AES_IGE
algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_ige256");
#endif
+#if defined(HAVE_GCM)
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_gcm");
+#endif
+#if defined(HAVE_CHACHA20_POLY1305)
+ algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"chacha20_poly1305");
+#endif
ASSERT(algo_hash_cnt <= sizeof(algo_hash)/sizeof(ERL_NIF_TERM));
ASSERT(algo_pubkey_cnt <= sizeof(algo_pubkey)/sizeof(ERL_NIF_TERM));
@@ -1760,6 +1802,236 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N
return ret;
}
+static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Key,Iv,AAD,In) */
+#if defined(HAVE_GCM)
+ GCM128_CONTEXT *ctx = NULL;
+ ErlNifBinary key, iv, aad, in;
+ AES_KEY aes_key;
+ unsigned char *outp;
+ ERL_NIF_TERM out, out_tag;
+
+ CHECK_OSE_CRYPTO();
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
+ || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0
+ || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0
+ || !enif_inspect_iolist_as_binary(env, argv[2], &aad)
+ || !enif_inspect_iolist_as_binary(env, argv[3], &in)) {
+ return enif_make_badarg(env);
+ }
+
+ if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt)))
+ return atom_error;
+
+ CRYPTO_gcm128_setiv(ctx, iv.data, iv.size);
+
+ if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size))
+ goto out_err;
+
+ outp = enif_make_new_binary(env, in.size, &out);
+
+ /* encrypt */
+ if (CRYPTO_gcm128_encrypt(ctx, in.data, outp, in.size))
+ goto out_err;
+
+ /* calculate the tag */
+ CRYPTO_gcm128_tag(ctx, enif_make_new_binary(env, EVP_GCM_TLS_TAG_LEN, &out_tag), EVP_GCM_TLS_TAG_LEN);
+ CRYPTO_gcm128_release(ctx);
+
+ CONSUME_REDS(env, in);
+
+ return enif_make_tuple2(env, out, out_tag);
+
+out_err:
+ CRYPTO_gcm128_release(ctx);
+ return atom_error;
+
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Key,Iv,AAD,In,Tag) */
+#if defined(HAVE_GCM)
+ GCM128_CONTEXT *ctx;
+ ErlNifBinary key, iv, aad, in, tag;
+ AES_KEY aes_key;
+ unsigned char *outp;
+ ERL_NIF_TERM out;
+
+ CHECK_OSE_CRYPTO();
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
+ || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0
+ || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0
+ || !enif_inspect_iolist_as_binary(env, argv[2], &aad)
+ || !enif_inspect_iolist_as_binary(env, argv[3], &in)
+ || !enif_inspect_iolist_as_binary(env, argv[4], &tag) || tag.size != EVP_GCM_TLS_TAG_LEN) {
+ return enif_make_badarg(env);
+ }
+
+ if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt)))
+ return atom_error;
+
+ CRYPTO_gcm128_setiv(ctx, iv.data, iv.size);
+
+ if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size))
+ goto out_err;
+
+ outp = enif_make_new_binary(env, in.size, &out);
+
+ /* decrypt */
+ if (CRYPTO_gcm128_decrypt(ctx, in.data, outp, in.size))
+ goto out_err;
+
+ /* calculate and check the tag */
+ if (CRYPTO_gcm128_finish(ctx, tag.data, EVP_GCM_TLS_TAG_LEN))
+ goto out_err;
+
+ CRYPTO_gcm128_release(ctx);
+ CONSUME_REDS(env, in);
+
+ return out;
+
+out_err:
+ CRYPTO_gcm128_release(ctx);
+ return atom_error;
+#else
+ return atom_notsup;
+#endif
+}
+
+#if defined(HAVE_CHACHA20_POLY1305)
+static void
+poly1305_update_with_length(poly1305_state *poly1305,
+ const unsigned char *data, size_t data_len)
+{
+ size_t j = data_len;
+ unsigned char length_bytes[8];
+ unsigned i;
+
+ for (i = 0; i < sizeof(length_bytes); i++) {
+ length_bytes[i] = j;
+ j >>= 8;
+ }
+
+ CRYPTO_poly1305_update(poly1305, data, data_len);
+ CRYPTO_poly1305_update(poly1305, length_bytes, sizeof(length_bytes));
+}
+#endif
+
+static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Key,Iv,AAD,In) */
+#if defined(HAVE_CHACHA20_POLY1305)
+ ErlNifBinary key, iv, aad, in;
+ unsigned char *outp;
+ ERL_NIF_TERM out, out_tag;
+ ErlNifUInt64 in_len_64;
+ unsigned char poly1305_key[32];
+ poly1305_state poly1305;
+
+ CHECK_OSE_CRYPTO();
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32
+ || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN
+ || !enif_inspect_iolist_as_binary(env, argv[2], &aad)
+ || !enif_inspect_iolist_as_binary(env, argv[3], &in)) {
+ return enif_make_badarg(env);
+ }
+
+ /* Take from OpenSSL patch set/LibreSSL:
+ *
+ * The underlying ChaCha implementation may not overflow the block
+ * counter into the second counter word. Therefore we disallow
+ * individual operations that work on more than 2TB at a time.
+ * in_len_64 is needed because, on 32-bit platforms, size_t is only
+ * 32-bits and this produces a warning because it's always false.
+ * Casting to uint64_t inside the conditional is not sufficient to stop
+ * the warning. */
+ in_len_64 = in.size;
+ if (in_len_64 >= (1ULL << 32) * 64 - 64)
+ return enif_make_badarg(env);
+
+ memset(poly1305_key, 0, sizeof(poly1305_key));
+ CRYPTO_chacha_20(poly1305_key, poly1305_key, sizeof(poly1305_key), key.data, iv.data, 0);
+
+ outp = enif_make_new_binary(env, in.size, &out);
+
+ CRYPTO_poly1305_init(&poly1305, poly1305_key);
+ poly1305_update_with_length(&poly1305, aad.data, aad.size);
+ CRYPTO_chacha_20(outp, in.data, in.size, key.data, iv.data, 1);
+ poly1305_update_with_length(&poly1305, outp, in.size);
+
+ CRYPTO_poly1305_finish(&poly1305, enif_make_new_binary(env, POLY1305_TAG_LEN, &out_tag));
+
+ CONSUME_REDS(env, in);
+
+ return enif_make_tuple2(env, out, out_tag);
+
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Key,Iv,AAD,In,Tag) */
+#if defined(HAVE_CHACHA20_POLY1305)
+ ErlNifBinary key, iv, aad, in, tag;
+ unsigned char *outp;
+ ERL_NIF_TERM out;
+ ErlNifUInt64 in_len_64;
+ unsigned char poly1305_key[32];
+ unsigned char mac[POLY1305_TAG_LEN];
+ poly1305_state poly1305;
+
+ CHECK_OSE_CRYPTO();
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32
+ || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN
+ || !enif_inspect_iolist_as_binary(env, argv[2], &aad)
+ || !enif_inspect_iolist_as_binary(env, argv[3], &in)
+ || !enif_inspect_iolist_as_binary(env, argv[4], &tag) || tag.size != POLY1305_TAG_LEN) {
+ return enif_make_badarg(env);
+ }
+
+ /* Take from OpenSSL patch set/LibreSSL:
+ *
+ * The underlying ChaCha implementation may not overflow the block
+ * counter into the second counter word. Therefore we disallow
+ * individual operations that work on more than 2TB at a time.
+ * in_len_64 is needed because, on 32-bit platforms, size_t is only
+ * 32-bits and this produces a warning because it's always false.
+ * Casting to uint64_t inside the conditional is not sufficient to stop
+ * the warning. */
+ in_len_64 = in.size;
+ if (in_len_64 >= (1ULL << 32) * 64 - 64)
+ return enif_make_badarg(env);
+
+ memset(poly1305_key, 0, sizeof(poly1305_key));
+ CRYPTO_chacha_20(poly1305_key, poly1305_key, sizeof(poly1305_key), key.data, iv.data, 0);
+
+ CRYPTO_poly1305_init(&poly1305, poly1305_key);
+ poly1305_update_with_length(&poly1305, aad.data, aad.size);
+ poly1305_update_with_length(&poly1305, in.data, in.size);
+ CRYPTO_poly1305_finish(&poly1305, mac);
+
+ if (memcmp(mac, tag.data, POLY1305_TAG_LEN) != 0)
+ return atom_error;
+
+ outp = enif_make_new_binary(env, in.size, &out);
+
+ CRYPTO_chacha_20(outp, in.data, in.size, key.data, iv.data, 1);
+
+ CONSUME_REDS(env, in);
+
+ return out;
+#else
+ return atom_notsup;
+#endif
+}
+
static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Bytes) */
unsigned bytes;
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index 98384978a5..271130a9e6 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -41,7 +41,7 @@
</item>
<item>
<p>Block ciphers - <url href="http://csrc.nist.gov/groups/ST/toolkit/block_ciphers.html"> </url> DES and AES in
- Block Cipher Modes - <url href="http://csrc.nist.gov/groups/ST/toolkit/BCM/index.html"> ECB, CBC, CFB, OFB and CTR </url></p>
+ Block Cipher Modes - <url href="http://csrc.nist.gov/groups/ST/toolkit/BCM/index.html"> ECB, CBC, CFB, OFB, CTR and GCM </url></p>
</item>
<item>
<p><url href="http://www.ietf.org/rfc/rfc1321.txt"> RSA encryption RFC 1321 </url> </p>
@@ -53,6 +53,12 @@
<item>
<p><url href="http://www.ietf.org/rfc/rfc2945.txt"> Secure Remote Password Protocol (SRP - RFC 2945) </url></p>
</item>
+ <item>
+ <p>gcm: Dworkin, M., "Recommendation for Block Cipher Modes of
+ Operation: Galois/Counter Mode (GCM) and GMAC",
+ National Institute of Standards and Technology SP 800-
+ 38D, November 2007.</p>
+ </item>
</list>
</description>
@@ -132,6 +138,8 @@
blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cbf
| des_ede3 | rc2_cbc </code></p>
+ <p><code>aead_cipher() = aes_gcm | chacha20_poly1305 </code></p>
+
<p><code>stream_key() = aes_key() | rc4_key() </code></p>
<p><code>block_key() = aes_key() | blowfish_key() | des_key()| des3_key() </code></p>
@@ -152,7 +160,7 @@
Note that both md4 and md5 are recommended only for compatibility with existing applications.
</p>
<p><code> cipher_algorithms() = des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 |
- blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128| aes_cbc256 | aes_ige256 | rc2_cbc | aes_ctr| rc4 </code> </p>
+ blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128| aes_cbc256 | aes_ige256 | aes_gcm | chacha20_poly1305 | rc2_cbc | aes_ctr| rc4 </code> </p>
<p><code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code>
Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported
with ecdsa and ecdh.
@@ -161,18 +169,23 @@
</section>
<funcs>
- <func>
+ <func>
<name>block_encrypt(Type, Key, Ivec, PlainText) -> CipherText</name>
- <fsummary>Encrypt <c>PlainText</c>according to <c>Type</c> block cipher</fsummary>
+ <name>block_encrypt(AeadType, Key, Ivec, {AAD, PlainText}) -> {CipherText, CipherTag}</name>
+ <fsummary>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher</fsummary>
<type>
<v>Type = block_cipher() </v>
+ <v>AeadType = aead_cipher() </v>
<v>Key = block_key() </v>
<v>PlainText = iodata() </v>
- <v>IVec = CipherText = binary()</v>
+ <v>AAD = IVec = CipherText = CipherTag = binary()</v>
</type>
<desc>
<p>Encrypt <c>PlainText</c>according to <c>Type</c> block cipher.
<c>IVec</c> is an arbitrary initializing vector.</p>
+ <p>In AEAD (Authenticated Encryption with Associated Data) mode, encrypt
+ <c>PlainText</c>according to <c>Type</c> block cipher and calculate
+ <c>CipherTag</c> that also authenticates the <c>AAD</c> (Associated Authenticated Data).</p>
<p>May throw exception <c>notsup</c> in case the chosen <c>Type</c>
is not supported by the underlying OpenSSL implementation.</p>
</desc>
@@ -180,16 +193,22 @@
<func>
<name>block_decrypt(Type, Key, Ivec, CipherText) -> PlainText</name>
- <fsummary>Decrypt <c>CipherText</c>according to <c>Type</c> block cipher</fsummary>
+ <name>block_decrypt(AeadType, Key, Ivec, {AAD, CipherText, CipherTag}) -> PlainText | error</name>
+ <fsummary>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher</fsummary>
<type>
<v>Type = block_cipher() </v>
+ <v>AeadType = aead_cipher() </v>
<v>Key = block_key() </v>
<v>PlainText = iodata() </v>
- <v>IVec = CipherText = binary()</v>
+ <v>AAD = IVec = CipherText = CipherTag = binary()</v>
</type>
<desc>
<p>Decrypt <c>CipherText</c>according to <c>Type</c> block cipher.
<c>IVec</c> is an arbitrary initializing vector.</p>
+ <p>In AEAD (Authenticated Encryption with Associated Data) mode, decrypt
+ <c>CipherText</c>according to <c>Type</c> block cipher and check the authenticity
+ the <c>PlainText</c> and <c>AAD</c> (Associated Authenticated Data) using the
+ <c>CipherTag</c>. May return <c>error</c> if the decryption or validation fail's</p>
<p>May throw exception <c>notsup</c> in case the chosen <c>Type</c>
is not supported by the underlying OpenSSL implementation.</p>
</desc>
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index e1fbbf9ab8..7f82fa83fd 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -282,7 +282,8 @@ hmac_final_n(_Context, _HashLen) -> ? nif_stub.
-spec block_encrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc |
blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | rc2_cbc,
- Key::iodata(), Ivec::binary(), Data::iodata()) -> binary().
+ Key::iodata(), Ivec::binary(), Data::iodata()) -> binary();
+ (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}.
block_encrypt(des_cbc, Key, Ivec, Data) ->
des_cbc_encrypt(Key, Ivec, Data);
@@ -310,14 +311,25 @@ block_encrypt(aes_cfb8, Key, Ivec, Data) ->
aes_cfb_8_encrypt(Key, Ivec, Data);
block_encrypt(aes_cfb128, Key, Ivec, Data) ->
aes_cfb_128_encrypt(Key, Ivec, Data);
+block_encrypt(aes_gcm, Key, Ivec, {AAD, Data}) ->
+ case aes_gcm_encrypt(Key, Ivec, AAD, Data) of
+ notsup -> erlang:error(notsup);
+ Return -> Return
+ end;
+block_encrypt(chacha20_poly1305, Key, Ivec, {AAD, Data}) ->
+ case chacha20_poly1305_encrypt(Key, Ivec, AAD, Data) of
+ notsup -> erlang:error(notsup);
+ Return -> Return
+ end;
block_encrypt(rc2_cbc, Key, Ivec, Data) ->
rc2_cbc_encrypt(Key, Ivec, Data).
-spec block_decrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc |
- blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cbc256 | aes_ige256 |
- aes_cfb8 | aes_cfb128 | rc2_cbc,
- Key::iodata(), Ivec::binary(), Data::iodata()) -> binary().
-
+ blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cbc256 | aes_ige256 |
+ aes_cfb8 | aes_cfb128 | rc2_cbc,
+ Key::iodata(), Ivec::binary(), Data::iodata()) -> binary();
+ (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(),
+ {AAD::binary(), Data::iodata(), Tag::binary()}) -> binary() | error.
block_decrypt(des_cbc, Key, Ivec, Data) ->
des_cbc_decrypt(Key, Ivec, Data);
block_decrypt(des_cfb, Key, Ivec, Data) ->
@@ -344,9 +356,18 @@ block_decrypt(aes_cfb8, Key, Ivec, Data) ->
aes_cfb_8_decrypt(Key, Ivec, Data);
block_decrypt(aes_cfb128, Key, Ivec, Data) ->
aes_cfb_128_decrypt(Key, Ivec, Data);
+block_decrypt(aes_gcm, Key, Ivec, {AAD, Data, Tag}) ->
+ case aes_gcm_decrypt(Key, Ivec, AAD, Data, Tag) of
+ notsup -> erlang:error(notsup);
+ Return -> Return
+ end;
+block_decrypt(chacha20_poly1305, Key, Ivec, {AAD, Data, Tag}) ->
+ case chacha20_poly1305_decrypt(Key, Ivec, AAD, Data, Tag) of
+ notsup -> erlang:error(notsup);
+ Return -> Return
+ end;
block_decrypt(rc2_cbc, Key, Ivec, Data) ->
rc2_cbc_decrypt(Key, Ivec, Data).
-
-spec block_encrypt(des_ecb | blowfish_ecb, Key::iodata(), Data::iodata()) -> binary().
block_encrypt(des_ecb, Key, Data) ->
@@ -1190,6 +1211,17 @@ aes_cfb_128_decrypt(Key, IVec, Data) ->
aes_cfb_128_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
+%%
+%% AES - in Galois/Counter Mode (GCM)
+%%
+aes_gcm_encrypt(_Key, _Ivec, _AAD, _In) -> ?nif_stub.
+aes_gcm_decrypt(_Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub.
+
+%%
+%% Chacha20/Ppoly1305
+%%
+chacha20_poly1305_encrypt(_Key, _Ivec, _AAD, _In) -> ?nif_stub.
+chacha20_poly1305_decrypt(_Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub.
%%
%% DES - in cipher block chaining mode (CBC)
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 03aa3964a5..1031e6403f 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -62,6 +62,8 @@ all() ->
{group, rc2_cbc},
{group, rc4},
{group, aes_ctr},
+ {group, aes_gcm},
+ {group, chacha20_poly1305},
mod_pow,
exor,
rand_uniform
@@ -100,7 +102,9 @@ groups() ->
{blowfish_cfb64, [], [block]},
{blowfish_ofb64,[], [block]},
{rc4, [], [stream]},
- {aes_ctr, [], [stream]}
+ {aes_ctr, [], [stream]},
+ {aes_gcm, [], [aead]},
+ {chacha20_poly1305, [], [aead]}
].
%%-------------------------------------------------------------------
@@ -203,6 +207,14 @@ stream(Config) when is_list(Config) ->
lists:foreach(fun stream_cipher/1, stream_iolistify(Streams)),
lists:foreach(fun stream_cipher_incment/1, stream_iolistify(Streams)).
+%%--------------------------------------------------------------------
+aead() ->
+ [{doc, "Test AEAD ciphers"}].
+aead(Config) when is_list(Config) ->
+ AEADs = lazy_eval(proplists:get_value(aead, Config)),
+
+ lists:foreach(fun aead_cipher/1, AEADs).
+
%%--------------------------------------------------------------------
sign_verify() ->
[{doc, "Sign/verify digital signatures"}].
@@ -406,7 +418,22 @@ stream_cipher_incment(_State, OrigState, [], Acc, Plain) ->
stream_cipher_incment(State0, OrigState, [PlainText | PlainTexts], Acc, Plain) ->
{State, CipherText} = crypto:stream_encrypt(State0, PlainText),
stream_cipher_incment(State, OrigState, PlainTexts, [CipherText | Acc], Plain).
-
+
+aead_cipher({Type, Key, PlainText, IV, AAD, CipherText, CipherTag}) ->
+ Plain = iolist_to_binary(PlainText),
+ case crypto:block_encrypt(Type, Key, IV, {AAD, Plain}) of
+ {CipherText, CipherTag} ->
+ ok;
+ Other0 ->
+ ct:fail({{crypto, block_encrypt, [Plain, PlainText]}, {expected, {CipherText, CipherTag}}, {got, Other0}})
+ end,
+ case crypto:block_decrypt(Type, Key, IV, {AAD, CipherText, CipherTag}) of
+ Plain ->
+ ok;
+ Other1 ->
+ ct:fail({{crypto, block_decrypt, [CipherText]}, {expected, Plain}, {got, Other1}})
+ end.
+
do_sign_verify({Type, Hash, Public, Private, Msg}) ->
Signature = crypto:sign(Type, Hash, Msg, Private),
case crypto:verify(Type, Hash, Msg, Signature, Public) of
@@ -749,6 +776,12 @@ group_config(rc4, Config) ->
group_config(aes_ctr, Config) ->
Stream = aes_ctr(),
[{stream, Stream} | Config];
+group_config(aes_gcm, Config) ->
+ AEAD = aes_gcm(),
+ [{aead, AEAD} | Config];
+group_config(chacha20_poly1305, Config) ->
+ AEAD = chacha20_poly1305(),
+ [{aead, AEAD} | Config];
group_config(_, Config) ->
Config.
@@ -1378,6 +1411,269 @@ aes_ctr() ->
long_msg()}
].
+
+%% AES GCM test vectors from http://csrc.nist.gov/groups/ST/toolkit/BCM/documents/proposedmodes/gcm/gcm-spec.pdf
+aes_gcm() ->
+ [
+ %% Test Case 1
+ {aes_gcm, hexstr2bin("00000000000000000000000000000000"), %% Key
+ hexstr2bin(""), %% PlainText
+ hexstr2bin("000000000000000000000000"), %% IV
+ hexstr2bin(""), %% AAD
+ hexstr2bin(""), %% CipherText
+ hexstr2bin("58e2fccefa7e3061367f1d57a4e7455a")}, %% CipherTag
+
+ %% Test Case 2
+ {aes_gcm, hexstr2bin("00000000000000000000000000000000"), %% Key
+ hexstr2bin("00000000000000000000000000000000"), %% PlainText
+ hexstr2bin("000000000000000000000000"), %% IV
+ hexstr2bin(""), %% AAD
+ hexstr2bin("0388dace60b6a392f328c2b971b2fe78"), %% CipherText
+ hexstr2bin("ab6e47d42cec13bdf53a67b21257bddf")}, %% CipherTag
+
+ %% Test Case 3
+ {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308"), %% Key
+ hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText
+ "86a7a9531534f7da2e4c303d8a318a72"
+ "1c3c0c95956809532fcf0e2449a6b525"
+ "b16aedf5aa0de657ba637b391aafd255"),
+ hexstr2bin("cafebabefacedbaddecaf888"), %% IV
+ hexstr2bin(""), %% AAD
+ hexstr2bin("42831ec2217774244b7221b784d0d49c" %% CipherText
+ "e3aa212f2c02a4e035c17e2329aca12e"
+ "21d514b25466931c7d8f6a5aac84aa05"
+ "1ba30b396a0aac973d58e091473f5985"),
+ hexstr2bin("4d5c2af327cd64a62cf35abd2ba6fab4")}, %% CipherTag
+
+ %% Test Case 4
+ {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308"), %% Key
+ hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText
+ "86a7a9531534f7da2e4c303d8a318a72"
+ "1c3c0c95956809532fcf0e2449a6b525"
+ "b16aedf5aa0de657ba637b39"),
+ hexstr2bin("cafebabefacedbaddecaf888"), %% IV
+ hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD
+ "abaddad2"),
+ hexstr2bin("42831ec2217774244b7221b784d0d49c" %% CipherText
+ "e3aa212f2c02a4e035c17e2329aca12e"
+ "21d514b25466931c7d8f6a5aac84aa05"
+ "1ba30b396a0aac973d58e091"),
+ hexstr2bin("5bc94fbc3221a5db94fae95ae7121a47")}, %% CipherTag
+
+ %% Test Case 5
+ {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308"), %% Key
+ hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText
+ "86a7a9531534f7da2e4c303d8a318a72"
+ "1c3c0c95956809532fcf0e2449a6b525"
+ "b16aedf5aa0de657ba637b39"),
+ hexstr2bin("cafebabefacedbad"), %% IV
+ hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD
+ "abaddad2"),
+ hexstr2bin("61353b4c2806934a777ff51fa22a4755" %% CipherText
+ "699b2a714fcdc6f83766e5f97b6c7423"
+ "73806900e49f24b22b097544d4896b42"
+ "4989b5e1ebac0f07c23f4598"),
+ hexstr2bin("3612d2e79e3b0785561be14aaca2fccb")}, %% CipherTag
+
+ %% Test Case 6"
+ {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308"), %% Key
+ hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText
+ "86a7a9531534f7da2e4c303d8a318a72"
+ "1c3c0c95956809532fcf0e2449a6b525"
+ "b16aedf5aa0de657ba637b39"),
+ hexstr2bin("9313225df88406e555909c5aff5269aa" %% IV
+ "6a7a9538534f7da1e4c303d2a318a728"
+ "c3c0c95156809539fcf0e2429a6b5254"
+ "16aedbf5a0de6a57a637b39b"),
+ hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD
+ "abaddad2"),
+ hexstr2bin("8ce24998625615b603a033aca13fb894" %% CipherText
+ "be9112a5c3a211a8ba262a3cca7e2ca7"
+ "01e4a9a4fba43c90ccdcb281d48c7c6f"
+ "d62875d2aca417034c34aee5"),
+ hexstr2bin("619cc5aefffe0bfa462af43c1699d050")}, %% CipherTag
+
+ %% Test Case 7
+ {aes_gcm, hexstr2bin("00000000000000000000000000000000" %% Key
+ "0000000000000000"),
+ hexstr2bin(""), %% PlainText
+ hexstr2bin("000000000000000000000000"), %% IV
+ hexstr2bin(""), %% AAD
+ hexstr2bin(""), %% CipherText
+ hexstr2bin("cd33b28ac773f74ba00ed1f312572435")}, %% CipherTag
+
+ %% Test Case 8
+ {aes_gcm, hexstr2bin("00000000000000000000000000000000" %% Key
+ "0000000000000000"),
+ hexstr2bin("00000000000000000000000000000000"), %% PlainText
+ hexstr2bin("000000000000000000000000"), %% IV
+ hexstr2bin(""), %% AAD
+ hexstr2bin("98e7247c07f0fe411c267e4384b0f600"), %% CipherText
+ hexstr2bin("2ff58d80033927ab8ef4d4587514f0fb")}, %% CipherTag
+
+ %% Test Case 9
+ {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key
+ "feffe9928665731c"),
+ hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText
+ "86a7a9531534f7da2e4c303d8a318a72"
+ "1c3c0c95956809532fcf0e2449a6b525"
+ "b16aedf5aa0de657ba637b391aafd255"),
+ hexstr2bin("cafebabefacedbaddecaf888"), %% IV
+ hexstr2bin(""), %% ADD
+ hexstr2bin("3980ca0b3c00e841eb06fac4872a2757" %% CipherText
+ "859e1ceaa6efd984628593b40ca1e19c"
+ "7d773d00c144c525ac619d18c84a3f47"
+ "18e2448b2fe324d9ccda2710acade256"),
+ hexstr2bin("9924a7c8587336bfb118024db8674a14")}, %% CipherTag
+
+ %% Test Case 10
+ {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key
+ "feffe9928665731c"),
+ hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText
+ "86a7a9531534f7da2e4c303d8a318a72"
+ "1c3c0c95956809532fcf0e2449a6b525"
+ "b16aedf5aa0de657ba637b39"),
+ hexstr2bin("cafebabefacedbaddecaf888"), %% IV
+ hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD
+ "abaddad2"),
+ hexstr2bin("3980ca0b3c00e841eb06fac4872a2757" %% CipherText
+ "859e1ceaa6efd984628593b40ca1e19c"
+ "7d773d00c144c525ac619d18c84a3f47"
+ "18e2448b2fe324d9ccda2710"),
+ hexstr2bin("2519498e80f1478f37ba55bd6d27618c")}, %% CipherTag
+
+ %% Test Case 11
+ {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key
+ "feffe9928665731c"),
+ hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText
+ "86a7a9531534f7da2e4c303d8a318a72"
+ "1c3c0c95956809532fcf0e2449a6b525"
+ "b16aedf5aa0de657ba637b39"),
+ hexstr2bin("cafebabefacedbad"), %% IV
+ hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD
+ "abaddad2"),
+ hexstr2bin("0f10f599ae14a154ed24b36e25324db8" %% CipherText
+ "c566632ef2bbb34f8347280fc4507057"
+ "fddc29df9a471f75c66541d4d4dad1c9"
+ "e93a19a58e8b473fa0f062f7"),
+ hexstr2bin("65dcc57fcf623a24094fcca40d3533f8")}, %% CipherTag
+
+ %% Test Case 12
+ {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key
+ "feffe9928665731c"),
+ hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText
+ "86a7a9531534f7da2e4c303d8a318a72"
+ "1c3c0c95956809532fcf0e2449a6b525"
+ "b16aedf5aa0de657ba637b39"),
+ hexstr2bin("9313225df88406e555909c5aff5269aa" %% IV
+ "6a7a9538534f7da1e4c303d2a318a728"
+ "c3c0c95156809539fcf0e2429a6b5254"
+ "16aedbf5a0de6a57a637b39b"),
+ hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD
+ "abaddad2"),
+ hexstr2bin("d27e88681ce3243c4830165a8fdcf9ff" %% CipherText
+ "1de9a1d8e6b447ef6ef7b79828666e45"
+ "81e79012af34ddd9e2f037589b292db3"
+ "e67c036745fa22e7e9b7373b"),
+ hexstr2bin("dcf566ff291c25bbb8568fc3d376a6d9")}, %% CipherTag
+
+ %% Test Case 13
+ {aes_gcm, hexstr2bin("00000000000000000000000000000000" %% Key
+ "00000000000000000000000000000000"),
+ hexstr2bin(""), %% PlainText
+ hexstr2bin("000000000000000000000000"), %% IV
+ hexstr2bin(""), %% AAD
+ hexstr2bin(""), %% CipherText
+ hexstr2bin("530f8afbc74536b9a963b4f1c4cb738b")}, %% CipherTag
+
+ %% Test Case 14
+ {aes_gcm, hexstr2bin("00000000000000000000000000000000" %% Key
+ "00000000000000000000000000000000"),
+ hexstr2bin("00000000000000000000000000000000"), %% PlainText
+ hexstr2bin("000000000000000000000000"), %% IV
+ hexstr2bin(""), %% AAD
+ hexstr2bin("cea7403d4d606b6e074ec5d3baf39d18"), %% CipherText
+ hexstr2bin("d0d1c8a799996bf0265b98b5d48ab919")}, %% CipherTag
+
+ %% Test Case 15
+ {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key
+ "feffe9928665731c6d6a8f9467308308"),
+ hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText
+ "86a7a9531534f7da2e4c303d8a318a72"
+ "1c3c0c95956809532fcf0e2449a6b525"
+ "b16aedf5aa0de657ba637b391aafd255"),
+ hexstr2bin("cafebabefacedbaddecaf888"), %% IV
+ hexstr2bin(""), %% AAD
+ hexstr2bin("522dc1f099567d07f47f37a32a84427d" %% CipherText
+ "643a8cdcbfe5c0c97598a2bd2555d1aa"
+ "8cb08e48590dbb3da7b08b1056828838"
+ "c5f61e6393ba7a0abcc9f662898015ad"),
+ hexstr2bin("b094dac5d93471bdec1a502270e3cc6c")}, %% CipherTag
+
+ %% Test Case 16
+ {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key
+ "feffe9928665731c6d6a8f9467308308"),
+ hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText
+ "86a7a9531534f7da2e4c303d8a318a72"
+ "1c3c0c95956809532fcf0e2449a6b525"
+ "b16aedf5aa0de657ba637b39"),
+ hexstr2bin("cafebabefacedbaddecaf888"), %% IV
+ hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD
+ "abaddad2"),
+ hexstr2bin("522dc1f099567d07f47f37a32a84427d" %% CipherText
+ "643a8cdcbfe5c0c97598a2bd2555d1aa"
+ "8cb08e48590dbb3da7b08b1056828838"
+ "c5f61e6393ba7a0abcc9f662"),
+ hexstr2bin("76fc6ece0f4e1768cddf8853bb2d551b")}, %% CipherTag
+
+ %% Test Case 17
+ {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key
+ "feffe9928665731c6d6a8f9467308308"),
+ hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText
+ "86a7a9531534f7da2e4c303d8a318a72"
+ "1c3c0c95956809532fcf0e2449a6b525"
+ "b16aedf5aa0de657ba637b39"),
+ hexstr2bin("cafebabefacedbad"), %% IV
+ hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD
+ "abaddad2"),
+ hexstr2bin("c3762df1ca787d32ae47c13bf19844cb" %% CipherText
+ "af1ae14d0b976afac52ff7d79bba9de0"
+ "feb582d33934a4f0954cc2363bc73f78"
+ "62ac430e64abe499f47c9b1f"),
+ hexstr2bin("3a337dbf46a792c45e454913fe2ea8f2")}, %% CipherTag
+
+ %% Test Case 18
+ {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key
+ "feffe9928665731c6d6a8f9467308308"),
+ hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText
+ "86a7a9531534f7da2e4c303d8a318a72"
+ "1c3c0c95956809532fcf0e2449a6b525"
+ "b16aedf5aa0de657ba637b39"),
+ hexstr2bin("9313225df88406e555909c5aff5269aa" %% IV
+ "6a7a9538534f7da1e4c303d2a318a728"
+ "c3c0c95156809539fcf0e2429a6b5254"
+ "16aedbf5a0de6a57a637b39b"),
+ hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD
+ "abaddad2"),
+ hexstr2bin("5a8def2f0c9e53f1f75d7853659e2a20" %% CipherText
+ "eeb2b22aafde6419a058ab4f6f746bf4"
+ "0fc0c3b780f244452da3ebf1c5d82cde"
+ "a2418997200ef82e44ae7e3f"),
+ hexstr2bin("a44a8266ee1c8eb0c8b5d4cf5ae9f19a")} %% CipherTag
+ ].
+
+%% http://tools.ietf.org/html/draft-agl-tls-chacha20poly1305-04
+chacha20_poly1305() ->
+ [
+ {chacha20_poly1305, hexstr2bin("4290bcb154173531f314af57f3be3b500" %% Key
+ "6da371ece272afa1b5dbdd1100a1007"),
+ hexstr2bin("86d09974840bded2a5ca"), %% PlainText
+ hexstr2bin("cd7cf67be39c794a"), %% Nonce
+ hexstr2bin("87e229d4500845a079c0"), %% AAD
+ hexstr2bin("e3e446f7ede9a19b62a4"), %% CipherText
+ hexstr2bin("677dabf4e3d24b876bb284753896e1d6")} %% CipherTag
+ ].
+
rsa_plain() ->
<<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger"
"09812312908312378623487263487623412039812 huagasd">>.
diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl
index 0076193725..e525484a8e 100644
--- a/lib/debugger/test/map_SUITE.erl
+++ b/lib/debugger/test/map_SUITE.erl
@@ -32,9 +32,30 @@
t_guard_receive/1, t_guard_fun/1,
t_list_comprehension/1,
t_map_sort_literals/1,
- %t_size/1,
t_map_size/1,
-
+ t_build_and_match_aliasing/1,
+
+ %% variables
+ t_build_and_match_variables/1,
+ t_update_assoc_variables/1,t_update_exact_variables/1,
+ t_nested_pattern_expressions/1,
+ t_guard_update_variables/1,
+ t_guard_sequence_variables/1,
+ t_guard_sequence_mixed/1,
+ t_frequency_table/1,
+
+ %% not covered in 17.0-rc1
+ t_build_and_match_over_alloc/1,
+ t_build_and_match_empty_val/1,
+ t_build_and_match_val/1,
+ t_build_and_match_nil/1,
+ t_build_and_match_structure/1,
+
+ %% errors in 17.0-rc1
+ t_update_values/1,
+ t_expand_map_update/1,
+ t_export/1,
+
%% Specific Map BIFs
t_bif_map_get/1,
t_bif_map_find/1,
@@ -61,8 +82,7 @@
%% misc
t_pdict/1,
- t_ets/1,
- t_dets/1
+ t_ets/1
]).
-include_lib("stdlib/include/ms_transform.hrl").
@@ -77,7 +97,30 @@ all() -> [
t_guard_bifs, t_guard_sequence, t_guard_update,
t_guard_receive,t_guard_fun, t_list_comprehension,
t_map_sort_literals,
-
+ t_build_and_match_aliasing,
+
+ %% variables
+ t_build_and_match_variables,
+ t_update_assoc_variables,t_update_exact_variables,
+ t_nested_pattern_expressions,
+ t_guard_update_variables,
+ t_guard_sequence_variables,
+ t_guard_sequence_mixed,
+ t_frequency_table,
+
+ %% not covered in 17.0-rc1
+ t_build_and_match_over_alloc,
+ t_build_and_match_empty_val,
+ t_build_and_match_val,
+ t_build_and_match_nil,
+ t_build_and_match_structure,
+
+
+ %% errors in 17.0-rc1
+ t_update_values,
+ t_expand_map_update,
+ t_export,
+
%% Specific Map BIFs
t_bif_map_get,t_bif_map_find,t_bif_map_is_key,
t_bif_map_keys, t_bif_map_merge, t_bif_map_new,
@@ -94,7 +137,6 @@ all() -> [
t_maps_fold, t_maps_map,
t_maps_size, t_maps_without,
-
%% Other functions
t_pdict,
t_ets
@@ -147,18 +189,6 @@ t_build_and_match_literals(Config) when is_list(Config) ->
{'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))),
ok.
-
-%% Tests size(Map).
-%% not implemented, perhaps it shouldn't be either
-
-%t_size(Config) when is_list(Config) ->
-% 0 = size(#{}),
-% 1 = size(#{a=>1}),
-% 1 = size(#{a=>#{a=>1}}),
-% 2 = size(#{a=>1, b=>2}),
-% 3 = size(#{a=>1, b=>2, b=>"3"}),
-% ok.
-
t_map_size(Config) when is_list(Config) ->
0 = map_size(id(#{})),
1 = map_size(id(#{a=>1})),
@@ -268,6 +298,44 @@ t_update_exact(Config) when is_list(Config) ->
ok.
+t_update_values(Config) when is_list(Config) ->
+ V0 = id(1337),
+ M0 = #{ a => 1, val => V0},
+ V1 = get_val(M0),
+ M1 = id(M0#{ val := [V0,V1], "wazzup" => 42 }),
+ [1337, {some_val, 1337}] = get_val(M1),
+ M2 = id(M1#{ <<42:333>> => 1337 }),
+ {bin_key,1337} = get_val(M2),
+
+ N = 110,
+ List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)],
+
+ {_,_,#{val2 := {1,2,3,"wat",N}, val1 := [N,1,2,3,N]}} = lists:foldl(fun
+ ({V2,V3},{Old2,Old3,Mi}) ->
+ ok = check_val(Mi,Old2,Old3),
+ #{ val1 := Old2, val2 := Old3 } = Mi,
+ {V2,V3, Mi#{ val1 := id(V2), val2 := V1, val2 => id(V3)}}
+ end, {none, none, #{val1=>none,val2=>none}},List),
+ ok.
+
+t_expand_map_update(Config) when is_list(Config) ->
+ M = #{<<"hello">> => <<"world">>}#{<<"hello">> := <<"les gens">>},
+ #{<<"hello">> := <<"les gens">>} = M,
+ ok.
+
+t_export(Config) when is_list(Config) ->
+ Raclette = id(#{}),
+ case brie of brie -> Fromage = Raclette end,
+ Raclette = Fromage#{},
+ ok.
+
+check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok.
+
+get_val(#{ <<42:333>> := V }) -> {bin_key, V};
+get_val(#{ "wazzup" := _, val := V}) -> V;
+get_val(#{ val := V }) -> {some_val, V}.
+
+
t_guard_bifs(Config) when is_list(Config) ->
true = map_guard_head(#{a=>1}),
false = map_guard_head([]),
@@ -988,16 +1056,385 @@ t_ets(_Config) ->
ets:delete(Tid),
ok.
-t_dets(_Config) ->
+t_build_and_match_aliasing(Config) when is_list(Config) ->
+ M1 = id(#{a=>1,b=>2,c=>3,d=>4}),
+ #{c:=C1=_=_=C2} = M1,
+ true = C1 =:= C2,
+ #{a:=A,a:=A,a:=A,b:=B,b:=B} = M1,
+ #{a:=A,a:=A,a:=A,b:=B,b:=B,b:=2} = M1,
+ #{a:=A=1,a:=A,a:=A,b:=B=2,b:=B,b:=2} = M1,
+ #{c:=C1, c:=_, c:=3, c:=_, c:=C2} = M1,
+ #{c:=C=_=3=_=C} = M1,
+
+ M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}),
+ #{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2,
+ #{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2,
+ ok.
+
+%% simple build and match variables
+t_build_and_match_variables(Config) when is_list(Config) ->
+ K0 = id(#{}),
+ K1 = id(1), V1 = id(a),
+ K2 = id(2), V2 = id(b),
+ K3 = id(3), V3 = id("c"),
+ K4 = id("4"), V4 = id("d"),
+ K5 = id(<<"5">>), V5 = id(<<"e">>),
+ K6 = id({"6",7}), V6 = id("f"),
+ K7 = id(#{ "a" => 3 }),
+ #{K1:=V1} = id(#{K1=>V1}),
+ #{K1:=V1,K2:=V2} = id(#{K1=>V1,K2=>V2}),
+ #{K1:=V1,K2:=V2,K3:=V3} = id(#{K1=>V1,K2=>V2,K3=>V3}),
+ #{K1:=V1,K2:=V2,K3:=V3,K4:=V4} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4}),
+ #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5}),
+ #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5,K6:=V6} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5,K6=>V6}),
+
+ #{K5:=X,K5:=X=3,K4:=4} = id(#{K5=>3,K4=>4}),
+ #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{K5=>3,K4=>4}),
+ #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{<<"5">>=>3,K4=>4}),
+
+ #{ K4:=#{ K3:=#{K1:=V1, K2:=V2}}, K5:=V5} =
+ id(#{ K5=>V5, K4=>#{ K3=>#{K2 => V2, K1 => V1}}}),
+ #{ K4 := #{ K5 := Res }, K6 := Res} = id(#{K4=>#{K5 => 99}, K6 => 99}),
+
+ %% has keys
+ #{a :=_,b :=_,K1:=_,K2:=_,K3:=V3,K4:=ResKey,K4:=ResKey,"4":=ResKey,"4":="ok"} =
+ id(#{ a=>1, b=>1, K1=>V1, K2=>V2, K3=>V3, K4=>"nope", "4"=>"ok" }),
+
+ %% function
+ ok = match_function_map_neg_keys(#{ -1 => a, -2 => b, -3 => c }),
+
+ %% map key
+ #{ K0 := 42 } = id(#{ K0 => 42 }),
+ #{ K7 := 42 } = id(#{ K7 => 42 }),
+
+ %% nil key
+ KNIL = id([]),
+ #{KNIL:=ok,1:=2} = id(#{KNIL=>ok,1=>2}),
+
+ Bin = <<0:258>>,
+ #{ Bin := "three" } = id(#{<<0:258>> =>"three"}),
+
+ %% error case
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3,x:=2} = id(#{K5=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=2} = id(#{K5=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id({a,b,c}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(#{K6=>3}))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(K7))),
+ {'EXIT',{{badmatch,_},_}} = (catch (#{K7:=3} = id(#{K7=>42}))),
+ ok.
+
+
+match_function_map_neg_keys(#{ -1 := a, -2 := b, -3 := c }) -> ok.
+
+t_update_assoc_variables(Config) when is_list(Config) ->
+ K1 = id(1),
+ K2 = id(2),
+ K3 = id(3.0),
+ K4 = id(4),
+ K5 = id(5),
+ K6 = id(2.0),
+
+ M0 = #{K1=>a,K2=>b,K3=>c,K4=>d,K5=>e},
+
+ M1 = M0#{K1=>42,K2=>100,K4=>[a,b,c]},
+ #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1,
+ #{1:=42,2:=b,4:=d,5:=e,2.0:=100,K3:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,K6=>100,4.0=>[a,b,c]},
+
+ M2 = M0#{K3=>new},
+ #{1:=a,2:=b,K3:=new,4:=d,5:=e} = M2,
+ M2 = M0#{3.0:=wrong,K3=>new},
+
+ #{ <<0:258>> := val } = id(M0#{<<0:258>> => val}), %% binary limitation
+
+ %% Errors cases.
+ BadMap = id(badmap),
+ {'EXIT',{{badarg,_},_}} = (catch BadMap#{nonexisting=>val}),
+ {'EXIT',{{badarg,_},_}} = (catch <<>>#{nonexisting=>val}),
+ ok.
+
+t_update_exact_variables(Config) when is_list(Config) ->
+ K1 = id(1),
+ K2 = id(2),
+ K3 = id(3.0),
+ K4 = id(4),
+
+ M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}),
+
+ M1 = M0#{K1:=42,K2:=100,K4:=[a,b,c]},
+ #{1:=42,2:=100,3.0:=c,K4:=[a,b,c],5:=e} = M1,
+ M1 = M0#{K1:=wrong,1:=also_wrong,K1=>42,2=>wrong,K2:=100,4:=[a,b,c]},
+
+ M2 = M0#{K3:=new},
+ #{1:=a,K2:=b,3.0:=new,K4:=d,5:=e} = M2,
+ M2 = M0#{3.0=>wrong,K3:=new},
+ true = M2 =/= M0#{3=>right,3.0:=new},
+ #{ 3 := right, 3.0 := new } = M0#{3=>right,K3:=new},
+
+ M3 = id(#{ 1 => val}),
+ #{1 := update2,1.0 := new_val4} = M3#{
+ 1.0 => new_val1, K1 := update, K1=> update3,
+ K1 := update2, 1.0 := new_val2, 1.0 => new_val3,
+ 1.0 => new_val4 },
+
+ %% Errors cases.
+ {'EXIT',{{badarg,_},_}} = (catch ((id(nil))#{ a := b })),
+ {'EXIT',{{badarg,_},_}} = (catch <<>>#{nonexisting:=val}),
+
+ {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}),
+ {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}),
+ {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}),
+ {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}),
+ {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation
+ ok.
+
+t_nested_pattern_expressions(Config) when is_list(Config) ->
+ K1 = id("hello"),
+ %K2 = id({ok}),
+ [_,_,#{ <<"hi">> := wat, K1 := 42 }|_] = id([k,k,#{<<"hi">> => wat, K1 => 42}]),
+ [_,_,#{ -1 := wat, K1 := 42 }|_] = id([k,k,#{-1 => wat, K1 => 42}]),
+ [_,_,{#{ -1 := #{ {-3,<<0:300>>} := V1 }, K1 := 42 },3}|_] = id([k,k,{#{-1 => #{{-3,<<0:300>>}=>"hi"}, K1 => 42},3}]),
+ "hi" = V1,
+ %[k,#{ {-1,K1,[]} := {wat,K1}, K2 := 42 }|_] = id([k,#{{-1,K1,[]} => {wat,K1}, K2 => 42}]),
+ %[k,#{ [-1,K2,[]] := {wat,K1}, K1 := 42 }|_] = id([k,#{[-1,K2,[]] => {wat,K1}, K1 => 42}]),
+ ok.
+
+t_guard_update_variables(Config) when is_list(Config) ->
+ error = map_guard_update_variables(n,#{},#{}),
+ first = map_guard_update_variables(x,#{}, #{x=>first}),
+ second = map_guard_update_variables(x,#{y=>old}, #{x=>second,y=>old}),
+ third = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>third,y=>old}),
+ fourth = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>4,y=>new}),
+ ok.
+
+map_guard_update_variables(K,M1,M2) when M1#{K=>first} =:= M2 -> first;
+map_guard_update_variables(K,M1,M2) when M1#{K=>second} =:= M2 -> second;
+map_guard_update_variables(K,M1,M2) when M1#{K:=third} =:= M2 -> third;
+map_guard_update_variables(K,M1,M2) when M1#{K:=4,y=>new} =:= M2 -> fourth;
+map_guard_update_variables(_,_,_) -> error.
+
+t_guard_sequence_variables(Config) when is_list(Config) ->
+ {1,"a"} = map_guard_sequence_var_1(a,#{seq=>1,a=>id("a"),b=>no}),
+ {2,"b"} = map_guard_sequence_var_1(b,#{seq=>2,b=>id("b"),a=>no}),
+ {3,"c"} = map_guard_sequence_var_1(a,#{seq=>3,a=>id("c"),b=>no}),
+ {4,"d"} = map_guard_sequence_var_1(b,#{seq=>4,b=>id("d"),a=>no}),
+ {4,4} = map_guard_sequence_var_1(seq,#{seq=>4}),
+ {4,4,y} = map_guard_sequence_var_1(seq,#{seq=>4,b=>id("d"),a=>y}),
+ {5,"d"} = map_guard_sequence_var_1(b,#{seq=>5,b=>id("d"),a=>y}),
+
+ %% error case
+ {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_var_1("a",#{seq=>4,val=>id("e")})),
+ ok.
+
+
+map_guard_sequence_var_1(K,M) ->
+ case M of
+ #{seq:=1=Seq, K:=Val} -> {Seq,Val};
+ #{seq:=2=Seq, K:=Val} -> {Seq,Val};
+ #{seq:=3=Seq, K:=Val} -> {Seq,Val};
+ #{K:=4=Seq, K:=Val1,a:=Val2} -> {Seq,Val1,Val2};
+ #{seq:=4=Seq, K:=Val} -> {Seq,Val};
+ #{K:=4=Seq, K:=Val} -> {Seq,Val};
+ #{seq:=5=Seq, K:=Val} -> {Seq,Val}
+ end.
+
+
+t_guard_sequence_mixed(Config) when is_list(Config) ->
+ M0 = id(#{ a=>1, b=>1, c=>1, d=>1, e=>1, f=>1, g=>1, h=>1 }),
+ M1 = id(M0#{ d := 3 }),
+ 1 = map_guard_sequence_mixed(a,d,M1),
+ M2 = id(M1#{ b := 2, d := 4, h := 2 }),
+ 2 = map_guard_sequence_mixed(a,d,M2),
+ M3 = id(M2#{ b := 3, e := 5, g := 3 }),
+ 3 = map_guard_sequence_mixed(a,e,M3),
+ M4 = id(M3#{ c := 4, e := 6, h := 1 }),
+ 4 = map_guard_sequence_mixed(a,e,M4),
+ M5 = id(M4#{ c := 5, f := 7, g := 2 }),
+ 5 = map_guard_sequence_mixed(a,f,M5),
+ M6 = id(M5#{ c := 6, f := 8, h := 3 }),
+ 6 = map_guard_sequence_mixed(a,f,M6),
+
+ %% error case
+ {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_mixed(a,b,M0)),
+ ok.
+
+map_guard_sequence_mixed(K1,K2,M) ->
+ case M of
+ #{ K1 := 1, b := 1, K2 := 3, g := 1} -> 1;
+ #{ K1 := 1, b := 2, K2 := 4, h := 2} -> 2;
+ #{ K1 := 1, b := 3, K2 := 5, g := 3} -> 3;
+ #{ K1 := 1, c := 4, K2 := 6, h := 1} -> 4;
+ #{ K1 := 1, c := 5, K2 := 7, g := 2} -> 5;
+ #{ K1 := 1, c := 6, K2 := 8, h := 3} -> 6
+ end.
+
+
+
+t_frequency_table(Config) when is_list(Config) ->
+ random:seed({13,1337,54}), % pseudo random
+ N = 100000,
+ Ts = rand_terms(N),
+ #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}),
+ ok = check_frequency(Ts,Tf),
+ ok.
+
+
+frequency_table([T|Ts], M) ->
+ case M of
+ #{ n := N, tf := #{ T := C } = F } ->
+ frequency_table(Ts,M#{ n := N + 1, tf := F#{ T := C + 1 }});
+ #{ n := N, tf := F } ->
+ frequency_table(Ts,M#{ n := N + 1, tf := F#{ T => 1 }})
+ end;
+frequency_table([], M) -> M.
+
+
+check_frequency(Ts,Tf) ->
+ check_frequency(Ts,Tf,dict:new()).
+
+check_frequency([T|Ts],Tf,D) ->
+ case dict:find(T,D) of
+ error -> check_frequency(Ts,Tf,dict:store(T,1,D));
+ {ok,C} -> check_frequency(Ts,Tf,dict:store(T,C+1,D))
+ end;
+check_frequency([],Tf,D) ->
+ validate_frequency(dict:to_list(D),Tf).
+
+validate_frequency([{T,C}|Fs],Tf) ->
+ case Tf of
+ #{ T := C } -> validate_frequency(Fs,Tf);
+ _ -> error
+ end;
+validate_frequency([], _) -> ok.
+
+
+%% aux
+
+rand_terms(0) -> [];
+rand_terms(N) -> [rand_term()|rand_terms(N-1)].
+
+rand_term() ->
+ case random:uniform(6) of
+ 1 -> rand_binary();
+ 2 -> rand_number();
+ 3 -> rand_atom();
+ 4 -> rand_tuple();
+ 5 -> rand_list();
+ 6 -> rand_map()
+ end.
+
+rand_binary() ->
+ case random:uniform(3) of
+ 1 -> <<>>;
+ 2 -> <<"hi">>;
+ 3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">>
+ end.
+
+rand_number() ->
+ case random:uniform(3) of
+ 1 -> random:uniform(5);
+ 2 -> float(random:uniform(5));
+ 3 -> 1 bsl (63 + random:uniform(3))
+ end.
+
+rand_atom() ->
+ case random:uniform(3) of
+ 1 -> hi;
+ 2 -> some_atom;
+ 3 -> some_other_atom
+ end.
+
+
+rand_tuple() ->
+ case random:uniform(3) of
+ 1 -> {ok, rand_term()}; % careful
+ 2 -> {1, 2, 3};
+ 3 -> {<<"yep">>, 1337}
+ end.
+
+rand_list() ->
+ case random:uniform(3) of
+ 1 -> "hi";
+ 2 -> [1,rand_term()]; % careful
+ 3 -> [improper|list]
+ end.
+
+rand_map() ->
+ case random:uniform(3) of
+ 1 -> #{ hi => 3 };
+ 2 -> #{ wat => rand_term(), other => 3 }; % careful
+ 3 -> #{ hi => 42, other => 42, yet_anoter => 1337 }
+ end.
+
+
+t_build_and_match_over_alloc(Config) when is_list(Config) ->
+ Ls = id([1,2,3]),
+ V0 = [a|Ls],
+ M0 = id(#{ "a" => V0 }),
+ #{ "a" := V1 } = M0,
+ V2 = id([c|Ls]),
+ M2 = id(#{ "a" => V2 }),
+ #{ "a" := V3 } = M2,
+ {[a,1,2,3],[c,1,2,3]} = id({V1,V3}),
+ ok.
+
+t_build_and_match_empty_val(Config) when is_list(Config) ->
+ F = fun(#{ "hi":=_,{1,2}:=_,1337:=_}) -> ok end,
+ ok = F(id(#{"hi"=>ok,{1,2}=>ok,1337=>ok})),
+
+ %% error case
+ case (catch (F(id(#{"hi"=>ok})))) of
+ {'EXIT',{function_clause,_}} -> ok;
+ {'EXIT', {{case_clause,_},_}} -> {comment,inlined};
+ Other ->
+ test_server:fail({no_match, Other})
+ end.
+
+t_build_and_match_val(Config) when is_list(Config) ->
+ F = fun
+ (#{ "hi" := first, v := V}) -> {1,V};
+ (#{ "hi" := second, v := V}) -> {2,V}
+ end,
+
+
+ {1,"hello"} = F(id(#{"hi"=>first,v=>"hello"})),
+ {2,"second"} = F(id(#{"hi"=>second,v=>"second"})),
+
+ %% error case
+ case (catch (F(id(#{"hi"=>ok})))) of
+ {'EXIT',{function_clause,_}} -> ok;
+ {'EXIT', {{case_clause,_},_}} -> {comment,inlined};
+ Other ->
+ test_server:fail({no_match, Other})
+ end.
+
+t_build_and_match_nil(Config) when is_list(Config) ->
+ %% literals removed the coverage
+ V1 = id(cookie),
+ V2 = id(cake),
+ V3 = id(crisps),
+
+ #{ [] := V1, "treat" := V2, {your,treat} := V3 } = id(#{
+ {your,treat} => V3,
+ "treat" => V2,
+ [] => V1 }),
+ #{ [] := V3, [] := V3 } = id(#{ [] => V1, [] => V3 }),
+ ok.
+
+t_build_and_match_structure(Config) when is_list(Config) ->
+ V2 = id("it"),
+ S = id([42,{"hi", "=)", #{ "a" => 42, any => any, val => "get_" ++ V2}}]),
+
+ %% match deep map values
+ V2 = case S of
+ [42,{"hi",_, #{ "a" := 42, val := "get_" ++ V1, any := _ }}] -> V1
+ end,
+ %% match deep map
+ ok = case S of
+ [42,{"hi",_, #{ }}] -> ok
+ end,
ok.
-getmsg(_Tracer) ->
- receive V -> V after 100 -> timeout end.
-trace_collector(Msg,Parent) ->
- io:format("~p~n",[Msg]),
- Parent ! Msg,
- Parent.
%% Use this function to avoid compile-time evaluation of an expression.
id(I) -> I.
diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl
index 1d458b49fc..bbedd3201e 100644
--- a/lib/dialyzer/src/dialyzer_behaviours.erl
+++ b/lib/dialyzer/src/dialyzer_behaviours.erl
@@ -102,14 +102,18 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest],
#state{plt = Plt, codeserver = Codeserver,
records = Records} = State, Acc) ->
{{Behaviour, Function, Arity},
- {{_BehFile, _BehLine}, Callback}} = Cb,
+ {{_BehFile, _BehLine}, Callback, Xtra}} = Cb,
CbMFA = {Module, Function, Arity},
CbReturnType = dialyzer_contracts:get_contract_return(Callback),
CbArgTypes = dialyzer_contracts:get_contract_args(Callback),
Acc0 = Acc,
Acc1 =
case dialyzer_plt:lookup(Plt, CbMFA) of
- 'none' -> [{callback_missing, [Behaviour, Function, Arity]}|Acc0];
+ 'none' ->
+ case lists:member(optional_callback, Xtra) of
+ true -> Acc0;
+ false -> [{callback_missing, [Behaviour, Function, Arity]}|Acc0]
+ end;
{'value', RetArgTypes} ->
Acc00 = Acc0,
{ReturnType, ArgTypes} = RetArgTypes,
@@ -137,7 +141,7 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest],
Acc2 =
case dialyzer_codeserver:lookup_mfa_contract(CbMFA, Codeserver) of
'error' -> Acc1;
- {ok, {{File, Line}, Contract}} ->
+ {ok, {{File, Line}, Contract, _Xtra}} ->
Acc10 = Acc1,
SpecReturnType0 = dialyzer_contracts:get_contract_return(Contract),
SpecArgTypes0 = dialyzer_contracts:get_contract_args(Contract),
diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl
index aab3d6add6..593e71f30b 100644
--- a/lib/dialyzer/src/dialyzer_codeserver.erl
+++ b/lib/dialyzer/src/dialyzer_codeserver.erl
@@ -278,10 +278,10 @@ lookup_mod_contracts(Mod, #codeserver{contracts = ContDict})
case ets_dict_find(Mod, ContDict) of
error -> dict:new();
{ok, Keys} ->
- dict:from_list([get_contract_pair(Key, ContDict)|| Key <- Keys])
+ dict:from_list([get_file_contract(Key, ContDict)|| Key <- Keys])
end.
-get_contract_pair(Key, ContDict) ->
+get_file_contract(Key, ContDict) ->
{Key, ets:lookup_element(ContDict, Key, 2)}.
-spec lookup_mfa_contract(mfa(), codeserver()) ->
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index f27fc1a842..ee147ca102 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -43,7 +43,7 @@
%% Types used in other parts of the system below
%%-----------------------------------------------------------------------
--type file_contract() :: {file_line(), #contract{}}.
+-type file_contract() :: {file_line(), #contract{}, Extra :: [_]}.
-type plt_contracts() :: [{mfa(), #contract{}}]. % actually, an orddict()
@@ -146,10 +146,10 @@ process_contract_remote_types(CodeServer) ->
ExpTypes = dialyzer_codeserver:get_exported_types(CodeServer),
RecordDict = dialyzer_codeserver:get_records(CodeServer),
ContractFun =
- fun({_M, _F, _A}, {File, #tmp_contract{contract_funs = CFuns, forms = Forms}}) ->
+ fun({_M, _F, _A}, {File, #tmp_contract{contract_funs = CFuns, forms = Forms}, Xtra}) ->
NewCs = [CFun(ExpTypes, RecordDict) || CFun <- CFuns],
Args = general_domain(NewCs),
- {File, #contract{contracts = NewCs, args = Args, forms = Forms}}
+ {File, #contract{contracts = NewCs, args = Args, forms = Forms}, Xtra}
end,
ModuleFun =
fun(_ModuleName, ContractDict) ->
@@ -175,7 +175,7 @@ check_contracts(Contracts, Callgraph, FunTypes, FindOpaques) ->
case dialyzer_callgraph:lookup_name(Label, Callgraph) of
{ok, {M,F,A} = MFA} ->
case orddict:find(MFA, Contracts) of
- {ok, {_FileLine, Contract}} ->
+ {ok, {_FileLine, Contract, _Xtra}} ->
Opaques = FindOpaques(M),
case check_contract(Contract, Type, Opaques) of
ok ->
@@ -362,7 +362,7 @@ contracts_without_fun(Contracts, AllFuns0, Callgraph) ->
[warn_spec_missing_fun(MFA, Contracts) || MFA <- ErrorContractMFAs].
warn_spec_missing_fun({M, F, A} = MFA, Contracts) ->
- {FileLine, _Contract} = dict:fetch(MFA, Contracts),
+ {FileLine, _Contract, _Xtra} = dict:fetch(MFA, Contracts),
{?WARN_CONTRACT_SYNTAX, FileLine, {spec_missing_fun, [M, F, A]}}.
%% This treats the "when" constraints. It will be extended, we hope.
@@ -386,14 +386,16 @@ insert_constraints([], Dict) -> Dict.
-type types() :: erl_types:type_table().
--spec store_tmp_contract(mfa(), file_line(), [_], contracts(), types()) ->
+-type spec_data() :: {TypeSpec :: [_], Xtra:: [_]}.
+
+-spec store_tmp_contract(mfa(), file_line(), spec_data(), contracts(), types()) ->
contracts().
-store_tmp_contract(MFA, FileLine, TypeSpec, SpecDict, RecordsDict) ->
+store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecDict, RecordsDict) ->
%% io:format("contract from form: ~p\n", [TypeSpec]),
TmpContract = contract_from_form(TypeSpec, RecordsDict, FileLine),
%% io:format("contract: ~p\n", [TmpContract]),
- dict:store(MFA, {FileLine, TmpContract}, SpecDict).
+ dict:store(MFA, {FileLine, TmpContract, Xtra}, SpecDict).
contract_from_form(Forms, RecDict, FileLine) ->
{CFuns, Forms1} = contract_from_form(Forms, RecDict, FileLine, [], []),
@@ -597,7 +599,7 @@ get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, FindOpaques,
get_invalid_contract_warnings_modules([], _CodeServer, _Plt, _FindOpaques, Acc) ->
Acc.
-get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract}}|Left],
+get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left],
Plt, RecDict, FindOpaques, Acc) ->
case dialyzer_plt:lookup(Plt, MFA) of
none ->
diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl
index 03005e689f..46467a1303 100644
--- a/lib/dialyzer/src/dialyzer_dataflow.erl
+++ b/lib/dialyzer/src/dialyzer_dataflow.erl
@@ -2781,8 +2781,7 @@ filter_match_fail([]) ->
%%% ===========================================================================
state__new(Callgraph, Tree, Plt, Module, Records) ->
- Opaques = erl_types:module_builtin_opaques(Module) ++
- erl_types:t_opaque_from_records(Records),
+ Opaques = erl_types:t_opaque_from_records(Records),
TreeMap = build_tree_map(Tree),
Funs = dict:fetch_keys(TreeMap),
FunTab = init_fun_tab(Funs, dict:new(), TreeMap, Callgraph, Plt),
diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl
index 63798f44b1..7c970daf41 100644
--- a/lib/dialyzer/src/dialyzer_plt.erl
+++ b/lib/dialyzer/src/dialyzer_plt.erl
@@ -158,9 +158,7 @@ lookup_contract(#mini_plt{contracts = ETSContracts},
ets_table_lookup(ETSContracts, MFA).
-spec lookup_callbacks(plt(), module()) ->
- 'none' | {'value', [{mfa(), {{Filename::string(),
- Line::pos_integer()},
- #contract{}}}]}.
+ 'none' | {'value', [{mfa(), dialyzer_contracts:file_contract()}]}.
lookup_callbacks(#mini_plt{callbacks = ETSCallbacks}, Mod) when is_atom(Mod) ->
ets_table_lookup(ETSCallbacks, Mod).
@@ -618,9 +616,7 @@ table_insert_list(Plt, [{Key, Val}|Left]) ->
table_insert_list(Plt, []) ->
Plt.
-table_insert(Plt, Key, {_Ret, _Arg} = Obj) ->
- dict:store(Key, Obj, Plt);
-table_insert(Plt, Key, #contract{} = C) ->
+table_insert(Plt, Key, {_File, #contract{}, _Xtra} = C) ->
dict:store(Key, C, Plt).
table_lookup(Plt, Obj) ->
diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl
index ef9b00e203..6dc4285194 100644
--- a/lib/dialyzer/src/dialyzer_succ_typings.erl
+++ b/lib/dialyzer/src/dialyzer_succ_typings.erl
@@ -201,7 +201,7 @@ postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {CallF, CallL}, Msg}|Rest],
Codeserver, WAcc, Acc) ->
{contract_range, [Contract, M, F, A, ArgStrings, CRet]} = Msg,
case dialyzer_codeserver:lookup_mfa_contract({M,F,A}, Codeserver) of
- {ok, {{ContrF, _ContrL} = FileLine, _C}} ->
+ {ok, {{ContrF, _ContrL} = FileLine, _C, _X}} ->
case CallF =:= ContrF of
true ->
NewMsg = {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]},
@@ -401,7 +401,7 @@ decorate_succ_typings(Contracts, Callgraph, FunTypes, FindOpaques) ->
case dialyzer_callgraph:lookup_name(Label, Callgraph) of
{ok, MFA} ->
case orddict:find(MFA, Contracts) of
- {ok, {_FileLine, Contract}} ->
+ {ok, {_FileLine, Contract, _Xtra}} ->
Args = dialyzer_contracts:get_contract_args(Contract),
Ret = dialyzer_contracts:get_contract_return(Contract),
C = erl_types:t_fun(Args, Ret),
@@ -422,10 +422,7 @@ lookup_and_find_opaques_fun(Codeserver) ->
end.
find_opaques_fun(Records) ->
- fun(Module) ->
- erl_types:module_builtin_opaques(Module) ++
- erl_types:t_opaque_from_records(Records)
- end.
+ fun(_Module) -> erl_types:t_opaque_from_records(Records) end.
get_fun_types_from_plt(FunList, Callgraph, Plt) ->
get_fun_types_from_plt(FunList, Callgraph, Plt, dict:new()).
diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index 5297a3a7b4..e5f5c69d45 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -345,8 +345,26 @@ merge_records(NewRecords, OldRecords) ->
{'ok', spec_dict(), callback_dict()} | {'error', string()}.
get_spec_info(ModName, AbstractCode, RecordsDict) ->
+ OptionalCallbacks0 = get_optional_callbacks(AbstractCode, ModName),
+ OptionalCallbacks = gb_sets:from_list(OptionalCallbacks0),
get_spec_info(AbstractCode, dict:new(), dict:new(),
- RecordsDict, ModName, "nofile").
+ RecordsDict, ModName, OptionalCallbacks, "nofile").
+
+get_optional_callbacks(Abs, ModName) ->
+ [{ModName, F, A} || {F, A} <- get_optional_callbacks(Abs)].
+
+get_optional_callbacks(Abs) ->
+ L = [O ||
+ {attribute, _, optional_callbacks, O} <- Abs,
+ is_fa_list(O)],
+ lists:append(L).
+
+is_fa_list([{FuncName, Arity}|L])
+ when is_atom(FuncName), is_integer(Arity), Arity >= 0 ->
+ is_fa_list(L);
+is_fa_list([]) -> true;
+is_fa_list(_) -> false.
+
%% TypeSpec is a list of conditional contracts for a function.
%% Each contract is of the form {[Argument], Range, [Constraint]} where
@@ -355,13 +373,14 @@ get_spec_info(ModName, AbstractCode, RecordsDict) ->
%% are erl_types:erl_type()
get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left],
- SpecDict, CallbackDict, RecordsDict, ModName, File)
+ SpecDict, CallbackDict, RecordsDict, ModName, OptCb, File)
when ((Contract =:= 'spec') or (Contract =:= 'callback')),
is_list(TypeSpec) ->
MFA = case Id of
{_, _, _} = T -> T;
{F, A} -> {ModName, F, A}
end,
+ Xtra = [optional_callback || gb_sets:is_member(MFA, OptCb)],
ActiveDict =
case Contract of
spec -> SpecDict;
@@ -369,8 +388,9 @@ get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left],
end,
try dict:find(MFA, ActiveDict) of
error ->
+ SpecData = {TypeSpec, Xtra},
NewActiveDict =
- dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, TypeSpec,
+ dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, SpecData,
ActiveDict, RecordsDict),
{NewSpecDict, NewCallbackDict} =
case Contract of
@@ -378,8 +398,8 @@ get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left],
callback -> {SpecDict, NewActiveDict}
end,
get_spec_info(Left, NewSpecDict, NewCallbackDict,
- RecordsDict, ModName,File);
- {ok, {{OtherFile, L},_C}} ->
+ RecordsDict, ModName, OptCb, File);
+ {ok, {{OtherFile, L}, _D}} ->
{Mod, Fun, Arity} = MFA,
Msg = flat_format(" Contract/callback for function ~w:~w/~w "
"already defined in ~s:~w\n",
@@ -391,13 +411,15 @@ get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left],
[Ln, Error])}
end;
get_spec_info([{attribute, _, file, {IncludeFile, _}}|Left],
- SpecDict, CallbackDict, RecordsDict, ModName, _File) ->
+ SpecDict, CallbackDict, RecordsDict, ModName, OptCb, _File) ->
get_spec_info(Left, SpecDict, CallbackDict,
- RecordsDict, ModName, IncludeFile);
+ RecordsDict, ModName, OptCb, IncludeFile);
get_spec_info([_Other|Left], SpecDict, CallbackDict,
- RecordsDict, ModName, File) ->
- get_spec_info(Left, SpecDict, CallbackDict, RecordsDict, ModName, File);
-get_spec_info([], SpecDict, CallbackDict, _RecordsDict, _ModName, _File) ->
+ RecordsDict, ModName, OptCb, File) ->
+ get_spec_info(Left, SpecDict, CallbackDict,
+ RecordsDict, ModName, OptCb, File);
+get_spec_info([], SpecDict, CallbackDict,
+ _RecordsDict, _ModName, _OptCb, _File) ->
{ok, SpecDict, CallbackDict}.
%% ============================================================================
@@ -449,7 +471,6 @@ cleanup_compile_options(Opts) ->
%% Using abstract, not asm or core.
keep_compile_option(from_asm) -> false;
-keep_compile_option(asm) -> false;
keep_compile_option(from_core) -> false;
%% The parse transform will already have been applied, may cause
%% problems if it is re-applied.
diff --git a/lib/dialyzer/test/small_SUITE_data/results/behaviour_info b/lib/dialyzer/test/small_SUITE_data/results/behaviour_info
new file mode 100644
index 0000000000..2da4d26acb
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/behaviour_info
@@ -0,0 +1,2 @@
+
+with_bad_format_status.erl:12: The inferred type for the 1st argument of format_status/2 ('bad_arg') is not a supertype of 'normal' | 'terminate', which is expected type for this argument in the callback of the gen_server behaviour
diff --git a/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_bad_format_status.erl b/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_bad_format_status.erl
new file mode 100644
index 0000000000..24591e08fa
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_bad_format_status.erl
@@ -0,0 +1,12 @@
+-module(with_bad_format_status).
+
+-behaviour(gen_server).
+-export([handle_call/3,handle_cast/2,handle_info/2,
+ code_change/3, init/1, terminate/2, format_status/2]).
+handle_call(_, _, S) -> {noreply, S}.
+handle_cast(_, S) -> {noreply, S}.
+handle_info(_, S) -> {noreply, S}.
+code_change(_, _, _) -> {error, not_implemented}.
+init(_) -> {ok, state}.
+terminate(_, _) -> ok.
+format_status(bad_arg, _) -> ok. % optional callback
diff --git a/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_format_status.erl b/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_format_status.erl
new file mode 100644
index 0000000000..a56ff63d1d
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_format_status.erl
@@ -0,0 +1,13 @@
+-module(with_format_status).
+
+-behaviour(gen_server).
+-export([handle_call/3,handle_cast/2,handle_info/2,
+ code_change/3, init/1, terminate/2, format_status/2]).
+-export([handle_call/3,handle_cast/2,handle_info/2]).
+handle_call(_, _, S) -> {noreply, S}.
+handle_cast(_, S) -> {noreply, S}.
+handle_info(_, S) -> {noreply, S}.
+code_change(_, _, _) -> {error, not_implemented}.
+init(_) -> {ok, state}.
+terminate(_, _) -> ok.
+format_status(normal, _) -> ok. % optional callback
diff --git a/lib/dialyzer/test/small_SUITE_data/src/predef2.erl b/lib/dialyzer/test/small_SUITE_data/src/predef2.erl
deleted file mode 100644
index b1d941a49a..0000000000
--- a/lib/dialyzer/test/small_SUITE_data/src/predef2.erl
+++ /dev/null
@@ -1,56 +0,0 @@
--module(predef2).
-
--export([array/1, dict/1, digraph/1, digraph2/1, gb_set/1, gb_tree/1,
- queue/1, set/1, tid/0, tid2/0]).
-
--export_type([array/0, digraph/0, gb_set/0]).
-
--spec array(array()) -> array:array().
-
-array(A) ->
- array:relax(A).
-
--spec dict(dict()) -> dict:dict().
-
-dict(D) ->
- dict:store(1, a, D).
-
--spec digraph(digraph()) -> [digraph:edge()].
-
-digraph(G) ->
- digraph:edges(G).
-
--spec digraph2(digraph:graph()) -> [digraph:edge()].
-
-digraph2(G) ->
- digraph:edges(G).
-
--spec gb_set(gb_set()) -> gb_sets:set().
-
-gb_set(S) ->
- gb_sets:balance(S).
-
--spec gb_tree(gb_tree()) -> gb_trees:tree().
-
-gb_tree(S) ->
- gb_trees:balance(S).
-
--spec queue(queue()) -> queue:queue().
-
-queue(Q) ->
- queue:reverse(Q).
-
--spec set(set()) -> sets:set().
-
-set(S) ->
- sets:union([S]).
-
--spec tid() -> tid().
-
-tid() ->
- ets:new(tid, []).
-
--spec tid2() -> ets:tid().
-
-tid2() ->
- ets:new(tid, []).
diff --git a/lib/edoc/src/edoc_data.erl b/lib/edoc/src/edoc_data.erl
index f88ba05f4b..eceb5cb1bd 100644
--- a/lib/edoc/src/edoc_data.erl
+++ b/lib/edoc/src/edoc_data.erl
@@ -173,21 +173,34 @@ callbacks(Es, Module, Env, Opts) ->
lists:keymember(callback, 1, Module#module.attributes)
of
true ->
- try (Module#module.name):behaviour_info(callbacks) of
- Fs ->
- Fs1 = [{F,A} || {F,A} <- Fs, is_atom(F), is_integer(A)],
- if Fs1 =:= [] ->
- [];
- true ->
- [{callbacks,
- [callback(F, Env, Opts) || F <- Fs1]}]
- end
- catch
- _:_ -> []
- end;
+ M = Module#module.name,
+ Fs = get_callback_functions(M, callbacks),
+ Os1 = get_callback_functions(M, optional_callbacks),
+ Fs1 = [FA || FA <- Fs, not lists:member(FA, Os1)],
+ Req = if Fs1 =:= [] ->
+ [];
+ true ->
+ [{callbacks,
+ [callback(FA, Env, Opts) || FA <- Fs1]}]
+ end,
+ Opt = if Os1 =:= [] ->
+ [];
+ true ->
+ [{optional_callbacks,
+ [callback(FA, Env, Opts) || FA <- Os1]}]
+ end,
+ Req ++ Opt;
false -> []
end.
+get_callback_functions(M, Callbacks) ->
+ try
+ [FA || {F, A} = FA <- M:behaviour_info(Callbacks),
+ is_atom(F), is_integer(A), A >= 0]
+ catch
+ _:_ -> []
+ end.
+
%% <!ELEMENT callback EMPTY>
%% <!ATTLIST callback
%% name CDATA #REQUIRED
diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl
index a102d432bc..36d067d9bc 100644
--- a/lib/edoc/src/edoc_layout.erl
+++ b/lib/edoc/src/edoc_layout.erl
@@ -701,6 +701,8 @@ deprecated(Es, S) ->
end.
behaviours(Es, Name) ->
+ CBs = get_content(callbacks, Es),
+ OCBs = get_content(optional_callbacks, Es),
(case get_elem(behaviour, Es) of
[] -> [];
Es1 ->
@@ -709,13 +711,24 @@ behaviours(Es, Name) ->
?NL]
end
++
- case get_content(callbacks, Es) of
- [] -> [];
- Es1 ->
+ if CBs =:= [], OCBs =:= [] ->
+ [];
+ true ->
+ Req = if CBs =:= [] ->
+ [];
+ true ->
+ [br, " Required callback functions: "]
+ ++ seq(fun callback/1, CBs, ["."])
+ end,
+ Opt = if OCBs =:= [] ->
+ [];
+ true ->
+ [br, " Optional callback functions: "]
+ ++ seq(fun callback/1, OCBs, ["."])
+ end,
[{p, ([{b, ["This module defines the ", {tt, [Name]},
- " behaviour."]},
- br, " Required callback functions: "]
- ++ seq(fun callback/1, Es1, ["."]))},
+ " behaviour."]}]
+ ++ Req ++ Opt)},
?NL]
end).
diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl
index 211a354c74..3bf81c6503 100644
--- a/lib/edoc/src/edoc_specs.erl
+++ b/lib/edoc/src/edoc_specs.erl
@@ -362,7 +362,7 @@ d2e({type,_,map,any}) ->
#t_map{ types = []};
d2e({type,_,map,Es}) ->
#t_map{ types = d2e(Es) };
-d2e({type,_,map_field_assoc,K,V}) ->
+d2e({type,_,map_field_assoc,[K,V]}) ->
#t_map_field{ k_type = d2e(K), v_type=d2e(V) };
d2e({type,_,map_field_exact,K,V}) ->
#t_map_field{ k_type = d2e(K), v_type=d2e(V) };
@@ -388,6 +388,9 @@ d2e({record_field,L,_Name}=F) ->
d2e({type,_,Name,Types0}) ->
Types = d2e(Types0),
typevar_anno(#t_type{name = #t_name{name = Name}, args = Types}, Types);
+d2e({user_type,_,Name,Types0}) ->
+ Types = d2e(Types0),
+ typevar_anno(#t_type{name = #t_name{name = Name}, args = Types}, Types);
d2e({var,_,'_'}) ->
#t_type{name = #t_name{name = ?TOP_TYPE}};
d2e({var,_,TypeName}) ->
diff --git a/lib/edoc/src/edoc_tags.erl b/lib/edoc/src/edoc_tags.erl
index 264a533a52..82a1b72d84 100644
--- a/lib/edoc/src/edoc_tags.erl
+++ b/lib/edoc/src/edoc_tags.erl
@@ -329,10 +329,7 @@ parse_typedef(Data, Line, _Env, Where) ->
NAs = length(As),
case edoc_types:is_predefined(T, NAs) of
true ->
- case
- edoc_types:is_new_predefined(T, NAs)
- orelse edoc_types:is_predefined_otp_type(T, NAs)
- of
+ case edoc_types:is_new_predefined(T, NAs) of
false ->
throw_error(Line, {"redefining built-in type '~w'.",
[T]});
@@ -499,7 +496,6 @@ check_used_type(#t_name{name = N, module = Mod}=Name, Args, P, LocalTypes) ->
Mod =/= []
orelse lists:member(TypeName, ets:lookup(DT, Name))
orelse edoc_types:is_predefined(N, NArgs)
- orelse edoc_types:is_predefined_otp_type(N, NArgs)
orelse lists:member(TypeName, LocalTypes)
of
true ->
diff --git a/lib/edoc/src/edoc_types.erl b/lib/edoc/src/edoc_types.erl
index 8a6c8eb33e..65fba61a72 100644
--- a/lib/edoc/src/edoc_types.erl
+++ b/lib/edoc/src/edoc_types.erl
@@ -25,7 +25,7 @@
-module(edoc_types).
--export([is_predefined/2, is_new_predefined/2, is_predefined_otp_type/2,
+-export([is_predefined/2, is_new_predefined/2,
to_ref/1, to_xml/2, to_label/1, arg_names/1, set_arg_names/2,
arg_descs/1, range_desc/1]).
@@ -34,67 +34,13 @@
-include("edoc_types.hrl").
-include_lib("xmerl/include/xmerl.hrl").
-
-is_predefined(any, 0) -> true;
-is_predefined(atom, 0) -> true;
-is_predefined(binary, 0) -> true;
-is_predefined(bool, 0) -> true; % kept for backwards compatibility
-is_predefined(char, 0) -> true;
is_predefined(cons, 2) -> true;
is_predefined(deep_string, 0) -> true;
-is_predefined(float, 0) -> true;
-is_predefined(function, 0) -> true;
-is_predefined(integer, 0) -> true;
-is_predefined(list, 0) -> true;
-is_predefined(list, 1) -> true;
-is_predefined(nil, 0) -> true;
-is_predefined(none, 0) -> true;
-is_predefined(no_return, 0) -> true;
-is_predefined(number, 0) -> true;
-is_predefined(pid, 0) -> true;
-is_predefined(port, 0) -> true;
-is_predefined(reference, 0) -> true;
-is_predefined(string, 0) -> true;
-is_predefined(term, 0) -> true;
-is_predefined(tuple, 0) -> true;
-is_predefined(F, A) -> is_new_predefined(F, A).
+is_predefined(F, A) -> erl_internal:is_type(F, A).
-%% Should eventually be coalesced with is_predefined/2.
-is_new_predefined(arity, 0) -> true;
-is_new_predefined(bitstring, 0) -> true;
-is_new_predefined(boolean, 0) -> true;
-is_new_predefined(byte, 0) -> true;
-is_new_predefined(iodata, 0) -> true;
-is_new_predefined(iolist, 0) -> true;
is_new_predefined(map, 0) -> true;
-is_new_predefined(maybe_improper_list, 0) -> true;
-is_new_predefined(maybe_improper_list, 2) -> true;
-is_new_predefined(mfa, 0) -> true;
-is_new_predefined(module, 0) -> true;
-is_new_predefined(neg_integer, 0) -> true;
-is_new_predefined(node, 0) -> true;
-is_new_predefined(non_neg_integer, 0) -> true;
-is_new_predefined(nonempty_improper_list, 2) -> true;
-is_new_predefined(nonempty_list, 0) -> true;
-is_new_predefined(nonempty_list, 1) -> true;
-is_new_predefined(nonempty_maybe_improper_list, 0) -> true;
-is_new_predefined(nonempty_maybe_improper_list, 2) -> true;
-is_new_predefined(nonempty_string, 0) -> true;
-is_new_predefined(pos_integer, 0) -> true;
-is_new_predefined(timeout, 0) -> true;
is_new_predefined(_, _) -> false.
-%% The following types will be removed later, but they are currently
-%% kind of built-in.
-is_predefined_otp_type(array, 0) -> true;
-is_predefined_otp_type(dict, 0) -> true;
-is_predefined_otp_type(digraph, 0) -> true;
-is_predefined_otp_type(gb_set, 0) -> true;
-is_predefined_otp_type(gb_tree, 0) -> true;
-is_predefined_otp_type(queue, 0) -> true;
-is_predefined_otp_type(set, 0) -> true;
-is_predefined_otp_type(_, _) -> false.
-
to_ref(#t_typedef{name = N}) ->
to_ref(N);
to_ref(#t_def{name = N}) ->
@@ -129,8 +75,7 @@ to_xml(#t_type{name = N, args = As}, Env) ->
Predef = case N of
#t_name{module = [], name = T} ->
NArgs = length(As),
- (is_predefined(T, NArgs)
- orelse is_predefined_otp_type(T, NArgs));
+ is_predefined(T, NArgs);
_ ->
false
end,
diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl
index 1075c47801..e2eee2b3c0 100644
--- a/lib/erl_docgen/src/docgen_otp_specs.erl
+++ b/lib/erl_docgen/src/docgen_otp_specs.erl
@@ -616,7 +616,7 @@ ot_map(Es) ->
{type,0,map,[ot_map_field(E) || E <- get_elem(map_field,Es)]}.
ot_map_field(#xmlElement{content=[K,V]}) ->
- {type,0,map_field_assoc, ot_utype_elem(K), ot_utype_elem(V)}.
+ {type,0,map_field_assoc,[ot_utype_elem(K),ot_utype_elem(V)]}.
ot_fun(Es) ->
Range = ot_utype(get_elem(type, Es)),
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 4b2bec5fa8..5124e7238a 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -40,7 +40,6 @@
any_none_or_unit/1,
lookup_record/3,
max/2,
- module_builtin_opaques/1,
min/2,
number_max/1, number_max/2,
number_min/1, number_min/2,
@@ -188,7 +187,6 @@
t_subtract_list/2,
t_sup/1,
t_sup/2,
- t_tid/0,
t_timeout/0,
t_to_string/1,
t_to_string/2,
@@ -466,16 +464,6 @@ has_opaque_subtype(T) ->
t_opaque_structure(?opaque(Elements)) ->
t_sup([Struct || #opaque{struct = Struct} <- ordsets:to_list(Elements)]).
--spec t_opaque_modules(erl_type()) -> [module()].
-
-t_opaque_modules(?opaque(Elements)) ->
- case ordsets:size(Elements) of
- 1 ->
- [#opaque{mod = Mod}] = set_to_list(Elements),
- [Mod];
- _ -> throw({error, "Unexpected multiple opaque types"})
- end.
-
-spec t_contains_opaque(erl_type()) -> boolean().
t_contains_opaque(Type) ->
@@ -801,11 +789,6 @@ t_struct_from_opaque(Type, _Opaques) -> Type.
list_struct_from_opaque(Types, Opaques) ->
[t_struct_from_opaque(Type, Opaques) || Type <- Types].
--spec module_builtin_opaques(module()) -> [erl_type()].
-
-module_builtin_opaques(Module) ->
- [O || O <- all_opaque_builtins(), lists:member(Module, t_opaque_modules(O))].
-
%%-----------------------------------------------------------------------------
%% Remote types: these types are used for preprocessing;
%% they should never reach the analysis stage.
@@ -1987,82 +1970,6 @@ t_parameterized_module() ->
t_timeout() ->
t_sup(t_non_neg_integer(), t_atom('infinity')).
-%%-----------------------------------------------------------------------------
-%% Some built-in opaque types
-%%
-
--spec t_array() -> erl_type().
-
-t_array() ->
- t_opaque(array, array, [t_any()],
- t_tuple([t_atom('array'),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_any(),
- t_any()])).
-
--spec t_dict() -> erl_type().
-
-t_dict() ->
- t_opaque(dict, dict, [t_any(), t_any()],
- t_tuple([t_atom('dict'),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_non_neg_integer()]),
- t_sup([t_atom('undefined'), t_tuple()]),
- t_sup([t_atom('undefined'), t_tuple()])])).
-
--spec t_digraph() -> erl_type().
-
-t_digraph() ->
- t_opaque(digraph, digraph, [],
- t_tuple([t_atom('digraph'),
- t_sup(t_atom(), t_tid()),
- t_sup(t_atom(), t_tid()),
- t_sup(t_atom(), t_tid()),
- t_boolean()])).
-
--spec t_gb_set() -> erl_type().
-
-t_gb_set() ->
- t_opaque(gb_sets, gb_set, [],
- t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(3))])).
-
--spec t_gb_tree() -> erl_type().
-
-t_gb_tree() ->
- t_opaque(gb_trees, gb_tree, [],
- t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(4))])).
-
--spec t_queue() -> erl_type().
-
-t_queue() ->
- t_opaque(queue, queue, [t_any()], t_tuple([t_list(), t_list()])).
-
--spec t_set() -> erl_type().
-
-t_set() ->
- t_opaque(sets, set, [t_any()],
- t_tuple([t_atom('set'), t_non_neg_integer(), t_non_neg_integer(),
- t_pos_integer(), t_non_neg_integer(), t_non_neg_integer(),
- t_non_neg_integer(),
- t_sup([t_atom('undefined'), t_tuple()]),
- t_sup([t_atom('undefined'), t_tuple()])])).
-
--spec t_tid() -> erl_type().
-
-t_tid() ->
- t_opaque(ets, tid, [], t_integer()).
-
--spec all_opaque_builtins() -> [erl_type(),...].
-
-all_opaque_builtins() ->
- [t_array(), t_dict(), t_digraph(), t_gb_set(),
- t_gb_tree(), t_queue(), t_set(), t_tid()].
-
%%------------------------------------
%% ?none is allowed in products. A product of size 1 is not a product.
@@ -3317,8 +3224,8 @@ is_opaque_type2(#opaque{mod = Mod1, name = Name1, args = Args1}, Opaques) ->
is_type_name(Mod, Name, Args1, Mod, Name, Args2) ->
length(Args1) =:= length(Args2);
-is_type_name(Mod1, Name1, Args1, Mod2, Name2, Args2) ->
- is_same_type_name2(Mod1, Name1, Args1, Mod2, Name2, Args2).
+is_type_name(_Mod1, _Name1, _Args1, _Mod2, _Name2, _Args2) ->
+ false.
%% Two functions since t_unify is not symmetric.
unify_tuple_set_and_tuple1(?tuple_set([{Arity, List}]),
@@ -4156,15 +4063,7 @@ opaque_name(Mod, Name, Extra) ->
flat_format("~s(~s)", [S, Extra]).
mod_name(Mod, Name) ->
- case is_obsolete_opaque_builtin(Mod, Name) of
- true -> flat_format("~w", [Name]);
- false -> flat_format("~w:~w", [Mod, Name])
- end.
-
-is_obsolete_opaque_builtin(digraph, digraph) -> true;
-is_obsolete_opaque_builtin(gb_sets, gb_set) -> true;
-is_obsolete_opaque_builtin(gb_trees, gb_tree) -> true;
-is_obsolete_opaque_builtin(_, _) -> false.
+ flat_format("~w:~w", [Mod, Name]).
%%=============================================================================
%%
@@ -4229,8 +4128,6 @@ t_from_form({type, _L, any, []}, _TypeNames, _RecDict, _VarDict) ->
{t_any(), []};
t_from_form({type, _L, arity, []}, _TypeNames, _RecDict, _VarDict) ->
{t_arity(), []};
-t_from_form({type, _L, array, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(array, t_array(), TypeNames, RecDict, VarDict);
t_from_form({type, _L, atom, []}, _TypeNames, _RecDict, _VarDict) ->
{t_atom(), []};
t_from_form({type, _L, binary, []}, _TypeNames, _RecDict, _VarDict) ->
@@ -4252,10 +4149,6 @@ t_from_form({type, _L, byte, []}, _TypeNames, _RecDict, _VarDict) ->
{t_byte(), []};
t_from_form({type, _L, char, []}, _TypeNames, _RecDict, _VarDict) ->
{t_char(), []};
-t_from_form({type, _L, dict, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(dict, t_dict(), TypeNames, RecDict, VarDict);
-t_from_form({type, _L, digraph, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(digraph, t_digraph(), TypeNames, RecDict, VarDict);
t_from_form({type, _L, float, []}, _TypeNames, _RecDict, _VarDict) ->
{t_float(), []};
t_from_form({type, _L, function, []}, _TypeNames, _RecDict, _VarDict) ->
@@ -4271,10 +4164,6 @@ t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]},
{L, R1} = list_from_form(Domain, TypeNames, RecDict, VarDict),
{T, R2} = t_from_form(Range, TypeNames, RecDict, VarDict),
{t_fun(L, T), R1 ++ R2};
-t_from_form({type, _L, gb_set, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(gb_set, t_gb_set(), TypeNames, RecDict, VarDict);
-t_from_form({type, _L, gb_tree, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(gb_tree, t_gb_tree(), TypeNames, RecDict, VarDict);
t_from_form({type, _L, identifier, []}, _TypeNames, _RecDict, _VarDict) ->
{t_identifier(), []};
t_from_form({type, _L, integer, []}, _TypeNames, _RecDict, _VarDict) ->
@@ -4347,8 +4236,6 @@ t_from_form({type, _L, maybe_improper_list, [Content, Termination]},
t_from_form({type, _L, product, Elements}, TypeNames, RecDict, VarDict) ->
{L, R} = list_from_form(Elements, TypeNames, RecDict, VarDict),
{t_product(L), R};
-t_from_form({type, _L, queue, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(queue, t_queue(), TypeNames, RecDict, VarDict);
t_from_form({type, _L, range, [From, To]} = Type,
_TypeNames, _RecDict, _VarDict) ->
case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of
@@ -4360,14 +4247,10 @@ t_from_form({type, _L, record, [Name|Fields]}, TypeNames, RecDict, VarDict) ->
record_from_form(Name, Fields, TypeNames, RecDict, VarDict);
t_from_form({type, _L, reference, []}, _TypeNames, _RecDict, _VarDict) ->
{t_reference(), []};
-t_from_form({type, _L, set, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(set, t_set(), TypeNames, RecDict, VarDict);
t_from_form({type, _L, string, []}, _TypeNames, _RecDict, _VarDict) ->
{t_string(), []};
t_from_form({type, _L, term, []}, _TypeNames, _RecDict, _VarDict) ->
{t_any(), []};
-t_from_form({type, _L, tid, []}, TypeNames, RecDict, VarDict) ->
- builtin_type(tid, t_tid(), TypeNames, RecDict, VarDict);
t_from_form({type, _L, timeout, []}, _TypeNames, _RecDict, _VarDict) ->
{t_timeout(), []};
t_from_form({type, _L, tuple, any}, _TypeNames, _RecDict, _VarDict) ->
@@ -4378,7 +4261,10 @@ t_from_form({type, _L, tuple, Args}, TypeNames, RecDict, VarDict) ->
t_from_form({type, _L, union, Args}, TypeNames, RecDict, VarDict) ->
{L, R} = list_from_form(Args, TypeNames, RecDict, VarDict),
{t_sup(L), R};
+t_from_form({user_type, _L, Name, Args}, TypeNames, RecDict, VarDict) ->
+ type_from_form(Name, Args, TypeNames, RecDict, VarDict);
t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) ->
+ %% Compatibility: modules compiled before Erlang/OTP 18.0.
type_from_form(Name, Args, TypeNames, RecDict, VarDict);
t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames,
_RecDict, _VarDict) ->
@@ -4622,9 +4508,12 @@ t_form_to_string({type, _L, Name, []} = T) ->
try t_to_string(t_from_form(T))
catch throw:{error, _} -> atom_to_string(Name) ++ "()"
end;
-t_form_to_string({type, _L, Name, List}) ->
+t_form_to_string({user_type, _L, Name, List}) ->
flat_format("~w(~s)",
- [Name, string:join(t_form_to_string_list(List), ",")]).
+ [Name, string:join(t_form_to_string_list(List), ",")]);
+t_form_to_string({type, L, Name, List}) ->
+ %% Compatibility: modules compiled before Erlang/OTP 18.0.
+ t_form_to_string({user_type, L, Name, List}).
t_form_to_string_list(List) ->
t_form_to_string_list(List, []).
@@ -4737,27 +4626,14 @@ do_opaque(Type, _Opaques, Pred) ->
is_same_type_name(ModNameArgs, ModNameArgs) -> true;
is_same_type_name({Mod, Name, Args1}, {Mod, Name, Args2}) ->
all_any(Args1) orelse all_any(Args2);
-is_same_type_name({Mod1, Name1, Args1}, {Mod2, Name2, Args2}) ->
- is_same_type_name2(Mod1, Name1, Args1, Mod2, Name2, Args2).
+is_same_type_name(_ModNameArgs1, _ModNameArgs2) ->
+ false.
all_any([]) -> true;
all_any([T|L]) ->
t_is_any(T) andalso all_any(L);
all_any(_) -> false.
-%% Compatibility. In Erlang/OTP 17 the pre-defined opaque types
-%% digraph() and so on can be used, but there are also new types such
-%% as digraph:graph() with the exact same meaning. In Erlang/OTP R18.0
-%% all but the last clause can be removed.
-
-is_same_type_name2(digraph, digraph, [], digraph, graph, []) -> true;
-is_same_type_name2(digraph, graph, [], digraph, digraph, []) -> true;
-is_same_type_name2(gb_sets, gb_set, [], gb_sets, set, [_]) -> true;
-is_same_type_name2(gb_sets, set, [_], gb_sets, gb_set, []) -> true;
-is_same_type_name2(gb_trees, gb_tree, [], gb_trees, tree, [_, _]) -> true;
-is_same_type_name2(gb_trees, tree, [_, _], gb_trees, gb_tree, []) -> true;
-is_same_type_name2(_, _, _, _, _, _) -> false.
-
map_keys(?map(Pairs)) ->
[K || {K, _} <- Pairs].
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index 0bbd40d656..0a42e7210c 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -1850,6 +1850,7 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) ->
Session2 = erlang:setelement(Pos, Session, Value),
insert_session(Session2, ProfileName);
T:E ->
+ Stacktrace = erlang:get_stacktrace(),
error_logger:error_msg("Failed updating session: "
"~n ProfileName: ~p"
"~n SessionId: ~p"
@@ -1873,7 +1874,7 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) ->
{value, Value},
{etype, T},
{error, E},
- {stacktrace, erlang:get_stacktrace()}]})
+ {stacktrace, Stacktrace}]})
end.
diff --git a/lib/kernel/doc/src/pg2.xml b/lib/kernel/doc/src/pg2.xml
index 5eb63c1ef6..35cf85470a 100644
--- a/lib/kernel/doc/src/pg2.xml
+++ b/lib/kernel/doc/src/pg2.xml
@@ -34,11 +34,8 @@
<module>pg2</module>
<modulesummary>Distributed Named Process Groups</modulesummary>
<description>
- <p>This module implements process groups. The groups in this
- module differ from the groups in the module <c>pg</c> in several
- ways. In <c>pg</c>, each message is sent to all members in the
- group. In this module, each message may be sent to one, some, or
- all members.
+ <p>This module implements process groups. Each message may be sent
+ to one, some, or all members of the group.
</p>
<p>A group of processes can be accessed by a common name. For
example, if there is a group named <c>foobar</c>, there can be a
@@ -160,8 +157,7 @@
<section>
<title>See Also</title>
- <p><seealso marker="kernel_app">kernel(6)</seealso>,
- <seealso marker="stdlib:pg">pg(3)</seealso></p>
+ <p><seealso marker="kernel_app">kernel(6)</seealso></p>
</section>
</erlref>
diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl
index b36dbf33dd..046885f885 100644
--- a/lib/kernel/src/group.erl
+++ b/lib/kernel/src/group.erl
@@ -111,8 +111,13 @@ start_shell1(Fun) ->
server_loop(Drv, Shell, Buf0) ->
receive
{io_request,From,ReplyAs,Req} when is_pid(From) ->
- Buf = io_request(Req, From, ReplyAs, Drv, Buf0),
- server_loop(Drv, Shell, Buf);
+ %% This io_request may cause a transition to a couple of
+ %% selective receive loops elsewhere in this module.
+ Buf = io_request(Req, From, ReplyAs, Drv, Buf0),
+ server_loop(Drv, Shell, Buf);
+ {reply,{{From,ReplyAs},Reply}} ->
+ io_reply(From, ReplyAs, Reply),
+ server_loop(Drv, Shell, Buf0);
{driver_id,ReplyTo} ->
ReplyTo ! {self(),driver_id,Drv},
server_loop(Drv, Shell, Buf0);
@@ -172,10 +177,13 @@ set_unicode_state(Drv,Bool) ->
io_request(Req, From, ReplyAs, Drv, Buf0) ->
- case io_request(Req, Drv, Buf0) of
+ case io_request(Req, Drv, {From,ReplyAs}, Buf0) of
{ok,Reply,Buf} ->
io_reply(From, ReplyAs, Reply),
Buf;
+ {noreply,Buf} ->
+ %% We expect a {reply,_} message from the Drv when request is done
+ Buf;
{error,Reply,Buf} ->
io_reply(From, ReplyAs, Reply),
Buf;
@@ -196,78 +204,85 @@ io_request(Req, From, ReplyAs, Drv, Buf0) ->
%% io_request({put_chars,unicode,Binary}, Drv, Buf) when is_binary(Binary) ->
%% send_drv(Drv, {put_chars,Binary}),
%% {ok,ok,Buf};
-io_request({put_chars,unicode,Chars}, Drv, Buf) ->
+%%
+%% These put requests have to be synchronous to the driver as otherwise
+%% there is no guarantee that the data has actually been printed.
+io_request({put_chars,unicode,Chars}, Drv, From, Buf) ->
case catch unicode:characters_to_binary(Chars,utf8) of
Binary when is_binary(Binary) ->
- send_drv(Drv, {put_chars, unicode, Binary}),
- {ok,ok,Buf};
+ send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}),
+ {noreply,Buf};
_ ->
{error,{error,{put_chars, unicode,Chars}},Buf}
end;
-io_request({put_chars,unicode,M,F,As}, Drv, Buf) ->
+io_request({put_chars,unicode,M,F,As}, Drv, From, Buf) ->
case catch apply(M, F, As) of
Binary when is_binary(Binary) ->
- send_drv(Drv, {put_chars, unicode,Binary}),
- {ok,ok,Buf};
+ send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}),
+ {noreply,Buf};
Chars ->
case catch unicode:characters_to_binary(Chars,utf8) of
B when is_binary(B) ->
- send_drv(Drv, {put_chars, unicode,B}),
- {ok,ok,Buf};
+ send_drv(Drv, {put_chars_sync, unicode, B, {From,ok}}),
+ {noreply,Buf};
_ ->
{error,{error,F},Buf}
end
end;
-io_request({put_chars,latin1,Binary}, Drv, Buf) when is_binary(Binary) ->
- send_drv(Drv, {put_chars, unicode,unicode:characters_to_binary(Binary,latin1)}),
- {ok,ok,Buf};
-io_request({put_chars,latin1,Chars}, Drv, Buf) ->
+io_request({put_chars,latin1,Binary}, Drv, From, Buf) when is_binary(Binary) ->
+ send_drv(Drv, {put_chars_sync, unicode,
+ unicode:characters_to_binary(Binary,latin1),
+ {From,ok}}),
+ {noreply,Buf};
+io_request({put_chars,latin1,Chars}, Drv, From, Buf) ->
case catch unicode:characters_to_binary(Chars,latin1) of
Binary when is_binary(Binary) ->
- send_drv(Drv, {put_chars, unicode,Binary}),
- {ok,ok,Buf};
+ send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}),
+ {noreply,Buf};
_ ->
{error,{error,{put_chars,latin1,Chars}},Buf}
end;
-io_request({put_chars,latin1,M,F,As}, Drv, Buf) ->
+io_request({put_chars,latin1,M,F,As}, Drv, From, Buf) ->
case catch apply(M, F, As) of
Binary when is_binary(Binary) ->
- send_drv(Drv, {put_chars, unicode,unicode:characters_to_binary(Binary,latin1)}),
- {ok,ok,Buf};
+ send_drv(Drv, {put_chars_sync, unicode,
+ unicode:characters_to_binary(Binary,latin1),
+ {From,ok}}),
+ {noreply,Buf};
Chars ->
case catch unicode:characters_to_binary(Chars,latin1) of
B when is_binary(B) ->
- send_drv(Drv, {put_chars, unicode,B}),
- {ok,ok,Buf};
+ send_drv(Drv, {put_chars_sync, unicode, B, {From,ok}}),
+ {noreply,Buf};
_ ->
{error,{error,F},Buf}
end
end;
-io_request({get_chars,Encoding,Prompt,N}, Drv, Buf) ->
+io_request({get_chars,Encoding,Prompt,N}, Drv, _From, Buf) ->
get_chars(Prompt, io_lib, collect_chars, N, Drv, Buf, Encoding);
-io_request({get_line,Encoding,Prompt}, Drv, Buf) ->
+io_request({get_line,Encoding,Prompt}, Drv, _From, Buf) ->
get_chars(Prompt, io_lib, collect_line, [], Drv, Buf, Encoding);
-io_request({get_until,Encoding, Prompt,M,F,As}, Drv, Buf) ->
+io_request({get_until,Encoding, Prompt,M,F,As}, Drv, _From, Buf) ->
get_chars(Prompt, io_lib, get_until, {M,F,As}, Drv, Buf, Encoding);
-io_request({get_password,_Encoding},Drv,Buf) ->
+io_request({get_password,_Encoding},Drv,_From,Buf) ->
get_password_chars(Drv, Buf);
-io_request({setopts,Opts}, Drv, Buf) when is_list(Opts) ->
+io_request({setopts,Opts}, Drv, _From, Buf) when is_list(Opts) ->
setopts(Opts, Drv, Buf);
-io_request(getopts, Drv, Buf) ->
+io_request(getopts, Drv, _From, Buf) ->
getopts(Drv, Buf);
-io_request({requests,Reqs}, Drv, Buf) ->
- io_requests(Reqs, {ok,ok,Buf}, Drv);
+io_request({requests,Reqs}, Drv, From, Buf) ->
+ io_requests(Reqs, {ok,ok,Buf}, From, Drv);
%% New in R12
-io_request({get_geometry,columns},Drv,Buf) ->
+io_request({get_geometry,columns},Drv,_From,Buf) ->
case get_tty_geometry(Drv) of
{W,_H} ->
{ok,W,Buf};
_ ->
{error,{error,enotsup},Buf}
end;
-io_request({get_geometry,rows},Drv,Buf) ->
+io_request({get_geometry,rows},Drv,_From,Buf) ->
case get_tty_geometry(Drv) of
{_W,H} ->
{ok,H,Buf};
@@ -276,38 +291,49 @@ io_request({get_geometry,rows},Drv,Buf) ->
end;
%% BC with pre-R13
-io_request({put_chars,Chars}, Drv, Buf) ->
- io_request({put_chars,latin1,Chars}, Drv, Buf);
-io_request({put_chars,M,F,As}, Drv, Buf) ->
- io_request({put_chars,latin1,M,F,As}, Drv, Buf);
-io_request({get_chars,Prompt,N}, Drv, Buf) ->
- io_request({get_chars,latin1,Prompt,N}, Drv, Buf);
-io_request({get_line,Prompt}, Drv, Buf) ->
- io_request({get_line,latin1,Prompt}, Drv, Buf);
-io_request({get_until, Prompt,M,F,As}, Drv, Buf) ->
- io_request({get_until,latin1, Prompt,M,F,As}, Drv, Buf);
-io_request(get_password,Drv,Buf) ->
- io_request({get_password,latin1},Drv,Buf);
-
-
-
-io_request(_, _Drv, Buf) ->
+io_request({put_chars,Chars}, Drv, From, Buf) ->
+ io_request({put_chars,latin1,Chars}, Drv, From, Buf);
+io_request({put_chars,M,F,As}, Drv, From, Buf) ->
+ io_request({put_chars,latin1,M,F,As}, Drv, From, Buf);
+io_request({get_chars,Prompt,N}, Drv, From, Buf) ->
+ io_request({get_chars,latin1,Prompt,N}, Drv, From, Buf);
+io_request({get_line,Prompt}, Drv, From, Buf) ->
+ io_request({get_line,latin1,Prompt}, Drv, From, Buf);
+io_request({get_until, Prompt,M,F,As}, Drv, From, Buf) ->
+ io_request({get_until,latin1, Prompt,M,F,As}, Drv, From, Buf);
+io_request(get_password,Drv,From,Buf) ->
+ io_request({get_password,latin1},Drv,From,Buf);
+
+
+
+io_request(_, _Drv, _From, Buf) ->
{error,{error,request},Buf}.
-%% Status = io_requests(RequestList, PrevStat, Drv)
-%% Process a list of output requests as long as the previous status is 'ok'.
-
-io_requests([R|Rs], {ok,ok,Buf}, Drv) ->
- io_requests(Rs, io_request(R, Drv, Buf), Drv);
-io_requests([_|_], Error, _Drv) ->
+%% Status = io_requests(RequestList, PrevStat, From, Drv)
+%% Process a list of output requests as long as
+%% the previous status is 'ok' or noreply.
+%%
+%% We use undefined as the From for all but the last request
+%% in order to discards acknowledgements from those requests.
+%%
+io_requests([R|Rs], {noreply,Buf}, From, Drv) ->
+ ReqFrom = if Rs =:= [] -> From; true -> undefined end,
+ io_requests(Rs, io_request(R, Drv, ReqFrom, Buf), From, Drv);
+io_requests([R|Rs], {ok,ok,Buf}, From, Drv) ->
+ ReqFrom = if Rs =:= [] -> From; true -> undefined end,
+ io_requests(Rs, io_request(R, Drv, ReqFrom, Buf), From, Drv);
+io_requests([_|_], Error, _From, _Drv) ->
Error;
-io_requests([], Stat, _) ->
+io_requests([], Stat, _From, _) ->
Stat.
%% io_reply(From, ReplyAs, Reply)
%% The function for sending i/o command acknowledgement.
%% The ACK contains the return value.
+io_reply(undefined, _ReplyAs, _Reply) ->
+ %% Ignore these replies as they are generated from io_requests/4.
+ ok;
io_reply(From, ReplyAs, Reply) ->
From ! {io_reply,ReplyAs,Reply},
ok.
@@ -619,6 +645,10 @@ more_data(What, Cont0, Drv, Ls, Encoding) ->
io_request(Req, From, ReplyAs, Drv, []), %WRONG!!!
send_drv_reqs(Drv, edlin:redraw_line(Cont)),
get_line1({more_chars,Cont,[]}, Drv, Ls, Encoding);
+ {reply,{{From,ReplyAs},Reply}} ->
+ %% We take care of replies from puts here as well
+ io_reply(From, ReplyAs, Reply),
+ more_data(What, Cont0, Drv, Ls, Encoding);
{'EXIT',Drv,interrupt} ->
interrupted;
{'EXIT',Drv,_} ->
@@ -641,6 +671,10 @@ get_line_echo_off1({Chars,[]}, Drv) ->
{io_request,From,ReplyAs,Req} when is_pid(From) ->
io_request(Req, From, ReplyAs, Drv, []),
get_line_echo_off1({Chars,[]}, Drv);
+ {reply,{{From,ReplyAs},Reply}} when From =/= undefined ->
+ %% We take care of replies from puts here as well
+ io_reply(From, ReplyAs, Reply),
+ get_line_echo_off1({Chars,[]},Drv);
{'EXIT',Drv,interrupt} ->
interrupted;
{'EXIT',Drv,_} ->
@@ -790,6 +824,10 @@ get_password1({Chars,[]}, Drv) ->
%% set to []. But do we expect anything but plain output?
get_password1({Chars, []}, Drv);
+ {reply,{{From,ReplyAs},Reply}} ->
+ %% We take care of replies from puts here as well
+ io_reply(From, ReplyAs, Reply),
+ get_password1({Chars, []},Drv);
{'EXIT',Drv,interrupt} ->
interrupted;
{'EXIT',Drv,_} ->
diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src
index f8f4cc1ec2..1bae762bed 100644
--- a/lib/kernel/src/kernel.appup.src
+++ b/lib/kernel/src/kernel.appup.src
@@ -17,9 +17,7 @@
%% %CopyrightEnd%
{"%VSN%",
%% Up from - max one major revision back
- [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17
- {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16
+ [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17
%% Down to - max one major revision back
- [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17
- {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16
+ [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17
}.
diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl
index a91c23539d..e6ce85c379 100644
--- a/lib/kernel/src/user_drv.erl
+++ b/lib/kernel/src/user_drv.erl
@@ -29,6 +29,7 @@
-define(OP_INSC,2).
-define(OP_DELC,3).
-define(OP_BEEP,4).
+-define(OP_PUTC_SYNC,5).
% Control op
-define(CTRL_OP_GET_WINSIZE,100).
-define(CTRL_OP_GET_UNICODE_STATE,101).
@@ -133,7 +134,7 @@ server1(Iport, Oport, Shell) ->
[erlang:system_info(system_version)]))},
Iport, Oport),
%% Enter the server loop.
- server_loop(Iport, Oport, Curr, User, Gr).
+ server_loop(Iport, Oport, Curr, User, Gr, queue:new()).
rem_sh_opts(Node) ->
[{expand_fun,fun(B)-> rpc:call(Node,edlin_expand,expand,[B]) end}].
@@ -158,42 +159,41 @@ start_user() ->
User
end.
-server_loop(Iport, Oport, User, Gr) ->
+server_loop(Iport, Oport, User, Gr, IOQueue) ->
Curr = gr_cur_pid(Gr),
put(current_group, Curr),
- server_loop(Iport, Oport, Curr, User, Gr).
+ server_loop(Iport, Oport, Curr, User, Gr, IOQueue).
-server_loop(Iport, Oport, Curr, User, Gr) ->
+server_loop(Iport, Oport, Curr, User, Gr, IOQueue) ->
receive
{Iport,{data,Bs}} ->
BsBin = list_to_binary(Bs),
Unicode = unicode:characters_to_list(BsBin,utf8),
- port_bytes(Unicode, Iport, Oport, Curr, User, Gr);
+ port_bytes(Unicode, Iport, Oport, Curr, User, Gr, IOQueue);
{Iport,eof} ->
Curr ! {self(),eof},
- server_loop(Iport, Oport, Curr, User, Gr);
- {User,Req} -> % never block from user!
- io_request(Req, Iport, Oport),
- server_loop(Iport, Oport, Curr, User, Gr);
- {Curr,tty_geometry} ->
- Curr ! {self(),tty_geometry,get_tty_geometry(Iport)},
- server_loop(Iport, Oport, Curr, User, Gr);
- {Curr,get_unicode_state} ->
- Curr ! {self(),get_unicode_state,get_unicode_state(Iport)},
- server_loop(Iport, Oport, Curr, User, Gr);
- {Curr,set_unicode_state, Bool} ->
- Curr ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)},
- server_loop(Iport, Oport, Curr, User, Gr);
- {Curr,Req} ->
- io_request(Req, Iport, Oport),
- server_loop(Iport, Oport, Curr, User, Gr);
+ server_loop(Iport, Oport, Curr, User, Gr, IOQueue);
+ Req when element(1,Req) =:= User orelse element(1,Req) =:= Curr,
+ tuple_size(Req) =:= 2 orelse tuple_size(Req) =:= 3 ->
+ %% We match {User|Curr,_}|{User|Curr,_,_}
+ NewQ = handle_req(Req, Iport, Oport, IOQueue),
+ server_loop(Iport, Oport, Curr, User, Gr, NewQ);
+ {Oport,ok} ->
+ %% We get this ok from the port, in io_request we store
+ %% info about where to send reply at head of queue
+ {{value,{Origin,Reply}},ReplyQ} = queue:out(IOQueue),
+ Origin ! {reply,Reply},
+ NewQ = handle_req(next, Iport, Oport, ReplyQ),
+ server_loop(Iport, Oport, Curr, User, Gr, NewQ);
{'EXIT',Iport,_R} ->
- server_loop(Iport, Oport, Curr, User, Gr);
+ server_loop(Iport, Oport, Curr, User, Gr, IOQueue);
{'EXIT',Oport,_R} ->
- server_loop(Iport, Oport, Curr, User, Gr);
+ server_loop(Iport, Oport, Curr, User, Gr, IOQueue);
+ {'EXIT',User,shutdown} -> % force data to port
+ server_loop(Iport, Oport, Curr, User, Gr, IOQueue);
{'EXIT',User,_R} -> % keep 'user' alive
NewU = start_user(),
- server_loop(Iport, Oport, Curr, NewU, gr_set_num(Gr, 1, NewU, {}));
+ server_loop(Iport, Oport, Curr, NewU, gr_set_num(Gr, 1, NewU, {}), IOQueue);
{'EXIT',Pid,R} -> % shell and group leader exit
case gr_cur_pid(Gr) of
Pid when R =/= die ,
@@ -213,18 +213,51 @@ server_loop(Iport, Oport, Curr, User, Gr) ->
{ok,Gr2} = gr_set_cur(gr_set_num(Gr1, Ix, Pid1,
{shell,start,Params}), Ix),
put(current_group, Pid1),
- server_loop(Iport, Oport, Pid1, User, Gr2);
+ server_loop(Iport, Oport, Pid1, User, Gr2, IOQueue);
_ -> % remote shell
io_requests([{put_chars,unicode,"(^G to start new job) ***\n"}],
Iport, Oport),
- server_loop(Iport, Oport, Curr, User, Gr1)
+ server_loop(Iport, Oport, Curr, User, Gr1, IOQueue)
end;
_ -> % not current, just remove it
- server_loop(Iport, Oport, Curr, User, gr_del_pid(Gr, Pid))
+ server_loop(Iport, Oport, Curr, User, gr_del_pid(Gr, Pid), IOQueue)
end;
_X ->
%% Ignore unknown messages.
- server_loop(Iport, Oport, Curr, User, Gr)
+ server_loop(Iport, Oport, Curr, User, Gr, IOQueue)
+ end.
+
+%% We always handle geometry and unicode requests
+handle_req({Curr,tty_geometry},Iport,_Oport,IOQueue) ->
+ Curr ! {self(),tty_geometry,get_tty_geometry(Iport)},
+ IOQueue;
+handle_req({Curr,get_unicode_state},Iport,_Oport,IOQueue) ->
+ Curr ! {self(),get_unicode_state,get_unicode_state(Iport)},
+ IOQueue;
+handle_req({Curr,set_unicode_state, Bool},Iport,_Oport,IOQueue) ->
+ Curr ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)},
+ IOQueue;
+handle_req(next,Iport,Oport,IOQueue) ->
+ case queue:out(IOQueue) of
+ {{value,Next},ExecQ} ->
+ NewQ = handle_req(Next,Iport,Oport,queue:new()),
+ queue:join(NewQ,ExecQ);
+ {empty,_} ->
+ IOQueue
+ end;
+handle_req(Msg,Iport,Oport,IOQueue) ->
+ case queue:peek(IOQueue) of
+ empty ->
+ {Origin,Req} = Msg,
+ case io_request(Req, Iport, Oport) of
+ ok -> IOQueue;
+ Reply ->
+ %% Push reply info to front of queue
+ queue:in_r({Origin,Reply},IOQueue)
+ end;
+ _Else ->
+ %% All requests are queued when we have outstanding sync put_chars
+ queue:in(Msg,IOQueue)
end.
%% port_bytes(Bytes, InPort, OutPort, CurrentProcess, UserProcess, Group)
@@ -232,34 +265,34 @@ server_loop(Iport, Oport, Curr, User, Gr) ->
%% either escape to switch_loop or restart the shell. Otherwise send
%% the bytes to Curr.
-port_bytes([$\^G|_Bs], Iport, Oport, _Curr, User, Gr) ->
- handle_escape(Iport, Oport, User, Gr);
+port_bytes([$\^G|_Bs], Iport, Oport, _Curr, User, Gr, IOQueue) ->
+ handle_escape(Iport, Oport, User, Gr, IOQueue);
-port_bytes([$\^C|_Bs], Iport, Oport, Curr, User, Gr) ->
- interrupt_shell(Iport, Oport, Curr, User, Gr);
+port_bytes([$\^C|_Bs], Iport, Oport, Curr, User, Gr, IOQueue) ->
+ interrupt_shell(Iport, Oport, Curr, User, Gr, IOQueue);
-port_bytes([B], Iport, Oport, Curr, User, Gr) ->
+port_bytes([B], Iport, Oport, Curr, User, Gr, IOQueue) ->
Curr ! {self(),{data,[B]}},
- server_loop(Iport, Oport, Curr, User, Gr);
-port_bytes(Bs, Iport, Oport, Curr, User, Gr) ->
+ server_loop(Iport, Oport, Curr, User, Gr, IOQueue);
+port_bytes(Bs, Iport, Oport, Curr, User, Gr, IOQueue) ->
case member($\^G, Bs) of
true ->
- handle_escape(Iport, Oport, User, Gr);
+ handle_escape(Iport, Oport, User, Gr, IOQueue);
false ->
Curr ! {self(),{data,Bs}},
- server_loop(Iport, Oport, Curr, User, Gr)
+ server_loop(Iport, Oport, Curr, User, Gr, IOQueue)
end.
-interrupt_shell(Iport, Oport, Curr, User, Gr) ->
+interrupt_shell(Iport, Oport, Curr, User, Gr, IOQueue) ->
case gr_get_info(Gr, Curr) of
undefined ->
ok; % unknown
_ ->
exit(Curr, interrupt)
end,
- server_loop(Iport, Oport, Curr, User, Gr).
+ server_loop(Iport, Oport, Curr, User, Gr, IOQueue).
-handle_escape(Iport, Oport, User, Gr) ->
+handle_escape(Iport, Oport, User, Gr, IOQueue) ->
case application:get_env(stdlib, shell_esc) of
{ok,abort} ->
Pid = gr_cur_pid(Gr),
@@ -278,11 +311,11 @@ handle_escape(Iport, Oport, User, Gr) ->
Pid1 = group:start(self(), {shell,start,[]}),
io_request({put_chars,unicode,"\n"}, Iport, Oport),
server_loop(Iport, Oport, User,
- gr_add_cur(Gr1, Pid1, {shell,start,[]}));
+ gr_add_cur(Gr1, Pid1, {shell,start,[]}), IOQueue);
_ -> % {ok,jcl} | undefined
io_request({put_chars,unicode,"\nUser switch command\n"}, Iport, Oport),
- server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr))
+ server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr), IOQueue)
end.
switch_loop(Iport, Oport, Gr) ->
@@ -492,9 +525,12 @@ set_unicode_state(Iport, Bool) ->
io_request(Request, Iport, Oport) ->
try io_command(Request) of
- Command ->
+ {command,_} = Command ->
Oport ! {self(),Command},
- ok
+ ok;
+ {Command,Reply} ->
+ Oport ! {self(),Command},
+ Reply
catch
{requests,Rs} ->
io_requests(Rs, Iport, Oport);
@@ -511,6 +547,13 @@ io_requests([], _Iport, _Oport) ->
put_int16(N, Tail) ->
[(N bsr 8)band 255,N band 255|Tail].
+%% When a put_chars_sync command is used, user_drv guarantees that
+%% the bytes have been put in the buffer of the port before an acknowledgement
+%% is sent back to the process sending the request. This command was added in
+%% OTP 18 to make sure that data sent from io:format is actually printed
+%% to the console before the vm stops when calling erlang:halt(integer()).
+io_command({put_chars_sync, unicode,Cs,Reply}) ->
+ {{command,[?OP_PUTC_SYNC|unicode:characters_to_binary(Cs,utf8)]},Reply};
io_command({put_chars, unicode,Cs}) ->
{command,[?OP_PUTC|unicode:characters_to_binary(Cs,utf8)]};
io_command({move_rel,N}) ->
diff --git a/lib/kernel/test/pdict_SUITE.erl b/lib/kernel/test/pdict_SUITE.erl
index 98cff0222e..4b60beb9dc 100644
--- a/lib/kernel/test/pdict_SUITE.erl
+++ b/lib/kernel/test/pdict_SUITE.erl
@@ -31,7 +31,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
- simple/1, complicated/1, heavy/1, info/1]).
+ simple/1, complicated/1, heavy/1, simple_all_keys/1, info/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
-export([other_process/2]).
@@ -46,7 +46,7 @@ end_per_testcase(_Case, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [simple, complicated, heavy, info].
+ [simple, complicated, heavy, simple_all_keys, info].
groups() ->
[].
@@ -70,6 +70,7 @@ simple(suite) ->
[];
simple(Config) when is_list(Config) ->
XX = get(),
+ ok = match_keys(XX),
erase(),
L = [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,
q,r,s,t,u,v,x,y,z,'A','B','C','D'],
@@ -105,6 +106,7 @@ simple(Config) when is_list(Config) ->
complicated(Config) when is_list(Config) ->
Previous = get(),
+ ok = match_keys(Previous),
Previous = erase(),
N = case ?t:is_debug() of
false -> 500000;
@@ -113,8 +115,10 @@ complicated(Config) when is_list(Config) ->
comp_1(N),
comp_2(N),
N = comp_3(lists:sort(get()), 1),
+ ok = match_keys(get()),
comp_4(get()),
[] = get(),
+ [] = get_keys(),
[put(Key, Value) || {Key,Value} <- Previous],
ok.
@@ -160,6 +164,26 @@ heavy(Config) when is_list(Config) ->
[put(Key, Value) || {Key,Value} <- XX],
ok.
+simple_all_keys(Config) when is_list(Config) ->
+ erase(),
+ ok = simple_all_keys_add_loop(1000),
+ [] = get_keys(),
+ [] = get(),
+ ok.
+
+simple_all_keys_add_loop(0) ->
+ simple_all_keys_del_loop(erlang:get_keys());
+simple_all_keys_add_loop(N) ->
+ put(gen_key(N),value),
+ ok = match_keys(get()),
+ simple_all_keys_add_loop(N-1).
+
+simple_all_keys_del_loop([]) -> ok;
+simple_all_keys_del_loop([K|Ks]) ->
+ value = erase(K),
+ ok = match_keys(get()),
+ simple_all_keys_del_loop(Ks).
+
info(doc) ->
["Tests process_info(Pid, dictionary)"];
info(suite) ->
@@ -339,3 +363,8 @@ m(A,B,Module,Line) ->
[A,B,Module,Line]),
exit({no_match,{A,B},Module,Line})
end.
+
+match_keys(All) ->
+ Ks = lists:sort([K||{K,_}<-All]),
+ Ks = lists:sort(erlang:get_keys()),
+ ok.
diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl
index 03ab0c20e1..1266b1f9b9 100644
--- a/lib/observer/test/crashdump_viewer_SUITE.erl
+++ b/lib/observer/test/crashdump_viewer_SUITE.erl
@@ -101,7 +101,7 @@ end_per_group(_GroupName, Config) ->
init_per_suite(Config) when is_list(Config) ->
delete_saved(Config),
DataDir = ?config(data_dir,Config),
- Rels = [R || R <- [r15b,r16b], ?t:is_release_available(R)] ++ [current],
+ Rels = [R || R <- [r16b,'17'], ?t:is_release_available(R)] ++ [current],
io:format("Creating crash dumps for the following releases: ~p", [Rels]),
AllDumps = create_dumps(DataDir,Rels),
[{dumps,AllDumps}|Config].
@@ -563,12 +563,6 @@ dump_with_strange_module_name(DataDir,Rel,DumpName) ->
CD.
dump(Node,DataDir,Rel,DumpName) ->
- case Rel of
- _ when Rel<r15b, Rel=/=current ->
- rpc:call(Node,os,putenv,["ERL_CRASH_DUMP_SECONDS","600"]);
- _ ->
- ok
- end,
rpc:call(Node,erlang,halt,[DumpName]),
Crashdump0 = filename:join(filename:dirname(code:which(?t)),
"erl_crash_dump.n1"),
@@ -623,42 +617,21 @@ dos_dump(DataDir,Rel,Dump) ->
rel_opt(Rel) ->
case Rel of
- r9b -> [{erl,[{release,"r9b_patched"}]}];
- r9c -> [{erl,[{release,"r9c_patched"}]}];
- r10b -> [{erl,[{release,"r10b_patched"}]}];
- r11b -> [{erl,[{release,"r11b_patched"}]}];
- r12b -> [{erl,[{release,"r12b_patched"}]}];
- r13b -> [{erl,[{release,"r13b_patched"}]}];
- r14b -> [{erl,[{release,"r14b_latest"}]}]; %naming convention changed
- r15b -> [{erl,[{release,"r15b_latest"}]}];
r16b -> [{erl,[{release,"r16b_latest"}]}];
+ '17' -> [{erl,[{release,"17_latest"}]}];
current -> []
end.
dump_prefix(Rel) ->
case Rel of
- r9b -> "r9b_dump.";
- r9c -> "r9c_dump.";
- r10b -> "r10b_dump.";
- r11b -> "r11b_dump.";
- r12b -> "r12b_dump.";
- r13b -> "r13b_dump.";
- r14b -> "r14b_dump.";
- r15b -> "r15b_dump.";
r16b -> "r16b_dump.";
- current -> "r17b_dump."
+ '17' -> "r17_dump.";
+ current -> "r18_dump."
end.
compat_rel(Rel) ->
case Rel of
- r9b -> "+R9 ";
- r9c -> "+R9 ";
- r10b -> "+R10 ";
- r11b -> "+R11 ";
- r12b -> "+R12 ";
- r13b -> "+R13 ";
- r14b -> "+R14 ";
- r15b -> "+R15 ";
r16b -> "+R16 ";
+ '17' -> "+R17 ";
current -> ""
end.
diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl
index 347e80ed7c..b3b7afd1a9 100644
--- a/lib/reltool/test/reltool_server_SUITE.erl
+++ b/lib/reltool/test/reltool_server_SUITE.erl
@@ -1205,14 +1205,9 @@ create_slim(Config) ->
RootDir = code:root_dir(),
Erl = filename:join([RootDir, "bin", "erl"]),
- EscapedQuote =
- case os:type() of
- {win32,_} -> "\\\"";
- _ -> "\""
- end,
Args = ["-boot_var", "RELTOOL_EXT_LIB", TargetLibDir,
"-boot", filename:join(TargetRelVsnDir,RelName),
- "-sasl", "releases_dir", EscapedQuote++TargetRelDir++EscapedQuote],
+ "-sasl", "releases_dir", "\""++TargetRelDir++"\""],
{ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl, Args)),
?msym(RootDir, rpc:call(Node, code, root_dir, [])),
wait_for_app(Node,sasl,50),
diff --git a/lib/sasl/src/sasl.appup.src b/lib/sasl/src/sasl.appup.src
index e789853eea..af04d007ac 100644
--- a/lib/sasl/src/sasl.appup.src
+++ b/lib/sasl/src/sasl.appup.src
@@ -17,9 +17,7 @@
%% %CopyrightEnd%
{"%VSN%",
%% Up from - max one major revision back
- [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17
- {<<"2\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}], %% R16
+ [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17
%% Down to - max one major revision back
- [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17
- {<<"2\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16
+ [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17
}.
diff --git a/lib/sasl/test/test_lib.hrl b/lib/sasl/test/test_lib.hrl
index c8a4e92f24..b16c4ac34c 100644
--- a/lib/sasl/test/test_lib.hrl
+++ b/lib/sasl/test/test_lib.hrl
@@ -1,3 +1,3 @@
-define(ertsvsn,"4.4").
--define(kernelvsn,"2.16.4").
--define(stdlibvsn,"1.19.4").
+-define(kernelvsn,"3.0").
+-define(stdlibvsn,"2.0").
diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl
index 18841e3d2d..de6d246403 100644
--- a/lib/ssh/src/ssh_cli.erl
+++ b/lib/ssh/src/ssh_cli.erl
@@ -98,7 +98,7 @@ handle_ssh_msg({ssh_cm, ConnectionHandler,
Pty = Pty0#ssh_pty{width = Width, height = Height,
pixel_width = PixWidth,
pixel_height = PixHeight},
- {Chars, NewBuf} = io_request({window_change, Pty0}, Buf, Pty),
+ {Chars, NewBuf} = io_request({window_change, Pty0}, Buf, Pty, undefined),
write_chars(ConnectionHandler, ChannelId, Chars),
{ok, State#state{pty = Pty, buf = NewBuf}};
@@ -188,7 +188,7 @@ handle_msg({Group, tty_geometry}, #state{group = Group,
handle_msg({Group, Req}, #state{group = Group, buf = Buf, pty = Pty,
cm = ConnectionHandler,
channel = ChannelId} = State) ->
- {Chars, NewBuf} = io_request(Req, Buf, Pty),
+ {Chars, NewBuf} = io_request(Req, Buf, Pty, Group),
write_chars(ConnectionHandler, ChannelId, Chars),
{ok, State#state{buf = NewBuf}};
@@ -263,40 +263,49 @@ eval(Error) ->
%%% displaying device...
%%% We are *not* really unicode aware yet, we just filter away characters
%%% beyond the latin1 range. We however handle the unicode binaries...
-io_request({window_change, OldTty}, Buf, Tty) ->
+io_request({window_change, OldTty}, Buf, Tty, _Group) ->
window_change(Tty, OldTty, Buf);
-io_request({put_chars, Cs}, Buf, Tty) ->
+io_request({put_chars, Cs}, Buf, Tty, _Group) ->
put_chars(bin_to_list(Cs), Buf, Tty);
-io_request({put_chars, unicode, Cs}, Buf, Tty) ->
+io_request({put_chars, unicode, Cs}, Buf, Tty, _Group) ->
put_chars(unicode:characters_to_list(Cs,unicode), Buf, Tty);
-io_request({insert_chars, Cs}, Buf, Tty) ->
+io_request({insert_chars, Cs}, Buf, Tty, _Group) ->
insert_chars(bin_to_list(Cs), Buf, Tty);
-io_request({insert_chars, unicode, Cs}, Buf, Tty) ->
+io_request({insert_chars, unicode, Cs}, Buf, Tty, _Group) ->
insert_chars(unicode:characters_to_list(Cs,unicode), Buf, Tty);
-io_request({move_rel, N}, Buf, Tty) ->
+io_request({move_rel, N}, Buf, Tty, _Group) ->
move_rel(N, Buf, Tty);
-io_request({delete_chars,N}, Buf, Tty) ->
+io_request({delete_chars,N}, Buf, Tty, _Group) ->
delete_chars(N, Buf, Tty);
-io_request(beep, Buf, _Tty) ->
+io_request(beep, Buf, _Tty, _Group) ->
{[7], Buf};
%% New in R12
-io_request({get_geometry,columns},Buf,Tty) ->
+io_request({get_geometry,columns},Buf,Tty, _Group) ->
{ok, Tty#ssh_pty.width, Buf};
-io_request({get_geometry,rows},Buf,Tty) ->
+io_request({get_geometry,rows},Buf,Tty, _Group) ->
{ok, Tty#ssh_pty.height, Buf};
-io_request({requests,Rs}, Buf, Tty) ->
- io_requests(Rs, Buf, Tty, []);
-io_request(tty_geometry, Buf, Tty) ->
- io_requests([{move_rel, 0}, {put_chars, unicode, [10]}], Buf, Tty, []);
+io_request({requests,Rs}, Buf, Tty, Group) ->
+ io_requests(Rs, Buf, Tty, [], Group);
+io_request(tty_geometry, Buf, Tty, Group) ->
+ io_requests([{move_rel, 0}, {put_chars, unicode, [10]}],
+ Buf, Tty, [], Group);
%{[], Buf};
-io_request(_R, Buf, _Tty) ->
+
+%% New in 18
+io_request({put_chars_sync, Class, Cs, Reply}, Buf, Tty, Group) ->
+ %% We handle these asynchronous for now, if we need output guarantees
+ %% we have to handle these synchronously
+ Group ! {reply, Reply},
+ io_request({put_chars, Class, Cs}, Buf, Tty, Group);
+
+io_request(_R, Buf, _Tty, _Group) ->
{[], Buf}.
-io_requests([R|Rs], Buf, Tty, Acc) ->
- {Chars, NewBuf} = io_request(R, Buf, Tty),
- io_requests(Rs, NewBuf, Tty, [Acc|Chars]);
-io_requests([], Buf, _Tty, Acc) ->
+io_requests([R|Rs], Buf, Tty, Acc, Group) ->
+ {Chars, NewBuf} = io_request(R, Buf, Tty, Group),
+ io_requests(Rs, NewBuf, Tty, [Acc|Chars], Group);
+io_requests([], Buf, _Tty, Acc, _Group) ->
{Acc, Buf}.
%%% return commands for cursor navigation, assume everything is ansi
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index b53344e381..83e5ed82bb 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -136,7 +136,7 @@
</c></p>
<p><c>cipher() = rc4_128 | des_cbc | '3des_ede_cbc'
- | aes_128_cbc | aes_256_cbc </c></p>
+ | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm </c></p>
<p> <c>hash() = md5 | sha
</c></p>
diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml
index 43cb3934f7..c8024548b5 100644
--- a/lib/ssl/doc/src/ssl_app.xml
+++ b/lib/ssl/doc/src/ssl_app.xml
@@ -4,7 +4,7 @@
<appref>
<header>
<copyright>
- <year>1999</year><year>2013</year>
+ <year>1999</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -75,10 +75,10 @@
</p>
</item>
- <tag><c><![CDATA[session_cb_init_args = list() <optional>]]></c></tag>
+ <tag><c><![CDATA[session_cb_init_args = proplist:proplist() <optional>]]></c></tag>
<item>
<p>
- List of arguments to the init function in session cache
+ List of additional user defined arguments to the init function in session cache
callback module, defaults to [].
</p>
</item>
diff --git a/lib/ssl/doc/src/ssl_session_cache_api.xml b/lib/ssl/doc/src/ssl_session_cache_api.xml
index 82de1784ca..cb97bbfbb2 100644
--- a/lib/ssl/doc/src/ssl_session_cache_api.xml
+++ b/lib/ssl/doc/src/ssl_session_cache_api.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1999</year><year>2013</year>
+ <year>1999</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -79,17 +79,25 @@
</func>
<func>
- <name>init() -> opaque() </name>
+ <name>init(Args) -> opaque() </name>
<fsummary>Return cache reference</fsummary>
<type>
- <v></v>
+ <v>Args = proplists:proplist()</v>
+ <d>Will always include the property {role, client | server}. Currently this
+ is the only predefined property, there may also be user defined properties.
+ <seealso marker="ssl_app"> See also application environment variable
+ session_cb_init_args</seealso>
+ </d>
</type>
<desc>
<p>Performs possible initializations of the cache and returns
a reference to it that will be used as parameter to the other
- api functions. Will be called by the cache handling processes
- init function, hence putting the same requirements on it as
- a normal process init function.
+ API functions. Will be called by the cache handling processes
+ init function, hence putting the same requirements on it as a
+ normal process init function. Note that this function will be
+ called twice when starting the ssl application, once with the
+ role client and once with the role server, as the ssl application
+ must be prepared to take on both roles.
</p>
</desc>
</func>
diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl
index a7bbb6bc40..c0776e822b 100644
--- a/lib/ssl/src/dtls_record.erl
+++ b/lib/ssl/src/dtls_record.erl
@@ -120,6 +120,26 @@ get_dtls_records_aux(Data, Acc) ->
end.
encode_plain_text(Type, Version, Data,
+ #connection_states{current_write =
+ #connection_state{
+ epoch = Epoch,
+ sequence_number = Seq,
+ compression_state=CompS0,
+ security_parameters=
+ #security_parameters{
+ cipher_type = ?AEAD,
+ compression_algorithm=CompAlg}
+ }= WriteState0} = ConnectionStates) ->
+ {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0),
+ WriteState1 = WriteState0#connection_state{compression_state = CompS1},
+ AAD = calc_aad(Type, Version, Epoch, Seq),
+ {CipherFragment, WriteState} = ssl_record:cipher_aead(dtls_v1:corresponding_tls_version(Version),
+ Comp, WriteState1, AAD),
+ CipherText = encode_tls_cipher_text(Type, Version, Epoch, Seq, CipherFragment),
+ {CipherText, ConnectionStates#connection_states{current_write =
+ WriteState#connection_state{sequence_number = Seq +1}}};
+
+encode_plain_text(Type, Version, Data,
#connection_states{current_write=#connection_state{
epoch = Epoch,
sequence_number = Seq,
@@ -141,16 +161,44 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version,
sequence_number = Seq,
fragment = CipherFragment} = CipherText,
#connection_states{current_read =
- #connection_state{compression_state = CompressionS0,
- security_parameters = SecParams} = ReadState0}
- = ConnnectionStates0) ->
- CompressAlg = SecParams#security_parameters.compression_algorithm,
+ #connection_state{
+ compression_state = CompressionS0,
+ security_parameters=
+ #security_parameters{
+ cipher_type = ?AEAD,
+ compression_algorithm=CompAlg}
+ } = ReadState0}= ConnnectionStates0) ->
+ AAD = calc_aad(Type, Version, Epoch, Seq),
+ case ssl_record:decipher_aead(dtls_v1:corresponding_tls_version(Version),
+ CipherFragment, ReadState0, AAD) of
+ {PlainFragment, ReadState1} ->
+ {Plain, CompressionS1} = ssl_record:uncompress(CompAlg,
+ PlainFragment, CompressionS0),
+ ConnnectionStates = ConnnectionStates0#connection_states{
+ current_read = ReadState1#connection_state{
+ compression_state = CompressionS1}},
+ {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates};
+ #alert{} = Alert ->
+ Alert
+ end;
+
+decode_cipher_text(#ssl_tls{type = Type, version = Version,
+ epoch = Epoch,
+ sequence_number = Seq,
+ fragment = CipherFragment} = CipherText,
+ #connection_states{current_read =
+ #connection_state{
+ compression_state = CompressionS0,
+ security_parameters=
+ #security_parameters{
+ compression_algorithm=CompAlg}
+ } = ReadState0}= ConnnectionStates0) ->
{PlainFragment, Mac, ReadState1} = ssl_record:decipher(dtls_v1:corresponding_tls_version(Version),
CipherFragment, ReadState0),
MacHash = calc_mac_hash(ReadState1, Type, Version, Epoch, Seq, PlainFragment),
case ssl_record:is_correct_mac(Mac, MacHash) of
true ->
- {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg,
+ {Plain, CompressionS1} = ssl_record:uncompress(CompAlg,
PlainFragment, CompressionS0),
ConnnectionStates = ConnnectionStates0#connection_states{
current_read = ReadState1#connection_state{
@@ -368,3 +416,7 @@ calc_mac_hash(#connection_state{mac_secret = MacSecret,
mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) ->
dtls_v1:mac_hash(Version, MacAlg, MacSecret, SeqNo, Type,
Length, Fragment).
+
+calc_aad(Type, {MajVer, MinVer}, Epoch, SeqNo) ->
+ NewSeq = (Epoch bsl 48) + SeqNo,
+ <<NewSeq:64/integer, ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>.
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index b4bea25942..dcba69a65e 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -354,7 +354,7 @@ cipher_suites(openssl) ->
cipher_suites(all) ->
Version = tls_record:highest_protocol_version([]),
Supported = ssl_cipher:all_suites(Version)
- ++ ssl_cipher:anonymous_suites()
+ ++ ssl_cipher:anonymous_suites(Version)
++ ssl_cipher:psk_suites(Version)
++ ssl_cipher:srp_suites(),
ssl_cipher:filter_suites([suite_definition(S) || S <- Supported]).
@@ -953,7 +953,7 @@ binary_cipher_suites(Version, [{_,_,_}| _] = Ciphers0) ->
binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) ->
All = ssl_cipher:suites(Version)
- ++ ssl_cipher:anonymous_suites()
+ ++ ssl_cipher:anonymous_suites(Version)
++ ssl_cipher:psk_suites(Version)
++ ssl_cipher:srp_suites(),
case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index 72467ea2a0..e1d89c149e 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -33,9 +33,9 @@
-include_lib("public_key/include/public_key.hrl").
-export([security_parameters/2, security_parameters/3, suite_definition/1,
- decipher/5, cipher/5,
+ cipher_init/3, decipher/5, cipher/5, decipher_aead/6, cipher_aead/6,
suite/1, suites/1, all_suites/1,
- ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0,
+ ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0,
openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1,
hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]).
@@ -44,7 +44,7 @@
key_algo/0]).
-type cipher() :: null |rc4_128 | idea_cbc | des40_cbc | des_cbc | '3des_ede_cbc'
- | aes_128_cbc | aes_256_cbc.
+ | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305.
-type hash() :: null | sha | md5 | sha224 | sha256 | sha384 | sha512.
-type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon.
-type erl_cipher_suite() :: {key_algo(), cipher(), hash()}.
@@ -88,20 +88,32 @@ security_parameters(Version, CipherSuite, SecParams) ->
hash_size = hash_size(Hash)}.
%%--------------------------------------------------------------------
+-spec cipher_init(cipher_enum(), binary(), binary()) -> #cipher_state{}.
+%%
+%% Description: Initializes the #cipher_state according to BCA
+%%-------------------------------------------------------------------
+cipher_init(?RC4, IV, Key) ->
+ State = crypto:stream_init(rc4, Key),
+ #cipher_state{iv = IV, key = Key, state = State};
+cipher_init(?AES_GCM, IV, Key) ->
+ <<Nonce:64>> = ssl:random_bytes(8),
+ #cipher_state{iv = IV, key = Key, nonce = Nonce};
+cipher_init(_BCA, IV, Key) ->
+ #cipher_state{iv = IV, key = Key}.
+
+%%--------------------------------------------------------------------
-spec cipher(cipher_enum(), #cipher_state{}, binary(), iodata(), ssl_record:ssl_version()) ->
{binary(), #cipher_state{}}.
%%
%% Description: Encrypts the data and the MAC using chipher described
%% by cipher_enum() and updating the cipher state
+%% Used for "MAC then Cipher" suites where first an HMAC of the
+%% data is calculated and the data plus the HMAC is ecncrypted.
%%-------------------------------------------------------------------
cipher(?NULL, CipherState, <<>>, Fragment, _Version) ->
GenStreamCipherList = [Fragment, <<>>],
{GenStreamCipherList, CipherState};
-cipher(?RC4, CipherState, Mac, Fragment, _Version) ->
- State0 = case CipherState#cipher_state.state of
- undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key);
- S -> S
- end,
+cipher(?RC4, CipherState = #cipher_state{state = State0}, Mac, Fragment, _Version) ->
GenStreamCipherList = [Fragment, Mac],
{State1, T} = crypto:stream_encrypt(State0, GenStreamCipherList),
{T, CipherState#cipher_state{state = State1}};
@@ -113,13 +125,40 @@ cipher(?'3DES', CipherState, Mac, Fragment, Version) ->
block_cipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) ->
crypto:block_encrypt(des3_cbc, [K1, K2, K3], IV, T)
end, block_size(des_cbc), CipherState, Mac, Fragment, Version);
-cipher(?AES, CipherState, Mac, Fragment, Version) ->
+cipher(?AES_CBC, CipherState, Mac, Fragment, Version) ->
block_cipher(fun(Key, IV, T) when byte_size(Key) =:= 16 ->
crypto:block_encrypt(aes_cbc128, Key, IV, T);
(Key, IV, T) when byte_size(Key) =:= 32 ->
crypto:block_encrypt(aes_cbc256, Key, IV, T)
end, block_size(aes_128_cbc), CipherState, Mac, Fragment, Version).
+%%--------------------------------------------------------------------
+-spec cipher_aead(cipher_enum(), #cipher_state{}, integer(), binary(), iodata(), ssl_record:ssl_version()) ->
+ {binary(), #cipher_state{}}.
+%%
+%% Description: Encrypts the data and protects associated data (AAD) using chipher
+%% described by cipher_enum() and updating the cipher state
+%% Use for suites that use authenticated encryption with associated data (AEAD)
+%%-------------------------------------------------------------------
+cipher_aead(?AES_GCM, CipherState, SeqNo, AAD, Fragment, Version) ->
+ aead_cipher(aes_gcm, CipherState, SeqNo, AAD, Fragment, Version);
+cipher_aead(?CHACHA20_POLY1305, CipherState, SeqNo, AAD, Fragment, Version) ->
+ aead_cipher(chacha20_poly1305, CipherState, SeqNo, AAD, Fragment, Version).
+
+aead_cipher(chacha20_poly1305, #cipher_state{key=Key} = CipherState, SeqNo, AAD0, Fragment, _Version) ->
+ CipherLen = erlang:iolist_size(Fragment),
+ AAD = <<AAD0/binary, ?UINT16(CipherLen)>>,
+ Nonce = <<SeqNo:64/integer>>,
+ {Content, CipherTag} = crypto:block_encrypt(chacha20_poly1305, Key, Nonce, {AAD, Fragment}),
+ {<<Content/binary, CipherTag/binary>>, CipherState};
+aead_cipher(Type, #cipher_state{key=Key, iv = IV0, nonce = Nonce} = CipherState, _SeqNo, AAD0, Fragment, _Version) ->
+ CipherLen = erlang:iolist_size(Fragment),
+ AAD = <<AAD0/binary, ?UINT16(CipherLen)>>,
+ <<Salt:4/bytes, _/binary>> = IV0,
+ IV = <<Salt/binary, Nonce:64/integer>>,
+ {Content, CipherTag} = crypto:block_encrypt(Type, Key, IV, {AAD, Fragment}),
+ {<<Nonce:64/integer, Content/binary, CipherTag/binary>>, CipherState#cipher_state{nonce = Nonce + 1}}.
+
build_cipher_block(BlockSz, Mac, Fragment) ->
TotSz = byte_size(Mac) + erlang:iolist_size(Fragment) + 1,
{PaddingLength, Padding} = get_padding(TotSz, BlockSz),
@@ -148,14 +187,12 @@ block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0,
%%
%% Description: Decrypts the data and the MAC using cipher described
%% by cipher_enum() and updating the cipher state.
+%% Used for "MAC then Cipher" suites where first the data is decrypted
+%% and the an HMAC of the decrypted data is checked
%%-------------------------------------------------------------------
decipher(?NULL, _HashSz, CipherState, Fragment, _) ->
{Fragment, <<>>, CipherState};
-decipher(?RC4, HashSz, CipherState, Fragment, _) ->
- State0 = case CipherState#cipher_state.state of
- undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key);
- S -> S
- end,
+decipher(?RC4, HashSz, CipherState = #cipher_state{state = State0}, Fragment, _) ->
try crypto:stream_decrypt(State0, Fragment) of
{State, Text} ->
GSC = generic_stream_cipher_from_bin(Text, HashSz),
@@ -179,13 +216,26 @@ decipher(?'3DES', HashSz, CipherState, Fragment, Version) ->
block_decipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) ->
crypto:block_decrypt(des3_cbc, [K1, K2, K3], IV, T)
end, CipherState, HashSz, Fragment, Version);
-decipher(?AES, HashSz, CipherState, Fragment, Version) ->
+decipher(?AES_CBC, HashSz, CipherState, Fragment, Version) ->
block_decipher(fun(Key, IV, T) when byte_size(Key) =:= 16 ->
crypto:block_decrypt(aes_cbc128, Key, IV, T);
(Key, IV, T) when byte_size(Key) =:= 32 ->
crypto:block_decrypt(aes_cbc256, Key, IV, T)
end, CipherState, HashSz, Fragment, Version).
+%%--------------------------------------------------------------------
+-spec decipher_aead(cipher_enum(), #cipher_state{}, integer(), binary(), binary(), ssl_record:ssl_version()) ->
+ {binary(), binary(), #cipher_state{}} | #alert{}.
+%%
+%% Description: Decrypts the data and checks the associated data (AAD) MAC using
+%% cipher described by cipher_enum() and updating the cipher state.
+%% Use for suites that use authenticated encryption with associated data (AEAD)
+%%-------------------------------------------------------------------
+decipher_aead(?AES_GCM, CipherState, SeqNo, AAD, Fragment, Version) ->
+ aead_decipher(aes_gcm, CipherState, SeqNo, AAD, Fragment, Version);
+decipher_aead(?CHACHA20_POLY1305, CipherState, SeqNo, AAD, Fragment, Version) ->
+ aead_decipher(chacha20_poly1305, CipherState, SeqNo, AAD, Fragment, Version).
+
block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0,
HashSz, Fragment, Version) ->
try
@@ -215,6 +265,35 @@ block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0,
%% bad_record_mac alert to hide the specific type of the error."
?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
end.
+
+aead_ciphertext_to_state(chacha20_poly1305, SeqNo, _IV, AAD0, Fragment, _Version) ->
+ CipherLen = size(Fragment) - 16,
+ <<CipherText:CipherLen/bytes, CipherTag:16/bytes>> = Fragment,
+ AAD = <<AAD0/binary, ?UINT16(CipherLen)>>,
+ Nonce = <<SeqNo:64/integer>>,
+ {Nonce, AAD, CipherText, CipherTag};
+aead_ciphertext_to_state(_, _SeqNo, <<Salt:4/bytes, _/binary>>, AAD0, Fragment, _Version) ->
+ CipherLen = size(Fragment) - 24,
+ <<ExplicitNonce:8/bytes, CipherText:CipherLen/bytes, CipherTag:16/bytes>> = Fragment,
+ AAD = <<AAD0/binary, ?UINT16(CipherLen)>>,
+ Nonce = <<Salt/binary, ExplicitNonce/binary>>,
+ {Nonce, AAD, CipherText, CipherTag}.
+
+aead_decipher(Type, #cipher_state{key = Key, iv = IV} = CipherState,
+ SeqNo, AAD0, Fragment, Version) ->
+ try
+ {Nonce, AAD, CipherText, CipherTag} = aead_ciphertext_to_state(Type, SeqNo, IV, AAD0, Fragment, Version),
+ case crypto:block_decrypt(Type, Key, Nonce, {AAD, CipherText, CipherTag}) of
+ Content when is_binary(Content) ->
+ {Content, CipherState};
+ _ ->
+ ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
+ end
+ catch
+ _:_ ->
+ ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
+ end.
+
%%--------------------------------------------------------------------
-spec suites(ssl_record:ssl_version()) -> [cipher_suite()].
%%
@@ -227,16 +306,26 @@ suites({3, N}) ->
all_suites(Version) ->
suites(Version)
- ++ ssl_cipher:anonymous_suites()
+ ++ ssl_cipher:anonymous_suites(Version)
++ ssl_cipher:psk_suites(Version)
++ ssl_cipher:srp_suites().
%%--------------------------------------------------------------------
--spec anonymous_suites() -> [cipher_suite()].
+-spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()].
%%
%% Description: Returns a list of the anonymous cipher suites, only supported
%% if explicitly set by user. Intended only for testing.
%%--------------------------------------------------------------------
-anonymous_suites() ->
+
+anonymous_suites({3, N}) ->
+ anonymous_suites(N);
+
+anonymous_suites(N)
+ when N >= 3 ->
+ [?TLS_DH_anon_WITH_AES_128_GCM_SHA256,
+ ?TLS_DH_anon_WITH_AES_256_GCM_SHA384
+ ] ++ anonymous_suites(0);
+
+anonymous_suites(_) ->
[?TLS_DH_anon_WITH_RC4_128_MD5,
?TLS_DH_anon_WITH_DES_CBC_SHA,
?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA,
@@ -260,13 +349,20 @@ psk_suites({3, N}) ->
psk_suites(N)
when N >= 3 ->
- psk_suites(0) ++
- [?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384,
- ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384,
- ?TLS_PSK_WITH_AES_256_CBC_SHA384,
- ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256,
- ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256,
- ?TLS_PSK_WITH_AES_128_CBC_SHA256];
+ [
+ ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384,
+ ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384,
+ ?TLS_PSK_WITH_AES_256_GCM_SHA384,
+ ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384,
+ ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384,
+ ?TLS_PSK_WITH_AES_256_CBC_SHA384,
+ ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256,
+ ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256,
+ ?TLS_PSK_WITH_AES_128_GCM_SHA256,
+ ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256,
+ ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256,
+ ?TLS_PSK_WITH_AES_128_CBC_SHA256
+ ] ++ psk_suites(0);
psk_suites(_) ->
[?TLS_DHE_PSK_WITH_AES_256_CBC_SHA,
@@ -418,6 +514,19 @@ suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA) ->
%%% TLS 1.2 PSK Cipher Suites RFC 5487
+suite_definition(?TLS_PSK_WITH_AES_128_GCM_SHA256) ->
+ {psk, aes_128_gcm, null, sha256};
+suite_definition(?TLS_PSK_WITH_AES_256_GCM_SHA384) ->
+ {psk, aes_256_gcm, null, sha384};
+suite_definition(?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256) ->
+ {dhe_psk, aes_128_gcm, null, sha256};
+suite_definition(?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384) ->
+ {dhe_psk, aes_256_gcm, null, sha384};
+suite_definition(?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256) ->
+ {rsa_psk, aes_128_gcm, null, sha256};
+suite_definition(?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384) ->
+ {rsa_psk, aes_256_gcm, null, sha384};
+
suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA256) ->
{psk, aes_128_cbc, sha256, default_prf};
suite_definition(?TLS_PSK_WITH_AES_256_CBC_SHA384) ->
@@ -537,7 +646,59 @@ suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) ->
suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) ->
{ecdh_rsa, aes_128_cbc, sha256, sha256};
suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) ->
- {ecdh_rsa, aes_256_cbc, sha384, sha384}.
+ {ecdh_rsa, aes_256_cbc, sha384, sha384};
+
+%% RFC 5288 AES-GCM Cipher Suites
+suite_definition(?TLS_RSA_WITH_AES_128_GCM_SHA256) ->
+ {rsa, aes_128_gcm, null, sha256};
+suite_definition(?TLS_RSA_WITH_AES_256_GCM_SHA384) ->
+ {rsa, aes_256_gcm, null, sha384};
+suite_definition(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) ->
+ {dhe_rsa, aes_128_gcm, null, sha256};
+suite_definition(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) ->
+ {dhe_rsa, aes_256_gcm, null, sha384};
+suite_definition(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) ->
+ {dh_rsa, aes_128_gcm, null, sha256};
+suite_definition(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) ->
+ {dh_rsa, aes_256_gcm, null, sha384};
+suite_definition(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) ->
+ {dhe_dss, aes_128_gcm, null, sha256};
+suite_definition(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) ->
+ {dhe_dss, aes_256_gcm, null, sha384};
+suite_definition(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) ->
+ {dh_dss, aes_128_gcm, null, sha256};
+suite_definition(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) ->
+ {dh_dss, aes_256_gcm, null, sha384};
+suite_definition(?TLS_DH_anon_WITH_AES_128_GCM_SHA256) ->
+ {dh_anon, aes_128_gcm, null, sha256};
+suite_definition(?TLS_DH_anon_WITH_AES_256_GCM_SHA384) ->
+ {dh_anon, aes_256_gcm, null, sha384};
+
+%% RFC 5289 ECC AES-GCM Cipher Suites
+suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) ->
+ {ecdhe_ecdsa, aes_128_gcm, null, sha256};
+suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) ->
+ {ecdhe_ecdsa, aes_256_gcm, null, sha384};
+suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) ->
+ {ecdh_ecdsa, aes_128_gcm, null, sha256};
+suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) ->
+ {ecdh_ecdsa, aes_256_gcm, null, sha384};
+suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) ->
+ {ecdhe_rsa, aes_128_gcm, null, sha256};
+suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) ->
+ {ecdhe_rsa, aes_256_gcm, null, sha384};
+suite_definition(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) ->
+ {ecdh_rsa, aes_128_gcm, null, sha256};
+suite_definition(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) ->
+ {ecdh_rsa, aes_256_gcm, null, sha384};
+
+%% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites
+suite_definition(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) ->
+ {ecdhe_rsa, chacha20_poly1305, null, sha256};
+suite_definition(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) ->
+ {ecdhe_ecdsa, chacha20_poly1305, null, sha256};
+suite_definition(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) ->
+ {dhe_rsa, chacha20_poly1305, null, sha256}.
%%--------------------------------------------------------------------
-spec suite(erl_cipher_suite()) -> cipher_suite().
@@ -641,6 +802,19 @@ suite({rsa_psk, aes_256_cbc,sha}) ->
%%% TLS 1.2 PSK Cipher Suites RFC 5487
+suite({psk, aes_128_gcm, null}) ->
+ ?TLS_PSK_WITH_AES_128_GCM_SHA256;
+suite({psk, aes_256_gcm, null}) ->
+ ?TLS_PSK_WITH_AES_256_GCM_SHA384;
+suite({dhe_psk, aes_128_gcm, null}) ->
+ ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256;
+suite({dhe_psk, aes_256_gcm, null}) ->
+ ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384;
+suite({rsa_psk, aes_128_gcm, null}) ->
+ ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256;
+suite({rsa_psk, aes_256_gcm, null}) ->
+ ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384;
+
suite({psk, aes_128_cbc, sha256}) ->
?TLS_PSK_WITH_AES_128_CBC_SHA256;
suite({psk, aes_256_cbc, sha384}) ->
@@ -760,7 +934,60 @@ suite({ecdhe_rsa, aes_256_cbc, sha384}) ->
suite({ecdh_rsa, aes_128_cbc, sha256}) ->
?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256;
suite({ecdh_rsa, aes_256_cbc, sha384}) ->
- ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384.
+ ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384;
+
+%% RFC 5288 AES-GCM Cipher Suites
+suite({rsa, aes_128_gcm, null}) ->
+ ?TLS_RSA_WITH_AES_128_GCM_SHA256;
+suite({rsa, aes_256_gcm, null}) ->
+ ?TLS_RSA_WITH_AES_256_GCM_SHA384;
+suite({dhe_rsa, aes_128_gcm, null}) ->
+ ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256;
+suite({dhe_rsa, aes_256_gcm, null}) ->
+ ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384;
+suite({dh_rsa, aes_128_gcm, null}) ->
+ ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256;
+suite({dh_rsa, aes_256_gcm, null}) ->
+ ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384;
+suite({dhe_dss, aes_128_gcm, null}) ->
+ ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256;
+suite({dhe_dss, aes_256_gcm, null}) ->
+ ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384;
+suite({dh_dss, aes_128_gcm, null}) ->
+ ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256;
+suite({dh_dss, aes_256_gcm, null}) ->
+ ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384;
+suite({dh_anon, aes_128_gcm, null}) ->
+ ?TLS_DH_anon_WITH_AES_128_GCM_SHA256;
+suite({dh_anon, aes_256_gcm, null}) ->
+ ?TLS_DH_anon_WITH_AES_256_GCM_SHA384;
+
+%% RFC 5289 ECC AES-GCM Cipher Suites
+suite({ecdhe_ecdsa, aes_128_gcm, null}) ->
+ ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256;
+suite({ecdhe_ecdsa, aes_256_gcm, null}) ->
+ ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384;
+suite({ecdh_ecdsa, aes_128_gcm, null}) ->
+ ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256;
+suite({ecdh_ecdsa, aes_256_gcm, null}) ->
+ ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384;
+suite({ecdhe_rsa, aes_128_gcm, null}) ->
+ ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256;
+suite({ecdhe_rsa, aes_256_gcm, null}) ->
+ ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384;
+suite({ecdh_rsa, aes_128_gcm, null}) ->
+ ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256;
+suite({ecdh_rsa, aes_256_gcm, null}) ->
+ ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384;
+
+
+%% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites
+suite({ecdhe_rsa, chacha20_poly1305, null}) ->
+ ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256;
+suite({ecdhe_ecdsa, chacha20_poly1305, null}) ->
+ ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256;
+suite({dhe_rsa, chacha20_poly1305, null}) ->
+ ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256.
%%--------------------------------------------------------------------
-spec openssl_suite(openssl_cipher_suite()) -> cipher_suite().
@@ -875,7 +1102,47 @@ openssl_suite("ECDHE-RSA-AES256-SHA384") ->
openssl_suite("ECDH-RSA-AES128-SHA256") ->
?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256;
openssl_suite("ECDH-RSA-AES256-SHA384") ->
- ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384.
+ ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384;
+
+%% RFC 5288 AES-GCM Cipher Suites
+openssl_suite("AES128-GCM-SHA256") ->
+ ?TLS_RSA_WITH_AES_128_GCM_SHA256;
+openssl_suite("AES256-GCM-SHA384") ->
+ ?TLS_RSA_WITH_AES_256_GCM_SHA384;
+openssl_suite("DHE-RSA-AES128-GCM-SHA256") ->
+ ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256;
+openssl_suite("DHE-RSA-AES256-GCM-SHA384") ->
+ ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384;
+openssl_suite("DH-RSA-AES128-GCM-SHA256") ->
+ ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256;
+openssl_suite("DH-RSA-AES256-GCM-SHA384") ->
+ ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384;
+openssl_suite("DHE-DSS-AES128-GCM-SHA256") ->
+ ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256;
+openssl_suite("DHE-DSS-AES256-GCM-SHA384") ->
+ ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384;
+openssl_suite("DH-DSS-AES128-GCM-SHA256") ->
+ ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256;
+openssl_suite("DH-DSS-AES256-GCM-SHA384") ->
+ ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384;
+
+%% RFC 5289 ECC AES-GCM Cipher Suites
+openssl_suite("ECDHE-ECDSA-AES128-GCM-SHA256") ->
+ ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256;
+openssl_suite("ECDHE-ECDSA-AES256-GCM-SHA384") ->
+ ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384;
+openssl_suite("ECDH-ECDSA-AES128-GCM-SHA256") ->
+ ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256;
+openssl_suite("ECDH-ECDSA-AES256-GCM-SHA384") ->
+ ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384;
+openssl_suite("ECDHE-RSA-AES128-GCM-SHA256") ->
+ ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256;
+openssl_suite("ECDHE-RSA-AES256-GCM-SHA384") ->
+ ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384;
+openssl_suite("ECDH-RSA-AES128-GCM-SHA256") ->
+ ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256;
+openssl_suite("ECDH-RSA-AES256-GCM-SHA384") ->
+ ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384.
%%--------------------------------------------------------------------
-spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite().
@@ -1012,6 +1279,46 @@ openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) ->
openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) ->
"ECDH-RSA-AES256-SHA384";
+%% RFC 5288 AES-GCM Cipher Suites
+openssl_suite_name(?TLS_RSA_WITH_AES_128_GCM_SHA256) ->
+ "AES128-GCM-SHA256";
+openssl_suite_name(?TLS_RSA_WITH_AES_256_GCM_SHA384) ->
+ "AES256-GCM-SHA384";
+openssl_suite_name(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) ->
+ "DHE-RSA-AES128-GCM-SHA256";
+openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) ->
+ "DHE-RSA-AES256-GCM-SHA384";
+openssl_suite_name(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) ->
+ "DH-RSA-AES128-GCM-SHA256";
+openssl_suite_name(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) ->
+ "DH-RSA-AES256-GCM-SHA384";
+openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) ->
+ "DHE-DSS-AES128-GCM-SHA256";
+openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) ->
+ "DHE-DSS-AES256-GCM-SHA384";
+openssl_suite_name(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) ->
+ "DH-DSS-AES128-GCM-SHA256";
+openssl_suite_name(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) ->
+ "DH-DSS-AES256-GCM-SHA384";
+
+%% RFC 5289 ECC AES-GCM Cipher Suites
+openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) ->
+ "ECDHE-ECDSA-AES128-GCM-SHA256";
+openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) ->
+ "ECDHE-ECDSA-AES256-GCM-SHA384";
+openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) ->
+ "ECDH-ECDSA-AES128-GCM-SHA256";
+openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) ->
+ "ECDH-ECDSA-AES256-GCM-SHA384";
+openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) ->
+ "ECDHE-RSA-AES128-GCM-SHA256";
+openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) ->
+ "ECDHE-RSA-AES256-GCM-SHA384";
+openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) ->
+ "ECDH-RSA-AES128-GCM-SHA256";
+openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) ->
+ "ECDH-RSA-AES256-GCM-SHA384";
+
%% No oppenssl name
openssl_suite_name(Cipher) ->
suite_definition(Cipher).
@@ -1095,6 +1402,13 @@ is_acceptable_keyexchange(KeyExchange, Algos)
is_acceptable_keyexchange(_, _) ->
true.
+is_acceptable_cipher(Cipher, Algos)
+ when Cipher == aes_128_gcm;
+ Cipher == aes_256_gcm ->
+ proplists:get_bool(aes_gcm, Algos);
+is_acceptable_cipher(Cipher, Algos)
+ when Cipher == chacha20_poly1305 ->
+ proplists:get_bool(Cipher, Algos);
is_acceptable_cipher(_, _) ->
true.
@@ -1122,7 +1436,12 @@ bulk_cipher_algorithm('3des_ede_cbc') ->
?'3DES';
bulk_cipher_algorithm(Cipher) when Cipher == aes_128_cbc;
Cipher == aes_256_cbc ->
- ?AES.
+ ?AES_CBC;
+bulk_cipher_algorithm(Cipher) when Cipher == aes_128_gcm;
+ Cipher == aes_256_gcm ->
+ ?AES_GCM;
+bulk_cipher_algorithm(chacha20_poly1305) ->
+ ?CHACHA20_POLY1305.
type(Cipher) when Cipher == null;
Cipher == rc4_128 ->
@@ -1132,7 +1451,11 @@ type(Cipher) when Cipher == des_cbc;
Cipher == '3des_ede_cbc';
Cipher == aes_128_cbc;
Cipher == aes_256_cbc ->
- ?BLOCK.
+ ?BLOCK;
+type(Cipher) when Cipher == aes_128_gcm;
+ Cipher == aes_256_gcm;
+ Cipher == chacha20_poly1305 ->
+ ?AEAD.
key_material(null) ->
0;
@@ -1145,6 +1468,12 @@ key_material('3des_ede_cbc') ->
key_material(aes_128_cbc) ->
16;
key_material(aes_256_cbc) ->
+ 32;
+key_material(aes_128_gcm) ->
+ 16;
+key_material(aes_256_gcm) ->
+ 32;
+key_material(chacha20_poly1305) ->
32.
expanded_key_material(null) ->
@@ -1156,7 +1485,10 @@ expanded_key_material(Cipher) when Cipher == des_cbc ->
expanded_key_material('3des_ede_cbc') ->
24;
expanded_key_material(Cipher) when Cipher == aes_128_cbc;
- Cipher == aes_256_cbc ->
+ Cipher == aes_256_cbc;
+ Cipher == aes_128_gcm;
+ Cipher == aes_256_gcm;
+ Cipher == chacha20_poly1305 ->
unknown.
@@ -1165,16 +1497,25 @@ effective_key_bits(null) ->
effective_key_bits(des_cbc) ->
56;
effective_key_bits(Cipher) when Cipher == rc4_128;
- Cipher == aes_128_cbc ->
+ Cipher == aes_128_cbc;
+ Cipher == aes_128_gcm ->
128;
effective_key_bits('3des_ede_cbc') ->
168;
-effective_key_bits(aes_256_cbc) ->
+effective_key_bits(Cipher) when Cipher == aes_256_cbc;
+ Cipher == aes_256_gcm;
+ Cipher == chacha20_poly1305 ->
256.
iv_size(Cipher) when Cipher == null;
- Cipher == rc4_128 ->
+ Cipher == rc4_128;
+ Cipher == chacha20_poly1305->
0;
+
+iv_size(Cipher) when Cipher == aes_128_gcm;
+ Cipher == aes_256_gcm ->
+ 4;
+
iv_size(Cipher) ->
block_size(Cipher).
@@ -1183,7 +1524,10 @@ block_size(Cipher) when Cipher == des_cbc;
8;
block_size(Cipher) when Cipher == aes_128_cbc;
- Cipher == aes_256_cbc ->
+ Cipher == aes_256_cbc;
+ Cipher == aes_128_gcm;
+ Cipher == aes_256_gcm;
+ Cipher == chacha20_poly1305 ->
16.
prf_algorithm(default_prf, {3, N}) when N >= 3 ->
@@ -1337,10 +1681,15 @@ dhe_rsa_suites() ->
?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA,
?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256,
?TLS_DHE_RSA_WITH_AES_128_CBC_SHA,
- ?TLS_DHE_RSA_WITH_DES_CBC_SHA].
+ ?TLS_DHE_RSA_WITH_DES_CBC_SHA,
+ ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256,
+ ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384,
+ ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256].
psk_rsa_suites() ->
- [?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384,
+ [?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384,
+ ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256,
+ ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384,
?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256,
?TLS_RSA_PSK_WITH_AES_256_CBC_SHA,
?TLS_RSA_PSK_WITH_AES_128_CBC_SHA,
@@ -1360,7 +1709,9 @@ rsa_suites() ->
?TLS_RSA_WITH_AES_128_CBC_SHA,
?TLS_RSA_WITH_RC4_128_SHA,
?TLS_RSA_WITH_RC4_128_MD5,
- ?TLS_RSA_WITH_DES_CBC_SHA].
+ ?TLS_RSA_WITH_DES_CBC_SHA,
+ ?TLS_RSA_WITH_AES_128_GCM_SHA256,
+ ?TLS_RSA_WITH_AES_256_GCM_SHA384].
ecdh_rsa_suites() ->
[?TLS_ECDH_RSA_WITH_NULL_SHA,
@@ -1369,7 +1720,9 @@ ecdh_rsa_suites() ->
?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA,
?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA,
?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256,
- ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384].
+ ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384,
+ ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256,
+ ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384].
ecdhe_rsa_suites() ->
[?TLS_ECDHE_RSA_WITH_NULL_SHA,
@@ -1378,7 +1731,10 @@ ecdhe_rsa_suites() ->
?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA,
?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA,
?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256,
- ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384].
+ ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384,
+ ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256,
+ ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384,
+ ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256].
dsa_signed_suites() ->
dhe_dss_suites() ++ srp_dss_suites().
@@ -1389,7 +1745,9 @@ dhe_dss_suites() ->
?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256,
?TLS_DHE_DSS_WITH_AES_128_CBC_SHA,
- ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA].
+ ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256,
+ ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384].
srp_dss_suites() ->
[?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA,
@@ -1413,7 +1771,9 @@ ecdh_ecdsa_suites() ->
?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA,
?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA,
?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256,
- ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384].
+ ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384,
+ ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256,
+ ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384].
ecdhe_ecdsa_suites() ->
[?TLS_ECDHE_ECDSA_WITH_NULL_SHA,
@@ -1422,7 +1782,10 @@ ecdhe_ecdsa_suites() ->
?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA,
?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA,
?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256,
- ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384].
+ ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384,
+ ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256,
+ ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384,
+ ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256].
filter_keyuse(OtpCert, Ciphers, Suites, SignSuites) ->
TBSCert = OtpCert#'OTPCertificate'.tbsCertificate,
diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl
index 3ce9c19aa9..448c2405aa 100644
--- a/lib/ssl/src/ssl_cipher.hrl
+++ b/lib/ssl/src/ssl_cipher.hrl
@@ -46,7 +46,8 @@
-record(cipher_state, {
iv,
key,
- state
+ state,
+ nonce
}).
%%% TLS_NULL_WITH_NULL_NULL is specified and is the initial state of a
@@ -395,6 +396,24 @@
%%% TLS 1.2 PSK Cipher Suites RFC 5487
+%% TLS_PSK_WITH_AES_128_GCM_SHA256 = {0x00,0xA8};
+-define(TLS_PSK_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A8)>>).
+
+%% TLS_PSK_WITH_AES_256_GCM_SHA384 = {0x00,0xA9};
+-define(TLS_PSK_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A9)>>).
+
+%% TLS_DHE_PSK_WITH_AES_128_GCM_SHA256 = {0x00,0xAA};
+-define(TLS_DHE_PSK_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#AA)>>).
+
+%% TLS_DHE_PSK_WITH_AES_256_GCM_SHA384 = {0x00,0xAB};
+-define(TLS_DHE_PSK_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#AB)>>).
+
+%% TLS_RSA_PSK_WITH_AES_128_GCM_SHA256 = {0x00,0xAC};
+-define(TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#AC)>>).
+
+%% TLS_RSA_PSK_WITH_AES_256_GCM_SHA384 = {0x00,0xAD};
+-define(TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#AD)>>).
+
%% TLS_PSK_WITH_AES_128_CBC_SHA256 = {0x00,0xAE};
-define(TLS_PSK_WITH_AES_128_CBC_SHA256, <<?BYTE(16#00), ?BYTE(16#AE)>>).
@@ -460,4 +479,79 @@
%% TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA = { 0xC0,0x22 };
-define(TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#22)>>).
+%%% AES-GCM Cipher Suites RFC 5288
+
+%% TLS_RSA_WITH_AES_128_GCM_SHA256 = {0x00,0x9C}
+-define(TLS_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#9C)>>).
+
+%% TLS_RSA_WITH_AES_256_GCM_SHA384 = {0x00,0x9D}
+-define(TLS_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#9D)>>).
+
+%% TLS_DHE_RSA_WITH_AES_128_GCM_SHA256 = {0x00,0x9E}
+-define(TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#9E)>>).
+
+%% TLS_DHE_RSA_WITH_AES_256_GCM_SHA384 = {0x00,0x9F}
+-define(TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#9F)>>).
+
+%% TLS_DH_RSA_WITH_AES_128_GCM_SHA256 = {0x00,0xA0}
+-define(TLS_DH_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A0)>>).
+
+%% TLS_DH_RSA_WITH_AES_256_GCM_SHA384 = {0x00,0xA1}
+-define(TLS_DH_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A1)>>).
+
+%% TLS_DHE_DSS_WITH_AES_128_GCM_SHA256 = {0x00,0xA2}
+-define(TLS_DHE_DSS_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A2)>>).
+
+%% TLS_DHE_DSS_WITH_AES_256_GCM_SHA384 = {0x00,0xA3}
+-define(TLS_DHE_DSS_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A3)>>).
+
+%% TLS_DH_DSS_WITH_AES_128_GCM_SHA256 = {0x00,0xA4}
+-define(TLS_DH_DSS_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A4)>>).
+
+%% TLS_DH_DSS_WITH_AES_256_GCM_SHA384 = {0x00,0xA5}
+-define(TLS_DH_DSS_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A5)>>).
+
+%% TLS_DH_anon_WITH_AES_128_GCM_SHA256 = {0x00,0xA6}
+-define(TLS_DH_anon_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A6)>>).
+
+%% TLS_DH_anon_WITH_AES_256_GCM_SHA384 = {0x00,0xA7}
+-define(TLS_DH_anon_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A7)>>).
+
+%%% ECC AES-GCM Cipher Suites RFC 5289
+
+%% TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 = {0xC0,0x2B};
+-define(TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#C0), ?BYTE(16#2B)>>).
+
+%% TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x2C};
+-define(TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#2C)>>).
+
+%% TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256 = {0xC0,0x2D};
+-define(TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#C0), ?BYTE(16#2D)>>).
+
+%% TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x2E};
+-define(TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#2E)>>).
+
+%% TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256 = {0xC0,0x2F};
+-define(TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#C0), ?BYTE(16#2F)>>).
+
+%% TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x30};
+-define(TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#30)>>).
+
+%% TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256 = {0xC0,0x31};
+-define(TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#C0), ?BYTE(16#31)>>).
+
+%% TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x32};
+-define(TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#32)>>).
+
+%%% Chacha20/Poly1305 Suites draft-agl-tls-chacha20poly1305-04
+
+%% TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x13}
+-define(TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#13)>>).
+
+%% TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x14}
+-define(TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#14)>>).
+
+%% TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x15}
+-define(TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#15)>>).
+
-endif. % -ifdef(ssl_cipher).
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 88ccb94e0b..07535e79b4 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -1435,6 +1435,7 @@ calc_finished({3, N}, Role, PrfAlgo, MasterSecret, Handshake) ->
master_secret(_RecordCB, Version, MasterSecret,
#security_parameters{
+ bulk_cipher_algorithm = BCA,
client_random = ClientRandom,
server_random = ServerRandom,
hash_size = HashSize,
@@ -1453,8 +1454,8 @@ master_secret(_RecordCB, Version, MasterSecret,
ssl_record:set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret,
Role, ConnStates1),
- ClientCipherState = #cipher_state{iv = ClientIV, key = ClientWriteKey},
- ServerCipherState = #cipher_state{iv = ServerIV, key = ServerWriteKey},
+ ClientCipherState = ssl_cipher:cipher_init(BCA, ClientIV, ClientWriteKey),
+ ServerCipherState = ssl_cipher:cipher_init(BCA, ServerIV, ServerWriteKey),
{MasterSecret,
ssl_record:set_pending_cipher_state(ConnStates2, ClientCipherState,
ServerCipherState, Role)}.
diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl
index d6e5064c39..5553fc9220 100644
--- a/lib/ssl/src/ssl_manager.erl
+++ b/lib/ssl/src/ssl_manager.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -44,7 +44,8 @@
-include_lib("kernel/include/file.hrl").
-record(state, {
- session_cache,
+ session_cache_client,
+ session_cache_server,
session_cache_cb,
session_lifetime,
certificate_db,
@@ -209,12 +210,16 @@ init([Name, Opts]) ->
SessionLifeTime =
proplists:get_value(session_lifetime, Opts, ?'24H_in_sec'),
CertDb = ssl_pkix_db:create(),
- SessionCache = CacheCb:init(proplists:get_value(session_cb_init_args, Opts, [])),
+ ClientSessionCache = CacheCb:init([{role, client} |
+ proplists:get_value(session_cb_init_args, Opts, [])]),
+ ServerSessionCache = CacheCb:init([{role, server} |
+ proplists:get_value(session_cb_init_args, Opts, [])]),
Timer = erlang:send_after(SessionLifeTime * 1000 + 5000,
self(), validate_sessions),
erlang:send_after(?CLEAR_PEM_CACHE, self(), clear_pem_cache),
{ok, #state{certificate_db = CertDb,
- session_cache = SessionCache,
+ session_cache_client = ClientSessionCache,
+ session_cache_server = ServerSessionCache,
session_cache_cb = CacheCb,
session_lifetime = SessionLifeTime,
session_validation_timer = Timer}}.
@@ -230,15 +235,32 @@ init([Name, Opts]) ->
%%
%% Description: Handling call messages
%%--------------------------------------------------------------------
-handle_call({{connection_init, <<>>, _Role}, _Pid}, _From,
+handle_call({{connection_init, <<>>, client}, _Pid}, _From,
#state{certificate_db = [CertDb, FileRefDb, PemChace],
- session_cache = Cache} = State) ->
+ session_cache_client = Cache} = State) ->
+ Result = {ok, make_ref(),CertDb, FileRefDb, PemChace, Cache},
+ {reply, Result, State};
+handle_call({{connection_init, <<>>, server}, _Pid}, _From,
+ #state{certificate_db = [CertDb, FileRefDb, PemChace],
+ session_cache_server = Cache} = State) ->
Result = {ok, make_ref(),CertDb, FileRefDb, PemChace, Cache},
{reply, Result, State};
-handle_call({{connection_init, Trustedcerts, _Role}, Pid}, _From,
+handle_call({{connection_init, Trustedcerts, client}, Pid}, _From,
+ #state{certificate_db = [CertDb, FileRefDb, PemChace] = Db,
+ session_cache_client = Cache} = State) ->
+ Result =
+ try
+ {ok, Ref} = ssl_pkix_db:add_trusted_certs(Pid, Trustedcerts, Db),
+ {ok, Ref, CertDb, FileRefDb, PemChace, Cache}
+ catch
+ _:Reason ->
+ {error, Reason}
+ end,
+ {reply, Result, State};
+handle_call({{connection_init, Trustedcerts, server}, Pid}, _From,
#state{certificate_db = [CertDb, FileRefDb, PemChace] = Db,
- session_cache = Cache} = State) ->
+ session_cache_server = Cache} = State) ->
Result =
try
{ok, Ref} = ssl_pkix_db:add_trusted_certs(Pid, Trustedcerts, Db),
@@ -249,9 +271,10 @@ handle_call({{connection_init, Trustedcerts, _Role}, Pid}, _From,
end,
{reply, Result, State};
+
handle_call({{new_session_id,Port}, _},
_, #state{session_cache_cb = CacheCb,
- session_cache = Cache} = State) ->
+ session_cache_server = Cache} = State) ->
Id = new_id(Port, ?GEN_UNIQUE_ID_MAX_TRIES, Cache, CacheCb),
{reply, Id, State};
@@ -278,16 +301,22 @@ handle_call({unconditionally_clear_pem_cache, _},_, #state{certificate_db = [_,_
%% Description: Handling cast messages
%%--------------------------------------------------------------------
handle_cast({register_session, Host, Port, Session},
- #state{session_cache = Cache,
+ #state{session_cache_client = Cache,
session_cache_cb = CacheCb} = State) ->
TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}),
NewSession = Session#session{time_stamp = TimeStamp},
- CacheCb:update(Cache, {{Host, Port},
- NewSession#session.session_id}, NewSession),
+
+ case CacheCb:select_session(Cache, {Host, Port}) of
+ no_session ->
+ CacheCb:update(Cache, {{Host, Port},
+ NewSession#session.session_id}, NewSession);
+ Sessions ->
+ register_unique_session(Sessions, NewSession, CacheCb, Cache, {Host, Port})
+ end,
{noreply, State};
handle_cast({register_session, Port, Session},
- #state{session_cache = Cache,
+ #state{session_cache_server = Cache,
session_cache_cb = CacheCb} = State) ->
TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}),
NewSession = Session#session{time_stamp = TimeStamp},
@@ -296,12 +325,12 @@ handle_cast({register_session, Port, Session},
handle_cast({invalidate_session, Host, Port,
#session{session_id = ID} = Session},
- #state{session_cache = Cache,
+ #state{session_cache_client = Cache,
session_cache_cb = CacheCb} = State) ->
invalidate_session(Cache, CacheCb, {{Host, Port}, ID}, Session, State);
handle_cast({invalidate_session, Port, #session{session_id = ID} = Session},
- #state{session_cache = Cache,
+ #state{session_cache_server = Cache,
session_cache_cb = CacheCb} = State) ->
invalidate_session(Cache, CacheCb, {Port, ID}, Session, State).
@@ -314,17 +343,18 @@ handle_cast({invalidate_session, Port, #session{session_id = ID} = Session},
%% Description: Handling all non call/cast messages
%%-------------------------------------------------------------------
handle_info(validate_sessions, #state{session_cache_cb = CacheCb,
- session_cache = Cache,
+ session_cache_client = ClientCache,
+ session_cache_server = ServerCache,
session_lifetime = LifeTime
} = State) ->
Timer = erlang:send_after(?SESSION_VALIDATION_INTERVAL,
self(), validate_sessions),
- start_session_validator(Cache, CacheCb, LifeTime),
+ start_session_validator(ClientCache, CacheCb, LifeTime),
+ start_session_validator(ServerCache, CacheCb, LifeTime),
{noreply, State#state{session_validation_timer = Timer}};
-handle_info({delayed_clean_session, Key}, #state{session_cache = Cache,
- session_cache_cb = CacheCb
- } = State) ->
+handle_info({delayed_clean_session, Key, Cache}, #state{session_cache_cb = CacheCb
+ } = State) ->
CacheCb:delete(Cache, Key),
{noreply, State};
@@ -367,12 +397,14 @@ handle_info(_Info, State) ->
%% The return value is ignored.
%%--------------------------------------------------------------------
terminate(_Reason, #state{certificate_db = Db,
- session_cache = SessionCache,
+ session_cache_client = ClientSessionCache,
+ session_cache_server = ServerSessionCache,
session_cache_cb = CacheCb,
session_validation_timer = Timer}) ->
erlang:cancel_timer(Timer),
ssl_pkix_db:remove(Db),
- CacheCb:terminate(SessionCache),
+ catch CacheCb:terminate(ClientSessionCache),
+ catch CacheCb:terminate(ServerSessionCache),
ok.
%%--------------------------------------------------------------------
@@ -445,7 +477,7 @@ invalidate_session(Cache, CacheCb, Key, Session, #state{last_delay_timer = LastT
%% up the session data but new connections should not get to use this session.
CacheCb:update(Cache, Key, Session#session{is_resumable = false}),
TRef =
- erlang:send_after(delay_time(), self(), {delayed_clean_session, Key}),
+ erlang:send_after(delay_time(), self(), {delayed_clean_session, Key, Cache}),
{noreply, State#state{last_delay_timer = last_delay_timer(Key, TRef, LastTimer)}}
end.
@@ -494,3 +526,34 @@ clean_cert_db(Ref, CertDb, RefDb, PemCache, File) ->
_ ->
ok
end.
+
+%% Do not let dumb clients create a gigantic session table
+%% for itself creating big delays at connection time.
+register_unique_session(Sessions, Session, CacheCb, Cache, PartialKey) ->
+ case exists_equivalent(Session , Sessions) of
+ true ->
+ ok;
+ false ->
+ CacheCb:update(Cache, {PartialKey,
+ Session#session.session_id}, Session)
+ end.
+
+exists_equivalent(_, []) ->
+ false;
+exists_equivalent(#session{
+ peer_certificate = PeerCert,
+ own_certificate = OwnCert,
+ compression_method = Compress,
+ cipher_suite = CipherSuite,
+ srp_username = SRP,
+ ecc = ECC} ,
+ [#session{
+ peer_certificate = PeerCert,
+ own_certificate = OwnCert,
+ compression_method = Compress,
+ cipher_suite = CipherSuite,
+ srp_username = SRP,
+ ecc = ECC} | _]) ->
+ true;
+exists_equivalent(Session, [ _ | Rest]) ->
+ exists_equivalent(Session, Rest).
diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl
index 7337225bc4..63fc57edad 100644
--- a/lib/ssl/src/ssl_record.erl
+++ b/lib/ssl/src/ssl_record.erl
@@ -48,7 +48,8 @@
-export([compress/3, uncompress/3, compressions/0]).
%% Payload encryption/decryption
--export([cipher/4, decipher/3, is_correct_mac/2]).
+-export([cipher/4, decipher/3, is_correct_mac/2,
+ cipher_aead/4, decipher_aead/4]).
-export_type([ssl_version/0, ssl_atom_version/0]).
@@ -377,6 +378,24 @@ cipher(Version, Fragment,
ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version),
{CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}.
%%--------------------------------------------------------------------
+-spec cipher_aead(ssl_version(), iodata(), #connection_state{}, MacHash::binary()) ->
+ {CipherFragment::binary(), #connection_state{}}.
+%%
+%% Description: Payload encryption
+%%--------------------------------------------------------------------
+cipher_aead(Version, Fragment,
+ #connection_state{cipher_state = CipherS0,
+ sequence_number = SeqNo,
+ security_parameters=
+ #security_parameters{bulk_cipher_algorithm =
+ BulkCipherAlgo}
+ } = WriteState0, AAD) ->
+
+ {CipherFragment, CipherS1} =
+ ssl_cipher:cipher_aead(BulkCipherAlgo, CipherS0, SeqNo, AAD, Fragment, Version),
+ {CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}.
+
+%%--------------------------------------------------------------------
-spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}} | #alert{}.
%%
%% Description: Payload decryption
@@ -396,6 +415,25 @@ decipher(Version, CipherFragment,
Alert
end.
%%--------------------------------------------------------------------
+-spec decipher_aead(ssl_version(), binary(), #connection_state{}, binary()) -> {binary(), binary(), #connection_state{}} | #alert{}.
+%%
+%% Description: Payload decryption
+%%--------------------------------------------------------------------
+decipher_aead(Version, CipherFragment,
+ #connection_state{sequence_number = SeqNo,
+ security_parameters =
+ #security_parameters{bulk_cipher_algorithm =
+ BulkCipherAlgo},
+ cipher_state = CipherS0
+ } = ReadState, AAD) ->
+ case ssl_cipher:decipher_aead(BulkCipherAlgo, CipherS0, SeqNo, AAD, CipherFragment, Version) of
+ {PlainFragment, CipherS1} ->
+ CS1 = ReadState#connection_state{cipher_state = CipherS1},
+ {PlainFragment, CS1};
+ #alert{} = Alert ->
+ Alert
+ end.
+%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
empty_connection_state(ConnectionEnd) ->
diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl
index 6aab35d6da..53b5f2399b 100644
--- a/lib/ssl/src/ssl_record.hrl
+++ b/lib/ssl/src/ssl_record.hrl
@@ -90,11 +90,14 @@
-define('3DES', 4).
-define(DES40, 5).
-define(IDEA, 6).
--define(AES, 7).
+-define(AES_CBC, 7).
+-define(AES_GCM, 8).
+-define(CHACHA20_POLY1305, 9).
%% CipherType
-define(STREAM, 0).
-define(BLOCK, 1).
+-define(AEAD, 2).
%% IsExportable
%-define(TRUE, 0). %% Already defined by ssl_internal.hrl
diff --git a/lib/ssl/src/ssl_session_cache.erl b/lib/ssl/src/ssl_session_cache.erl
index 5c6ee3c54c..b011732f2c 100644
--- a/lib/ssl/src/ssl_session_cache.erl
+++ b/lib/ssl/src/ssl_session_cache.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -31,8 +31,8 @@
%%--------------------------------------------------------------------
%% Description: Return table reference. Called by ssl_manager process.
%%--------------------------------------------------------------------
-init(_) ->
- ets:new(cache_name(), [ordered_set, protected]).
+init(Options) ->
+ ets:new(cache_name(proplists:get_value(role, Options)), [ordered_set, protected]).
%%--------------------------------------------------------------------
%% Description: Handles cache table at termination of ssl manager.
@@ -87,5 +87,5 @@ select_session(Cache, PartialKey) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-cache_name() ->
- ssl_otp_session_cache.
+cache_name(Name) ->
+ list_to_atom(atom_to_list(Name) ++ "_ssl_otp_session_cache").
diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl
index f50ea22f39..544d200f70 100644
--- a/lib/ssl/src/tls_record.erl
+++ b/lib/ssl/src/tls_record.erl
@@ -132,6 +132,23 @@ encode_plain_text(Type, Version, Data,
sequence_number = Seq,
compression_state=CompS0,
security_parameters=
+ #security_parameters{
+ cipher_type = ?AEAD,
+ compression_algorithm=CompAlg}
+ }= WriteState0} = ConnectionStates) ->
+ {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0),
+ WriteState1 = WriteState0#connection_state{compression_state = CompS1},
+ AAD = calc_aad(Type, Version, WriteState1),
+ {CipherFragment, WriteState} = ssl_record:cipher_aead(Version, Comp, WriteState1, AAD),
+ CipherText = encode_tls_cipher_text(Type, Version, CipherFragment),
+ {CipherText, ConnectionStates#connection_states{current_write = WriteState#connection_state{sequence_number = Seq +1}}};
+
+encode_plain_text(Type, Version, Data,
+ #connection_states{current_write =
+ #connection_state{
+ sequence_number = Seq,
+ compression_state=CompS0,
+ security_parameters=
#security_parameters{compression_algorithm=CompAlg}
}= WriteState0} = ConnectionStates) ->
{Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0),
@@ -148,18 +165,45 @@ encode_plain_text(Type, Version, Data,
%% Description: Decode cipher text
%%--------------------------------------------------------------------
decode_cipher_text(#ssl_tls{type = Type, version = Version,
- fragment = CipherFragment} = CipherText, ConnnectionStates0) ->
- ReadState0 = ConnnectionStates0#connection_states.current_read,
- #connection_state{compression_state = CompressionS0,
- sequence_number = Seq,
- security_parameters = SecParams} = ReadState0,
- CompressAlg = SecParams#security_parameters.compression_algorithm,
+ fragment = CipherFragment} = CipherText,
+ #connection_states{current_read =
+ #connection_state{
+ compression_state = CompressionS0,
+ sequence_number = Seq,
+ security_parameters=
+ #security_parameters{
+ cipher_type = ?AEAD,
+ compression_algorithm=CompAlg}
+ } = ReadState0} = ConnnectionStates0) ->
+ AAD = calc_aad(Type, Version, ReadState0),
+ case ssl_record:decipher_aead(Version, CipherFragment, ReadState0, AAD) of
+ {PlainFragment, ReadState1} ->
+ {Plain, CompressionS1} = ssl_record:uncompress(CompAlg,
+ PlainFragment, CompressionS0),
+ ConnnectionStates = ConnnectionStates0#connection_states{
+ current_read = ReadState1#connection_state{
+ sequence_number = Seq + 1,
+ compression_state = CompressionS1}},
+ {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates};
+ #alert{} = Alert ->
+ Alert
+ end;
+
+decode_cipher_text(#ssl_tls{type = Type, version = Version,
+ fragment = CipherFragment} = CipherText,
+ #connection_states{current_read =
+ #connection_state{
+ compression_state = CompressionS0,
+ sequence_number = Seq,
+ security_parameters=
+ #security_parameters{compression_algorithm=CompAlg}
+ } = ReadState0} = ConnnectionStates0) ->
case ssl_record:decipher(Version, CipherFragment, ReadState0) of
{PlainFragment, Mac, ReadState1} ->
MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1),
case ssl_record:is_correct_mac(Mac, MacHash) of
true ->
- {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg,
+ {Plain, CompressionS1} = ssl_record:uncompress(CompAlg,
PlainFragment, CompressionS0),
ConnnectionStates = ConnnectionStates0#connection_states{
current_read = ReadState1#connection_state{
@@ -322,3 +366,7 @@ calc_mac_hash(Type, Version,
mac_hash(Version, SecPars#security_parameters.mac_algorithm,
MacSecret, SeqNo, Type,
Length, PlainFragment).
+
+calc_aad(Type, {MajVer, MinVer},
+ #connection_state{sequence_number = SeqNo}) ->
+ <<SeqNo:64/integer, ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>.
diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl
index 7a5f9c1b38..c4114278a4 100644
--- a/lib/ssl/src/tls_v1.erl
+++ b/lib/ssl/src/tls_v1.erl
@@ -221,25 +221,50 @@ suites(Minor) when Minor == 1; Minor == 2 ->
];
suites(3) ->
[
+ ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256,
+ ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256,
+
+ ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384,
+ ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384,
?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384,
?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384,
+ ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384,
+ ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384,
?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384,
?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384,
+ ?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,
?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256,
?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256,
+ ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256,
+ ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256,
?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256,
?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256,
+ ?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
+
+ %% not supported
+ %% ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384,
+ %% ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384,
+ %% ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256,
+ %% ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256
] ++ suites(2).
+
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index 2f8ff6f04e..3639c2b2da 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -37,6 +37,7 @@ VSN=$(GS_VSN)
MODULES = \
ssl_test_lib \
ssl_basic_SUITE \
+ ssl_bench_SUITE \
ssl_cipher_SUITE \
ssl_certificate_verify_SUITE\
ssl_crl_SUITE\
@@ -130,7 +131,7 @@ release_spec: opt
release_tests_spec: opt
$(INSTALL_DIR) "$(RELSYSDIR)"
$(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(HRL_FILES_NEEDED_IN_TEST) $(COVER_FILE) "$(RELSYSDIR)"
- $(INSTALL_DATA) ssl.spec ssl.cover "$(RELSYSDIR)"
+ $(INSTALL_DATA) ssl.spec ssl_bench.spec ssl.cover "$(RELSYSDIR)"
chmod -R u+w "$(RELSYSDIR)"
@tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
diff --git a/lib/ssl/test/ssl.spec b/lib/ssl/test/ssl.spec
index fc7c1bbb82..86e14c033e 100644
--- a/lib/ssl/test/ssl.spec
+++ b/lib/ssl/test/ssl.spec
@@ -1 +1,4 @@
{suites,"../ssl_test",all}.
+{skip_cases, "../ssl_test",
+ ssl_bench_SUITE, [setup_sequential, setup_concurrent, payload_simple],
+ "Benchmarks run separately"}.
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 1da4e88077..dc9e8934e6 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -629,7 +629,7 @@ clear_pem_cache(Config) when is_list(Config) ->
{status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)),
[_, _,_, _, Prop] = StatusInfo,
State = ssl_test_lib:state(Prop),
- [_,FilRefDb, _] = element(5, State),
+ [_,FilRefDb, _] = element(6, State),
{Server, Client} = basic_verify_test_no_close(Config),
2 = ets:info(FilRefDb, size),
ssl:clear_pem_cache(),
@@ -2339,7 +2339,7 @@ der_input(Config) when is_list(Config) ->
{status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)),
[_, _,_, _, Prop] = StatusInfo,
State = ssl_test_lib:state(Prop),
- [CADb | _] = element(5, State),
+ [CADb | _] = element(6, State),
[] = ets:tab2list(CADb).
%%--------------------------------------------------------------------
diff --git a/lib/ssl/test/ssl_bench.spec b/lib/ssl/test/ssl_bench.spec
new file mode 100644
index 0000000000..d2f75b4203
--- /dev/null
+++ b/lib/ssl/test/ssl_bench.spec
@@ -0,0 +1 @@
+{suites,"../ssl_test",[ssl_bench_SUITE]}.
diff --git a/lib/ssl/test/ssl_bench_SUITE.erl b/lib/ssl/test/ssl_bench_SUITE.erl
new file mode 100644
index 0000000000..b6b3769922
--- /dev/null
+++ b/lib/ssl/test/ssl_bench_SUITE.erl
@@ -0,0 +1,366 @@
+%%%-------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.2
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ssl_bench_SUITE).
+-compile(export_all).
+-include_lib("common_test/include/ct_event.hrl").
+
+-define(remote_host, "NETMARKS_REMOTE_HOST").
+
+suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}].
+
+all() -> [{group, setup}, {group, payload}].
+
+groups() ->
+ [{setup, [{repeat, 3}], [setup_sequential, setup_concurrent]},
+ {payload, [{repeat, 3}], [payload_simple]}
+ ].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, _Config) ->
+ ok.
+
+init_per_suite(Config) ->
+ try
+ Server = setup(ssl, node()),
+ [{server_node, Server}|Config]
+ catch _:_ ->
+ {skipped, "Benchmark machines only"}
+ end.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_testcase(_Func, Conf) ->
+ Conf.
+
+end_per_testcase(_Func, _Conf) ->
+ ok.
+
+
+-define(COUNT, 400).
+-define(TC(Cmd), tc(fun() -> Cmd end, ?MODULE, ?LINE)).
+
+-define(FPROF_CLIENT, false).
+-define(FPROF_SERVER, false).
+-define(EPROF_CLIENT, false).
+-define(EPROF_SERVER, false).
+-define(PERCEPT_SERVER, false).
+
+%% Current numbers gives roughly a testcase per minute on todays hardware..
+
+setup_sequential(Config) ->
+ Server = proplists:get_value(server_node, Config),
+ Server =/= undefined orelse error(no_server),
+ {ok, Result} = do_test(ssl, setup_connection, ?COUNT * 20, 1, Server),
+ ct_event:notify(#event{name = benchmark_data,
+ data=[{value, Result},
+ {suite, "ssl"}, {name, "Sequential setup"}]}),
+ ok.
+
+setup_concurrent(Config) ->
+ Server = proplists:get_value(server_node, Config),
+ Server =/= undefined orelse error(no_server),
+ {ok, Result} = do_test(ssl, setup_connection, ?COUNT, 100, Server),
+ ct_event:notify(#event{name = benchmark_data,
+ data=[{value, Result},
+ {suite, "ssl"}, {name, "Concurrent setup"}]}),
+ ok.
+
+payload_simple(Config) ->
+ Server = proplists:get_value(server_node, Config),
+ Server =/= undefined orelse error(no_server),
+ {ok, Result} = do_test(ssl, payload, ?COUNT*300, 10, Server),
+ ct_event:notify(#event{name = benchmark_data,
+ data=[{value, Result},
+ {suite, "ssl"}, {name, "Payload simple"}]}),
+ ok.
+
+
+ssl() ->
+ test(ssl, ?COUNT, node()).
+
+test(Type, Count, Host) ->
+ Server = setup(Type, Host),
+ (do_test(Type, setup_connection, Count * 20, 1, Server)),
+ (do_test(Type, setup_connection, Count, 100, Server)),
+ (do_test(Type, payload, Count*300, 10, Server)),
+ ok.
+
+do_test(Type, TC, Loop, ParallellConnections, Server) ->
+ _ = ssl:stop(),
+ {ok, _} = ensure_all_started(ssl, []),
+
+ {ok, {SPid, Host, Port}} = rpc:call(Server, ?MODULE, setup_server_init,
+ [Type, TC, Loop, ParallellConnections]),
+ link(SPid),
+ Me = self(),
+ Test = fun(Id) ->
+ CData = client_init(Me, Type, TC, Host, Port),
+ receive
+ go ->
+ ?FPROF_CLIENT andalso Id =:= 1 andalso
+ start_profile(fprof, [self(),new]),
+ ?EPROF_CLIENT andalso Id =:= 1 andalso
+ start_profile(eprof, [ssl_connection_sup, ssl_manager]),
+ ok = ?MODULE:TC(Loop, Type, CData),
+ ?FPROF_CLIENT andalso Id =:= 1 andalso
+ stop_profile(fprof, "test_connection_client_res.fprof"),
+ ?EPROF_CLIENT andalso Id =:= 1 andalso
+ stop_profile(eprof, "test_connection_client_res.eprof"),
+ Me ! self()
+ end
+ end,
+ Spawn = fun(Id) ->
+ Pid = spawn(fun() -> Test(Id) end),
+ receive {Pid, init} -> Pid end
+ end,
+ Pids = [Spawn(Id) || Id <- lists:seq(ParallellConnections, 1, -1)],
+ Run = fun() ->
+ [Pid ! go || Pid <- Pids],
+ [receive Pid -> ok end || Pid <- Pids]
+ end,
+ {TimeInMicro, _} = timer:tc(Run),
+ TotalTests = ParallellConnections * Loop,
+ TestPerSecond = 1000000 * TotalTests div TimeInMicro,
+ io:format("TC ~p ~p ~p ~p 1/s~n", [TC, Type, ParallellConnections, TestPerSecond]),
+ unlink(SPid),
+ SPid ! quit,
+ {ok, TestPerSecond}.
+
+server_init(ssl, setup_connection, _, _, Server) ->
+ {ok, Socket} = ssl:listen(0, ssl_opts(listen)),
+ {ok, {_Host, Port}} = ssl:sockname(Socket),
+ {ok, Host} = inet:gethostname(),
+ ?FPROF_SERVER andalso start_profile(fprof, [whereis(ssl_manager), new]),
+ %%?EPROF_SERVER andalso start_profile(eprof, [ssl_connection_sup, ssl_manager]),
+ ?EPROF_SERVER andalso start_profile(eprof, [ssl_manager]),
+ ?PERCEPT_SERVER andalso percept:profile("/tmp/ssl_server.percept"),
+ Server ! {self(), {init, Host, Port}},
+ Test = fun(TSocket) ->
+ ok = ssl:ssl_accept(TSocket),
+ ssl:close(TSocket)
+ end,
+ setup_server_connection(Socket, Test);
+server_init(ssl, payload, Loop, _, Server) ->
+ {ok, Socket} = ssl:listen(0, ssl_opts(listen)),
+ {ok, {_Host, Port}} = ssl:sockname(Socket),
+ {ok, Host} = inet:gethostname(),
+ Server ! {self(), {init, Host, Port}},
+ Test = fun(TSocket) ->
+ ok = ssl:ssl_accept(TSocket),
+ Size = byte_size(msg()),
+ server_echo(TSocket, Size, Loop),
+ ssl:close(TSocket)
+ end,
+ setup_server_connection(Socket, Test);
+
+server_init(Type, Tc, _, _, Server) ->
+ io:format("No server init code for ~p ~p~n",[Type, Tc]),
+ Server ! {self(), no_init}.
+
+client_init(Master, ssl, setup_connection, Host, Port) ->
+ Master ! {self(), init},
+ {Host, Port, ssl_opts(connect)};
+client_init(Master, ssl, payload, Host, Port) ->
+ {ok, Sock} = ssl:connect(Host, Port, ssl_opts(connect)),
+ Master ! {self(), init},
+ Size = byte_size(msg()),
+ {Sock, Size};
+client_init(_Me, Type, Tc, Host, Port) ->
+ io:format("No client init code for ~p ~p~n",[Type, Tc]),
+ {Host, Port}.
+
+setup_server_connection(LSocket, Test) ->
+ receive quit ->
+ ?FPROF_SERVER andalso stop_profile(fprof, "test_server_res.fprof"),
+ ?EPROF_SERVER andalso stop_profile(eprof, "test_server_res.eprof"),
+ ?PERCEPT_SERVER andalso stop_profile(percept, "/tmp/ssl_server.percept"),
+ ok
+ after 0 ->
+ case ssl:transport_accept(LSocket, 2000) of
+ {ok, TSocket} -> spawn_link(fun() -> Test(TSocket) end);
+ {error, timeout} -> ok
+ end,
+ setup_server_connection(LSocket, Test)
+ end.
+
+server_echo(Socket, Size, Loop) when Loop > 0 ->
+ {ok, Msg} = ssl:recv(Socket, Size),
+ ok = ssl:send(Socket, Msg),
+ server_echo(Socket, Size, Loop-1);
+server_echo(_, _, _) -> ok.
+
+setup_connection(N, ssl, Env = {Host, Port, Opts}) when N > 0 ->
+ case ssl:connect(Host, Port, Opts) of
+ {ok, Sock} ->
+ ssl:close(Sock),
+ setup_connection(N-1, ssl, Env);
+ {error, Error} ->
+ io:format("Error: ~p (~p)~n",[Error, length(erlang:ports())]),
+ setup_connection(N, ssl, Env)
+ end;
+setup_connection(_, _, _) ->
+ ok.
+
+payload(Loop, ssl, D = {Socket, Size}) when Loop > 0 ->
+ ok = ssl:send(Socket, msg()),
+ {ok, _} = ssl:recv(Socket, Size),
+ payload(Loop-1, ssl, D);
+payload(_, _, {Socket, _}) ->
+ ssl:close(Socket).
+
+msg() ->
+ <<"Hello",
+ 0:(512*8),
+ "asdlkjsafsdfoierwlejsdlkfjsdf",
+ 1:(512*8),
+ "asdlkjsafsdfoierwlejsdlkfjsdf">>.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+setup(_Type, nonode@nohost) ->
+ exit(dist_not_enabled);
+setup(Type, _This) ->
+ Host = case os:getenv(?remote_host) of
+ false ->
+ {ok, This} = inet:gethostname(),
+ This;
+ RemHost ->
+ RemHost
+ end,
+ Node = list_to_atom("perf_server@" ++ Host),
+ SlaveArgs = case init:get_argument(pa) of
+ {ok, PaPaths} ->
+ lists:append([" -pa " ++ P || [P] <- PaPaths]);
+ _ -> []
+ end,
+ %% io:format("Slave args: ~p~n",[SlaveArgs]),
+ Prog =
+ case os:find_executable("erl") of
+ false -> "erl";
+ P -> P
+ end,
+ io:format("Prog = ~p~n", [Prog]),
+
+ case net_adm:ping(Node) of
+ pong -> ok;
+ pang ->
+ {ok, Node} = slave:start(Host, perf_server, SlaveArgs, no_link, Prog)
+ end,
+ Path = code:get_path(),
+ true = rpc:call(Node, code, set_path, [Path]),
+ ok = rpc:call(Node, ?MODULE, setup_server, [Type, node()]),
+ io:format("Client (~p) using ~s~n",[node(), code:which(ssl)]),
+ (Node =:= node()) andalso restrict_schedulers(client),
+ Node.
+
+setup_server(_Type, ClientNode) ->
+ (ClientNode =:= node()) andalso restrict_schedulers(server),
+ io:format("Server (~p) using ~s~n",[node(), code:which(ssl)]),
+ ok.
+
+
+ensure_all_started(App, Ack) ->
+ case application:start(App) of
+ ok -> {ok, [App|Ack]};
+ {error, {not_started, Dep}} ->
+ {ok, Ack1} = ensure_all_started(Dep, Ack),
+ ensure_all_started(App, Ack1);
+ {error, {already_started, _}} ->
+ {ok, Ack}
+ end.
+
+setup_server_init(Type, Tc, Loop, PC) ->
+ _ = ssl:stop(),
+ {ok, _} = ensure_all_started(ssl, []),
+ Me = self(),
+ Pid = spawn_link(fun() -> server_init(Type, Tc, Loop, PC, Me) end),
+ Res = receive
+ {Pid, {init, Host, Port}} -> {ok, {Pid, Host, Port}};
+ {Pid, Error} -> {error, Error}
+ end,
+ unlink(Pid),
+ Res.
+
+restrict_schedulers(Type) ->
+ %% We expect this to run on 8 core machine
+ Extra0 = 1,
+ Extra = if (Type =:= server) -> -Extra0; true -> Extra0 end,
+ Scheds = erlang:system_info(schedulers),
+ erlang:system_flag(schedulers_online, (Scheds div 2) + Extra).
+
+tc(Fun, Mod, Line) ->
+ case timer:tc(Fun) of
+ {_,{'EXIT',Reason}} ->
+ io:format("Process EXITED ~p:~p \n", [Mod, Line]),
+ exit(Reason);
+ {_T,R={error,_}} ->
+ io:format("Process Error ~p:~p \n", [Mod, Line]),
+ R;
+ {T,R} ->
+ io:format("~p:~p: Time: ~p\n", [Mod, Line, T]),
+ R
+ end.
+
+start_profile(eprof, Procs) ->
+ profiling = eprof:start_profiling(Procs),
+ io:format("(E)Profiling ...",[]);
+start_profile(fprof, Procs) ->
+ fprof:trace([start, {procs, Procs}]),
+ io:format("(F)Profiling ...",[]).
+
+stop_profile(percept, File) ->
+ percept:stop_profile(),
+ percept:analyze(File),
+ {started, _Host, Port} = percept:start_webserver(),
+ wx:new(),
+ wx_misc:launchDefaultBrowser("http://" ++ net_adm:localhost() ++ ":" ++ integer_to_list(Port)),
+ ok;
+stop_profile(eprof, File) ->
+ profiling_stopped = eprof:stop_profiling(),
+ eprof:log(File),
+ io:format(".analysed => ~s ~n",[File]),
+ eprof:analyze(total),
+ eprof:stop();
+stop_profile(fprof, File) ->
+ fprof:trace(stop),
+ io:format("..collect..",[]),
+ fprof:profile(),
+ fprof:analyse([{dest, File},{totals, true}]),
+ io:format(".analysed => ~s ~n",[File]),
+ fprof:stop(),
+ ok.
+
+ssl_opts(listen) ->
+ [{backlog, 500} | ssl_opts("server")];
+ssl_opts(connect) ->
+ [{verify, verify_peer}
+ | ssl_opts("client")];
+ssl_opts(Role) ->
+ Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]),
+ [{active, false},
+ {depth, 2},
+ {reuseaddr, true},
+ {mode,binary},
+ {nodelay, true},
+ {ciphers, [{dhe_rsa,aes_256_cbc,sha}]},
+ {cacertfile, filename:join([Dir, Role, "cacerts.pem"])},
+ {certfile, filename:join([Dir, Role, "cert.pem"])},
+ {keyfile, filename:join([Dir, Role, "key.pem"])}].
diff --git a/lib/ssl/test/ssl_cipher_SUITE.erl b/lib/ssl/test/ssl_cipher_SUITE.erl
index 45e91786d4..f2dc1b52c1 100644
--- a/lib/ssl/test/ssl_cipher_SUITE.erl
+++ b/lib/ssl/test/ssl_cipher_SUITE.erl
@@ -86,9 +86,9 @@ aes_decipher_good(Config) when is_list(Config) ->
Content = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56, "HELLO\n">>,
Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>,
Version = {3,0},
- {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version),
+ {Content, Mac, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version),
Version1 = {3,1},
- {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1),
+ {Content, Mac, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1),
ok.
%%--------------------------------------------------------------------
@@ -110,9 +110,9 @@ aes_decipher_good_tls11(Config) when is_list(Config) ->
NextIV = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>>,
Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>,
Version = {3,2},
- {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version),
+ {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version),
Version1 = {3,2},
- {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1),
+ {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1),
ok.
%%--------------------------------------------------------------------
@@ -130,11 +130,11 @@ aes_decipher_fail(Config) when is_list(Config) ->
198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122,
108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>,
Version = {3,0},
- {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version),
+ {Content, Mac, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version),
32 = byte_size(Content),
32 = byte_size(Mac),
Version1 = {3,1},
- {Content1, Mac1, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1),
+ {Content1, Mac1, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1),
32 = byte_size(Content1),
32 = byte_size(Mac1),
ok.
@@ -156,10 +156,10 @@ aes_decipher_fail_tls11(Config) when is_list(Config) ->
108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>,
Version = {3,2},
#alert{level = ?FATAL, description = ?BAD_RECORD_MAC} =
- ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version),
+ ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version),
Version1 = {3,3},
#alert{level = ?FATAL, description = ?BAD_RECORD_MAC} =
- ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1),
+ ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1),
ok.
%%--------------------------------------------------------------------
diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl
index c31f6c2d7d..06a41f1260 100644
--- a/lib/ssl/test/ssl_session_cache_SUITE.erl
+++ b/lib/ssl/test/ssl_session_cache_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -108,8 +108,12 @@ init_customized_session_cache(Type, Config0) ->
ssl:stop(),
application:load(ssl),
application:set_env(ssl, session_cb, ?MODULE),
- application:set_env(ssl, session_cb_init_args, [Type]),
+ application:set_env(ssl, session_cb_init_args, [{type, Type}]),
ssl:start(),
+ catch (end_per_testcase(list_to_atom("session_cache_process" ++ atom_to_list(Type)),
+ Config)),
+ ets:new(ssl_test, [named_table, public, set]),
+ ets:insert(ssl_test, {type, Type}),
[{watchdog, Dog} | Config].
end_per_testcase(session_cache_process_list, Config) ->
@@ -126,7 +130,11 @@ end_per_testcase(session_cleanup, Config) ->
application:unset_env(ssl, session_delay_cleanup_time),
application:unset_env(ssl, session_lifetime),
end_per_testcase(default_action, Config);
-end_per_testcase(_TestCase, Config) ->
+end_per_testcase(Case, Config) when Case == session_cache_process_list;
+ Case == session_cache_process_mnesia ->
+ ets:delete(ssl_test),
+ Config;
+end_per_testcase(_, Config) ->
Config.
%%--------------------------------------------------------------------
@@ -164,12 +172,13 @@ session_cleanup(Config)when is_list(Config) ->
{status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)),
[_, _,_, _, Prop] = StatusInfo,
State = ssl_test_lib:state(Prop),
- Cache = element(2, State),
- SessionTimer = element(6, State),
+ ClientCache = element(2, State),
+ ServerCache = element(3, State),
+ SessionTimer = element(7, State),
Id = proplists:get_value(session_id, SessionInfo),
- CSession = ssl_session_cache:lookup(Cache, {{Hostname, Port}, Id}),
- SSession = ssl_session_cache:lookup(Cache, {Port, Id}),
+ CSession = ssl_session_cache:lookup(ClientCache, {{Hostname, Port}, Id}),
+ SSession = ssl_session_cache:lookup(ServerCache, {Port, Id}),
true = CSession =/= undefined,
true = SSession =/= undefined,
@@ -185,8 +194,8 @@ session_cleanup(Config)when is_list(Config) ->
ct:sleep(?SLEEP), %% Make sure clean has had time to run
- undefined = ssl_session_cache:lookup(Cache, {{Hostname, Port}, Id}),
- undefined = ssl_session_cache:lookup(Cache, {Port, Id}),
+ undefined = ssl_session_cache:lookup(ClientCache, {{Hostname, Port}, Id}),
+ undefined = ssl_session_cache:lookup(ServerCache, {Port, Id}),
process_flag(trap_exit, false),
ssl_test_lib:close(Server),
@@ -208,7 +217,7 @@ get_delay_timers() ->
{status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)),
[_, _,_, _, Prop] = StatusInfo,
State = ssl_test_lib:state(Prop),
- case element(7, State) of
+ case element(8, State) of
{undefined, undefined} ->
ct:sleep(?SLEEP),
get_delay_timers();
@@ -236,16 +245,16 @@ session_cache_process_mnesia(Config) when is_list(Config) ->
%%% Session cache API callbacks
%%--------------------------------------------------------------------
-init([Type]) ->
- ets:new(ssl_test, [named_table, public, set]),
- ets:insert(ssl_test, {type, Type}),
- case Type of
+init(Opts) ->
+ case proplists:get_value(type, Opts) of
list ->
spawn(fun() -> session_loop([]) end);
mnesia ->
mnesia:start(),
- {atomic,ok} = mnesia:create_table(sess_cache, []),
- sess_cache
+ Name = atom_to_list(proplists:get_value(role, Opts)),
+ TabName = list_to_atom(Name ++ "sess_cache"),
+ {atomic,ok} = mnesia:create_table(TabName, []),
+ TabName
end.
session_cb() ->
@@ -258,7 +267,7 @@ terminate(Cache) ->
Cache ! terminate;
mnesia ->
catch {atomic,ok} =
- mnesia:delete_table(sess_cache)
+ mnesia:delete_table(Cache)
end.
lookup(Cache, Key) ->
@@ -268,10 +277,10 @@ lookup(Cache, Key) ->
receive {Cache, Res} -> Res end;
mnesia ->
case mnesia:transaction(fun() ->
- mnesia:read(sess_cache,
+ mnesia:read(Cache,
Key, read)
end) of
- {atomic, [{sess_cache, Key, Value}]} ->
+ {atomic, [{Cache, Key, Value}]} ->
Value;
_ ->
undefined
@@ -285,8 +294,8 @@ update(Cache, Key, Value) ->
mnesia ->
{atomic, ok} =
mnesia:transaction(fun() ->
- mnesia:write(sess_cache,
- {sess_cache, Key, Value}, write)
+ mnesia:write(Cache,
+ {Cache, Key, Value}, write)
end)
end.
@@ -297,7 +306,7 @@ delete(Cache, Key) ->
mnesia ->
{atomic, ok} =
mnesia:transaction(fun() ->
- mnesia:delete(sess_cache, Key)
+ mnesia:delete(Cache, Key)
end)
end.
@@ -308,7 +317,7 @@ foldl(Fun, Acc, Cache) ->
receive {Cache, Res} -> Res end;
mnesia ->
Foldl = fun() ->
- mnesia:foldl(Fun, Acc, sess_cache)
+ mnesia:foldl(Fun, Acc, Cache)
end,
{atomic, Res} = mnesia:transaction(Foldl),
Res
@@ -325,7 +334,7 @@ select_session(Cache, PartialKey) ->
mnesia ->
Sel = fun() ->
mnesia:select(Cache,
- [{{sess_cache,{PartialKey,'$1'}, '$2'},
+ [{{Cache,{PartialKey,'$1'}, '$2'},
[],['$$']}])
end,
{atomic, Res} = mnesia:transaction(Sel),
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index 74d71263de..d2e6e41482 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -811,48 +811,34 @@ openssl_rsa_suites(CounterPart) ->
false ->
"DSS | ECDHE | ECDH"
end,
- lists:filter(fun(Str) ->
- case re:run(Str, Names,[]) of
- nomatch ->
- false;
- _ ->
- true
- end
- end, Ciphers).
+ lists:filter(fun(Str) -> string_regex_filter(Str, Names)
+ end, Ciphers).
openssl_dsa_suites() ->
Ciphers = ssl:cipher_suites(openssl),
- lists:filter(fun(Str) ->
- case re:run(Str,"DSS",[]) of
- nomatch ->
- false;
- _ ->
- true
- end
+ lists:filter(fun(Str) -> string_regex_filter(Str, "DSS")
end, Ciphers).
openssl_ecdsa_suites() ->
Ciphers = ssl:cipher_suites(openssl),
- lists:filter(fun(Str) ->
- case re:run(Str,"ECDHE-ECDSA",[]) of
- nomatch ->
- false;
- _ ->
- true
- end
+ lists:filter(fun(Str) -> string_regex_filter(Str, "ECDHE-ECDSA")
end, Ciphers).
openssl_ecdh_rsa_suites() ->
Ciphers = ssl:cipher_suites(openssl),
- lists:filter(fun(Str) ->
- case re:run(Str,"ECDH-RSA",[]) of
- nomatch ->
- false;
- _ ->
- true
- end
+ lists:filter(fun(Str) -> string_regex_filter(Str, "ECDH-RSA")
end, Ciphers).
+string_regex_filter(Str, Search) when is_list(Str) ->
+ case re:run(Str, Search, []) of
+ nomatch ->
+ false;
+ _ ->
+ true
+ end;
+string_regex_filter(Str, _Search) ->
+ false.
+
anonymous_suites() ->
Suites =
[{dh_anon, rc4_128, md5},
@@ -860,6 +846,8 @@ anonymous_suites() ->
{dh_anon, '3des_ede_cbc', sha},
{dh_anon, aes_128_cbc, sha},
{dh_anon, aes_256_cbc, sha},
+ {dh_anon, aes_128_gcm, null},
+ {dh_anon, aes_256_gcm, null},
{ecdh_anon,rc4_128,sha},
{ecdh_anon,'3des_ede_cbc',sha},
{ecdh_anon,aes_128_cbc,sha},
@@ -885,8 +873,13 @@ psk_suites() ->
{rsa_psk, aes_128_cbc, sha},
{rsa_psk, aes_256_cbc, sha},
{rsa_psk, aes_128_cbc, sha256},
- {rsa_psk, aes_256_cbc, sha384}
-],
+ {rsa_psk, aes_256_cbc, sha384},
+ {psk, aes_128_gcm, null},
+ {psk, aes_256_gcm, null},
+ {dhe_psk, aes_128_gcm, null},
+ {dhe_psk, aes_256_gcm, null},
+ {rsa_psk, aes_128_gcm, null},
+ {rsa_psk, aes_256_gcm, null}],
ssl_cipher:filter_suites(Suites).
psk_anon_suites() ->
@@ -1130,7 +1123,7 @@ version_flag(sslv3) ->
filter_suites(Ciphers0) ->
Version = tls_record:highest_protocol_version([]),
Supported0 = ssl_cipher:suites(Version)
- ++ ssl_cipher:anonymous_suites()
+ ++ ssl_cipher:anonymous_suites(Version)
++ ssl_cipher:psk_suites(Version)
++ ssl_cipher:srp_suites(),
Supported1 = ssl_cipher:filter_suites(Supported0),
diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile
index ff77c3eea0..f5d8b2072a 100644
--- a/lib/stdlib/doc/src/Makefile
+++ b/lib/stdlib/doc/src/Makefile
@@ -76,7 +76,6 @@ XML_REF3_FILES = \
ms_transform.xml \
orddict.xml \
ordsets.xml \
- pg.xml \
pool.xml \
proc_lib.xml \
proplists.xml \
diff --git a/lib/stdlib/doc/src/binary.xml b/lib/stdlib/doc/src/binary.xml
index 2410f1f9b8..0fde763bfb 100644
--- a/lib/stdlib/doc/src/binary.xml
+++ b/lib/stdlib/doc/src/binary.xml
@@ -5,7 +5,7 @@
<header>
<copyright>
<year>2009</year>
- <year>2013</year>
+ <year>2014</year>
<holder>Ericsson AB, All Rights Reserved</holder>
</copyright>
<legalnotice>
@@ -450,7 +450,7 @@ store(Binary, GBSet) ->
</code>
<p>In this example, we chose to copy the binary content before
- inserting it in the <c>gb_set()</c> if it references a binary more than
+ inserting it in the <c>gb_sets:set()</c> if it references a binary more than
twice the size of the data we're going to keep. Of course
different rules for when copying will apply to different
programs.</p>
diff --git a/lib/stdlib/doc/src/gen_event.xml b/lib/stdlib/doc/src/gen_event.xml
index b9dfff833e..5c96d6e576 100644
--- a/lib/stdlib/doc/src/gen_event.xml
+++ b/lib/stdlib/doc/src/gen_event.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2013</year>
+ <year>1996</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -44,6 +44,7 @@
<pre>
gen_event module Callback module
---------------- ---------------
+gen_event:start
gen_event:start_link -----> -
gen_event:add_handler
@@ -177,7 +178,7 @@ gen_event:stop -----> Module:terminate/2
<name>add_handler(EventMgrRef, Handler, Args) -> Result</name>
<fsummary>Add an event handler to a generic event manager.</fsummary>
<type>
- <v>EventMgr = Name | {Name,Node} | {global,GlobalName}
+ <v>EventMgrRef = Name | {Name,Node} | {global,GlobalName}
| {via,Module,ViaName} | pid()</v>
<v>&nbsp;Name = Node = atom()</v>
<v>&nbsp;GlobalName = ViaName = term()</v>
@@ -223,7 +224,7 @@ gen_event:stop -----> Module:terminate/2
<name>add_sup_handler(EventMgrRef, Handler, Args) -> Result</name>
<fsummary>Add a supervised event handler to a generic event manager.</fsummary>
<type>
- <v>EventMgr = Name | {Name,Node} | {global,GlobalName}
+ <v>EventMgrRef = Name | {Name,Node} | {global,GlobalName}
| {via,Module,ViaName} | pid()</v>
<v>&nbsp;Name = Node = atom()</v>
<v>&nbsp;GlobalName = ViaName = term()</v>
@@ -456,19 +457,37 @@ gen_event:stop -----> Module:terminate/2
</func>
<func>
<name>stop(EventMgrRef) -> ok</name>
+ <name>stop(EventMgrRef, Reason, Timeout) -> ok</name>
<fsummary>Terminate a generic event manager.</fsummary>
<type>
<v>EventMgrRef = Name | {Name,Node} | {global,GlobalName}
| {via,Module,ViaName} | pid()</v>
<v>Name = Node = atom()</v>
<v>GlobalName = ViaName = term()</v>
+ <v>Reason = term()</v>
+ <v>Timeout = int()>0 | infinity</v>
</type>
<desc>
- <p>Terminates the event manager <c>EventMgrRef</c>. Before
- terminating, the event manager will call
- <c>Module:terminate(stop,...)</c> for each installed event
- handler.</p>
- <p>See <c>add_handler/3</c> for a description of the argument.</p>
+ <p>Orders the event manager <c>EventMgrRef</c> to exit with
+ the given <c>Reason</c> and waits for it to
+ terminate. Before terminating, the gen_event will call
+ <seealso marker="#Module:terminate/2">Module:terminate(stop,...)</seealso>
+ for each installed event handler.</p>
+ <p>The function returns <c>ok</c> if the event manager terminates
+ with the expected reason. Any other reason than <c>normal</c>,
+ <c>shutdown</c>, or <c>{shutdown,Term}</c> will cause an
+ error report to be issued using
+ <seealso marker="kernel:error_logger#format/2">error_logger:format/2</seealso>.
+ The default <c>Reason</c> is <c>normal</c>.</p>
+ <p><c>Timeout</c> is an integer greater than zero which
+ specifies how many milliseconds to wait for the event manager to
+ terminate, or the atom <c>infinity</c> to wait
+ indefinitely. The default value is <c>infinity</c>. If the
+ event manager has not terminated within the specified time, a
+ <c>timeout</c> exception is raised.</p>
+ <p>If the process does not exist, a <c>noproc</c> exception
+ is raised.</p>
+ <p>See <c>add_handler/3</c> for a description of <c>EventMgrRef</c>.</p>
</desc>
</func>
</funcs>
diff --git a/lib/stdlib/doc/src/gen_fsm.xml b/lib/stdlib/doc/src/gen_fsm.xml
index 848d57f3e6..b1bba3eff0 100644
--- a/lib/stdlib/doc/src/gen_fsm.xml
+++ b/lib/stdlib/doc/src/gen_fsm.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2013</year>
+ <year>1996</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -43,8 +43,11 @@
<pre>
gen_fsm module Callback module
-------------- ---------------
+gen_fsm:start
gen_fsm:start_link -----> Module:init/1
+gen_fsm:stop -----> Module:terminate/3
+
gen_fsm:send_event -----> Module:StateName/2
gen_fsm:send_all_state_event -----> Module:handle_event/3
@@ -187,6 +190,39 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4
</desc>
</func>
<func>
+ <name>stop(FsmRef) -> ok</name>
+ <name>stop(FsmRef, Reason, Timeout) -> ok</name>
+ <fsummary>Synchronously stop a generic FSM.</fsummary>
+ <type>
+ <v>FsmRef = Name | {Name,Node} | {global,GlobalName}
+ | {via,Module,ViaName} | pid()</v>
+ <v>&nbsp;Node = atom()</v>
+ <v>&nbsp;GlobalName = ViaName = term()</v>
+ <v>Reason = term()</v>
+ <v>Timeout = int()>0 | infinity</v>
+ </type>
+ <desc>
+ <p>Orders a generic FSM to exit with the given <c>Reason</c>
+ and waits for it to terminate. The gen_fsm will call
+ <seealso marker="#Module:terminate/3">Module:terminate/3</seealso>
+ before exiting.</p>
+ <p>The function returns <c>ok</c> if the generic FSM terminates
+ with the expected reason. Any other reason than <c>normal</c>,
+ <c>shutdown</c>, or <c>{shutdown,Term}</c> will cause an
+ error report to be issued using
+ <seealso marker="kernel:error_logger#format/2">error_logger:format/2</seealso>.
+ The default <c>Reason</c> is <c>normal</c>.</p>
+ <p><c>Timeout</c> is an integer greater than zero which
+ specifies how many milliseconds to wait for the generic FSM
+ to terminate, or the atom <c>infinity</c> to wait
+ indefinitely. The default value is <c>infinity</c>. If the
+ generic FSM has not terminated within the specified time, a
+ <c>timeout</c> exception is raised.</p>
+ <p>If the process does not exist, a <c>noproc</c> exception
+ is raised.</p>
+ </desc>
+ </func>
+ <func>
<name>send_event(FsmRef, Event) -> ok</name>
<fsummary>Send an event asynchronously to a generic FSM.</fsummary>
<type>
@@ -528,7 +564,8 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4
<c>Module:init/1</c> for a description of <c>Timeout</c> and <c>hibernate</c>.</p>
<p>If the function returns <c>{stop,Reason,NewStateData}</c>,
the gen_fsm will call
- <c>Module:terminate(Reason,NewStateData)</c> and terminate.</p>
+ <c>Module:terminate(Reason,StateName,NewStateData)</c> and
+ terminate.</p>
</desc>
</func>
<func>
@@ -614,7 +651,8 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4
<c>{stop,Reason,NewStateData}</c>, any reply to <c>From</c>
must be given explicitly using <c>gen_fsm:reply/2</c>.
The gen_fsm will then call
- <c>Module:terminate(Reason,NewStateData)</c> and terminate.</p>
+ <c>Module:terminate(Reason,StateName,NewStateData)</c> and
+ terminate.</p>
</desc>
</func>
<func>
diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml
index 62c0394479..a915e567a5 100644
--- a/lib/stdlib/doc/src/gen_server.xml
+++ b/lib/stdlib/doc/src/gen_server.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2013</year>
+ <year>1996</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -43,8 +43,11 @@
<pre>
gen_server module Callback module
----------------- ---------------
+gen_server:start
gen_server:start_link -----> Module:init/1
+gen_server:stop -----> Module:terminate/2
+
gen_server:call
gen_server:multi_call -----> Module:handle_call/3
@@ -184,6 +187,40 @@ gen_server:abcast -----> Module:handle_cast/2
</desc>
</func>
<func>
+ <name>stop(ServerRef) -> ok</name>
+ <name>stop(ServerRef, Reason, Timeout) -> ok</name>
+ <fsummary>Synchronously stop a generic server.</fsummary>
+ <type>
+ <v>ServerRef = Name | {Name,Node} | {global,GlobalName}
+ | {via,Module,ViaName} | pid()</v>
+ <v>&nbsp;Node = atom()</v>
+ <v>&nbsp;GlobalName = ViaName = term()</v>
+ <v>Reason = term()</v>
+ <v>Timeout = int()>0 | infinity</v>
+ </type>
+ <desc>
+ <p>Orders a generic server to exit with the
+ given <c>Reason</c> and waits for it to terminate. The
+ gen_server will call
+ <seealso marker="#Module:terminate/2">Module:terminate/2</seealso>
+ before exiting.</p>
+ <p>The function returns <c>ok</c> if the server terminates
+ with the expected reason. Any other reason than <c>normal</c>,
+ <c>shutdown</c>, or <c>{shutdown,Term}</c> will cause an
+ error report to be issued using
+ <seealso marker="kernel:error_logger#format/2">error_logger:format/2</seealso>.
+ The default <c>Reason</c> is <c>normal</c>.</p>
+ <p><c>Timeout</c> is an integer greater than zero which
+ specifies how many milliseconds to wait for the server to
+ terminate, or the atom <c>infinity</c> to wait
+ indefinitely. The default value is <c>infinity</c>. If the
+ server has not terminated within the specified time, a
+ <c>timeout</c> exception is raised.</p>
+ <p>If the process does not exist, a <c>noproc</c> exception
+ is raised.</p>
+ </desc>
+ </func>
+ <func>
<name>call(ServerRef, Request) -> Reply</name>
<name>call(ServerRef, Request, Timeout) -> Reply</name>
<fsummary>Make a synchronous call to a generic server.</fsummary>
diff --git a/lib/stdlib/doc/src/pg.xml b/lib/stdlib/doc/src/pg.xml
deleted file mode 100644
index a3b69884b6..0000000000
--- a/lib/stdlib/doc/src/pg.xml
+++ /dev/null
@@ -1,114 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-
-<erlref>
- <header>
- <copyright>
- <year>1996</year>
- <year>2014</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- The contents of this file are subject to the Erlang Public License,
- Version 1.1, (the "License"); you may not use this file except in
- compliance with the License. You should have received a copy of the
- Erlang Public License along with this software. If not, it can be
- retrieved online at http://www.erlang.org/.
-
- Software distributed under the License is distributed on an "AS IS"
- basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
- the License for the specific language governing rights and limitations
- under the License.
-
- The Initial Developer of the Original Code is Ericsson AB.
- </legalnotice>
-
- <title>pg</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <module>pg</module>
- <modulesummary>Distributed, Named Process Groups</modulesummary>
- <description>
- <warning>
- <p>This module is deprecated and will be removed in Erlang/OTP 18.</p>
- </warning>
- <p>This (experimental) module implements process groups. A process
- group is a group of processes that can be accessed by a common
- name. For example, a group named <c>foobar</c> can include a set
- of processes as members of this group and they can be located on
- different nodes.</p>
- <p>When messages are sent to the named group, all members of
- the group receive the message. The messages are serialized. If
- the process <c>P1</c> sends the message <c>M1</c> to the group,
- and process <c>P2</c> simultaneously sends message <c>M2</c>, then
- all members of the group receive the two messages in the same
- order. If members of a group terminate, they are automatically
- removed from the group.</p>
- <p>This module is not complete. The module is inspired by the ISIS
- system and the causal order protocol of the ISIS system should
- also be implemented. At the moment, all messages are serialized
- by sending them through a group master process.</p>
- </description>
- <funcs>
- <func>
- <name name="create" arity="1"/>
- <fsummary>Create an empty group</fsummary>
- <desc>
- <p>Creates an empty group named <c><anno>PgName</anno></c> on the current
- node.</p>
- </desc>
- </func>
- <func>
- <name name="create" arity="2"/>
- <fsummary>Create an empty group on another node</fsummary>
- <desc>
- <p>Creates an empty group named <c><anno>PgName</anno></c> on the node
- <c><anno>Node</anno></c>.</p>
- </desc>
- </func>
- <func>
- <name name="join" arity="2"/>
- <fsummary>Join a pid to a process group</fsummary>
- <desc>
- <p>Joins the pid <c><anno>Pid</anno></c> to the process group
- <c><anno>PgName</anno></c>.
- Returns a list of all old members of the group.</p>
- </desc>
- </func>
- <func>
- <name name="send" arity="2"/>
- <fsummary>Send a message to all members of a process group</fsummary>
- <desc>
- <p>Sends the tuple <c>{pg_message, From, PgName, Msg}</c> to
- all members of the process group <c><anno>PgName</anno></c>.</p>
- <p>Failure: <c>{badarg, {<anno>PgName</anno>, <anno>Msg</anno>}}</c>
- if <c><anno>PgName</anno></c> is
- not a process group (a globally registered name).</p>
- </desc>
- </func>
- <func>
- <name name="esend" arity="2"/>
- <fsummary>Send a message to all members of a process group, except ourselves</fsummary>
- <desc>
- <p>Sends the tuple <c>{pg_message, From, PgName, Msg}</c> to
- all members of the process group <c><anno>PgName</anno></c>, except
- ourselves.</p>
- <p>Failure: <c>{badarg, {<anno>PgName</anno>, <anno>Msg</anno>}}</c>
- if <c><anno>PgName</anno></c> is
- not a process group (a globally registered name).</p>
- </desc>
- </func>
- <func>
- <name name="members" arity="1"/>
- <fsummary>Return a list of all members of a process group</fsummary>
- <desc>
- <p>Returns a list of all members of the process group
- <c>PgName</c>.</p>
- </desc>
- </func>
- </funcs>
-</erlref>
-
diff --git a/lib/stdlib/doc/src/proc_lib.xml b/lib/stdlib/doc/src/proc_lib.xml
index 5bf5744622..f27a974242 100644
--- a/lib/stdlib/doc/src/proc_lib.xml
+++ b/lib/stdlib/doc/src/proc_lib.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2013</year>
+ <year>1996</year><year>2014</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -298,6 +298,40 @@ init(Parent) ->
<c>proc_lib</c> functions.</p>
</desc>
</func>
+ <func>
+ <name name="stop" arity="1"/>
+ <fsummary>Terminate a process synchronously.</fsummary>
+ <type variable="Process"/>
+ <desc>
+ <p>Equivalent to <seealso marker="#stop/3">stop(Process,
+ normal, infinity)</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="stop" arity="3"/>
+ <fsummary>Terminate a process synchronously.</fsummary>
+ <type variable="Process"/>
+ <type variable="Reason"/>
+ <type variable="Timeout"/>
+ <desc>
+ <p>Orders the process to exit with the given <c>Reason</c> and
+ waits for it to terminate.</p>
+ <p>The function returns <c>ok</c> if the process exits with
+ the given <c>Reason</c> within <c>Timeout</c>
+ milliseconds.</p>
+ <p>If the call times out, a <c>timeout</c> exception is
+ raised.</p>
+ <p>If the process does not exist, a <c>noproc</c>
+ exception is raised.</p>
+ <p>The implementation of this function is based on the
+ <c>terminate</c> system message, and requires that the
+ process handles system messages correctly.
+ See <seealso marker="sys">sys(3)</seealso>
+ and <seealso marker="doc/design_principles:spec_proc">OTP
+ Design Principles</seealso> for information about system
+ messages.</p>
+ </desc>
+ </func>
</funcs>
<section>
diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml
index 6c35578bdf..ea4009dc3e 100644
--- a/lib/stdlib/doc/src/ref_man.xml
+++ b/lib/stdlib/doc/src/ref_man.xml
@@ -73,7 +73,6 @@
<xi:include href="ms_transform.xml"/>
<xi:include href="orddict.xml"/>
<xi:include href="ordsets.xml"/>
- <xi:include href="pg.xml"/>
<xi:include href="pool.xml"/>
<xi:include href="proc_lib.xml"/>
<xi:include href="proplists.xml"/>
diff --git a/lib/stdlib/doc/src/specs.xml b/lib/stdlib/doc/src/specs.xml
index 60a04ed5e7..fd77b52da6 100644
--- a/lib/stdlib/doc/src/specs.xml
+++ b/lib/stdlib/doc/src/specs.xml
@@ -39,7 +39,6 @@
<xi:include href="../specs/specs_ms_transform.xml"/>
<xi:include href="../specs/specs_orddict.xml"/>
<xi:include href="../specs/specs_ordsets.xml"/>
- <xi:include href="../specs/specs_pg.xml"/>
<xi:include href="../specs/specs_pool.xml"/>
<xi:include href="../specs/specs_proc_lib.xml"/>
<xi:include href="../specs/specs_proplists.xml"/>
diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml
index 19605f325b..cf7df54d1d 100644
--- a/lib/stdlib/doc/src/sys.xml
+++ b/lib/stdlib/doc/src/sys.xml
@@ -359,6 +359,17 @@
installed.</p>
</desc>
</func>
+ <func>
+ <name name="terminate" arity="2"/>
+ <name name="terminate" arity="3"/>
+ <fsummary>Terminate the process</fsummary>
+ <desc>
+ <p>This function orders the process to terminate with the
+ given <c><anno>Reason</anno></c>. The termination is done
+ asynchronously, so there is no guarantee that the process is
+ actually terminated when the function returns.</p>
+ </desc>
+ </func>
</funcs>
<section>
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile
index 9ab2cd4134..1b3744b6fb 100644
--- a/lib/stdlib/src/Makefile
+++ b/lib/stdlib/src/Makefile
@@ -97,7 +97,6 @@ MODULES= \
otp_internal \
orddict \
ordsets \
- pg \
re \
pool \
proc_lib \
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index 639ddfc214..371573dc23 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -1172,7 +1172,7 @@ match_tuple([], _, _, Bs, _BBs) ->
match_map([{map_field_exact, _, K, V}|Fs], Map, Bs0, BBs) ->
Vm = try
- {value, Ke, _} = expr(K, new_bindings()),
+ {value, Ke, _} = expr(K, Bs0),
maps:get(Ke,Map)
catch error:_ ->
throw(nomatch)
diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl
index edfb097de0..2bf8b86c23 100644
--- a/lib/stdlib/src/erl_internal.erl
+++ b/lib/stdlib/src/erl_internal.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -51,6 +51,8 @@
type_test/2,new_type_test/2,old_type_test/2,old_bif/2]).
-export([arith_op/2,bool_op/2,comp_op/2,list_op/2,send_op/2,op_type/2]).
+-export([is_type/2]).
+
%%---------------------------------------------------------------------------
%% Erlang builtin functions allowed in guards.
@@ -293,6 +295,7 @@ bif(garbage_collect, 1) -> true;
bif(garbage_collect, 2) -> true;
bif(get, 0) -> true;
bif(get, 1) -> true;
+bif(get_keys, 0) -> true;
bif(get_keys, 1) -> true;
bif(group_leader, 0) -> true;
bif(group_leader, 2) -> true;
@@ -530,3 +533,53 @@ old_bif(unlink, 1) -> true;
old_bif(unregister, 1) -> true;
old_bif(whereis, 1) -> true;
old_bif(Name, A) when is_atom(Name), is_integer(A) -> false.
+
+-spec is_type(Name, NumberOfTypeVariables) -> boolean() when
+ Name :: atom(),
+ NumberOfTypeVariables :: non_neg_integer().
+%% Returns true if Name/NumberOfTypeVariables is a predefined type.
+
+is_type(any, 0) -> true;
+is_type(arity, 0) -> true;
+is_type(atom, 0) -> true;
+is_type(binary, 0) -> true;
+is_type(bitstring, 0) -> true;
+is_type(bool, 0) -> true;
+is_type(boolean, 0) -> true;
+is_type(byte, 0) -> true;
+is_type(char, 0) -> true;
+is_type(float, 0) -> true;
+is_type(function, 0) -> true;
+is_type(identifier, 0) -> true;
+is_type(integer, 0) -> true;
+is_type(iodata, 0) -> true;
+is_type(iolist, 0) -> true;
+is_type(list, 0) -> true;
+is_type(list, 1) -> true;
+is_type(map, 0) -> true;
+is_type(maybe_improper_list, 0) -> true;
+is_type(maybe_improper_list, 2) -> true;
+is_type(mfa, 0) -> true;
+is_type(module, 0) -> true;
+is_type(neg_integer, 0) -> true;
+is_type(nil, 0) -> true;
+is_type(no_return, 0) -> true;
+is_type(node, 0) -> true;
+is_type(non_neg_integer, 0) -> true;
+is_type(none, 0) -> true;
+is_type(nonempty_improper_list, 2) -> true;
+is_type(nonempty_list, 0) -> true;
+is_type(nonempty_list, 1) -> true;
+is_type(nonempty_maybe_improper_list, 0) -> true;
+is_type(nonempty_maybe_improper_list, 2) -> true;
+is_type(nonempty_string, 0) -> true;
+is_type(number, 0) -> true;
+is_type(pid, 0) -> true;
+is_type(port, 0) -> true;
+is_type(pos_integer, 0) -> true;
+is_type(reference, 0) -> true;
+is_type(string, 0) -> true;
+is_type(term, 0) -> true;
+is_type(timeout, 0) -> true;
+is_type(tuple, 0) -> true;
+is_type(_, _) -> false.
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index 39cc03cf7a..39f8a26fe1 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -130,6 +130,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) ->
:: dict:dict(mfa(), line()),
callbacks = dict:new() %Callback types
:: dict:dict(mfa(), line()),
+ optional_callbacks = dict:new() %Optional callbacks
+ :: dict:dict(mfa(), line()),
types = dict:new() %Type definitions
:: dict:dict(ta(), #typeinfo{}),
exp_types=gb_sets:empty() %Exported types
@@ -237,10 +239,7 @@ format_error({too_many_arguments,Arity}) ->
"maximum allowed is ~w", [Arity,?MAX_ARGUMENTS]);
%% --- patterns and guards ---
format_error(illegal_pattern) -> "illegal pattern";
-format_error(illegal_map_key) ->
- "illegal map key";
-format_error({illegal_map_key_variable,K}) ->
- io_lib:format("illegal use of variable ~w in map",[K]);
+format_error(illegal_map_key) -> "illegal map key in pattern";
format_error(illegal_bin_pattern) ->
"binary patterns cannot be matched in parallel using '='";
format_error(illegal_expr) -> "illegal expression";
@@ -313,13 +312,20 @@ format_error({undefined_behaviour,Behaviour}) ->
io_lib:format("behaviour ~w undefined", [Behaviour]);
format_error({undefined_behaviour_callbacks,Behaviour}) ->
io_lib:format("behaviour ~w callback functions are undefined",
- [Behaviour]);
+ [Behaviour]);
format_error({ill_defined_behaviour_callbacks,Behaviour}) ->
io_lib:format("behaviour ~w callback functions erroneously defined",
[Behaviour]);
+format_error({ill_defined_optional_callbacks,Behaviour}) ->
+ io_lib:format("behaviour ~w optional callback functions erroneously defined",
+ [Behaviour]);
format_error({behaviour_info, {_M,F,A}}) ->
io_lib:format("cannot define callback attibute for ~w/~w when "
"behaviour_info is defined",[F,A]);
+format_error({redefine_optional_callback, {F, A}}) ->
+ io_lib:format("optional callback ~w/~w duplicated", [F, A]);
+format_error({undefined_callback, {_M, F, A}}) ->
+ io_lib:format("callback ~w/~w is undefined", [F, A]);
%% --- types and specs ---
format_error({singleton_typevar, Name}) ->
io_lib:format("type variable ~w is only used once (is unbound)", [Name]);
@@ -331,14 +337,10 @@ format_error({undefined_type, {TypeName, Arity}}) ->
io_lib:format("type ~w~s undefined", [TypeName, gen_type_paren(Arity)]);
format_error({unused_type, {TypeName, Arity}}) ->
io_lib:format("type ~w~s is unused", [TypeName, gen_type_paren(Arity)]);
-%% format_error({new_builtin_type, {TypeName, Arity}}) ->
-%% io_lib:format("type ~w~s is a new builtin type; "
-%% "its (re)definition is allowed only until the next release",
-%% [TypeName, gen_type_paren(Arity)]);
-format_error({new_var_arity_type, TypeName}) ->
- io_lib:format("type ~w is a new builtin type; "
+format_error({new_builtin_type, {TypeName, Arity}}) ->
+ io_lib:format("type ~w~s is a new builtin type; "
"its (re)definition is allowed only until the next release",
- [TypeName]);
+ [TypeName, gen_type_paren(Arity)]);
format_error({builtin_type, {TypeName, Arity}}) ->
io_lib:format("type ~w~s is a builtin type; it cannot be redefined",
[TypeName, gen_type_paren(Arity)]);
@@ -352,10 +354,14 @@ format_error({type_syntax, Constr}) ->
io_lib:format("bad ~w type", [Constr]);
format_error({redefine_spec, {M, F, A}}) ->
io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]);
-format_error({redefine_callback, {M, F, A}}) ->
- io_lib:format("callback ~w:~w/~w already defined", [M, F, A]);
-format_error({spec_fun_undefined, {M, F, A}}) ->
- io_lib:format("spec for undefined function ~w:~w/~w", [M, F, A]);
+format_error({redefine_spec, {F, A}}) ->
+ io_lib:format("spec for ~w/~w already defined", [F, A]);
+format_error({redefine_callback, {F, A}}) ->
+ io_lib:format("callback ~w/~w already defined", [F, A]);
+format_error({bad_callback, {M, F, A}}) ->
+ io_lib:format("explicit module not allowed for callback ~w:~w/~w ", [M, F, A]);
+format_error({spec_fun_undefined, {F, A}}) ->
+ io_lib:format("spec for undefined function ~w/~w", [F, A]);
format_error({missing_spec, {F,A}}) ->
io_lib:format("missing specification for function ~w/~w", [F, A]);
format_error(spec_wrong_arity) ->
@@ -727,6 +733,8 @@ attribute_state({attribute,L,spec,{Fun,Types}}, St) ->
spec_decl(L, Fun, Types, St);
attribute_state({attribute,L,callback,{Fun,Types}}, St) ->
callback_decl(L, Fun, Types, St);
+attribute_state({attribute,L,optional_callbacks,Es}, St) ->
+ optional_callbacks(L, Es, St);
attribute_state({attribute,L,on_load,Val}, St) ->
on_load(L, Val, St);
attribute_state({attribute,_L,_Other,_Val}, St) -> % Ignore others
@@ -834,57 +842,73 @@ check_behaviour(St0) ->
%% Check behaviours for existence and defined functions.
behaviour_check(Bs, St0) ->
- {AllBfs,St1} = all_behaviour_callbacks(Bs, [], St0),
- St = behaviour_missing_callbacks(AllBfs, St1),
+ {AllBfs0, St1} = all_behaviour_callbacks(Bs, [], St0),
+ St = behaviour_missing_callbacks(AllBfs0, St1),
+ Exports = exports(St0),
+ F = fun(Bfs, OBfs) ->
+ [B || B <- Bfs,
+ not lists:member(B, OBfs)
+ orelse gb_sets:is_member(B, Exports)]
+ end,
+ %% After fixing missing callbacks new warnings may be emitted.
+ AllBfs = [{Item,F(Bfs0, OBfs0)} || {Item,Bfs0,OBfs0} <- AllBfs0],
behaviour_conflicting(AllBfs, St).
all_behaviour_callbacks([{Line,B}|Bs], Acc, St0) ->
- {Bfs0,St} = behaviour_callbacks(Line, B, St0),
- all_behaviour_callbacks(Bs, [{{Line,B},Bfs0}|Acc], St);
+ {Bfs0,OBfs0,St} = behaviour_callbacks(Line, B, St0),
+ all_behaviour_callbacks(Bs, [{{Line,B},Bfs0,OBfs0}|Acc], St);
all_behaviour_callbacks([], Acc, St) -> {reverse(Acc),St}.
behaviour_callbacks(Line, B, St0) ->
try B:behaviour_info(callbacks) of
- Funcs when is_list(Funcs) ->
- All = all(fun({FuncName, Arity}) ->
- is_atom(FuncName) andalso is_integer(Arity);
- ({FuncName, Arity, Spec}) ->
- is_atom(FuncName) andalso is_integer(Arity)
- andalso is_list(Spec);
- (_Other) ->
- false
- end,
- Funcs),
- MaybeRemoveSpec = fun({_F,_A}=FA) -> FA;
- ({F,A,_S}) -> {F,A};
- (Other) -> Other
- end,
- if
- All =:= true ->
- {[MaybeRemoveSpec(F) || F <- Funcs], St0};
+ undefined ->
+ St1 = add_warning(Line, {undefined_behaviour_callbacks, B}, St0),
+ {[], [], St1};
+ Funcs ->
+ case is_fa_list(Funcs) of
true ->
+ try B:behaviour_info(optional_callbacks) of
+ undefined ->
+ {Funcs, [], St0};
+ OptFuncs ->
+ %% OptFuncs should always be OK thanks to
+ %% sys_pre_expand.
+ case is_fa_list(OptFuncs) of
+ true ->
+ {Funcs, OptFuncs, St0};
+ false ->
+ W = {ill_defined_optional_callbacks, B},
+ St1 = add_warning(Line, W, St0),
+ {Funcs, [], St1}
+ end
+ catch
+ _:_ ->
+ {Funcs, [], St0}
+ end;
+ false ->
St1 = add_warning(Line,
- {ill_defined_behaviour_callbacks,B},
+ {ill_defined_behaviour_callbacks, B},
St0),
- {[], St1}
- end;
- undefined ->
- St1 = add_warning(Line, {undefined_behaviour_callbacks,B}, St0),
- {[], St1};
- _Other ->
- St1 = add_warning(Line, {ill_defined_behaviour_callbacks,B}, St0),
- {[], St1}
+ {[], [], St1}
+ end
catch
_:_ ->
- St1 = add_warning(Line, {undefined_behaviour,B}, St0),
- {[], St1}
+ St1 = add_warning(Line, {undefined_behaviour, B}, St0),
+ {[], [], St1}
end.
-behaviour_missing_callbacks([{{Line,B},Bfs}|T], St0) ->
+behaviour_missing_callbacks([{{Line,B},Bfs0,OBfs}|T], St0) ->
+ Bfs = ordsets:subtract(ordsets:from_list(Bfs0), ordsets:from_list(OBfs)),
Exports = gb_sets:to_list(exports(St0)),
- Missing = ordsets:subtract(ordsets:from_list(Bfs), Exports),
+ Missing = ordsets:subtract(Bfs, Exports),
St = foldl(fun (F, S0) ->
- add_warning(Line, {undefined_behaviour_func,F,B}, S0)
+ case is_fa(F) of
+ true ->
+ M = {undefined_behaviour_func,F,B},
+ add_warning(Line, M, S0);
+ false ->
+ S0 % ill_defined_behaviour_callbacks
+ end
end, St0, Missing),
behaviour_missing_callbacks(T, St);
behaviour_missing_callbacks([], St) -> St.
@@ -1046,10 +1070,9 @@ check_undefined_types(#lint{usage=Usage,types=Def}=St0) ->
Used = Usage#usage.used_types,
UTAs = dict:fetch_keys(Used),
Undef = [{TA,dict:fetch(TA, Used)} ||
- {T,_}=TA <- UTAs,
+ TA <- UTAs,
not dict:is_key(TA, Def),
- not is_default_type(TA),
- not is_newly_introduced_var_arity_type(T)],
+ not is_default_type(TA)],
foldl(fun ({TA,L}, St) ->
add_error(L, {undefined_type,TA}, St)
end, St0, Undef).
@@ -1127,19 +1150,29 @@ check_unused_records(Forms, St0) ->
end.
check_callback_information(#lint{callbacks = Callbacks,
- defined = Defined} = State) ->
- case gb_sets:is_member({behaviour_info,1}, Defined) of
- false -> State;
+ optional_callbacks = OptionalCbs,
+ defined = Defined} = St0) ->
+ OptFun = fun({MFA, Line}, St) ->
+ case dict:is_key(MFA, Callbacks) of
+ true ->
+ St;
+ false ->
+ add_error(Line, {undefined_callback, MFA}, St)
+ end
+ end,
+ St1 = lists:foldl(OptFun, St0, dict:to_list(OptionalCbs)),
+ case gb_sets:is_member({behaviour_info, 1}, Defined) of
+ false -> St1;
true ->
case dict:size(Callbacks) of
- 0 -> State;
+ 0 -> St1;
_ ->
CallbacksList = dict:to_list(Callbacks),
FoldL =
- fun({Fa,Line},St) ->
+ fun({Fa, Line}, St) ->
add_error(Line, {behaviour_info, Fa}, St)
end,
- lists:foldl(FoldL, State, CallbacksList)
+ lists:foldl(FoldL, St1, CallbacksList)
end
end.
@@ -1404,20 +1437,7 @@ pattern({cons,_Line,H,T}, Vt, Old, Bvt, St0) ->
pattern({tuple,_Line,Ps}, Vt, Old, Bvt, St) ->
pattern_list(Ps, Vt, Old, Bvt, St);
pattern({map,_Line,Ps}, Vt, Old, Bvt, St) ->
- foldl(fun
- ({map_field_assoc,L,_,_}, {Psvt,Bvt0,St0}) ->
- {Psvt,Bvt0,add_error(L, illegal_pattern, St0)};
- ({map_field_exact,L,KP,VP}, {Psvt,Bvt0,St0}) ->
- case is_valid_map_key(KP, pattern, St0) of
- true ->
- {Pvt,Bvt1,St1} = pattern(VP, Vt, Old, Bvt, St0),
- {vtmerge_pat(Pvt, Psvt),vtmerge_pat(Bvt0, Bvt1), St1};
- false ->
- {Psvt,Bvt0,add_error(L, illegal_map_key, St0)};
- {false,variable,Var} ->
- {Psvt,Bvt0,add_error(L, {illegal_map_key_variable,Var}, St0)}
- end
- end, {[],[],St}, Ps);
+ pattern_map(Ps, Vt, Old, Bvt, St);
%%pattern({struct,_Line,_Tag,Ps}, Vt, Old, Bvt, St) ->
%% pattern_list(Ps, Vt, Old, Bvt, St);
pattern({record_index,Line,Name,Field}, _Vt, _Old, _Bvt, St) ->
@@ -1571,6 +1591,21 @@ is_pattern_expr_1({op,_Line,Op,A1,A2}) ->
erl_internal:arith_op(Op, 2) andalso all(fun is_pattern_expr/1, [A1,A2]);
is_pattern_expr_1(_Other) -> false.
+pattern_map(Ps, Vt, Old, Bvt, St) ->
+ foldl(fun
+ ({map_field_assoc,L,_,_}, {Psvt,Bvt0,St0}) ->
+ {Psvt,Bvt0,add_error(L, illegal_pattern, St0)};
+ ({map_field_exact,L,K,V}, {Psvt,Bvt0,St0}) ->
+ case is_valid_map_key(K) of
+ true ->
+ {Kvt,St1} = expr(K, Vt, St0),
+ {Vvt,Bvt2,St2} = pattern(V, Vt, Old, Bvt, St1),
+ {vtmerge_pat(vtmerge_pat(Kvt, Vvt), Psvt), vtmerge_pat(Bvt0, Bvt2), St2};
+ false ->
+ {Psvt,Bvt0,add_error(L, illegal_map_key, St0)}
+ end
+ end, {[],[],St}, Ps).
+
%% pattern_bin([Element], VarTable, Old, BinVarTable, State) ->
%% {UpdVarTable,UpdBinVarTable,State}.
%% Check a pattern group. BinVarTable are used binsize variables.
@@ -2085,8 +2120,8 @@ expr({'receive',Line,Cs,To,ToEs}, Vt, St0) ->
{Cvt,St3} = icrt_clauses(Cs, Vt, St2),
%% Csvts = [vtnew(Tevt, Vt)|Cvt], %This is just NEW variables!
Csvts = [Tevt|Cvt],
- {Rvt,St4} = icrt_export(Csvts, Vt, {'receive',Line}, St3),
- {vtmerge([Tvt,Tevt,Rvt]),St4};
+ Rvt = icrt_export(Csvts, Vt, {'receive',Line}),
+ {vtmerge([Tvt,Tevt,Rvt]),St3};
expr({'fun',Line,Body}, Vt, St) ->
%%No one can think funs export!
case Body of
@@ -2197,21 +2232,20 @@ expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) ->
%% passes cannot handle exports in combination with 'after'.
{Evt0,St1} = exprs(Es, Vt, St0),
TryLine = {'try',Line},
- Uvt = vtunsafe(vtnames(vtnew(Evt0, Vt)), TryLine, []),
- Evt1 = vtupdate(Uvt, vtsubtract(Evt0, Uvt)),
+ Uvt = vtunsafe(TryLine, Evt0, Vt),
+ Evt1 = vtupdate(Uvt, Evt0),
{Sccs,St2} = icrt_clauses(Scs++Ccs, TryLine, vtupdate(Evt1, Vt), St1),
Rvt0 = Sccs,
- Rvt1 = vtupdate(vtunsafe(vtnames(vtnew(Rvt0, Vt)), TryLine, []), Rvt0),
+ Rvt1 = vtupdate(vtunsafe(TryLine, Rvt0, Vt), Rvt0),
Evt2 = vtmerge(Evt1, Rvt1),
{Avt0,St} = exprs(As, vtupdate(Evt2, Vt), St2),
- Avt1 = vtupdate(vtunsafe(vtnames(vtnew(Avt0, Vt)), TryLine, []), Avt0),
+ Avt1 = vtupdate(vtunsafe(TryLine, Avt0, Vt), Avt0),
Avt = vtmerge(Evt2, Avt1),
{Avt,St};
expr({'catch',Line,E}, Vt, St0) ->
%% No new variables added, flag new variables as unsafe.
- {Evt,St1} = expr(E, Vt, St0),
- Uvt = vtunsafe(vtnames(vtnew(Evt, Vt)), {'catch',Line}, []),
- {vtupdate(Uvt,vtupdate(Evt, Vt)),St1};
+ {Evt,St} = expr(E, Vt, St0),
+ {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt),St};
expr({match,_Line,P,E}, Vt, St0) ->
{Evt,St1} = expr(E, Vt, St0),
{Pvt,Bvt,St2} = pattern(P, vtupdate(Evt, Vt), St1),
@@ -2224,9 +2258,8 @@ expr({op,Line,Op,L,R}, Vt, St0) when Op =:= 'orelse'; Op =:= 'andalso' ->
{Evt1,St1} = expr(L, Vt, St0),
Vt1 = vtupdate(Evt1, Vt),
{Evt2,St2} = expr(R, Vt1, St1),
- Vt2 = vtmerge(Evt2, Vt1),
- {Vt3,St3} = icrt_export([Vt1,Vt2], Vt1, {Op,Line}, St2),
- {vtmerge(Evt1, Vt3),St3};
+ Evt3 = vtupdate(vtunsafe({Op,Line}, Evt2, Vt1), Evt2),
+ {vtmerge(Evt1, Evt3),St2};
expr({op,_Line,_Op,L,R}, Vt, St) ->
expr_list([L,R], Vt, St); %They see the same variables
%% The following are not allowed to occur anywhere!
@@ -2254,14 +2287,9 @@ check_assoc_fields([{map_field_assoc,_,_,_}|Fs], St) ->
check_assoc_fields([], St) ->
St.
-map_fields([{Tag,Line,K,V}|Fs], Vt, St, F) when Tag =:= map_field_assoc;
- Tag =:= map_field_exact ->
- St1 = case is_valid_map_key(K, St) of
- true -> St;
- false -> add_error(Line, illegal_map_key, St);
- {false,variable,Var} -> add_error(Line, {illegal_map_key_variable,Var}, St)
- end,
- {Pvt,St2} = F([K,V], Vt, St1),
+map_fields([{Tag,_,K,V}|Fs], Vt, St, F) when Tag =:= map_field_assoc;
+ Tag =:= map_field_exact ->
+ {Pvt,St2} = F([K,V], Vt, St),
{Vts,St3} = map_fields(Fs, Vt, St2, F),
{vtupdate(Pvt, Vts),St3};
map_fields([], Vt, St, _) ->
@@ -2319,21 +2347,14 @@ is_valid_call(Call) ->
_ -> true
end.
-%% is_valid_map_key(K,St) -> true | false | {false, Var::atom()}
-%% check for value expression without variables
-
-is_valid_map_key(K,St) ->
- is_valid_map_key(K,expr,St).
-is_valid_map_key(K,Ctx,St) ->
- case expr(K,[],St) of
- {[],_} ->
- is_valid_map_key_value(K,Ctx);
- {[Var|_],_} ->
- {false,variable,element(1,Var)}
- end.
+%% is_valid_map_key(K,St) -> true | false
+%% variables are allowed for patterns only at the top of the tree
-is_valid_map_key_value(K,Ctx) ->
+is_valid_map_key({var,_,_}) -> true;
+is_valid_map_key(K) -> is_valid_map_key_value(K).
+is_valid_map_key_value(K) ->
case K of
+ {var,_,_} -> false;
{char,_,_} -> true;
{integer,_,_} -> true;
{float,_,_} -> true;
@@ -2341,36 +2362,36 @@ is_valid_map_key_value(K,Ctx) ->
{nil,_} -> true;
{atom,_,_} -> true;
{cons,_,H,T} ->
- is_valid_map_key_value(H,Ctx) andalso
- is_valid_map_key_value(T,Ctx);
+ is_valid_map_key_value(H) andalso
+ is_valid_map_key_value(T);
{tuple,_,Es} ->
foldl(fun(E,B) ->
- B andalso is_valid_map_key_value(E,Ctx)
+ B andalso is_valid_map_key_value(E)
end,true,Es);
{map,_,Arg,Ps} ->
% only check for value expressions to be valid
% invalid map expressions are later checked in
% core and kernel
- is_valid_map_key_value(Arg,Ctx) andalso foldl(fun
+ is_valid_map_key_value(Arg) andalso foldl(fun
({Tag,_,Ke,Ve},B) when Tag =:= map_field_assoc;
- Tag =:= map_field_exact, Ctx =:= expr ->
- B andalso is_valid_map_key_value(Ke,Ctx)
- andalso is_valid_map_key_value(Ve,Ctx);
+ Tag =:= map_field_exact ->
+ B andalso is_valid_map_key_value(Ke)
+ andalso is_valid_map_key_value(Ve);
(_,_) -> false
end,true,Ps);
{map,_,Ps} ->
foldl(fun
({Tag,_,Ke,Ve},B) when Tag =:= map_field_assoc;
- Tag =:= map_field_exact, Ctx =:= expr ->
- B andalso is_valid_map_key_value(Ke,Ctx)
- andalso is_valid_map_key_value(Ve,Ctx);
+ Tag =:= map_field_exact ->
+ B andalso is_valid_map_key_value(Ke)
+ andalso is_valid_map_key_value(Ve);
(_,_) -> false
end, true, Ps);
{record,_,_,Fs} ->
foldl(fun
({record_field,_,Ke,Ve},B) ->
- B andalso is_valid_map_key_value(Ke,Ctx)
- andalso is_valid_map_key_value(Ve,Ctx)
+ B andalso is_valid_map_key_value(Ke)
+ andalso is_valid_map_key_value(Ve)
end,true,Fs);
{bin,_,Es} ->
% only check for value expressions to be valid
@@ -2378,9 +2399,9 @@ is_valid_map_key_value(K,Ctx) ->
% core and kernel
foldl(fun
({bin_element,_,E,_,_},B) ->
- B andalso is_valid_map_key_value(E,Ctx)
+ B andalso is_valid_map_key_value(E)
end,true,Es);
- _ -> false
+ Val -> is_pattern_expr(Val)
end.
%% record_def(Line, RecordName, [RecField], State) -> State.
@@ -2615,30 +2636,21 @@ type_def(Attr, Line, TypeName, ProtoType, Args, St0) ->
true ->
case is_obsolete_builtin_type(TypePair) of
true -> StoreType(St0);
- false -> add_error(Line, {builtin_type, TypePair}, St0)
-%% case is_newly_introduced_builtin_type(TypePair) of
-%% %% allow some types just for bootstrapping
-%% true ->
-%% Warn = {new_builtin_type, TypePair},
-%% St1 = add_warning(Line, Warn, St0),
-%% StoreType(St1);
-%% false ->
-%% add_error(Line, {builtin_type, TypePair}, St0)
-%% end
+ false ->
+ case is_newly_introduced_builtin_type(TypePair) of
+ %% allow some types just for bootstrapping
+ true ->
+ Warn = {new_builtin_type, TypePair},
+ St1 = add_warning(Line, Warn, St0),
+ StoreType(St1);
+ false ->
+ add_error(Line, {builtin_type, TypePair}, St0)
+ end
end;
false ->
- case
- dict:is_key(TypePair, TypeDefs) orelse
- is_var_arity_type(TypeName)
- of
+ case dict:is_key(TypePair, TypeDefs) of
true ->
- case is_newly_introduced_var_arity_type(TypeName) of
- true ->
- Warn = {new_var_arity_type, TypeName},
- add_warning(Line, Warn, St0);
- false ->
- add_error(Line, {redefine_type, TypePair}, St0)
- end;
+ add_error(Line, {redefine_type, TypePair}, St0);
false ->
St1 = case
Attr =:= opaque andalso
@@ -2675,7 +2687,7 @@ check_type({paren_type, _L, [Type]}, SeenVars, St) ->
check_type({remote_type, L, [{atom, _, Mod}, {atom, _, Name}, Args]},
SeenVars, #lint{module=CurrentMod} = St) ->
case Mod =:= CurrentMod of
- true -> check_type({type, L, Name, Args}, SeenVars, St);
+ true -> check_type({user_type, L, Name, Args}, SeenVars, St);
false ->
lists:foldl(fun(T, {AccSeenVars, AccSt}) ->
check_type(T, AccSeenVars, AccSt)
@@ -2709,12 +2721,15 @@ check_type({type, L, range, [From, To]}, SeenVars, St) ->
_ -> add_error(L, {type_syntax, range}, St)
end,
{SeenVars, St1};
-check_type({type, _L, map, any}, SeenVars, St) -> {SeenVars, St};
+check_type({type, L, map, any}, SeenVars, St) ->
+ %% To get usage right while map/0 is a newly_introduced_builtin_type.
+ St1 = used_type({map, 0}, L, St),
+ {SeenVars, St1};
check_type({type, _L, map, Pairs}, SeenVars, St) ->
lists:foldl(fun(Pair, {AccSeenVars, AccSt}) ->
check_type(Pair, AccSeenVars, AccSt)
end, {SeenVars, St}, Pairs);
-check_type({type, _L, map_field_assoc, Dom, Range}, SeenVars, St) ->
+check_type({type, _L, map_field_assoc, [Dom, Range]}, SeenVars, St) ->
check_type({type, -1, product, [Dom, Range]}, SeenVars, St);
check_type({type, _L, tuple, any}, SeenVars, St) -> {SeenVars, St};
check_type({type, _L, any}, SeenVars, St) -> {SeenVars, St};
@@ -2733,41 +2748,39 @@ check_type({type, L, record, [Name|Fields]}, SeenVars, St) ->
check_record_types(L, Atom, Fields, SeenVars, St1);
_ -> {SeenVars, add_error(L, {type_syntax, record}, St)}
end;
-check_type({type, _L, product, Args}, SeenVars, St) ->
+check_type({type, _L, Tag, Args}, SeenVars, St) when Tag =:= product;
+ Tag =:= union;
+ Tag =:= tuple ->
lists:foldl(fun(T, {AccSeenVars, AccSt}) ->
check_type(T, AccSeenVars, AccSt)
end, {SeenVars, St}, Args);
check_type({type, La, TypeName, Args}, SeenVars, St) ->
- #lint{usage=Usage, module = Module, types=Types} = St,
+ #lint{module = Module, types=Types} = St,
Arity = length(Args),
TypePair = {TypeName, Arity},
- St1 = case is_var_arity_type(TypeName) of
- true -> St;
- false ->
- Obsolete = (is_warn_enabled(deprecated_type, St)
- andalso obsolete_builtin_type(TypePair)),
- IsObsolete =
- case Obsolete of
- {deprecated, Repl, _} when element(1, Repl) =/= Module ->
- case dict:find(TypePair, Types) of
- {ok, _} -> false;
- error -> true
- end;
- _ -> false
- end,
- case IsObsolete of
- true ->
+ Obsolete = (is_warn_enabled(deprecated_type, St)
+ andalso obsolete_builtin_type(TypePair)),
+ St1 = case Obsolete of
+ {deprecated, Repl, _} when element(1, Repl) =/= Module ->
+ case dict:find(TypePair, Types) of
+ {ok, _} ->
+ used_type(TypePair, La, St);
+ error ->
{deprecated, Replacement, Rel} = Obsolete,
Tag = deprecated_builtin_type,
W = {Tag, TypePair, Replacement, Rel},
- add_warning(La, W, St);
- false ->
- OldUsed = Usage#usage.used_types,
- UsedTypes = dict:store(TypePair, La, OldUsed),
- St#lint{usage=Usage#usage{used_types=UsedTypes}}
- end
- end,
+ add_warning(La, W, St)
+ end;
+ _ -> St
+ end,
check_type({type, -1, product, Args}, SeenVars, St1);
+check_type({user_type, L, TypeName, Args}, SeenVars, St) ->
+ Arity = length(Args),
+ TypePair = {TypeName, Arity},
+ St1 = used_type(TypePair, L, St),
+ lists:foldl(fun(T, {AccSeenVars, AccSt}) ->
+ check_type(T, AccSeenVars, AccSt)
+ end, {SeenVars, St1}, Args);
check_type(I, SeenVars, St) ->
case erl_eval:partial_eval(I) of
{integer,_ILn,_Integer} -> {SeenVars, St};
@@ -2809,95 +2822,24 @@ check_record_types([{type, _, field_type, [{atom, AL, FName}, Type]}|Left],
check_record_types([], _Name, _DefFields, SeenVars, St, _SeenFields) ->
{SeenVars, St}.
-is_var_arity_type(tuple) -> true;
-is_var_arity_type(map) -> true;
-is_var_arity_type(product) -> true;
-is_var_arity_type(union) -> true;
-is_var_arity_type(record) -> true;
-is_var_arity_type(_) -> false.
-
-is_default_type({any, 0}) -> true;
-is_default_type({arity, 0}) -> true;
-is_default_type({array, 0}) -> true;
-is_default_type({atom, 0}) -> true;
-is_default_type({atom, 1}) -> true;
-is_default_type({binary, 0}) -> true;
-is_default_type({binary, 2}) -> true;
-is_default_type({bitstring, 0}) -> true;
-is_default_type({bool, 0}) -> true;
-is_default_type({boolean, 0}) -> true;
-is_default_type({byte, 0}) -> true;
-is_default_type({char, 0}) -> true;
-is_default_type({dict, 0}) -> true;
-is_default_type({digraph, 0}) -> true;
-is_default_type({float, 0}) -> true;
-is_default_type({'fun', 0}) -> true;
-is_default_type({'fun', 2}) -> true;
-is_default_type({function, 0}) -> true;
-is_default_type({gb_set, 0}) -> true;
-is_default_type({gb_tree, 0}) -> true;
-is_default_type({identifier, 0}) -> true;
-is_default_type({integer, 0}) -> true;
-is_default_type({integer, 1}) -> true;
-is_default_type({iodata, 0}) -> true;
-is_default_type({iolist, 0}) -> true;
-is_default_type({list, 0}) -> true;
-is_default_type({list, 1}) -> true;
-is_default_type({maybe_improper_list, 0}) -> true;
-is_default_type({maybe_improper_list, 2}) -> true;
-is_default_type({mfa, 0}) -> true;
-is_default_type({module, 0}) -> true;
-is_default_type({neg_integer, 0}) -> true;
-is_default_type({nil, 0}) -> true;
-is_default_type({no_return, 0}) -> true;
-is_default_type({node, 0}) -> true;
-is_default_type({non_neg_integer, 0}) -> true;
-is_default_type({none, 0}) -> true;
-is_default_type({nonempty_list, 0}) -> true;
-is_default_type({nonempty_list, 1}) -> true;
-is_default_type({nonempty_improper_list, 2}) -> true;
-is_default_type({nonempty_maybe_improper_list, 0}) -> true;
-is_default_type({nonempty_maybe_improper_list, 2}) -> true;
-is_default_type({nonempty_string, 0}) -> true;
-is_default_type({number, 0}) -> true;
-is_default_type({pid, 0}) -> true;
-is_default_type({port, 0}) -> true;
-is_default_type({pos_integer, 0}) -> true;
-is_default_type({queue, 0}) -> true;
-is_default_type({range, 2}) -> true;
-is_default_type({reference, 0}) -> true;
-is_default_type({set, 0}) -> true;
-is_default_type({string, 0}) -> true;
-is_default_type({term, 0}) -> true;
-is_default_type({timeout, 0}) -> true;
-is_default_type({var, 1}) -> true;
-is_default_type(_) -> false.
-
-is_newly_introduced_var_arity_type(map) -> true;
-is_newly_introduced_var_arity_type(_) -> false.
-
-%% is_newly_introduced_builtin_type({Name, _}) when is_atom(Name) -> false.
+used_type(TypePair, L, St) ->
+ Usage = St#lint.usage,
+ OldUsed = Usage#usage.used_types,
+ UsedTypes = dict:store(TypePair, L, OldUsed),
+ St#lint{usage=Usage#usage{used_types=UsedTypes}}.
+
+is_default_type({Name, NumberOfTypeVariables}) ->
+ erl_internal:is_type(Name, NumberOfTypeVariables).
+
+is_newly_introduced_builtin_type({map, 0}) -> true;
+is_newly_introduced_builtin_type({Name, _}) when is_atom(Name) -> false.
is_obsolete_builtin_type(TypePair) ->
obsolete_builtin_type(TypePair) =/= no.
-%% Obsolete in OTP 17.0.
-obsolete_builtin_type({array, 0}) ->
- {deprecated, {array, array, 1}, "OTP 18.0"};
-obsolete_builtin_type({dict, 0}) ->
- {deprecated, {dict, dict, 2}, "OTP 18.0"};
-obsolete_builtin_type({digraph, 0}) ->
- {deprecated, {digraph, graph}, "OTP 18.0"};
-obsolete_builtin_type({gb_set, 0}) ->
- {deprecated, {gb_sets, set, 1}, "OTP 18.0"};
-obsolete_builtin_type({gb_tree, 0}) ->
- {deprecated, {gb_trees, tree, 2}, "OTP 18.0"};
-obsolete_builtin_type({queue, 0}) ->
- {deprecated, {queue, queue, 1}, "OTP 18.0"};
-obsolete_builtin_type({set, 0}) ->
- {deprecated, {sets, set, 1}, "OTP 18.0"};
-obsolete_builtin_type({tid, 0}) ->
- {deprecated, {ets, tid}, "OTP 18.0"};
+%% To keep Dialyzer silent...
+obsolete_builtin_type({1, 255}) ->
+ {deprecated, {2, 255}, ""};
obsolete_builtin_type({Name, A}) when is_atom(Name), is_integer(A) -> no.
%% spec_decl(Line, Fun, Types, State) -> State.
@@ -2909,7 +2851,7 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) ->
end,
St1 = St0#lint{specs = dict:store(MFA, Line, Specs)},
case dict:is_key(MFA, Specs) of
- true -> add_error(Line, {redefine_spec, MFA}, St1);
+ true -> add_error(Line, {redefine_spec, MFA0}, St1);
false -> check_specs(TypeSpecs, Arity, St1)
end.
@@ -2917,16 +2859,50 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) ->
callback_decl(Line, MFA0, TypeSpecs,
St0 = #lint{callbacks = Callbacks, module = Mod}) ->
- MFA = case MFA0 of
- {F, Arity} -> {Mod, F, Arity};
- {_M, _F, Arity} -> MFA0
- end,
- St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)},
- case dict:is_key(MFA, Callbacks) of
- true -> add_error(Line, {redefine_callback, MFA}, St1);
- false -> check_specs(TypeSpecs, Arity, St1)
+ case MFA0 of
+ {_M, _F, _A} -> add_error(Line, {bad_callback, MFA0}, St0);
+ {F, Arity} ->
+ MFA = {Mod, F, Arity},
+ St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)},
+ case dict:is_key(MFA, Callbacks) of
+ true -> add_error(Line, {redefine_callback, MFA0}, St1);
+ false -> check_specs(TypeSpecs, Arity, St1)
+ end
+ end.
+
+%% optional_callbacks(Line, FAs, State) -> State.
+
+optional_callbacks(Line, Term, St0) ->
+ try true = is_fa_list(Term), Term of
+ FAs ->
+ optional_cbs(Line, FAs, St0)
+ catch
+ _:_ ->
+ St0 % ignore others
end.
+optional_cbs(_Line, [], St) ->
+ St;
+optional_cbs(Line, [{F,A}|FAs], St0) ->
+ #lint{optional_callbacks = OptionalCbs, module = Mod} = St0,
+ MFA = {Mod, F, A},
+ St1 = St0#lint{optional_callbacks = dict:store(MFA, Line, OptionalCbs)},
+ St2 = case dict:is_key(MFA, OptionalCbs) of
+ true ->
+ add_error(Line, {redefine_optional_callback, {F,A}}, St1);
+ false ->
+ St1
+ end,
+ optional_cbs(Line, FAs, St2).
+
+is_fa_list([E|L]) -> is_fa(E) andalso is_fa_list(L);
+is_fa_list([]) -> true;
+is_fa_list(_) -> false.
+
+is_fa({FuncName, Arity})
+ when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> true;
+is_fa(_) -> false.
+
check_specs([FunType|Left], Arity, St0) ->
{FunType1, CTypes} =
case FunType of
@@ -2950,10 +2926,11 @@ check_specs([], _Arity, St) ->
St.
check_specs_without_function(#lint{module=Mod,defined=Funcs,specs=Specs}=St) ->
- Fun = fun({M, F, A} = MFA, Line, AccSt) when M =:= Mod ->
- case gb_sets:is_element({F, A}, Funcs) of
+ Fun = fun({M, F, A}, Line, AccSt) when M =:= Mod ->
+ FA = {F, A},
+ case gb_sets:is_element(FA, Funcs) of
true -> AccSt;
- false -> add_error(Line, {spec_fun_undefined, MFA}, AccSt)
+ false -> add_error(Line, {spec_fun_undefined, FA}, AccSt)
end;
({_M, _F, _A}, _Line, AccSt) -> AccSt
end,
@@ -3032,11 +3009,12 @@ check_local_opaque_types(St) ->
dict:fold(FoldFun, St, Ts).
%% icrt_clauses(Clauses, In, ImportVarTable, State) ->
-%% {NewVts,State}.
+%% {UpdVt,State}.
icrt_clauses(Cs, In, Vt, St0) ->
{Csvt,St1} = icrt_clauses(Cs, Vt, St0),
- icrt_export(Csvt, Vt, In, St1).
+ UpdVt = icrt_export(Csvt, Vt, In),
+ {UpdVt,St1}.
%% icrt_clauses(Clauses, ImportVarTable, State) ->
%% {NewVts,State}.
@@ -3046,26 +3024,73 @@ icrt_clauses(Cs, Vt, St) ->
icrt_clause({clause,_Line,H,G,B}, Vt0, St0) ->
{Hvt,Binvt,St1} = head(H, Vt0, St0),
- Vt1 = vtupdate(Hvt, vtupdate(Binvt, Vt0)),
- {Gvt,St2} = guard(G, Vt1, St1),
+ Vt1 = vtupdate(Hvt, Binvt),
+ {Gvt,St2} = guard(G, vtupdate(Vt1, Vt0), St1),
Vt2 = vtupdate(Gvt, Vt1),
- {Bvt,St3} = exprs(B, Vt2, St2),
+ {Bvt,St3} = exprs(B, vtupdate(Vt2, Vt0), St2),
{vtupdate(Bvt, Vt2),St3}.
-icrt_export(Csvt, Vt, In, St) ->
- Vt1 = vtmerge(Csvt),
- All = ordsets:subtract(vintersection(Csvt), vtnames(Vt)),
- Some = ordsets:subtract(vtnames(Vt1), vtnames(Vt)),
- Xvt = vtexport(All, In, []),
- Evt = vtunsafe(ordsets:subtract(Some, All), In, Xvt),
- Unused = vtmerge([unused_vars(Vt0, Vt, St) || Vt0 <- Csvt]),
- %% Exported and unsafe variables may be unused:
- Uvt = vtmerge(Evt, Unused),
- %% Make exported and unsafe unused variables unused in subsequent code:
- Vt2 = vtmerge(Uvt, vtsubtract(Vt1, Uvt)),
- %% Forget about old variables which were not used:
- Vt3 = vtmerge(vtnew(Vt2, Vt), vt_no_unused(vtold(Vt2, Vt))),
- {Vt3,St}.
+icrt_export(Vts, Vt, {Tag,Attrs}) ->
+ {_File,Loc} = loc(Attrs),
+ icrt_export(lists:merge(Vts), Vt, {Tag,Loc}, length(Vts), []).
+
+icrt_export([{V,{{export,_},_,_}}|Vs0], [{V,{{export,_}=S0,_,Ls}}|Vt],
+ In, I, Acc) ->
+ %% V was an exported variable and has been used in an expression in at least
+ %% one clause. Its state needs to be merged from all clauses to silence any
+ %% exported var warning already emitted.
+ {VVs,Vs} = lists:partition(fun ({K,_}) -> K =:= V end, Vs0),
+ S = foldl(fun ({_,{S1,_,_}}, AccS) -> merge_state(AccS, S1) end, S0, VVs),
+ icrt_export(Vs, Vt, In, I, [{V,{S,used,Ls}}|Acc]);
+icrt_export([{V,_}|Vs0], [{V,{_,_,Ls}}|Vt], In, I, Acc) ->
+ %% V was either unsafe or bound and has now been reused. It may also have
+ %% been an export but as it was not matched by the previous clause, it means
+ %% it has been changed to 'bound' in at least one clause because it was used
+ %% in a pattern.
+ Vs = lists:dropwhile(fun ({K,_}) -> K =:= V end, Vs0),
+ icrt_export(Vs, Vt, In, I, [{V,{bound,used,Ls}}|Acc]);
+icrt_export([{V1,_}|_]=Vs, [{V2,_}|Vt], In, I, Acc) when V1 > V2 ->
+ %% V2 was already in scope and has not been reused in any clause.
+ icrt_export(Vs, Vt, In, I, Acc);
+icrt_export([{V,_}|_]=Vs0, Vt, In, I, Acc) ->
+ %% V is a new variable.
+ {VVs,Vs} = lists:partition(fun ({K,_}) -> K =:= V end, Vs0),
+ F = fun ({_,{S,U,Ls}}, {AccI,AccS0,AccLs0}) ->
+ AccS = case {S,AccS0} of
+ {{unsafe,_},{unsafe,_}} ->
+ %% V was found unsafe in a previous clause, mark
+ %% it as unsafe for the whole parent expression.
+ {unsafe,In};
+ {{unsafe,_},_} ->
+ %% V was unsafe in a clause, keep that state and
+ %% generalize it to the whole expression if it
+ %% is found unsafe in another one.
+ S;
+ _ ->
+ %% V is either bound or exported, keep original
+ %% state.
+ AccS0
+ end,
+ AccLs = case U of
+ used -> AccLs0;
+ unused -> merge_lines(AccLs0, Ls)
+ end,
+ {AccI + 1,AccS,AccLs}
+ end,
+ %% Initial state is exported from the current expression.
+ {Count,S1,Ls} = foldl(F, {0,{export,In},[]}, VVs),
+ S = case Count of
+ I ->
+ %% V was found in all clauses, keep computed state.
+ S1;
+ _ ->
+ %% V was not bound in some clauses, mark as unsafe.
+ {unsafe,In}
+ end,
+ U = case Ls of [] -> used; _ -> unused end,
+ icrt_export(Vs, Vt, In, I, [{V,{S,U,Ls}}|Acc]);
+icrt_export([], _, _, _, Acc) ->
+ reverse(Acc).
handle_comprehension(E, Qs, Vt0, St0) ->
{Vt1, Uvt, St1} = lc_quals(Qs, Vt0, St0),
@@ -3163,7 +3188,8 @@ fun_clauses(Cs, Vt, St) ->
{Cvt,St1} = fun_clause(C, Vt, St0),
{vtmerge(Cvt, Bvt0),St1}
end, {[],St#lint{recdef_top = false}}, Cs),
- {vt_no_unused(vtold(Bvt, Vt)),St2#lint{recdef_top = OldRecDef}}.
+ Uvt = vt_no_unsafe(vt_no_unused(vtold(Bvt, Vt))),
+ {Uvt,St2#lint{recdef_top = OldRecDef}}.
fun_clause({clause,_Line,H,G,B}, Vt0, St0) ->
{Hvt,Binvt,St1} = head(H, Vt0, [], St0), % No imported pattern variables
@@ -3277,19 +3303,24 @@ pat_binsize_var(V, Line, Vt, Bvt, St) ->
%% exported vars are probably safe, warn only if warn_export_vars is
%% set.
-expr_var(V, Line, Vt, St0) ->
+expr_var(V, Line, Vt, St) ->
case orddict:find(V, Vt) of
{ok,{bound,_Usage,Ls}} ->
- {[{V,{bound,used,Ls}}],St0};
+ {[{V,{bound,used,Ls}}],St};
{ok,{{unsafe,In},_Usage,Ls}} ->
{[{V,{bound,used,Ls}}],
- add_error(Line, {unsafe_var,V,In}, St0)};
+ add_error(Line, {unsafe_var,V,In}, St)};
{ok,{{export,From},_Usage,Ls}} ->
- {[{V,{bound,used,Ls}}],
- exported_var(Line, V, From, St0)};
+ case is_warn_enabled(export_vars, St) of
+ true ->
+ {[{V,{bound,used,Ls}}],
+ add_warning(Line, {exported_var,V,From}, St)};
+ false ->
+ {[{V,{{export,From},used,Ls}}],St}
+ end;
error ->
{[{V,{bound,used,[Line]}}],
- add_error(Line, {unbound_var,V}, St0)}
+ add_error(Line, {unbound_var,V}, St)}
end.
exported_var(Line, V, From, St) ->
@@ -3353,17 +3384,12 @@ vtupdate(Uvt, Vt0) ->
{S, merge_used(U1, U2), merge_lines(L1, L2)}
end, Uvt, Vt0).
-%% vtexport([Variable], From, VarTable) -> VarTable.
-%% vtunsafe([Variable], From, VarTable) -> VarTable.
-%% Add the variables to VarTable either as exported from From or as unsafe.
+%% vtunsafe(From, UpdVarTable, VarTable) -> UnsafeVarTable.
+%% Return all new variables in UpdVarTable as unsafe.
-vtexport(Vs, {InTag,FileLine}, Vt0) ->
+vtunsafe({Tag,FileLine}, Uvt, Vt) ->
{_File,Line} = loc(FileLine),
- vtupdate([{V,{{export,{InTag,Line}},unused,[]}} || V <- Vs], Vt0).
-
-vtunsafe(Vs, {InTag,FileLine}, Vt0) ->
- {_File,Line} = loc(FileLine),
- vtupdate([{V,{{unsafe,{InTag,Line}},unused,[]}} || V <- Vs], Vt0).
+ [{V,{{unsafe,{Tag,Line}},U,Ls}} || {V,{_,U,Ls}} <- vtnew(Uvt, Vt)].
%% vtmerge(VarTable, VarTable) -> VarTable.
%% Merge two variables tables generating a new vartable. Give priority to
@@ -3416,8 +3442,6 @@ vtsubtract(New, Old) ->
vtold(New, Old) ->
orddict:filter(fun (V, _How) -> orddict:is_key(V, Old) end, New).
-vtnames(Vt) -> [ V || {V,_How} <- Vt ].
-
vt_no_unsafe(Vt) -> [V || {_,{S,_U,_L}}=V <- Vt,
case S of
{unsafe,_} -> false;
@@ -3426,29 +3450,6 @@ vt_no_unsafe(Vt) -> [V || {_,{S,_U,_L}}=V <- Vt,
vt_no_unused(Vt) -> [V || {_,{_,U,_L}}=V <- Vt, U =/= unused].
-%% vunion(VarTable1, VarTable2) -> [VarName].
-%% vunion([VarTable]) -> [VarName].
-%% vintersection(VarTable1, VarTable2) -> [VarName].
-%% vintersection([VarTable]) -> [VarName].
-%% Union/intersection of names of vars in VarTable.
-
--ifdef(NOTUSED).
-vunion(Vs1, Vs2) -> ordsets:union(vtnames(Vs1), vtnames(Vs2)).
-
-vunion(Vss) -> foldl(fun (Vs, Uvs) ->
- ordsets:union(vtnames(Vs), Uvs)
- end, [], Vss).
-
-vintersection(Vs1, Vs2) -> ordsets:intersection(vtnames(Vs1), vtnames(Vs2)).
--endif.
-
-vintersection([Vs]) ->
- vtnames(Vs); %Boundary conditions!!!
-vintersection([Vs|Vss]) ->
- ordsets:intersection(vtnames(Vs), vintersection(Vss));
-vintersection([]) ->
- [].
-
%% copy_expr(Expr, Line) -> Expr.
%% Make a copy of Expr converting all line numbers to Line.
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 1d4a2a1fef..767b620871 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -146,8 +146,7 @@ type -> '(' top_type ')' : {paren_type, ?line('$2'), ['$2']}.
type -> var : '$1'.
type -> atom : '$1'.
type -> atom '(' ')' : build_gen_type('$1').
-type -> atom '(' top_types ')' : {type, ?line('$1'),
- normalise('$1'), '$3'}.
+type -> atom '(' top_types ')' : build_type('$1', '$3').
type -> atom ':' atom '(' ')' : {remote_type, ?line('$1'),
['$1', '$3', []]}.
type -> atom ':' atom '(' top_types ')' : {remote_type, ?line('$1'),
@@ -181,7 +180,7 @@ fun_type -> '(' top_types ')' '->' top_type
map_pair_types -> map_pair_type : ['$1'].
map_pair_types -> map_pair_type ',' map_pair_types : ['$1'|'$3'].
-map_pair_type -> top_type '=>' top_type : {type, ?line('$2'), map_field_assoc,'$1','$3'}.
+map_pair_type -> top_type '=>' top_type : {type, ?line('$2'), map_field_assoc,['$1','$3']}.
field_types -> field_type : ['$1'].
field_types -> field_type ',' field_types : ['$1'|'$3'].
@@ -665,6 +664,8 @@ find_arity_from_specs([Spec|_]) ->
{type, _, 'fun', [{type, _, product, Args},_]} = Fun,
length(Args).
+build_def({var, L, '_'}, _Types) ->
+ ret_err(L, "bad type variable");
build_def(LHS, Types) ->
IsSubType = {atom, ?line(LHS), is_subtype},
{type, ?line(LHS), constraint, [IsSubType, [LHS, Types]]}.
@@ -684,7 +685,8 @@ build_gen_type({atom, La, tuple}) ->
build_gen_type({atom, La, map}) ->
{type, La, map, any};
build_gen_type({atom, La, Name}) ->
- {type, La, Name, []}.
+ Tag = type_tag(Name, 0),
+ {Tag, La, Name, []}.
build_bin_type([{var, _, '_'}|Left], Int) ->
build_bin_type(Left, Int);
@@ -693,6 +695,16 @@ build_bin_type([], Int) ->
build_bin_type([{var, La, _}|_], _) ->
ret_err(La, "Bad binary type").
+build_type({atom, L, Name}, Types) ->
+ Tag = type_tag(Name, length(Types)),
+ {Tag, L, Name, Types}.
+
+type_tag(TypeName, NumberOfTypeVariables) ->
+ case erl_internal:is_type(TypeName, NumberOfTypeVariables) of
+ true -> type;
+ false -> user_type
+ end.
+
%% build_attribute(AttrName, AttrValue) ->
%% {attribute,Line,module,Module}
%% {attribute,Line,export,Exports}
diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl
index 1fd6d2a8df..17a758ff58 100644
--- a/lib/stdlib/src/erl_pp.erl
+++ b/lib/stdlib/src/erl_pp.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -232,13 +232,21 @@ lattribute(import, Name, _Opts, _State) when is_list(Name) ->
attr("import", [{var,0,pname(Name)}]);
lattribute(import, {From,Falist}, _Opts, _State) ->
attr("import",[{var,0,pname(From)},falist(Falist)]);
+lattribute(optional_callbacks, Falist, Opts, _State) ->
+ ArgL = try falist(Falist)
+ catch _:_ -> abstract(Falist, Opts)
+ end,
+ call({var,0,"-optional_callbacks"}, [ArgL], 0, options(none));
lattribute(file, {Name,Line}, _Opts, State) ->
attr("file", [{var,0,(State#pp.string_fun)(Name)},{integer,0,Line}]);
lattribute(record, {Name,Is}, Opts, _State) ->
Nl = leaf(format("-record(~w,", [Name])),
[{first,Nl,record_fields(Is, Opts)},$)];
-lattribute(Name, Arg, #options{encoding = Encoding}, _State) ->
- attr(write(Name), [erl_parse:abstract(Arg, [{encoding,Encoding}])]).
+lattribute(Name, Arg, Options, _State) ->
+ attr(write(Name), [abstract(Arg, Options)]).
+
+abstract(Arg, #options{encoding = Encoding}) ->
+ erl_parse:abstract(Arg, [{encoding,Encoding}]).
typeattr(Tag, {TypeName,Type,Args}, _Opts) ->
{first,leaf("-"++atom_to_list(Tag)++" "),
@@ -277,6 +285,9 @@ ltype({type,_,'fun',[{type,_,any},_]}=FunType) ->
ltype({type,_Line,'fun',[{type,_,product,_},_]}=FunType) ->
[fun_type(['fun',$(], FunType),$)];
ltype({type,Line,T,Ts}) ->
+ %% Compatibility. Before 18.0.
+ simple_type({atom,Line,T}, Ts);
+ltype({user_type,Line,T,Ts}) ->
simple_type({atom,Line,T}, Ts);
ltype({remote_type,Line,[M,F,Ts]}) ->
simple_type({remote,Line,M,F}, Ts);
@@ -299,7 +310,7 @@ map_type(Fs) ->
map_pair_types(Fs) ->
tuple_type(Fs, fun map_pair_type/1).
-map_pair_type({type,_Line,map_field_assoc,Ktype,Vtype}) ->
+map_pair_type({type,_Line,map_field_assoc,[Ktype,Vtype]}) ->
map_assoc_typed(ltype(Ktype), Vtype).
map_assoc_typed(B, {type,_,union,Ts}) ->
diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl
index e6bde5673c..632af17e2a 100644
--- a/lib/stdlib/src/filename.erl
+++ b/lib/stdlib/src/filename.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -444,6 +444,8 @@ join1([], RelativeName, [$:|Rest], win32) ->
join1(RelativeName, [], [$:|Rest], win32);
join1([], RelativeName, [$/|Result], OsType) ->
join1(RelativeName, [], [$/|Result], OsType);
+join1([], RelativeName, [$., $/|Result], OsType) ->
+ join1(RelativeName, [], [$/|Result], OsType);
join1([], RelativeName, Result, OsType) ->
join1(RelativeName, [], [$/|Result], OsType);
join1([[_|_]=List|Rest], RelativeName, Result, OsType) ->
@@ -470,6 +472,8 @@ join1b(<<>>, RelativeName, [$:|Rest], win32) ->
join1b(RelativeName, <<>>, [$:|Rest], win32);
join1b(<<>>, RelativeName, [$/|Result], OsType) ->
join1b(RelativeName, <<>>, [$/|Result], OsType);
+join1b(<<>>, RelativeName, [$., $/|Result], OsType) ->
+ join1b(RelativeName, <<>>, [$/|Result], OsType);
join1b(<<>>, RelativeName, Result, OsType) ->
join1b(RelativeName, <<>>, [$/|Result], OsType);
join1b(<<Char,Rest/binary>>, RelativeName, Result, OsType) when is_integer(Char) ->
diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl
index 63116fa16e..6d7ca3d75c 100644
--- a/lib/stdlib/src/gen.erl
+++ b/lib/stdlib/src/gen.erl
@@ -26,7 +26,7 @@
%%% The standard behaviour should export init_it/6.
%%%-----------------------------------------------------------------
-export([start/5, start/6, debug_options/1,
- call/3, call/4, reply/2]).
+ call/3, call/4, reply/2, stop/1, stop/3]).
-export([init_it/6, init_it/7]).
@@ -145,56 +145,10 @@ init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options) ->
call(Process, Label, Request) ->
call(Process, Label, Request, ?default_timeout).
-%% Local or remote by pid
-call(Pid, Label, Request, Timeout)
- when is_pid(Pid), Timeout =:= infinity;
- is_pid(Pid), is_integer(Timeout), Timeout >= 0 ->
- do_call(Pid, Label, Request, Timeout);
-%% Local by name
-call(Name, Label, Request, Timeout)
- when is_atom(Name), Timeout =:= infinity;
- is_atom(Name), is_integer(Timeout), Timeout >= 0 ->
- case whereis(Name) of
- Pid when is_pid(Pid) ->
- do_call(Pid, Label, Request, Timeout);
- undefined ->
- exit(noproc)
- end;
-%% Global by name
call(Process, Label, Request, Timeout)
- when ((tuple_size(Process) == 2 andalso element(1, Process) == global)
- orelse
- (tuple_size(Process) == 3 andalso element(1, Process) == via))
- andalso
- (Timeout =:= infinity orelse (is_integer(Timeout) andalso Timeout >= 0)) ->
- case where(Process) of
- Pid when is_pid(Pid) ->
- Node = node(Pid),
- try do_call(Pid, Label, Request, Timeout)
- catch
- exit:{nodedown, Node} ->
- %% A nodedown not yet detected by global,
- %% pretend that it was.
- exit(noproc)
- end;
- undefined ->
- exit(noproc)
- end;
-%% Local by name in disguise
-call({Name, Node}, Label, Request, Timeout)
- when Node =:= node(), Timeout =:= infinity;
- Node =:= node(), is_integer(Timeout), Timeout >= 0 ->
- call(Name, Label, Request, Timeout);
-%% Remote by name
-call({_Name, Node}=Process, Label, Request, Timeout)
- when is_atom(Node), Timeout =:= infinity;
- is_atom(Node), is_integer(Timeout), Timeout >= 0 ->
- if
- node() =:= nonode@nohost ->
- exit({nodedown, Node});
- true ->
- do_call(Process, Label, Request, Timeout)
- end.
+ when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 ->
+ Fun = fun(Pid) -> do_call(Pid, Label, Request, Timeout) end,
+ do_for_proc(Process, Fun).
do_call(Process, Label, Request, Timeout) ->
try erlang:monitor(process, Process) of
@@ -276,6 +230,65 @@ reply({To, Tag}, Reply) ->
Msg = {Tag, Reply},
try To ! Msg catch _:_ -> Msg end.
+%%-----------------------------------------------------------------
+%% Syncronously stop a generic process
+%%-----------------------------------------------------------------
+stop(Process) ->
+ stop(Process, normal, infinity).
+
+stop(Process, Reason, Timeout)
+ when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 ->
+ Fun = fun(Pid) -> proc_lib:stop(Pid, Reason, Timeout) end,
+ do_for_proc(Process, Fun).
+
+%%-----------------------------------------------------------------
+%% Map different specifications of a process to either Pid or
+%% {Name,Node}. Execute the given Fun with the process as only
+%% argument.
+%% -----------------------------------------------------------------
+
+%% Local or remote by pid
+do_for_proc(Pid, Fun) when is_pid(Pid) ->
+ Fun(Pid);
+%% Local by name
+do_for_proc(Name, Fun) when is_atom(Name) ->
+ case whereis(Name) of
+ Pid when is_pid(Pid) ->
+ Fun(Pid);
+ undefined ->
+ exit(noproc)
+ end;
+%% Global by name
+do_for_proc(Process, Fun)
+ when ((tuple_size(Process) == 2 andalso element(1, Process) == global)
+ orelse
+ (tuple_size(Process) == 3 andalso element(1, Process) == via)) ->
+ case where(Process) of
+ Pid when is_pid(Pid) ->
+ Node = node(Pid),
+ try Fun(Pid)
+ catch
+ exit:{nodedown, Node} ->
+ %% A nodedown not yet detected by global,
+ %% pretend that it was.
+ exit(noproc)
+ end;
+ undefined ->
+ exit(noproc)
+ end;
+%% Local by name in disguise
+do_for_proc({Name, Node}, Fun) when Node =:= node() ->
+ do_for_proc(Name, Fun);
+%% Remote by name
+do_for_proc({_Name, Node} = Process, Fun) when is_atom(Node) ->
+ if
+ node() =:= nonode@nohost ->
+ exit({nodedown, Node});
+ true ->
+ Fun(Process)
+ end.
+
+
%%%-----------------------------------------------------------------
%%% Misc. functions.
%%%-----------------------------------------------------------------
diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl
index 469acdc37c..5a1fff3a9c 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -31,8 +31,8 @@
%%% Modified by Martin - uses proc_lib, sys and gen!
--export([start/0, start/1, start_link/0, start_link/1, stop/1, notify/2,
- sync_notify/2,
+-export([start/0, start/1, start_link/0, start_link/1, stop/1, stop/3,
+ notify/2, sync_notify/2,
add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3,
swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]).
@@ -99,6 +99,14 @@
-callback code_change(OldVsn :: (term() | {down, term()}),
State :: term(), Extra :: term()) ->
{ok, NewState :: term()}.
+-callback format_status(Opt, StatusData) -> Status when
+ Opt :: 'normal' | 'terminate',
+ StatusData :: [PDict | State],
+ PDict :: [{Key :: term(), Value :: term()}],
+ State :: term(),
+ Status :: term().
+
+-optional_callbacks([format_status/2]).
%%---------------------------------------------------------------------------
@@ -183,7 +191,11 @@ swap_sup_handler(M, {H1, A1}, {H2, A2}) ->
which_handlers(M) -> rpc(M, which_handlers).
-spec stop(emgr_ref()) -> 'ok'.
-stop(M) -> rpc(M, stop).
+stop(M) ->
+ gen:stop(M).
+
+stop(M, Reason, Timeout) ->
+ gen:stop(M, Reason, Timeout).
rpc(M, Cmd) ->
{ok, Reply} = gen:call(M, self(), Cmd, infinity),
diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl
index 5afe3e8b09..89825a6a57 100644
--- a/lib/stdlib/src/gen_fsm.erl
+++ b/lib/stdlib/src/gen_fsm.erl
@@ -106,6 +106,7 @@
-export([start/3, start/4,
start_link/3, start_link/4,
+ stop/1, stop/3,
send_event/2, sync_send_event/2, sync_send_event/3,
send_all_state_event/2,
sync_send_all_state_event/2, sync_send_all_state_event/3,
@@ -160,6 +161,14 @@
-callback code_change(OldVsn :: term() | {down, term()}, StateName :: atom(),
StateData :: term(), Extra :: term()) ->
{ok, NextStateName :: atom(), NewStateData :: term()}.
+-callback format_status(Opt, StatusData) -> Status when
+ Opt :: 'normal' | 'terminate',
+ StatusData :: [PDict | State],
+ PDict :: [{Key :: term(), Value :: term()}],
+ State :: term(),
+ Status :: term().
+
+-optional_callbacks([format_status/2]).
%%% ---------------------------------------------------
%%% Starts a generic state machine.
@@ -189,6 +198,11 @@ start_link(Mod, Args, Options) ->
start_link(Name, Mod, Args, Options) ->
gen:start(?MODULE, link, Name, Mod, Args, Options).
+stop(Name) ->
+ gen:stop(Name).
+
+stop(Name, Reason, Timeout) ->
+ gen:stop(Name, Reason, Timeout).
send_event({global, Name}, Event) ->
catch global:send(Name, {'$gen_event', Event}),
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index dadfe56b3d..2d8d7f6233 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -88,6 +88,7 @@
%% API
-export([start/3, start/4,
start_link/3, start_link/4,
+ stop/1, stop/3,
call/2, call/3,
cast/2, reply/2,
abcast/2, abcast/3,
@@ -137,6 +138,15 @@
-callback code_change(OldVsn :: (term() | {down, term()}), State :: term(),
Extra :: term()) ->
{ok, NewState :: term()} | {error, Reason :: term()}.
+-callback format_status(Opt, StatusData) -> Status when
+ Opt :: 'normal' | 'terminate',
+ StatusData :: [PDict | State],
+ PDict :: [{Key :: term(), Value :: term()}],
+ State :: term(),
+ Status :: term().
+
+-optional_callbacks([format_status/2]).
+
%%% -----------------------------------------------------------------
%%% Starts a generic server.
@@ -168,6 +178,17 @@ start_link(Name, Mod, Args, Options) ->
%% -----------------------------------------------------------------
+%% Stop a generic server and wait for it to terminate.
+%% If the server is located at another node, that node will
+%% be monitored.
+%% -----------------------------------------------------------------
+stop(Name) ->
+ gen:stop(Name).
+
+stop(Name, Reason, Timeout) ->
+ gen:stop(Name, Reason, Timeout).
+
+%% -----------------------------------------------------------------
%% Make a call to a generic server.
%% If the server is located at another node, that node will
%% be monitored.
@@ -782,22 +803,10 @@ opt(_, []) ->
debug_options(Name, Opts) ->
case opt(debug, Opts) of
- {ok, Options} -> dbg_options(Name, Options);
- _ -> dbg_options(Name, [])
+ {ok, Options} -> dbg_opts(Name, Options);
+ _ -> []
end.
-dbg_options(Name, []) ->
- Opts =
- case init:get_argument(generic_debug) of
- error ->
- [];
- _ ->
- [log, statistics]
- end,
- dbg_opts(Name, Opts);
-dbg_options(Name, Opts) ->
- dbg_opts(Name, Opts).
-
dbg_opts(Name, Opts) ->
case catch sys:debug_options(Opts) of
{'EXIT',_} ->
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 6c25beabe9..0ace87ef5c 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -577,8 +577,6 @@ obsolete_1(asn1rt, utf8_binary_to_list, 1) ->
{deprecated,{unicode,characters_to_list,1}};
obsolete_1(asn1rt, utf8_list_to_binary, 1) ->
{deprecated,{unicode,characters_to_binary,1}};
-obsolete_1(pg, _, _) ->
- {deprecated,"deprecated; will be removed in OTP 18"};
obsolete_1(_, _, _) ->
no.
diff --git a/lib/stdlib/src/pg.erl b/lib/stdlib/src/pg.erl
deleted file mode 100644
index a41fd329c2..0000000000
--- a/lib/stdlib/src/pg.erl
+++ /dev/null
@@ -1,187 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
-%%
-%% The contents of this file are subject to the Erlang Public License,
-%% Version 1.1, (the "License"); you may not use this file except in
-%% compliance with the License. You should have received a copy of the
-%% Erlang Public License along with this software. If not, it can be
-%% retrieved online at http://www.erlang.org/.
-%%
-%% Software distributed under the License is distributed on an "AS IS"
-%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
-%% the License for the specific language governing rights and limitations
-%% under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(pg).
--deprecated(module).
-
-%% pg provides a process group facility. Messages
-%% can be multicasted to all members in the group
-
--export([create/1,
- create/2,
- standby/2,
- join/2,
- send/2,
- esend/2,
- members/1,
- name_to_pid/1,
- master/1]).
-
-
-%% Create a brand new empty process group with the master residing
-%% at the local node
-
--spec create(PgName) -> 'ok' | {'error', Reason} when
- PgName :: term(),
- Reason :: 'already_created' | term().
-
-create(PgName) ->
- catch begin check(PgName),
- Pid = spawn(pg,master,[PgName]),
- global:register_name(PgName,Pid),
- ok end.
-
-%% Create a brand new empty process group with the master
-%% residing at Node
-
--spec create(PgName, Node) -> 'ok' | {'error', Reason} when
- PgName :: term(),
- Node :: node(),
- Reason :: 'already_created' | term().
-
-create(PgName, Node) ->
- catch begin check(PgName),
- Pid = spawn(Node,pg,master,[PgName]),
- global:register_name(PgName,Pid),
- ok end.
-
-%% Have a process on Node that will act as a standby for the process
-%% group manager. So if the node where the manager runs fails, the
-%% process group will continue to function.
-
--spec standby(term(), node()) -> 'ok'.
-
-standby(_PgName, _Node) ->
- ok.
-
-%% Tell process group PgName that Pid is a new member of the group
-%% synchronously return a list of all old members in the group
-
--spec join(PgName, Pid) -> Members when
- PgName :: term(),
- Pid :: pid(),
- Members :: [pid()].
-
-join(PgName, Pid) when is_atom(PgName) ->
- global:send(PgName, {join,self(),Pid}),
- receive
- {_P,{members,Members}} ->
- Members
- end.
-
-%% Multi cast Mess to all members in the group
-
--spec send(PgName, Msg) -> 'ok' when
- PgName :: term(),
- Msg :: term().
-
-send(PgName, Mess) when is_atom(PgName) ->
- global:send(PgName, {send, self(), Mess}),
- ok;
-send(Pg, Mess) when is_pid(Pg) ->
- Pg ! {send,self(),Mess},
- ok.
-
-%% multi cast a message to all members in the group but ourselves
-%% If we are a member
-
--spec esend(PgName, Msg) -> 'ok' when
- PgName :: term(),
- Msg :: term().
-
-esend(PgName, Mess) when is_atom(PgName) ->
- global:send(PgName, {esend,self(),Mess}),
- ok;
-esend(Pg, Mess) when is_pid(Pg) ->
- Pg ! {esend,self(),Mess},
- ok.
-
-%% Return the members of the group
-
--spec members(PgName) -> Members when
- PgName :: term(),
- Members :: [pid()].
-
-members(PgName) when is_atom(PgName) ->
- global:send(PgName, {self() ,members}),
- receive
- {_P,{members,Members}} ->
- Members
- end;
-members(Pg) when is_pid(Pg) ->
- Pg ! {self,members},
- receive
- {_P,{members,Members}} ->
- Members
- end.
-
--spec name_to_pid(atom()) -> pid() | 'undefined'.
-
-name_to_pid(PgName) when is_atom(PgName) ->
- global:whereis_name(PgName).
-
--spec master(term()) -> no_return().
-
-master(PgName) ->
- process_flag(trap_exit, true),
- master_loop(PgName, []).
-
-master_loop(PgName,Members) ->
- receive
- {send,From,Message} ->
- send_all(Members,{pg_message,From,PgName,Message}),
- master_loop(PgName,Members);
- {esend,From,Message} ->
- send_all(lists:delete(From,Members),
- {pg_message,From,PgName,Message}),
- master_loop(PgName,Members);
- {join,From,Pid} ->
- link(Pid),
- send_all(Members,{new_member,PgName,Pid}),
- From ! {self(),{members,Members}},
- master_loop(PgName,[Pid|Members]);
- {From,members} ->
- From ! {self(),{members,Members}},
- master_loop(PgName,Members);
- {'EXIT',From,_} ->
- L =
- case lists:member(From,Members) of
- true ->
- NewMembers = lists:delete(From,Members),
- send_all(NewMembers, {crashed_member,PgName,From}),
- NewMembers;
- false ->
- Members
- end,
- master_loop(PgName,L)
- end.
-
-send_all([], _) -> ok;
-send_all([P|Ps], M) ->
- P ! M,
- send_all(Ps, M).
-
-%% Check if the process group already exists
-
-check(PgName) ->
- case global:whereis_name(PgName) of
- Pid when is_pid(Pid) ->
- throw({error,already_created});
- undefined ->
- ok
- end.
diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl
index bf2a4e7ac5..8792ff44d3 100644
--- a/lib/stdlib/src/proc_lib.erl
+++ b/lib/stdlib/src/proc_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -30,7 +30,8 @@
hibernate/3,
init_ack/1, init_ack/2,
init_p/3,init_p/5,format/1,format/2,initial_call/1,
- translate_initial_call/1]).
+ translate_initial_call/1,
+ stop/1, stop/3]).
%% Internal exports.
-export([wake_up/3]).
@@ -748,3 +749,50 @@ format_tag(Tag, Data) ->
modifier(latin1) -> "";
modifier(_) -> "t".
+
+
+%%% -----------------------------------------------------------
+%%% Stop a process and wait for it to terminate
+%%% -----------------------------------------------------------
+-spec stop(Process) -> 'ok' when
+ Process :: pid() | RegName | {RegName,node()},
+ RegName :: atom().
+stop(Process) ->
+ stop(Process, normal, infinity).
+
+-spec stop(Process, Reason, Timeout) -> 'ok' when
+ Process :: pid() | RegName | {RegName,node()},
+ RegName :: atom(),
+ Reason :: term(),
+ Timeout :: timeout().
+stop(Process, Reason, Timeout) ->
+ {Pid, Mref} = erlang:spawn_monitor(do_stop(Process, Reason)),
+ receive
+ {'DOWN', Mref, _, _, Reason} ->
+ ok;
+ {'DOWN', Mref, _, _, {noproc,{sys,terminate,_}}} ->
+ exit(noproc);
+ {'DOWN', Mref, _, _, CrashReason} ->
+ exit(CrashReason)
+ after Timeout ->
+ exit(Pid, kill),
+ receive
+ {'DOWN', Mref, _, _, _} ->
+ exit(timeout)
+ end
+ end.
+
+-spec do_stop(Process, Reason) -> Fun when
+ Process :: pid() | RegName | {RegName,node()},
+ RegName :: atom(),
+ Reason :: term(),
+ Fun :: fun(() -> no_return()).
+do_stop(Process, Reason) ->
+ fun() ->
+ Mref = erlang:monitor(process, Process),
+ ok = sys:terminate(Process, Reason, infinity),
+ receive
+ {'DOWN', Mref, _, _, ExitReason} ->
+ exit(ExitReason)
+ end
+ end.
diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src
index aa9899da3b..f134c75869 100644
--- a/lib/stdlib/src/stdlib.app.src
+++ b/lib/stdlib/src/stdlib.app.src
@@ -77,7 +77,6 @@
orddict,
ordsets,
otp_internal,
- pg,
pool,
proc_lib,
proplists,
diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src
index 7802ea884f..5900fd3ff3 100644
--- a/lib/stdlib/src/stdlib.appup.src
+++ b/lib/stdlib/src/stdlib.appup.src
@@ -18,10 +18,8 @@
{"%VSN%",
%% Up from - max one major revision back
[{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3
- {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.0
- {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16
+ {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0
%% Down to - max one major revision back
[{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3
- {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.0
- {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16
+ {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0
}.
diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl
index d3ba09ce82..7e4bfa1fdd 100644
--- a/lib/stdlib/src/sys.erl
+++ b/lib/stdlib/src/sys.erl
@@ -24,6 +24,7 @@
get_state/1, get_state/2,
replace_state/2, replace_state/3,
change_code/4, change_code/5,
+ terminate/2, terminate/3,
log/2, log/3, trace/2, trace/3, statistics/2, statistics/3,
log_to_file/2, log_to_file/3, no_debug/1, no_debug/2,
install/2, install/3, remove/2, remove/3]).
@@ -163,6 +164,19 @@ change_code(Name, Mod, Vsn, Extra) ->
change_code(Name, Mod, Vsn, Extra, Timeout) ->
send_system_msg(Name, {change_code, Mod, Vsn, Extra}, Timeout).
+-spec terminate(Name, Reason) -> 'ok' when
+ Name :: name(),
+ Reason :: term().
+terminate(Name, Reason) ->
+ send_system_msg(Name, {terminate, Reason}).
+
+-spec terminate(Name, Reason, Timeout) -> 'ok' when
+ Name :: name(),
+ Reason :: term(),
+ Timeout :: timeout().
+terminate(Name, Reason, Timeout) ->
+ send_system_msg(Name, {terminate, Reason}, Timeout).
+
%%-----------------------------------------------------------------
%% Debug commands
%%-----------------------------------------------------------------
@@ -298,6 +312,8 @@ mfa(Name, {debug, {Func, Arg2}}) ->
{sys, Func, [Name, Arg2]};
mfa(Name, {change_code, Mod, Vsn, Extra}) ->
{sys, change_code, [Name, Mod, Vsn, Extra]};
+mfa(Name, {terminate, Reason}) ->
+ {sys, terminate, [Name, Reason]};
mfa(Name, Atom) ->
{sys, Atom, [Name]}.
@@ -313,7 +329,7 @@ mfa(Name, Req, Timeout) ->
%% Returns: This function *never* returns! It calls the function
%% Module:system_continue(Parent, NDebug, Misc)
%% there the process continues the execution or
-%% Module:system_terminate(Raeson, Parent, Debug, Misc) if
+%% Module:system_terminate(Reason, Parent, Debug, Misc) if
%% the process should terminate.
%% The Module must export system_continue/3, system_terminate/4
%% and format_status/2 for status information.
@@ -339,7 +355,10 @@ handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc, Hib) ->
suspend_loop(suspended, Parent, Mod, NDebug, NMisc, Hib);
{running, Reply, NDebug, NMisc} ->
_ = gen:reply(From, Reply),
- Mod:system_continue(Parent, NDebug, NMisc)
+ Mod:system_continue(Parent, NDebug, NMisc);
+ {{terminating, Reason}, Reply, NDebug, NMisc} ->
+ _ = gen:reply(From, Reply),
+ Mod:system_terminate(Reason, Parent, NDebug, NMisc)
end.
%%-----------------------------------------------------------------
@@ -419,6 +438,8 @@ do_cmd(SysState, get_status, Parent, Mod, Debug, Misc) ->
do_cmd(SysState, {debug, What}, _Parent, _Mod, Debug, Misc) ->
{Res, NDebug} = debug_cmd(What, Debug),
{SysState, Res, NDebug, Misc};
+do_cmd(_, {terminate, Reason}, _Parent, _Mod, Debug, Misc) ->
+ {{terminating, Reason}, ok, Debug, Misc};
do_cmd(suspended, {change_code, Module, Vsn, Extra}, _Parent,
Mod, Debug, Misc) ->
{Res, NMisc} = do_change_code(Mod, Module, Vsn, Extra, Misc),
diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl
index b55324161b..3427f431c5 100644
--- a/lib/stdlib/test/erl_eval_SUITE.erl
+++ b/lib/stdlib/test/erl_eval_SUITE.erl
@@ -1458,6 +1458,30 @@ eep43(Config) when is_list(Config) ->
"lists:map(fun (X) -> X#{price := 0} end,
[#{hello => 0, price => nil}]).",
[#{hello => 0, price => 0}]),
+ check(fun () ->
+ Map = #{ <<33:333>> => "wat" },
+ #{ <<33:333>> := "wat" } = Map
+ end,
+ "begin "
+ " Map = #{ <<33:333>> => \"wat\" }, "
+ " #{ <<33:333>> := \"wat\" } = Map "
+ "end.",
+ #{ <<33:333>> => "wat" }),
+ check(fun () ->
+ K1 = 1,
+ K2 = <<42:301>>,
+ K3 = {3,K2},
+ Map = #{ K1 => 1, K2 => 2, K3 => 3, {2,2} => 4},
+ #{ K1 := 1, K2 := 2, K3 := 3, {2,2} := 4} = Map
+ end,
+ "begin "
+ " K1 = 1, "
+ " K2 = <<42:301>>, "
+ " K3 = {3,K2}, "
+ " Map = #{ K1 => 1, K2 => 2, K3 => 3, {2,2} => 4}, "
+ " #{ K1 := 1, K2 := 2, K3 := 3, {2,2} := 4} = Map "
+ "end.",
+ #{ 1 => 1, <<42:301>> => 2, {3,<<42:301>>} => 3, {2,2} => 4}),
error_check("[camembert]#{}.", {badarg,[camembert]}),
error_check("#{} = 1.", {badmatch,1}),
ok.
diff --git a/lib/stdlib/test/erl_internal_SUITE.erl b/lib/stdlib/test/erl_internal_SUITE.erl
index b6b3c004ea..197a7a33eb 100644
--- a/lib/stdlib/test/erl_internal_SUITE.erl
+++ b/lib/stdlib/test/erl_internal_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -51,7 +51,7 @@ end_per_group(_GroupName, Config) ->
-define(default_timeout, ?t:minutes(2)).
init_per_testcase(_Case, Config) ->
- ?line Dog = test_server:timetrap(?default_timeout),
+ Dog = test_server:timetrap(?default_timeout),
[{watchdog, Dog}|Config].
end_per_testcase(_Case, Config) ->
@@ -63,27 +63,50 @@ behav(suite) -> [];
behav(doc) ->
["Check that the behaviour callbacks are correctly defined"];
behav(_) ->
- ?line check_behav_list([{start,2}, {stop,1}],
- application:behaviour_info(callbacks)),
- ?line check_behav_list([{init,1}, {handle_call,3}, {handle_cast,2},
- {handle_info,2}, {terminate,2}, {code_change,3}],
- gen_server:behaviour_info(callbacks)),
- ?line check_behav_list([{init,1}, {handle_event,3}, {handle_sync_event,4},
- {handle_info,3}, {terminate,3}, {code_change,4}],
- gen_fsm:behaviour_info(callbacks)),
- ?line check_behav_list([{init,1}, {handle_event,2}, {handle_call,2},
- {handle_info,2}, {terminate,2}, {code_change,3}],
- gen_event:behaviour_info(callbacks)),
- ?line check_behav_list( [{init,1}, {terminate,2}],
- supervisor_bridge:behaviour_info(callbacks)),
- ?line check_behav_list([{init,1}],
- supervisor:behaviour_info(callbacks)),
- ok.
+ Modules = [application, gen_server, gen_fsm, gen_event,
+ supervisor_bridge, supervisor],
+ lists:foreach(fun check_behav/1, Modules).
+
+check_behav(Module) ->
+ Callbacks = callbacks(Module),
+ Optional = optional_callbacks(Module),
+ check_behav_list(Callbacks, Module:behaviour_info(callbacks)),
+ check_behav_list(Optional, Module:behaviour_info(optional_callbacks)).
check_behav_list([], []) -> ok;
check_behav_list([L | L1], L2) ->
- ?line true = lists:member(L, L2),
- ?line L3 = lists:delete(L, L2),
+ true = lists:member(L, L2),
+ L3 = lists:delete(L, L2),
check_behav_list(L1, L3).
-
+callbacks(application) ->
+ [{start,2}, {stop,1}];
+callbacks(gen_server) ->
+ [{init,1}, {handle_call,3}, {handle_cast,2},
+ {handle_info,2}, {terminate,2}, {code_change,3},
+ {format_status,2}];
+callbacks(gen_fsm) ->
+ [{init,1}, {handle_event,3}, {handle_sync_event,4},
+ {handle_info,3}, {terminate,3}, {code_change,4},
+ {format_status,2}];
+callbacks(gen_event) ->
+ [{init,1}, {handle_event,2}, {handle_call,2},
+ {handle_info,2}, {terminate,2}, {code_change,3},
+ {format_status,2}];
+callbacks(supervisor_bridge) ->
+ [{init,1}, {terminate,2}];
+callbacks(supervisor) ->
+ [{init,1}].
+
+optional_callbacks(application) ->
+ [];
+optional_callbacks(gen_server) ->
+ [{format_status,2}];
+optional_callbacks(gen_fsm) ->
+ [{format_status,2}];
+optional_callbacks(gen_event) ->
+ [{format_status,2}];
+optional_callbacks(supervisor_bridge) ->
+ [];
+optional_callbacks(supervisor) ->
+ [].
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index ea61b2082b..f8a99f653a 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -42,6 +42,7 @@
unused_vars_warn_rec/1,
unused_vars_warn_fun/1,
unused_vars_OTP_4858/1,
+ unused_unsafe_vars_warn/1,
export_vars_warn/1,
shadow_vars/1,
unused_import/1,
@@ -55,7 +56,7 @@
otp_11772/1, otp_11771/1, otp_11872/1,
export_all/1,
bif_clash/1,
- behaviour_basic/1, behaviour_multiple/1,
+ behaviour_basic/1, behaviour_multiple/1, otp_11861/1,
otp_7550/1,
otp_8051/1,
format_warn/1,
@@ -63,7 +64,7 @@
too_many_arguments/1,
basic_errors/1,bin_syntax_errors/1,
predef/1,
- maps/1,maps_type/1
+ maps/1,maps_type/1,otp_11851/1
]).
% Default timetrap timeout (set in init_per_testcase).
@@ -89,16 +90,16 @@ all() ->
otp_5362, otp_5371, otp_7227, otp_5494, otp_5644,
otp_5878, otp_5917, otp_6585, otp_6885, otp_10436, otp_11254,
otp_11772, otp_11771, otp_11872, export_all,
- bif_clash, behaviour_basic, behaviour_multiple,
+ bif_clash, behaviour_basic, behaviour_multiple, otp_11861,
otp_7550, otp_8051, format_warn, {group, on_load},
too_many_arguments, basic_errors, bin_syntax_errors, predef,
- maps, maps_type].
+ maps, maps_type, otp_11851].
groups() ->
[{unused_vars_warn, [],
[unused_vars_warn_basic, unused_vars_warn_lc,
unused_vars_warn_rec, unused_vars_warn_fun,
- unused_vars_OTP_4858]},
+ unused_vars_OTP_4858, unused_unsafe_vars_warn]},
{on_load, [], [on_load_successful, on_load_failing]}].
init_per_suite(Config) ->
@@ -730,6 +731,48 @@ unused_vars_OTP_4858(Config) when is_list(Config) ->
?line [] = run(Config, Ts),
ok.
+unused_unsafe_vars_warn(Config) when is_list(Config) ->
+ Ts = [{unused_unsafe1,
+ <<"t1() ->
+ UnusedVar1 = unused1,
+ try
+ UnusedVar2 = unused2
+ catch
+ _:_ ->
+ ok
+ end,
+ ok.
+ ">>,
+ [warn_unused_vars],
+ {warnings,[{2,erl_lint,{unused_var,'UnusedVar1'}},
+ {4,erl_lint,{unused_var,'UnusedVar2'}}]}},
+ {unused_unsafe2,
+ <<"t2() ->
+ try
+ X = 1
+ catch
+ _:_ -> ok
+ end.
+ ">>,
+ [warn_unused_vars],
+ {warnings,[{3,erl_lint,{unused_var,'X'}}]}},
+ {unused_unsafe2,
+ <<"t3(X, Y) ->
+ X andalso Y.
+ ">>,
+ [warn_unused_vars],
+ []},
+ {unused_unsafe4,
+ <<"t4() ->
+ _ = (catch X = X = 1),
+ _ = case ok of _ -> fun() -> ok end end,
+ fun (X) -> X end.
+ ">>,
+ [warn_unused_vars],
+ []}],
+ run(Config, Ts),
+ ok.
+
export_vars_warn(doc) ->
"Warnings for exported variables";
export_vars_warn(suite) -> [];
@@ -808,7 +851,19 @@ export_vars_warn(Config) when is_list(Config) ->
[],
{error,[{9,erl_lint,{unbound_var,'B'}}],
[{9,erl_lint,{exported_var,'Y',{'receive',2}}},
- {10,erl_lint,{shadowed_var,'B',generate}}]}}
+ {10,erl_lint,{shadowed_var,'B',generate}}]}},
+
+ {exp4,
+ <<"t(X) ->
+ if true -> Z = X end,
+ case X of
+ 1 -> Z;
+ 2 -> X
+ end,
+ Z = X.
+ ">>,
+ [],
+ {warnings,[{7,erl_lint,{exported_var,'Z',{'if',2}}}]}}
],
?line [] = run(Config, Ts),
ok.
@@ -832,8 +887,15 @@ shadow_vars(Config) when is_list(Config) ->
">>,
[nowarn_shadow_vars],
{error,[{9,erl_lint,{unbound_var,'B'}}],
- [{9,erl_lint,{exported_var,'Y',{'receive',2}}}]}}],
-
+ [{9,erl_lint,{exported_var,'Y',{'receive',2}}}]}},
+ {shadow2,
+ <<"t() ->
+ _ = (catch MS = MS = 1), % MS used unsafe
+ _ = case ok of _ -> fun() -> ok end end,
+ fun (MS) -> MS end. % MS not shadowed here
+ ">>,
+ [],
+ []}],
?line [] = run(Config, Ts),
ok.
@@ -958,6 +1020,45 @@ unsafe_vars(Config) when is_list(Config) ->
[warn_unused_vars],
{errors,[{3,erl_lint,{unsafe_var,'X',{'if',2}}},
{4,erl_lint,{unsafe_var,'X',{'if',2}}}],
+ []}},
+ {unsafe8,
+ <<"t8(X) ->
+ case X of _ -> catch _Y = 1 end,
+ _Y."
+ >>,
+ [],
+ {errors,[{3,erl_lint,{unsafe_var,'_Y',{'catch',2}}}],
+ []}},
+ {unsafe9,
+ <<"t9(X) ->
+ case X of
+ 1 ->
+ catch A = 1, % unsafe only here
+ B = 1,
+ C = 1,
+ D = 1;
+ 2 ->
+ A = 2,
+ % B not bound here
+ C = 2,
+ catch D = 2; % unsafe in two clauses
+ 3 ->
+ A = 3,
+ B = 3,
+ C = 3,
+ catch D = 3; % unsafe in two clauses
+ 4 ->
+ A = 4,
+ B = 4,
+ C = 4,
+ D = 4
+ end,
+ {A,B,C,D}."
+ >>,
+ [],
+ {errors,[{24,erl_lint,{unsafe_var,'A',{'catch',4}}},
+ {24,erl_lint,{unsafe_var,'B',{'case',2}}},
+ {24,erl_lint,{unsafe_var,'D',{'case',2}}}],
[]}}
],
?line [] = run(Config, Ts),
@@ -2648,8 +2749,9 @@ otp_11872(Config) when is_list(Config) ->
t() ->
1.
">>,
- {error,[{6,erl_lint,{undefined_type,{product,0}}}],
- [{8,erl_lint,{new_var_arity_type,map}}]} =
+ {error,[{6,erl_lint,{undefined_type,{product,0}}},
+ {8,erl_lint,{undefined_type,{dict,0}}}],
+ [{8,erl_lint,{new_builtin_type,{map,0}}}]} =
run_test2(Config, Ts, []),
ok.
@@ -3080,6 +3182,193 @@ behaviour_multiple(Config) when is_list(Config) ->
?line [] = run(Config, Ts),
ok.
+otp_11861(doc) ->
+ "OTP-11861. behaviour_info() and -callback.";
+otp_11861(suite) -> [];
+otp_11861(Conf) when is_list(Conf) ->
+ CallbackFiles = [callback1, callback2, callback3,
+ bad_behaviour1, bad_behaviour2],
+ lists:foreach(fun(M) ->
+ F = filename:join(?datadir, M),
+ Opts = [{outdir,?privdir}, return],
+ {ok, M, []} = compile:file(F, Opts)
+ end, CallbackFiles),
+ CodePath = code:get_path(),
+ true = code:add_path(?privdir),
+ Ts = [{otp_11861_1,
+ <<"
+ -export([b1/1]).
+ -behaviour(callback1).
+ -behaviour(callback2).
+
+ -spec b1(atom()) -> integer().
+ b1(A) when is_atom(A)->
+ 3.
+ ">>,
+ [],
+ %% b2/1 is optional in both modules
+ {warnings,[{4,erl_lint,
+ {conflicting_behaviours,{b1,1},callback2,3,callback1}}]}},
+ {otp_11861_2,
+ <<"
+ -export([b2/1]).
+ -behaviour(callback1).
+ -behaviour(callback2).
+
+ -spec b2(integer()) -> atom().
+ b2(I) when is_integer(I)->
+ a.
+ ">>,
+ [],
+ %% b2/1 is optional in callback2, but not in callback1
+ {warnings,[{3,erl_lint,{undefined_behaviour_func,{b1,1},callback1}},
+ {4,erl_lint,
+ {conflicting_behaviours,{b2,1},callback2,3,callback1}}]}},
+ {otp_11861_3,
+ <<"
+ -callback b(_) -> atom().
+ -optional_callbacks({b1,1}). % non-existing and ignored
+ ">>,
+ [],
+ []},
+ {otp_11861_4,
+ <<"
+ -callback b(_) -> atom().
+ -optional_callbacks([{b1,1}]). % non-existing
+ ">>,
+ [],
+ %% No behaviour-info(), but callback.
+ {errors,[{3,erl_lint,{undefined_callback,{lint_test,b1,1}}}],[]}},
+ {otp_11861_5,
+ <<"
+ -optional_callbacks([{b1,1}]). % non-existing
+ ">>,
+ [],
+ %% No behaviour-info() and no callback: warning anyway
+ {errors,[{2,erl_lint,{undefined_callback,{lint_test,b1,1}}}],[]}},
+ {otp_11861_6,
+ <<"
+ -optional_callbacks([b1/1]). % non-existing
+ behaviour_info(callbacks) -> [{b1,1}].
+ ">>,
+ [],
+ %% behaviour-info() and no callback: warning anyway
+ {errors,[{2,erl_lint,{undefined_callback,{lint_test,b1,1}}}],[]}},
+ {otp_11861_7,
+ <<"
+ -optional_callbacks([b1/1]). % non-existing
+ -callback b(_) -> atom().
+ behaviour_info(callbacks) -> [{b1,1}].
+ ">>,
+ [],
+ %% behaviour-info() callback: warning
+ {errors,[{2,erl_lint,{undefined_callback,{lint_test,b1,1}}},
+ {3,erl_lint,{behaviour_info,{lint_test,b,1}}}],
+ []}},
+ {otp_11861_8,
+ <<"
+ -callback b(_) -> atom().
+ -optional_callbacks([b/1, {b, 1}]).
+ ">>,
+ [],
+ {errors,[{3,erl_lint,{redefine_optional_callback,{b,1}}}],[]}},
+ {otp_11861_9,
+ <<"
+ -behaviour(gen_server).
+ -export([handle_call/3,handle_cast/2,handle_info/2,
+ code_change/3, init/1, terminate/2]).
+ handle_call(_, _, _) -> ok.
+ handle_cast(_, _) -> ok.
+ handle_info(_, _) -> ok.
+ code_change(_, _, _) -> ok.
+ init(_) -> ok.
+ terminate(_, _) -> ok.
+ ">>,
+ [],
+ []},
+ {otp_11861_9,
+ <<"
+ -behaviour(gen_server).
+ -export([handle_call/3,handle_cast/2,handle_info/2,
+ code_change/3, init/1, terminate/2, format_status/2]).
+ handle_call(_, _, _) -> ok.
+ handle_cast(_, _) -> ok.
+ handle_info(_, _) -> ok.
+ code_change(_, _, _) -> ok.
+ init(_) -> ok.
+ terminate(_, _) -> ok.
+ format_status(_, _) -> ok. % optional callback
+ ">>,
+ [],
+ %% Nothing...
+ []},
+ {otp_11861_10,
+ <<"
+ -optional_callbacks([{b1,1,bad}]). % badly formed and ignored
+ behaviour_info(callbacks) -> [{b1,1}].
+ ">>,
+ [],
+ []},
+ {otp_11861_11,
+ <<"
+ -behaviour(bad_behaviour1).
+ ">>,
+ [],
+ {warnings,[{2,erl_lint,
+ {ill_defined_behaviour_callbacks,bad_behaviour1}}]}},
+ {otp_11861_12,
+ <<"
+ -behaviour(non_existing_behaviour).
+ ">>,
+ [],
+ {warnings,[{2,erl_lint,
+ {undefined_behaviour,non_existing_behaviour}}]}},
+ {otp_11861_13,
+ <<"
+ -behaviour(bad_behaviour_none).
+ ">>,
+ [],
+ {warnings,[{2,erl_lint,{undefined_behaviour,bad_behaviour_none}}]}},
+ {otp_11861_14,
+ <<"
+ -callback b(_) -> atom().
+ ">>,
+ [],
+ []},
+ {otp_11861_15,
+ <<"
+ -optional_callbacks([{b1,1,bad}]). % badly formed
+ -callback b(_) -> atom().
+ ">>,
+ [],
+ []},
+ {otp_11861_16,
+ <<"
+ -callback b(_) -> atom().
+ -callback b(_) -> atom().
+ ">>,
+ [],
+ {errors,[{3,erl_lint,{redefine_callback,{b,1}}}],[]}},
+ {otp_11861_17,
+ <<"
+ -behaviour(bad_behaviour2).
+ ">>,
+ [],
+ {warnings,[{2,erl_lint,{undefined_behaviour_callbacks,
+ bad_behaviour2}}]}},
+ {otp_11861_18,
+ <<"
+ -export([f1/1]).
+ -behaviour(callback3).
+ f1(_) -> ok.
+ ">>,
+ [],
+ []}
+ ],
+ ?line [] = run(Conf, Ts),
+ true = code:set_path(CodePath),
+ ok.
+
otp_7550(doc) ->
"Test that the new utf8/utf16/utf32 types do not allow size or unit specifiers.";
otp_7550(Config) when is_list(Config) ->
@@ -3145,8 +3434,8 @@ format_warn(Config) when is_list(Config) ->
ok.
format_level(Level, Count, Config) ->
- ?line W = get_compilation_warnings(Config, "format",
- [{warn_format, Level}]),
+ ?line W = get_compilation_result(Config, "format",
+ [{warn_format, Level}]),
%% Pick out the 'format' warnings.
?line FW = lists:filter(fun({_Line, erl_lint, {format_error, _}}) -> true;
(_) -> false
@@ -3330,42 +3619,22 @@ bin_syntax_errors(Config) ->
ok.
predef(doc) ->
- "OTP-10342: Predefined types: array(), digraph(), and so on";
+ "OTP-10342: No longer predefined types: array(), digraph(), and so on";
predef(suite) -> [];
predef(Config) when is_list(Config) ->
- W = get_compilation_warnings(Config, "predef", []),
+ W = get_compilation_result(Config, "predef", []),
[] = W,
- W2 = get_compilation_warnings(Config, "predef2", []),
- Tag = deprecated_builtin_type,
- [{7,erl_lint,{Tag,{array,0},{array,array,1},"OTP 18.0"}},
- {12,erl_lint,{Tag,{dict,0},{dict,dict,2},"OTP 18.0"}},
- {17,erl_lint,{Tag,{digraph,0},{digraph,graph},"OTP 18.0"}},
- {27,erl_lint,{Tag,{gb_set,0},{gb_sets,set,1},"OTP 18.0"}},
- {32,erl_lint,{Tag,{gb_tree,0},{gb_trees,tree,2},"OTP 18.0"}},
- {37,erl_lint,{Tag,{queue,0},{queue,queue,1},"OTP 18.0"}},
- {42,erl_lint,{Tag,{set,0},{sets,set,1},"OTP 18.0"}},
- {47,erl_lint,{Tag,{tid,0},{ets,tid},"OTP 18.0"}}] = W2,
- Ts = [{otp_10342_1,
- <<"-compile(nowarn_deprecated_type).
-
- -spec t(dict()) -> non_neg_integer().
-
- t(D) ->
- erlang:phash2(D, 3000).
- ">>,
- {[nowarn_unused_function]},
- []},
- {otp_10342_2,
- <<"-spec t(dict()) -> non_neg_integer().
-
- t(D) ->
- erlang:phash2(D, 3000).
- ">>,
- {[nowarn_unused_function]},
- {warnings,[{1,erl_lint,
- {deprecated_builtin_type,{dict,0},{dict,dict,2},
- "OTP 18.0"}}]}}],
- [] = run(Config, Ts),
+ %% dict(), digraph() and so on were removed in Erlang/OTP 18.0.
+ E2 = get_compilation_result(Config, "predef2", []),
+ Tag = undefined_type,
+ {[{7,erl_lint,{Tag,{array,0}}},
+ {12,erl_lint,{Tag,{dict,0}}},
+ {17,erl_lint,{Tag,{digraph,0}}},
+ {27,erl_lint,{Tag,{gb_set,0}}},
+ {32,erl_lint,{Tag,{gb_tree,0}}},
+ {37,erl_lint,{Tag,{queue,0}}},
+ {42,erl_lint,{Tag,{set,0}}},
+ {47,erl_lint,{Tag,{tid,0}}}],[]} = E2,
ok.
maps(Config) ->
@@ -3398,7 +3667,8 @@ maps(Config) ->
g := 1 + 1,
h := _,
i := (_X = _Y),
- j := (x ! y) }) ->
+ j := (x ! y),
+ <<0:300>> := 33}) ->
{A,F}.
">>,
[],
@@ -3411,9 +3681,10 @@ maps(Config) ->
{errors,[{1,erl_lint,illegal_map_construction},
{1,erl_lint,{unbound_var,'X'}}],
[]}},
- {errors_in_map_keys,
+ {legal_map_construction,
<<"t(V) -> #{ a => 1,
#{a=>V} => 2,
+ #{{a,V}=>V} => 2,
#{ \"hi\" => wazzup, hi => ho } => yep,
[try a catch _:_ -> b end] => nope,
ok => 1.0,
@@ -3425,11 +3696,7 @@ maps(Config) ->
}.
">>,
[],
- {errors,[{2,erl_lint,{illegal_map_key_variable,'V'}},
- {4,erl_lint,illegal_map_key},
- {6,erl_lint,illegal_map_key},
- {8,erl_lint,illegal_map_key},
- {10,erl_lint,illegal_map_key}],[]}},
+ []},
{errors_in_map_keys_pattern,
<<"t(#{ a := 2,
#{} := A,
@@ -3440,8 +3707,8 @@ maps(Config) ->
A.
">>,
[],
- {errors,[{4,erl_lint,illegal_map_key},
- {6,erl_lint,{illegal_map_key_variable,'V'}}],[]}}],
+ {errors,[{4,erl_lint,illegal_map_construction},
+ {6,erl_lint,illegal_map_key}],[]}}],
[] = run(Config, Ts),
ok.
@@ -3470,7 +3737,94 @@ maps_type(Config) when is_list(Config) ->
t(M) -> M.
">>,
[],
- {warnings,[{3,erl_lint,{new_var_arity_type,map}}]}}],
+ {warnings,[{3,erl_lint,{new_builtin_type,{map,0}}}]}}],
+ [] = run(Config, Ts),
+ ok.
+
+otp_11851(doc) ->
+ "OTP-11851: More atoms can be used as type names + bug fixes.";
+otp_11851(Config) when is_list(Config) ->
+ Ts = [
+ {otp_11851_1,
+ <<"-export([t/0]).
+ -type range(A, B) :: A | B.
+
+ -type union(A) :: A.
+
+ -type product() :: integer().
+
+ -type tuple(A) :: A.
+
+ -type map(A) :: A.
+
+ -type record() :: a | b.
+
+ -type integer(A) :: A.
+
+ -type atom(A) :: A.
+
+ -type binary(A, B) :: A | B.
+
+ -type 'fun'() :: integer().
+
+ -type 'fun'(X) :: X.
+
+ -type 'fun'(X, Y) :: X | Y.
+
+ -type all() :: range(atom(), integer()) | union(pid()) | product()
+ | tuple(reference()) | map(function()) | record()
+ | integer(atom()) | atom(integer())
+ | binary(pid(), tuple()) | 'fun'(port())
+ | 'fun'() | 'fun'(<<>>, 'none').
+
+ -spec t() -> all().
+
+ t() ->
+ a.
+ ">>,
+ [],
+ []},
+ {otp_11851_2,
+ <<"-export([a/1, b/1, t/0]).
+
+ -callback b(_) -> integer().
+
+ -callback ?MODULE:a(_) -> integer().
+
+ a(_) -> 3.
+
+ b(_) -> a.
+
+ t()-> a.
+ ">>,
+ [],
+ {errors,[{5,erl_lint,{bad_callback,{lint_test,a,1}}}],[]}},
+ {otp_11851_3,
+ <<"-export([a/1]).
+
+ -spec a(_A) -> boolean() when
+ _ :: atom(),
+ _A :: integer().
+
+ a(_) -> true.
+ ">>,
+ [],
+ {errors,[{4,erl_parse,"bad type variable"}],[]}},
+ {otp_11851_4,
+ <<"
+ -spec a(_) -> ok.
+ -spec a(_) -> ok.
+
+ -spec ?MODULE:a(_) -> ok.
+ -spec ?MODULE:a(_) -> ok.
+ ">>,
+ [],
+ {errors,[{3,erl_lint,{redefine_spec,{a,1}}},
+ {5,erl_lint,{redefine_spec,{lint_test,a,1}}},
+ {6,erl_lint,{redefine_spec,{lint_test,a,1}}},
+ {6,erl_lint,{spec_fun_undefined,{a,1}}}],
+ []}}
+ ],
[] = run(Config, Ts),
ok.
@@ -3487,9 +3841,9 @@ run(Config, Tests) ->
end,
lists:foldl(F, [], Tests).
-%% Compiles a test file and returns the list of warnings.
+%% Compiles a test file and returns the list of warnings/errors.
-get_compilation_warnings(Conf, Filename, Warnings) ->
+get_compilation_result(Conf, Filename, Warnings) ->
?line DataDir = ?datadir,
?line File = filename:join(DataDir, Filename),
{ok,Bin} = file:read_file(File++".erl"),
@@ -3498,6 +3852,7 @@ get_compilation_warnings(Conf, Filename, Warnings) ->
Test = lists:nthtail(Start+Length, FileS),
case run_test(Conf, Test, Warnings) of
{warnings, Ws} -> Ws;
+ {errors,Es,Ws} -> {Es,Ws};
[] -> []
end.
diff --git a/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl
new file mode 100644
index 0000000000..230f4b4519
--- /dev/null
+++ b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl
@@ -0,0 +1,6 @@
+-module(bad_behaviour1).
+
+-export([behaviour_info/1]).
+
+behaviour_info(callbacks) ->
+ [{a,1,bad}].
diff --git a/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour2.erl b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour2.erl
new file mode 100644
index 0000000000..bb755ce18b
--- /dev/null
+++ b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour2.erl
@@ -0,0 +1,6 @@
+-module(bad_behaviour2).
+
+-export([behaviour_info/1]).
+
+behaviour_info(callbacks) ->
+ undefined.
diff --git a/lib/stdlib/test/erl_lint_SUITE_data/callback1.erl b/lib/stdlib/test/erl_lint_SUITE_data/callback1.erl
new file mode 100644
index 0000000000..3cc5b51879
--- /dev/null
+++ b/lib/stdlib/test/erl_lint_SUITE_data/callback1.erl
@@ -0,0 +1,6 @@
+-module(callback1).
+
+-callback b1(I :: integer()) -> atom().
+-callback b2(A :: atom()) -> integer().
+
+-optional_callbacks([{b2,1}]).
diff --git a/lib/stdlib/test/erl_lint_SUITE_data/callback2.erl b/lib/stdlib/test/erl_lint_SUITE_data/callback2.erl
new file mode 100644
index 0000000000..211cf9f115
--- /dev/null
+++ b/lib/stdlib/test/erl_lint_SUITE_data/callback2.erl
@@ -0,0 +1,6 @@
+-module(callback2).
+
+-callback b1(I :: integer()) -> atom().
+-callback b2(A :: atom()) -> integer().
+
+-optional_callbacks([b1/1, b2/1]).
diff --git a/lib/stdlib/test/erl_lint_SUITE_data/callback3.erl b/lib/stdlib/test/erl_lint_SUITE_data/callback3.erl
new file mode 100644
index 0000000000..97b3ecb860
--- /dev/null
+++ b/lib/stdlib/test/erl_lint_SUITE_data/callback3.erl
@@ -0,0 +1,8 @@
+-module(callback3).
+
+-export([behaviour_info/1]).
+
+behaviour_info(callbacks) ->
+ [{f1, 1}];
+behaviour_info(_) ->
+ undefined.
diff --git a/lib/stdlib/test/erl_lint_SUITE_data/predef.erl b/lib/stdlib/test/erl_lint_SUITE_data/predef.erl
index ee9073aa67..3cb7bf40f1 100644
--- a/lib/stdlib/test/erl_lint_SUITE_data/predef.erl
+++ b/lib/stdlib/test/erl_lint_SUITE_data/predef.erl
@@ -5,8 +5,8 @@
-export_type([array/0, digraph/0, gb_set/0]).
-%% Before Erlang/OTP 17.0 local re-definitions of pre-defined opaque
-%% types were ignored but did not generate any warning.
+%% Since Erlang/OTP 18.0 array() and so on are no longer pre-defined,
+%% so there is nothing special about them at all.
-opaque array() :: atom().
-opaque digraph() :: atom().
-opaque gb_set() :: atom().
diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl
index 927fe0b595..046b5cf330 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-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -50,7 +50,7 @@
otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1,
otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1,
- otp_10302/1, otp_10820/1, otp_11100/1]).
+ otp_10302/1, otp_10820/1, otp_11100/1, otp_11861/1]).
%% Internal export.
-export([ehook/6]).
@@ -83,7 +83,7 @@ groups() ->
{tickets, [],
[otp_6321, otp_6911, otp_6914, otp_8150, otp_8238,
otp_8473, otp_8522, otp_8567, otp_8664, otp_9147,
- otp_10302, otp_10820, otp_11100]}].
+ otp_10302, otp_10820, otp_11100, otp_11861]}].
init_per_suite(Config) ->
Config.
@@ -874,6 +874,7 @@ type_examples() ->
{ex3,<<"-type paren() :: (ann2()). ">>},
{ex4,<<"-type t1() :: atom(). ">>},
{ex5,<<"-type t2() :: [t1()]. ">>},
+ {ex56,<<"-type integer(A) :: A. ">>},
{ex6,<<"-type t3(Atom) :: integer(Atom). ">>},
{ex7,<<"-type '\\'t::4'() :: t3('\\'foobar'). ">>},
{ex8,<<"-type t5() :: {t1(), t3(foo)}. ">>},
@@ -1204,8 +1205,18 @@ otp_11100(Config) when is_list(Config) ->
[]}}),
ok.
+otp_11861(doc) ->
+ "OTP-11861. behaviour_info() and -callback.";
+otp_11861(suite) -> [];
+otp_11861(Config) when is_list(Config) ->
+ "-optional_callbacks([bar/0]).\n" =
+ pf({attribute,3,optional_callbacks,[{bar,0}]}),
+ "-optional_callbacks([{bar,1,bad}]).\n" =
+ pf({attribute,4,optional_callbacks,[{bar,1,bad}]}),
+ ok.
+
pf(Form) ->
- lists:flatten(erl_pp:form(Form,none)).
+ lists:flatten(erl_pp:form(Form, none)).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl
index bd313390b3..146d810189 100644
--- a/lib/stdlib/test/filelib_SUITE.erl
+++ b/lib/stdlib/test/filelib_SUITE.erl
@@ -77,7 +77,8 @@ wildcard_one(Config) when is_list(Config) ->
L = filelib:wildcard(Wc),
L = filelib:wildcard(Wc, erl_prim_loader),
L = filelib:wildcard(Wc, "."),
- L = filelib:wildcard(Wc, Dir)
+ L = filelib:wildcard(Wc, Dir),
+ L = filelib:wildcard(Wc, Dir++"/.")
end),
?line file:set_cwd(OldCwd),
?line ok = file:del_dir(Dir),
diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl
index ecd9cff9f9..6f1d1a891d 100644
--- a/lib/stdlib/test/filename_SUITE.erl
+++ b/lib/stdlib/test/filename_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -287,38 +287,66 @@ extension(Config) when is_list(Config) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
join(Config) when is_list(Config) ->
+ %% Whenever joining two elements, test the equivalence between
+ %% join/1 and join/2 (OTP-12158) by using help function
+ %% filename_join/2.
?line "/" = filename:join(["/"]),
?line "/" = filename:join(["//"]),
- ?line "usr/foo.erl" = filename:join("usr","foo.erl"),
- ?line "/src/foo.erl" = filename:join(usr, "/src/foo.erl"),
- ?line "/src/foo.erl" = filename:join(["/src/",'foo.erl']),
- ?line "/src/foo.erl" = filename:join(usr, ["/sr", 'c/foo.erl']),
- ?line "/src/foo.erl" = filename:join("usr", "/src/foo.erl"),
+ "usr/foo.erl" = filename_join("usr","foo.erl"),
+ "/src/foo.erl" = filename_join(usr, "/src/foo.erl"),
+ "/src/foo.erl" = filename_join("/src/",'foo.erl'),
+ "/src/foo.erl" = filename_join(usr, ["/sr", 'c/foo.erl']),
+ "/src/foo.erl" = filename_join("usr", "/src/foo.erl"),
%% Make sure that redundant slashes work too.
?line "a/b/c/d/e/f/g" = filename:join(["a//b/c/////d//e/f/g"]),
- ?line "a/b/c/d/e/f/g" = filename:join(["a//b/c/", "d//e/f/g"]),
- ?line "a/b/c/d/e/f/g" = filename:join(["a//b/c", "d//e/f/g"]),
- ?line "/d/e/f/g" = filename:join(["a//b/c", "/d//e/f/g"]),
- ?line "/d/e/f/g" = filename:join(["a//b/c", "//d//e/f/g"]),
-
- ?line "foo/bar" = filename:join([$f,$o,$o,$/,[]], "bar"),
+ "a/b/c/d/e/f/g" = filename_join("a//b/c/", "d//e/f/g"),
+ "a/b/c/d/e/f/g" = filename_join("a//b/c", "d//e/f/g"),
+ "/d/e/f/g" = filename_join("a//b/c", "/d//e/f/g"),
+ "/d/e/f/g" = filename:join("a//b/c", "//d//e/f/g"),
+
+ "foo/bar" = filename_join([$f,$o,$o,$/,[]], "bar"),
+
+ %% Single dots - should be removed if in the middle of the path,
+ %% but not at the end of the path.
+ "/." = filename:join(["/."]),
+ "/" = filename:join(["/./"]),
+ "/." = filename:join(["/./."]),
+ "./." = filename:join(["./."]),
+
+ "/a/b" = filename_join("/a/.","b"),
+ "/a/b/." = filename_join("/a/.","b/."),
+ "/a/." = filename_join("/a/.","."),
+ "/a/." = filename_join("/a","."),
+ "/a/." = filename_join("/a/.",""),
+ "./." = filename_join("./.","."),
+ "./." = filename_join("./","."),
+ "./." = filename_join("./.",""),
+ "." = filename_join(".",""),
+ "./." = filename_join(".","."),
+
+ %% Trailing slash shall be removed - except the root
+ "/" = filename:join(["/"]),
+ "/" = filename:join(["/./"]),
+ "/a" = filename:join(["/a/"]),
+ "/b" = filename_join("/a/","/b/"),
+ "/a/b" = filename_join("/a/","b/"),
?line case os:type() of
{win32, _} ->
?line "d:/" = filename:join(["D:/"]),
?line "d:/" = filename:join(["D:\\"]),
- ?line "d:/abc" = filename:join(["D:/", "abc"]),
- ?line "d:abc" = filename:join(["D:", "abc"]),
+ "d:/abc" = filename_join("D:/", "abc"),
+ "d:abc" = filename_join("D:", "abc"),
?line "a/b/c/d/e/f/g" =
filename:join(["a//b\\c//\\/\\d/\\e/f\\g"]),
?line "a:usr/foo.erl" =
filename:join(["A:","usr","foo.erl"]),
?line "/usr/foo.erl" =
filename:join(["A:","/usr","foo.erl"]),
- ?line "c:usr" = filename:join("A:","C:usr"),
- ?line "a:usr" = filename:join("A:","usr"),
- ?line "c:/usr" = filename:join("A:", "C:/usr"),
+ "c:usr" = filename_join("A:","C:usr"),
+ "a:usr" = filename_join("A:","usr"),
+ "c:/usr" = filename_join("A:", "C:/usr"),
?line "c:/usr/foo.erl" =
filename:join(["A:","C:/usr","foo.erl"]),
?line "c:usr/foo.erl" =
@@ -329,6 +357,11 @@ join(Config) when is_list(Config) ->
ok
end.
+%% Make sure join([A,B]) is equivalent to join(A,B) (OTP-12158)
+filename_join(A,B) ->
+ Res = filename:join(A,B),
+ Res = filename:join([A,B]).
+
pathtype(Config) when is_list(Config) ->
?line relative = filename:pathtype(".."),
?line relative = filename:pathtype("foo"),
@@ -633,6 +666,53 @@ join_bin(Config) when is_list(Config) ->
?line <<"foo/bar">> = filename:join([$f,$o,$o,$/,[]], <<"bar">>),
+ %% Single dots - should be removed if in the middle of the path,
+ %% but not at the end of the path.
+ %% Also test equivalence between join/1 and join/2 (OTP-12158)
+ <<"/.">> = filename:join([<<"/.">>]),
+ <<"/">> = filename:join([<<"/./">>]),
+ <<"/.">> = filename:join([<<"/./.">>]),
+ <<"./.">> = filename:join([<<"./.">>]),
+
+ <<"/a/b">> = filename:join([<<"/a/.">>,<<"b">>]),
+ <<"/a/b">> = filename:join(<<"/a/.">>,<<"b">>),
+
+ <<"/a/b/.">> = filename:join([<<"/a/.">>,<<"b/.">>]),
+ <<"/a/b/.">> = filename:join(<<"/a/.">>,<<"b/.">>),
+
+ <<"/a/.">> = filename:join([<<"/a/.">>,<<".">>]),
+ <<"/a/.">> = filename:join(<<"/a/.">>,<<".">>),
+
+ <<"/a/.">> = filename:join([<<"/a">>,<<".">>]),
+ <<"/a/.">> = filename:join(<<"/a">>,<<".">>),
+
+ <<"/a/.">> = filename:join([<<"/a/.">>,<<"">>]),
+ <<"/a/.">> = filename:join(<<"/a/.">>,<<"">>),
+
+ <<"./.">> = filename:join([<<"./.">>,<<".">>]),
+ <<"./.">> = filename:join(<<"./.">>,<<".">>),
+
+ <<"./.">> = filename:join([<<"./">>,<<".">>]),
+ <<"./.">> = filename:join(<<"./">>,<<".">>),
+
+ <<"./.">> = filename:join([<<"./.">>,<<"">>]),
+ <<"./.">> = filename:join(<<"./.">>,<<"">>),
+
+ <<".">> = filename:join([<<".">>,<<"">>]),
+ <<".">> = filename:join(<<".">>,<<"">>),
+
+ <<"./.">> = filename:join([<<".">>,<<".">>]),
+ <<"./.">> = filename:join(<<".">>,<<".">>),
+
+ %% Trailing slash shall be removed - except the root
+ <<"/">> = filename:join([<<"/">>]),
+ <<"/">> = filename:join([<<"/./">>]),
+ <<"/a">> = filename:join([<<"/a/">>]),
+ <<"/b">> = filename:join([<<"/a/">>,<<"/b/">>]),
+ <<"/b">> = filename:join(<<"/a/">>,<<"/b/">>),
+ <<"/a/b">> = filename:join([<<"/a/">>,<<"b/">>]),
+ <<"/a/b">> = filename:join(<<"/a/">>,<<"b/">>),
+
?line case os:type() of
{win32, _} ->
?line <<"d:/">> = filename:join([<<"D:/">>]),
diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl
index 60a1ba8c60..576a5adfce 100644
--- a/lib/stdlib/test/gen_event_SUITE.erl
+++ b/lib/stdlib/test/gen_event_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -106,7 +106,7 @@ start(Config) when is_list(Config) ->
?line {error, {already_started, _}} =
gen_event:start({global, my_dummy_name}),
- exit(Pid6, shutdown),
+ ok = gen_event:stop({global, my_dummy_name}, shutdown, 10000),
receive
{'EXIT', Pid6, shutdown} -> ok
after 10000 ->
diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl
index 336065b258..75796ab1b6 100644
--- a/lib/stdlib/test/gen_fsm_SUITE.erl
+++ b/lib/stdlib/test/gen_fsm_SUITE.erl
@@ -27,6 +27,9 @@
-export([start1/1, start2/1, start3/1, start4/1, start5/1, start6/1,
start7/1, start8/1, start9/1, start10/1, start11/1, start12/1]).
+-export([stop1/1, stop2/1, stop3/1, stop4/1, stop5/1, stop6/1, stop7/1,
+ stop8/1, stop9/1, stop10/1]).
+
-export([ abnormal1/1, abnormal2/1]).
-export([shutdown/1]).
@@ -66,6 +69,8 @@ groups() ->
[{start, [],
[start1, start2, start3, start4, start5, start6, start7,
start8, start9, start10, start11, start12]},
+ {stop, [],
+ [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]},
{abnormal, [], [abnormal1, abnormal2]},
{sys, [],
[sys1, call_format_status, error_format_status, terminate_crash_format,
@@ -281,6 +286,105 @@ start12(Config) when is_list(Config) ->
ok.
+%% Anonymous, reason 'normal'
+stop1(_Config) ->
+ {ok, Pid} = gen_fsm:start(?MODULE, [], []),
+ ok = gen_fsm:stop(Pid),
+ false = erlang:is_process_alive(Pid),
+ {'EXIT',noproc} = (catch gen_fsm:stop(Pid)),
+ ok.
+
+%% Anonymous, other reason
+stop2(_Config) ->
+ {ok,Pid} = gen_fsm:start(?MODULE, [], []),
+ ok = gen_fsm:stop(Pid, other_reason, infinity),
+ false = erlang:is_process_alive(Pid),
+ ok.
+
+%% Anonymous, invalid timeout
+stop3(_Config) ->
+ {ok,Pid} = gen_fsm:start(?MODULE, [], []),
+ {'EXIT',_} = (catch gen_fsm:stop(Pid, other_reason, invalid_timeout)),
+ true = erlang:is_process_alive(Pid),
+ ok = gen_fsm:stop(Pid),
+ false = erlang:is_process_alive(Pid),
+ ok.
+
+%% Registered name
+stop4(_Config) ->
+ {ok,Pid} = gen_fsm:start({local,to_stop},?MODULE, [], []),
+ ok = gen_fsm:stop(to_stop),
+ false = erlang:is_process_alive(Pid),
+ {'EXIT',noproc} = (catch gen_fsm:stop(to_stop)),
+ ok.
+
+%% Registered name and local node
+stop5(_Config) ->
+ {ok,Pid} = gen_fsm:start({local,to_stop},?MODULE, [], []),
+ ok = gen_fsm:stop({to_stop,node()}),
+ false = erlang:is_process_alive(Pid),
+ {'EXIT',noproc} = (catch gen_fsm:stop({to_stop,node()})),
+ ok.
+
+%% Globally registered name
+stop6(_Config) ->
+ {ok, Pid} = gen_fsm:start({global, to_stop}, ?MODULE, [], []),
+ ok = gen_fsm:stop({global,to_stop}),
+ false = erlang:is_process_alive(Pid),
+ {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})),
+ ok.
+
+%% 'via' registered name
+stop7(_Config) ->
+ dummy_via:reset(),
+ {ok, Pid} = gen_fsm:start({via, dummy_via, to_stop},
+ ?MODULE, [], []),
+ ok = gen_fsm:stop({via, dummy_via, to_stop}),
+ false = erlang:is_process_alive(Pid),
+ {'EXIT',noproc} = (catch gen_fsm:stop({via, dummy_via, to_stop})),
+ ok.
+
+%% Anonymous on remote node
+stop8(_Config) ->
+ {ok,Node} = test_server:start_node(gen_fsm_SUITE_stop8,slave,[]),
+ Dir = filename:dirname(code:which(?MODULE)),
+ rpc:call(Node,code,add_path,[Dir]),
+ {ok, Pid} = rpc:call(Node,gen_fsm,start,[?MODULE,[],[]]),
+ ok = gen_fsm:stop(Pid),
+ false = rpc:call(Node,erlang,is_process_alive,[Pid]),
+ {'EXIT',noproc} = (catch gen_fsm:stop(Pid)),
+ true = test_server:stop_node(Node),
+ {'EXIT',{{nodedown,Node},_}} = (catch gen_fsm:stop(Pid)),
+ ok.
+
+%% Registered name on remote node
+stop9(_Config) ->
+ {ok,Node} = test_server:start_node(gen_fsm_SUITE_stop9,slave,[]),
+ Dir = filename:dirname(code:which(?MODULE)),
+ rpc:call(Node,code,add_path,[Dir]),
+ {ok, Pid} = rpc:call(Node,gen_fsm,start,[{local,to_stop},?MODULE,[],[]]),
+ ok = gen_fsm:stop({to_stop,Node}),
+ undefined = rpc:call(Node,erlang,whereis,[to_stop]),
+ false = rpc:call(Node,erlang,is_process_alive,[Pid]),
+ {'EXIT',noproc} = (catch gen_fsm:stop({to_stop,Node})),
+ true = test_server:stop_node(Node),
+ {'EXIT',{{nodedown,Node},_}} = (catch gen_fsm:stop({to_stop,Node})),
+ ok.
+
+%% Globally registered name on remote node
+stop10(_Config) ->
+ {ok,Node} = test_server:start_node(gen_fsm_SUITE_stop10,slave,[]),
+ 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 = gen_fsm:stop({global,to_stop}),
+ false = rpc:call(Node,erlang,is_process_alive,[Pid]),
+ {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})),
+ true = test_server:stop_node(Node),
+ {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})),
+ ok.
+
%% Check that time outs in calls work
abnormal1(suite) -> [];
abnormal1(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl
index 42694d8b5d..8b6654dd5e 100644
--- a/lib/stdlib/test/gen_server_SUITE.erl
+++ b/lib/stdlib/test/gen_server_SUITE.erl
@@ -36,6 +36,9 @@
get_state/1, replace_state/1, call_with_huge_message_queue/1
]).
+-export([stop1/1, stop2/1, stop3/1, stop4/1, stop5/1, stop6/1, stop7/1,
+ stop8/1, stop9/1, stop10/1]).
+
% spawn export
-export([spec_init_local/2, spec_init_global/2, spec_init_via/2,
spec_init_default_timeout/2, spec_init_global_default_timeout/2,
@@ -51,7 +54,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [start, crash, call, cast, cast_fast, info, abcast,
+ [start, {group,stop}, crash, call, cast, cast_fast, info, abcast,
multicall, multicall_down, call_remote1, call_remote2,
call_remote3, call_remote_n1, call_remote_n2,
call_remote_n3, spec_init,
@@ -63,7 +66,8 @@ all() ->
call_with_huge_message_queue].
groups() ->
- [].
+ [{stop, [],
+ [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]}].
init_per_suite(Config) ->
Config.
@@ -237,6 +241,105 @@ start(Config) when is_list(Config) ->
process_flag(trap_exit, OldFl),
ok.
+%% Anonymous, reason 'normal'
+stop1(_Config) ->
+ {ok, Pid} = gen_server:start(?MODULE, [], []),
+ ok = gen_server:stop(Pid),
+ false = erlang:is_process_alive(Pid),
+ {'EXIT',noproc} = (catch gen_server:stop(Pid)),
+ ok.
+
+%% Anonymous, other reason
+stop2(_Config) ->
+ {ok,Pid} = gen_server:start(?MODULE, [], []),
+ ok = gen_server:stop(Pid, other_reason, infinity),
+ false = erlang:is_process_alive(Pid),
+ ok.
+
+%% Anonymous, invalid timeout
+stop3(_Config) ->
+ {ok,Pid} = gen_server:start(?MODULE, [], []),
+ {'EXIT',_} = (catch gen_server:stop(Pid, other_reason, invalid_timeout)),
+ true = erlang:is_process_alive(Pid),
+ ok = gen_server:stop(Pid),
+ false = erlang:is_process_alive(Pid),
+ ok.
+
+%% Registered name
+stop4(_Config) ->
+ {ok,Pid} = gen_server:start({local,to_stop},?MODULE, [], []),
+ ok = gen_server:stop(to_stop),
+ false = erlang:is_process_alive(Pid),
+ {'EXIT',noproc} = (catch gen_server:stop(to_stop)),
+ ok.
+
+%% Registered name and local node
+stop5(_Config) ->
+ {ok,Pid} = gen_server:start({local,to_stop},?MODULE, [], []),
+ ok = gen_server:stop({to_stop,node()}),
+ false = erlang:is_process_alive(Pid),
+ {'EXIT',noproc} = (catch gen_server:stop({to_stop,node()})),
+ ok.
+
+%% Globally registered name
+stop6(_Config) ->
+ {ok, Pid} = gen_server:start({global, to_stop}, ?MODULE, [], []),
+ ok = gen_server:stop({global,to_stop}),
+ false = erlang:is_process_alive(Pid),
+ {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})),
+ ok.
+
+%% 'via' registered name
+stop7(_Config) ->
+ dummy_via:reset(),
+ {ok, Pid} = gen_server:start({via, dummy_via, to_stop},
+ ?MODULE, [], []),
+ ok = gen_server:stop({via, dummy_via, to_stop}),
+ false = erlang:is_process_alive(Pid),
+ {'EXIT',noproc} = (catch gen_server:stop({via, dummy_via, to_stop})),
+ ok.
+
+%% Anonymous on remote node
+stop8(_Config) ->
+ {ok,Node} = test_server:start_node(gen_server_SUITE_stop8,slave,[]),
+ Dir = filename:dirname(code:which(?MODULE)),
+ rpc:call(Node,code,add_path,[Dir]),
+ {ok, Pid} = rpc:call(Node,gen_server,start,[?MODULE,[],[]]),
+ ok = gen_server:stop(Pid),
+ false = rpc:call(Node,erlang,is_process_alive,[Pid]),
+ {'EXIT',noproc} = (catch gen_server:stop(Pid)),
+ true = test_server:stop_node(Node),
+ {'EXIT',{{nodedown,Node},_}} = (catch gen_server:stop(Pid)),
+ ok.
+
+%% Registered name on remote node
+stop9(_Config) ->
+ {ok,Node} = test_server:start_node(gen_server_SUITE_stop9,slave,[]),
+ Dir = filename:dirname(code:which(?MODULE)),
+ rpc:call(Node,code,add_path,[Dir]),
+ {ok, Pid} = rpc:call(Node,gen_server,start,[{local,to_stop},?MODULE,[],[]]),
+ ok = gen_server:stop({to_stop,Node}),
+ undefined = rpc:call(Node,erlang,whereis,[to_stop]),
+ false = rpc:call(Node,erlang,is_process_alive,[Pid]),
+ {'EXIT',noproc} = (catch gen_server:stop({to_stop,Node})),
+ true = test_server:stop_node(Node),
+ {'EXIT',{{nodedown,Node},_}} = (catch gen_server:stop({to_stop,Node})),
+ ok.
+
+%% Globally registered name on remote node
+stop10(_Config) ->
+ {ok,Node} = test_server:start_node(gen_server_SUITE_stop10,slave,[]),
+ 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 = gen_server:stop({global,to_stop}),
+ false = rpc:call(Node,erlang,is_process_alive,[Pid]),
+ {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})),
+ true = test_server:stop_node(Node),
+ {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})),
+ ok.
+
crash(Config) when is_list(Config) ->
?line error_logger_forwarder:register(),
diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl
index 8dca69bac4..b6f1973a05 100644
--- a/lib/stdlib/test/proc_lib_SUITE.erl
+++ b/lib/stdlib/test/proc_lib_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -27,7 +27,7 @@
init_per_group/2,end_per_group/2,
crash/1, sync_start_nolink/1, sync_start_link/1,
spawn_opt/1, sp1/0, sp2/0, sp3/1, sp4/2, sp5/1,
- hibernate/1]).
+ hibernate/1, stop/1]).
-export([ otp_6345/1, init_dont_hang/1]).
-export([hib_loop/1, awaken/1]).
@@ -38,6 +38,7 @@
-export([otp_6345_init/1, init_dont_hang_init/1]).
+-export([system_terminate/4]).
-ifdef(STANDALONE).
-define(line, noop, ).
@@ -49,7 +50,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[crash, {group, sync_start}, spawn_opt, hibernate,
- {group, tickets}].
+ {group, tickets}, stop].
groups() ->
[{tickets, [], [otp_6345, init_dont_hang]},
@@ -361,10 +362,94 @@ init_dont_hang(Config) when is_list(Config) ->
exit(Error)
end.
-init_dont_hang_init(Parent) ->
+init_dont_hang_init(_Parent) ->
1 = 2.
+%% Test proc_lib:stop/1,3
+stop(_Config) ->
+ Parent = self(),
+ SysMsgProc =
+ fun() ->
+ receive
+ {system,From,Request} ->
+ sys:handle_system_msg(Request,From,Parent,?MODULE,[],[])
+ end
+ end,
+
+ %% Normal case:
+ %% Process handles system message and terminated with given reason
+ Pid1 = proc_lib:spawn(SysMsgProc),
+ ok = proc_lib:stop(Pid1),
+ false = erlang:is_process_alive(Pid1),
+
+ %% Process does not exit
+ {'EXIT',noproc} = (catch proc_lib:stop(Pid1)),
+
+ %% Badly handled system message
+ DieProc =
+ fun() ->
+ receive
+ {system,_From,_Request} ->
+ exit(die)
+ end
+ end,
+ Pid2 = proc_lib:spawn(DieProc),
+ {'EXIT',{die,_}} = (catch proc_lib:stop(Pid2)),
+
+ %% Hanging process => timeout
+ HangProc =
+ fun() ->
+ receive
+ {system,_From,_Request} ->
+ timer:sleep(5000)
+ end
+ end,
+ Pid3 = proc_lib:spawn(HangProc),
+ {'EXIT',timeout} = (catch proc_lib:stop(Pid3,normal,1000)),
+
+ %% Success case with other reason than 'normal'
+ Pid4 = proc_lib:spawn(SysMsgProc),
+ ok = proc_lib:stop(Pid4,other_reason,infinity),
+ false = erlang:is_process_alive(Pid4),
+
+ %% System message is handled, but process dies with other reason
+ %% than the given (in system_terminate/4 below)
+ Pid5 = proc_lib:spawn(SysMsgProc),
+ {'EXIT',{badmatch,2}} = (catch proc_lib:stop(Pid5,crash,infinity)),
+ false = erlang:is_process_alive(Pid5),
+
+ %% Local registered name
+ Pid6 = proc_lib:spawn(SysMsgProc),
+ register(to_stop,Pid6),
+ ok = proc_lib:stop(to_stop),
+ undefined = whereis(to_stop),
+ false = erlang:is_process_alive(Pid6),
+
+ %% Remote registered name
+ {ok,Node} = test_server:start_node(proc_lib_SUITE_stop,slave,[]),
+ Dir = filename:dirname(code:which(?MODULE)),
+ rpc:call(Node,code,add_path,[Dir]),
+ Pid7 = spawn(Node,SysMsgProc),
+ true = rpc:call(Node,erlang,register,[to_stop,Pid7]),
+ Pid7 = rpc:call(Node,erlang,whereis,[to_stop]),
+ ok = proc_lib:stop({to_stop,Node}),
+ undefined = rpc:call(Node,erlang,whereis,[to_stop]),
+ false = rpc:call(Node,erlang,is_process_alive,[Pid7]),
+
+ %% Local and remote registered name, but non-existing
+ {'EXIT',noproc} = (catch proc_lib:stop(to_stop)),
+ {'EXIT',noproc} = (catch proc_lib:stop({to_stop,Node})),
+
+ true = test_server:stop_node(Node),
+
+ %% Remote registered name, but non-existing node
+ {'EXIT',{{nodedown,Node},_}} = (catch proc_lib:stop({to_stop,Node})),
+ ok.
+system_terminate(crash,_Parent,_Deb,_State) ->
+ 1 = 2;
+system_terminate(Reason,_Parent,_Deb,_State) ->
+ exit(Reason).
%%-----------------------------------------------------------------
%% The error_logger handler used.
diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl
index 3d09bd27ff..6669a21b9c 100644
--- a/lib/stdlib/test/stdlib_SUITE.erl
+++ b/lib/stdlib/test/stdlib_SUITE.erl
@@ -22,14 +22,7 @@
-module(stdlib_SUITE).
-include_lib("test_server/include/test_server.hrl").
-
-% Test server specific exports
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2]).
--export([init_per_testcase/2, end_per_testcase/2]).
-
-% Test cases must be exported.
--export([app_test/1, appup_test/1]).
+-compile(export_all).
%%
%% all/1
@@ -37,10 +30,10 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [app_test, appup_test].
+ [app_test, appup_test, {group,upgrade}].
groups() ->
- [].
+ [{upgrade,[minor_upgrade,major_upgrade]}].
init_per_suite(Config) ->
Config.
@@ -48,9 +41,13 @@ init_per_suite(Config) ->
end_per_suite(_Config) ->
ok.
+init_per_group(upgrade, Config) ->
+ ct_release_test:init(Config);
init_per_group(_GroupName, Config) ->
Config.
+end_per_group(upgrade, Config) ->
+ ct_release_test:cleanup(Config);
end_per_group(_GroupName, Config) ->
Config.
@@ -165,3 +162,19 @@ check_appup([Vsn|Vsns],Instrs,Expected) ->
end;
check_appup([],_,_) ->
ok.
+
+
+minor_upgrade(Config) ->
+ ct_release_test:upgrade(stdlib,minor,{?MODULE,[]},Config).
+
+major_upgrade(Config) ->
+ ct_release_test:upgrade(stdlib,major,{?MODULE,[]},Config).
+
+%% Version numbers are checked by ct_release_test, so there is nothing
+%% more to check here...
+upgrade_init(State) ->
+ State.
+upgrade_upgraded(State) ->
+ State.
+upgrade_downgraded(State) ->
+ State.
diff --git a/lib/stdlib/test/sys_SUITE.erl b/lib/stdlib/test/sys_SUITE.erl
index f38bc87ae5..047ee9f1fa 100644
--- a/lib/stdlib/test/sys_SUITE.erl
+++ b/lib/stdlib/test/sys_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -202,14 +202,7 @@ spec_proc(Mod) ->
{Mod,system_get_state},{throw,fail}},_}} ->
ok
end,
- Mod:stop(),
- WaitForUnregister = fun W() ->
- case whereis(Mod) of
- undefined -> ok;
- _ -> timer:sleep(10), W()
- end
- end,
- WaitForUnregister(),
+ ok = sys:terminate(Mod, normal),
{ok,_} = Mod:start_link(4),
ok = case catch sys:replace_state(Mod, fun(_) -> {} end) of
{} ->
@@ -218,8 +211,7 @@ spec_proc(Mod) ->
{Mod,system_replace_state},{throw,fail}},_}} ->
ok
end,
- Mod:stop(),
- WaitForUnregister(),
+ ok = sys:terminate(Mod, normal),
{ok,_} = Mod:start_link(4),
StateFun = fun(_) -> error(fail) end,
ok = case catch sys:replace_state(Mod, StateFun) of
@@ -231,7 +223,7 @@ spec_proc(Mod) ->
{'EXIT',{{callback_failed,StateFun,{error,fail}},_}} ->
ok
end,
- Mod:stop().
+ ok = sys:terminate(Mod, normal).
%%%%%%%%%%%%%%%%%%%%
%% Dummy server
diff --git a/lib/stdlib/test/sys_sp1.erl b/lib/stdlib/test/sys_sp1.erl
index e84ffcfa12..0fb288991f 100644
--- a/lib/stdlib/test/sys_sp1.erl
+++ b/lib/stdlib/test/sys_sp1.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -17,7 +17,7 @@
%% %CopyrightEnd%
%%
-module(sys_sp1).
--export([start_link/1, stop/0]).
+-export([start_link/1]).
-export([alloc/0, free/1]).
-export([init/1]).
-export([system_continue/3, system_terminate/4,
@@ -31,10 +31,6 @@
start_link(NumCh) ->
proc_lib:start_link(?MODULE, init, [[self(),NumCh]]).
-stop() ->
- ?MODULE ! stop,
- ok.
-
alloc() ->
?MODULE ! {self(), alloc},
receive
@@ -70,11 +66,7 @@ loop(Chs, Parent, Deb) ->
loop(Chs2, Parent, Deb2);
{system, From, Request} ->
sys:handle_system_msg(Request, From, Parent,
- ?MODULE, Deb, Chs);
- stop ->
- sys:handle_debug(Deb, fun write_debug/3,
- ?MODULE, {in, stop}),
- ok
+ ?MODULE, Deb, Chs)
end.
system_continue(Parent, Deb, Chs) ->
diff --git a/lib/stdlib/test/sys_sp2.erl b/lib/stdlib/test/sys_sp2.erl
index 56a5e4d071..a0847b5838 100644
--- a/lib/stdlib/test/sys_sp2.erl
+++ b/lib/stdlib/test/sys_sp2.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -17,7 +17,7 @@
%% %CopyrightEnd%
%%
-module(sys_sp2).
--export([start_link/1, stop/0]).
+-export([start_link/1]).
-export([alloc/0, free/1]).
-export([init/1]).
-export([system_continue/3, system_terminate/4,
@@ -30,10 +30,6 @@
start_link(NumCh) ->
proc_lib:start_link(?MODULE, init, [[self(),NumCh]]).
-stop() ->
- ?MODULE ! stop,
- ok.
-
alloc() ->
?MODULE ! {self(), alloc},
receive
@@ -45,11 +41,6 @@ free(Ch) ->
?MODULE ! {free, Ch},
ok.
-%% can't use 2-tuple for state here as we do in sys_sp1, since the 2-tuple
-%% is not compatible with the backward compatibility handling for
-%% sys:get_state in sys.erl
--record(state, {alloc,free}).
-
init([Parent,NumCh]) ->
register(?MODULE, self()),
Chs = channels(NumCh),
@@ -74,11 +65,7 @@ loop(Chs, Parent, Deb) ->
loop(Chs2, Parent, Deb2);
{system, From, Request} ->
sys:handle_system_msg(Request, From, Parent,
- ?MODULE, Deb, Chs);
- stop ->
- sys:handle_debug(Deb, fun write_debug/3,
- ?MODULE, {in, stop}),
- ok
+ ?MODULE, Deb, Chs)
end.
system_continue(Parent, Deb, Chs) ->
@@ -91,17 +78,17 @@ write_debug(Dev, Event, Name) ->
io:format(Dev, "~p event = ~p~n", [Name, Event]).
channels(NumCh) ->
- #state{alloc=[], free=lists:seq(1,NumCh)}.
+ {_Allocated=[], _Free=lists:seq(1,NumCh)}.
-alloc(#state{free=[]}=Channels) ->
- {{error, "no channels available"}, Channels};
-alloc(#state{alloc=Allocated, free=[H|T]}) ->
- {H, #state{alloc=[H|Allocated], free=T}}.
+alloc({_, []}) ->
+ {error, "no channels available"};
+alloc({Allocated, [H|T]}) ->
+ {H, {[H|Allocated], T}}.
-free(Ch, #state{alloc=Alloc, free=Free}=Channels) ->
+free(Ch, {Alloc, Free}=Channels) ->
case lists:member(Ch, Alloc) of
true ->
- #state{alloc=lists:delete(Ch, Alloc), free=[Ch|Free]};
+ {lists:delete(Ch, Alloc), [Ch|Free]};
false ->
Channels
end.
diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl
index 40372a2106..de271d7f2f 100644
--- a/lib/syntax_tools/src/erl_syntax.erl
+++ b/lib/syntax_tools/src/erl_syntax.erl
@@ -3323,6 +3323,11 @@ attribute_arguments(Node) ->
[set_pos(
list(unfold_function_names(Data, Pos)),
Pos)];
+ optional_callbacks ->
+ D = try list(unfold_function_names(Data, Pos))
+ catch _:_ -> abstract(Data)
+ end,
+ [set_pos(D, Pos)];
import ->
{Module, Imports} = Data,
[set_pos(atom(Module), Pos),
@@ -6135,6 +6140,13 @@ abstract_tail(H, T) ->
%% {@link char/1} function to explicitly create an abstract
%% character.)
%%
+%% Note: `arity_qualifier' nodes are recognized. This is to follow The
+%% Erlang Parser when it comes to wild attributes: both {F, A} and F/A
+%% are recognized, which makes it possible to turn wild attributes
+%% into recognized attributes without at the same time making it
+%% impossible to compile files using the new syntax with the old
+%% version of the Erlang Compiler.
+%%
%% @see abstract/1
%% @see is_literal/1
%% @see char/1
@@ -6184,6 +6196,20 @@ concrete(Node) ->
{value, concrete(F), []}
end, [], true),
B;
+ arity_qualifier ->
+ A = erl_syntax:arity_qualifier_argument(Node),
+ case erl_syntax:type(A) of
+ integer ->
+ F = erl_syntax:arity_qualifier_body(Node),
+ case erl_syntax:type(F) of
+ atom ->
+ {F, A};
+ _ ->
+ erlang:error({badarg, Node})
+ end;
+ _ ->
+ erlang:error({badarg, Node})
+ end;
_ ->
erlang:error({badarg, Node})
end.
diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl
index 572bf24ca4..cbad05081e 100644
--- a/lib/typer/src/typer.erl
+++ b/lib/typer/src/typer.erl
@@ -405,7 +405,7 @@ get_type({{M, F, A} = MFA, Range, Arg}, CodeServer, Records) ->
case dialyzer_codeserver:lookup_mfa_contract(MFA, CodeServer) of
error ->
{{F, A}, {Range, Arg}};
- {ok, {_FileLine, Contract}} ->
+ {ok, {_FileLine, Contract, _Xtra}} ->
Sig = erl_types:t_fun(Arg, Range),
case dialyzer_contracts:check_contract(Contract, Sig) of
ok -> {{F, A}, {contract, Contract}};
diff --git a/lib/wx/src/wx_object.erl b/lib/wx/src/wx_object.erl
index 80f8937656..2c016e7951 100644
--- a/lib/wx/src/wx_object.erl
+++ b/lib/wx/src/wx_object.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -102,6 +102,7 @@
%% API
-export([start/3, start/4,
start_link/3, start_link/4,
+ stop/1, stop/3,
call/2, call/3,
cast/2,
reply/2,
@@ -215,6 +216,42 @@ gen_response({ok, Pid}) ->
gen_response(Reply) ->
Reply.
+%% @spec (Ref::wxObject()|atom()|pid()) -> ok
+%% @doc Stops a generic wx_object server with reason 'normal'.
+%% Invokes terminate(Reason,State) in the server. The call waits until
+%% the process is terminated. If the process does not exist, an
+%% exception is raised.
+stop(Ref = #wx_ref{state=Pid}) when is_pid(Pid) ->
+ try
+ gen:stop(Pid)
+ catch _:ExitReason ->
+ erlang:error({ExitReason, {?MODULE, stop, [Ref]}})
+ end;
+stop(Name) when is_atom(Name) orelse is_pid(Name) ->
+ try
+ gen:stop(Name)
+ catch _:ExitReason ->
+ erlang:error({ExitReason, {?MODULE, stop, [Name]}})
+ end.
+
+%% @spec (Ref::wxObject()|atom()|pid(), Reason::term(), Timeout::timeout()) -> ok
+%% @doc Stops a generic wx_object server with the given Reason.
+%% Invokes terminate(Reason,State) in the server. The call waits until
+%% the process is terminated. If the call times out, or if the process
+%% does not exist, an exception is raised.
+stop(Ref = #wx_ref{state=Pid}, Reason, Timeout) when is_pid(Pid) ->
+ try
+ gen:stop(Pid, Reason, Timeout)
+ catch _:ExitReason ->
+ erlang:error({ExitReason, {?MODULE, stop, [Ref, Reason, Timeout]}})
+ end;
+stop(Name, Reason, Timeout) when is_atom(Name) orelse is_pid(Name) ->
+ try
+ gen:stop(Name, Reason, Timeout)
+ catch _:ExitReason ->
+ erlang:error({ExitReason, {?MODULE, stop, [Name, Reason, Timeout]}})
+ end.
+
%% @spec (Ref::wxObject()|atom()|pid(), Request::term()) -> term()
%% @doc Make a call to a wx_object server.
%% The call waits until it gets a result.
@@ -563,22 +600,10 @@ opt(_, []) ->
%% @hidden
debug_options(Name, Opts) ->
case opt(debug, Opts) of
- {ok, Options} -> dbg_options(Name, Options);
- _ -> dbg_options(Name, [])
+ {ok, Options} -> dbg_opts(Name, Options);
+ _ -> []
end.
%% @hidden
-dbg_options(Name, []) ->
- Opts =
- case init:get_argument(generic_debug) of
- error ->
- [];
- _ ->
- [log, statistics]
- end,
- dbg_opts(Name, Opts);
-dbg_options(Name, Opts) ->
- dbg_opts(Name, Opts).
-%% @hidden
dbg_opts(Name, Opts) ->
case catch sys:debug_options(Opts) of
{'EXIT',_} ->
diff --git a/lib/wx/test/wx_event_SUITE.erl b/lib/wx/test/wx_event_SUITE.erl
index 076f16ba16..2c6c59bb55 100644
--- a/lib/wx/test/wx_event_SUITE.erl
+++ b/lib/wx/test/wx_event_SUITE.erl
@@ -542,13 +542,14 @@ handler_clean(_Config) ->
?mt(wxFrame, Frame1),
wxWindow:show(Frame1),
?m([_|_], lists:sort(wx_test_lib:flush())),
- ?m({stop,_}, wx_obj_test:stop(Frame1, fun(_) -> normal end)),
+ ?m(ok, wx_obj_test:stop(Frame1)),
?m([{terminate,normal}], lists:sort(wx_test_lib:flush())),
- Frame2 = wx_obj_test:start([{init, Init}]),
+ Terminate = fun({Frame,_}) -> wxWindow:destroy(Frame) end,
+ Frame2 = wx_obj_test:start([{init, Init}, {terminate, Terminate}]),
wxWindow:show(Frame2),
?m([_|_], lists:sort(wx_test_lib:flush())),
- ?m({stop,_}, wx_obj_test:stop(Frame2, fun(_) -> wxWindow:destroy(Frame2), normal end)),
+ ?m(ok, wx_obj_test:stop(Frame2)),
?m([{terminate,normal}], lists:sort(wx_test_lib:flush())),
timer:sleep(104),
?m({[],[],[]}, white_box_check_event_handlers()),
diff --git a/lib/wx/test/wx_obj_test.erl b/lib/wx/test/wx_obj_test.erl
index f47f2fbc46..6c648c65f8 100644
--- a/lib/wx/test/wx_obj_test.erl
+++ b/lib/wx/test/wx_obj_test.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -18,7 +18,7 @@
-module(wx_obj_test).
-include_lib("wx/include/wx.hrl").
--export([start/1, stop/2]).
+-export([start/1, stop/1]).
%% wx_object callbacks
-export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3,
@@ -29,8 +29,8 @@
start(Opts) ->
wx_object:start_link(?MODULE, [{parent, self()}| Opts], []).
-stop(Object, Fun) ->
- wx_object:call(Object, {stop, Fun}).
+stop(Object) ->
+ wx_object:stop(Object).
init(Opts) ->
Parent = proplists:get_value(parent, Opts),
@@ -61,8 +61,6 @@ handle_event(Event, State = #state{parent=Parent}) ->
handle_call(What, From, State = #state{user_state=US}) when is_function(What) ->
Result = What(US),
{reply, {call, Result, From}, State};
-handle_call({stop, Fun}, From, State = #state{user_state=US}) ->
- {stop, Fun(US), {stop, From}, State};
handle_call(What, From, State) ->
{reply, {call, What, From}, State}.
@@ -79,7 +77,13 @@ handle_info(What, State = #state{parent=Pid}) ->
Pid ! {info, What},
{noreply, State}.
-terminate(What, #state{parent=Pid}) ->
+terminate(What, #state{parent=Pid, opts=Opts, user_state=US}) ->
+ case proplists:get_value(terminate, Opts) of
+ undefined ->
+ ok;
+ Terminate ->
+ Terminate(US)
+ end,
Pid ! {terminate, What},
ok.
diff --git a/make/run_make.mk b/make/run_make.mk
index 01ab257006..9570113861 100644
--- a/make/run_make.mk
+++ b/make/run_make.mk
@@ -30,7 +30,7 @@ include $(ERL_TOP)/make/target.mk
.PHONY: valgrind
-opt debug purify quantify purecov valgrind gcov gprof lcnt frmptr:
+opt debug purify quantify purecov valgrind gcov gprof lcnt frmptr icount:
$(make_verbose)$(MAKE) -f $(TARGET)/Makefile TYPE=$@
plain smp frag smp_frag:
diff --git a/system/doc/design_principles/distributed_applications.xml b/system/doc/design_principles/distributed_applications.xml
index 2886f06b53..4d4ba3136e 100644
--- a/system/doc/design_principles/distributed_applications.xml
+++ b/system/doc/design_principles/distributed_applications.xml
@@ -43,7 +43,7 @@
addressing mechanism is required to ensure that it can be
addressed by other applications, regardless on which node it
currently executes. This issue is not addressed here, but the
- Kernel module <c>global</c> or STDLIB module <c>pg</c> can be
+ Kernel modules <c>global</c> or <c>pg2</c> can be
used for this purpose.</p>
</section>
diff --git a/system/doc/design_principles/spec_proc.xml b/system/doc/design_principles/spec_proc.xml
index e4fb5fdca7..e849388a38 100644
--- a/system/doc/design_principles/spec_proc.xml
+++ b/system/doc/design_principles/spec_proc.xml
@@ -431,43 +431,79 @@ loop(...) ->
<section>
<title>User-Defined Behaviours</title>
- <p><marker id="behaviours"/>To implement a user-defined behaviour, write code similar to
- code for a special process but calling functions in a callback
- module for handling specific tasks.</p>
- <p>If it is desired that the compiler should warn for missing callback
- functions, as it does for the OTP behaviours, add <c>-callback</c> attributes in the
- behaviour module to describe the expected callbacks:</p>
+
+ <p><marker id="behaviours"/>To implement a user-defined behaviour,
+ write code similar to code for a special process but calling
+ functions in a callback module for handling specific tasks.</p>
+ <p>If it is desired that the compiler should warn for missing
+ callback functions, as it does for the OTP behaviours, add
+ <c>-callback</c> attributes in the behaviour module to describe
+ the expected callback functions:</p>
+
<code type="none">
-callback Name1(Arg1_1, Arg1_2, ..., Arg1_N1) -> Res1.
-callback Name2(Arg2_1, Arg2_2, ..., Arg2_N2) -> Res2.
...
-callback NameM(ArgM_1, ArgM_2, ..., ArgM_NM) -> ResM.</code>
- <p>where <c>NameX</c> are the names of the expected callbacks and
- <c>ArgX_Y</c>, <c>ResX</c> are types as they are described in Specifications
- for functions in <seealso marker="../reference_manual/typespec">Types and
- Function Specifications</seealso>. The whole syntax of <c>-spec</c> attribute is
- supported by <c>-callback</c> attribute.</p>
- <p>Alternatively you may directly implement and export the function:</p>
+
+ <p>where each <c>Name</c> is the name of a callback function and
+ <c>Arg</c> and <c>Res</c> are types as described in
+ Specifications for functions in <seealso
+ marker="../reference_manual/typespec">Types and Function
+ Specifications</seealso>. The whole syntax of the
+ <c>-spec</c> attribute is supported by <c>-callback</c>
+ attribute.</p>
+ <p>Callback functions that are optional for the user of the
+ behaviour to implement are specified by use of the
+ <c>-optional_callbacks</c> attribute:</p>
+
+<code type="none">
+-optional_callbacks([OptName1/OptArity1, ..., OptNameK/OptArityK]).</code>
+
+ <p>where each <c>OptName/OptArity</c> specifies the name and arity
+ of a callback function. Note that the <c>-optional_callbacks</c>
+ attribute is to be used together with the <c>-callback</c>
+ attribute; it cannot be combined with the
+ <c>behaviour_info()</c> function described below.</p>
+ <p>Tools that need to know about optional callback functions can
+ call <c>Behaviour:behaviour_info(optional_callbacks)</c> to get
+ a list of all optional callback functions.</p>
+
+ <note><p>We recommend using the <c>-callback</c> attribute rather
+ than the <c>behaviour_info()</c> function. The reason is that
+ the extra type information can be used by tools to produce
+ documentation or find discrepancies.</p></note>
+
+ <p>As an alternative to the <c>-callback</c> and
+ <c>-optional_callbacks</c> attributes you may directly implement
+ and export <c>behaviour_info()</c>:</p>
+
<code type="none">
behaviour_info(callbacks) ->
[{Name1, Arity1},...,{NameN, ArityN}].</code>
- <p>where each <c>{Name, Arity}</c> specifies the name and arity of a callback
- function. This function is otherwise automatically generated by the compiler
- using the <c>-callback</c> attributes.</p>
+
+ <p>where each <c>{Name, Arity}</c> specifies the name and arity of
+ a callback function. This function is otherwise automatically
+ generated by the compiler using the <c>-callback</c>
+ attributes.</p>
<p>When the compiler encounters the module attribute
- <c>-behaviour(Behaviour).</c> in a module <c>Mod</c>, it will call
- <c>Behaviour:behaviour_info(callbacks)</c> and compare the result with the
- set of functions actually exported from <c>Mod</c>, and issue a warning if
- any callback function is missing.</p>
+ <c>-behaviour(Behaviour).</c> in a module <c>Mod</c>, it will
+ call <c>Behaviour:behaviour_info(callbacks)</c> and compare the
+ result with the set of functions actually exported from
+ <c>Mod</c>, and issue a warning if any callback function is
+ missing.</p>
<p>Example:</p>
<code type="none">
%% User-defined behaviour module
-module(simple_server).
--export([start_link/2,...]).
+-export([start_link/2, init/3, ...]).
-callback init(State :: term()) -> 'ok'.
-callback handle_req(Req :: term(), State :: term()) -> {'ok', Reply :: term()}.
-callback terminate() -> 'ok'.
+-callback format_state(State :: term()) -> term().
+
+-optional_callbacks([format_state/1]).
%% Alternatively you may define:
%%
diff --git a/system/doc/reference_manual/modules.xml b/system/doc/reference_manual/modules.xml
index f0ec7ef165..5fc8b363f8 100644
--- a/system/doc/reference_manual/modules.xml
+++ b/system/doc/reference_manual/modules.xml
@@ -229,13 +229,9 @@ behaviour_info(callbacks) -> Callbacks.</pre>
<p>The <c>module_info/0</c> function in each module returns
a list of <c>{Key,Value}</c> tuples with information about
the module. Currently, the list contain tuples with the following
- <c>Key</c>s: <c>attributes</c>, <c>compile</c>,
- <c>exports</c>, and <c>imports</c>. The order and number of tuples
+ <c>Key</c>s: <c>module</c>, <c>attributes</c>, <c>compile</c>,
+ <c>exports</c> and <c>md5</c>. The order and number of tuples
may change without prior notice.</p>
-
- <warning><p>The <c>{imports,Value}</c> tuple may be removed in a future
- release because <c>Value</c> is always an empty list.
- Do not write code that depends on it being present.</p></warning>
</section>
<section>
@@ -246,6 +242,11 @@ behaviour_info(callbacks) -> Callbacks.</pre>
<p>The following values are allowed for <c>Key</c>:</p>
<taglist>
+ <tag><c>module</c></tag>
+ <item>
+ <p>Return an atom representing the module name.</p>
+ </item>
+
<tag><c>attributes</c></tag>
<item>
<p>Return a list of <c>{AttributeName,ValueList}</c> tuples,
@@ -267,10 +268,9 @@ behaviour_info(callbacks) -> Callbacks.</pre>
<seealso marker="stdlib:beam_lib#strip/1">beam_lib(3)</seealso>.</p>
</item>
- <tag><c>imports</c></tag>
+ <tag><c>md5</c></tag>
<item>
- <p>Always return an empty list. The <c>imports</c> key may not
- be supported in future release.</p>
+ <p>Return a binary representing the MD5 checksum of the module.</p>
</item>
<tag><c>exports</c></tag>
diff --git a/system/doc/tutorial/distribution.xml b/system/doc/tutorial/distribution.xml
index 6a0ea759c4..ced8e4a545 100644
--- a/system/doc/tutorial/distribution.xml
+++ b/system/doc/tutorial/distribution.xml
@@ -58,7 +58,6 @@
<item>global_group - Grouping nodes to global name registration groups.</item>
<item>net_adm - Various net administration routines.</item>
<item>net_kernel - Networking kernel.</item>
- <item>pg - Distributed named process groups, experimental implementation.</item>
<item>pg2 - Distributed named process groups.</item>
<item>pool - Load distribution facility.</item>
<item>slave - Functions for starting and controlling slave nodes.</item>