diff options
552 files changed, 32909 insertions, 12703 deletions
@@ -36,6 +36,8 @@ Here are the [instructions for submitting patches] [2]. In short: +* Go to the JIRA issue tracker at [bugs.erlang.org] [7] to see reported issues which you can contribute to. Search for issues with the status *Contribution Needed*. + * We prefer to receive proposed updates via email on the [`erlang-patches`] [3] mailing list or through a pull request. @@ -58,8 +60,6 @@ In short: may suggest improvements that are needed before the change can be accepted and merged. -* Once or twice a week, a status email called ["What's cooking in Erlang/OTP"] [4] - will be sent to the [`erlang-patches`] [3] mailing list. Bug Reports -------------------------- @@ -91,8 +91,9 @@ Copyright and License [1]: http://www.erlang.org - [2]: http://wiki.github.com/erlang/otp/submitting-patches + [2]: http://wiki.github.com/erlang/otp/contribution-guidelines [3]: http://www.erlang.org/static/doc/mailinglist.html [4]: http://erlang.github.com/otp/ [5]: HOWTO/INSTALL.md [6]: https://github.com/erlang/otp/wiki/Bug-reports + [7]: http://bugs.erlang.org diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex e07137fd5c..cc0edd5427 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex e07137fd5c..cc0edd5427 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 3249ce70a5..c8bc82022c 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam Binary files differindex 7a96ad3196..cccf21d9ab 100644 --- a/bootstrap/lib/compiler/ebin/beam_block.beam +++ b/bootstrap/lib/compiler/ebin/beam_block.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bool.beam b/bootstrap/lib/compiler/ebin/beam_bool.beam Binary files differindex e677c125a3..a793db8bed 100644 --- a/bootstrap/lib/compiler/ebin/beam_bool.beam +++ b/bootstrap/lib/compiler/ebin/beam_bool.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bs.beam b/bootstrap/lib/compiler/ebin/beam_bs.beam Binary files differindex 18b9f8bc1b..6105ef85ca 100644 --- a/bootstrap/lib/compiler/ebin/beam_bs.beam +++ b/bootstrap/lib/compiler/ebin/beam_bs.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam Binary files differindex b65f915978..51abd68b00 100644 --- a/bootstrap/lib/compiler/ebin/beam_bsm.beam +++ b/bootstrap/lib/compiler/ebin/beam_bsm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_dead.beam b/bootstrap/lib/compiler/ebin/beam_dead.beam Binary files differindex 10926614e6..4fda5157fa 100644 --- a/bootstrap/lib/compiler/ebin/beam_dead.beam +++ b/bootstrap/lib/compiler/ebin/beam_dead.beam diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam Binary files differindex b2fd7faa0c..477ab0a957 100644 --- a/bootstrap/lib/compiler/ebin/beam_disasm.beam +++ b/bootstrap/lib/compiler/ebin/beam_disasm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam Binary files differindex 334047bbf6..2a2b8d38f5 100644 --- a/bootstrap/lib/compiler/ebin/beam_peep.beam +++ b/bootstrap/lib/compiler/ebin/beam_peep.beam diff --git a/bootstrap/lib/compiler/ebin/beam_receive.beam b/bootstrap/lib/compiler/ebin/beam_receive.beam Binary files differindex 0aa196f3de..fef3fcc816 100644 --- a/bootstrap/lib/compiler/ebin/beam_receive.beam +++ b/bootstrap/lib/compiler/ebin/beam_receive.beam diff --git a/bootstrap/lib/compiler/ebin/beam_split.beam b/bootstrap/lib/compiler/ebin/beam_split.beam Binary files differindex a4e2b78938..3a02e2b17c 100644 --- a/bootstrap/lib/compiler/ebin/beam_split.beam +++ b/bootstrap/lib/compiler/ebin/beam_split.beam diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam Binary files differindex 194882f68a..67d290e733 100644 --- a/bootstrap/lib/compiler/ebin/beam_trim.beam +++ b/bootstrap/lib/compiler/ebin/beam_trim.beam diff --git a/bootstrap/lib/compiler/ebin/beam_type.beam b/bootstrap/lib/compiler/ebin/beam_type.beam Binary files differindex 35bc046ef8..8f89c771b7 100644 --- a/bootstrap/lib/compiler/ebin/beam_type.beam +++ b/bootstrap/lib/compiler/ebin/beam_type.beam diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex a97fc853a7..661cd1c60d 100644 --- a/bootstrap/lib/compiler/ebin/beam_utils.beam +++ b/bootstrap/lib/compiler/ebin/beam_utils.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex 73fa117755..187968450f 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/beam_z.beam b/bootstrap/lib/compiler/ebin/beam_z.beam Binary files differindex 7bf77d7d33..11ddf0e062 100644 --- a/bootstrap/lib/compiler/ebin/beam_z.beam +++ b/bootstrap/lib/compiler/ebin/beam_z.beam diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam Binary files differindex 88857b8905..82bd89c17a 100644 --- a/bootstrap/lib/compiler/ebin/cerl.beam +++ b/bootstrap/lib/compiler/ebin/cerl.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam Binary files differindex cc90a53ef9..ce1f13db6a 100644 --- a/bootstrap/lib/compiler/ebin/cerl_inline.beam +++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam Binary files differindex 37120929ba..a2c27861c4 100644 --- a/bootstrap/lib/compiler/ebin/cerl_trees.beam +++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex a0c114bf7e..b309544c39 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index c5ec501890..53891c7260 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -1,7 +1,7 @@ % This is an -*- erlang -*- file. %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup index 0cdf00818d..367a845adf 100644 --- a/bootstrap/lib/compiler/ebin/compiler.appup +++ b/bootstrap/lib/compiler/ebin/compiler.appup @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014. All Rights Reserved. +%% Copyright Ericsson AB 2014-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam Binary files differindex 69143cdd23..0e47e00b15 100644 --- a/bootstrap/lib/compiler/ebin/core_lint.beam +++ b/bootstrap/lib/compiler/ebin/core_lint.beam diff --git a/bootstrap/lib/compiler/ebin/core_parse.beam b/bootstrap/lib/compiler/ebin/core_parse.beam Binary files differindex 3ef8588f65..baf2c9d70f 100644 --- a/bootstrap/lib/compiler/ebin/core_parse.beam +++ b/bootstrap/lib/compiler/ebin/core_parse.beam diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam Binary files differindex f320fd6908..6047596cb6 100644 --- a/bootstrap/lib/compiler/ebin/core_pp.beam +++ b/bootstrap/lib/compiler/ebin/core_pp.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam Binary files differindex 0c2d05286a..81da8b62c5 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex 52c0d62f5f..088d69fa2a 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam Binary files differindex 71d381b5b3..0914282354 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex 322469639f..0d76bb21e2 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 223eb2acef..3b3b8f4208 100644 --- a/bootstrap/lib/compiler/ebin/v3_core.beam +++ b/bootstrap/lib/compiler/ebin/v3_core.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam Binary files differindex 6555a39c86..5e3ae80d14 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam Binary files differindex 28d8a5b579..784d8c2e71 100644 --- a/bootstrap/lib/kernel/ebin/code.beam +++ b/bootstrap/lib/kernel/ebin/code.beam diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam Binary files differindex aa1ba78550..97123d4961 100644 --- a/bootstrap/lib/kernel/ebin/code_server.beam +++ b/bootstrap/lib/kernel/ebin/code_server.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log.beam b/bootstrap/lib/kernel/ebin/disk_log.beam Binary files differindex 3384baedc0..998d4bca2f 100644 --- a/bootstrap/lib/kernel/ebin/disk_log.beam +++ b/bootstrap/lib/kernel/ebin/disk_log.beam diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam Binary files differindex 8b75d83dd1..369871f398 100644 --- a/bootstrap/lib/kernel/ebin/dist_util.beam +++ b/bootstrap/lib/kernel/ebin/dist_util.beam diff --git a/bootstrap/lib/kernel/ebin/error_handler.beam b/bootstrap/lib/kernel/ebin/error_handler.beam Binary files differindex 64f44baeb7..a898c909ac 100644 --- a/bootstrap/lib/kernel/ebin/error_handler.beam +++ b/bootstrap/lib/kernel/ebin/error_handler.beam diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam Binary files differindex 908c63cb9a..ab883f3a50 100644 --- a/bootstrap/lib/kernel/ebin/erts_debug.beam +++ b/bootstrap/lib/kernel/ebin/erts_debug.beam diff --git a/bootstrap/lib/kernel/ebin/file.beam b/bootstrap/lib/kernel/ebin/file.beam Binary files differindex 1856278999..c82dada559 100644 --- a/bootstrap/lib/kernel/ebin/file.beam +++ b/bootstrap/lib/kernel/ebin/file.beam diff --git a/bootstrap/lib/kernel/ebin/file_io_server.beam b/bootstrap/lib/kernel/ebin/file_io_server.beam Binary files differindex dabb6b194e..c22b7e4dec 100644 --- a/bootstrap/lib/kernel/ebin/file_io_server.beam +++ b/bootstrap/lib/kernel/ebin/file_io_server.beam diff --git a/bootstrap/lib/kernel/ebin/gen_sctp.beam b/bootstrap/lib/kernel/ebin/gen_sctp.beam Binary files differindex 91aaa41063..fe2ff17ff1 100644 --- a/bootstrap/lib/kernel/ebin/gen_sctp.beam +++ b/bootstrap/lib/kernel/ebin/gen_sctp.beam diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam Binary files differindex 419102e285..b461d30baa 100644 --- a/bootstrap/lib/kernel/ebin/global.beam +++ b/bootstrap/lib/kernel/ebin/global.beam diff --git a/bootstrap/lib/kernel/ebin/global_group.beam b/bootstrap/lib/kernel/ebin/global_group.beam Binary files differindex 1269f7e321..03202f68eb 100644 --- a/bootstrap/lib/kernel/ebin/global_group.beam +++ b/bootstrap/lib/kernel/ebin/global_group.beam diff --git a/bootstrap/lib/kernel/ebin/group.beam b/bootstrap/lib/kernel/ebin/group.beam Binary files differindex 3df8f6030c..0511d1fa09 100644 --- a/bootstrap/lib/kernel/ebin/group.beam +++ b/bootstrap/lib/kernel/ebin/group.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex b1b7fcdef2..5a2f294951 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam Binary files differindex 55598b0067..60469432b9 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam Binary files differindex 1b7450f0d3..557852c917 100644 --- a/bootstrap/lib/kernel/ebin/inet_db.beam +++ b/bootstrap/lib/kernel/ebin/inet_db.beam diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam Binary files differindex 88ecaaf10b..f4be62bae6 100644 --- a/bootstrap/lib/kernel/ebin/inet_dns.beam +++ b/bootstrap/lib/kernel/ebin/inet_dns.beam diff --git a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam Binary files differindex 93f60428a1..f090de9fba 100644 --- a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam +++ b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam diff --git a/bootstrap/lib/kernel/ebin/inet_parse.beam b/bootstrap/lib/kernel/ebin/inet_parse.beam Binary files differindex 4323d12bf1..30f05d5c09 100644 --- a/bootstrap/lib/kernel/ebin/inet_parse.beam +++ b/bootstrap/lib/kernel/ebin/inet_parse.beam diff --git a/bootstrap/lib/kernel/ebin/inet_res.beam b/bootstrap/lib/kernel/ebin/inet_res.beam Binary files differindex ada7300673..2713c7fef6 100644 --- a/bootstrap/lib/kernel/ebin/inet_res.beam +++ b/bootstrap/lib/kernel/ebin/inet_res.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index 49163534f8..8e00bc4a45 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,7 +22,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "4.2"}, + {vsn, "5.0"}, {modules, [application, application_controller, application_master, diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index dbbc1ef977..1ed9771492 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -16,7 +16,7 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"4.2", +{"5.0", %% Up from - max one major revision back [{<<"5\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* {<<"4\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.* diff --git a/bootstrap/lib/kernel/ebin/ram_file.beam b/bootstrap/lib/kernel/ebin/ram_file.beam Binary files differindex b119b3656c..2b14a4d28b 100644 --- a/bootstrap/lib/kernel/ebin/ram_file.beam +++ b/bootstrap/lib/kernel/ebin/ram_file.beam diff --git a/bootstrap/lib/kernel/ebin/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam Binary files differindex 4fbd7b70fa..3b77ed641a 100644 --- a/bootstrap/lib/kernel/ebin/rpc.beam +++ b/bootstrap/lib/kernel/ebin/rpc.beam diff --git a/bootstrap/lib/kernel/ebin/seq_trace.beam b/bootstrap/lib/kernel/ebin/seq_trace.beam Binary files differindex 68d1b50f84..0155810ca7 100644 --- a/bootstrap/lib/kernel/ebin/seq_trace.beam +++ b/bootstrap/lib/kernel/ebin/seq_trace.beam diff --git a/bootstrap/lib/kernel/ebin/user_drv.beam b/bootstrap/lib/kernel/ebin/user_drv.beam Binary files differindex e306b172bf..1d72927105 100644 --- a/bootstrap/lib/kernel/ebin/user_drv.beam +++ b/bootstrap/lib/kernel/ebin/user_drv.beam diff --git a/bootstrap/lib/kernel/include/dist.hrl b/bootstrap/lib/kernel/include/dist.hrl index 47d9459a19..d6bccdf474 100644 --- a/bootstrap/lib/kernel/include/dist.hrl +++ b/bootstrap/lib/kernel/include/dist.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -39,3 +39,4 @@ -define(DFLAG_SMALL_ATOM_TAGS, 16#4000). -define(DFLAG_UTF8_ATOMS, 16#10000). -define(DFLAG_MAP_TAG, 16#20000). +-define(DFLAG_BIG_CREATION, 16#40000). diff --git a/bootstrap/lib/kernel/include/dist_util.hrl b/bootstrap/lib/kernel/include/dist_util.hrl index d5df2be4ec..43e50d4325 100644 --- a/bootstrap/lib/kernel/include/dist_util.hrl +++ b/bootstrap/lib/kernel/include/dist_util.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/bootstrap/lib/kernel/include/inet.hrl b/bootstrap/lib/kernel/include/inet.hrl index d983fa9e72..b39df8c3f2 100644 --- a/bootstrap/lib/kernel/include/inet.hrl +++ b/bootstrap/lib/kernel/include/inet.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/bootstrap/lib/kernel/include/inet_sctp.hrl b/bootstrap/lib/kernel/include/inet_sctp.hrl index d6376e452e..ddb3cdc26c 100644 --- a/bootstrap/lib/kernel/include/inet_sctp.hrl +++ b/bootstrap/lib/kernel/include/inet_sctp.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/bootstrap/lib/kernel/include/net_address.hrl b/bootstrap/lib/kernel/include/net_address.hrl index 9dd4b78cd4..4988175593 100644 --- a/bootstrap/lib/kernel/include/net_address.hrl +++ b/bootstrap/lib/kernel/include/net_address.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam Binary files differindex 4ad8942b06..b7b808035a 100644 --- a/bootstrap/lib/stdlib/ebin/array.beam +++ b/bootstrap/lib/stdlib/ebin/array.beam diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam Binary files differindex 8b987fd7f7..bdea71378f 100644 --- a/bootstrap/lib/stdlib/ebin/beam_lib.beam +++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/c.beam b/bootstrap/lib/stdlib/ebin/c.beam Binary files differindex 133035102e..e1d964115d 100644 --- a/bootstrap/lib/stdlib/ebin/c.beam +++ b/bootstrap/lib/stdlib/ebin/c.beam diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam Binary files differindex b255a4e10f..754663b531 100644 --- a/bootstrap/lib/stdlib/ebin/dets.beam +++ b/bootstrap/lib/stdlib/ebin/dets.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_server.beam b/bootstrap/lib/stdlib/ebin/dets_server.beam Binary files differindex da999f3025..502eb98318 100644 --- a/bootstrap/lib/stdlib/ebin/dets_server.beam +++ b/bootstrap/lib/stdlib/ebin/dets_server.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam Binary files differindex ab627d50df..37247c7176 100644 --- a/bootstrap/lib/stdlib/ebin/dets_utils.beam +++ b/bootstrap/lib/stdlib/ebin/dets_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam Binary files differindex 0b966769ba..3e02f4b0be 100644 --- a/bootstrap/lib/stdlib/ebin/dets_v9.beam +++ b/bootstrap/lib/stdlib/ebin/dets_v9.beam diff --git a/bootstrap/lib/stdlib/ebin/dict.beam b/bootstrap/lib/stdlib/ebin/dict.beam Binary files differindex 3b2b5a4c04..c91e90a0a9 100644 --- a/bootstrap/lib/stdlib/ebin/dict.beam +++ b/bootstrap/lib/stdlib/ebin/dict.beam diff --git a/bootstrap/lib/stdlib/ebin/digraph_utils.beam b/bootstrap/lib/stdlib/ebin/digraph_utils.beam Binary files differindex 9065fda936..66777eeb8f 100644 --- a/bootstrap/lib/stdlib/ebin/digraph_utils.beam +++ b/bootstrap/lib/stdlib/ebin/digraph_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex e2a528f9fc..5c98ffdafc 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_bits.beam b/bootstrap/lib/stdlib/ebin/erl_bits.beam Binary files differindex af8619bac0..a5aec9de8b 100644 --- a/bootstrap/lib/stdlib/ebin/erl_bits.beam +++ b/bootstrap/lib/stdlib/ebin/erl_bits.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_compile.beam b/bootstrap/lib/stdlib/ebin/erl_compile.beam Binary files differindex 82949da20a..2c02065f58 100644 --- a/bootstrap/lib/stdlib/ebin/erl_compile.beam +++ b/bootstrap/lib/stdlib/ebin/erl_compile.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex b58781d3f8..8793d70a39 100644 --- a/bootstrap/lib/stdlib/ebin/erl_eval.beam +++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam Binary files differindex 617913c674..f6c0d0a732 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 3a0681d1bf..22d3607866 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam Binary files differindex 79e96cabec..9b04739d58 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex 4cc4884c92..9841362f9d 100644 --- a/bootstrap/lib/stdlib/ebin/erl_pp.beam +++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam Binary files differindex 6c35d20c46..f33c5bd6f9 100644 --- a/bootstrap/lib/stdlib/ebin/erl_scan.beam +++ b/bootstrap/lib/stdlib/ebin/erl_scan.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_tar.beam b/bootstrap/lib/stdlib/ebin/erl_tar.beam Binary files differindex 9bcbabc27c..d29dbf18fd 100644 --- a/bootstrap/lib/stdlib/ebin/erl_tar.beam +++ b/bootstrap/lib/stdlib/ebin/erl_tar.beam diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam Binary files differindex c006d9a1ad..70ac06c476 100644 --- a/bootstrap/lib/stdlib/ebin/escript.beam +++ b/bootstrap/lib/stdlib/ebin/escript.beam diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam Binary files differindex a15534b365..130d9df1b5 100644 --- a/bootstrap/lib/stdlib/ebin/ets.beam +++ b/bootstrap/lib/stdlib/ebin/ets.beam diff --git a/bootstrap/lib/stdlib/ebin/eval_bits.beam b/bootstrap/lib/stdlib/ebin/eval_bits.beam Binary files differindex be20e8c720..0529da7250 100644 --- a/bootstrap/lib/stdlib/ebin/eval_bits.beam +++ b/bootstrap/lib/stdlib/ebin/eval_bits.beam diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam Binary files differindex 9286aea119..ac4f1a36f1 100644 --- a/bootstrap/lib/stdlib/ebin/file_sorter.beam +++ b/bootstrap/lib/stdlib/ebin/file_sorter.beam diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam Binary files differindex 5ea27fdca6..a9783ed990 100644 --- a/bootstrap/lib/stdlib/ebin/filelib.beam +++ b/bootstrap/lib/stdlib/ebin/filelib.beam diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam Binary files differindex 95e4d69df0..b6248fe460 100644 --- a/bootstrap/lib/stdlib/ebin/filename.beam +++ b/bootstrap/lib/stdlib/ebin/filename.beam diff --git a/bootstrap/lib/stdlib/ebin/gen.beam b/bootstrap/lib/stdlib/ebin/gen.beam Binary files differindex 586973a973..08735311fb 100644 --- a/bootstrap/lib/stdlib/ebin/gen.beam +++ b/bootstrap/lib/stdlib/ebin/gen.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex 4788735049..2486647f46 100644 --- a/bootstrap/lib/stdlib/ebin/gen_event.beam +++ b/bootstrap/lib/stdlib/ebin/gen_event.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam Binary files differindex f78a7368d5..dbf38090af 100644 --- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam +++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam Binary files differindex 8ebe9d7a3a..e7026a2a9a 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_statem.beam b/bootstrap/lib/stdlib/ebin/gen_statem.beam Binary files differnew file mode 100644 index 0000000000..5be1739fd5 --- /dev/null +++ b/bootstrap/lib/stdlib/ebin/gen_statem.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex 9d37b74ad3..8488125227 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam diff --git a/bootstrap/lib/stdlib/ebin/lib.beam b/bootstrap/lib/stdlib/ebin/lib.beam Binary files differindex 8e594d97ad..541ea59421 100644 --- a/bootstrap/lib/stdlib/ebin/lib.beam +++ b/bootstrap/lib/stdlib/ebin/lib.beam diff --git a/bootstrap/lib/stdlib/ebin/lists.beam b/bootstrap/lib/stdlib/ebin/lists.beam Binary files differindex 91297311b2..422a9bd214 100644 --- a/bootstrap/lib/stdlib/ebin/lists.beam +++ b/bootstrap/lib/stdlib/ebin/lists.beam diff --git a/bootstrap/lib/stdlib/ebin/maps.beam b/bootstrap/lib/stdlib/ebin/maps.beam Binary files differindex 7533b56554..5f041ab10f 100644 --- a/bootstrap/lib/stdlib/ebin/maps.beam +++ b/bootstrap/lib/stdlib/ebin/maps.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex c9881fdd18..e1ebd34afd 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam Binary files differindex 568015b3e4..d3249b120e 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex 436b62e50e..f0ed1e961b 100644 --- a/bootstrap/lib/stdlib/ebin/qlc.beam +++ b/bootstrap/lib/stdlib/ebin/qlc.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam Binary files differindex 4032af0dd7..17c698de60 100644 --- a/bootstrap/lib/stdlib/ebin/qlc_pt.beam +++ b/bootstrap/lib/stdlib/ebin/qlc_pt.beam diff --git a/bootstrap/lib/stdlib/ebin/re.beam b/bootstrap/lib/stdlib/ebin/re.beam Binary files differindex 7b2e736a21..c68d7cc82a 100644 --- a/bootstrap/lib/stdlib/ebin/re.beam +++ b/bootstrap/lib/stdlib/ebin/re.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex 8e64036c90..9fa5727aa5 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam Binary files differindex 5514b0d4f9..01f7810764 100644 --- a/bootstrap/lib/stdlib/ebin/sofs.beam +++ b/bootstrap/lib/stdlib/ebin/sofs.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 97910ada4f..4c8f196620 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,7 +20,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "2.8"}, + {vsn, "3.0"}, {modules, [array, base64, beam_lib, @@ -65,6 +65,7 @@ gen_event, gen_fsm, gen_server, + gen_statem, io, io_lib, io_lib_format, diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index 58af9ab142..737486d3c5 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -16,7 +16,7 @@ %% limitations under the License. %% %% %CopyrightEnd% -{"2.8", +{"3.0", %% Up from - max one major revision back [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* {<<"2\\.[5-8](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.* diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex e03a3264a6..d30b4a037b 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam Binary files differindex 17a318c4d4..1f5c92e369 100644 --- a/bootstrap/lib/stdlib/ebin/unicode.beam +++ b/bootstrap/lib/stdlib/ebin/unicode.beam diff --git a/bootstrap/lib/stdlib/include/assert.hrl b/bootstrap/lib/stdlib/include/assert.hrl index f913760102..9e5d4eb598 100644 --- a/bootstrap/lib/stdlib/include/assert.hrl +++ b/bootstrap/lib/stdlib/include/assert.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright (C) 2004-2014 Richard Carlsson, Mickaël Rémond +%% Copyright (C) 2004-2016 Richard Carlsson, Mickaël Rémond %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -59,19 +59,22 @@ -define(assert(BoolExpr),ok). -else. %% The assert macro is written the way it is so as not to cause warnings -%% for clauses that cannot match, even if the expression is a constant. +%% for clauses that cannot match, even if the expression is a constant or +%% is known to be boolean-only. -define(assert(BoolExpr), begin ((fun () -> + __T = is_process_alive(self()), % cheap source of truth case (BoolExpr) of - true -> ok; + __T -> ok; __V -> erlang:error({assert, [{module, ?MODULE}, {line, ?LINE}, {expression, (??BoolExpr)}, {expected, true}, - case __V of false -> {value, __V}; - _ -> {not_boolean,__V} + case not __T of + __V -> {value, false}; + _ -> {not_boolean, __V} end]}) end end)()) @@ -85,15 +88,17 @@ -define(assertNot(BoolExpr), begin ((fun () -> + __F = not is_process_alive(self()), case (BoolExpr) of - false -> ok; + __F -> ok; __V -> erlang:error({assert, [{module, ?MODULE}, {line, ?LINE}, {expression, (??BoolExpr)}, {expected, false}, - case __V of true -> {value, __V}; - _ -> {not_boolean,__V} + case not __F of + __V -> {value, true}; + _ -> {not_boolean, __V} end]}) end end)()) @@ -149,7 +154,8 @@ -else. -define(assertEqual(Expect, Expr), begin - ((fun (__X) -> + ((fun () -> + __X = (Expect), case (Expr) of __X -> ok; __V -> erlang:error({assertEqual, @@ -159,7 +165,7 @@ {expected, __X}, {value, __V}]}) end - end)(Expect)) + end)()) end). -endif. @@ -169,7 +175,8 @@ -else. -define(assertNotEqual(Unexpected, Expr), begin - ((fun (__X) -> + ((fun () -> + __X = (Unexpected), case (Expr) of __X -> erlang:error({assertNotEqual, [{module, ?MODULE}, @@ -178,7 +185,7 @@ {value, __X}]}); _ -> ok end - end)(Unexpected)) + end)()) end). -endif. diff --git a/bootstrap/lib/stdlib/include/erl_compile.hrl b/bootstrap/lib/stdlib/include/erl_compile.hrl index c5fb491308..1c45613716 100644 --- a/bootstrap/lib/stdlib/include/erl_compile.hrl +++ b/bootstrap/lib/stdlib/include/erl_compile.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/bootstrap/lib/stdlib/include/ms_transform.hrl b/bootstrap/lib/stdlib/include/ms_transform.hrl index f8a2d35394..0d2c19fd4e 100644 --- a/bootstrap/lib/stdlib/include/ms_transform.hrl +++ b/bootstrap/lib/stdlib/include/ms_transform.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/bootstrap/lib/stdlib/include/qlc.hrl b/bootstrap/lib/stdlib/include/qlc.hrl index e3513314a0..60cd92aab0 100644 --- a/bootstrap/lib/stdlib/include/qlc.hrl +++ b/bootstrap/lib/stdlib/include/qlc.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/bootstrap/lib/stdlib/include/zip.hrl b/bootstrap/lib/stdlib/include/zip.hrl index 5f5abf9df3..2d0ee56f87 100644 --- a/bootstrap/lib/stdlib/include/zip.hrl +++ b/bootstrap/lib/stdlib/include/zip.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/erts/configure.in b/erts/configure.in index 97ddcf4666..11c428ced7 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -3351,6 +3351,13 @@ if test X${enable_hipe} = Xyes; then AC_DEFINE(HIPE,[1],[Define to enable HiPE]) HIPE_HELPERS="xmerl syntax_tools edoc" ENABLE_ALLOC_TYPE_VARS="$ENABLE_ALLOC_TYPE_VARS hipe" + case "$ARCH" in + amd64) + # For now exec_alloc is only used for hipe on amd64 + AC_MSG_NOTICE([Enable exec_alloc for hipe code allocation]) + ENABLE_ALLOC_TYPE_VARS="$ENABLE_ALLOC_TYPE_VARS exec_alloc" + ;; + esac fi fi AC_SUBST(HIPE_HELPERS) diff --git a/erts/doc/src/Makefile b/erts/doc/src/Makefile index e02e89238e..b96cbbce40 100644 --- a/erts/doc/src/Makefile +++ b/erts/doc/src/Makefile @@ -50,12 +50,14 @@ XML_REF1_FILES = epmd.xml \ XML_REF3_EFILES = \ erl_prim_loader.xml \ erlang.xml \ + erl_tracer.xml \ init.xml \ zlib.xml XML_REF3_FILES = \ driver_entry.xml \ erl_nif.xml \ + erl_tracer.xml \ erl_driver.xml \ erl_prim_loader.xml \ erlang.xml \ @@ -154,18 +156,9 @@ clean: rm -f $(SPECDIR)/* rm -f errs core *~ -$(SPECDIR)/specs_driver_entry.xml: +$(SPECDIR)/specs_%.xml: escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ - -o$(dir $@) -module driver_entry -$(SPECDIR)/specs_erl_nif.xml: - escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ - -o$(dir $@) -module erl_nif -$(SPECDIR)/specs_erl_driver.xml: - escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ - -o$(dir $@) -module erl_driver -$(SPECDIR)/specs_erts_alloc.xml: - escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ - -o$(dir $@) -module erts_alloc + -o$(dir $@) -module $(patsubst $(SPECDIR)/specs_%.xml,%,$@) # ---------------------------------------------------- # Release Target diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml index 13756ddfdc..6d6ba224a0 100644 --- a/erts/doc/src/absform.xml +++ b/erts/doc/src/absform.xml @@ -636,6 +636,9 @@ <item>If A is an association type <c>K => V</c>, where <c>K</c> and <c>V</c> are types, then Rep(A) = <c>{type,LINE,map_field_assoc,[Rep(K),Rep(V)]}</c>.</item> + <item>If A is an association type <c>K := V</c>, where + <c>K</c> and <c>V</c> are types, then Rep(A) = + <c>{type,LINE,map_field_exact,[Rep(K),Rep(V)]}</c>.</item> </list> </section> diff --git a/erts/doc/src/erl_dist_protocol.xml b/erts/doc/src/erl_dist_protocol.xml index b435d5c9b4..f9fa981d9a 100644 --- a/erts/doc/src/erl_dist_protocol.xml +++ b/erts/doc/src/erl_dist_protocol.xml @@ -364,14 +364,14 @@ If Result > 0, the packet only consists of [119, Result]. NodeInfo is, as expressed in Erlang: </p> <code> - io:format("active name ~ts at port ~p, fd = ~p ~n", + io:format("active name ~ts at port ~p, fd = ~p~n", [NodeName, Port, Fd]). </code> <p> or </p> <code> - io:format("old/unused name ~ts at port ~p, fd = ~p~n", + io:format("old/unused name ~ts at port ~p, fd = ~p ~n", [NodeName, Port, Fd]). </code> diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index b7839cec33..7546f7ef81 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -566,8 +566,7 @@ typedef struct { <code type="none"> typedef void ErlNifResourceDtor(ErlNifEnv* env, void* obj); </code> - <p>The function prototype of a resource destructor function. - A destructor function is not allowed to call any term-making functions.</p> + <p>The function prototype of a resource destructor function.</p> </item> <tag><marker id="ErlNifCharEncoding"/>ErlNifCharEncoding</tag> <item> @@ -1632,7 +1631,7 @@ enif_map_iterator_destroy(env, &iter); <tag><c>msg_env</c></tag> <item>The environment of the message term. Must be a process independent environment allocated with - <seealso marker="#enif_alloc_env">enif_alloc_env</seealso>.</item> + <seealso marker="#enif_alloc_env">enif_alloc_env</seealso> or NULL.</item> <tag><c>msg</c></tag> <item>The message term to send.</item> </taglist> @@ -1641,6 +1640,8 @@ enif_map_iterator_destroy(env, &iter); <c>msg</c>) will be invalidated by a successful call to <c>enif_send</c>. The environment should either be freed with <seealso marker="#enif_free_env">enif_free_env</seealso> of cleared for reuse with <seealso marker="#enif_clear_env">enif_clear_env</seealso>.</p> + <p>If <c>msg_env</c> is set to NULL the <c>msg</c> term is copied and + the original term and its environemt is still valid after the call.</p> <p>This function is only thread-safe when the emulator with SMP support is used. It can only be used in a non-SMP emulator from a NIF-calling thread.</p> <note><p>Passing <c>msg_env</c> as <c>NULL</c> is only supported since diff --git a/erts/doc/src/erl_tracer.xml b/erts/doc/src/erl_tracer.xml new file mode 100644 index 0000000000..2075b962d8 --- /dev/null +++ b/erts/doc/src/erl_tracer.xml @@ -0,0 +1,668 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2016</year><year>2016</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>erl_tracer</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + </header> + <module>erl_tracer</module> + <modulesummary>Erlang Tracer Behaviour</modulesummary> + <description> + <p>A behaviour module for implementing the back end of the erlang + tracing system. The functions in this module will be called whenever + a trace probe is triggered. Both the <c>enabled</c> and <c>trace</c> + functions are called in the context of the entity that triggered the + trace probe. + This means that the overhead by having the tracing enabled will be + greatly effected by how much time is spent in these functions. So do as + little work as possible in these functions.</p> + <note> + <p>All functions in this behaviour have to be implemented as NIF's. + This is a limitation that may the lifted in the future. + There is an <seealso marker="#example">example tracer module nif</seealso> + implementation at the end of this page.</p> + </note> + <warning> + <p>Do not send messages or issue port commands to the <c>Tracee</c> + in any of the callbacks. Doing so is not allowed and can cause all + sorts of strange behaviour, including but not limited to infinite + recursions.</p> + </warning> + </description> + + <datatypes> + <datatype> <name name="trace_tag_send" /> </datatype> + <datatype> <name name="trace_tag_receive" /> </datatype> + <datatype> <name name="trace_tag_call" /> </datatype> + <datatype> <name name="trace_tag_procs" /> </datatype> + <datatype> <name name="trace_tag_ports" /> </datatype> + <datatype> <name name="trace_tag_running_procs" /> </datatype> + <datatype> <name name="trace_tag_running_ports" /> </datatype> + <datatype> <name name="trace_tag_gc" /> </datatype> + <datatype> + <name name="trace_tag" /> + <desc> + <p>The different trace tags that the tracer will be called with. + Each trace tag is described in greater detail in + <seealso marker="#trace">Module:trace/6</seealso> + </p> + </desc> + </datatype> + <datatype> + <name name="tracee" /> + <desc> + <p>The process or port that the trace belongs to. + </p> + </desc> + </datatype> + <datatype> + <name name="trace_opts" /> + <desc> + <p>The options for the tracee. + <taglist> + <tag><c>timestamp</c></tag> + <item>If not set to <c>undefined</c>, the tracer has been requested to + include a timestamp.</item> + <tag><c>match_spec_result</c></tag> + <item>If not set to <c>true</c>, the tracer has been requested to + include the output of a match specification that was run.</item> + <tag><c>scheduler_id</c></tag> + <item>Set to a number of the scheduler id is to be included by the tracer. + Otherwise it is set to <c>undefined</c>.</item> + </taglist> + </p> + </desc> + </datatype> + <datatype> + <name name="tracer_state" /> + <desc> + <p> + The state which is given when calling + <seealso marker="erlang#trace-3"><c>erlang:trace(PidPortSpec,true,[{tracer,Module,TracerState}])</c></seealso>. + The tracer state is an immutable value that is passed to erl_tracer callbacks and should + contain all the data that is needed to generate the trace event. + </p> + </desc> + </datatype> + </datatypes> + + <section> + <title>CALLBACK FUNCTIONS</title> + <p>The following functions + should be exported from a <c>erl_tracer</c> callback module.</p> + <taglist> + <tag><seealso marker="#enabled"><c>Module:enabled/3</c></seealso></tag> + <item>Mandatory</item> + <tag><seealso marker="#trace"><c>Module:trace/6</c></seealso></tag> + <item>Mandatory</item> + <tag><seealso marker="#enabled_procs"><c>Module:enabled_procs/3</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#trace_procs"><c>Module:trace_procs/6</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#enabled_ports"><c>Module:enabled_ports/3</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#trace_ports"><c>Module:trace_ports/6</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#enabled_running_ports"><c>Module:enabled_running_ports/3</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#trace_running_ports"><c>Module:trace_running_ports/6</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#enabled_running_procs"><c>Module:enabled_running_procs/3</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#trace_running_procs"><c>Module:trace_running_procs/6</c></seealso></tag> + <item>Optional</item> + </taglist> + + </section> + <marker id="enabled"></marker> + <funcs> + <func> + <name>Module:enabled(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag">trace_tag()</seealso> | trace_status</v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint is triggered. It + allows the tracer to decide whether a trace should be generated or not. + This check is made as early as possible in order to limit the amount of + overhead associated with tracing. If <c>trace</c> is returned the + necessary trace data will be created and the trace call-back of the tracer + will be called. If <c>discard</c> is returned, this trace call + will be discarded and no call to trace will be done. If + <c>remove</c> is returned, the VM will attempt to remove this tracer + from the tracee, together with any trace flags set on the tracee. + </p> + <p><c>trace_status</c> is a special type of <c>TraceTag</c> which is used + to check if the tracer should still be active. It is called in multiple + scenarios, but most significantly it is used when tracing is started + using this tracer.</p> + <p>This function may be called multiple times per tracepoint, so it + is important that it is both fast and side effect free.</p> + </desc> + </func> + <marker id="trace"></marker> + <func> + <name>Module:trace(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag">trace_tag()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled">Module:enabled/3</seealso> + callback returned <c>trace</c>. In it any side effects needed by + the tracer should be done. The tracepoint payload is located in + the <c>FirstTraceTerm</c> and <c>SecondTraceTerm</c>. The content + of the TraceTerms depends on which <c>TraceTag</c> has been triggered. + The <c>FirstTraceTerm</c> and <c>SecondTraceTerm</c> correspond to the + fourth and fifth slot in the trace tuples described in + <seealso marker="erlang#trace_3_trace_messages">erlang:trace/3</seealso>. + If the tuple only has four elements, <c>SecondTraceTerm</c> will be + <c>undefined</c>.</p> + </desc> + </func> + <func> + <name name="trace">Module:trace(seq_trace, TracerState, Label, SeqTraceInfo, undefined, Opts) -> Result</name> + <fsummary>Check if a sequence trace event should be generated.</fsummary> + <type> + <v>TracerState = term()</v> + <v>Label = term()</v> + <v>SeqTraceInfo = term()</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>The <c>TraceTag</c> <c>seq_trace</c> is handled a little bit + differently. There is not <c>Tracee</c> for seq_trace, instead the + <c>Label</c> associated with the seq_trace event is given. + For more info on what <c>Label</c> and <c>SeqTraceInfo</c> can be + see the <seealso marker="kernel:seq_trace">seq_trace</seealso> manual.</p> + </desc> + </func> + + <marker id="enabled_procs"></marker> + <func> + <name>Module:enabled_procs(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_procs">trace_tag_procs()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>procs</c></seealso> + is triggered.</p> + <p>If <c>enabled_procs/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_procs"></marker> + <func> + <name>Module:trace_procs(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_procs">trace_tag()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_procs">Module:enabled_procs/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_procs/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_ports"></marker> + <func> + <name>Module:enabled_ports(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_ports">trace_tag_ports()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>ports</c></seealso> + is triggered.</p> + <p>If <c>enabled_ports/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_ports"></marker> + <func> + <name>Module:trace_ports(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_ports">trace_tag()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_ports">Module:enabled_ports/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_ports/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_running_procs"></marker> + <func> + <name>Module:enabled_running_procs(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_running_procs">trace_tag_running_procs()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>running_procs | running</c></seealso> + is triggered.</p> + <p>If <c>enabled_running_procs/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_running_procs"></marker> + <func> + <name>Module:trace_running_procs(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_running_procs">trace_tag_running_procs()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_running_procs">Module:enabled_running_procs/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_running_procs/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_running_ports"></marker> + <func> + <name>Module:enabled_running_ports(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_running_ports">trace_tag_running_ports()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>running_ports</c></seealso> + is triggered.</p> + <p>If <c>enabled_running_ports/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_running_ports"></marker> + <func> + <name>Module:trace_running_ports(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_running_ports">trace_tag_running_ports()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_running_ports">Module:enabled_running_ports/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_running_ports/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_call"></marker> + <func> + <name>Module:enabled_call(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_call">trace_tag_call()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>call | return_to</c></seealso> + is triggered.</p> + <p>If <c>enabled_call/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_call"></marker> + <func> + <name>Module:trace_call(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_call">trace_tag_call()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_call">Module:enabled_call/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_call/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_send"></marker> + <func> + <name>Module:enabled_send(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_send">trace_tag_send()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>send</c></seealso> + is triggered.</p> + <p>If <c>enabled_send/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_send"></marker> + <func> + <name>Module:trace_send(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_send">trace_tag_send()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_send">Module:enabled_send/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_send/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_receive"></marker> + <func> + <name>Module:enabled_receive(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_receive">trace_tag_receive()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>'receive'</c></seealso> + is triggered.</p> + <p>If <c>enabled_receive/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_receive"></marker> + <func> + <name>Module:trace_receive(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_receive">trace_tag_receive()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_receive">Module:enabled_receive/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_receive/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_garbage_collection"></marker> + <func> + <name>Module:enabled_garbage_collection(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_gc">trace_tag_gc()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>garbage_collection</c></seealso> + is triggered.</p> + <p>If <c>enabled_garbage_collection/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_garbage_collection"></marker> + <func> + <name>Module:trace_garbage_collection(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_gc">trace_tag_gc()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_garbage_collection">Module:enabled_garbage_collection/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_garbage_collection/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + </funcs> + <section> + <marker id="example"></marker> + <title>Erl Tracer Module example</title> + <p>In the example below a tracer module with a nif backend sends a message + for each <c>send</c> trace tag containing only the sender and receiver. + Using this tracer module, a much more lightweight message tracer is + used that only records who sent messages to who.</p> + <p>Here is an example session using it on Linux.</p> + <pre> +$ gcc -I erts-8.0/include/ -fPIC -shared -o erl_msg_tracer.so erl_msg_tracer.c +$ erl +Erlang/OTP 19 [DEVELOPMENT] [erts-8.0] [source-ed2b56b] [64-bit] [smp:8:8] [async-threads:10] [hipe] [kernel-poll:false] + +Eshell V8.0 (abort with ^G) +1> c(erl_msg_tracer), erl_msg_tracer:load(). +ok +2> Tracer = spawn(fun F() -> receive M -> io:format("~p~n",[M]), F() end end). +<0.37.0> +3> erlang:trace(new, true, [send,{tracer, erl_msg_tracer, Tracer}]). +0 +{<0.39.0>,<0.27.0>} +4> {ok, D} = file:open("/tmp/tmp.data",[write]). +{trace,#Port<0.486>,<0.40.0>} +{trace,<0.40.0>,<0.21.0>} +{trace,#Port<0.487>,<0.4.0>} +{trace,#Port<0.488>,<0.4.0>} +{trace,#Port<0.489>,<0.4.0>} +{trace,#Port<0.490>,<0.4.0>} +{ok,<0.40.0>} +{trace,<0.41.0>,<0.27.0>} +5> + </pre> + <p>erl_msg_tracer.erl</p> + <pre> +-module(erl_msg_tracer). + +-export([enabled/3, trace/6, load/0]). + +load() -> + erlang:load_nif("erl_msg_tracer", []). + +enabled(_, _, _) -> + error. + +trace(_, _, _,_, _, _) -> + error. + </pre> + <p>erl_msg_tracer.c</p> + <pre> +#include "erl_nif.h" + +/* NIF interface declarations */ +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); +static void unload(ErlNifEnv* env, void* priv_data); + +/* The NIFs: */ +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ErlNifFunc nif_funcs[] = { + {"enabled", 3, enabled}, + {"trace", 6, trace} +}; + +ERL_NIF_INIT(erl_msg_tracer, nif_funcs, load, NULL, upgrade, unload) + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + *priv_data = NULL; + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ + +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, + ERL_NIF_TERM load_info) +{ + if (*old_priv_data != NULL || *priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (load(env, priv_data, load_info)) { + return -1; + } + return 0; +} + +/* + * argv[0]: Trace Tag + * argv[1]: TracerState + * argv[2]: Tracee + */ +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid to_pid; + if (enif_get_local_pid(env, argv[1], &to_pid)) + if (!enif_is_process_alive(env, &to_pid)) + /* tracer is dead so we should remove this tracepoint */ + return enif_make_atom(env, "remove"); + + /* Only generate trace for when tracer != tracee */ + if (enif_is_identical(argv[1], argv[2])) + return enif_make_atom(env, "discard"); + + /* Only trigger trace messages on 'send' */ + if (enif_is_identical(enif_make_atom(env, "send"), argv[0])) + return enif_make_atom(env, "trace"); + + /* Have to answer trace_status */ + if (enif_is_identical(enif_make_atom(env, "trace_status"), argv[0])) + return enif_make_atom(env, "trace"); + + return enif_make_atom(env, "discard"); +} + +/* + * argv[0]: Trace Tag, should only be 'send' + * argv[1]: TracerState, process to send {argv[2], argv[4]} to + * argv[2]: Tracee + * argv[3]: Message, ignored + * argv[4]: Recipient + * argv[5]: Options, ignored + */ +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid to_pid; + + if (enif_get_local_pid(env, argv[1], &to_pid)) { + ERL_NIF_TERM msg = enif_make_tuple3(env, enif_make_atom(env, "trace"), argv[2], argv[4]); + enif_send(env, &to_pid, NULL, msg); + } + + return enif_make_atom(env, "ok"); +} + </pre> + </section> +</erlref> diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index ef577c82bf..423ccdf98f 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -2613,6 +2613,48 @@ os_prompt% </pre> </func> <func> + <name name="match_spec_test" arity="3"/> + <fsummary>Test that a match specification works</fsummary> + <desc> + <p> + This function is a utility to test a match_spec used in calls to + <seealso marker="stdlib:ets#select/2">ets:select/2</seealso> and + <seealso marker="#trace_pattern/3">erlang:trace_pattern/3</seealso>. + The function both tests MatchSpec for "syntactic" correctness and + runs the match_spec against the object. If the match_spec contains + errors, the tuple {error, Errors} is returned where Errors is a list + of natural language descriptions of what was wrong with the match_spec. + </p> + <p> + If the <c><anno>Type</anno></c> is <c>table</c> the object to match + against should be a tuple. The function then returns + {ok,Result,[],Warnings} where Result is what would have been the + result in a real ets:select/2 call or false if the match_spec does + not match the object tuple. + </p> + + <p> + If <c><anno>Type</anno></c> is <c>trace</c> the object to match + against should be a list. The function returns + {ok, Result, Flags, Warnings} where Result is <c>true</c> if a trace + message should be emitted, <c>false</c> if a trace message should not + be emitted or the message term to be appended to the trace message. + Flags is a list containing all the trace flags that will be enabled, + at the moment this is only <c>return_trace</c>. + </p> + + <p> + This is a useful debugging and test tool, especially when writing complicated + match specifications. + </p> + <p> + See also + <seealso marker="stdlib:ets#test_ms/2">ets:test_ms/2</seealso>. + </p> + </desc> + </func> + + <func> <name name="max" arity="2"/> <fsummary>Returns the largest of two terms.</fsummary> <desc> @@ -8347,22 +8389,47 @@ timestamp() -> <c><anno>How</anno> == false</c>) the trace flags in <c><anno>FlagList</anno></c> for the process or processes represented by - <c><anno>PidSpec</anno></c>.</p> - <p><c><anno>PidSpec</anno></c> is either a process identifier - (pid) for a local process, or one of the following atoms:</p> + <c><anno>PidPortSpec</anno></c>.</p> + <p><c><anno>PidPortSpec</anno></c> is either a process identifier + (pid) for a local process, a port identifier, + or one of the following atoms:</p> <taglist> + <tag><c>all</c></tag> + <item> + <p>All currently existing processes and ports and all that + will be created in the future.</p> + </item> + <tag><c>processes</c></tag> + <item> + <p>All currently existing processes and all that will be created in the future.</p> + </item> + <tag><c>ports</c></tag> + <item> + <p>All currently existing ports and all that will be created in the future.</p> + </item> <tag><c>existing</c></tag> <item> + <p>All currently existing processes and ports.</p> + </item> + <tag><c>existing_processes</c></tag> + <item> <p>All currently existing processes.</p> </item> + <tag><c>existing_ports</c></tag> + <item> + <p>All currently existing ports.</p> + </item> <tag><c>new</c></tag> <item> - <p>All processes that are created in the future.</p> + <p>All processes and ports that will be created in the future.</p> </item> - <tag><c>all</c></tag> + <tag><c>new_processes</c></tag> + <item> + <p>All processes that will be created in the future.</p> + </item> + <tag><c>new_ports</c></tag> <item> - <p>All currently existing processes and all processes that - are created in the future.</p> + <p>All ports that will be created in the future.</p> </item> </taglist> <p><c><anno>FlagList</anno></c> can contain any number of the @@ -8371,35 +8438,28 @@ timestamp() -> <taglist> <tag><c>all</c></tag> <item> - <p>Sets all trace flags except <c>{tracer, Tracer}</c> and + <p>Sets all trace flags except <c>tracer</c> and <c>cpu_timestamp</c>, which are in their nature different than the others.</p> </item> <tag><c>send</c></tag> <item> <p>Traces sending of messages.</p> - <p>Message tags: <c>send</c> and - <c>send_to_non_existing_process</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_send">send</seealso></c> and + <c><seealso marker="#trace_3_trace_messages_send_to_non_existing_process">send_to_non_existing_process</seealso></c>.</p> </item> <tag><c>'receive'</c></tag> <item> <p>Traces receiving of messages.</p> - <p>Message tags: <c>'receive'</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_receive">'receive'</seealso></c>.</p> </item> - <tag><c>procs</c></tag> - <item> - <p>Traces process-related events.</p> - <p>Message tags: <c>spawn</c>, <c>exit</c>, - <c>register</c>, <c>unregister</c>, <c>link</c>, - <c>unlink</c>, <c>getting_linked</c>, and - <c>getting_unlinked</c>.</p> - </item> - <tag><c>call</c></tag> +<tag><c>call</c></tag> <item> <p>Traces certain function calls. Specify which function calls to trace by calling <seealso marker="#trace_pattern/3">erlang:trace_pattern/3</seealso>.</p> - <p>Message tags: <c>call</c> and <c>return_from</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_call">call</seealso></c> and + <c><seealso marker="#trace_3_trace_messages_return_from">return_from</seealso></c>.</p> </item> <tag><c>silent</c></tag> <item> @@ -8417,8 +8477,9 @@ timestamp() -> specification function <c>{silent,Bool}</c>, giving a high degree of control of which functions with which arguments that trigger the trace.</p> - <p>Message tags: <c>call</c>, <c>return_from</c>, and - <c>return_to</c>. Or rather, the absence of.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_call">call</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_return_from">return_from</seealso></c>, and + <c><seealso marker="#trace_3_trace_messages_return_to">return_to</seealso></c>. Or rather, the absence of.</p> </item> <tag><c>return_to</c></tag> <item> @@ -8439,23 +8500,63 @@ timestamp() -> <p>To get trace messages containing return values from functions, use the <c>{return_trace}</c> match specification action instead.</p> - <p>Message tags: <c>return_to</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_return_to">return_to</seealso></c>.</p> + </item> + <tag><c>procs</c></tag> + <item> + <p>Traces process-related events.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_spawn">spawn</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_spawned">spawned</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_exit">exit</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_register">register</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_unregister">unregister</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_link">link</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_unlink">unlink</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_getting_linked">getting_linked</seealso></c>, and + <c><seealso marker="#trace_3_trace_messages_getting_unlinked">getting_unlinked</seealso></c>.</p> + </item> + <tag><c>ports</c></tag> + <item> + <p>Traces port-related events.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_open">open</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_closed">closed</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_register">register</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_unregister">unregister</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_getting_linked">getting_linked</seealso></c>, and + <c><seealso marker="#trace_3_trace_messages_getting_unlinked">getting_unlinked</seealso></c>.</p> </item> <tag><c>running</c></tag> <item> <p>Traces scheduling of processes.</p> - <p>Message tags: <c>in</c> and <c>out</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_in_proc">in</seealso></c> and + <c><seealso marker="#trace_3_trace_messages_out_proc">out</seealso></c>.</p> </item> <tag><c>exiting</c></tag> <item> <p>Traces scheduling of exiting processes.</p> - <p>Message tags: <c>in_exiting</c>, <c>out_exiting</c>, and - <c>out_exited</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_in_exiting_proc">in_exiting</seealso></c>, + <c><seealso marker="#trace_3_trace_messages_out_exiting_proc">out_exiting</seealso></c>, and + <c><seealso marker="#trace_3_trace_messages_out_exited_proc">out_exited</seealso></c>.</p> + </item> + <tag><c>running_procs</c></tag> + <item> + <p>Traces scheduling of processes just like <c>running</c>. + However this option also includes schedule events when the + process executes within the context of a port without + being scheduled out itself.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_in_proc">in</seealso></c> and + <c><seealso marker="#trace_3_trace_messages_out_proc">out</seealso></c>.</p> + </item> + <tag><c>running_ports</c></tag> + <item> + <p>Traces scheduling of ports.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_in_port">in</seealso></c> and + <c><seealso marker="#trace_3_trace_messages_out_port">out</seealso></c>.</p> </item> <tag><c>garbage_collection</c></tag> <item> <p>Traces garbage collections of processes.</p> - <p>Message tags: <c>gc_start</c> and <c>gc_end</c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_gc_start">gc_start</seealso></c> and <c><seealso marker="#trace_3_trace_messages_gc_end">gc_end</seealso></c>.</p> </item> <tag><c>timestamp</c></tag> <item> @@ -8470,8 +8571,8 @@ timestamp() -> in CPU time, not wall clock time. That is, <c>cpu_timestamp</c> will not be used if <c>monotonic_timestamp</c>, or <c>strict_monotonic_timestamp</c> is enabled. - Only allowed with <c>PidSpec==all</c>. If the host - machine OS does not support high-resolution + Only allowed with <c><anno>PidPortSpec</anno>==all</c>. If the + host machine OS does not support high-resolution CPU time measurements, <c>trace/3</c> exits with <c>badarg</c>. Notice that most OS do not synchronize this value across cores, so be prepared @@ -8483,8 +8584,8 @@ timestamp() -> <seealso marker="time_correction#Erlang_Monotonic_Time">Erlang monotonic time</seealso> time-stamp in all trace messages. The time-stamp (Ts) has the same format and value as produced by - <c>erlang:monotonic_time(nano_seconds)</c>. This flag overrides - the <c>cpu_timestamp</c> flag.</p> + <c><seealso marker="#monotonic_time-1">erlang:monotonic_time(nano_seconds)</seealso></c>. + This flag overrides the <c>cpu_timestamp</c> flag.</p> </item> <tag><c>strict_monotonic_timestamp</c></tag> <item> @@ -8493,9 +8594,9 @@ timestamp() -> monotonic time</seealso> and a monotonically increasing integer in all trace messages. The time-stamp (Ts) has the same format and value as produced by - <c>{erlang:monotonic_time(nano_seconds), - erlang:unique_integer([monotonic])}</c>. This flag overrides - the <c>cpu_timestamp</c> flag.</p> + <c>{<seealso marker="#monotonic_time-1">erlang:monotonic_time(nano_seconds)</seealso>, + <seealso marker="#unique_integer-1">erlang:unique_integer([monotonic])</seealso>}</c>. + This flag overrides the <c>cpu_timestamp</c> flag.</p> </item> <tag><c>arity</c></tag> <item> @@ -8529,12 +8630,20 @@ timestamp() -> <item> <p>Specifies where to send the trace messages. <c>Tracer</c> must be the process identifier of a local process - or the port identifier - of a local port. If this flag is not given, trace - messages are sent to the process that called - <c>erlang:trace/3</c>.</p> + or the port identifier of a local port.</p> + </item> + <tag><c>{tracer, TracerModule, TracerState}</c></tag> + <item> + <p>Specifies that a tracer module should be called + instead of sending a trace message. The tracer module + can then ignore or change the trace message. For more details + on how to write a tracer module see <seealso marker="erl_tracer"> + erl_tracer</seealso> + </p> </item> </taglist> + <p>If no <c>tracer</c> is given, the calling process + will be receiving all of the trace messages</p> <p>The effect of combining <c>set_on_first_link</c> with <c>set_on_link</c> is the same as having <c>set_on_first_link</c> alone. Likewise for @@ -8555,21 +8664,36 @@ timestamp() -> the other one will become active.</p> <marker id="trace_3_trace_messages"></marker> <taglist> - <tag><c>{trace, Pid, 'receive', Msg}</c></tag> - <item> - <p>When <c>Pid</c> receives message <c>Msg</c>.</p> - </item> - <tag><c>{trace, Pid, send, Msg, To}</c></tag> + <tag> + <marker id="trace_3_trace_messages_send"></marker> + <c>{trace, PidPort, send, Msg, To}</c> + </tag> <item> - <p>When <c>Pid</c> sends message <c>Msg</c> to + <p>When <c>PidPort</c> sends message <c>Msg</c> to process <c>To</c>.</p> </item> - <tag><c>{trace, Pid, send_to_non_existing_process, Msg, To}</c></tag> + <tag> + <marker id="trace_3_trace_messages_send_to_non_existing_process"></marker> + <c>{trace, PidPort, send_to_non_existing_process, Msg, To}</c> + </tag> <item> - <p>When <c>Pid</c> sends message <c>Msg</c> to + <p>When <c>PidPort</c> sends message <c>Msg</c> to the non-existing process <c>To</c>.</p> </item> - <tag><c>{trace, Pid, call, {M, F, Args}}</c></tag> + <tag> + <marker id="trace_3_trace_messages_receive"></marker> + <c>{trace, PidPort, 'receive', Msg}</c> + </tag> + <item> + <p>When <c>PidPort</c> receives message <c>Msg</c>. + If <c>Msg</c> is set to timeout, then a receive + statement may have timedout, or the process received + a message with the payload <c>timeout</c>.</p> + </item> + <tag> + <marker id="trace_3_trace_messages_call"></marker> + <c>{trace, Pid, call, {M, F, Args}}</c> + </tag> <item> <p>When <c>Pid</c> calls a traced function. The return values of calls are never supplied, only the call and its @@ -8578,7 +8702,10 @@ timestamp() -> change the contents of this message, so that <c>Arity</c> is specified instead of <c>Args</c>.</p> </item> - <tag><c>{trace, Pid, return_to, {M, F, Arity}}</c></tag> + <tag> + <marker id="trace_3_trace_messages_return_to"></marker> + <c>{trace, Pid, return_to, {M, F, Arity}}</c> + </tag> <item> <p>When <c>Pid</c> returns <em>to</em> the specified function. This trace message is sent if both @@ -8590,73 +8717,172 @@ timestamp() -> (that is, the functions match specification matched, and <c>{message, false}</c> was not an action).</p> </item> - <tag><c>{trace, Pid, return_from, {M, F, Arity}, ReturnValue}</c></tag> + <tag> + <marker id="trace_3_trace_messages_return_from"></marker> + <c>{trace, Pid, return_from, {M, F, Arity}, ReturnValue}</c> + </tag> <item> <p>When <c>Pid</c> returns <em>from</em> the specified function. This trace message is sent if flag <c>call</c> is set, and the function has a match specification with a <c>return_trace</c> or <c>exception_trace</c> action.</p> </item> - <tag><c>{trace, Pid, exception_from, {M, F, Arity}, {Class, Value}}</c></tag> + <tag> + <marker id="trace_3_trace_messages_exception_from"></marker> + <c>{trace, Pid, exception_from, {M, F, Arity}, {Class, Value}}</c> + </tag> <item> <p>When <c>Pid</c> exits <em>from</em> the specified function because of an exception. This trace message is sent if flag <c>call</c> is set, and the function has a match specification with an <c>exception_trace</c> action.</p> </item> - <tag><c>{trace, Pid, spawn, Pid2, {M, F, Args}}</c></tag> + <tag> + <marker id="trace_3_trace_messages_spawn"></marker> + <c>{trace, Pid, spawn, Pid2, {M, F, Args}}</c> + </tag> <item> <p>When <c>Pid</c> spawns a new process <c>Pid2</c> with the specified function call as entry point.</p> <p><c>Args</c> is supposed to be the argument list, but can be any term if the spawn is erroneous.</p> </item> - <tag><c>{trace, Pid, exit, Reason}</c></tag> + <tag> + <marker id="trace_3_trace_messages_spawned"></marker> + <c>{trace, Pid, spawned, Pid2, {M, F, Args}}</c> + </tag> + <item> + <p>When <c>Pid</c> is spawned by process <c>Pid2</c> with + the specified function call as entry point.</p> + <p><c>Args</c> is supposed to be the argument list, + but can be any term if the spawn is erroneous.</p> + </item> + <tag> + <marker id="trace_3_trace_messages_exit"></marker> + <c>{trace, Pid, exit, Reason}</c> + </tag> <item> <p>When <c>Pid</c> exits with reason <c>Reason</c>.</p> </item> - <tag><c>{trace, Pid, link, Pid2}</c></tag> + <tag> + <marker id="trace_3_trace_messages_register"></marker> + <c>{trace, PidPort, register, RegName}</c> + </tag> + <item> + <p>When <c>PidPort</c> gets the name <c>RegName</c> registered.</p> + </item> + <tag> + <marker id="trace_3_trace_messages_unregister"></marker> + <c>{trace, PidPort, unregister, RegName}</c> + </tag> + <item> + <p>When <c>PidPort</c> gets the name <c>RegName</c> unregistered. + This is done automatically when a registered + process or port exits.</p> + </item> + <tag> + <marker id="trace_3_trace_messages_link"></marker> + <c>{trace, Pid, link, Pid2}</c> + </tag> <item> <p>When <c>Pid</c> links to a process <c>Pid2</c>.</p> </item> - <tag><c>{trace, Pid, unlink, Pid2}</c></tag> + <tag> + <marker id="trace_3_trace_messages_unlink"></marker> + <c>{trace, Pid, unlink, Pid2}</c> + </tag> <item> <p>When <c>Pid</c> removes the link from a process <c>Pid2</c>.</p> </item> - <tag><c>{trace, Pid, getting_linked, Pid2}</c></tag> + <tag> + <marker id="trace_3_trace_messages_getting_linked"></marker> + <c>{trace, PidPort, getting_linked, Pid2}</c> + </tag> <item> - <p>When <c>Pid</c> gets linked to a process <c>Pid2</c>.</p> + <p>When <c>PidPort</c> gets linked to a process <c>Pid2</c>.</p> </item> - <tag><c>{trace, Pid, getting_unlinked, Pid2}</c></tag> + <tag> + <marker id="trace_3_trace_messages_getting_unlinked"></marker> + <c>{trace, PidPort, getting_unlinked, Pid2}</c> + </tag> <item> - <p>When <c>Pid</c> gets unlinked from a process <c>Pid2</c>.</p> + <p>When <c>PidPort</c> gets unlinked from a process <c>Pid2</c>.</p> </item> - <tag><c>{trace, Pid, register, RegName}</c></tag> + <tag> + <marker id="trace_3_trace_messages_exit"></marker> + <c>{trace, Pid, exit, Reason}</c> + </tag> <item> - <p>When <c>Pid</c> gets the name <c>RegName</c> registered.</p> + <p>When <c>Pid</c> exits with reason <c>Reason</c>.</p> </item> - <tag><c>{trace, Pid, unregister, RegName}</c></tag> + <tag> + <marker id="trace_3_trace_messages_open"></marker> + <c>{trace, Port, open, Pid, Driver}</c> + </tag> <item> - <p>When <c>Pid</c> gets the name <c>RegName</c> unregistered. - This is done automatically when a registered - process exits.</p> + <p>When <c>Pid</c> opens a new port <c>Port</c> with + the running the <c>Driver</c>.</p> + <p><c>Driver</c> is the name of the driver as an atom.</p> + </item> + <tag> + <marker id="trace_3_trace_messages_closed"></marker> + <c>{trace, Port, closed, Reason}</c> + </tag> + <item> + <p>When <c>Port</c> closed with <c>Reason</c>.</p> </item> - <tag><c>{trace, Pid, in, {M, F, Arity} | 0}</c></tag> + <tag> + <marker id="trace_3_trace_messages_in_proc"></marker> + <marker id="trace_3_trace_messages_in_exiting_proc"></marker> + <c>{trace, Pid, in | in_exiting, {M, F, Arity} | 0}</c> + </tag> <item> <p>When <c>Pid</c> is scheduled to run. The process runs in function <c>{M, F, Arity}</c>. On some rare occasions, the current function cannot be determined, then the last element is <c>0</c>.</p> </item> - <tag><c>{trace, Pid, out, {M, F, Arity} | 0}</c></tag> + <tag> + <marker id="trace_3_trace_messages_out_proc"></marker> + <marker id="trace_3_trace_messages_out_exiting_proc"></marker> + <marker id="trace_3_trace_messages_out_exited_proc"></marker> + <c>{trace, Pid, out | out_exiting | out_exited, {M, F, Arity} | 0}</c> + </tag> <item> <p>When <c>Pid</c> is scheduled out. The process was running in function {M, F, Arity}. On some rare occasions, the current function cannot be determined, then the last element is <c>0</c>.</p> </item> - <tag><c>{trace, Pid, gc_start, Info}</c></tag> + <tag> + <marker id="trace_3_trace_messages_in_port"></marker> + <c>{trace, Port, in, Command | 0}</c> + </tag> + <item> + <p>When <c>Port</c> is scheduled to run. <c>Command</c> is the + first thing the port will execute, it may however run several + commands before being scheduled out. On some rare + occasions, the current function cannot be determined, + then the last element is <c>0</c>.</p> + <p>The possible commands are: <c>call | close | command | connect | control | flush | info | link | open | unlink</c></p> + </item> + <tag> + <marker id="trace_3_trace_messages_out_port"></marker> + <c>{trace, Port, out, Command | 0}</c> + </tag> + <item> + <p>When <c>Port</c> is scheduled out. The last command run + was <c>Command</c>. On some rare occasions, + the current function cannot be determined, then the last + element is <c>0</c>. <c>Command</c> can contain the same + commands as <c>in</c> + </p> + </item> + <tag> + <marker id="trace_3_trace_messages_gc_start"></marker> + <c>{trace, Pid, gc_start, Info}</c> + </tag> <item> <marker id="gc_start"></marker> <p>Sent when garbage collection is about to be started. @@ -8698,7 +8924,10 @@ timestamp() -> </taglist> <p>All sizes are in words.</p> </item> - <tag><c>{trace, Pid, gc_end, Info}</c></tag> + <tag> + <marker id="trace_3_trace_messages_gc_end"></marker> + <c>{trace, Pid, gc_end, Info}</c> + </tag> <item> <p>Sent when garbage collection is finished. <c>Info</c> contains the same kind of list as in message <c>gc_start</c>, @@ -8706,18 +8935,18 @@ timestamp() -> garbage collection.</p> </item> </taglist> - <p>If the tracing process dies, the flags are silently - removed.</p> - <p>Only one process can trace a particular process. Therefore, + <p>If the tracing process/port dies or the tracer module returns + <c>remove</c>, the flags are silently removed.</p> + <p>Each process can only be traced by one tracer. Therefore, attempts to trace an already traced process fail.</p> <p>Returns: A number indicating the number of processes that - matched <c><anno>PidSpec</anno></c>. - If <c><anno>PidSpec</anno></c> is a process + matched <c><anno>PidPortSpec</anno></c>. + If <c><anno>PidPortSpec</anno></c> is a process identifier, the return value is <c>1</c>. - If <c><anno>PidSpec</anno></c> + If <c><anno>PidPortSpec</anno></c> is <c>all</c> or <c>existing</c>, the return value is - the number of processes running, excluding tracer processes. - If <c><anno>PidSpec</anno></c> is <c>new</c>, the return value is + the number of processes running. + If <c><anno>PidPortSpec</anno></c> is <c>new</c>, the return value is <c>0</c>.</p> <p>Failure: <c>badarg</c> if the specified arguments are not supported. For example, <c>cpu_timestamp</c> is not @@ -8729,7 +8958,11 @@ timestamp() -> <name name="trace_delivered" arity="1"/> <fsummary>Notification when trace has been delivered.</fsummary> <desc> - <p>The delivery of trace messages is dislocated on the time-line + <p>The delivery of trace messages (generated by + <seealso marker="#trace/3"><c>erlang:trace/3</c></seealso>, + <seealso marker="kernel:seq_trace"><c>seq_trace</c></seealso> or + <seealso marker="#system_profile/2"><c>erlang:system_profile/2</c></seealso>) + is dislocated on the time-line compared to other events in the system. If you know that <c><anno>Tracee</anno></c> has passed some specific point in its execution, @@ -8750,13 +8983,16 @@ timestamp() -> has not been traced by someone, but if this is the case, <em>no</em> trace messages have been delivered when the <c>trace_delivered</c> message arrives.</p> - <p>Notice that that <c><anno>Tracee</anno></c> must refer + <p>Notice that <c><anno>Tracee</anno></c> must refer to a process currently, or previously existing on the same node as the caller of <c>erlang:trace_delivered(<anno>Tracee</anno>)</c> resides on. The special <c><anno>Tracee</anno></c> atom <c>all</c> - denotes all processes - that currently are traced in the node.</p> + denotes all processes that currently are traced in the node.</p> + <p>When used together with an <seealso marker="#erl_tracer"> + Tracer Module</seealso> any message sent in the trace callback + is guaranteed to have reached it's recipient before the + <c>trace_delivered</c> message is sent.</p> <p>Example: Process <c>A</c> is <c><anno>Tracee</anno></c>, port <c>B</c> is tracer, and process <c>C</c> is the port owner of <c>B</c>. <c>C</c> wants to close <c>B</c> when @@ -8779,12 +9015,15 @@ timestamp() -> <type name="trace_info_flag"/> <type name="trace_match_spec"/> <desc> - <p>Returns trace information about a process or function.</p> - <p>To get information about a process, - <c><anno>PidOrFunc</anno></c> is to - be a process identifier (pid) or the atom <c>new</c>. - The atom <c>new</c> means that the default trace state for - processes to be created is returned.</p> + <p>Returns trace information about a port, process or function.</p> + <p>To get information about a port or process, + <c><anno>PidPortOrFunc</anno></c> is to + be a process identifier (pid), port identifier or one of + the atoms <c>new</c>, <c>new_processes</c>, <c>new_ports</c>. + The atom <c>new</c> or <c>new_processes</c> means that the default trace + state for processes to be created is returned. The atom <c>new_ports</c> + means that the default trace state for ports to be created is returned. + </p> <p>The following <c>Item</c>s are valid:</p> <taglist> <tag><c>flags</c></tag> @@ -8794,19 +9033,22 @@ timestamp() -> traces are enabled, and one or more of the followings atoms if traces are enabled: <c>send</c>, <c>'receive'</c>, <c>set_on_spawn</c>, <c>call</c>, - <c>return_to</c>, <c>procs</c>, <c>set_on_first_spawn</c>, - <c>set_on_link</c>, <c>running</c>, + <c>return_to</c>, <c>procs</c>, <c>ports</c>, <c>set_on_first_spawn</c>, + <c>set_on_link</c>, <c>running</c>, <c>running_procs</c>, + <c>running_ports</c>, <c>silent</c>, <c>exiting</c> + <c>monotonic_timestamp</c>, <c>strict_monotonic_timestamp</c>, <c>garbage_collection</c>, <c>timestamp</c>, and <c>arity</c>. The order is arbitrary.</p> </item> <tag><c>tracer</c></tag> <item> - <p>Returns the identifier for process or port tracing this + <p>Returns the identifier for process, port or a tuple containing + the tracer module and tracer state tracing this process. If this process is not being traced, the return value is <c>[]</c>.</p> </item> </taglist> - <p>To get information about a function, <c>PidOrFunc</c> is to + <p>To get information about a function, <c><anno>PidPortOrFunc</anno></c> is to be the three-element tuple <c>{Module, Function, Arity}</c> or the atom <c>on_load</c>. No wild cards are allowed. Returns <c>undefined</c> if the function does not exist, or @@ -8830,8 +9072,8 @@ timestamp() -> </item> <tag><c>meta</c></tag> <item> - <p>Returns the meta-trace tracer process or port for this - function, if it has one. If the function is not + <p>Returns the meta-trace tracer process, port or trace module + for this function, if it has one. If the function is not meta-traced, the returned value is <c>false</c>. If the function is meta-traced but has once detected that the tracer process is invalid, the returned value is [].</p> @@ -8874,7 +9116,7 @@ timestamp() -> <c>Value</c> is the requested information as described earlier. If a pid for a dead process was given, or the name of a non-existing function, <c>Value</c> is <c>undefined</c>.</p> - <p>If <c><anno>PidOrFunc</anno></c> is <c>on_load</c>, the information + <p>If <c><anno>PidPortOrFunc</anno></c> is <c>on_load</c>, the information returned refers to the default value for code that will be loaded.</p> </desc> @@ -8999,13 +9241,12 @@ timestamp() -> the process, a <c>return_to</c> message is also sent when this function returns to its caller.</p> </item> - <tag><c>meta | {meta, <anno>Pid</anno>}</c></tag> + <tag><c>meta | {meta, <anno>Pid</anno>} | {meta, <anno>TracerModule</anno>, <anno>TracerState</anno>}</c> + </tag> <item> <p>Turns on or off meta-tracing for all types of function - calls. Trace messages are sent to the tracer process - or port <c><anno>Pid</anno></c> whenever any of the specified - functions are called, regardless of how they are called. - If no <c><anno>Pid</anno></c> is specified, + calls. Trace messages are sent to the tracer whenever any of + the specified functions are called. If no tracer is specified, <c>self()</c> is used as a default tracer process.</p> <p>Meta-tracing traces all processes and does not care about the process trace flags set by <c>trace/3</c>, @@ -9013,7 +9254,7 @@ timestamp() -> <c>[call, timestamp]</c>.</p> <p>The match specification function <c>{return_trace}</c> works with meta-trace and sends its trace message to the - same tracer process.</p> + same tracer.</p> </item> <tag><c>call_count</c></tag> <item> diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml index 05be35e0af..70775b9f0f 100644 --- a/erts/doc/src/erts_alloc.xml +++ b/erts/doc/src/erts_alloc.xml @@ -63,6 +63,9 @@ <tag><c>fix_alloc</c></tag> <item>A fast allocator used for some frequently used fixed size data types.</item> + <tag><c>exec_alloc</c></tag> + <item>Allocator used by hipe for native executable code + on specific architectures (x86_64).</item> <tag><c>std_alloc</c></tag> <item>Allocator used for most memory blocks not allocated via any of the other allocators described above.</item> @@ -80,7 +83,8 @@ the number of system calls made.</item> </taglist> <p><c>sys_alloc</c> and <c>literal_alloc</c> are always enabled and - cannot be disabled. <c>mseg_alloc</c> is always enabled if it is + cannot be disabled. <c>exec_alloc</c> is only available if it is needed + and cannot be disabled. <c>mseg_alloc</c> is always enabled if it is available and an allocator that uses it is enabled. All other allocators can be <seealso marker="#M_e">enabled or disabled</seealso>. By default all allocators are enabled. @@ -248,16 +252,17 @@ the currently present allocators:</p> <list type="bulleted"> <item><c>B: binary_alloc</c></item> - <item><c>I: literal_alloc</c></item> <item><c>D: std_alloc</c></item> <item><c>E: ets_alloc</c></item> <item><c>F: fix_alloc</c></item> <item><c>H: eheap_alloc</c></item> + <item><c>I: literal_alloc</c></item> <item><c>L: ll_alloc</c></item> <item><c>M: mseg_alloc</c></item> <item><c>R: driver_alloc</c></item> <item><c>S: sl_alloc</c></item> <item><c>T: temp_alloc</c></item> + <item><c>X: exec_alloc</c></item> <item><c>Y: sys_alloc</c></item> </list> <p>The following flags are available for configuration of @@ -576,6 +581,15 @@ and is usually sufficient. The flag is ignored on 32-bit architectures.</item> </taglist> + <p>The following flag is special for <c>exec_alloc</c>:</p> + <taglist> + <tag><marker id="MIscs"/><c><![CDATA[+MXscs <size in MB>]]></c></tag> + <item> + <c>exec_alloc</c> super carrier size (in MB). The amount of + <em>virtual</em> address space reserved for native executable code + used by hipe on specific architectures (x86_64). The default is 512 MB. + </item> + </taglist> <p>Instrumentation flags:</p> <taglist> <tag><marker id="Mim"/><c>+Mim true|false</c></tag> diff --git a/erts/doc/src/match_spec.xml b/erts/doc/src/match_spec.xml index 975f01cf2c..3944f24f84 100644 --- a/erts/doc/src/match_spec.xml +++ b/erts/doc/src/match_spec.xml @@ -287,7 +287,7 @@ can <em>not</em> be one of the atoms <c><![CDATA[all]]></c>, <c><![CDATA[new]]></c> or <c><![CDATA[existing]]></c> (unless, of course, they are registered names). <c><![CDATA[P2]]></c> can <em>not</em> be <c><![CDATA[cpu_timestamp]]></c> nor - <c><![CDATA[{tracer,_}]]></c>. + <c><![CDATA[tracer]]></c>. Returns <c><![CDATA[true]]></c> and may only be used in the <c><![CDATA[MatchBody]]></c> part when tracing. </p> @@ -298,7 +298,7 @@ be either a process identifier or a registered name and is given as the first argument to the match_spec function. <c><![CDATA[P2]]></c> can <em>not</em> be <c><![CDATA[cpu_timestamp]]></c> nor - <c><![CDATA[{tracer,_}]]></c>. Returns + <c><![CDATA[tracer]]></c>. Returns <c><![CDATA[true]]></c> and may only be used in the <c><![CDATA[MatchBody]]></c> part when tracing. </p> @@ -308,11 +308,14 @@ disable list is applied first, but effectively all changes are applied atomically. The trace flags are the same as for <c><![CDATA[erlang:trace/3]]></c> not including - <c><![CDATA[cpu_timestamp]]></c> but including <c><![CDATA[{tracer,_}]]></c>. If a + <c><![CDATA[cpu_timestamp]]></c> but including <c><![CDATA[tracer]]></c>. If a tracer is specified in both lists, the tracer in the enable list takes precedence. If no tracer is specified the same tracer as the process executing the match spec is - used. With three parameters to this function the first is + used. When using a <seealso marker="erl_tracer">tracer module</seealso> + the module has to be loaded before the match specification is executed. + If it is not loaded the match will fail. + With three parameters to this function the first is either a process identifier or the registered name of a process to set trace flags on, the second is the disable list, and the third is the enable list. Returns @@ -525,7 +528,7 @@ </section> <section> - <title>Examples</title> + <title>ETS Examples</title> <p>Match an argument list of three where the first and third arguments are equal:</p> <code type="none"><![CDATA[ @@ -616,5 +619,44 @@ <p>The function <c><![CDATA[ets:test_ms/2]]></c> can be useful for testing complicated ets matches.</p> </section> + <section> + <title>Tracing Examples</title> + <p>Only generate trace message if trace control word is set to 1:</p> + <code type="none"><![CDATA[ +[{'_', + [{'==',{get_tcw},{const, 1}}], + []}] + ]]></code> + <p>Only generate trace message if there is a seq trace token:</p> + <code type="none"><![CDATA[ +[{'_', + [{'==',{is_seq_trace},{const, 1}}], + []}] + ]]></code> + <p>Remove 'silent' trace flag when first argument is 'verbose' + and add it when it is 'silent':</p> + <code type="none"><![CDATA[ +[{'$1', + [{'==',{hd, '$1'},verbose}], + [{trace, [silent],[]}]}, + {'$1', + [{'==',{hd, '$1'},silent}], + [{trace, [],[silent]}]}] + ]]></code> + <p>Add return_trace message if function is of arity 3:</p> + <code type="none"><![CDATA[ +[{'$1', + [{'==',{length, '$1'},3}], + [{return_trace}]}, + {'_',[],[]}] + ]]></code> + <p>Only generate trace message if function is of arity 3 and first argument is 'trace':</p> + <code type="none"><![CDATA[ +[{['trace','$2','$3'], + [], + []}, + {'_',[],[]}] + ]]></code> + </section> </chapter> diff --git a/erts/doc/src/ref_man.xml b/erts/doc/src/ref_man.xml index aa245ec08a..e45402a397 100644 --- a/erts/doc/src/ref_man.xml +++ b/erts/doc/src/ref_man.xml @@ -56,5 +56,6 @@ <xi:include href="driver_entry.xml"/> <xi:include href="erts_alloc.xml"/> <xi:include href="erl_nif.xml"/> + <xi:include href="erl_tracer.xml"/> </application> diff --git a/erts/doc/src/specs.xml b/erts/doc/src/specs.xml index 41a3984659..ed6be650e5 100644 --- a/erts/doc/src/specs.xml +++ b/erts/doc/src/specs.xml @@ -2,6 +2,7 @@ <specs xmlns:xi="http://www.w3.org/2001/XInclude"> <xi:include href="../specs/specs_erl_prim_loader.xml"/> <xi:include href="../specs/specs_erlang.xml"/> + <xi:include href="../specs/specs_erl_tracer.xml"/> <xi:include href="../specs/specs_init.xml"/> <xi:include href="../specs/specs_zlib.xml"/> </specs> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 26a737619e..fb486c917f 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -577,7 +577,7 @@ GENERATE += $(TARGET)/erl_version.h # driver table $(TTF_DIR)/driver_tab.c: Makefile.in utils/make_driver_tab - $(gen_verbose)LANG=C $(PERL) utils/make_driver_tab -o $@ -nifs $(STATIC_NIF_LIBS) -drivers $(DRV_OBJS) $(STATIC_DRIVER_LIBS) + $(gen_verbose)LANG=C $(PERL) utils/make_driver_tab -o $@ -nifs $(NIF_OBJS) $(STATIC_NIF_LIBS) -drivers $(DRV_OBJS) $(STATIC_DRIVER_LIBS) GENERATE += $(TTF_DIR)/driver_tab.c @@ -600,8 +600,8 @@ $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_zip.beam \ $(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \ $(ERL_TOP)/erts/preloaded/ebin/erlang.beam \ - $(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam - + $(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam \ + $(ERL_TOP)/erts/preloaded/ebin/erl_tracer.beam $(gen_verbose)LANG=C $(PERL) utils/make_preload $(MAKE_PRELOAD_EXTRA) -rc $^ > $@ else PRELOAD_OBJ = $(OBJDIR)/preload.o @@ -616,7 +616,8 @@ $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_zip.beam \ $(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \ $(ERL_TOP)/erts/preloaded/ebin/erlang.beam \ - $(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam + $(ERL_TOP)/erts/preloaded/ebin/erts_internal.beam \ + $(ERL_TOP)/erts/preloaded/ebin/erl_tracer.beam $(gen_verbose)LANG=C $(PERL) utils/make_preload -old $^ > $@ endif @@ -690,6 +691,9 @@ $(OBJDIR)/%.o: drivers/common/%.c $(OBJDIR)/%.o: drivers/$(ERLANG_OSTYPE)/%.c $(V_CC) $(CFLAGS) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) -I../etc/$(ERLANG_OSTYPE) -c $< -o $@ +$(OBJDIR)/%.o: nifs/common/%.c + $(V_CC) $(CFLAGS) -DLIBSCTP=$(LIBSCTP) $(INCLUDES) -Inifs/common -Inifs/$(ERLANG_OSTYPE) -c $< -o $@ + # ---------------------------------------------------------------------- # Specials # @@ -780,6 +784,7 @@ RUN_OBJS = \ $(OBJDIR)/erl_msacc.o LTTNG_OBJS = $(OBJDIR)/erlang_lttng.o +NIF_OBJS = $(OBJDIR)/erl_tracer_nif.o ifeq ($(TARGET),win32) DRV_OBJS = \ @@ -889,7 +894,7 @@ endif BASE_OBJS = $(EMU_OBJS) $(RUN_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) $(LTTNG_OBJS) -before_DTrace_OBJS = $(BASE_OBJS) $(DRV_OBJS) +before_DTrace_OBJS = $(BASE_OBJS) $(DRV_OBJS) $(NIF_OBJS) DTRACE_OBJS = ifdef DTRACE_ENABLED_2STEP @@ -1042,6 +1047,7 @@ endif BEAM_SRC=$(wildcard beam/*.c) DRV_COMMON_SRC=$(wildcard drivers/common/*.c) DRV_OSTYPE_SRC=$(wildcard drivers/$(ERLANG_OSTYPE)/*.c) +NIF_COMMON_SRC=$(wildcard nifs/common/*.c) ALL_SYS_SRC=$(wildcard sys/$(ERLANG_OSTYPE)/*.c) $(wildcard sys/common/*.c) # We use $(shell ls) here instead of wildcard as $(wildcard ) resolved at # loadtime of the makefile and at that time these files are not generated yet. @@ -1074,7 +1080,7 @@ MG_FLAG=-MG endif DEP_CC=$(CC) -DEP_FLAGS=-MM $(MG_FLAG) $(CFLAGS) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) +DEP_FLAGS=-MM $(MG_FLAG) $(CFLAGS) $(INCLUDES) -Inifs/common -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) SYS_SRC=$(ALL_SYS_SRC) endif @@ -1099,6 +1105,8 @@ $(TTF_DIR)/depend.mk: $(TTF_DIR)/GENERATED $(PRELOAD_SRC) | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk $(V_at)$(DEP_CC) $(DEP_FLAGS) -I../etc/$(ERLANG_OSTYPE) $(DRV_OSTYPE_SRC) \ | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk + $(V_at)$(DEP_CC) $(DEP_FLAGS) $(NIF_COMMON_SRC) \ + | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk $(V_at)$(DEP_CC) $(DEP_FLAGS) $(SYS_SRC) \ | $(SED_DEPEND) >> $(TTF_DIR)/depend.mk $(V_at)$(DEP_CC) $(DEP_FLAGS) $(TARGET_SRC) \ diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index d466f00028..3022c0a99a 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -161,6 +161,7 @@ atom close atom closed atom code atom command +atom commandv atom compact atom compat_rel atom compile @@ -197,6 +198,7 @@ atom dirty_cpu_schedulers_online atom dirty_io atom disable_trace atom disabled +atom discard atom display_items atom dist atom dist_cmd @@ -231,6 +233,7 @@ atom exception_trace atom extended atom Eq='=:=' atom Eqeq='==' +atom erl_tracer atom erlang atom ERROR='ERROR' atom error_handler @@ -243,6 +246,9 @@ atom exact_reductions atom exclusive atom exit_status atom existing +atom existing_processes +atom existing_ports +atom existing atom exiting atom exports atom external @@ -267,6 +273,10 @@ atom garbage_collecting atom garbage_collection atom garbage_collection_info atom gc_end +atom gc_major_end +atom gc_major_start +atom gc_minor_end +atom gc_minor_start atom gc_start atom Ge='>=' atom generational @@ -353,6 +363,7 @@ atom match atom match_limit atom match_limit_recursion atom match_spec +atom match_spec_result atom max atom maximum atom max_tables max_processes @@ -401,6 +412,8 @@ atom net_kernel_terminated atom never_utf atom new atom new_index +atom new_processes +atom new_ports atom new_uniq atom newline atom next @@ -540,6 +553,7 @@ atom scheme atom scientific atom scope atom seconds +atom send_to_non_existing_process atom sensitive atom sequential_tracer atom sequential_trace_token @@ -561,6 +575,7 @@ atom size atom sl_alloc atom spawn_executable atom spawn_driver +atom spawned atom ssl_tls atom stack_size atom start @@ -569,6 +584,7 @@ atom static atom stderr_to_stdout atom stop atom stream +atom strict_monotonic atom strict_monotonic_timestamp atom sunrm atom suspend @@ -596,8 +612,9 @@ atom total_active_tasks atom total_heap_size atom total_run_queue_lengths atom tpkt -atom trace trace_ts traced +atom trace trace_ts traced atom trace_control_word +atom trace_status atom tracer atom trap_exit atom trim diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 320dee6668..87508dcf5f 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -719,13 +719,13 @@ set_default_trace_pattern(Eterm module) Binary *match_spec; Binary *meta_match_spec; struct trace_pattern_flags trace_pattern_flags; - Eterm meta_tracer_pid; + ErtsTracer meta_tracer; erts_get_default_trace_pattern(&trace_pattern_is_on, &match_spec, &meta_match_spec, &trace_pattern_flags, - &meta_tracer_pid); + &meta_tracer); if (trace_pattern_is_on) { Eterm mfa[1]; mfa[0] = module; @@ -733,7 +733,7 @@ set_default_trace_pattern(Eterm module) match_spec, meta_match_spec, 1, trace_pattern_flags, - meta_tracer_pid, 1); + meta_tracer, 1); } } @@ -832,7 +832,7 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp) /* * Message queue can contains funs, but (at least currently) no - * constants. If we got references to this module from the message + * literals. If we got references to this module from the message * queue, a GC cannot remove these... */ @@ -853,7 +853,7 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp) for (; hfrag; hfrag = hfrag->next) { if (check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size)) return am_true; - /* Should not contain any constants... */ + /* Should not contain any literals... */ ASSERT(!any_heap_refs(&hfrag->mem[0], &hfrag->mem[hfrag->used_size], literals, @@ -908,7 +908,7 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp) #ifdef DEBUG /* * Message buffer fragments should not have any references - * to constants, and off heap lists should already have + * to literals, and off heap lists should already have * been moved into process off heap structure. */ for (msgp = rp->msg_frag; msgp; msgp = msgp->next) { @@ -945,7 +945,7 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp) need_gc &= ~done_gc; /* - * Try to get rid of constants by by garbage collecting. + * Try to get rid of literals by by garbage collecting. * Clear both fvalue and ftrace. */ @@ -1264,6 +1264,7 @@ delete_code(Module* modp) modp->curr.code_length = 0; modp->curr.catches = BEAM_CATCHES_NIL; modp->curr.nif = NULL; + } diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 0a13454951..2ee98ed7b5 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -92,15 +92,15 @@ get_mtime(Process *c_p) /* ** Helpers */ -static Eterm do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, - int local, Binary* ms, Eterm tracer_pid); +static ErtsTracer do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, + int local, Binary* ms, ErtsTracer tracer); static void set_break(BpFunctions* f, Binary *match_spec, Uint break_flags, - enum erts_break_op count_op, Eterm tracer_pid); + enum erts_break_op count_op, ErtsTracer tracer); static void set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags, enum erts_break_op count_op, - Eterm tracer_pid); + ErtsTracer tracer); static void clear_break(BpFunctions* f, Uint break_flags); static int clear_function_break(BeamInstr *pc, Uint break_flags); @@ -108,7 +108,7 @@ static int clear_function_break(BeamInstr *pc, Uint break_flags); static BpDataTime* get_time_break(BeamInstr *pc); static GenericBpData* check_break(BeamInstr *pc, Uint break_flags); -static void bp_meta_unref(BpMetaPid* bmp); +static void bp_meta_unref(BpMetaTracer* bmt); static void bp_count_unref(BpCount* bcp); static void bp_time_unref(BpDataTime* bdt); static void consolidate_bp_data(Module* modp, BeamInstr* pc, int local); @@ -302,7 +302,7 @@ consolidate_bp_data(Module* modp, BeamInstr* pc, int local) MatchSetUnref(dst->local_ms); } if (flags & ERTS_BPF_META_TRACE) { - bp_meta_unref(dst->meta_pid); + bp_meta_unref(dst->meta_tracer); MatchSetUnref(dst->meta_ms); } if (flags & ERTS_BPF_COUNT) { @@ -343,8 +343,8 @@ consolidate_bp_data(Module* modp, BeamInstr* pc, int local) MatchSetRef(dst->local_ms); } if (flags & ERTS_BPF_META_TRACE) { - dst->meta_pid = src->meta_pid; - erts_refc_inc(&dst->meta_pid->refc, 1); + dst->meta_tracer = src->meta_tracer; + erts_refc_inc(&dst->meta_tracer->refc, 1); dst->meta_ms = src->meta_ms; MatchSetRef(dst->meta_ms); } @@ -436,13 +436,13 @@ uninstall_breakpoint(BeamInstr* pc) void erts_set_trace_break(BpFunctions* f, Binary *match_spec) { - set_break(f, match_spec, ERTS_BPF_LOCAL_TRACE, 0, am_true); + set_break(f, match_spec, ERTS_BPF_LOCAL_TRACE, 0, erts_tracer_true); } void -erts_set_mtrace_break(BpFunctions* f, Binary *match_spec, Eterm tracer_pid) +erts_set_mtrace_break(BpFunctions* f, Binary *match_spec, ErtsTracer tracer) { - set_break(f, match_spec, ERTS_BPF_META_TRACE, 0, tracer_pid); + set_break(f, match_spec, ERTS_BPF_META_TRACE, 0, tracer); } void @@ -450,13 +450,13 @@ erts_set_call_trace_bif(BeamInstr *pc, Binary *match_spec, int local) { Uint flags = local ? ERTS_BPF_LOCAL_TRACE : ERTS_BPF_GLOBAL_TRACE; - set_function_break(pc, match_spec, flags, 0, NIL); + set_function_break(pc, match_spec, flags, 0, erts_tracer_nil); } void -erts_set_mtrace_bif(BeamInstr *pc, Binary *match_spec, Eterm tracer_pid) +erts_set_mtrace_bif(BeamInstr *pc, Binary *match_spec, ErtsTracer tracer) { - set_function_break(pc, match_spec, ERTS_BPF_META_TRACE, 0, tracer_pid); + set_function_break(pc, match_spec, ERTS_BPF_META_TRACE, 0, tracer); } void @@ -464,7 +464,7 @@ erts_set_time_trace_bif(BeamInstr *pc, enum erts_break_op count_op) { set_function_break(pc, NULL, ERTS_BPF_TIME_TRACE|ERTS_BPF_TIME_TRACE_ACTIVE, - count_op, NIL); + count_op, erts_tracer_nil); } void @@ -474,21 +474,21 @@ erts_clear_time_trace_bif(BeamInstr *pc) { void erts_set_debug_break(BpFunctions* f) { - set_break(f, NULL, ERTS_BPF_DEBUG, 0, NIL); + set_break(f, NULL, ERTS_BPF_DEBUG, 0, erts_tracer_nil); } void erts_set_count_break(BpFunctions* f, enum erts_break_op count_op) { set_break(f, 0, ERTS_BPF_COUNT|ERTS_BPF_COUNT_ACTIVE, - count_op, NIL); + count_op, erts_tracer_nil); } void erts_set_time_break(BpFunctions* f, enum erts_break_op count_op) { set_break(f, 0, ERTS_BPF_TIME_TRACE|ERTS_BPF_TIME_TRACE_ACTIVE, - count_op, NIL); + count_op, erts_tracer_nil); } void @@ -625,19 +625,26 @@ erts_generic_breakpoint(Process* c_p, BeamInstr* I, Eterm* reg) if (bp_flags & ERTS_BPF_LOCAL_TRACE) { ASSERT((bp_flags & ERTS_BPF_GLOBAL_TRACE) == 0); - (void) do_call_trace(c_p, I, reg, 1, bp->local_ms, am_true); + (void) do_call_trace(c_p, I, reg, 1, bp->local_ms, erts_tracer_true); } else if (bp_flags & ERTS_BPF_GLOBAL_TRACE) { - (void) do_call_trace(c_p, I, reg, 0, bp->local_ms, am_true); + (void) do_call_trace(c_p, I, reg, 0, bp->local_ms, erts_tracer_true); } if (bp_flags & ERTS_BPF_META_TRACE) { - Eterm old_pid; - Eterm new_pid; - - old_pid = (Eterm) erts_smp_atomic_read_nob(&bp->meta_pid->pid); - new_pid = do_call_trace(c_p, I, reg, 1, bp->meta_ms, old_pid); - if (new_pid != old_pid) { - erts_smp_atomic_set_nob(&bp->meta_pid->pid, new_pid); + ErtsTracer old_tracer, new_tracer; + + old_tracer = erts_smp_atomic_read_nob(&bp->meta_tracer->tracer); + + new_tracer = do_call_trace(c_p, I, reg, 1, bp->meta_ms, old_tracer); + if (!ERTS_TRACER_COMPARE(new_tracer, old_tracer)) { + if (old_tracer == erts_smp_atomic_cmpxchg_acqb( + &bp->meta_tracer->tracer, + (erts_aint_t)new_tracer, + (erts_aint_t)old_tracer)) { + ERTS_TRACER_CLEAR(&old_tracer); + } else { + ERTS_TRACER_CLEAR(&new_tracer); + } } } @@ -645,7 +652,8 @@ erts_generic_breakpoint(Process* c_p, BeamInstr* I, Eterm* reg) erts_smp_atomic_inc_nob(&bp->count->acount); } - if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE && erts_is_tracer_proc_valid(c_p)) { + if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE + && ERTS_TRACER_PROC_IS_ENABLED(c_p)) { Eterm w; erts_trace_time_call(c_p, I, bp->time); w = (BeamInstr) *c_p->cp; @@ -690,7 +698,7 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) Eterm (*func)(Process*, Eterm*, BeamInstr*); Export* ep = bif_export[bif_index]; Uint32 flags = 0, flags_meta = 0; - Eterm meta_tracer_pid = NIL; + ErtsTracer meta_tracer = erts_tracer_nil; int applying = (I == &(ep->code[3])); /* Yup, the apply code for a bif * is actually in the * export entry */ @@ -718,23 +726,32 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) IS_TRACED_FL(p, F_TRACE_CALLS)) { int local = !!(bp_flags & ERTS_BPF_LOCAL_TRACE); flags = erts_call_trace(p, ep->code, bp->local_ms, args, - local, &ERTS_TRACER_PROC(p)); + local, &ERTS_TRACER(p)); } if (bp_flags & ERTS_BPF_META_TRACE) { - Eterm tpid1, tpid2; + ErtsTracer old_tracer; - tpid1 = tpid2 = - (Eterm) erts_smp_atomic_read_nob(&bp->meta_pid->pid); + meta_tracer = erts_smp_atomic_read_nob(&bp->meta_tracer->tracer); + old_tracer = meta_tracer; flags_meta = erts_call_trace(p, ep->code, bp->meta_ms, args, - 0, &tpid2); - meta_tracer_pid = tpid2; - if (tpid1 != tpid2) { - erts_smp_atomic_set_nob(&bp->meta_pid->pid, tpid2); + 0, &meta_tracer); + + if (!ERTS_TRACER_COMPARE(old_tracer, meta_tracer)) { + ErtsTracer new_tracer = erts_tracer_nil; + erts_tracer_update(&new_tracer, meta_tracer); + if (old_tracer == erts_smp_atomic_cmpxchg_acqb( + &bp->meta_tracer->tracer, + (erts_aint_t)new_tracer, + (erts_aint_t)old_tracer)) { + ERTS_TRACER_CLEAR(&old_tracer); + } else { + ERTS_TRACER_CLEAR(&new_tracer); + } } } if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE && IS_TRACED_FL(p, F_TRACE_CALLS) && - erts_is_tracer_proc_valid(p)) { + ERTS_TRACER_PROC_IS_ENABLED(p)) { BeamInstr *pc = (BeamInstr *)ep->code+3; erts_trace_time_call(p, pc, bp->time); } @@ -778,8 +795,6 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) if (reason != TRAP) { Eterm class; Eterm value = p->fvalue; - DeclareTmpHeapNoproc(nocatch,3); - UseTmpHeapNoproc(3); /* Expand error value like in handle_error() */ if (reason & EXF_ARGLIST) { Eterm *tp; @@ -788,7 +803,8 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) value = tp[1]; } if ((reason & EXF_THROWN) && (p->catches <= 0)) { - value = TUPLE2(nocatch, am_nocatch, value); + Eterm *hp = HAlloc(p, 3); + value = TUPLE2(hp, am_nocatch, value); reason = EXC_ERROR; } /* Note: expand_error_value() could theoretically @@ -801,11 +817,11 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) if (flags_meta & MATCH_SET_EXCEPTION_TRACE) { erts_trace_exception(p, ep->code, class, value, - &meta_tracer_pid); + &meta_tracer); } if (flags & MATCH_SET_EXCEPTION_TRACE) { erts_trace_exception(p, ep->code, class, value, - &ERTS_TRACER_PROC(p)); + &ERTS_TRACER(p)); } if ((flags & MATCH_SET_RETURN_TO_TRACE) && p->catches > 0) { /* can only happen if(local)*/ @@ -827,7 +843,6 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) } } } - UnUseTmpHeapNoproc(3); if ((flags_meta|flags) & MATCH_SET_EXCEPTION_TRACE) { erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); ERTS_TRACE_FLAGS(p) |= F_EXCEPTION_TRACE; @@ -836,11 +851,11 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) } } else { if (flags_meta & MATCH_SET_RX_TRACE) { - erts_trace_return(p, ep->code, result, &meta_tracer_pid); + erts_trace_return(p, ep->code, result, &meta_tracer); } /* MATCH_SET_RETURN_TO_TRACE cannot occur if(meta) */ if (flags & MATCH_SET_RX_TRACE) { - erts_trace_return(p, ep->code, result, &ERTS_TRACER_PROC(p)); + erts_trace_return(p, ep->code, result, &ERTS_TRACER(p)); } if (flags & MATCH_SET_RETURN_TO_TRACE) { /* can only happen if(local)*/ @@ -857,9 +872,9 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) return result; } -static Eterm +static ErtsTracer do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, - int local, Binary* ms, Eterm tracer_pid) + int local, Binary* ms, ErtsTracer tracer) { Eterm* cpp; int return_to_trace = 0; @@ -899,7 +914,7 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, ASSERT(is_CP(*cpp)); } ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); - flags = erts_call_trace(c_p, I-3, ms, reg, local, &tracer_pid); + flags = erts_call_trace(c_p, I-3, ms, reg, local, &tracer); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); if (cpp) { c_p->cp = cp_save; @@ -910,7 +925,7 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, need += 1; } if (flags & MATCH_SET_RX_TRACE) { - need += 3; + need += 3 + size_object(tracer); } if (need) { ASSERT(c_p->htop <= E && E <= c_p->hend); @@ -926,14 +941,15 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, E[0] = make_cp(c_p->cp); c_p->cp = beam_return_to_trace; } - if (flags & MATCH_SET_RX_TRACE) { + if (flags & MATCH_SET_RX_TRACE) + { E -= 3; + c_p->stop = E; ASSERT(c_p->htop <= E && E <= c_p->hend); ASSERT(is_CP((Eterm) (UWord) (I - 3))); - ASSERT(am_true == tracer_pid || - is_internal_pid(tracer_pid) || is_internal_port(tracer_pid)); + ASSERT(IS_TRACER_VALID(tracer)); E[2] = make_cp(c_p->cp); - E[1] = tracer_pid; + E[1] = copy_object(tracer, c_p); E[0] = make_cp(I - 3); /* We ARE at the beginning of an instruction, the funcinfo is above i. */ @@ -942,9 +958,9 @@ do_call_trace(Process* c_p, BeamInstr* I, Eterm* reg, erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); ERTS_TRACE_FLAGS(c_p) |= F_EXCEPTION_TRACE; erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); - } - c_p->stop = E; - return tracer_pid; + } else + c_p->stop = E; + return tracer; } void @@ -1098,9 +1114,9 @@ erts_is_trace_break(BeamInstr *pc, Binary **match_spec_ret, int local) return 0; } -int +int erts_is_mtrace_break(BeamInstr *pc, Binary **match_spec_ret, - Eterm *tracer_pid_ret) + ErtsTracer *tracer_ret) { GenericBpData* bp = check_break(pc, ERTS_BPF_META_TRACE); @@ -1108,9 +1124,8 @@ erts_is_mtrace_break(BeamInstr *pc, Binary **match_spec_ret, if (match_spec_ret) { *match_spec_ret = bp->meta_ms; } - if (tracer_pid_ret) { - *tracer_pid_ret = - (Eterm) erts_smp_atomic_read_nob(&bp->meta_pid->pid); + if (tracer_ret) { + *tracer_ret = erts_smp_atomic_read_nob(&bp->meta_tracer->tracer); } return 1; } @@ -1391,7 +1406,7 @@ void erts_schedule_time_break(Process *p, Uint schedule) { static void set_break(BpFunctions* f, Binary *match_spec, Uint break_flags, - enum erts_break_op count_op, Eterm tracer_pid) + enum erts_break_op count_op, ErtsTracer tracer) { Uint i; Uint n; @@ -1400,13 +1415,13 @@ set_break(BpFunctions* f, Binary *match_spec, Uint break_flags, for (i = 0; i < n; i++) { BeamInstr* pc = f->matching[i].pc; set_function_break(pc, match_spec, break_flags, - count_op, tracer_pid); + count_op, tracer); } } static void set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags, - enum erts_break_op count_op, Eterm tracer_pid) + enum erts_break_op count_op, ErtsTracer tracer) { GenericBp* g; GenericBpData* bp; @@ -1439,7 +1454,7 @@ set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags, MatchSetUnref(bp->local_ms); } else if (common & ERTS_BPF_META_TRACE) { MatchSetUnref(bp->meta_ms); - bp_meta_unref(bp->meta_pid); + bp_meta_unref(bp->meta_tracer); } else if (common & ERTS_BPF_COUNT) { if (count_op == erts_break_stop) { bp->flags &= ~ERTS_BPF_COUNT_ACTIVE; @@ -1474,13 +1489,15 @@ set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags, MatchSetRef(match_spec); bp->local_ms = match_spec; } else if (break_flags & ERTS_BPF_META_TRACE) { - BpMetaPid* bmp; + BpMetaTracer* bmt; + ErtsTracer meta_tracer = erts_tracer_nil; MatchSetRef(match_spec); bp->meta_ms = match_spec; - bmp = Alloc(sizeof(BpMetaPid)); - erts_refc_init(&bmp->refc, 1); - erts_smp_atomic_init_nob(&bmp->pid, tracer_pid); - bp->meta_pid = bmp; + bmt = Alloc(sizeof(BpMetaTracer)); + erts_refc_init(&bmt->refc, 1); + erts_tracer_update(&meta_tracer, tracer); /* copy tracer */ + erts_smp_atomic_init_nob(&bmt->tracer, (erts_aint_t)meta_tracer); + bp->meta_tracer = bmt; } else if (break_flags & ERTS_BPF_COUNT) { BpCount* bcp; @@ -1544,7 +1561,7 @@ clear_function_break(BeamInstr *pc, Uint break_flags) } if (common & ERTS_BPF_META_TRACE) { MatchSetUnref(bp->meta_ms); - bp_meta_unref(bp->meta_pid); + bp_meta_unref(bp->meta_tracer); } if (common & ERTS_BPF_COUNT) { ASSERT((bp->flags & ERTS_BPF_COUNT_ACTIVE) == 0); @@ -1560,10 +1577,12 @@ clear_function_break(BeamInstr *pc, Uint break_flags) } static void -bp_meta_unref(BpMetaPid* bmp) +bp_meta_unref(BpMetaTracer* bmt) { - if (erts_refc_dectest(&bmp->refc, 0) <= 0) { - Free(bmp); + if (erts_refc_dectest(&bmt->refc, 0) <= 0) { + ErtsTracer trc = erts_smp_atomic_read_nob(&bmt->tracer); + ERTS_TRACER_CLEAR(&trc); + Free(bmt); } } diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h index f9eca94e2a..bb171be8a6 100644 --- a/erts/emulator/beam/beam_bp.h +++ b/erts/emulator/beam/beam_bp.h @@ -55,15 +55,15 @@ typedef struct { } BpCount; typedef struct { - erts_smp_atomic_t pid; + erts_smp_atomic_t tracer; erts_refc_t refc; -} BpMetaPid; +} BpMetaTracer; typedef struct generic_bp_data { Uint flags; Binary* local_ms; /* Match spec for local call trace */ Binary* meta_ms; /* Match spec for meta trace */ - BpMetaPid* meta_pid; /* Meta trace pid */ + BpMetaTracer* meta_tracer; /* Meta tracer */ BpCount* count; /* For call count */ BpDataTime* time; /* For time trace */ } GenericBpData; @@ -132,10 +132,10 @@ void erts_set_call_trace_bif(BeamInstr *pc, Binary *match_spec, int local); void erts_clear_call_trace_bif(BeamInstr *pc, int local); void erts_set_mtrace_break(BpFunctions *f, Binary *match_spec, - Eterm tracer_pid); + ErtsTracer tracer); void erts_clear_mtrace_break(BpFunctions *f); void erts_set_mtrace_bif(BeamInstr *pc, Binary *match_spec, - Eterm tracer_pid); + ErtsTracer tracer); void erts_clear_mtrace_bif(BeamInstr *pc); void erts_set_debug_break(BpFunctions *f); @@ -150,13 +150,13 @@ void erts_clear_export_break(Module *modp, BeamInstr* pc); BeamInstr erts_generic_breakpoint(Process* c_p, BeamInstr* I, Eterm* reg); BeamInstr erts_trace_break(Process *p, BeamInstr *pc, Eterm *args, - Uint32 *ret_flags, Eterm *tracer_pid); + Uint32 *ret_flags, ErtsTracer *tracer); int erts_is_trace_break(BeamInstr *pc, Binary **match_spec_ret, int local); int erts_is_mtrace_break(BeamInstr *pc, Binary **match_spec_ret, - Eterm *tracer_pid_rte); + ErtsTracer *tracer_ret); int erts_is_mtrace_bif(BeamInstr *pc, Binary **match_spec_ret, - Eterm *tracer_pid_ret); + ErtsTracer *tracer_ret); int erts_is_native_break(BeamInstr *pc); int erts_is_count_break(BeamInstr *pc, Uint *count_ret); int erts_is_time_break(Process *p, BeamInstr *pc, Eterm *call_time); diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 61149721fe..a4ad3e7886 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -431,7 +431,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) packed >>= 10; break; case '0': /* Tight shift */ - *ap++ = packed & (BEAM_TIGHT_MASK / sizeof(Eterm)); + *ap++ = packed & BEAM_TIGHT_MASK; packed >>= BEAM_TIGHT_SHIFT; break; case '6': /* Shift 16 steps */ diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 901419c989..72526bca5e 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -702,6 +702,17 @@ void** beam_ops; dst[1] = E2; \ } while (0) +#define GetTupleElement2Y(Src, Element, D1, D2) \ + do { \ + Eterm* src; \ + Eterm E1, E2; \ + src = ADD_BYTE_OFFSET(tuple_val(Src), (Element)); \ + E1 = src[0]; \ + E2 = src[1]; \ + D1 = E1; \ + D2 = E2; \ + } while (0) + #define GetTupleElement3(Src, Element, Dest) \ do { \ Eterm* src; \ @@ -3346,7 +3357,7 @@ do { \ OpCase(normal_exit): { SWAPOUT; c_p->freason = EXC_NORMAL; - c_p->arity = 0; /* In case this process will ever be garbed again. */ + c_p->arity = 0; /* In case this process will never be garbed again. */ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); erts_do_exit_process(c_p, am_normal); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); @@ -3460,7 +3471,7 @@ do { \ typedef Eterm NifF(struct enif_environment_t*, int argc, Eterm argv[]); NifF* fp = vbf = (NifF*) I[1]; struct enif_environment_t env; - erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2]); + erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2], NULL); live_hf_end = c_p->mbuf; nif_bif_result = (*fp)(&env, bif_nif_arity, reg); if (env.exception_thrown) @@ -4588,7 +4599,7 @@ do { \ SWAPOUT; /* Needed for shared heap */ ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); - erts_trace_return(c_p, code, r(0), E+1/*Process tracer*/); + erts_trace_return(c_p, code, r(0), ERTS_TRACER_FROM_ETERM(E+1)/* tracer */); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); SWAPIN; c_p->cp = NULL; @@ -5228,7 +5239,8 @@ next_catch(Process* c_p, Eterm *reg) { BeamInstr *cpp = c_p->cp; if (cpp == beam_exception_trace) { erts_trace_exception(c_p, cp_val(ptr[0]), - reg[1], reg[2], ptr+1); + reg[1], reg[2], + ERTS_TRACER_FROM_ETERM(ptr+1)); /* Skip return_trace parameters */ ptr += 2; } else if (cpp == beam_return_trace) { @@ -5255,7 +5267,8 @@ next_catch(Process* c_p, Eterm *reg) { } if (cp_val(*prev) == beam_exception_trace) { erts_trace_exception(c_p, cp_val(ptr[0]), - reg[1], reg[2], ptr+1); + reg[1], reg[2], + ERTS_TRACER_FROM_ETERM(ptr+1)); } /* Skip return_trace parameters */ ptr += 2; @@ -6049,7 +6062,7 @@ erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* re return -1; } #else /* ERTS_SMP */ - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); if (!c_p->msg.len) #endif erts_smp_atomic32_read_band_relb(&c_p->state, ~ERTS_PSFLG_ACTIVE); diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 754e11f047..ed5b2983dd 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -123,15 +123,12 @@ static int insert_internal_link(Process* p, Eterm rpid) erts_add_link(&ERTS_P_LINKS(p), LINK_PID, rp->common.id); erts_add_link(&ERTS_P_LINKS(rp), LINK_PID, p->common.id); - ASSERT(is_nil(ERTS_TRACER_PROC(p)) - || is_internal_pid(ERTS_TRACER_PROC(p)) - || is_internal_port(ERTS_TRACER_PROC(p))); + ASSERT(IS_TRACER_VALID(ERTS_TRACER(p))); if (IS_TRACED(p)) { if (ERTS_TRACE_FLAGS(p) & (F_TRACE_SOL|F_TRACE_SOL1)) { ERTS_TRACE_FLAGS(rp) |= (ERTS_TRACE_FLAGS(p) & TRACEE_FLAGS); - ERTS_TRACER_PROC(rp) = ERTS_TRACER_PROC(p); /* maybe steal */ - + erts_tracer_replace(&rp->common, ERTS_TRACER(p)); if (ERTS_TRACE_FLAGS(p) & F_TRACE_SOL1) { /* maybe override */ ERTS_TRACE_FLAGS(rp) &= ~(F_TRACE_SOL1 | F_TRACE_SOL); ERTS_TRACE_FLAGS(p) &= ~(F_TRACE_SOL1 | F_TRACE_SOL); @@ -140,7 +137,8 @@ static int insert_internal_link(Process* p, Eterm rpid) } } if (IS_TRACED_FL(rp, F_TRACE_PROCS)) - trace_proc(p, rp, am_getting_linked, p->common.id); + trace_proc(p, p == rp ? rp_locks : ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK, + rp, am_getting_linked, p->common.id); if (p == rp) erts_smp_proc_unlock(p, rp_locks & ~ERTS_PROC_LOCK_MAIN); @@ -159,7 +157,7 @@ BIF_RETTYPE link_1(BIF_ALIST_1) DistEntry *dep; if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) { - trace_proc(BIF_P, BIF_P, am_link, BIF_ARG_1); + trace_proc(BIF_P, ERTS_PROC_LOCK_MAIN, BIF_P, am_link, BIF_ARG_1); } /* check that the pid or port which is our argument is OK */ @@ -613,7 +611,7 @@ erts_queue_monitor_message(Process *p, ref_copy = copy_struct(ref, ref_size, &hp, ohp); tup = TUPLE5(hp, am_DOWN, ref_copy, type, item_copy, reason_copy); - erts_queue_message(p, p_locksp, msgp, tup, NIL); + erts_queue_message(p, p_locksp, msgp, tup); } static BIF_RETTYPE @@ -1001,6 +999,7 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) Process *rp; DistEntry *dep; ErtsLink *l = NULL, *rl = NULL; + ErtsProcLocks cp_locks = ERTS_PROC_LOCK_MAIN; /* * SMP specific note concerning incoming exit signals: @@ -1015,7 +1014,7 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) */ if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) { - trace_proc(BIF_P, BIF_P, am_unlink, BIF_ARG_1); + trace_proc(BIF_P, cp_locks, BIF_P, am_unlink, BIF_ARG_1); } if (is_internal_port(BIF_ARG_1)) { @@ -1120,10 +1119,10 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); + cp_locks |= ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS; + /* get process struct */ - rp = erts_pid2proc_opt(BIF_P, (ERTS_PROC_LOCK_MAIN - | ERTS_PROC_LOCK_LINK - | ERTS_PROC_LOCK_STATUS), + rp = erts_pid2proc_opt(BIF_P, cp_locks, BIF_ARG_1, ERTS_PROC_LOCK_LINK, ERTS_P2P_FLG_ALLOW_OTHER_X); @@ -1149,14 +1148,17 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1) erts_destroy_link(rl); if (IS_TRACED_FL(rp, F_TRACE_PROCS) && rl != NULL) { - trace_proc(BIF_P, rp, am_getting_unlinked, BIF_P->common.id); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_STATUS); + cp_locks &= ~ERTS_PROC_LOCK_STATUS; + trace_proc(BIF_P, (ERTS_PROC_LOCK_MAIN | ERTS_PROC_LOCK_LINK), + rp, am_getting_unlinked, BIF_P->common.id); } if (rp != BIF_P) erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); } - erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); + erts_smp_proc_unlock(BIF_P, cp_locks & ~ERTS_PROC_LOCK_MAIN); BIF_RET(am_true); @@ -1909,7 +1911,7 @@ static Sint remote_send(Process *p, DistEntry *dep, } if (res >= 0) { - if (IS_TRACED(p)) + if (IS_TRACED_FL(p, F_TRACE_SEND)) trace_send(p, full_to, msg); if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); @@ -1928,7 +1930,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) Eterm* tp; if (is_internal_pid(to)) { - if (IS_TRACED(p)) + if (IS_TRACED_FL(p, F_TRACE_SEND)) trace_send(p, to, msg); if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); @@ -1957,7 +1959,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) rp = erts_proc_lookup_raw(id); if (rp) { - if (IS_TRACED(p)) + if (IS_TRACED_FL(p, F_TRACE_SEND)) trace_send(p, to, msg); if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); @@ -1973,7 +1975,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) goto port_common; } - if (IS_TRACED(p)) + if (IS_TRACED_FL(p, F_TRACE_SEND)) trace_send(p, to, msg); if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); @@ -2004,11 +2006,20 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) port_common: ret_val = 0; - + if (pt) { int ps_flags = ctx->suspend ? 0 : ERTS_PORT_SIG_FLG_NOSUSPEND; *refp = NIL; + if (IS_TRACED_FL(p, F_TRACE_SEND)) /* trace once only !! */ + trace_send(p, portid, msg); + + if (have_seqtrace(SEQ_TRACE_TOKEN(p))) { + seq_trace_update_send(p); + seq_trace_output(SEQ_TRACE_TOKEN(p), msg, + SEQ_TRACE_SEND, portid, p); + } + switch (erts_port_command(p, ps_flags, pt, msg, refp)) { case ERTS_PORT_OP_CALLER_EXIT: /* We are exiting... */ @@ -2041,18 +2052,10 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) break; } } - - if (IS_TRACED(p)) /* trace once only !! */ - trace_send(p, portid, msg); + if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); - - if (have_seqtrace(SEQ_TRACE_TOKEN(p))) { - seq_trace_update_send(p); - seq_trace_output(SEQ_TRACE_TOKEN(p), msg, - SEQ_TRACE_SEND, portid, p); - } - + if (ERTS_PROC_IS_EXITING(p)) { KILL_CATCHES(p); /* Must exit */ return SEND_USER_ERROR; @@ -2075,7 +2078,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) if (dep == erts_this_dist_entry) { Eterm id; erts_deref_dist_entry(dep); - if (IS_TRACED(p)) + if (IS_TRACED_FL(p, F_TRACE_SEND)) trace_send(p, to, msg); if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); @@ -2106,7 +2109,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) } return ret; } else { - if (IS_TRACED(p)) /* XXX Is this really neccessary ??? */ + if (IS_TRACED_FL(p, F_TRACE_SEND)) trace_send(p, to, msg); if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) save_calls(p, &exp_send); @@ -4337,12 +4340,34 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2) } else if (BIF_ARG_1 == am_trace_control_word) { BIF_RET(db_set_trace_control_word(BIF_P, BIF_ARG_2)); } else if (BIF_ARG_1 == am_sequential_tracer) { - Eterm old_value = erts_set_system_seq_tracer(BIF_P, - ERTS_PROC_LOCK_MAIN, - BIF_ARG_2); - if (old_value != THE_NON_VALUE) { - BIF_RET(old_value); - } + ErtsTracer new_seq_tracer, old_seq_tracer; + Eterm ret; + + if (BIF_ARG_2 == am_false) + new_seq_tracer = erts_tracer_nil; + else + new_seq_tracer = erts_term_to_tracer(THE_NON_VALUE, BIF_ARG_2); + + if (new_seq_tracer == THE_NON_VALUE) + goto error; + + old_seq_tracer = erts_set_system_seq_tracer(BIF_P, + ERTS_PROC_LOCK_MAIN, + new_seq_tracer); + + ERTS_TRACER_CLEAR(&new_seq_tracer); + + if (old_seq_tracer == THE_NON_VALUE) + goto error; + + if (ERTS_TRACER_IS_NIL(old_seq_tracer)) + BIF_RET(am_false); + + ret = erts_tracer_to_term(BIF_P, old_seq_tracer); + + ERTS_TRACER_CLEAR(&old_seq_tracer); + + BIF_RET(ret); } else if (BIF_ARG_1 == make_small(1)) { int i, max; ErtsMessage* mp; @@ -4679,7 +4704,7 @@ skip_current_msgq(Process *c_p) res = 0; } else { - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); c_p->msg.save = c_p->msg.last; res = 1; } diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 9bb77190d6..872f0f9b2a 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -181,9 +181,8 @@ bif erlang:port_set_data/2 bif erlang:port_get_data/1 # Tracing & debugging. -bif erlang:trace_pattern/2 -bif erlang:trace_pattern/3 -bif erlang:trace/3 +bif erts_internal:trace_pattern/3 +bif erts_internal:trace/3 bif erlang:trace_info/2 bif erlang:trace_delivered/1 bif erlang:seq_trace/2 @@ -653,6 +652,8 @@ bif erts_debug:size_shared/1 bif erts_debug:copy_shared/1 bif erlang:has_prepared_code_on_load/1 +bif maps:take/2 + # # Obsolete # diff --git a/erts/emulator/beam/code_ix.c b/erts/emulator/beam/code_ix.c index 9da750e366..ec6267711b 100644 --- a/erts/emulator/beam/code_ix.c +++ b/erts/emulator/beam/code_ix.c @@ -94,6 +94,7 @@ void erts_commit_staging_code_ix(void) ix = (ix + 1) % ERTS_NUM_CODE_IX; erts_smp_atomic32_set_nob(&the_staging_code_index, ix); export_staging_unlock(); + erts_tracer_nif_clear(); CIX_TRACE("activate"); } diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 88449adb8e..52fd57e101 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -337,7 +337,7 @@ static void doit_link_net_exits_sub(ErtsLink *sublnk, void *vlnecp) erts_destroy_link(rlnk); if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { /* We didn't exit the process and it is traced */ - trace_proc(NULL, rp, am_getting_unlinked, sublnk->pid); + trace_proc(NULL, 0, rp, am_getting_unlinked, sublnk->pid); } } erts_smp_proc_unlock(rp, rp_locks); @@ -397,7 +397,7 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp) msgp = erts_alloc_message_heap(rp, &rp_locks, 3, &hp, &ohp); tup = TUPLE2(hp, am_nodedown, name); - erts_queue_message(rp, &rp_locks, msgp, tup, NIL); + erts_queue_message(rp, &rp_locks, msgp, tup); } erts_smp_proc_unlock(rp, rp_locks); } @@ -1275,7 +1275,7 @@ int erts_net_message(Port *prt, erts_smp_de_links_unlock(dep); if (IS_TRACED_FL(rp, F_TRACE_PROCS)) - trace_proc(NULL, rp, am_getting_linked, from); + trace_proc(NULL, 0, rp, am_getting_linked, from); erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); break; @@ -1300,7 +1300,7 @@ int erts_net_message(Port *prt, lnk = erts_remove_link(&ERTS_P_LINKS(rp), from); if (IS_TRACED_FL(rp, F_TRACE_PROCS) && lnk != NULL) { - trace_proc(NULL, rp, am_getting_unlinked, from); + trace_proc(NULL, 0, rp, am_getting_unlinked, from); } erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); @@ -1628,7 +1628,11 @@ int erts_net_message(Port *prt, ERTS_XSIG_FLG_IGN_KILL); if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { /* We didn't exit the process and it is traced */ - trace_proc(NULL, rp, am_getting_unlinked, from); + if (rp_locks & ERTS_PROC_LOCKS_XSIG_SEND) { + erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_XSIG_SEND); + rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND; + } + trace_proc(NULL, 0, rp, am_getting_unlinked, from); } } erts_smp_proc_unlock(rp, rp_locks); @@ -1719,7 +1723,7 @@ decode_error: } data_error: UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE); - erts_deliver_port_exit(prt, dep->cid, am_killed, 0); + erts_deliver_port_exit(prt, dep->cid, am_killed, 0, 1); ERTS_SMP_CHK_NO_PROC_LOCKS; return -1; } @@ -2089,7 +2093,7 @@ erts_dist_command(Port *prt, int reds_limit) erts_smp_de_runlock(dep); if (status & ERTS_DE_SFLG_EXITING) { - erts_deliver_port_exit(prt, prt->common.id, am_killed, 0); + erts_deliver_port_exit(prt, prt->common.id, am_killed, 0, 1); erts_deref_dist_entry(dep); return reds + ERTS_PORT_REDS_DIST_CMD_EXIT; } @@ -3313,7 +3317,7 @@ send_nodes_mon_msg(Process *rp, } ASSERT(hend == hp); - erts_queue_message(rp, rp_locksp, mp, msg, NIL); + erts_queue_message(rp, rp_locksp, mp, msg); } static void diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index cfe0bc3205..d04977b9ae 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -30,6 +30,7 @@ #endif #define ERTS_ALLOC_C__ #define ERTS_ALC_INTERNAL__ +#define ERTS_WANT_MEM_MAPPERS #include "sys.h" #define ERL_THREADS_EMU_INTERNAL__ #include "erl_threads.h" @@ -131,6 +132,9 @@ static ErtsAllocatorState_t ets_alloc_state; static ErtsAllocatorState_t driver_alloc_state; static ErtsAllocatorState_t fix_alloc_state; static ErtsAllocatorState_t literal_alloc_state; +#ifdef ERTS_ALC_A_EXEC +static ErtsAllocatorState_t exec_alloc_state; +#endif static ErtsAllocatorState_t test_alloc_state; typedef struct { @@ -216,6 +220,7 @@ typedef struct { struct au_init driver_alloc; struct au_init fix_alloc; struct au_init literal_alloc; + struct au_init exec_alloc; struct au_init test_alloc; } erts_alc_hndl_args_init_t; @@ -307,9 +312,9 @@ set_default_literal_alloc_opts(struct au_init *ip) ip->init.util.name_prefix = "literal_"; ip->init.util.alloc_no = ERTS_ALC_A_LITERAL; #ifndef SMALL_MEMORY - ip->init.util.mmbcs = 2*1024*1024; /* Main carrier size */ + ip->init.util.mmbcs = 1024*1024; /* Main carrier size */ #else - ip->init.util.mmbcs = 1*1024*1024; /* Main carrier size */ + ip->init.util.mmbcs = 256*1024; /* Main carrier size */ #endif ip->init.util.ts = ERTS_ALC_MTA_LITERAL; ip->init.util.asbcst = 0; @@ -329,15 +334,48 @@ set_default_literal_alloc_opts(struct au_init *ip) ip->init.util.sys_dealloc = &erts_alcu_literal_32_sys_dealloc; #elif defined(ARCH_64) # ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION - ip->init.util.mseg_alloc = &erts_alcu_literal_64_mseg_alloc; - ip->init.util.mseg_realloc = &erts_alcu_literal_64_mseg_realloc; - ip->init.util.mseg_dealloc = &erts_alcu_literal_64_mseg_dealloc; + ip->init.util.mseg_alloc = &erts_alcu_mmapper_mseg_alloc; + ip->init.util.mseg_realloc = &erts_alcu_mmapper_mseg_realloc; + ip->init.util.mseg_dealloc = &erts_alcu_mmapper_mseg_dealloc; + ip->init.util.mseg_mmapper = &erts_literal_mmapper; # endif #else # error Unknown architecture #endif } +#ifdef ERTS_ALC_A_EXEC +static void +set_default_exec_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = 1; + ip->thr_spec = 0; + ip->disable_allowed = 0; + ip->thr_spec_allowed = 0; + ip->carrier_migration_allowed = 0; + ip->atype = BESTFIT; + ip->init.bf.ao = 1; + ip->init.util.ramv = 0; + ip->init.util.mmsbc = 0; + ip->init.util.sbct = ~((UWord) 0); + ip->init.util.name_prefix = "exec_"; + ip->init.util.alloc_no = ERTS_ALC_A_EXEC; + ip->init.util.mmbcs = 0; /* No main carrier */ + ip->init.util.ts = ERTS_ALC_MTA_EXEC; + ip->init.util.asbcst = 0; + ip->init.util.rsbcst = 0; + ip->init.util.rsbcmt = 0; + ip->init.util.rmbcmt = 0; + ip->init.util.acul = 0; + + ip->init.util.mseg_alloc = &erts_alcu_mmapper_mseg_alloc; + ip->init.util.mseg_realloc = &erts_alcu_mmapper_mseg_realloc; + ip->init.util.mseg_dealloc = &erts_alcu_mmapper_mseg_dealloc; + ip->init.util.mseg_mmapper = &erts_exec_mmapper; +} +#endif /* ERTS_ALC_A_EXEC */ + static void set_default_temp_alloc_opts(struct au_init *ip) { @@ -659,6 +697,9 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) set_default_fix_alloc_opts(&init.fix_alloc, fix_type_sizes); set_default_literal_alloc_opts(&init.literal_alloc); +#ifdef ERTS_ALC_A_EXEC + set_default_exec_alloc_opts(&init.exec_alloc); +#endif set_default_test_alloc_opts(&init.test_alloc); if (argc && argv) @@ -688,6 +729,9 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.driver_alloc.thr_spec = 0; init.fix_alloc.thr_spec = 0; init.literal_alloc.thr_spec = 0; +#ifdef ERTS_ALC_A_EXEC + init.exec_alloc.thr_spec = 0; +#endif #endif /* Make adjustments for carrier migration support */ @@ -701,6 +745,9 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) adjust_carrier_migration_support(&init.driver_alloc); adjust_carrier_migration_support(&init.fix_alloc); adjust_carrier_migration_support(&init.literal_alloc); +#ifdef ERTS_ALC_A_EXEC + adjust_carrier_migration_support(&init.exec_alloc); +#endif if (init.erts_alloc_config) { /* Adjust flags that erts_alloc_config won't like */ @@ -716,6 +763,9 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.driver_alloc.thr_spec = 0; init.fix_alloc.thr_spec = 0; init.literal_alloc.thr_spec = 0; +#ifdef ERTS_ALC_A_EXEC + init.exec_alloc.thr_spec = 0; +#endif /* No carrier migration */ init.temp_alloc.init.util.acul = 0; @@ -728,6 +778,9 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.driver_alloc.init.util.acul = 0; init.fix_alloc.init.util.acul = 0; init.literal_alloc.init.util.acul = 0; +#ifdef ERTS_ALC_A_EXEC + init.exec_alloc.init.util.acul = 0; +#endif } #ifdef ERTS_SMP @@ -745,6 +798,9 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) adjust_tpref(&init.driver_alloc, erts_no_schedulers); adjust_tpref(&init.fix_alloc, erts_no_schedulers); adjust_tpref(&init.literal_alloc, erts_no_schedulers); +#ifdef ERTS_ALC_A_EXEC + adjust_tpref(&init.exec_alloc, erts_no_schedulers); +#endif #else /* No thread specific if not smp */ @@ -764,6 +820,9 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) refuse_af_strategy(&init.driver_alloc); refuse_af_strategy(&init.fix_alloc); refuse_af_strategy(&init.literal_alloc); +#ifdef ERTS_ALC_A_EXEC + refuse_af_strategy(&init.exec_alloc); +#endif #ifdef ERTS_SMP if (!init.temp_alloc.thr_spec) @@ -808,6 +867,9 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) set_au_allocator(ERTS_ALC_A_DRIVER, &init.driver_alloc, ncpu); set_au_allocator(ERTS_ALC_A_FIXED_SIZE, &init.fix_alloc, ncpu); set_au_allocator(ERTS_ALC_A_LITERAL, &init.literal_alloc, ncpu); +#ifdef ERTS_ALC_A_EXEC + set_au_allocator(ERTS_ALC_A_EXEC, &init.exec_alloc, ncpu); +#endif set_au_allocator(ERTS_ALC_A_TEST, &init.test_alloc, ncpu); for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { @@ -864,7 +926,11 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) start_au_allocator(ERTS_ALC_A_LITERAL, &init.literal_alloc, &literal_alloc_state); - +#ifdef ERTS_ALC_A_EXEC + start_au_allocator(ERTS_ALC_A_EXEC, + &init.exec_alloc, + &exec_alloc_state); +#endif start_au_allocator(ERTS_ALC_A_TEST, &init.test_alloc, &test_alloc_state); @@ -1499,6 +1565,16 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) else handle_au_arg(&init->literal_alloc, &argv[i][3], argv, &i, 0); break; + case 'X': + if (has_prefix("scs", argv[i]+3)) { +#ifdef ERTS_ALC_A_EXEC + init->mseg.exec_mmap.scs = +#endif + get_mb_value(argv[i]+6, argv, &i); + } + else + handle_au_arg(&init->exec_alloc, &argv[i][3], argv, &i, 0); + break; case 'D': handle_au_arg(&init->std_alloc, &argv[i][3], argv, &i, 0); break; @@ -3210,7 +3286,7 @@ reply_alloc_info(void *vair) if (hp != hp_end) erts_shrink_message_heap(&mp, rp, hp_start, hp, hp_end, &msg, 1); - erts_queue_message(rp, &rp_locks, mp, msg, NIL); + erts_queue_message(rp, &rp_locks, mp, msg); if (air->req_sched == sched_id) rp_locks &= ~ERTS_PROC_LOCK_MAIN; diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 9482ab9265..ba216c7eb4 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -87,6 +87,9 @@ allocator EHEAP true eheap_alloc allocator ETS true ets_alloc allocator FIXED_SIZE true fix_alloc allocator LITERAL true literal_alloc ++if exec_alloc +allocator EXEC true exec_alloc ++endif +else # Non smp build @@ -98,6 +101,9 @@ allocator EHEAP false eheap_alloc allocator ETS false ets_alloc allocator FIXED_SIZE false fix_alloc allocator LITERAL false literal_alloc ++if exec_alloc +allocator EXEC false exec_alloc ++endif +endif @@ -258,7 +264,6 @@ type PRTSD STANDARD SYSTEM port_specific_data type CPUDATA LONG_LIVED SYSTEM cpu_data type TMP_CPU_IDS SHORT_LIVED SYSTEM tmp_cpu_ids type EXT_TERM_DATA SHORT_LIVED PROCESSES external_term_data -type ZLIB STANDARD SYSTEM zlib type CPU_GRPS_MAP LONG_LIVED SYSTEM cpu_groups_map type AUX_WORK_TMO LONG_LIVED SYSTEM aux_work_timeouts type MISC_AUX_WORK_Q LONG_LIVED SYSTEM misc_aux_work_q @@ -270,6 +275,9 @@ type PROC_SYS_TSK SHORT_LIVED PROCESSES proc_sys_task type PROC_SYS_TSK_QS SHORT_LIVED PROCESSES proc_sys_task_queues type NEW_TIME_OFFSET SHORT_LIVED SYSTEM new_time_offset type IOB_REQ SHORT_LIVED SYSTEM io_bytes_request +type TRACER_NIF LONG_LIVED SYSTEM tracer_nif +type TRACE_MSG_QUEUE SHORT_LIVED SYSTEM trace_message_queue +type SCHED_ASYNC_JOB SHORT_LIVED SYSTEM async_calls +if threads_no_smp # Need thread safe allocs, but std_alloc and fix_alloc are not; @@ -288,8 +296,10 @@ type THR_Q_LL LONG_LIVED SYSTEM long_lived_thr_queue +if smp type ASYNC SHORT_LIVED SYSTEM async +type ZLIB STANDARD SYSTEM zlib +else -# sl_alloc is not thread safe in non smp build; therefore, we use driver_alloc +# sl/std_alloc is not thread safe in non smp build; therefore, we use driver_alloc +type ZLIB DRIVER SYSTEM zlib type ASYNC DRIVER SYSTEM async +endif @@ -335,8 +345,14 @@ type SL_MPATHS SHORT_LIVED SYSTEM sl_migration_paths # Currently most hipe code use this type. type HIPE SYSTEM SYSTEM hipe_data ++if exec_alloc +type HIPE_EXEC EXEC CODE hipe_code +endif ++endif + + + +if heap_frag_elim_test type SSB SHORT_LIVED PROCESSES ssb diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index b913886d86..2995f2f822 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -859,28 +859,36 @@ void* erts_alcu_literal_32_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags) { void* res; - ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL - && !allctr->t && allctr->thread_safe); + Uint sz = ERTS_SUPERALIGNED_CEILING(*size_p); + ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL && + allctr->t == 0); + ERTS_SMP_LC_ASSERT(allctr->thread_safe); - res = erts_alcu_mseg_alloc(allctr, size_p, flags); - if (res) - set_literal_range(res, *size_p); + res = erts_alcu_mseg_alloc(allctr, &sz, flags); + if (res) { + set_literal_range(res, sz); + *size_p = sz; + } return res; } void* erts_alcu_literal_32_mseg_realloc(Allctr_t *allctr, void *seg, - Uint old_size, Uint *new_size_p) + Uint old_size, Uint *new_size_p) { void* res; - ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL - && !allctr->t && allctr->thread_safe); + Uint new_sz = ERTS_SUPERALIGNED_CEILING(*new_size_p); + ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL && + allctr->t == 0); + ERTS_SMP_LC_ASSERT(allctr->thread_safe); if (seg && old_size) clear_literal_range(seg, old_size); - res = erts_alcu_mseg_realloc(allctr, seg, old_size, new_size_p); - if (res) - set_literal_range(res, *new_size_p); + res = erts_alcu_mseg_realloc(allctr, seg, old_size, &new_sz); + if (res) { + set_literal_range(res, new_sz); + *new_size_p = new_sz; + } return res; } @@ -888,8 +896,9 @@ void erts_alcu_literal_32_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags) { - ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL - && !allctr->t && allctr->thread_safe); + ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL && + allctr->t == 0); + ERTS_SMP_LC_ASSERT(allctr->thread_safe); erts_alcu_mseg_dealloc(allctr, seg, size, flags); @@ -898,8 +907,9 @@ erts_alcu_literal_32_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, #elif defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) +/* Used by literal allocator that has its own mmapper (super carrier) */ void* -erts_alcu_literal_64_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags) +erts_alcu_mmapper_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags) { void* res; UWord size = (UWord) *size_p; @@ -907,33 +917,33 @@ erts_alcu_literal_64_mseg_alloc(Allctr_t *allctr, Uint *size_p, Uint flags) if (flags & ERTS_MSEG_FLG_2POW) mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; - res = erts_mmap(&erts_literal_mmapper, mmap_flags, &size); + res = erts_mmap(allctr->mseg_mmapper, mmap_flags, &size); *size_p = (Uint)size; INC_CC(allctr->calls.mseg_alloc); return res; } void* -erts_alcu_literal_64_mseg_realloc(Allctr_t *allctr, void *seg, +erts_alcu_mmapper_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p) { void *res; UWord new_size = (UWord) *new_size_p; - res = erts_mremap(&erts_literal_mmapper, ERTS_MSEG_FLG_NONE, seg, old_size, &new_size); + res = erts_mremap(allctr->mseg_mmapper, ERTS_MSEG_FLG_NONE, seg, old_size, &new_size); *new_size_p = (Uint) new_size; INC_CC(allctr->calls.mseg_realloc); return res; } void -erts_alcu_literal_64_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, +erts_alcu_mmapper_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, Uint flags) { Uint32 mmap_flags = ERTS_MMAPFLG_SUPERCARRIER_ONLY; if (flags & ERTS_MSEG_FLG_2POW) mmap_flags |= ERTS_MMAPFLG_SUPERALIGNED; - erts_munmap(&erts_literal_mmapper, mmap_flags, seg, (UWord)size); + erts_munmap(allctr->mseg_mmapper, mmap_flags, seg, (UWord)size); INC_CC(allctr->calls.mseg_dealloc); } #endif /* ARCH_64 && ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION */ @@ -941,9 +951,10 @@ erts_alcu_literal_64_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size, #endif /* HAVE_ERTS_MSEG */ void* -erts_alcu_sys_alloc(Allctr_t *allctr, Uint size, int superalign) +erts_alcu_sys_alloc(Allctr_t *allctr, Uint* size_p, int superalign) { void *res; + const Uint size = *size_p; #if ERTS_SA_MB_CARRIERS && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC if (superalign) res = erts_sys_aligned_alloc(ERTS_SACRR_UNIT_SZ, size); @@ -957,9 +968,10 @@ erts_alcu_sys_alloc(Allctr_t *allctr, Uint size, int superalign) } void* -erts_alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign) +erts_alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint *size_p, Uint old_size, int superalign) { void *res; + const Uint size = *size_p; #if ERTS_SA_MB_CARRIERS && ERTS_HAVE_ERTS_SYS_ALIGNED_ALLOC if (superalign) @@ -994,38 +1006,48 @@ erts_alcu_sys_dealloc(Allctr_t *allctr, void *ptr, Uint size, int superalign) #ifdef ARCH_32 void* -erts_alcu_literal_32_sys_alloc(Allctr_t *allctr, Uint size, int superalign) +erts_alcu_literal_32_sys_alloc(Allctr_t *allctr, Uint* size_p, int superalign) { void* res; - ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL - && !allctr->t && allctr->thread_safe); + Uint size = ERTS_SUPERALIGNED_CEILING(*size_p); + ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL && + allctr->t == 0); + ERTS_SMP_LC_ASSERT(allctr->thread_safe); - res = erts_alcu_sys_alloc(allctr, size, 1); - if (res) + res = erts_alcu_sys_alloc(allctr, &size, 1); + if (res) { set_literal_range(res, size); + *size_p = size; + } return res; } void* -erts_alcu_literal_32_sys_realloc(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign) +erts_alcu_literal_32_sys_realloc(Allctr_t *allctr, void *ptr, Uint* size_p, Uint old_size, int superalign) { void* res; - ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL - && !allctr->t && allctr->thread_safe); + Uint size = ERTS_SUPERALIGNED_CEILING(*size_p); + + ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL && + allctr->t == 0); + ERTS_SMP_LC_ASSERT(allctr->thread_safe); if (ptr && old_size) clear_literal_range(ptr, old_size); - res = erts_alcu_sys_realloc(allctr, ptr, size, old_size, 1); - if (res) + res = erts_alcu_sys_realloc(allctr, ptr, &size, old_size, 1); + if (res) { set_literal_range(res, size); + *size_p = size; + } return res; } void erts_alcu_literal_32_sys_dealloc(Allctr_t *allctr, void *ptr, Uint size, int superalign) { - ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL - && !allctr->t && allctr->thread_safe); + ERTS_LC_ASSERT(allctr->alloc_no == ERTS_ALC_A_LITERAL && + allctr->t == 0); + ERTS_SMP_LC_ASSERT(allctr->thread_safe); erts_alcu_sys_dealloc(allctr, ptr, size, 1); @@ -3864,12 +3886,12 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) ? UNIT_CEILING(bcrr_sz) : SYS_ALLOC_CARRIER_CEILING(bcrr_sz)); - crr = (Carrier_t *) allctr->sys_alloc(allctr, crr_sz, flags & CFLG_MBC); + crr = (Carrier_t *) allctr->sys_alloc(allctr, &crr_sz, flags & CFLG_MBC); if (!crr) { if (crr_sz > UNIT_CEILING(bcrr_sz)) { crr_sz = UNIT_CEILING(bcrr_sz); - crr = (Carrier_t *) allctr->sys_alloc(allctr, crr_sz, flags & CFLG_MBC); + crr = (Carrier_t *) allctr->sys_alloc(allctr, &crr_sz, flags & CFLG_MBC); } if (!crr) { #if HAVE_ERTS_MSEG @@ -4027,7 +4049,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) new_crr = (Carrier_t *) allctr->sys_realloc(allctr, (void *) old_crr, - new_crr_sz, + &new_crr_sz, old_crr_sz, 0); if (new_crr) { @@ -4048,7 +4070,7 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) new_crr_sz = UNIT_CEILING(new_crr_sz); new_crr = (Carrier_t *) allctr->sys_realloc(allctr, (void *) old_crr, - new_crr_sz, + &new_crr_sz, old_crr_sz, 0); if (new_crr) @@ -6127,6 +6149,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) allctr->mseg_alloc = init->mseg_alloc; allctr->mseg_realloc = init->mseg_realloc; allctr->mseg_dealloc = init->mseg_dealloc; + allctr->mseg_mmapper = init->mseg_mmapper; } else { ASSERT(!init->mseg_realloc && !init->mseg_dealloc); diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index 527a0cd91d..f50f09907a 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -72,9 +72,10 @@ typedef struct { void* (*mseg_alloc)(Allctr_t*, Uint *size_p, Uint flags); void* (*mseg_realloc)(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p); void (*mseg_dealloc)(Allctr_t*, void *seg, Uint size, Uint flags); + ErtsMemMapper *mseg_mmapper; #endif - void* (*sys_alloc)(Allctr_t *allctr, Uint size, int superalign); - void* (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign); + void* (*sys_alloc)(Allctr_t *allctr, Uint *size_p, int superalign); + void* (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint *size_p, Uint old_size, int superalign); void (*sys_dealloc)(Allctr_t *allctr, void *ptr, Uint size, int superalign); } AllctrInit_t; @@ -205,18 +206,18 @@ void* erts_alcu_literal_32_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uin void erts_alcu_literal_32_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags); # elif defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) -void* erts_alcu_literal_64_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags); -void* erts_alcu_literal_64_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p); -void erts_alcu_literal_64_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags); +void* erts_alcu_mmapper_mseg_alloc(Allctr_t*, Uint *size_p, Uint flags); +void* erts_alcu_mmapper_mseg_realloc(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p); +void erts_alcu_mmapper_mseg_dealloc(Allctr_t*, void *seg, Uint size, Uint flags); # endif #endif /* HAVE_ERTS_MSEG */ -void* erts_alcu_sys_alloc(Allctr_t*, Uint size, int superalign); -void* erts_alcu_sys_realloc(Allctr_t*, void *ptr, Uint size, Uint old_size, int superalign); +void* erts_alcu_sys_alloc(Allctr_t*, Uint *size_p, int superalign); +void* erts_alcu_sys_realloc(Allctr_t*, void *ptr, Uint *size_p, Uint old_size, int superalign); void erts_alcu_sys_dealloc(Allctr_t*, void *ptr, Uint size, int superalign); #ifdef ARCH_32 -void* erts_alcu_literal_32_sys_alloc(Allctr_t*, Uint size, int superalign); -void* erts_alcu_literal_32_sys_realloc(Allctr_t*, void *ptr, Uint size, Uint old_size, int superalign); +void* erts_alcu_literal_32_sys_alloc(Allctr_t*, Uint *size_p, int superalign); +void* erts_alcu_literal_32_sys_realloc(Allctr_t*, void *ptr, Uint *size_p, Uint old_size, int superalign); void erts_alcu_literal_32_sys_dealloc(Allctr_t*, void *ptr, Uint size, int superalign); #endif @@ -601,9 +602,10 @@ struct Allctr_t_ { void* (*mseg_alloc)(Allctr_t*, Uint *size_p, Uint flags); void* (*mseg_realloc)(Allctr_t*, void *seg, Uint old_size, Uint *new_size_p); void (*mseg_dealloc)(Allctr_t*, void *seg, Uint size, Uint flags); + ErtsMemMapper *mseg_mmapper; #endif - void* (*sys_alloc)(Allctr_t *allctr, Uint size, int superalign); - void* (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint size, Uint old_size, int superalign); + void* (*sys_alloc)(Allctr_t *allctr, Uint *size_p, int superalign); + void* (*sys_realloc)(Allctr_t *allctr, void *ptr, Uint *size_p, Uint old_size, int superalign); void (*sys_dealloc)(Allctr_t *allctr, void *ptr, Uint size, int superalign); void (*init_atoms) (void); diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index a79ce11563..1e2db38442 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -1737,7 +1737,7 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type, hp += REF_THING_SIZE; mess = TUPLE5(hp,type,r,am_driver,driver_name,tag); } - erts_queue_message(proc, &rp_locks, mp, mess, am_undefined); + erts_queue_message(proc, &rp_locks, mp, mess); erts_smp_proc_unlock(proc, rp_locks); ERTS_SMP_CHK_NO_PROC_LOCKS; } diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 68f6abfcdc..c9741b361f 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -22,6 +22,7 @@ # include "config.h" #endif +#define ERTS_WANT_MEM_MAPPERS #include "sys.h" #include "erl_vm.h" #include "global.h" @@ -846,6 +847,7 @@ process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap, if (unlock_locks) erts_smp_proc_unlock(rp, unlock_locks); + } /* @@ -2162,8 +2164,8 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) res = build_snifs_term(&hp, NULL, NIL); BIF_RET(res); } else if (BIF_ARG_1 == am_sequential_tracer) { - val = erts_get_system_seq_tracer(); - ASSERT(is_internal_pid(val) || is_internal_port(val) || val==am_false); + ErtsTracer seq_tracer = erts_get_system_seq_tracer(); + val = erts_tracer_to_term(BIF_P, seq_tracer); hp = HAlloc(BIF_P, 3); res = TUPLE2(hp, am_sequential_tracer, val); BIF_RET(res); diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index 648f33744a..37f4e1de49 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -79,6 +79,7 @@ BIF_RETTYPE erts_internal_open_port_2(BIF_ALIST_2) } if (port->drv_ptr->flags & ERL_DRV_FLAG_USE_INIT_ACK) { + /* Copied from erl_port_task.c */ port->async_open_port = erts_alloc(ERTS_ALC_T_PRTSD, sizeof(*port->async_open_port)); @@ -109,6 +110,10 @@ BIF_RETTYPE erts_internal_open_port_2(BIF_ALIST_2) erts_add_link(&ERTS_P_LINKS(port), LINK_PID, BIF_P->common.id); erts_add_link(&ERTS_P_LINKS(BIF_P), LINK_PID, port->common.id); + if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) + trace_proc(BIF_P, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK, BIF_P, + am_link, port->common.id); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); erts_port_release(port); @@ -339,8 +344,7 @@ BIF_RETTYPE erts_internal_port_close_1(BIF_ALIST_1) if (!prt) BIF_RET(am_badarg); - - switch (erts_port_exit(BIF_P, 0, prt, prt->common.id, am_normal, &ref)) { + switch (erts_port_exit(BIF_P, 0, prt, BIF_P->common.id, am_normal, &ref)) { case ERTS_PORT_OP_CALLER_EXIT: case ERTS_PORT_OP_BADARG: case ERTS_PORT_OP_DROPPED: @@ -373,7 +377,7 @@ BIF_RETTYPE erts_internal_port_connect_2(BIF_ALIST_2) ref = NIL; #endif - switch (erts_port_connect(BIF_P, 0, prt, prt->common.id, BIF_ARG_2, &ref)) { + switch (erts_port_connect(BIF_P, 0, prt, BIF_P->common.id, BIF_ARG_2, &ref)) { case ERTS_PORT_OP_CALLER_EXIT: case ERTS_PORT_OP_BADARG: case ERTS_PORT_OP_DROPPED: @@ -911,7 +915,7 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) } if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { - trace_virtual_sched(p, am_out); + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_out); } @@ -928,21 +932,22 @@ open_port(Process* p, Eterm name, Eterm settings, int *err_typep, int *err_nump) DTRACE3(port_open, process_str, name_buf, port_str); } #endif + + if (port && IS_TRACED_FL(port, F_TRACE_PORTS)) + trace_port(port, am_getting_linked, p->common.id); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in); + } + if (!port) { DEBUGF(("open_driver returned (%d:%d)\n", err_typep ? *err_typep : 4711, err_nump ? *err_nump : 4711)); - if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { - trace_virtual_sched(p, am_in); - } goto do_return; } - - if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { - trace_virtual_sched(p, am_in); - } if (linebuf && port->linebuf == NULL){ port->linebuf = allocate_linebuf(linebuf); @@ -985,6 +990,8 @@ static char **convert_args(Eterm l) } n = erts_list_length(l); + if (n < 0) + return NULL; /* We require at least one element in argv[0] + NULL at end */ pp = erts_alloc(ERTS_ALC_T_TMP, (n + 2) * sizeof(char **)); pp[i++] = erts_default_arg0; diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index a9443ee8df..ff2018aa27 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -52,7 +52,7 @@ static int erts_default_trace_pattern_is_on; static Binary *erts_default_match_spec; static Binary *erts_default_meta_match_spec; static struct trace_pattern_flags erts_default_trace_pattern_flags; -static Eterm erts_default_meta_tracer_pid; +static ErtsTracer erts_default_meta_tracer; static struct { /* Protected by code write permission */ int current; @@ -75,8 +75,6 @@ static BIF_RETTYPE system_monitor(Process *p, Eterm monitor_pid, Eterm list); static void new_seq_trace_token(Process* p); /* help func for seq_trace_2*/ -static int already_traced(Process *p, Process *tracee_p, Eterm tracer); -static int port_already_traced(Process *p, Port *tracee_port, Eterm tracer); static Eterm trace_info_pid(Process* p, Eterm pid_spec, Eterm key); static Eterm trace_info_func(Process* p, Eterm pid_spec, Eterm key); static Eterm trace_info_on_load(Process* p, Eterm key); @@ -94,21 +92,15 @@ erts_bif_trace_init(void) erts_default_match_spec = NULL; erts_default_meta_match_spec = NULL; erts_default_trace_pattern_flags = erts_trace_pattern_flags_off; - erts_default_meta_tracer_pid = NIL; + erts_default_meta_tracer = erts_tracer_nil; } /* * Turn on/off call tracing for the given function(s). */ - -Eterm -trace_pattern_2(BIF_ALIST_2) -{ - return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, NIL); -} Eterm -trace_pattern_3(BIF_ALIST_3) +erts_internal_trace_pattern_3(BIF_ALIST_3) { return trace_pattern(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); } @@ -125,11 +117,10 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) Eterm l; struct trace_pattern_flags flags = erts_trace_pattern_flags_off; int is_global; - Process *meta_tracer_proc = p; - Eterm meta_tracer_pid = p->common.id; + ErtsTracer meta_tracer = erts_tracer_nil; if (!erts_try_seize_code_write_permission(p)) { - ERTS_BIF_YIELD3(bif_export[BIF_trace_pattern_3], p, MFA, Pattern, flaglist); + ERTS_BIF_YIELD3(bif_export[BIF_erts_internal_trace_pattern_3], p, MFA, Pattern, flaglist); } finish_bp.current = -1; @@ -160,31 +151,11 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) is_global = 0; for(l = flaglist; is_list(l); l = CDR(list_val(l))) { if (is_tuple(CAR(list_val(l)))) { - Eterm *tp = tuple_val(CAR(list_val(l))); - - if (arityval(tp[0]) != 2 || tp[1] != am_meta) { - goto error; - } - meta_tracer_pid = tp[2]; - if (is_internal_pid(meta_tracer_pid)) { - meta_tracer_proc = erts_pid2proc(NULL, 0, meta_tracer_pid, 0); - if (!meta_tracer_proc) { - goto error; - } - } else if (is_internal_port(meta_tracer_pid)) { - Port *meta_tracer_port; - meta_tracer_proc = NULL; - meta_tracer_port = (erts_port_lookup( - meta_tracer_pid, - ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP)); - if (!meta_tracer_port) - goto error; - } else { - goto error; - } - if (is_global) { - goto error; - } + meta_tracer = erts_term_to_tracer(am_meta, CAR(list_val(l))); + if (meta_tracer == THE_NON_VALUE) { + meta_tracer = erts_tracer_nil; + goto error; + } flags.breakpoint = 1; flags.meta = 1; } else { @@ -202,6 +173,8 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) } flags.breakpoint = 1; flags.meta = 1; + if (ERTS_TRACER_IS_NIL(meta_tracer)) + meta_tracer = erts_term_to_tracer(THE_NON_VALUE, p->common.id); break; case am_global: if (flags.breakpoint) { @@ -252,14 +225,11 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) MatchSetUnref(erts_default_meta_match_spec); erts_default_meta_match_spec = match_prog_set; MatchSetRef(erts_default_meta_match_spec); - erts_default_meta_tracer_pid = meta_tracer_pid; - if (meta_tracer_proc) { - ERTS_TRACE_FLAGS(meta_tracer_proc) |= F_TRACER; - } + erts_tracer_update(&erts_default_meta_tracer, meta_tracer); } else if (! flags.breakpoint) { MatchSetUnref(erts_default_meta_match_spec); erts_default_meta_match_spec = NULL; - erts_default_meta_tracer_pid = NIL; + ERTS_TRACER_CLEAR(&erts_default_meta_tracer); } if (erts_default_trace_pattern_flags.breakpoint && flags.breakpoint) { @@ -340,20 +310,18 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) if (is_small(mfa[2])) { mfa[2] = signed_val(mfa[2]); } - - if (meta_tracer_proc) { - ERTS_TRACE_FLAGS(meta_tracer_proc) |= F_TRACER; - } matches = erts_set_trace_pattern(p, mfa, specified, match_prog_set, match_prog_set, - on, flags, meta_tracer_pid, 0); + on, flags, meta_tracer, 0); } error: MatchSetUnref(match_prog_set); UnUseTmpHeap(3,p); + ERTS_TRACER_CLEAR(&meta_tracer); + #ifdef ERTS_SMP if (finish_bp.current >= 0) { ASSERT(matches >= 0); @@ -404,7 +372,7 @@ erts_get_default_trace_pattern(int *trace_pattern_is_on, Binary **match_spec, Binary **meta_match_spec, struct trace_pattern_flags *trace_pattern_flags, - Eterm *meta_tracer_pid) + ErtsTracer *meta_tracer) { ERTS_SMP_LC_ASSERT(erts_has_code_write_permission() || erts_smp_thr_progress_is_blocking()); @@ -416,8 +384,8 @@ erts_get_default_trace_pattern(int *trace_pattern_is_on, *meta_match_spec = erts_default_meta_match_spec; if (trace_pattern_flags) *trace_pattern_flags = erts_default_trace_pattern_flags; - if (meta_tracer_pid) - *meta_tracer_pid = erts_default_meta_tracer_pid; + if (meta_tracer) + *meta_tracer = erts_default_meta_tracer; } int erts_is_default_trace_enabled(void) @@ -465,12 +433,12 @@ erts_trace_flag2bit(Eterm flag) ** occurred in the argument list. */ int -erts_trace_flags(Eterm List, - Uint *pMask, Eterm *pTracer, int *pCpuTimestamp) +erts_trace_flags(Eterm List, + Uint *pMask, ErtsTracer *pTracer, int *pCpuTimestamp) { Eterm list = List; Uint mask = 0; - Eterm tracer = NIL; + ErtsTracer tracer = erts_tracer_nil; int cpu_timestamp = 0; while (is_list(list)) { @@ -483,33 +451,73 @@ erts_trace_flags(Eterm List, cpu_timestamp = !0; #endif } else if (is_tuple(item)) { - Eterm* tp = tuple_val(item); - - if (arityval(tp[0]) != 2 || tp[1] != am_tracer) goto error; - if (is_internal_pid(tp[2]) || is_internal_port(tp[2])) { - tracer = tp[2]; - } else goto error; + tracer = erts_term_to_tracer(am_tracer, item); + if (tracer == THE_NON_VALUE) + goto error; } else goto error; list = CDR(list_val(list)); } if (is_not_nil(list)) goto error; - if (pMask && mask) *pMask = mask; - if (pTracer && tracer != NIL) *pTracer = tracer; - if (pCpuTimestamp && cpu_timestamp) *pCpuTimestamp = cpu_timestamp; + if (pMask && mask) *pMask = mask; + if (pTracer && !ERTS_TRACER_IS_NIL(tracer)) *pTracer = tracer; + if (pCpuTimestamp && cpu_timestamp) *pCpuTimestamp = cpu_timestamp; return !0; error: return 0; } -Eterm trace_3(BIF_ALIST_3) +static ERTS_INLINE int +start_trace(Process *c_p, ErtsTracer tracer, + ErtsPTabElementCommon *common, + int on, int mask) +{ + /* We can use the common part of both port+proc without checking what it is + In the code below port is used for both proc and port */ + Port *port = (Port*)common; + + /* + * SMP build assumes that either system is blocked or: + * * main lock is held on c_p + * * all locks are held on port common + */ + + if (!ERTS_TRACER_IS_NIL(tracer)) { + if ((ERTS_TRACE_FLAGS(port) & TRACEE_FLAGS) + && !ERTS_TRACER_COMPARE(ERTS_TRACER(port), tracer)) { + /* This tracee is already being traced, and not by the + * tracer to be */ + if (erts_is_tracer_proc_enabled(c_p, ERTS_PROC_LOCKS_ALL, + common, am_trace_status)) { + /* The tracer is still in use */ + return 1; + } + /* Current tracer now invalid */ + } + } + + if (on) + ERTS_TRACE_FLAGS(port) |= mask; + else + ERTS_TRACE_FLAGS(port) &= ~mask; + + if ((ERTS_TRACE_FLAGS(port) & TRACEE_FLAGS) == 0) { + tracer = erts_tracer_nil; + erts_tracer_replace(common, erts_tracer_nil); + } else if (!ERTS_TRACER_IS_NIL(tracer)) + erts_tracer_replace(common, tracer); + + return 0; +} + +Eterm erts_internal_trace_3(BIF_ALIST_3) { Process* p = BIF_P; Eterm pid_spec = BIF_ARG_1; Eterm how = BIF_ARG_2; Eterm list = BIF_ARG_3; int on; - Eterm tracer = NIL; + ErtsTracer tracer = erts_tracer_nil; int matches = 0; Uint mask = 0; int cpu_ts = 0; @@ -522,41 +530,24 @@ Eterm trace_3(BIF_ALIST_3) } if (!erts_try_seize_code_write_permission(BIF_P)) { - ERTS_BIF_YIELD3(bif_export[BIF_trace_3], BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + ERTS_BIF_YIELD3(bif_export[BIF_erts_internal_trace_3], + BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); } - if (is_nil(tracer) || is_internal_pid(tracer)) { - Process *tracer_proc = erts_pid2proc(p, - ERTS_PROC_LOCK_MAIN, - is_nil(tracer) ? p->common.id : tracer, - ERTS_PROC_LOCKS_ALL); - if (!tracer_proc) - goto error; - ERTS_TRACE_FLAGS(tracer_proc) |= F_TRACER; - erts_smp_proc_unlock(tracer_proc, - (tracer_proc == p - ? ERTS_PROC_LOCKS_ALL_MINOR - : ERTS_PROC_LOCKS_ALL)); - } else if (is_internal_port(tracer)) { - Port *tracer_port = erts_id2port_sflgs(tracer, - p, - ERTS_PROC_LOCK_MAIN, - ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP); - if (!tracer_port) - goto error; - ERTS_TRACE_FLAGS(tracer_port) |= F_TRACER; - erts_port_release(tracer_port); - } else - goto error; - switch (how) { case am_false: on = 0; break; case am_true: on = 1; - if (is_nil(tracer)) - tracer = p->common.id; + if (ERTS_TRACER_IS_NIL(tracer)) + tracer = erts_term_to_tracer(am_tracer, p->common.id); + + if (tracer == THE_NON_VALUE) { + tracer = erts_tracer_nil; + goto error; + } + break; default: goto error; @@ -575,34 +566,20 @@ Eterm trace_3(BIF_ALIST_3) } #endif - if (pid_spec == tracer) - goto error; - tracee_port = erts_id2port_sflgs(pid_spec, p, ERTS_PROC_LOCK_MAIN, ERTS_PORT_SFLGS_INVALID_LOOKUP); + if (!tracee_port) goto error; - - if (tracer != NIL && port_already_traced(p, tracee_port, tracer)) { + + if (start_trace(p, tracer, &tracee_port->common, on, mask)) { erts_port_release(tracee_port); goto already_traced; - } - - if (on) - ERTS_TRACE_FLAGS(tracee_port) |= mask; - else - ERTS_TRACE_FLAGS(tracee_port) &= ~mask; - - if (!ERTS_TRACE_FLAGS(tracee_port)) - ERTS_TRACER_PROC(tracee_port) = NIL; - else if (tracer != NIL) - ERTS_TRACER_PROC(tracee_port) = tracer; - - erts_port_release(tracee_port); - - matches = 1; + } + erts_port_release(tracee_port); + matches = 1; } else if (is_pid(pid_spec)) { Process *tracee_p; @@ -615,33 +592,19 @@ Eterm trace_3(BIF_ALIST_3) * and not about to be tracing. */ - if (pid_spec == tracer) - goto error; - tracee_p = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, pid_spec, ERTS_PROC_LOCKS_ALL); if (!tracee_p) goto error; - if (tracer != NIL && already_traced(p, tracee_p, tracer)) { + if (start_trace(tracee_p, tracer, &tracee_p->common, on, mask)) { erts_smp_proc_unlock(tracee_p, (tracee_p == p ? ERTS_PROC_LOCKS_ALL_MINOR : ERTS_PROC_LOCKS_ALL)); goto already_traced; - } - - if (on) - ERTS_TRACE_FLAGS(tracee_p) |= mask; - else - ERTS_TRACE_FLAGS(tracee_p) &= ~mask; - - if ((ERTS_TRACE_FLAGS(tracee_p) & TRACEE_FLAGS) == 0) - ERTS_TRACER_PROC(tracee_p) = NIL; - else if (tracer != NIL) - ERTS_TRACER_PROC(tracee_p) = tracer; - - erts_smp_proc_unlock(tracee_p, + } + erts_smp_proc_unlock(tracee_p, (tracee_p == p ? ERTS_PROC_LOCKS_ALL_MINOR : ERTS_PROC_LOCKS_ALL)); @@ -692,18 +655,27 @@ Eterm trace_3(BIF_ALIST_3) } #endif - if (pid_spec == am_all || pid_spec == am_existing) { + if (pid_spec == am_all || pid_spec == am_existing || + pid_spec == am_ports || pid_spec == am_processes || + pid_spec == am_existing_ports || pid_spec == am_existing_processes + ) { int i; int procs = 0; int ports = 0; int mods = 0; if (mask & (ERTS_PROC_TRACEE_FLAGS & ~ERTS_TRACEE_MODIFIER_FLAGS)) - procs = 1; + procs = pid_spec != am_ports && pid_spec != am_existing_ports; if (mask & (ERTS_PORT_TRACEE_FLAGS & ~ERTS_TRACEE_MODIFIER_FLAGS)) - ports = 1; - if (mask & ERTS_TRACEE_MODIFIER_FLAGS) - mods = 1; + ports = pid_spec != am_processes && pid_spec != am_existing_processes; + if (mask & ERTS_TRACEE_MODIFIER_FLAGS) { + if (pid_spec == am_ports || pid_spec == am_existing_ports) + ports = 1; + else if (pid_spec == am_processes || pid_spec == am_existing_processes) + procs = 1; + else + mods = 1; + } #ifdef ERTS_SMP erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); @@ -719,22 +691,7 @@ Eterm trace_3(BIF_ALIST_3) Process* tracee_p = erts_pix2proc(i); if (! tracee_p) continue; - if (tracer != NIL) { - if (tracee_p->common.id == tracer) - continue; - if (already_traced(NULL, tracee_p, tracer)) - continue; - } - if (on) { - ERTS_TRACE_FLAGS(tracee_p) |= mask; - } else { - ERTS_TRACE_FLAGS(tracee_p) &= ~mask; - } - if(!(ERTS_TRACE_FLAGS(tracee_p) & TRACEE_FLAGS)) { - ERTS_TRACER_PROC(tracee_p) = NIL; - } else if (tracer != NIL) { - ERTS_TRACER_PROC(tracee_p) = tracer; - } + start_trace(p, tracer, &tracee_p->common, on, mask); matches++; } } @@ -749,33 +706,26 @@ Eterm trace_3(BIF_ALIST_3) state = erts_atomic32_read_nob(&tracee_port->state); if (state & ERTS_PORT_SFLGS_DEAD) continue; - if (tracer != NIL) { - if (tracee_port->common.id == tracer) - continue; - if (port_already_traced(NULL, tracee_port, tracer)) - continue; - } - - if (on) ERTS_TRACE_FLAGS(tracee_port) |= mask; - else ERTS_TRACE_FLAGS(tracee_port) &= ~mask; - - if (!(ERTS_TRACE_FLAGS(tracee_port) & TRACEE_FLAGS)) { - ERTS_TRACER_PROC(tracee_port) = NIL; - } else if (tracer != NIL) { - ERTS_TRACER_PROC(tracee_port) = tracer; - } - /* matches are not counted for ports since it would violate compatibility */ - /* This could be a reason to modify this function or make a new one. */ + start_trace(p, tracer, &tracee_port->common, on, mask); + matches++; } } } - if (pid_spec == am_all || pid_spec == am_new) { - Uint def_flags = mask; - Eterm def_tracer = tracer; + if (pid_spec == am_all || pid_spec == am_new + || pid_spec == am_ports || pid_spec == am_processes + || pid_spec == am_new_ports || pid_spec == am_new_processes + ) { ok = 1; - erts_change_default_tracing(on, &def_flags, &def_tracer); + if (mask & ERTS_PROC_TRACEE_FLAGS && + pid_spec != am_ports && pid_spec != am_new_ports) + erts_change_default_proc_tracing( + on, mask & ERTS_PROC_TRACEE_FLAGS, tracer); + if (mask & ERTS_PORT_TRACEE_FLAGS && + pid_spec != am_processes && pid_spec != am_new_processes) + erts_change_default_port_tracing( + on, mask & ERTS_PORT_TRACEE_FLAGS, tracer); #ifdef HAVE_ERTS_NOW_CPU if (cpu_ts && !on) { @@ -801,6 +751,7 @@ Eterm trace_3(BIF_ALIST_3) } #endif erts_release_code_write_permission(); + ERTS_TRACER_CLEAR(&tracer); BIF_RET(make_small(matches)); @@ -810,6 +761,8 @@ Eterm trace_3(BIF_ALIST_3) error: + ERTS_TRACER_CLEAR(&tracer); + #ifdef ERTS_SMP if (system_blocked) { erts_smp_thr_progress_unblock(); @@ -821,88 +774,6 @@ Eterm trace_3(BIF_ALIST_3) BIF_ERROR(p, BADARG); } -/* Check that the process to be traced is not already traced - * by a valid other tracer than the tracer to be. - */ -static int port_already_traced(Process *c_p, Port *tracee_port, Eterm tracer) -{ - /* - * SMP build assumes that either system is blocked or: - * * main lock is held on c_p - * * all locks are held on port tracee_p - */ - if ((ERTS_TRACE_FLAGS(tracee_port) & TRACEE_FLAGS) - && ERTS_TRACER_PROC(tracee_port) != tracer) { - /* This tracee is already being traced, and not by the - * tracer to be */ - if (is_internal_port(ERTS_TRACER_PROC(tracee_port))) { - if (!erts_is_valid_tracer_port(ERTS_TRACER_PROC(tracee_port))) { - /* Current trace port now invalid - * - discard it and approve the new. */ - goto remove_tracer; - } else - return 1; - } - else if(is_internal_pid(ERTS_TRACER_PROC(tracee_port))) { - Process *tracer_p = erts_proc_lookup(ERTS_TRACER_PROC(tracee_port)); - if (!tracer_p) { - /* Current trace process now invalid - * - discard it and approve the new. */ - goto remove_tracer; - } else - return 1; - } - else { - remove_tracer: - ERTS_TRACE_FLAGS(tracee_port) &= ~TRACEE_FLAGS; - ERTS_TRACER_PROC(tracee_port) = NIL; - } - } - return 0; -} - -/* Check that the process to be traced is not already traced - * by a valid other tracer than the tracer to be. - */ -static int already_traced(Process *c_p, Process *tracee_p, Eterm tracer) -{ - /* - * SMP build assumes that either system is blocked or: - * * main lock is held on c_p - * * all locks multiple are held on tracee_p - */ - if ((ERTS_TRACE_FLAGS(tracee_p) & TRACEE_FLAGS) - && ERTS_TRACER_PROC(tracee_p) != tracer) { - /* This tracee is already being traced, and not by the - * tracer to be */ - if (is_internal_port(ERTS_TRACER_PROC(tracee_p))) { - if (!erts_is_valid_tracer_port(ERTS_TRACER_PROC(tracee_p))) { - /* Current trace port now invalid - * - discard it and approve the new. */ - goto remove_tracer; - } else - return 1; - } - else if(is_internal_pid(ERTS_TRACER_PROC(tracee_p))) { - Process *tracer_p; - - tracer_p = erts_proc_lookup(ERTS_TRACER_PROC(tracee_p)); - if (!tracer_p) { - /* Current trace process now invalid - * - discard it and approve the new. */ - goto remove_tracer; - } else - return 1; - } - else { - remove_tracer: - ERTS_TRACE_FLAGS(tracee_p) &= ~TRACEE_FLAGS; - ERTS_TRACER_PROC(tracee_p) = NIL; - } - } - return 0; -} - /* * Return information about a process or an external function being traced. */ @@ -920,7 +791,7 @@ Eterm trace_info_2(BIF_ALIST_2) if (What == am_on_load) { res = trace_info_on_load(p, Key); - } else if (is_atom(What) || is_pid(What)) { + } else if (is_atom(What) || is_pid(What) || is_port(What)) { res = trace_info_pid(p, What, Key); } else if (is_tuple(What)) { res = trace_info_func(p, What, Key); @@ -936,41 +807,52 @@ static Eterm trace_info_pid(Process* p, Eterm pid_spec, Eterm key) { Eterm tracer; - Uint trace_flags; + Uint trace_flags = am_false; Eterm* hp; - if (pid_spec == am_new) { - erts_get_default_tracing(&trace_flags, &tracer); + if (pid_spec == am_new || pid_spec == am_new_processes) { + ErtsTracer def_tracer; + erts_get_default_proc_tracing(&trace_flags, &def_tracer); + tracer = erts_tracer_to_term(p, def_tracer); + ERTS_TRACER_CLEAR(&def_tracer); + } else if (pid_spec == am_new_ports) { + ErtsTracer def_tracer; + erts_get_default_port_tracing(&trace_flags, &def_tracer); + tracer = erts_tracer_to_term(p, def_tracer); + ERTS_TRACER_CLEAR(&def_tracer); + } else if (is_internal_port(pid_spec)) { + Port *tracee; + tracee = erts_id2port_sflgs(pid_spec, p, ERTS_PROC_LOCK_MAIN, + ERTS_PORT_SFLGS_INVALID_LOOKUP); + + if (!tracee) + return am_undefined; + + if (!ERTS_TRACER_IS_NIL(ERTS_TRACER(tracee))) + erts_is_tracer_proc_enabled(NULL, 0, &tracee->common, am_trace_status); + + tracer = erts_tracer_to_term(p, ERTS_TRACER(tracee)); + trace_flags = ERTS_TRACE_FLAGS(tracee); + + erts_port_release(tracee); + } else if (is_internal_pid(pid_spec)) { Process *tracee; tracee = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, - pid_spec, ERTS_PROC_LOCKS_ALL); + pid_spec, ERTS_PROC_LOCK_MAIN); - if (!tracee) { + if (!tracee) return am_undefined; - } else { - tracer = ERTS_TRACER_PROC(tracee); - trace_flags = ERTS_TRACE_FLAGS(tracee); - } - if (is_internal_pid(tracer)) { - if (!erts_proc_lookup(tracer)) { - reset_tracer: - ERTS_TRACE_FLAGS(tracee) &= ~TRACEE_FLAGS; - trace_flags = ERTS_TRACE_FLAGS(tracee); - tracer = ERTS_TRACER_PROC(tracee) = NIL; - } - } - else if (is_internal_port(tracer)) { - if (!erts_is_valid_tracer_port(tracer)) - goto reset_tracer; - } -#ifdef ERTS_SMP - erts_smp_proc_unlock(tracee, - (tracee == p - ? ERTS_PROC_LOCKS_ALL_MINOR - : ERTS_PROC_LOCKS_ALL)); -#endif + if (!ERTS_TRACER_IS_NIL(ERTS_TRACER(tracee))) + erts_is_tracer_proc_enabled(tracee, ERTS_PROC_LOCK_MAIN, + &tracee->common, am_trace_status); + + tracer = erts_tracer_to_term(p, ERTS_TRACER(tracee)); + trace_flags = ERTS_TRACE_FLAGS(tracee); + + if (tracee != p) + erts_smp_proc_unlock(tracee, ERTS_PROC_LOCK_MAIN); } else if (is_external_pid(pid_spec) && external_pid_dist_entry(pid_spec) == erts_this_dist_entry) { return am_undefined; @@ -1024,8 +906,10 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key) HRelease(p,limit,hp+3); return TUPLE2(hp, key, flag_list); } else if (key == am_tracer) { - hp = HAlloc(p, 3); - return TUPLE2(hp, key, tracer); /* Local pid or port */ + if (tracer == am_false) + tracer = NIL; + hp = HAlloc(p, 3); + return TUPLE2(hp, key, tracer); } else { goto error; } @@ -1054,11 +938,11 @@ trace_info_pid(Process* p, Eterm pid_spec, Eterm key) */ static int function_is_traced(Process *p, Eterm mfa[3], - Binary **ms, /* out */ - Binary **ms_meta, /* out */ - Eterm *tracer_pid_meta, /* out */ - Uint *count, /* out */ - Eterm *call_time) /* out */ + Binary **ms, /* out */ + Binary **ms_meta, /* out */ + ErtsTracer *tracer_pid_meta, /* out */ + Uint *count, /* out */ + Eterm *call_time) /* out */ { Export e; Export* ep; @@ -1123,7 +1007,7 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) Eterm traced = am_false; Eterm match_spec = am_false; Eterm retval = am_false; - Eterm meta = am_false; + ErtsTracer meta = erts_tracer_nil; Eterm call_time = NIL; int r; @@ -1193,7 +1077,10 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) retval = match_spec; break; case am_meta: - retval = meta; + retval = erts_tracer_to_term(p, meta); + if (retval == am_false) + /* backwards compatibility */ + retval = NIL; break; case am_meta_match_spec: if (r & FUNC_TRACE_META_TRACE) { @@ -1216,7 +1103,8 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) } break; case am_all: { - Eterm match_spec_meta = am_false, c = am_false, t, ct = am_false; + Eterm match_spec_meta = am_false, c = am_false, t, ct = am_false, + m = am_false; if (ms) { match_spec = MatchSetGetSource(ms); @@ -1235,6 +1123,9 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) if (r & FUNC_TRACE_TIME_TRACE) { ct = call_time; } + + m = erts_tracer_to_term(p, meta); + hp = HAlloc(p, (3+2)*6); retval = NIL; t = TUPLE2(hp, am_call_count, c); hp += 3; @@ -1243,7 +1134,7 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) retval = CONS(hp, t, retval); hp += 2; t = TUPLE2(hp, am_meta_match_spec, match_spec_meta); hp += 3; retval = CONS(hp, t, retval); hp += 2; - t = TUPLE2(hp, am_meta, meta); hp += 3; + t = TUPLE2(hp, am_meta, m); hp += 3; retval = CONS(hp, t, retval); hp += 2; t = TUPLE2(hp, am_match_spec, match_spec); hp += 3; retval = CONS(hp, t, retval); hp += 2; @@ -1306,7 +1197,8 @@ trace_info_on_load(Process* p, Eterm key) case am_meta: hp = HAlloc(p, 3); if (erts_default_trace_pattern_flags.meta) { - return TUPLE2(hp, key, erts_default_meta_tracer_pid); + ASSERT(!ERTS_TRACER_IS_NIL(erts_default_meta_tracer)); + return TUPLE2(hp, key, erts_tracer_to_term(p, erts_default_meta_tracer)); } else { return TUPLE2(hp, key, am_false); } @@ -1345,7 +1237,7 @@ trace_info_on_load(Process* p, Eterm key) } case am_all: { - Eterm match_spec = am_false, meta_match_spec = am_false, r = NIL, t; + Eterm match_spec = am_false, meta_match_spec = am_false, r = NIL, t, m; if (erts_default_trace_pattern_flags.local || (! erts_default_trace_pattern_flags.breakpoint)) { @@ -1363,6 +1255,8 @@ trace_info_on_load(Process* p, Eterm key) MatchSetGetSource(erts_default_meta_match_spec); meta_match_spec = copy_object(meta_match_spec, p); } + m = (erts_default_trace_pattern_flags.meta + ? erts_tracer_to_term(p, erts_default_meta_tracer) : am_false); hp = HAlloc(p, (3+2)*5 + 3); t = TUPLE2(hp, am_call_count, (erts_default_trace_pattern_flags.call_count @@ -1370,9 +1264,7 @@ trace_info_on_load(Process* p, Eterm key) r = CONS(hp, t, r); hp += 2; t = TUPLE2(hp, am_meta_match_spec, meta_match_spec); hp += 3; r = CONS(hp, t, r); hp += 2; - t = TUPLE2(hp, am_meta, - (erts_default_trace_pattern_flags.meta - ? erts_default_meta_tracer_pid : am_false)); hp += 3; + t = TUPLE2(hp, am_meta, m); hp += 3; r = CONS(hp, t, r); hp += 2; t = TUPLE2(hp, am_match_spec, match_spec); hp += 3; r = CONS(hp, t, r); hp += 2; @@ -1397,7 +1289,7 @@ int erts_set_trace_pattern(Process*p, Eterm* mfa, int specified, Binary* match_prog_set, Binary *meta_match_prog_set, int on, struct trace_pattern_flags flags, - Eterm meta_tracer_pid, int is_blocking) + ErtsTracer meta_tracer, int is_blocking) { const ErtsCodeIndex code_ix = erts_active_code_ix(); int matches = 0; @@ -1487,7 +1379,7 @@ erts_set_trace_pattern(Process*p, Eterm* mfa, int specified, } if (flags.meta) { erts_set_mtrace_bif(pc, meta_match_prog_set, - meta_tracer_pid); + meta_tracer); m = 1; } if (flags.call_time) { @@ -1527,7 +1419,7 @@ erts_set_trace_pattern(Process*p, Eterm* mfa, int specified, } if (flags.meta) { erts_set_mtrace_break(&finish_bp.f, meta_match_prog_set, - meta_tracer_pid); + meta_tracer); } if (flags.call_count) { erts_set_count_break(&finish_bp.f, on); @@ -2336,50 +2228,86 @@ BIF_RETTYPE system_profile_2(BIF_ALIST_2) } /* End: Trace for System Profiling */ -BIF_RETTYPE -trace_delivered_1(BIF_ALIST_1) +/* Trace delivered send an aux work message to all schedulers + and when all schedulers have acknowledged that they have seen + the message the message is sent to the requesting process. + + IMPORTANT: We have to make sure that the all messages sent + using enif_send have been delivered before we send the message + to the caller. + + There used to be a separate implementation for when only a pid + is passed in, but since this is not performance critical code + we now use the same approach for both. +*/ + +typedef struct { + Process *proc; + Eterm ref; + Eterm ref_heap[REF_THING_SIZE]; + Eterm target; + erts_smp_atomic32_t refc; +} ErtsTraceDeliveredAll; + +static void +reply_trace_delivered_all(void *vtdarp) { - DECL_AM(trace_delivered); -#ifdef ERTS_SMP - ErlHeapFragment *bp; -#else - ErtsProcLocks locks = 0; -#endif - Eterm *hp; - Eterm msg, ref, msg_ref; - Process *p; - if (BIF_ARG_1 == am_all) { - p = NULL; - } else if (! (p = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, - BIF_ARG_1, ERTS_PROC_LOCKS_ALL))) { - if (is_not_internal_pid(BIF_ARG_1)) { - BIF_ERROR(BIF_P, BADARG); - } - } - - ref = erts_make_ref(BIF_P); + ErtsTraceDeliveredAll *tdarp = (ErtsTraceDeliveredAll *) vtdarp; + if (erts_smp_atomic32_dec_read_nob(&tdarp->refc) == 0) { + Eterm ref_copy, msg; + Process *rp = tdarp->proc; + Eterm *hp = NULL; + ErlOffHeap *ohp; #ifdef ERTS_SMP - bp = new_message_buffer(REF_THING_SIZE + 4); - hp = &bp->mem[0]; - msg_ref = STORE_NC(&hp, &bp->off_heap, ref); + ErlHeapFragment *bp; + bp = new_message_buffer(4 + NC_HEAP_SIZE(tdarp->ref)); + hp = &bp->mem[0]; + ohp = &bp->off_heap; #else - hp = HAlloc(BIF_P, 4); - msg_ref = ref; + ErtsProcLocks rp_locks = 0; + ErtsMessage *mp; + mp = erts_alloc_message_heap( + rp, &rp_locks, 4 + NC_HEAP_SIZE(tdarp->ref), &hp, &ohp); #endif - msg = TUPLE3(hp, AM_trace_delivered, BIF_ARG_1, msg_ref); + ref_copy = STORE_NC(&hp, ohp, tdarp->ref); + msg = TUPLE3(hp, am_trace_delivered, tdarp->target, ref_copy); #ifdef ERTS_SMP - erts_send_sys_msg_proc(BIF_P->common.id, BIF_P->common.id, msg, bp); - if (p) - erts_smp_proc_unlock(p, - (BIF_P == p - ? ERTS_PROC_LOCKS_ALL_MINOR - : ERTS_PROC_LOCKS_ALL)); + erts_send_sys_msg_proc(rp->common.id, rp->common.id, msg, bp); #else - erts_send_message(BIF_P, BIF_P, &locks, msg, ERTS_SND_FLG_NO_SEQ_TRACE); + erts_queue_message(rp, &rp_locks, mp, msg); #endif - BIF_RET(ref); + erts_free(ERTS_ALC_T_MISC_AUX_WORK, vtdarp); + erts_proc_dec_refc(rp); + } +} + +BIF_RETTYPE +trace_delivered_1(BIF_ALIST_1) +{ + + if (BIF_ARG_1 == am_all || is_internal_pid(BIF_ARG_1)) { + Eterm *hp, ref; + ErtsTraceDeliveredAll *tdarp = + erts_alloc(ERTS_ALC_T_MISC_AUX_WORK, sizeof(ErtsTraceDeliveredAll)); + + tdarp->proc = BIF_P; + ref = erts_make_ref(BIF_P); + hp = &tdarp->ref_heap[0]; + tdarp->ref = STORE_NC(&hp, NULL, ref); + tdarp->target = BIF_ARG_1; + erts_smp_atomic32_init_nob(&tdarp->refc, + (erts_aint32_t) erts_no_schedulers); + erts_proc_add_refc(BIF_P, 1); + erts_schedule_multi_misc_aux_work(0, + erts_no_schedulers, + reply_trace_delivered_all, + (void *) tdarp); + BIF_RET(ref); + } else { + BIF_ERROR(BIF_P, BADARG); + } } diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index be14386b14..76b96637ae 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -135,21 +135,22 @@ get_proc(Process *cp, Uint32 cp_locks, Eterm id, Uint32 id_locks) static Eterm -set_tracee_flags(Process *tracee_p, Eterm tracer, Uint d_flags, Uint e_flags) { +set_tracee_flags(Process *tracee_p, ErtsTracer tracer, + Uint d_flags, Uint e_flags) { Eterm ret; Uint flags; - if (tracer == NIL) { + if (ERTS_TRACER_IS_NIL(tracer)) { flags = ERTS_TRACE_FLAGS(tracee_p) & ~TRACEE_FLAGS; } else { flags = ((ERTS_TRACE_FLAGS(tracee_p) & ~d_flags) | e_flags); - if (! flags) tracer = NIL; + if (! flags) tracer = erts_tracer_nil; } - ret = ((ERTS_TRACER_PROC(tracee_p) != tracer + ret = ((!ERTS_TRACER_COMPARE(ERTS_TRACER(tracee_p),tracer) || ERTS_TRACE_FLAGS(tracee_p) != flags) ? am_true : am_false); - ERTS_TRACER_PROC(tracee_p) = tracer; + erts_tracer_replace(&tracee_p->common, tracer); ERTS_TRACE_FLAGS(tracee_p) = flags; return ret; } @@ -163,40 +164,16 @@ set_tracee_flags(Process *tracee_p, Eterm tracer, Uint d_flags, Uint e_flags) { ** returns fail_term on failure. Fails if tracer pid or port is invalid. */ static Eterm -set_match_trace(Process *tracee_p, Eterm fail_term, Eterm tracer, +set_match_trace(Process *tracee_p, Eterm fail_term, ErtsTracer tracer, Uint d_flags, Uint e_flags) { - Eterm ret = fail_term; - Process *tracer_p; - - ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCKS_ALL == - erts_proc_lc_my_proc_locks(tracee_p)); - - if (is_internal_pid(tracer) - && (tracer_p = - erts_pid2proc(tracee_p, ERTS_PROC_LOCKS_ALL, - tracer, ERTS_PROC_LOCKS_ALL))) { - if (tracee_p != tracer_p) { - ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags); - ERTS_TRACE_FLAGS(tracer_p) |= (ERTS_TRACE_FLAGS(tracee_p) - ? F_TRACER - : 0); - erts_smp_proc_unlock(tracer_p, ERTS_PROC_LOCKS_ALL); - } - } else if (is_internal_port(tracer)) { - Port *tracer_port = - erts_id2port_sflgs(tracer, - tracee_p, - ERTS_PROC_LOCKS_ALL, - ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP); - if (tracer_port) { - ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags); - erts_port_release(tracer_port); - } - } else { - ASSERT(is_nil(tracer)); - ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags); - } - return ret; + + ERTS_SMP_LC_ASSERT( + ERTS_PROC_LOCKS_ALL == erts_proc_lc_my_proc_locks(tracee_p) + || erts_thr_progress_is_blocking()); + + if (ERTS_TRACER_IS_NIL(tracer) || erts_is_tracer_enabled(tracee_p, tracer)) + return set_tracee_flags(tracee_p, tracer, d_flags, e_flags); + return fail_term; } /* @@ -2358,7 +2335,7 @@ restart: case matchEnableTrace: if ( (n = erts_trace_flag2bit(esp[-1]))) { BEGIN_ATOMIC_TRACE(c_p); - set_tracee_flags(c_p, ERTS_TRACER_PROC(c_p), 0, n); + set_tracee_flags(c_p, ERTS_TRACER(c_p), 0, n); esp[-1] = am_true; } else { esp[-1] = FAIL_TERM; @@ -2371,7 +2348,7 @@ restart: BEGIN_ATOMIC_TRACE(c_p); if ( (tmpp = get_proc(c_p, 0, esp[0], 0))) { /* Always take over the tracer of the current process */ - set_tracee_flags(tmpp, ERTS_TRACER_PROC(c_p), 0, n); + set_tracee_flags(tmpp, ERTS_TRACER(c_p), 0, n); esp[-1] = am_true; } } @@ -2379,7 +2356,7 @@ restart: case matchDisableTrace: if ( (n = erts_trace_flag2bit(esp[-1]))) { BEGIN_ATOMIC_TRACE(c_p); - set_tracee_flags(c_p, ERTS_TRACER_PROC(c_p), n, 0); + set_tracee_flags(c_p, ERTS_TRACER(c_p), n, 0); esp[-1] = am_true; } else { esp[-1] = FAIL_TERM; @@ -2392,7 +2369,7 @@ restart: BEGIN_ATOMIC_TRACE(c_p); if ( (tmpp = get_proc(c_p, 0, esp[0], 0))) { /* Always take over the tracer of the current process */ - set_tracee_flags(tmpp, ERTS_TRACER_PROC(c_p), n, 0); + set_tracee_flags(tmpp, ERTS_TRACER(c_p), n, 0); esp[-1] = am_true; } } @@ -2428,7 +2405,7 @@ restart: { /* disable enable */ Uint d_flags = 0, e_flags = 0; /* process trace flags */ - Eterm tracer = ERTS_TRACER_PROC(c_p); + ErtsTracer tracer = erts_tracer_nil; /* XXX Atomicity note: Not fully atomic. Default tracer * is sampled from current process but applied to * tracee and tracer later after releasing main @@ -2440,29 +2417,34 @@ restart: * {trace,[],[{{tracer,Tracer}}]} is much, much older. */ int cputs = 0; + erts_tracer_update(&tracer, ERTS_TRACER(c_p)); if (! erts_trace_flags(esp[-1], &d_flags, &tracer, &cputs) || ! erts_trace_flags(esp[-2], &e_flags, &tracer, &cputs) || cputs ) { (--esp)[-1] = FAIL_TERM; + ERTS_TRACER_CLEAR(&tracer); break; } erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); (--esp)[-1] = set_match_trace(c_p, FAIL_TERM, tracer, d_flags, e_flags); erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + ERTS_TRACER_CLEAR(&tracer); } break; case matchTrace3: { /* disable enable */ Uint d_flags = 0, e_flags = 0; /* process trace flags */ - Eterm tracer = ERTS_TRACER_PROC(c_p); + ErtsTracer tracer = erts_tracer_nil; /* XXX Atomicity note. Not fully atomic. See above. * Above it could possibly be solved, but not here. */ int cputs = 0; Eterm tracee = (--esp)[0]; + + erts_tracer_update(&tracer, ERTS_TRACER(c_p)); if (! erts_trace_flags(esp[-1], &d_flags, &tracer, &cputs) || ! erts_trace_flags(esp[-2], &e_flags, &tracer, &cputs) || @@ -2470,6 +2452,7 @@ restart: ! (tmpp = get_proc(c_p, ERTS_PROC_LOCK_MAIN, tracee, ERTS_PROC_LOCKS_ALL))) { (--esp)[-1] = FAIL_TERM; + ERTS_TRACER_CLEAR(&tracer); break; } if (tmpp == c_p) { @@ -2483,6 +2466,7 @@ restart: erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL); erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); } + ERTS_TRACER_CLEAR(&tracer); } break; case matchCatch: /* Match success, now build result */ @@ -5084,7 +5068,7 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace) lint_res = db_match_set_lint(p, spec, DCOMP_TABLE | DCOMP_FAKE_DESTRUCTIVE); mps = db_match_set_compile(p, spec, DCOMP_TABLE | DCOMP_FAKE_DESTRUCTIVE); } - + if (mps == NULL) { hp = HAlloc(p,3); ret = TUPLE2(hp, am_error, lint_res); diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 62417fa05c..df5d0f4918 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -593,10 +593,6 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, esdp = erts_get_scheduler_data(); - if (IS_TRACED_FL(p, F_TRACE_GC)) { - trace_gc(p, am_gc_start); - } - erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); if (erts_system_monitor_long_gc != 0) start_time = erts_get_monotonic_time(esdp); @@ -619,18 +615,29 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, */ if (GEN_GCS(p) < MAX_GEN_GCS(p) && !(FLAGS(p) & F_NEED_FULLSWEEP)) { - DTRACE2(gc_minor_start, pidbuf, need); - reds = minor_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); - DTRACE2(gc_minor_end, pidbuf, reclaimed_now); - if (reds < 0) - goto do_major_collection; - } - else { - do_major_collection: + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_minor_start, need); + } + DTRACE2(gc_minor_start, pidbuf, need); + reds = minor_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); + DTRACE2(gc_minor_end, pidbuf, reclaimed_now); + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_minor_end, reclaimed_now); + } + if (reds < 0) + goto do_major_collection; + } else { +do_major_collection: ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC_FULL); - DTRACE2(gc_major_start, pidbuf, need); - reds = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); - DTRACE2(gc_major_end, pidbuf, reclaimed_now); + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_major_start, need); + } + DTRACE2(gc_major_start, pidbuf, need); + reds = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); + DTRACE2(gc_major_end, pidbuf, reclaimed_now); + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_major_end, reclaimed_now); + } ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC); } @@ -646,10 +653,6 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC); - if (IS_TRACED_FL(p, F_TRACE_GC)) { - trace_gc(p, am_gc_end); - } - if (erts_system_monitor_long_gc != 0) { ErtsMonotonicTime end_time; Uint gc_time; @@ -2053,8 +2056,26 @@ copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap, *hp++ = val; break; case TAG_PRIMARY_LIST: +#ifdef SHCOPY_SEND + if (erts_is_literal(val,list_val(val))) { + *hp++ = val; + } else { + *hp++ = offset_ptr(val, offs); + } +#else + *hp++ = offset_ptr(val, offs); +#endif + break; case TAG_PRIMARY_BOXED: - *hp++ = offset_ptr(val, offs); +#ifdef SHCOPY_SEND + if (erts_is_literal(val,boxed_val(val))) { + *hp++ = val; + } else { + *hp++ = offset_ptr(val, offs); + } +#else + *hp++ = offset_ptr(val, offs); +#endif break; case TAG_PRIMARY_HEADER: *hp++ = val; @@ -2233,9 +2254,7 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) n++; } #endif - ASSERT(is_nil(ERTS_TRACER_PROC(p)) || - is_internal_pid(ERTS_TRACER_PROC(p)) || - is_internal_port(ERTS_TRACER_PROC(p))); + ASSERT(IS_TRACER_VALID(ERTS_TRACER(p))); ASSERT(is_pid(follow_moved(p->group_leader, (Eterm) 0))); if (is_not_immed(p->group_leader)) { @@ -2905,7 +2924,7 @@ reply_gc_info(void *vgcirp) hpp = &hp; } - erts_queue_message(rp, &rp_locks, mp, msg, NIL); + erts_queue_message(rp, &rp_locks, mp, msg); if (gcirp->req_sched == esdp->no) rp_locks &= ~ERTS_PROC_LOCK_MAIN; diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c index 1a621863bb..8e201d5711 100644 --- a/erts/emulator/beam/erl_hl_timer.c +++ b/erts/emulator/beam/erl_hl_timer.c @@ -1248,7 +1248,7 @@ hlt_bif_timer_timeout(ErtsHLTimer *tmr, Uint32 roflgs) ErtsMessage *mp = erts_alloc_message(0, NULL); mp->data.heap_frag = tmr->btm.bp; erts_queue_message(proc, &proc_locks, mp, - tmr->btm.message, NIL); + tmr->btm.message); erts_smp_proc_unlock(proc, ERTS_PROC_LOCKS_MSG_SEND); queued_message = 1; proc_locks &= ~ERTS_PROC_LOCKS_MSG_SEND; @@ -1980,7 +1980,7 @@ access_sched_local_btm(Process *c_p, Eterm pid, ERTS_HLT_ASSERT(hp + (async ? 4 : 3) == hp_end); - erts_queue_message(proc, &proc_locks, mp, msg, NIL); + erts_queue_message(proc, &proc_locks, mp, msg); if (c_p) proc_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -2111,7 +2111,7 @@ try_access_sched_remote_btm(ErtsSchedulerData *esdp, msg = TUPLE3(hp, tag, tref, res); - erts_queue_message(c_p, &proc_locks, mp, msg, NIL); + erts_queue_message(c_p, &proc_locks, mp, msg); proc_locks &= ~ERTS_PROC_LOCK_MAIN; if (proc_locks) diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 9231fb1b34..39c0617143 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -97,6 +97,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "dist_entry_links", "address" }, { "code_write_permission", NULL }, { "proc_status", "pid" }, + { "proc_trace", "pid" }, { "ports_snapshot", NULL }, { "meta_name_tab", "address" }, { "meta_main_tab_slot", "address" }, @@ -148,6 +149,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "dist_entry_out_queue", "address" }, { "port_sched_lock", "port_id" }, { "sys_msg_q", NULL }, + { "tracer_mtx", NULL }, { "port_table", NULL }, #endif { "mtrace_op", NULL }, @@ -160,9 +162,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "proclist_pre_alloc_lock", "address" }, { "xports_list_pre_alloc_lock", "address" }, { "inet_buffer_stack_lock", NULL }, - { "gc_info", NULL }, - { "io_wake", NULL }, - { "timer_wheel", NULL }, { "system_block", NULL }, { "timeofday", NULL }, { "get_time", NULL }, diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index 03a96cb00a..8efc983f04 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -54,6 +54,7 @@ * - maps:new/0 * - maps:put/3 * - maps:remove/2 + * - maps:take/2 * - maps:to_list/1 * - maps:update/3 * - maps:values/1 @@ -93,7 +94,7 @@ static Uint hashmap_subtree_size(Eterm node); static Eterm hashmap_to_list(Process *p, Eterm map); static Eterm hashmap_keys(Process *p, Eterm map); static Eterm hashmap_values(Process *p, Eterm map); -static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm node); +static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm node, Eterm *value); static Eterm flatmap_from_validated_list(Process *p, Eterm list, Uint size); static Eterm hashmap_from_validated_list(Process *p, Eterm list, Uint size); static Eterm hashmap_from_unsorted_array(ErtsHeapFactory*, hxnode_t *hxns, Uint n, int reject_dupkeys); @@ -1521,10 +1522,45 @@ BIF_RETTYPE maps_put_3(BIF_ALIST_3) { BIF_ERROR(BIF_P, BADMAP); } -/* maps:remove/3 */ +/* maps:take/2 */ -int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { +BIF_RETTYPE maps_take_2(BIF_ALIST_2) { + if (is_map(BIF_ARG_2)) { + Eterm res, map, val; + if (erts_maps_take(BIF_P, BIF_ARG_1, BIF_ARG_2, &map, &val)) { + Eterm *hp = HAlloc(BIF_P, 3); + res = make_tuple(hp); + *hp++ = make_arityval(2); + *hp++ = val; + *hp++ = map; + BIF_RET(res); + } + BIF_RET(am_error); + } + BIF_P->fvalue = BIF_ARG_2; + BIF_ERROR(BIF_P, BADMAP); +} + +/* maps:remove/2 */ + +BIF_RETTYPE maps_remove_2(BIF_ALIST_2) { + if (is_map(BIF_ARG_2)) { + Eterm res; + (void) erts_maps_take(BIF_P, BIF_ARG_1, BIF_ARG_2, &res, NULL); + BIF_RET(res); + } + BIF_P->fvalue = BIF_ARG_2; + BIF_ERROR(BIF_P, BADMAP); +} + +/* erts_maps_take + * return 1 if key is found, otherwise 0 + * If the key is not found res (output map) will be map (input map) + */ +int erts_maps_take(Process *p, Eterm key, Eterm map, + Eterm *res, Eterm *value) { Uint32 hx; + Eterm ret; if (is_flatmap(map)) { Sint n; Uint need; @@ -1537,7 +1573,7 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { if (n == 0) { *res = map; - return 1; + return 0; } ks = flatmap_get_keys(mp); @@ -1564,6 +1600,7 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { if (is_immed(key)) { while (1) { if (*ks == key) { + if (value) *value = *vs; goto found_key; } else if (--n) { *mhp++ = *vs++; @@ -1574,6 +1611,7 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { } else { while(1) { if (EQ(*ks, key)) { + if (value) *value = *vs; goto found_key; } else if (--n) { *mhp++ = *vs++; @@ -1589,7 +1627,7 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { HRelease(p, hp_start + need, hp_start); *res = map; - return 1; + return 0; found_key: /* Copy rest of keys and values */ @@ -1601,19 +1639,13 @@ found_key: } ASSERT(is_hashmap(map)); hx = hashmap_make_hash(key); - *res = hashmap_delete(p, hx, key, map); - return 1; -} - -BIF_RETTYPE maps_remove_2(BIF_ALIST_2) { - if (is_map(BIF_ARG_2)) { - Eterm res; - if (erts_maps_remove(BIF_P, BIF_ARG_1, BIF_ARG_2, &res)) { - BIF_RET(res); - } + ret = hashmap_delete(p, hx, key, map, value); + if (is_value(ret)) { + *res = ret; + return 1; } - BIF_P->fvalue = BIF_ARG_2; - BIF_ERROR(BIF_P, BADMAP); + *res = map; + return 0; } int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res) { @@ -2322,7 +2354,8 @@ static Eterm hashmap_values(Process* p, Eterm node) { return res; } -static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) { +static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, + Eterm map, Eterm *value) { Eterm *hp = NULL, *nhp = NULL, *hp_end = NULL; Eterm *ptr; Eterm hdr, res = map, node = map; @@ -2337,8 +2370,12 @@ static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) { switch(primary_tag(node)) { case TAG_PRIMARY_LIST: if (EQ(CAR(list_val(node)), key)) { + if (value) { + *value = CDR(list_val(node)); + } goto unroll; } + res = THE_NON_VALUE; goto not_found; case TAG_PRIMARY_BOXED: ptr = boxed_val(node); @@ -2365,6 +2402,7 @@ static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) { n = hashmap_bitcount(hval); } else { /* not occupied */ + res = THE_NON_VALUE; goto not_found; } @@ -2394,6 +2432,7 @@ static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) { break; } /* not occupied */ + res = THE_NON_VALUE; goto not_found; default: erts_exit(ERTS_ERROR_EXIT, "bad header tag %ld\r\n", hdr & _HEADER_MAP_SUBTAG_MASK); diff --git a/erts/emulator/beam/erl_map.h b/erts/emulator/beam/erl_map.h index a40070d00d..8b5c9582ba 100644 --- a/erts/emulator/beam/erl_map.h +++ b/erts/emulator/beam/erl_map.h @@ -66,7 +66,7 @@ typedef struct flatmap_s { /* erl_term.h stuff */ -#define flatmap_get_values(x) (((Eterm *)(x)) + 3) +#define flatmap_get_values(x) (((Eterm *)(x)) + sizeof(flatmap_t)/sizeof(Eterm)) #define flatmap_get_keys(x) (((Eterm *)tuple_val(((flatmap_t *)(x))->keys)) + 1) #define flatmap_get_size(x) (((flatmap_t*)(x))->size) @@ -82,6 +82,7 @@ struct ErtsEStack_; Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map); int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res); int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res); +int erts_maps_take(Process *p, Eterm key, Eterm map, Eterm *res, Eterm *value); Eterm erts_hashmap_insert(Process *p, Uint32 hx, Eterm key, Eterm value, Eterm node, int is_update); diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 7596747b91..9beff52835 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -324,7 +324,7 @@ erts_queue_dist_message(Process *rcvr, tok_label, tok_lastcnt, tok_serial); } #endif - erts_queue_message(rcvr, rcvr_locks, mp, msg, token); + erts_queue_message(rcvr, rcvr_locks, mp, msg); } } else { @@ -349,7 +349,7 @@ erts_queue_dist_message(Process *rcvr, } #endif - LINK_MESSAGE(rcvr, mp); + LINK_MESSAGE(rcvr, mp, &mp->next, 1); if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ)) erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ); @@ -364,31 +364,34 @@ erts_queue_dist_message(Process *rcvr, } } -/* Add a message last in message queue */ +/* Add messages last in message queue */ static Sint -queue_message(Process *c_p, - Process* receiver, - erts_aint32_t *receiver_state, - ErtsProcLocks *receiver_locks, - ErtsMessage* mp, - Eterm message, - Eterm seq_trace_token -#ifdef USE_VM_PROBES - , Eterm dt_utag -#endif - ) +queue_messages(Process *c_p, + Process* receiver, + erts_aint32_t *receiver_state, + ErtsProcLocks *receiver_locks, + ErtsMessage* first, + ErtsMessage** last, + Uint len) { Sint res; int locked_msgq = 0; erts_aint32_t state; - ERTS_SMP_LC_ASSERT(*receiver_locks == erts_proc_lc_my_proc_locks(receiver)); + ASSERT(is_value(ERL_MESSAGE_TERM(first))); + ASSERT(ERL_MESSAGE_TOKEN(first) == am_undefined || + ERL_MESSAGE_TOKEN(first) == NIL || + is_tuple(ERL_MESSAGE_TOKEN(first))); #ifdef ERTS_SMP +#ifdef ERTS_ENABLE_LOCK_CHECK + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(receiver) < ERTS_PROC_LOCK_MSGQ || + *receiver_locks == erts_proc_lc_my_proc_locks(receiver)); +#endif if (!(*receiver_locks & ERTS_PROC_LOCK_MSGQ)) { if (erts_smp_proc_trylock(receiver, ERTS_PROC_LOCK_MSGQ) == EBUSY) { - ErtsProcLocks need_locks = ERTS_PROC_LOCK_MSGQ; + ErtsProcLocks need_locks = ERTS_PROC_LOCK_MSGQ; if (receiver_state) state = *receiver_state; @@ -417,16 +420,10 @@ queue_message(Process *c_p, /* Drop message if receiver is exiting or has a pending exit... */ if (locked_msgq) erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ); - erts_cleanup_messages(mp); + erts_cleanup_messages(first); return 0; } - ERL_MESSAGE_TERM(mp) = message; - ERL_MESSAGE_TOKEN(mp) = seq_trace_token; -#ifdef USE_VM_PROBES - ERL_MESSAGE_DT_UTAG(mp) = dt_utag; -#endif - res = receiver->msg.len; #ifdef ERTS_SMP if (*receiver_locks & ERTS_PROC_LOCK_MAIN) { @@ -440,75 +437,83 @@ queue_message(Process *c_p, */ res += receiver->msg_inq.len; ERTS_SMP_MSGQ_MV_INQ2PRIVQ(receiver); - LINK_MESSAGE_PRIVQ(receiver, mp); + LINK_MESSAGE_PRIVQ(receiver, first, last, len); } else #endif { - LINK_MESSAGE(receiver, mp); + LINK_MESSAGE(receiver, first, last, len); } + if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) { + ErtsMessage *msg = first; + #ifdef USE_VM_PROBES - if (DTRACE_ENABLED(message_queued)) { - DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); - Sint tok_label = 0; - Sint tok_lastcnt = 0; - Sint tok_serial = 0; - - dtrace_proc_str(receiver, receiver_name); - if (seq_trace_token != NIL && is_tuple(seq_trace_token)) { - tok_label = signed_val(SEQ_TRACE_T_LABEL(seq_trace_token)); - tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(seq_trace_token)); - tok_serial = signed_val(SEQ_TRACE_T_SERIAL(seq_trace_token)); + if (DTRACE_ENABLED(message_queued)) { + DTRACE_CHARBUF(receiver_name, DTRACE_TERM_BUF_SIZE); + Sint tok_label = 0; + Sint tok_lastcnt = 0; + Sint tok_serial = 0; + Eterm seq_trace_token = ERL_MESSAGE_TOKEN(msg); + + dtrace_proc_str(receiver, receiver_name); + if (seq_trace_token != NIL && is_tuple(seq_trace_token)) { + tok_label = signed_val(SEQ_TRACE_T_LABEL(seq_trace_token)); + tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(seq_trace_token)); + tok_serial = signed_val(SEQ_TRACE_T_SERIAL(seq_trace_token)); + } + DTRACE6(message_queued, + receiver_name, size_object(ERL_MESSAGE_TERM(msg)), + receiver->msg.len, + tok_label, tok_lastcnt, tok_serial); } - DTRACE6(message_queued, - receiver_name, size_object(message), receiver->msg.len, - tok_label, tok_lastcnt, tok_serial); - } #endif - if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) - trace_receive(receiver, message); + while (msg) { + trace_receive(receiver, ERL_MESSAGE_TERM(msg)); + msg = msg->next; + } + + } if (locked_msgq) erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ); - erts_proc_notify_new_message(receiver, #ifdef ERTS_SMP - *receiver_locks + erts_proc_notify_new_message(receiver, *receiver_locks); #else - 0 -#endif - ); - -#ifndef ERTS_SMP + erts_proc_notify_new_message(receiver, 0); ERTS_HOLE_CHECK(receiver); #endif return res; } -void -#ifdef USE_VM_PROBES -erts_queue_message_probe(Process* receiver, ErtsProcLocks *receiver_locks, - ErtsMessage* mp, - Eterm message, Eterm seq_trace_token, Eterm dt_utag) -#else +static Sint +queue_message(Process *c_p, + Process* receiver, + erts_aint32_t *receiver_state, + ErtsProcLocks *receiver_locks, + ErtsMessage* mp, Eterm msg) +{ + ERL_MESSAGE_TERM(mp) = msg; + return queue_messages(c_p, receiver, receiver_state, receiver_locks, + mp, &mp->next, 1 ); +} + +Sint erts_queue_message(Process* receiver, ErtsProcLocks *receiver_locks, - ErtsMessage* mp, - Eterm message, Eterm seq_trace_token) -#endif + ErtsMessage* mp, Eterm msg) { - queue_message(NULL, - receiver, - NULL, - receiver_locks, - mp, - message, - seq_trace_token -#ifdef USE_VM_PROBES - , dt_utag -#endif - ); + return queue_message(NULL, receiver, NULL, receiver_locks, mp, msg); +} + + +Sint +erts_queue_messages(Process* receiver, ErtsProcLocks *receiver_locks, + ErtsMessage* first, ErtsMessage** last, Uint len) +{ + return queue_messages(NULL, receiver, NULL, receiver_locks, + first, last, len); } void @@ -591,7 +596,7 @@ erts_try_alloc_message_on_heap(Process *pp, #if defined(ERTS_SMP) *plp & ERTS_PROC_LOCK_MAIN #else - 1 + pp #endif ) { #ifdef ERTS_SMP @@ -621,7 +626,7 @@ erts_try_alloc_message_on_heap(Process *pp, *on_heap_p = !0; } #ifdef ERTS_SMP - else if (erts_smp_proc_trylock(pp, ERTS_PROC_LOCK_MAIN) == 0) { + else if (pp && erts_smp_proc_trylock(pp, ERTS_PROC_LOCK_MAIN) == 0) { locked_main = 1; *psp = erts_smp_atomic32_read_nob(&pp->state); *plp |= ERTS_PROC_LOCK_MAIN; @@ -821,17 +826,15 @@ erts_send_message(Process* sender, #endif } + ERL_MESSAGE_TOKEN(mp) = token; +#ifdef USE_VM_PROBES + ERL_MESSAGE_DT_UTAG(mp) = utag; +#endif res = queue_message(sender, receiver, &receiver_state, receiver_locks, - mp, - message, - token -#ifdef USE_VM_PROBES - , utag -#endif - ); + mp, message); BM_SWAP_TIMER(send,system); @@ -887,7 +890,8 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, /* the trace token must in this case be updated by the caller */ seq_trace_output(token, save, SEQ_TRACE_SEND, to->common.id, NULL); temptoken = copy_struct(token, sz_token, &hp, ohp); - erts_queue_message(to, to_locksp, mp, save, temptoken); + ERL_MESSAGE_TOKEN(mp) = temptoken; + erts_queue_message(to, to_locksp, mp, save); } else { sz_from = IS_CONST(from) ? 0 : size_object(from); #ifdef SHCOPY_SEND @@ -909,7 +913,7 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, ? from : copy_struct(from, sz_from, &hp, ohp)); save = TUPLE3(hp, am_EXIT, from_copy, mess); - erts_queue_message(to, to_locksp, mp, save, NIL); + erts_queue_message(to, to_locksp, mp, save); } } @@ -1484,7 +1488,7 @@ erts_factory_message_create(ErtsHeapFactory* factory, int on_heap; erts_aint32_t state; - state = erts_smp_atomic32_read_nob(&proc->state); + state = proc ? erts_smp_atomic32_read_nob(&proc->state) : 0; if (state & ERTS_PSFLG_OFF_HEAP_MSGQ) { msgp = erts_alloc_message(sz, &hp); diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h index ad4e65274c..608cf552a2 100644 --- a/erts/emulator/beam/erl_message.h +++ b/erts/emulator/beam/erl_message.h @@ -182,48 +182,64 @@ typedef struct { Sint len; /* queue length */ } ErlMessageInQueue; +typedef struct erl_trace_message_queue__ { + struct erl_trace_message_queue__ *next; /* point to the next receiver */ + Eterm receiver; + ErtsMessage* first; + ErtsMessage** last; /* point to the last next pointer */ + Sint len; /* queue length */ +} ErlTraceMessageQueue; + #endif /* Get "current" message */ #define PEEK_MESSAGE(p) (*(p)->msg.save) +#ifdef USE_VM_PROBES +#define LINK_MESSAGE_DTAG(mp, dt) ERL_MESSAGE_DT_UTAG(mp) = dt +#else +#define LINK_MESSAGE_DTAG(mp, dt) +#endif -/* Add message last in private message queue */ -#define LINK_MESSAGE_PRIVQ(p, mp) do { \ - *(p)->msg.last = (mp); \ - (p)->msg.last = &(mp)->next; \ - (p)->msg.len++; \ -} while (0) - +#define LINK_MESSAGE_IMPL(p, first_msg, last_msg, num_msgs, where) do { \ + *(p)->where.last = (first_msg); \ + (p)->where.last = (last_msg); \ + (p)->where.len += (num_msgs); \ + } while(0) #ifdef ERTS_SMP -/* Move in message queue to end of private message queue */ -#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(P) \ -do { \ - if ((P)->msg_inq.first) { \ - *(P)->msg.last = (P)->msg_inq.first; \ - (P)->msg.last = (P)->msg_inq.last; \ - (P)->msg.len += (P)->msg_inq.len; \ - (P)->msg_inq.first = NULL; \ - (P)->msg_inq.last = &(P)->msg_inq.first; \ - (P)->msg_inq.len = 0; \ - } \ -} while (0) - -/* Add message last in message queue */ -#define LINK_MESSAGE(p, mp) do { \ - *(p)->msg_inq.last = (mp); \ - (p)->msg_inq.last = &(mp)->next; \ - (p)->msg_inq.len++; \ -} while(0) +/* Add message last in private message queue */ +#define LINK_MESSAGE_PRIVQ(p, first_msg, last_msg, len) \ + do { \ + LINK_MESSAGE_IMPL(p, first_msg, last_msg, len, msg); \ + } while (0) + +/* Add message last_msg in message queue */ +#define LINK_MESSAGE(p, first_msg, last_msg, len) \ + LINK_MESSAGE_IMPL(p, first_msg, last_msg, len, msg_inq) + +#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p) \ + do { \ + if (p->msg_inq.first) { \ + *p->msg.last = p->msg_inq.first; \ + p->msg.last = p->msg_inq.last; \ + p->msg.len += p->msg_inq.len; \ + p->msg_inq.first = NULL; \ + p->msg_inq.last = &p->msg_inq.first; \ + p->msg_inq.len = 0; \ + } \ + } while (0) #else -#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(P) +#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p) -/* Add message last in message queue */ -#define LINK_MESSAGE(p, mp) LINK_MESSAGE_PRIVQ((p), (mp)) +/* Add message last_msg in message queue */ +#define LINK_MESSAGE(p, first_msg, last_msg, len) \ + do { \ + LINK_MESSAGE_IMPL(p, first_msg, last_msg, len, msg); \ + } while(0) #endif @@ -259,23 +275,30 @@ do { \ (HEAP_FRAG_P)->off_heap.overhead = 0; \ } while (0) +#ifdef USE_VM_PROBES +#define ERL_MESSAGE_DT_UTAG_INIT(MP) ERL_MESSAGE_DT_UTAG(MP) = NIL +#else +#define ERL_MESSAGE_DT_UTAG_INIT(MP) do{ } while (0) +#endif + +#define ERTS_INIT_MESSAGE(MP) \ + do { \ + (MP)->next = NULL; \ + ERL_MESSAGE_TERM(MP) = THE_NON_VALUE; \ + ERL_MESSAGE_TOKEN(MP) = NIL; \ + ERL_MESSAGE_DT_UTAG_INIT(MP); \ + MP->data.attached = NULL; \ + } while (0) + void init_message(void); ErlHeapFragment* new_message_buffer(Uint); ErlHeapFragment* erts_resize_message_buffer(ErlHeapFragment *, Uint, Eterm *, Uint); void free_message_buffer(ErlHeapFragment *); void erts_queue_dist_message(Process*, ErtsProcLocks*, ErtsDistExternal *, Eterm); -#ifdef USE_VM_PROBES -void erts_queue_message_probe(Process*, ErtsProcLocks*, ErtsMessage*, - Eterm message, Eterm seq_trace_token, Eterm dt_utag); -#define erts_queue_message(RP,RL,BP,Msg,SEQ) \ - erts_queue_message_probe((RP),(RL),(BP),(Msg),(SEQ),NIL) -#else -void erts_queue_message(Process*, ErtsProcLocks*, ErtsMessage*, - Eterm message, Eterm seq_trace_token); -#define erts_queue_message_probe(RP,RL,BP,Msg,SEQ,TAG) \ - erts_queue_message((RP),(RL),(BP),(Msg),(SEQ)) -#endif +Sint erts_queue_message(Process*, ErtsProcLocks*,ErtsMessage*, Eterm); +Sint erts_queue_messages(Process*, ErtsProcLocks*, + ErtsMessage*, ErtsMessage**, Uint); void erts_deliver_exit_message(Eterm, Process*, ErtsProcLocks *, Eterm, Eterm); Sint erts_send_message(Process*, Process*, ErtsProcLocks*, Eterm, unsigned); void erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp); @@ -354,9 +377,7 @@ ERTS_GLB_FORCE_INLINE ErtsMessage *erts_alloc_message(Uint sz, Eterm **hpp) if (sz == 0) { mp = erts_alloc_message_ref(); - mp->next = NULL; - ERL_MESSAGE_TERM(mp) = NIL; - mp->data.attached = NULL; + ERTS_INIT_MESSAGE(mp); if (hpp) *hpp = NULL; return mp; @@ -365,8 +386,7 @@ ERTS_GLB_FORCE_INLINE ErtsMessage *erts_alloc_message(Uint sz, Eterm **hpp) mp = erts_alloc(ERTS_ALC_T_MSG, sizeof(ErtsMessage) + (sz - 1)*sizeof(Eterm)); - mp->next = NULL; - ERL_MESSAGE_TERM(mp) = NIL; + ERTS_INIT_MESSAGE(mp); mp->data.attached = ERTS_MSG_COMBINED_HFRAG; ERTS_INIT_HEAP_FRAG(&mp->hfrag, sz, sz); diff --git a/erts/emulator/beam/erl_msacc.c b/erts/emulator/beam/erl_msacc.c index 71e3fd8b6e..d0f305900a 100644 --- a/erts/emulator/beam/erl_msacc.c +++ b/erts/emulator/beam/erl_msacc.c @@ -257,7 +257,7 @@ static void send_reply(ErtsMsAcc *msacc, ErtsMSAccReq *msaccrp) { if (msacc->unmanaged) erts_mtx_unlock(&msacc->mtx); - erts_queue_message(rp, &rp_locks, msgp, msg, NIL); + erts_queue_message(rp, &rp_locks, msgp, msg); if (esdp && msaccrp->req_sched == esdp->no) rp_locks &= ~ERTS_PROC_LOCK_MAIN; diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 9ed136c4c2..941f44b9ec 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -92,11 +92,12 @@ static ERTS_INLINE Eterm* alloc_heap(ErlNifEnv* env, unsigned need) } static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp) -{ +{ env->hp = hp; - if (env->heap_frag == NULL) { + if (env->heap_frag == NULL) { ASSERT(HEAP_LIMIT(env->proc) == env->hp_end); - HEAP_TOP(env->proc) = env->hp; + ASSERT(env->hp + need > env->hp_end); + HEAP_TOP(env->proc) = env->hp; } else { env->heap_frag->used_size = hp - env->heap_frag->mem; @@ -120,7 +121,8 @@ static ERTS_INLINE void ensure_heap(ErlNifEnv* env, unsigned may_need) } #endif -void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif) +void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif, + Process* tracee) { env->mod_nif = mod_nif; env->proc = p; @@ -130,17 +132,7 @@ void erts_pre_nif(ErlNifEnv* env, Process* p, struct erl_module_nif* mod_nif) env->fpe_was_unmasked = erts_block_fpe(); env->tmp_obj_list = NULL; env->exception_thrown = 0; -} - -static void pre_nif_noproc(ErlNifEnv* env, struct erl_module_nif* mod_nif) -{ - env->mod_nif = mod_nif; - env->proc = NULL; - env->hp = NULL; - env->hp_end = NULL; - env->heap_frag = NULL; - env->fpe_was_unmasked = erts_block_fpe(); - env->tmp_obj_list = NULL; + env->tracee = tracee; } /* Temporary object header, auto-deallocated when NIF returns @@ -180,13 +172,6 @@ void erts_post_nif(ErlNifEnv* env) free_tmp_objs(env); } -static void post_nif_noproc(ErlNifEnv* env) -{ - erts_unblock_fpe(env->fpe_was_unmasked); - free_tmp_objs(env); -} - - /* Flush out our cached heap pointers to allow an ordinary HAlloc */ static void flush_env(ErlNifEnv* env) @@ -247,18 +232,20 @@ struct enif_msg_environment_t Process phony_proc; }; -ErlNifEnv* enif_alloc_env(void) +static ERTS_INLINE void +setup_nif_env(struct enif_msg_environment_t* msg_env, + struct erl_module_nif* mod, + Process* tracee) { - struct enif_msg_environment_t* msg_env = - erts_alloc_fnf(ERTS_ALC_T_NIF, sizeof(struct enif_msg_environment_t)); Eterm* phony_heap = (Eterm*) msg_env; /* dummy non-NULL ptr */ - - msg_env->env.hp = phony_heap; + + msg_env->env.hp = phony_heap; msg_env->env.hp_end = phony_heap; msg_env->env.heap_frag = NULL; - msg_env->env.mod_nif = NULL; + msg_env->env.mod_nif = mod; msg_env->env.tmp_obj_list = NULL; msg_env->env.proc = &msg_env->phony_proc; + msg_env->env.exception_thrown = 0; memset(&msg_env->phony_proc, 0, sizeof(Process)); HEAP_START(&msg_env->phony_proc) = phony_heap; HEAP_TOP(&msg_env->phony_proc) = phony_heap; @@ -270,6 +257,14 @@ ErlNifEnv* enif_alloc_env(void) msg_env->phony_proc.space_verified = 0; msg_env->phony_proc.space_verified_from = NULL; #endif + msg_env->env.tracee = tracee; +} + +ErlNifEnv* enif_alloc_env(void) +{ + struct enif_msg_environment_t* msg_env = + erts_alloc_fnf(ERTS_ALC_T_NIF, sizeof(struct enif_msg_environment_t)); + setup_nif_env(msg_env, NULL, NULL); return &msg_env->env; } void enif_free_env(ErlNifEnv* env) @@ -278,6 +273,20 @@ void enif_free_env(ErlNifEnv* env) erts_free(ERTS_ALC_T_NIF, env); } +static ERTS_INLINE void pre_nif_noproc(struct enif_msg_environment_t* msg_env, + struct erl_module_nif* mod, + Process* tracee) +{ + setup_nif_env(msg_env, mod, tracee); + msg_env->env.fpe_was_unmasked = erts_block_fpe(); +} + +static ERTS_INLINE void post_nif_noproc(struct enif_msg_environment_t* msg_env) +{ + erts_unblock_fpe(msg_env->env.fpe_was_unmasked); + enif_clear_env(&msg_env->env); +} + static ERTS_INLINE void clear_offheap(ErlOffHeap* oh) { oh->first = NULL; @@ -304,23 +313,111 @@ void enif_clear_env(ErlNifEnv* env) ASSERT(!is_offheap(&MSO(p))); free_tmp_objs(env); } -int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, - ErlNifEnv* msg_env, ERL_NIF_TERM msg) + +#ifdef ERTS_SMP +#ifdef DEBUG +static int enif_send_delay = 0; +#define ERTS_FORCE_ENIF_SEND_DELAY() (enif_send_delay++ % 2 == 0) +#else +#ifdef ERTS_PROC_LOCK_OWN_IMPL +#define ERTS_FORCE_ENIF_SEND_DELAY() 0 +#else +/* + * We always schedule messages if we do not use our own + * process lock implementation, as if we try to do a trylock on + * a lock that might already be locked by the same thread. + * And what happens then with different mutex implementations + * is not always guaranteed. + */ +#define ERTS_FORCE_ENIF_SEND_DELAY() 1 +#endif +#endif + +int erts_flush_trace_messages(Process *c_p, ErtsProcLocks c_p_locks) +{ + ErlTraceMessageQueue *msgq, **last_msgq; + int reds = 0; + + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_TRACE); + + msgq = c_p->trace_msg_q; + + if (!msgq) + goto error; + + do { + Process* rp; + ErtsProcLocks rp_locks; + ErtsMessage *first, **last; + Uint len; + + first = msgq->first; + last = msgq->last; + len = msgq->len; + msgq->first = NULL; + msgq->last = &msgq->first; + msgq->len = 0; + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_TRACE); + + ASSERT(len != 0); + + rp = erts_proc_lookup(msgq->receiver); + if (rp) { + rp_locks = 0; + if (rp->common.id == c_p->common.id) + rp_locks = c_p_locks; + erts_queue_messages(rp, &rp_locks, first, last, len); + if (rp->common.id == c_p->common.id) + rp_locks &= ~c_p_locks; + if (rp_locks) + erts_smp_proc_unlock(rp, rp_locks); + reds += len; + } else { + erts_cleanup_messages(first); + } + reds += 1; + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_TRACE); + msgq = msgq->next; + } while (msgq); + + last_msgq = &c_p->trace_msg_q; + + while (*last_msgq) { + msgq = *last_msgq; + if (msgq->len == 0) { + *last_msgq = msgq->next; + erts_free(ERTS_ALC_T_TRACE_MSG_QUEUE, msgq); + } else { + last_msgq = &msgq->next; + } + } + +error: + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_TRACE); + + return reds; +} + +#endif + +int +enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, + ErlNifEnv* msg_env, ERL_NIF_TERM msg) { struct enif_msg_environment_t* menv = (struct enif_msg_environment_t*)msg_env; - ErtsProcLocks rp_locks = 0; + ErtsProcLocks rp_locks = 0, lc_locks = 0, c_p_locks = ERTS_PROC_LOCK_MAIN; Process* rp; Process* c_p; ErtsMessage *mp; - ErlHeapFragment* frags; Eterm receiver = to_pid->pid; int flush_me = 0; - int scheduler = erts_get_scheduler_id() != 0; + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + int scheduler = esdp ? esdp->no : 0; if (env != NULL) { c_p = env->proc; if (receiver == c_p->common.id) { - rp_locks = ERTS_PROC_LOCK_MAIN; + rp_locks = c_p_locks; flush_me = 1; } } @@ -330,40 +427,124 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, #else erts_exit(ERTS_ABORT_EXIT,"enif_send: env==NULL on non-SMP VM"); #endif - } + } rp = (scheduler ? erts_proc_lookup(receiver) : erts_pid2proc_opt(c_p, ERTS_PROC_LOCK_MAIN, receiver, rp_locks, ERTS_P2P_FLG_INC_REFC)); + if (rp == NULL) { ASSERT(env == NULL || receiver != c_p->common.id); return 0; } - flush_env(msg_env); - frags = menv->env.heap_frag; - ASSERT(frags == MBUF(&menv->phony_proc)); - if (frags != NULL) { - /* Move all offheap's from phony proc to the first fragment. - Quick and dirty... */ - ASSERT(!is_offheap(&frags->off_heap)); - frags->off_heap = MSO(&menv->phony_proc); - clear_offheap(&MSO(&menv->phony_proc)); - menv->env.heap_frag = NULL; - MBUF(&menv->phony_proc) = NULL; - } - ASSERT(!is_offheap(&MSO(&menv->phony_proc))); - - if (flush_me) { - flush_env(env); /* Needed for ERTS_HOLE_CHECK */ - } - mp = erts_alloc_message(0, NULL); - mp->data.heap_frag = frags; - erts_queue_message(rp, &rp_locks, mp, msg, am_undefined); + if (menv) { + flush_env(msg_env); + mp = erts_alloc_message(0, NULL); + mp->data.heap_frag = menv->env.heap_frag; + ASSERT(mp->data.heap_frag == MBUF(&menv->phony_proc)); + if (mp->data.heap_frag != NULL) { + /* Move all offheap's from phony proc to the first fragment. + Quick and dirty... */ + ASSERT(!is_offheap(&mp->data.heap_frag->off_heap)); + mp->data.heap_frag->off_heap = MSO(&menv->phony_proc); + clear_offheap(&MSO(&menv->phony_proc)); + menv->env.heap_frag = NULL; + MBUF(&menv->phony_proc) = NULL; + } + } else { + Uint sz = size_object(msg); + Eterm *hp; + mp = erts_alloc_message(sz, &hp); + msg = copy_struct(msg, sz, &hp, &mp->hfrag.off_heap); + ASSERT(hp == mp->hfrag.mem+mp->hfrag.used_size); + } + + ERL_MESSAGE_TERM(mp) = msg; + + if (flush_me) { + flush_env(env); /* Needed for ERTS_HOLE_CHECK */ + } + + if (!env || !env->tracee) { + + if (c_p && IS_TRACED_FL(c_p, F_TRACE_SEND)) + trace_send(c_p, receiver, msg); + +#ifndef ERTS_SMP + } +#endif + + erts_queue_message(rp, &rp_locks, mp, msg); +#ifdef ERTS_SMP + } + else { + /* This clause is taken when the nif is called in the context + of a traced process. We do not know which locks we have + so we have to do a try lock and if that fails we enqueue + the message in a special trace message output queue of the + tracee */ + ErlTraceMessageQueue *msgq; + Process *t_p = env->tracee; + + + erts_smp_proc_lock(t_p, ERTS_PROC_LOCK_TRACE); + + msgq = t_p->trace_msg_q; + + while (msgq != NULL) { + if (msgq->receiver == receiver) { + break; + } + msgq = msgq->next; + } + +#ifdef ERTS_ENABLE_LOCK_CHECK + lc_locks = erts_proc_lc_my_proc_locks(rp); + rp_locks |= lc_locks; + if (receiver == c_p->common.id) + c_p_locks |= lc_locks; +#endif + if (ERTS_FORCE_ENIF_SEND_DELAY() || msgq || + rp_locks & ERTS_PROC_LOCK_MSGQ || + erts_smp_proc_trylock(rp, ERTS_PROC_LOCK_MSGQ) == EBUSY) { + + if (!msgq) { + + msgq = erts_alloc(ERTS_ALC_T_TRACE_MSG_QUEUE, + sizeof(ErlTraceMessageQueue)); + msgq->receiver = receiver; + msgq->first = mp; + msgq->last = &mp->next; + msgq->len = 1; + + /* Insert in linked list */ + msgq->next = t_p->trace_msg_q; + t_p->trace_msg_q = msgq; + + erts_smp_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE); + + erts_schedule_flush_trace_messages(t_p->common.id); + + } else { + msgq->len++; + *msgq->last = mp; + msgq->last = &mp->next; + erts_smp_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE); + } + } else { + erts_smp_proc_unlock(t_p, ERTS_PROC_LOCK_TRACE); + rp_locks &= ~ERTS_PROC_LOCK_TRACE; + rp_locks |= ERTS_PROC_LOCK_MSGQ; + erts_queue_message(rp, &rp_locks, mp, msg); + } + } +#endif + if (c_p == rp) rp_locks &= ~ERTS_PROC_LOCK_MAIN; - if (rp_locks) - erts_smp_proc_unlock(rp, rp_locks); + if (rp_locks & ~lc_locks) + erts_smp_proc_unlock(rp, rp_locks & ~lc_locks); if (!scheduler) erts_proc_dec_refc(rp); if (flush_me) { @@ -392,6 +573,9 @@ enif_port_command(ErlNifEnv *env, const ErlNifPort* to_port, if (!prt) return 0; + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, env->proc->common.id, am_command, msg); + return erts_port_output_async(prt, env->proc->common.id, msg); } @@ -1479,10 +1663,10 @@ static void close_lib(struct erl_module_nif* lib) ASSERT(erts_refc_read(&lib->rt_dtor_cnt,0) == 0); if (lib->entry != NULL && lib->entry->unload != NULL) { - ErlNifEnv env; - pre_nif_noproc(&env, lib); - lib->entry->unload(&env, lib->priv_data); - post_nif_noproc(&env); + struct enif_msg_environment_t msg_env; + pre_nif_noproc(&msg_env, lib, NULL); + lib->entry->unload(&msg_env.env, lib->priv_data); + post_nif_noproc(&msg_env); } if (!erts_is_static_nif(lib->handle)) erts_sys_ddll_close(lib->handle); @@ -1628,10 +1812,10 @@ static void nif_resource_dtor(Binary* bin) ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == &nif_resource_dtor); if (type->dtor != NULL) { - ErlNifEnv env; - pre_nif_noproc(&env, type->owner); - type->dtor(&env,resource->data); - post_nif_noproc(&env); + struct enif_msg_environment_t msg_env; + pre_nif_noproc(&msg_env, type->owner, NULL); + type->dtor(&msg_env.env, resource->data); + post_nif_noproc(&msg_env); } if (erts_refc_dectest(&type->refc, 0) == 0) { ASSERT(type->next == NULL); @@ -2259,14 +2443,13 @@ int enif_make_map_remove(ErlNifEnv* env, Eterm key, Eterm *map_out) { - int res; if (!is_map(map_in)) { return 0; } flush_env(env); - res = erts_maps_remove(env->proc, key, map_in, map_out); + (void) erts_maps_take(env->proc, key, map_in, map_out, NULL); cache_env(env); - return res; + return 1; } int enif_map_iterator_create(ErlNifEnv *env, @@ -2791,7 +2974,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) } old_func = next_func(mod->curr.nif->entry, &old_incr, old_func); } - erts_pre_nif(&env, BIF_P, lib); + erts_pre_nif(&env, BIF_P, lib, NULL); veto = entry->reload(&env, &lib->priv_data, BIF_ARG_2); erts_post_nif(&env); if (veto) { @@ -2812,7 +2995,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) ret = load_nif_error(BIF_P, upgrade, "Upgrade not supported by this NIF library."); goto error; } - erts_pre_nif(&env, BIF_P, lib); + erts_pre_nif(&env, BIF_P, lib, NULL); veto = entry->upgrade(&env, &lib->priv_data, &mod->old.nif->priv_data, BIF_ARG_2); erts_post_nif(&env); if (veto) { @@ -2823,7 +3006,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) commit_opened_resource_types(lib); } else if (entry->load != NULL) { /********* Initial load ***********/ - erts_pre_nif(&env, BIF_P, lib); + erts_pre_nif(&env, BIF_P, lib, NULL); veto = entry->load(&env, &lib->priv_data, BIF_ARG_2); erts_post_nif(&env); if (veto) { @@ -2910,6 +3093,9 @@ erts_unload_nif(struct erl_module_nif* lib) ASSERT(erts_smp_thr_progress_is_blocking()); ASSERT(lib != NULL); ASSERT(lib->mod != NULL); + + erts_tracer_nif_clear(); + for (rt = resource_type_list.next; rt != &resource_type_list; rt = next) { @@ -2952,6 +3138,76 @@ void erl_nif_init() resource_type_list.owner = NULL; resource_type_list.module = THE_NON_VALUE; resource_type_list.name = THE_NON_VALUE; + +} + +int erts_nif_get_funcs(struct erl_module_nif* mod, + ErlNifFunc **funcs) +{ + *funcs = mod->entry->funcs; + return mod->entry->num_of_funcs; +} + +Eterm erts_nif_call_function(Process *p, Process *tracee, + struct erl_module_nif* mod, + ErlNifFunc *fun, int argc, Eterm *argv) +{ + Eterm nif_result; +#ifdef DEBUG + /* Verify that function is part of this module */ + int i; + for (i = 0; i < mod->entry->num_of_funcs; i++) + if (fun == &(mod->entry->funcs[i])) + break; + ASSERT(i < mod->entry->num_of_funcs); + if (p) + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(p) & ERTS_PROC_LOCK_MAIN + || erts_smp_thr_progress_is_blocking()); +#endif + if (p) { + /* This is almost a normal nif call like in beam_emu, + except that any heap fragment created in the nif will be + discarded without checking if anything in it is live. + This is because we cannot do a GC here as we don't know + the number of live registers that have to be preserved. + This means that any heap part of the returned term may + not be used outside this function. */ + struct enif_environment_t env; + ErlHeapFragment *orig_hf = MBUF(p); + ErlOffHeap orig_oh = MSO(p); + ASSERT(is_internal_pid(p->common.id)); + MBUF(p) = NULL; + clear_offheap(&MSO(p)); + + erts_pre_nif(&env, p, mod, tracee); + nif_result = (*fun->fptr)(&env, argc, argv); + if (env.exception_thrown) + nif_result = THE_NON_VALUE; + erts_post_nif(&env); + + /* Free any offheap and heap fragments created in nif */ + if (MSO(p).first) { + erts_cleanup_offheap(&MSO(p)); + clear_offheap(&MSO(p)); + } + if (MBUF(p)) + free_message_buffer(MBUF(p)); + + /* restore original heap fragment list */ + MBUF(p) = orig_hf; + MSO(p) = orig_oh; + } else { + /* Nif call was done without a process context, + so we create a phony one. */ + struct enif_msg_environment_t msg_env; + pre_nif_noproc(&msg_env, mod, tracee); + nif_result = (*fun->fptr)(&msg_env.env, argc, argv); + if (msg_env.env.exception_thrown) + nif_result = THE_NON_VALUE; + post_nif_noproc(&msg_env); + } + + return nif_result; } #ifdef USE_VM_PROBES diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 44a2581436..3964f7f679 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -87,16 +87,16 @@ typedef ErlNifSInt64 ErlNifTime; #define ERL_NIF_TIME_ERROR ((ErlNifSInt64) ERTS_NAPI_TIME_ERROR__) typedef enum { - ERL_NIF_SEC = ERTS_NAPI_SEC__, - ERL_NIF_MSEC = ERTS_NAPI_MSEC__, - ERL_NIF_USEC = ERTS_NAPI_USEC__, - ERL_NIF_NSEC = ERTS_NAPI_NSEC__ + ERL_NIF_SEC = ERTS_NAPI_SEC__, + ERL_NIF_MSEC = ERTS_NAPI_MSEC__, + ERL_NIF_USEC = ERTS_NAPI_USEC__, + ERL_NIF_NSEC = ERTS_NAPI_NSEC__ } ErlNifTimeUnit; struct enif_environment_t; typedef struct enif_environment_t ErlNifEnv; -typedef struct +typedef struct enif_func_t { const char* name; unsigned arity; diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h index 59aa034f48..c2588e718d 100644 --- a/erts/emulator/beam/erl_port.h +++ b/erts/emulator/beam/erl_port.h @@ -944,7 +944,7 @@ erts_schedule_proc2port_signal(Process *, ErtsPortTaskHandle *, ErtsProc2PortSigCallback); -int erts_deliver_port_exit(Port *, Eterm, Eterm, int); +int erts_deliver_port_exit(Port *, Eterm, Eterm, int, int); /* * Port signal flags diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index 30ce181ebb..3102e44c11 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -1766,6 +1766,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) if (!(state & ERTS_PORT_SFLGS_DEAD)) { DTRACE_DRIVER(driver_timeout, pp); LTTNG_DRIVER(driver_timeout, pp); + if (IS_TRACED_FL(pp, F_TRACE_RECEIVE)) + trace_port(pp, am_receive, am_timeout); (*pp->drv_ptr->timeout)((ErlDrvData) pp->drv_data); } } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index d222e79f56..d485affa3b 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -444,7 +444,8 @@ int erts_system_profile_ts_type = ERTS_TRACE_FLG_NOW_TIMESTAMP; typedef enum { ERTS_PSTT_GC, /* Garbage Collect */ ERTS_PSTT_CPC, /* Check Process Code */ - ERTS_PSTT_COHMQ /* Change off heap message queue */ + ERTS_PSTT_COHMQ, /* Change off heap message queue */ + ERTS_PSTT_FTMQ /* Flush trace msg queue */ } ErtsProcSysTaskType; #define ERTS_MAX_PROC_SYS_TASK_ARGS 2 @@ -1138,7 +1139,7 @@ reply_sched_wall_time(void *vswtrp) hpp = &hp; } - erts_queue_message(rp, &rp_locks, mp, msg, NIL); + erts_queue_message(rp, &rp_locks, mp, msg); if (swtrp->req_sched == esdp->no) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -1217,7 +1218,7 @@ reply_system_check(void *vscrp) hpp = &hp; msg = STORE_NC(hpp, ohp, scrp->ref); - erts_queue_message(rp, &rp_locks, mp, msg, NIL); + erts_queue_message(rp, &rp_locks, mp, msg); if (scrp->req_sched == esdp->no) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -2311,7 +2312,7 @@ handle_reap_ports(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) ERTS_PORT_SFLG_HALT); erts_smp_atomic32_inc_nob(&erts_halt_progress); if (!(state & (ERTS_PORT_SFLG_EXITING|ERTS_PORT_SFLG_CLOSING))) - erts_deliver_port_exit(prt, prt->common.id, am_killed, 0); + erts_deliver_port_exit(prt, prt->common.id, am_killed, 0, 1); } erts_port_release(prt); @@ -9315,6 +9316,7 @@ Process *schedule(Process *p, int calls) esdp = erts_scheduler_data; ASSERT(esdp->current_process == p); #endif + reds = actual_reds = calls - esdp->virtual_reds; if (reds < ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST) reds = ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST; @@ -9327,27 +9329,39 @@ Process *schedule(Process *p, int calls) p->reds += actual_reds; - erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); +#ifdef ERTS_SMP + erts_smp_proc_lock(p, ERTS_PROC_LOCK_TRACE); + if (p->trace_msg_q) { + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_TRACE); + erts_schedule_flush_trace_messages(p->common.id); + } else + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_TRACE); +#endif - state = erts_smp_atomic32_read_acqb(&p->state); + state = erts_smp_atomic32_read_nob(&p->state); if (IS_TRACED(p)) { if (IS_TRACED_FL(p, F_TRACE_CALLS) && !(state & ERTS_PSFLG_FREE)) erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_OUT); - if (state & (ERTS_PSFLG_FREE|ERTS_PSFLG_EXITING)) { + if ((state & (ERTS_PSFLG_FREE|ERTS_PSFLG_EXITING)) == ERTS_PSFLG_EXITING) { if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) - trace_sched(p, ((state & ERTS_PSFLG_FREE) - ? am_out_exited - : am_out_exiting)); + trace_sched(p, ERTS_PROC_LOCK_MAIN, + ((state & ERTS_PSFLG_FREE) + ? am_out_exited + : am_out_exiting)); } else { - if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED)) - trace_sched(p, am_out); - else if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) - trace_virtual_sched(p, am_out); + if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED) || + ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_out); } } + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + + /* have to re-read state after taking lock */ + state = erts_smp_atomic32_read_nob(&p->state); + #ifdef ERTS_SMP if (state & ERTS_PSFLG_PENDING_EXIT) erts_handle_pending_exit(p, (ERTS_PROC_LOCK_MAIN @@ -9844,27 +9858,27 @@ Process *schedule(Process *p, int calls) p->fcalls = reds; + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + if (IS_TRACED(p)) { if (state & ERTS_PSFLG_EXITING) { if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) - trace_sched(p, am_in_exiting); + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in_exiting); } else { - if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED)) - trace_sched(p, am_in); - else if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) - trace_virtual_sched(p, am_in); + if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED) || + ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) + trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in); } if (IS_TRACED_FL(p, F_TRACE_CALLS)) { erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_IN); } } - erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); #ifdef ERTS_SMP - if (is_not_nil(ERTS_TRACER_PROC(p))) - erts_check_my_tracer_proc(p); + /* Clears tracer if it has been removed */ + (void)ERTS_TRACER_PROC_IS_ENABLED(p); #endif if (state & ERTS_PSFLG_RUNNING_SYS) { @@ -9996,7 +10010,7 @@ notify_sys_task_executed(Process *c_p, ErtsProcSysTask *st, Eterm st_result) ASSERT(hp_start + hsz == hp); #endif - erts_queue_message(rp, &rp_locks, mp, msg, NIL); + erts_queue_message(rp, &rp_locks, mp, msg); if (c_p == rp) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -10164,8 +10178,7 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) { int garbage_collected = 0; erts_aint32_t state = *statep; - int max_reds = in_reds; - int reds = 0; + int reds = in_reds; int qmask = 0; ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN); @@ -10193,12 +10206,12 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) if (c_p->flags & F_DISABLE_GC) { save_gc_task(c_p, st, st_prio); st = NULL; - reds++; + reds--; } else { if (!garbage_collected) { FLAGS(c_p) |= F_NEED_FULLSWEEP; - reds += erts_garbage_collect_nobump(c_p, + reds -= erts_garbage_collect_nobump(c_p, 0, c_p->arg_reg, c_p->arity); @@ -10207,21 +10220,30 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) st_res = am_true; } break; - case ERTS_PSTT_CPC: + case ERTS_PSTT_CPC: { + int cpc_reds = 0; st_res = erts_check_process_code(c_p, st->arg[0], unsigned_val(st->arg[1]), - &reds); + &cpc_reds); + reds -= cpc_reds; if (is_non_value(st_res)) { /* Needed gc, but gc was disabled */ save_gc_task(c_p, st, st_prio); st = NULL; } break; + } case ERTS_PSTT_COHMQ: - reds += erts_complete_off_heap_message_queue_change(c_p); + reds -= erts_complete_off_heap_message_queue_change(c_p); + st_res = am_true; + break; +#ifdef ERTS_SMP + case ERTS_PSTT_FTMQ: + reds -= erts_flush_trace_messages(c_p, ERTS_PROC_LOCK_MAIN); st_res = am_true; break; +#endif default: ERTS_INTERNAL_ERROR("Invalid process sys task type"); st_res = am_false; @@ -10231,11 +10253,11 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) reds += notify_sys_task_executed(c_p, st, st_res); state = erts_smp_atomic32_read_acqb(&c_p->state); - } while (qmask && reds < max_reds); + } while (qmask && reds > 0); *statep = state; - return reds; + return in_reds - reds; } static int @@ -10267,6 +10289,12 @@ cleanup_sys_tasks(Process *c_p, erts_aint32_t in_state, int in_reds) case ERTS_PSTT_COHMQ: st_res = am_false; break; +#ifdef ERTS_SMP + case ERTS_PSTT_FTMQ: + reds -= erts_flush_trace_messages(c_p, ERTS_PROC_LOCK_MAIN); + st_res = am_true; + break; +#endif default: ERTS_INTERNAL_ERROR("Invalid process sys task type"); st_res = am_false; @@ -10402,8 +10430,8 @@ badarg: BIF_ERROR(BIF_P, BADARG); } -void -erts_schedule_complete_off_heap_message_queue_change(Eterm pid) +static void +erts_schedule_generic_sys_task(Eterm pid, ErtsProcSysTaskType type) { Process *rp = erts_proc_lookup(pid); if (rp) { @@ -10413,7 +10441,7 @@ erts_schedule_complete_off_heap_message_queue_change(Eterm pid) st = erts_alloc(ERTS_ALC_T_PROC_SYS_TSK, ERTS_PROC_SYS_TASK_SIZE(0)); - st->type = ERTS_PSTT_COHMQ; + st->type = type; st->requester = NIL; st->reply_tag = NIL; st->req_id = NIL; @@ -10428,6 +10456,18 @@ erts_schedule_complete_off_heap_message_queue_change(Eterm pid) } } +void +erts_schedule_complete_off_heap_message_queue_change(Eterm pid) +{ + erts_schedule_generic_sys_task(pid, ERTS_PSTT_COHMQ); +} + +void +erts_schedule_flush_trace_messages(Eterm pid) +{ + erts_schedule_generic_sys_task(pid, ERTS_PSTT_FTMQ); +} + static void save_gc_task(Process *c_p, ErtsProcSysTask *st, int prio) { @@ -10886,14 +10926,13 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). Eterm res = THE_NON_VALUE; erts_aint32_t state = 0; erts_aint32_t prio = (erts_aint32_t) PRIORITY_NORMAL; + ErtsProcLocks locks = ERTS_PROC_LOCKS_ALL; #ifdef SHCOPY_SPAWN erts_shcopy_t info; INITIALIZE_SHCOPY(info); #endif -#ifdef ERTS_SMP erts_smp_proc_lock(parent, ERTS_PROC_LOCKS_ALL_MINOR); -#endif /* * Check for errors. @@ -11062,7 +11101,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). : STORE_NC(&p->htop, &p->off_heap, parent->group_leader); } - erts_get_default_tracing(&ERTS_TRACE_FLAGS(p), &ERTS_TRACER_PROC(p)); + erts_get_default_proc_tracing(&ERTS_TRACE_FLAGS(p), &ERTS_TRACER(p)); p->msg.first = NULL; p->msg.last = &p->msg.first; @@ -11098,21 +11137,60 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->last_old_htop = NULL; #endif +#ifdef ERTS_SMP + p->trace_msg_q = NULL; + p->scheduler_data = NULL; + p->suspendee = NIL; + p->pending_suspenders = NULL; + p->pending_exit.reason = THE_NON_VALUE; + p->pending_exit.bp = NULL; +#endif + +#if !defined(NO_FPE_SIGNALS) || defined(HIPE) + p->fp_exception = 0; +#endif + if (IS_TRACED(parent)) { if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOS) { ERTS_TRACE_FLAGS(p) |= (ERTS_TRACE_FLAGS(parent) & TRACEE_FLAGS); - ERTS_TRACER_PROC(p) = ERTS_TRACER_PROC(parent); + erts_tracer_replace(&p->common, ERTS_TRACER(parent)); } - if (ARE_TRACE_FLAGS_ON(parent, F_TRACE_PROCS)) { - trace_proc_spawn(parent, p->common.id, mod, func, args); - } - if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOS1) { + if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOS1) { /* Overrides TRACE_CHILDREN */ ERTS_TRACE_FLAGS(p) |= (ERTS_TRACE_FLAGS(parent) & TRACEE_FLAGS); - ERTS_TRACER_PROC(p) = ERTS_TRACER_PROC(parent); + erts_tracer_replace(&p->common, ERTS_TRACER(parent)); ERTS_TRACE_FLAGS(p) &= ~(F_TRACE_SOS1 | F_TRACE_SOS); ERTS_TRACE_FLAGS(parent) &= ~(F_TRACE_SOS1 | F_TRACE_SOS); } + if (so->flags & SPO_LINK && ERTS_TRACE_FLAGS(parent) & (F_TRACE_SOL|F_TRACE_SOL1)) { + ERTS_TRACE_FLAGS(p) |= (ERTS_TRACE_FLAGS(parent)&TRACEE_FLAGS); + erts_tracer_replace(&p->common, ERTS_TRACER(parent)); + if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOL1) {/*maybe override*/ + ERTS_TRACE_FLAGS(p) &= ~(F_TRACE_SOL1 | F_TRACE_SOL); + ERTS_TRACE_FLAGS(parent) &= ~(F_TRACE_SOL1 | F_TRACE_SOL); + } + } + if (ARE_TRACE_FLAGS_ON(parent, F_TRACE_PROCS)) { + locks &= ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + trace_proc_spawn(parent, am_spawn, p->common.id, mod, func, args); + if (so->flags & SPO_LINK) + trace_proc(parent, locks, parent, am_link, p->common.id); + } + } + + if (IS_TRACED_FL(p, F_TRACE_PROCS)) { + if ((locks & (ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE)) + == (ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE)) { + /* This happens when parent was not traced, but child is */ + locks &= ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + erts_smp_proc_unlock(parent, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + } + trace_proc_spawn(p, am_spawned, parent->common.id, mod, func, args); + if (so->flags & SPO_LINK) + trace_proc(p, locks, p, am_getting_linked, parent->common.id); } /* @@ -11123,10 +11201,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). #ifdef DEBUG int ret; #endif - if (IS_TRACED_FL(parent, F_TRACE_PROCS)) { - trace_proc(parent, parent, am_link, p->common.id); - } - #ifdef DEBUG ret = erts_add_link(&ERTS_P_LINKS(parent), LINK_PID, p->common.id); ASSERT(ret == 0); @@ -11137,17 +11211,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). erts_add_link(&ERTS_P_LINKS(p), LINK_PID, parent->common.id); #endif - if (IS_TRACED(parent)) { - if (ERTS_TRACE_FLAGS(parent) & (F_TRACE_SOL|F_TRACE_SOL1)) { - ERTS_TRACE_FLAGS(p) |= (ERTS_TRACE_FLAGS(parent)&TRACEE_FLAGS); - ERTS_TRACER_PROC(p) = ERTS_TRACER_PROC(parent); /*maybe steal*/ - - if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOL1) {/*maybe override*/ - ERTS_TRACE_FLAGS(p) &= ~(F_TRACE_SOL1 | F_TRACE_SOL); - ERTS_TRACE_FLAGS(parent) &= ~(F_TRACE_SOL1 | F_TRACE_SOL); - } - } - } } /* @@ -11162,19 +11225,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). so->mref = mref; } -#ifdef ERTS_SMP - p->scheduler_data = NULL; - p->suspendee = NIL; - p->pending_suspenders = NULL; - p->pending_exit.reason = THE_NON_VALUE; - p->pending_exit.bp = NULL; -#endif - -#if !defined(NO_FPE_SIGNALS) || defined(HIPE) - p->fp_exception = 0; -#endif - - erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL); + erts_smp_proc_unlock(p, locks); res = p->common.id; @@ -11182,6 +11233,8 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). * Schedule process for execution. */ + erts_smp_proc_unlock(parent, locks & ERTS_PROC_LOCKS_ALL_MINOR); + schedule_process(p, state, 0); VERBOSE(DEBUG_PROCESSES, ("Created a new process: %T\n",p->common.id)); @@ -11195,10 +11248,11 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). DTRACE2(process_spawn, process_name, mfa); } #endif + return res; error: - erts_smp_proc_unlock(parent, ERTS_PROC_LOCKS_ALL_MINOR); + erts_smp_proc_unlock(parent, locks & ERTS_PROC_LOCKS_ALL_MINOR); return res; } @@ -11223,7 +11277,7 @@ void erts_init_empty_process(Process *p) p->rcount = 0; p->common.id = ERTS_INVALID_PID; p->reds = 0; - ERTS_TRACER_PROC(p) = NIL; + ERTS_TRACER(p) = erts_tracer_nil; ERTS_TRACE_FLAGS(p) = F_INITIAL_TRACE_FLAGS; p->group_leader = ERTS_INVALID_PID; p->flags = 0; @@ -11343,7 +11397,7 @@ erts_debug_verify_clean_empty_process(Process* p) ASSERT(p->live_hf_end == ERTS_INVALID_HFRAG_PTR); ASSERT(p->heap == NULL); ASSERT(p->common.id == ERTS_INVALID_PID); - ASSERT(ERTS_TRACER_PROC(p) == NIL); + ASSERT(ERTS_TRACER_IS_NIL(ERTS_TRACER(p))); ASSERT(ERTS_TRACE_FLAGS(p) == F_INITIAL_TRACE_FLAGS); ASSERT(p->group_leader == ERTS_INVALID_PID); ASSERT(p->next == NULL); @@ -11690,7 +11744,7 @@ send_exit_message(Process *to, ErtsProcLocks *to_locksp, mp = erts_alloc_message_heap(to, to_locksp, term_size, &hp, &ohp); mess = copy_struct(exit_term, term_size, &hp, ohp); #endif - erts_queue_message(to, to_locksp, mp, mess, NIL); + erts_queue_message(to, to_locksp, mp, mess); } else { Eterm temp_token; Uint sz_token; @@ -11708,9 +11762,10 @@ send_exit_message(Process *to, ErtsProcLocks *to_locksp, mess = copy_struct(exit_term, term_size, &hp, ohp); #endif /* the trace token must in this case be updated by the caller */ - seq_trace_output(token, mess, SEQ_TRACE_SEND, to->common.id, NULL); + seq_trace_output(token, mess, SEQ_TRACE_SEND, to->common.id, to); temp_token = copy_struct(token, sz_token, &hp, ohp); - erts_queue_message(to, to_locksp, mp, mess, temp_token); + ERL_MESSAGE_TOKEN(mp) = temp_token; + erts_queue_message(to, to_locksp, mp, mess); } } @@ -11819,6 +11874,9 @@ send_exit_signal(Process *c_p, /* current process if and only if ((state & ERTS_PSFLG_TRAP_EXIT) && (reason != am_kill || (flags & ERTS_XSIG_FLG_IGN_KILL))) { + /* have to release the status lock in order to send the exit message */ + erts_smp_proc_unlock(rp, *rp_locks & ERTS_PROC_LOCKS_XSIG_SEND); + *rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND; if (have_seqtrace(token) && token_update) seq_trace_update_send(token_update); if (is_value(exit_tuple)) @@ -12116,6 +12174,7 @@ static void doit_exit_link(ErtsLink *lnk, void *vpcontext) DistEntry *dep; Process *rp; + switch(lnk->type) { case LINK_PID: if(is_internal_port(item)) { @@ -12163,7 +12222,11 @@ static void doit_exit_link(ErtsLink *lnk, void *vpcontext) if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { /* We didn't exit the process and it is traced */ if (IS_TRACED_FL(rp, F_TRACE_PROCS)) { - trace_proc(p, rp, am_getting_unlinked, p->common.id); + if (rp_locks & ERTS_PROC_LOCKS_XSIG_SEND) { + erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_XSIG_SEND); + rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND; + } + trace_proc(NULL, 0, rp, am_getting_unlinked, p->common.id); } } } @@ -12280,8 +12343,6 @@ erts_do_exit_process(Process* p, Eterm reason) if (IS_TRACED_FL(p, F_TRACE_CALLS)) erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_EXITING); - if (IS_TRACED_FL(p,F_TRACE_PROCS)) - trace_proc(p, p, am_exit, reason); } erts_trace_check_exiting(p->common.id); @@ -12297,6 +12358,10 @@ erts_do_exit_process(Process* p, Eterm reason) erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); + if (IS_TRACED_FL(p,F_TRACE_PROCS)) + trace_proc(p, ERTS_PROC_LOCK_MAIN, p, am_exit, reason); + + /* * p->u.initial of this process can *not* be used anymore; * will be overwritten by misc termination data. @@ -12436,6 +12501,9 @@ erts_continue_exit_process(Process *p) ASSERT(!p->common.u.alive.reg); } + if (IS_TRACED_FL(p, F_TRACE_SCHED_EXIT)) + trace_sched(p, curr_locks, am_out_exited); + erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); curr_locks = ERTS_PROC_LOCKS_ALL; @@ -12559,6 +12627,12 @@ erts_continue_exit_process(Process *p) if (nif_export) erts_destroy_nif_export(nif_export); +#ifdef ERTS_SMP + erts_flush_trace_messages(p, 0); +#endif + + ERTS_TRACER_CLEAR(&ERTS_TRACER(p)); + delete_process(p); #ifdef ERTS_SMP diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index c2303eea49..61acf5924b 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1041,6 +1041,7 @@ struct process { #ifdef ERTS_SMP ErlMessageInQueue msg_inq; + ErlTraceMessageQueue *trace_msg_q; ErtsPendExit pending_exit; erts_proc_lock_t lock; ErtsSchedulerData *scheduler_data; @@ -1358,7 +1359,6 @@ extern int erts_system_profile_ts_type; #define F_TRACE_FLAG(N) (1 << (ERTS_TRACE_TS_TYPE_BITS + (N))) /* process trace_flags */ - #define F_NOW_TS (ERTS_TRACE_FLG_NOW_TIMESTAMP \ << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT) #define F_STRICT_MON_TS (ERTS_TRACE_FLG_STRICT_MONOTONIC_TIMESTAMP \ @@ -1380,8 +1380,7 @@ extern int erts_system_profile_ts_type; #define F_TRACE_ARITY_ONLY F_TRACE_FLAG(12) #define F_TRACE_RETURN_TO F_TRACE_FLAG(13) /* Return_to trace when breakpoint tracing */ #define F_TRACE_SILENT F_TRACE_FLAG(14) /* No call trace msg suppress */ -#define F_TRACER F_TRACE_FLAG(15) /* May be (has been) tracer */ -#define F_EXCEPTION_TRACE F_TRACE_FLAG(16) /* May have exception trace on stack */ +#define F_EXCEPTION_TRACE F_TRACE_FLAG(15) /* May have exception trace on stack */ /* port trace flags, currently the same as process trace flags */ #define F_TRACE_SCHED_PORTS F_TRACE_FLAG(17) /* Trace of port scheduling */ @@ -1410,12 +1409,14 @@ extern int erts_system_profile_ts_type; | F_TRACE_SCHED_PORTS | F_TRACE_SCHED_NO \ | F_TRACE_SCHED_EXIT) + #define ERTS_TRACEE_MODIFIER_FLAGS \ - (F_TRACE_SILENT | F_TIMESTAMP_MASK | F_TRACE_SCHED_NO) -#define ERTS_PORT_TRACEE_FLAGS \ - (ERTS_TRACEE_MODIFIER_FLAGS | F_TRACE_PORTS | F_TRACE_SCHED_PORTS) + (F_TRACE_SILENT | F_TIMESTAMP_MASK | F_TRACE_SCHED_NO \ + | F_TRACE_RECEIVE | F_TRACE_SEND) +#define ERTS_PORT_TRACEE_FLAGS \ + (ERTS_TRACEE_MODIFIER_FLAGS | F_TRACE_PORTS | F_TRACE_SCHED_PORTS) #define ERTS_PROC_TRACEE_FLAGS \ - ((TRACEE_FLAGS & ~ERTS_PORT_TRACEE_FLAGS) | ERTS_TRACEE_MODIFIER_FLAGS) + ((TRACEE_FLAGS & ~ERTS_PORT_TRACEE_FLAGS) | ERTS_TRACEE_MODIFIER_FLAGS) #define SEQ_TRACE_FLAG(N) (1 << (ERTS_TRACE_TS_TYPE_BITS + (N))) @@ -1717,6 +1718,8 @@ void erts_schedule_thr_prgr_later_cleanup_op(void (*)(void *), ErtsThrPrgrLaterOp *, UWord); void erts_schedule_complete_off_heap_message_queue_change(Eterm pid); +void erts_schedule_flush_trace_messages(Eterm pid); +int erts_flush_trace_messages(Process *c_p, ErtsProcLocks locks); #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) int erts_dbg_check_halloc_lock(Process *p); @@ -1996,7 +1999,6 @@ erts_psd_set(Process *p, int ix, void *data) #define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, NTE) \ erts_psd_set((P), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (NTE)) - ERTS_GLB_INLINE Eterm erts_proc_get_error_handler(Process *p); ERTS_GLB_INLINE Eterm erts_proc_set_error_handler(Process *p, Eterm handler); @@ -2326,14 +2328,17 @@ erts_alloc_message_heap_state(Process *pp, ErlOffHeap **ohpp) { int on_heap; + ErtsMessage *mp; if ((*psp) & ERTS_PSFLG_OFF_HEAP_MSGQ) { - ErtsMessage *mp = erts_alloc_message(sz, hpp); + mp = erts_alloc_message(sz, hpp); *ohpp = sz == 0 ? NULL : &mp->hfrag.off_heap; return mp; } - return erts_try_alloc_message_on_heap(pp, psp, plp, sz, hpp, ohpp, &on_heap); + mp = erts_try_alloc_message_on_heap(pp, psp, plp, sz, hpp, ohpp, &on_heap); + ASSERT(pp || !on_heap); + return mp; } ERTS_GLB_INLINE ErtsMessage * @@ -2343,7 +2348,7 @@ erts_alloc_message_heap(Process *pp, Eterm **hpp, ErlOffHeap **ohpp) { - erts_aint32_t state = erts_smp_atomic32_read_nob(&pp->state); + erts_aint32_t state = pp ? erts_smp_atomic32_read_nob(&pp->state) : 0; return erts_alloc_message_heap_state(pp, &state, plp, sz, hpp, ohpp); } diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c index e1f470d381..a69185bc5c 100644 --- a/erts/emulator/beam/erl_process_lock.c +++ b/erts/emulator/beam/erl_process_lock.c @@ -106,6 +106,7 @@ static struct { Sint16 proc_lock_msgq; Sint16 proc_lock_btm; Sint16 proc_lock_status; + Sint16 proc_lock_trace; } lc_id; #endif @@ -152,6 +153,7 @@ erts_init_proc_lock(int cpus) lc_id.proc_lock_msgq = erts_lc_get_lock_order_id("proc_msgq"); lc_id.proc_lock_btm = erts_lc_get_lock_order_id("proc_btm"); lc_id.proc_lock_status = erts_lc_get_lock_order_id("proc_status"); + lc_id.proc_lock_trace = erts_lc_get_lock_order_id("proc_trace"); #endif } @@ -1057,6 +1059,11 @@ erts_proc_lock_init(Process *p) #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_trylock(1, &p->lock.status.lc); #endif + erts_mtx_init_x(&p->lock.trace, "proc_trace", p->common.id, do_lock_count); + ethr_mutex_lock(&p->lock.trace.mtx); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_trylock(1, &p->lock.trace.lc); +#endif #endif #ifdef ERTS_PROC_LOCK_DEBUG for (i = 0; i <= ERTS_PROC_LOCK_MAX_BIT; i++) @@ -1078,6 +1085,7 @@ erts_proc_lock_fin(Process *p) erts_mtx_destroy(&p->lock.msgq); erts_mtx_destroy(&p->lock.btm); erts_mtx_destroy(&p->lock.status); + erts_mtx_destroy(&p->lock.trace); #endif #if defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP) erts_lcnt_proc_lock_destroy(p); @@ -1100,26 +1108,29 @@ void erts_lcnt_enable_proc_lock_count(int enable) { void erts_lcnt_proc_lock_init(Process *p) { if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) { erts_lcnt_init_lock_empty(&(p->lock.lcnt_main)); + erts_lcnt_init_lock_empty(&(p->lock.lcnt_link)); erts_lcnt_init_lock_empty(&(p->lock.lcnt_msgq)); erts_lcnt_init_lock_empty(&(p->lock.lcnt_btm)); - erts_lcnt_init_lock_empty(&(p->lock.lcnt_link)); erts_lcnt_init_lock_empty(&(p->lock.lcnt_status)); + erts_lcnt_init_lock_empty(&(p->lock.lcnt_trace)); } else { /* now the common case */ Eterm pid = (p->common.id != ERTS_INVALID_PID) ? p->common.id : NIL; erts_lcnt_init_lock_x(&(p->lock.lcnt_main), "proc_main", ERTS_LCNT_LT_PROCLOCK, pid); + erts_lcnt_init_lock_x(&(p->lock.lcnt_link), "proc_link", ERTS_LCNT_LT_PROCLOCK, pid); erts_lcnt_init_lock_x(&(p->lock.lcnt_msgq), "proc_msgq", ERTS_LCNT_LT_PROCLOCK, pid); erts_lcnt_init_lock_x(&(p->lock.lcnt_btm), "proc_btm", ERTS_LCNT_LT_PROCLOCK, pid); - erts_lcnt_init_lock_x(&(p->lock.lcnt_link), "proc_link", ERTS_LCNT_LT_PROCLOCK, pid); erts_lcnt_init_lock_x(&(p->lock.lcnt_status),"proc_status",ERTS_LCNT_LT_PROCLOCK, pid); + erts_lcnt_init_lock_x(&(p->lock.lcnt_trace), "proc_trace", ERTS_LCNT_LT_PROCLOCK, pid); } /* the lock names should really be aligned to four characters */ } /* logic reversed */ void erts_lcnt_proc_lock_destroy(Process *p) { erts_lcnt_destroy_lock(&(p->lock.lcnt_main)); + erts_lcnt_destroy_lock(&(p->lock.lcnt_link)); erts_lcnt_destroy_lock(&(p->lock.lcnt_msgq)); erts_lcnt_destroy_lock(&(p->lock.lcnt_btm)); - erts_lcnt_destroy_lock(&(p->lock.lcnt_link)); erts_lcnt_destroy_lock(&(p->lock.lcnt_status)); + erts_lcnt_destroy_lock(&(p->lock.lcnt_trace)); } static void lcnt_enable_proc_lock_count(Process *proc, int enable) { @@ -1138,10 +1149,11 @@ static void lcnt_enable_proc_lock_count(Process *proc, int enable) { void erts_lcnt_proc_lock(erts_proc_lock_t *lock, ErtsProcLocks locks) { if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) return; if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_lock(&(lock->lcnt_main)); } + if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_lock(&(lock->lcnt_link)); } if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_lock(&(lock->lcnt_msgq)); } if (locks & ERTS_PROC_LOCK_BTM) { erts_lcnt_lock(&(lock->lcnt_btm)); } - if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_lock(&(lock->lcnt_link)); } if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_lock(&(lock->lcnt_status)); } + if (locks & ERTS_PROC_LOCK_TRACE) { erts_lcnt_lock(&(lock->lcnt_trace)); } } void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks, @@ -1150,44 +1162,50 @@ void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks, if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_lock_post_x(&(lock->lcnt_main), file, line); } + if (locks & ERTS_PROC_LOCK_LINK) { + erts_lcnt_lock_post_x(&(lock->lcnt_link), file, line); + } if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_lock_post_x(&(lock->lcnt_msgq), file, line); } if (locks & ERTS_PROC_LOCK_BTM) { erts_lcnt_lock_post_x(&(lock->lcnt_btm), file, line); } - if (locks & ERTS_PROC_LOCK_LINK) { - erts_lcnt_lock_post_x(&(lock->lcnt_link), file, line); - } if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_lock_post_x(&(lock->lcnt_status), file, line); } + if (locks & ERTS_PROC_LOCK_TRACE) { + erts_lcnt_lock_post_x(&(lock->lcnt_trace), file, line); + } } void erts_lcnt_proc_lock_unaquire(erts_proc_lock_t *lock, ErtsProcLocks locks) { if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) return; if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_lock_unaquire(&(lock->lcnt_main)); } + if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_lock_unaquire(&(lock->lcnt_link)); } if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_lock_unaquire(&(lock->lcnt_msgq)); } if (locks & ERTS_PROC_LOCK_BTM) { erts_lcnt_lock_unaquire(&(lock->lcnt_btm)); } - if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_lock_unaquire(&(lock->lcnt_link)); } if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_lock_unaquire(&(lock->lcnt_status)); } + if (locks & ERTS_PROC_LOCK_TRACE) { erts_lcnt_lock_unaquire(&(lock->lcnt_trace)); } } void erts_lcnt_proc_unlock(erts_proc_lock_t *lock, ErtsProcLocks locks) { if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) return; if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_unlock(&(lock->lcnt_main)); } + if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_unlock(&(lock->lcnt_link)); } if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_unlock(&(lock->lcnt_msgq)); } if (locks & ERTS_PROC_LOCK_BTM) { erts_lcnt_unlock(&(lock->lcnt_btm)); } - if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_unlock(&(lock->lcnt_link)); } if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_unlock(&(lock->lcnt_status)); } + if (locks & ERTS_PROC_LOCK_TRACE) { erts_lcnt_unlock(&(lock->lcnt_trace)); } } void erts_lcnt_proc_trylock(erts_proc_lock_t *lock, ErtsProcLocks locks, int res) { if (!(erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK)) return; if (locks & ERTS_PROC_LOCK_MAIN) { erts_lcnt_trylock(&(lock->lcnt_main), res); } + if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_trylock(&(lock->lcnt_link), res); } if (locks & ERTS_PROC_LOCK_MSGQ) { erts_lcnt_trylock(&(lock->lcnt_msgq), res); } if (locks & ERTS_PROC_LOCK_BTM) { erts_lcnt_trylock(&(lock->lcnt_btm), res); } - if (locks & ERTS_PROC_LOCK_LINK) { erts_lcnt_trylock(&(lock->lcnt_link), res); } if (locks & ERTS_PROC_LOCK_STATUS) { erts_lcnt_trylock(&(lock->lcnt_status), res); } + if (locks & ERTS_PROC_LOCK_TRACE) { erts_lcnt_trylock(&(lock->lcnt_trace), res); } } /* reversed logic */ #endif /* ERTS_ENABLE_LOCK_COUNT */ @@ -1224,6 +1242,10 @@ erts_proc_lc_lock(Process *p, ErtsProcLocks locks, char *file, unsigned int line lck.id = lc_id.proc_lock_status; erts_lc_lock_x(&lck,file,line); } + if (locks & ERTS_PROC_LOCK_TRACE) { + lck.id = lc_id.proc_lock_trace; + erts_lc_lock_x(&lck,file,line); + } } void @@ -1253,6 +1275,10 @@ erts_proc_lc_trylock(Process *p, ErtsProcLocks locks, int locked, lck.id = lc_id.proc_lock_status; erts_lc_trylock_x(locked, &lck, file, line); } + if (locks & ERTS_PROC_LOCK_TRACE) { + lck.id = lc_id.proc_lock_trace; + erts_lc_trylock_x(locked, &lck, file, line); + } } void @@ -1261,6 +1287,10 @@ erts_proc_lc_unlock(Process *p, ErtsProcLocks locks) erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, p->common.id, ERTS_LC_FLG_LT_PROCLOCK); + if (locks & ERTS_PROC_LOCK_TRACE) { + lck.id = lc_id.proc_lock_trace; + erts_lc_unlock(&lck); + } if (locks & ERTS_PROC_LOCK_STATUS) { lck.id = lc_id.proc_lock_status; erts_lc_unlock(&lck); @@ -1292,6 +1322,10 @@ erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks) erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, p->common.id, ERTS_LC_FLG_LT_PROCLOCK); + if (locks & ERTS_PROC_LOCK_TRACE) { + lck.id = lc_id.proc_lock_trace; + erts_lc_might_unlock(&lck); + } if (locks & ERTS_PROC_LOCK_STATUS) { lck.id = lc_id.proc_lock_status; erts_lc_might_unlock(&lck); @@ -1323,6 +1357,8 @@ erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks) erts_lc_might_unlock(&p->lock.btm.lc); if (locks & ERTS_PROC_LOCK_STATUS) erts_lc_might_unlock(&p->lock.status.lc); + if (locks & ERTS_PROC_LOCK_TRACE) + erts_lc_might_unlock(&p->lock.trace.lc); #endif } @@ -1354,6 +1390,10 @@ erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, char *file, lck.id = lc_id.proc_lock_status; erts_lc_require_lock(&lck, file, line); } + if (locks & ERTS_PROC_LOCK_TRACE) { + lck.id = lc_id.proc_lock_trace; + erts_lc_require_lock(&lck, file, line); + } #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL if (locks & ERTS_PROC_LOCK_MAIN) erts_lc_require_lock(&p->lock.main.lc, file, line); @@ -1365,6 +1405,8 @@ erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks, char *file, erts_lc_require_lock(&p->lock.btm.lc, file, line); if (locks & ERTS_PROC_LOCK_STATUS) erts_lc_require_lock(&p->lock.status.lc, file, line); + if (locks & ERTS_PROC_LOCK_TRACE) + erts_lc_require_lock(&p->lock.trace.lc, file, line); #endif } @@ -1375,6 +1417,10 @@ erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks) erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, p->common.id, ERTS_LC_FLG_LT_PROCLOCK); + if (locks & ERTS_PROC_LOCK_TRACE) { + lck.id = lc_id.proc_lock_trace; + erts_lc_unrequire_lock(&lck); + } if (locks & ERTS_PROC_LOCK_STATUS) { lck.id = lc_id.proc_lock_status; erts_lc_unrequire_lock(&lck); @@ -1406,6 +1452,8 @@ erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks) erts_lc_unrequire_lock(&p->lock.btm.lc); if (locks & ERTS_PROC_LOCK_STATUS) erts_lc_unrequire_lock(&p->lock.status.lc); + if (locks & ERTS_PROC_LOCK_TRACE) + erts_lc_unrequire_lock(&p->lock.trace.lc); #endif } @@ -1429,6 +1477,8 @@ erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks) lck.id = lc_id.proc_lock_btm; else if (locks & ERTS_PROC_LOCK_STATUS) lck.id = lc_id.proc_lock_status; + else if (locks & ERTS_PROC_LOCK_TRACE) + lck.id = lc_id.proc_lock_trace; else erts_lc_fail("Unknown proc lock found"); @@ -1441,14 +1491,7 @@ erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks) void erts_proc_lc_chk_only_proc_main(Process *p) { -#if ERTS_PROC_LOCK_OWN_IMPL - erts_lc_lock_t proc_main = ERTS_LC_LOCK_INIT(lc_id.proc_lock_main, - p->common.id, - ERTS_LC_FLG_LT_PROCLOCK); - erts_lc_check_exact(&proc_main, 1); -#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL - erts_lc_check_exact(&p->lock.main.lc, 1); -#endif + erts_proc_lc_chk_only_proc(p, ERTS_PROC_LOCK_MAIN); } #if ERTS_PROC_LOCK_OWN_IMPL @@ -1456,14 +1499,67 @@ void erts_proc_lc_chk_only_proc_main(Process *p) ERTS_LC_LOCK_INIT(-1, THE_NON_VALUE, ERTS_LC_FLG_LT_PROCLOCK) #endif /* ERTS_PROC_LOCK_OWN_IMPL */ +void erts_proc_lc_chk_only_proc(Process *p, ErtsProcLocks locks) +{ + int have_locks_len = 0; +#if ERTS_PROC_LOCK_OWN_IMPL + erts_lc_lock_t have_locks[6] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT}; + if (locks & ERTS_PROC_LOCK_MAIN) { + have_locks[have_locks_len].id = lc_id.proc_lock_main; + have_locks[have_locks_len++].extra = p->common.id; + } + if (locks & ERTS_PROC_LOCK_LINK) { + have_locks[have_locks_len].id = lc_id.proc_lock_link; + have_locks[have_locks_len++].extra = p->common.id; + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + have_locks[have_locks_len].id = lc_id.proc_lock_msgq; + have_locks[have_locks_len++].extra = p->common.id; + } + if (locks & ERTS_PROC_LOCK_BTM) { + have_locks[have_locks_len].id = lc_id.proc_lock_btm; + have_locks[have_locks_len++].extra = p->common.id; + } + if (locks & ERTS_PROC_LOCK_STATUS) { + have_locks[have_locks_len].id = lc_id.proc_lock_status; + have_locks[have_locks_len++].extra = p->common.id; + } + if (locks & ERTS_PROC_LOCK_TRACE) { + have_locks[have_locks_len].id = lc_id.proc_lock_trace; + have_locks[have_locks_len++].extra = p->common.id; + } +#elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL + erts_lc_lock_t have_locks[6]; + if (locks & ERTS_PROC_LOCK_MAIN) + have_locks[have_locks_len++] = p->lock.main.lc; + if (locks & ERTS_PROC_LOCK_LINK) + have_locks[have_locks_len++] = p->lock.link.lc; + if (locks & ERTS_PROC_LOCK_MSGQ) + have_locks[have_locks_len++] = p->lock.msgq.lc; + if (locks & ERTS_PROC_LOCK_BTM) + have_locks[have_locks_len++] = p->lock.btm.lc; + if (locks & ERTS_PROC_LOCK_STATUS) + have_locks[have_locks_len++] = p->lock.status.lc; + if (locks & ERTS_PROC_LOCK_TRACE) + have_locks[have_locks_len++] = p->lock.trace.lc; +#endif + erts_lc_check_exact(have_locks, have_locks_len); +} + void erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks) { int have_locks_len = 0; #if ERTS_PROC_LOCK_OWN_IMPL - erts_lc_lock_t have_locks[5] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + erts_lc_lock_t have_locks[6] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT}; if (locks & ERTS_PROC_LOCK_MAIN) { @@ -1486,8 +1582,12 @@ erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks) have_locks[have_locks_len].id = lc_id.proc_lock_status; have_locks[have_locks_len++].extra = p->common.id; } + if (locks & ERTS_PROC_LOCK_TRACE) { + have_locks[have_locks_len].id = lc_id.proc_lock_trace; + have_locks[have_locks_len++].extra = p->common.id; + } #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL - erts_lc_lock_t have_locks[5]; + erts_lc_lock_t have_locks[6]; if (locks & ERTS_PROC_LOCK_MAIN) have_locks[have_locks_len++] = p->lock.main.lc; if (locks & ERTS_PROC_LOCK_LINK) @@ -1498,6 +1598,8 @@ erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks) have_locks[have_locks_len++] = p->lock.btm.lc; if (locks & ERTS_PROC_LOCK_STATUS) have_locks[have_locks_len++] = p->lock.status.lc; + if (locks & ERTS_PROC_LOCK_TRACE) + have_locks[have_locks_len++] = p->lock.trace.lc; #endif erts_lc_check(have_locks, have_locks_len, NULL, 0); } @@ -1508,12 +1610,14 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks) int have_locks_len = 0; int have_not_locks_len = 0; #if ERTS_PROC_LOCK_OWN_IMPL - erts_lc_lock_t have_locks[5] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + erts_lc_lock_t have_locks[6] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT}; - erts_lc_lock_t have_not_locks[5] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + erts_lc_lock_t have_not_locks[6] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT, ERTS_PROC_LC_EMPTY_LOCK_INIT}; @@ -1557,9 +1661,17 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks) have_not_locks[have_not_locks_len].id = lc_id.proc_lock_status; have_not_locks[have_not_locks_len++].extra = p->common.id; } + if (locks & ERTS_PROC_LOCK_TRACE) { + have_locks[have_locks_len].id = lc_id.proc_lock_trace; + have_locks[have_locks_len++].extra = p->common.id; + } + else { + have_not_locks[have_not_locks_len].id = lc_id.proc_lock_trace; + have_not_locks[have_not_locks_len++].extra = p->common.id; + } #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL - erts_lc_lock_t have_locks[5]; - erts_lc_lock_t have_not_locks[5]; + erts_lc_lock_t have_locks[6]; + erts_lc_lock_t have_not_locks[6]; if (locks & ERTS_PROC_LOCK_MAIN) have_locks[have_locks_len++] = p->lock.main.lc; @@ -1581,6 +1693,10 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks) have_locks[have_locks_len++] = p->lock.status.lc; else have_not_locks[have_not_locks_len++] = p->lock.status.lc; + if (locks & ERTS_PROC_LOCK_TRACE) + have_locks[have_locks_len++] = p->lock.trace.lc; + else + have_not_locks[have_not_locks_len++] = p->lock.trace.lc; #endif erts_lc_check(have_locks, have_locks_len, @@ -1590,10 +1706,10 @@ erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks) ErtsProcLocks erts_proc_lc_my_proc_locks(Process *p) { - int resv[5]; + int resv[6]; ErtsProcLocks res = 0; #if ERTS_PROC_LOCK_OWN_IMPL - erts_lc_lock_t locks[5] = {ERTS_LC_LOCK_INIT(lc_id.proc_lock_main, + erts_lc_lock_t locks[6] = {ERTS_LC_LOCK_INIT(lc_id.proc_lock_main, p->common.id, ERTS_LC_FLG_LT_PROCLOCK), ERTS_LC_LOCK_INIT(lc_id.proc_lock_link, @@ -1607,16 +1723,20 @@ erts_proc_lc_my_proc_locks(Process *p) ERTS_LC_FLG_LT_PROCLOCK), ERTS_LC_LOCK_INIT(lc_id.proc_lock_status, p->common.id, + ERTS_LC_FLG_LT_PROCLOCK), + ERTS_LC_LOCK_INIT(lc_id.proc_lock_trace, + p->common.id, ERTS_LC_FLG_LT_PROCLOCK)}; #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL - erts_lc_lock_t locks[5] = {p->lock.main.lc, + erts_lc_lock_t locks[6] = {p->lock.main.lc, p->lock.link.lc, p->lock.msgq.lc, p->lock.btm.lc, - p->lock.status.lc}; + p->lock.status.lc, + p->lock.trace.lc}; #endif - erts_lc_have_locks(resv, locks, 5); + erts_lc_have_locks(resv, locks, 6); if (resv[0]) res |= ERTS_PROC_LOCK_MAIN; if (resv[1]) @@ -1627,6 +1747,8 @@ erts_proc_lc_my_proc_locks(Process *p) res |= ERTS_PROC_LOCK_BTM; if (resv[4]) res |= ERTS_PROC_LOCK_STATUS; + if (resv[5]) + res |= ERTS_PROC_LOCK_TRACE; return res; } @@ -1634,14 +1756,15 @@ erts_proc_lc_my_proc_locks(Process *p) void erts_proc_lc_chk_no_proc_locks(char *file, int line) { - int resv[5]; - int ids[5] = {lc_id.proc_lock_main, + int resv[6]; + int ids[6] = {lc_id.proc_lock_main, lc_id.proc_lock_link, lc_id.proc_lock_msgq, lc_id.proc_lock_btm, - lc_id.proc_lock_status}; - erts_lc_have_lock_ids(resv, ids, 5); - if (!ERTS_IS_CRASH_DUMPING && (resv[0] || resv[1] || resv[2] || resv[3] || resv[4])) { + lc_id.proc_lock_status, + lc_id.proc_lock_trace}; + erts_lc_have_lock_ids(resv, ids, 6); + if (!ERTS_IS_CRASH_DUMPING && (resv[0] || resv[1] || resv[2] || resv[3] || resv[4] || resv[5])) { erts_lc_fail("%s:%d: Thread has process locks locked when expected " "not to have any process locks locked", file, line); diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h index ac324c6f3e..2cccf0697a 100644 --- a/erts/emulator/beam/erl_process_lock.h +++ b/erts/emulator/beam/erl_process_lock.h @@ -66,7 +66,7 @@ #endif -#define ERTS_PROC_LOCK_MAX_BIT 4 +#define ERTS_PROC_LOCK_MAX_BIT 5 typedef erts_aint32_t ErtsProcLocks; @@ -84,6 +84,7 @@ typedef struct erts_proc_lock_t_ { erts_lcnt_lock_t lcnt_msgq; erts_lcnt_lock_t lcnt_btm; erts_lcnt_lock_t lcnt_status; + erts_lcnt_lock_t lcnt_trace; #endif #elif ERTS_PROC_LOCK_RAW_MUTEX_IMPL erts_mtx_t main; @@ -91,6 +92,7 @@ typedef struct erts_proc_lock_t_ { erts_mtx_t msgq; erts_mtx_t btm; erts_mtx_t status; + erts_mtx_t trace; #else # error "no implementation" #endif @@ -137,9 +139,18 @@ typedef struct erts_proc_lock_t_ { * Protects the following fields in the process structure: * * pending_suspenders * * suspendee + * * sys_tasks * * ... */ -#define ERTS_PROC_LOCK_STATUS (((ErtsProcLocks) 1) << ERTS_PROC_LOCK_MAX_BIT) +#define ERTS_PROC_LOCK_STATUS (((ErtsProcLocks) 1) << 4) + +/* + * Trace message lock: + * Protects the order in which messages are sent + * from trace nifs. This lock is taken inside enif_send. + * + */ +#define ERTS_PROC_LOCK_TRACE (((ErtsProcLocks) 1) << ERTS_PROC_LOCK_MAX_BIT) /* * Special fields: @@ -154,8 +165,8 @@ typedef struct erts_proc_lock_t_ { * all process locks are held, and are allowed to be read if * at least one process lock (whichever one doesn't matter) * is held: - * * tracer_proc - * * tracer_flags + * * common.tracer + * * common.trace_flags * * The following fields are only allowed to be accessed if * both the schedule queue lock and at least one process lock @@ -198,17 +209,15 @@ typedef struct erts_proc_lock_t_ { /* ERTS_PROC_LOCKS_* are combinations of process locks */ -#define ERTS_PROC_LOCKS_MSG_RECEIVE (ERTS_PROC_LOCK_MSGQ \ - | ERTS_PROC_LOCK_STATUS) -#define ERTS_PROC_LOCKS_MSG_SEND (ERTS_PROC_LOCK_MSGQ \ - | ERTS_PROC_LOCK_STATUS) +#define ERTS_PROC_LOCKS_MSG_RECEIVE ERTS_PROC_LOCK_MSGQ +#define ERTS_PROC_LOCKS_MSG_SEND ERTS_PROC_LOCK_MSGQ #define ERTS_PROC_LOCKS_XSIG_SEND ERTS_PROC_LOCK_STATUS #define ERTS_PROC_LOCKS_ALL \ ((((ErtsProcLocks) 1) << (ERTS_PROC_LOCK_MAX_BIT + 1)) - 1) #define ERTS_PROC_LOCKS_ALL_MINOR (ERTS_PROC_LOCKS_ALL \ - & ~ERTS_PROC_LOCK_MAIN) + & ~ERTS_PROC_LOCK_MAIN) #define ERTS_PIX_LOCKS_BITS 10 @@ -260,6 +269,7 @@ void erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks); void erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks); void erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks); void erts_proc_lc_chk_only_proc_main(Process *p); +void erts_proc_lc_chk_only_proc(Process *p, ErtsProcLocks locks); void erts_proc_lc_chk_no_proc_locks(char *file, int line); ErtsProcLocks erts_proc_lc_my_proc_locks(Process *p); int erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks); @@ -477,9 +487,15 @@ erts_smp_proc_raw_trylock__(Process *p, ErtsProcLocks locks) if (locks & ERTS_PROC_LOCK_STATUS) if (erts_mtx_trylock(&p->lock.status) == EBUSY) goto busy_status; + if (locks & ERTS_PROC_LOCK_TRACE) + if (erts_mtx_trylock(&p->lock.trace) == EBUSY) + goto busy_trace; return 0; +busy_trace: + if (locks & ERTS_PROC_LOCK_TRACE) + erts_mtx_unlock(&p->lock.trace); busy_status: if (locks & ERTS_PROC_LOCK_BTM) erts_mtx_unlock(&p->lock.btm); @@ -568,6 +584,8 @@ erts_smp_proc_lock__(Process *p, erts_mtx_lock(&p->lock.btm); if (locks & ERTS_PROC_LOCK_STATUS) erts_mtx_lock(&p->lock.status); + if (locks & ERTS_PROC_LOCK_TRACE) + erts_mtx_lock(&p->lock.trace); #ifdef ERTS_PROC_LOCK_DEBUG erts_proc_lock_op_debug(p, locks, 1); @@ -653,6 +671,8 @@ erts_smp_proc_unlock__(Process *p, erts_proc_lock_op_debug(p, locks, 0); #endif + if (locks & ERTS_PROC_LOCK_TRACE) + erts_mtx_unlock(&p->lock.trace); if (locks & ERTS_PROC_LOCK_STATUS) erts_mtx_unlock(&p->lock.status); if (locks & ERTS_PROC_LOCK_BTM) diff --git a/erts/emulator/beam/erl_ptab.h b/erts/emulator/beam/erl_ptab.h index 97df8bc3fc..a5931ffc25 100644 --- a/erts/emulator/beam/erl_ptab.h +++ b/erts/emulator/beam/erl_ptab.h @@ -37,14 +37,16 @@ #include "erl_alloc.h" #include "erl_monitors.h" -#define ERTS_TRACER_PROC(P) ((P)->common.tracer_proc) +#define ERTS_TRACER(P) ((P)->common.tracer) +#define ERTS_TRACER_MODULE(T) (CAR(list_val(T))) +#define ERTS_TRACER_STATE(T) (CDR(list_val(T))) #define ERTS_TRACE_FLAGS(P) ((P)->common.trace_flags) #define ERTS_P_LINKS(P) ((P)->common.u.alive.links) #define ERTS_P_MONITORS(P) ((P)->common.u.alive.monitors) #define IS_TRACED(p) \ - (ERTS_TRACER_PROC((p)) != NIL) + (ERTS_TRACER(p) != NIL) #define ARE_TRACE_FLAGS_ON(p,tf) \ ((ERTS_TRACE_FLAGS((p)) & (tf|F_SENSITIVE)) == (tf)) #define IS_TRACED_FL(p,tf) \ @@ -56,7 +58,7 @@ typedef struct { erts_atomic_t atmc; Sint sint; } refc; - Eterm tracer_proc; + ErtsTracer tracer; Uint trace_flags; erts_smp_atomic_t timer; union { diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c index 947def7398..346404fe2a 100644 --- a/erts/emulator/beam/erl_time_sup.c +++ b/erts/emulator/beam/erl_time_sup.c @@ -1966,7 +1966,7 @@ send_time_offset_changed_notifications(void *new_offsetp) *patch_refp = ref; ASSERT(hsz == size_object(message_template)); message = copy_struct(message_template, hsz, &hp, ohp); - erts_queue_message(rp, &rp_locks, mp, message, NIL); + erts_queue_message(rp, &rp_locks, mp, message); } erts_smp_proc_unlock(rp, rp_locks); } diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index fb3f0d4e62..56899f574a 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -20,6 +20,19 @@ /* * Support functions for tracing. + * + * Ideas for future speed improvements in tracing framework: + * * Move ErtsTracerNif into ErtsTracer + * + Removes need for locking + * + Removes hash lookup overhead + * + Use a refc on the ErtsTracerNif to know when it can + * be freed. We don't want to allocate a separate + * ErtsTracerNif for each module used. + * * Optimize GenericBp for cache locality by reusing equivalent + * GenericBp and GenericBpData in multiple tracer points. + * + Possibly we want to use specialized instructions for different + * types of trace so that the knowledge of which struct is used + * can be in the instruction. */ #ifdef HAVE_CONFIG_H @@ -39,6 +52,7 @@ #include "erl_bits.h" #include "erl_thr_progress.h" #include "erl_bif_unique.h" +#include "erl_map.h" #if 0 #define DEBUG_PRINTOUTS @@ -46,17 +60,15 @@ #undef DEBUG_PRINTOUTS #endif -extern BeamInstr beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */ -extern BeamInstr beam_return_trace[1]; /* OpCode(i_return_trace) */ -extern BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ - /* Pseudo export entries. Never filled in with data, only used to yield unique pointers of the correct type. */ Export exp_send, exp_receive, exp_timeout; -static Eterm system_seq_tracer; -static Uint default_trace_flags; -static Eterm default_tracer; +static ErtsTracer system_seq_tracer; +static Uint default_proc_trace_flags; +static ErtsTracer default_proc_tracer; +static Uint default_port_trace_flags; +static ErtsTracer default_port_tracer; static Eterm system_monitor; static Eterm system_profile; @@ -70,8 +82,6 @@ static erts_smp_rwmtx_t sys_trace_rwmtx; enum ErtsSysMsgType { SYS_MSG_TYPE_UNDEFINED, - SYS_MSG_TYPE_TRACE, - SYS_MSG_TYPE_SEQTRACE, SYS_MSG_TYPE_SYSMON, SYS_MSG_TYPE_ERRLGR, SYS_MSG_TYPE_PROC_MSG, @@ -227,6 +237,7 @@ write_timestamp(ErtsTraceTimeStamp *tsp, Eterm **hpp) } } +#ifdef ERTS_SMP #define PATCH_TS_SIZE(p) patch_ts_size(TFLGS_TS_TYPE(p)) static ERTS_INLINE Uint @@ -247,6 +258,7 @@ patch_ts_size(int ts_type) return 0; } } +#endif /* * Write a timestamp. The timestamp MUST be the last @@ -298,43 +310,6 @@ write_ts(int ts_type, Eterm *hp, ErlHeapFragment *bp, Process *tracer) return res; } -/* - * Patch a timestamp into a tuple. The tuple MUST be the last thing - * built on the heap before the call, and the timestamp MUST be - * the last thing after the call. This since patch_ts() might adjust - * the size of the used area. - */ - -#define PATCH_TS__(Type, Tuple, Hp, Bp, Tracer) \ - do { \ - int ts_type__ = (Type); \ - if (ts_type__) \ - patch_ts(ts_type__, (Tuple), (Hp), (Bp), (Tracer)); \ - } while (0) - -#ifdef ERTS_SMP -#define PATCH_TS(Type, Tuple, Hp, Bp, Tracer) \ - PATCH_TS__((Type), (Tuple), (Hp), (Bp), NULL) -#else -#define PATCH_TS(Type, Tuple, Hp, Bp, Tracer) \ - PATCH_TS__((Type), (Tuple), (Hp), (Bp), (Tracer)) -#endif - -static ERTS_INLINE void -patch_ts(int ts_type, Eterm tuple, Eterm* hp, ErlHeapFragment *bp, Process *tracer) -{ - Eterm *tptr = tuple_val(tuple); - int arity = arityval(*tptr); - - ASSERT(ts_type); - ASSERT((tptr+arity+1) == hp); - - tptr[0] = make_arityval(arity+1); - tptr[1] = am_trace_ts; - - *hp = write_ts(ts_type, hp+1, bp, tracer); -} - #ifdef ERTS_SMP static void enqueue_sys_msg_unlocked(enum ErtsSysMsgType type, Eterm from, @@ -349,6 +324,14 @@ static void enqueue_sys_msg(enum ErtsSysMsgType type, static void init_sys_msg_dispatcher(void); #endif +static void init_tracer_nif(void); +static int tracer_cmp_fun(void*, void*); +static HashValue tracer_hash_fun(void*); +static void *tracer_alloc_fun(void*); +static void tracer_free_fun(void*); + +typedef struct ErtsTracerNif_ ErtsTracerNif; + void erts_init_trace(void) { erts_smp_rwmtx_opt_t rwmtx_opts = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER; rwmtx_opts.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ; @@ -362,80 +345,66 @@ void erts_init_trace(void) { erts_bif_trace_init(); erts_system_monitor_clear(NULL); erts_system_profile_clear(NULL); - default_trace_flags = F_INITIAL_TRACE_FLAGS; - default_tracer = NIL; - system_seq_tracer = am_false; + default_proc_trace_flags = F_INITIAL_TRACE_FLAGS; + default_proc_tracer = erts_tracer_nil; + default_port_trace_flags = F_INITIAL_TRACE_FLAGS; + default_port_tracer = erts_tracer_nil; + system_seq_tracer = erts_tracer_nil; #ifdef ERTS_SMP init_sys_msg_dispatcher(); #endif + init_tracer_nif(); } -static Eterm system_seq_tracer; - #define ERTS_ALLOC_SYSMSG_HEAP(SZ, BPP, OHPP, UNUSED) \ (*(BPP) = new_message_buffer((SZ)), \ *(OHPP) = &(*(BPP))->off_heap, \ (*(BPP))->mem) -#ifdef ERTS_SMP -#define ERTS_ENQ_TRACE_MSG(FPID, TPID, MSG, BP) \ -do { \ - ERTS_LC_ASSERT(erts_smp_lc_mtx_is_locked(&smq_mtx)); \ - enqueue_sys_msg_unlocked(SYS_MSG_TYPE_TRACE, (FPID), (TPID), (MSG), (BP)); \ -} while(0) -#else -#define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \ - do { \ - ErtsMessage *mp__ = erts_alloc_message(0, NULL); \ - mp__->data.heap_frag = (BP); \ - erts_queue_message((TPROC), NULL, mp__, (MSG), NIL); \ - } while (0) -#endif +enum ErtsTracerOpt { + TRACE_FUN_DEFAULT = 0, + TRACE_FUN_ENABLED = 1, + TRACE_FUN_T_SEND = 2, + TRACE_FUN_T_RECEIVE = 3, + TRACE_FUN_T_CALL = 4, + TRACE_FUN_T_SCHED_PROC = 5, + TRACE_FUN_T_SCHED_PORT = 6, + TRACE_FUN_T_GC = 7, + TRACE_FUN_T_PROCS = 8, + TRACE_FUN_T_PORTS = 9, + TRACE_FUN_E_SEND = 10, + TRACE_FUN_E_RECEIVE = 11, + TRACE_FUN_E_CALL = 12, + TRACE_FUN_E_SCHED_PROC = 13, + TRACE_FUN_E_SCHED_PORT = 14, + TRACE_FUN_E_GC = 15, + TRACE_FUN_E_PROCS = 16, + TRACE_FUN_E_PORTS = 17 +}; -/* - * NOTE that the ERTS_GET_TRACER_REF() returns from the function (!!!) - * using it, and resets the parameters used if the tracer is invalid, i.e., - * use it with extreme care! - */ -#ifdef ERTS_SMP -#define ERTS_NULL_TRACER_REF NIL -#define ERTS_TRACER_REF_TYPE Eterm - /* In the smp case, we never find the tracer invalid here (the sys - message dispatcher thread takes care of that). */ -#define ERTS_GET_TRACER_REF(RES, TPID, TRACEE_FLGS) \ -do { (RES) = (TPID); } while(0) -int -erts_is_tracer_proc_valid(Process* p) -{ - return 1; -} -#else -#define ERTS_NULL_TRACER_REF NULL -#define ERTS_TRACER_REF_TYPE Process * -#define ERTS_GET_TRACER_REF(RES, TPID, TRACEE_FLGS) \ -do { \ - (RES) = erts_proc_lookup((TPID)); \ - if (!(RES) || !(ERTS_TRACE_FLAGS((RES)) & F_TRACER)) { \ - (TPID) = NIL; \ - (TRACEE_FLGS) &= ~TRACEE_FLAGS; \ - return; \ - } \ -} while (0) -int -erts_is_tracer_proc_valid(Process* p) -{ - Process* tracer; +#define NIF_TRACER_TYPES (18) - tracer = erts_proc_lookup(ERTS_TRACER_PROC(p)); - if (tracer && ERTS_TRACE_FLAGS(tracer) & F_TRACER) { - return 1; - } else { - ERTS_TRACER_PROC(p) = NIL; - ERTS_TRACE_FLAGS(p) = ~TRACEE_FLAGS; - return 0; - } -} -#endif + +static ERTS_INLINE int +send_to_tracer_nif_raw(Process *c_p, Process *tracee, const ErtsTracer tracer, + Uint trace_flags, Eterm t_p_id, ErtsTracerNif *tnif, + enum ErtsTracerOpt topt, + Eterm tag, Eterm msg, Eterm extra, Eterm pam_result); +static ERTS_INLINE int +send_to_tracer_nif(Process *c_p, ErtsPTabElementCommon *t_p, + Eterm t_p_id, ErtsTracerNif *tnif, + enum ErtsTracerOpt topt, + Eterm tag, Eterm msg, Eterm extra); +static ERTS_INLINE Eterm +call_enabled_tracer(Process *c_p, const ErtsTracer tracer, + ErtsTracerNif **tnif_ref, + enum ErtsTracerOpt topt, + Eterm tag, Eterm t_p_id); +static int +is_tracer_enabled(Process* c_p, ErtsProcLocks c_p_locks, + ErtsPTabElementCommon *t_p, + ErtsTracerNif **tnif_ret, + enum ErtsTracerOpt topt, Eterm tag); static Uint active_sched; @@ -450,19 +419,6 @@ static void exiting_reset(Eterm exiting) { erts_smp_rwmtx_rwlock(&sys_trace_rwmtx); - if (exiting == default_tracer) { - default_tracer = NIL; - default_trace_flags &= TRACEE_FLAGS; -#ifdef DEBUG - default_trace_flags |= F_INITIAL_TRACE_FLAGS; -#endif - } - if (exiting == system_seq_tracer) { -#ifdef DEBUG_PRINTOUTS - erts_fprintf(stderr, "seq tracer %T exited\n", exiting); -#endif - system_seq_tracer = am_false; - } if (exiting == system_monitor) { #ifdef ERTS_SMP system_monitor = NIL; @@ -487,11 +443,7 @@ erts_trace_check_exiting(Eterm exiting) { int reset = 0; erts_smp_rwmtx_rlock(&sys_trace_rwmtx); - if (exiting == default_tracer) - reset = 1; - else if (exiting == system_seq_tracer) - reset = 1; - else if (exiting == system_monitor) + if (exiting == system_monitor) reset = 1; else if (exiting == system_profile) reset = 1; @@ -500,23 +452,26 @@ erts_trace_check_exiting(Eterm exiting) exiting_reset(exiting); } -static ERTS_INLINE int -is_valid_tracer(Eterm tracer) +ErtsTracer +erts_set_system_seq_tracer(Process *c_p, ErtsProcLocks c_p_locks, ErtsTracer new) { - return erts_proc_lookup(tracer) || erts_is_valid_tracer_port(tracer); -} + ErtsTracer old; -Eterm -erts_set_system_seq_tracer(Process *c_p, ErtsProcLocks c_p_locks, Eterm new) -{ - Eterm old; - - if (new != am_false && !is_valid_tracer(new)) - return THE_NON_VALUE; + if (!ERTS_TRACER_IS_NIL(new)) { + Eterm nif_result = call_enabled_tracer( + NULL, new, NULL, + TRACE_FUN_ENABLED, am_trace_status, am_undefined); + switch (nif_result) { + case am_trace: break; + default: + return THE_NON_VALUE; + } + } erts_smp_rwmtx_rwlock(&sys_trace_rwmtx); old = system_seq_tracer; - system_seq_tracer = new; + system_seq_tracer = erts_tracer_nil; + erts_tracer_update(&system_seq_tracer, new); #ifdef DEBUG_PRINTOUTS erts_fprintf(stderr, "set seq tracer new=%T old=%T\n", new, old); @@ -525,66 +480,134 @@ erts_set_system_seq_tracer(Process *c_p, ErtsProcLocks c_p_locks, Eterm new) return old; } -Eterm +ErtsTracer erts_get_system_seq_tracer(void) { - Eterm st; + ErtsTracer st; erts_smp_rwmtx_rlock(&sys_trace_rwmtx); st = system_seq_tracer; #ifdef DEBUG_PRINTOUTS erts_fprintf(stderr, "get seq tracer %T\n", st); #endif erts_smp_rwmtx_runlock(&sys_trace_rwmtx); + + if (st != erts_tracer_nil && + call_enabled_tracer(NULL, st, NULL, TRACE_FUN_ENABLED, + am_trace_status, am_undefined) == am_remove) { + erts_set_system_seq_tracer(NULL, 0, erts_tracer_nil); + st = erts_tracer_nil; + } + return st; } static ERTS_INLINE void -get_default_tracing(Uint *flagsp, Eterm *tracerp) -{ - if (!(default_trace_flags & TRACEE_FLAGS)) - default_tracer = NIL; - - if (is_nil(default_tracer)) { - default_trace_flags &= ~TRACEE_FLAGS; - } else if (is_internal_pid(default_tracer)) { - if (!erts_proc_lookup(default_tracer)) { - reset_tracer: - default_trace_flags &= ~TRACEE_FLAGS; - default_tracer = NIL; - } +get_default_tracing(Uint *flagsp, ErtsTracer *tracerp, + Uint *default_trace_flags, + ErtsTracer *default_tracer) +{ + if (!(*default_trace_flags & TRACEE_FLAGS)) + ERTS_TRACER_CLEAR(default_tracer); + + if (ERTS_TRACER_IS_NIL(*default_tracer)) { + *default_trace_flags &= ~TRACEE_FLAGS; } else { - ASSERT(is_internal_port(default_tracer)); - if (!erts_is_valid_tracer_port(default_tracer)) - goto reset_tracer; + Eterm nif_res; + nif_res = call_enabled_tracer(NULL, *default_tracer, + NULL, TRACE_FUN_ENABLED, + am_trace_status, am_undefined); + switch (nif_res) { + case am_trace: break; + default: { + ErtsTracer curr_default_tracer = *default_tracer; + if (tracerp) { + /* we only have a rlock, so we have to unlock and then rwlock */ + erts_smp_rwmtx_runlock(&sys_trace_rwmtx); + erts_smp_rwmtx_rwlock(&sys_trace_rwmtx); + } + /* check if someone else changed default tracer + while we got the write lock, if so we don't do + anything. */ + if (curr_default_tracer == *default_tracer) { + *default_trace_flags &= ~TRACEE_FLAGS; + ERTS_TRACER_CLEAR(default_tracer); + } + if (tracerp) { + erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx); + erts_smp_rwmtx_rlock(&sys_trace_rwmtx); + } + } + } } if (flagsp) - *flagsp = default_trace_flags; - if (tracerp) - *tracerp = default_tracer; + *flagsp = *default_trace_flags; + if (tracerp) { + erts_tracer_update(tracerp,*default_tracer); + } +} + +static ERTS_INLINE void +erts_change_default_tracing(int setflags, Uint flags, + const ErtsTracer tracer, + Uint *default_trace_flags, + ErtsTracer *default_tracer) +{ + if (setflags) + *default_trace_flags |= flags; + else + *default_trace_flags &= ~flags; + + erts_tracer_update(default_tracer, tracer); + + get_default_tracing(NULL, NULL, default_trace_flags, default_tracer); } void -erts_change_default_tracing(int setflags, Uint *flagsp, Eterm *tracerp) +erts_change_default_proc_tracing(int setflags, Uint flagsp, + const ErtsTracer tracer) { erts_smp_rwmtx_rwlock(&sys_trace_rwmtx); - if (flagsp) { - if (setflags) - default_trace_flags |= *flagsp; - else - default_trace_flags &= ~(*flagsp); - } - if (tracerp) - default_tracer = *tracerp; - get_default_tracing(flagsp, tracerp); + erts_change_default_tracing( + setflags, flagsp, tracer, + &default_proc_trace_flags, + &default_proc_tracer); + erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx); +} + +void +erts_change_default_port_tracing(int setflags, Uint flagsp, + const ErtsTracer tracer) +{ + erts_smp_rwmtx_rwlock(&sys_trace_rwmtx); + erts_change_default_tracing( + setflags, flagsp, tracer, + &default_port_trace_flags, + &default_port_tracer); erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx); } void -erts_get_default_tracing(Uint *flagsp, Eterm *tracerp) +erts_get_default_proc_tracing(Uint *flagsp, ErtsTracer *tracerp) +{ + erts_smp_rwmtx_rlock(&sys_trace_rwmtx); + *tracerp = erts_tracer_nil; /* initialize */ + get_default_tracing( + flagsp, tracerp, + &default_proc_trace_flags, + &default_proc_tracer); + erts_smp_rwmtx_runlock(&sys_trace_rwmtx); +} + +void +erts_get_default_port_tracing(Uint *flagsp, ErtsTracer *tracerp) { erts_smp_rwmtx_rlock(&sys_trace_rwmtx); - get_default_tracing(flagsp, tracerp); + *tracerp = erts_tracer_nil; /* initialize */ + get_default_tracing( + flagsp, tracerp, + &default_port_trace_flags, + &default_port_tracer); erts_smp_rwmtx_runlock(&sys_trace_rwmtx); } @@ -622,29 +645,21 @@ erts_get_system_profile(void) { return profile; } -#ifdef ERTS_SMP -static void -do_send_to_port(Eterm to, - Port* unused_port, - Eterm from, - enum ErtsSysMsgType type, - Eterm message) -{ - Uint sz = size_object(message); - ErlHeapFragment *bp = new_message_buffer(sz); - Uint *hp = bp->mem; - Eterm msg = copy_struct(message, sz, &hp, &bp->off_heap); - - enqueue_sys_msg_unlocked(type, from, to, msg, bp); -} -#define WRITE_SYS_MSG_TO_PORT write_sys_msg_to_port +#ifdef HAVE_ERTS_NOW_CPU +# define GET_NOW(m, s, u) \ +do { \ + if (erts_cpu_timestamp) \ + erts_get_now_cpu(m, s, u); \ + else \ + get_now(m, s, u); \ +} while (0) #else -#define WRITE_SYS_MSG_TO_PORT do_send_to_port +# define GET_NOW(m, s, u) do {get_now(m, s, u);} while (0) #endif static void -WRITE_SYS_MSG_TO_PORT(Eterm unused_to, +write_sys_msg_to_port(Eterm unused_to, Port* trace_port, Eterm unused_from, enum ErtsSysMsgType unused_type, @@ -671,150 +686,6 @@ WRITE_SYS_MSG_TO_PORT(Eterm unused_to, erts_free(ERTS_ALC_T_TMP, (void *) buffer); } - -#ifndef ERTS_SMP -/* Send {trace_ts, Pid, out, 0, Timestamp} - * followed by {trace_ts, Pid, in, 0, NewTimestamp} - * - * 'NewTimestamp' through patch_ts(). - */ -static void -do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp, int ts_type) { -#define LOCAL_HEAP_SIZE (5+5+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - Eterm message; - Eterm *hp; - Eterm mfarity; - - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - ASSERT(is_pid(pid)); - ASSERT(is_tuple(timestamp)); - ASSERT(*tuple_val(timestamp) == make_arityval(3)); - - hp = local_heap; - mfarity = make_small(0); - message = TUPLE5(hp, am_trace_ts, pid, am_out, mfarity, timestamp); - /* Note, hp is deliberately NOT incremented since it will be reused */ - - do_send_to_port(trace_port->common.id, - trace_port, - pid, - SYS_MSG_TYPE_UNDEFINED, - message); - - - message = TUPLE5(hp, am_trace_ts, pid, am_in, mfarity, - NIL /* Will be overwritten by timestamp */); - hp += 6; - hp[-1] = write_ts(ts_type, hp, NULL, NULL); - - do_send_to_port(trace_port->common.id, - trace_port, - pid, - SYS_MSG_TYPE_UNDEFINED, - message); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE -} -#endif - -/* If (c_p != NULL), a fake schedule out/in message pair will be sent, - * if the driver so requests. - * It is assumed that 'message' is not an 'out' message. - * - * 'c_p' is the currently executing process, "tracee" is the traced process - * which 'message' concerns => if (*tracee_flags & F_TIMESTAMP_MASK), - * 'message' must contain a timestamp. - */ -static void -send_to_port(Process *c_p, Eterm message, - Eterm *tracer_pid, Uint *tracee_flags) { - Port* trace_port; -#ifndef ERTS_SMP - int ts_type; -#define LOCAL_HEAP_SIZE ERTS_TRACE_PATCH_TS_MAX_SIZE - Eterm ts; - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); -#endif - - ASSERT(is_internal_port(*tracer_pid)); -#ifdef ERTS_SMP - if (is_not_internal_port(*tracer_pid)) - return; - - trace_port = NULL; -#else - - trace_port = erts_id2port_sflgs(*tracer_pid, - NULL, - 0, - ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP); - - if (!trace_port) { - *tracee_flags &= ~TRACEE_FLAGS; - *tracer_pid = NIL; - return; - } - - /* - * Make a fake schedule only if the current process is traced - * with 'running' and 'timestamp'. - */ - - if ( c_p == NULL || - (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP_MASK))) { -#endif - do_send_to_port(*tracer_pid, - trace_port, - c_p ? c_p->common.id : NIL, - SYS_MSG_TYPE_TRACE, - message); -#ifndef ERTS_SMP - erts_port_release(trace_port); - return; - } - - /* - * Note that the process being traced for some type of trace messages - * (e.g. getting_linked) need not be the current process. That other - * process might not have timestamps enabled. - */ - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - /* A fake schedule might be needed. - * Create a dummy trace message with timestamp to be - * passed to do_send_schedfix_to_port(). - */ - ts_type = TFLGS_TS_TYPE(c_p); - ts = write_ts(ts_type, local_heap, NULL, NULL); - - trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY; - do_send_to_port(*tracer_pid, - trace_port, - c_p ? c_p->common.id : NIL, - SYS_MSG_TYPE_TRACE, - message); - - if (trace_port->control_flags & PORT_CONTROL_FLAG_HEAVY) { - /* The driver has just informed us that the last write took a - * non-neglectible amount of time. - * - * We need to fake some trace messages to compensate for the time the - * current process had to sacrifice for the writing of the previous - * trace message. We pretend that the process got scheduled out - * just after writning the real trace message, and now gets scheduled - * in again. - */ - do_send_schedfix_to_port(trace_port, c_p->common.id, ts, ts_type); - } - - erts_port_release(trace_port); - - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE -#endif -} - #ifndef ERTS_SMP /* Profile send * Checks if profiler is port or process @@ -843,11 +714,11 @@ profile_send(Eterm from, Eterm message) { 0, ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP); if (profiler_port) { - do_send_to_port(profiler, - profiler_port, - NIL, /* or current process->common.id */ - SYS_MSG_TYPE_SYSPROF, - message); + write_sys_msg_to_port(profiler, + profiler_port, + NIL, /* or current process->common.id */ + SYS_MSG_TYPE_SYSPROF, + message); erts_port_release(profiler_port); } @@ -867,154 +738,26 @@ profile_send(Eterm from, Eterm message) { else msg = copy_struct(message, sz, &hp, &mp->hfrag.off_heap); - erts_queue_message(profile_p, NULL, mp, msg, NIL); + erts_queue_message(profile_p, NULL, mp, msg); } } #endif - -/* A fake schedule out/in message pair will be sent, - * if the driver so requests. - * - * 'c_p' is the currently executing process, may be NULL. - */ -static void -seq_trace_send_to_port(Process *c_p, - Eterm seq_tracer, - Eterm message) -{ - Port* trace_port; -#ifndef ERTS_SMP - int ts_type; - Eterm ts; -#define LOCAL_HEAP_SIZE ERTS_TRACE_PATCH_TS_MAX_SIZE - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#endif - - ASSERT(is_internal_port(seq_tracer)); -#ifdef ERTS_SMP - if (is_not_internal_port(seq_tracer)) - return; - - trace_port = NULL; -#else - trace_port = erts_id2port_sflgs(seq_tracer, - NULL, - 0, - ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP); - if (!trace_port) { - system_seq_tracer = am_false; -#ifndef ERTS_SMP - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#endif - return; - } - - if (c_p == NULL - || (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP_MASK))) { -#endif - do_send_to_port(seq_tracer, - trace_port, - c_p ? c_p->common.id : NIL, - SYS_MSG_TYPE_SEQTRACE, - message); - -#ifndef ERTS_SMP - erts_port_release(trace_port); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); - return; - } - /* Make a fake schedule only if the current process is traced - * with 'running' and 'timestamp'. - */ - - /* A fake schedule might be needed. - * Create a dummy trace message with timestamp to be - * passed to do_send_schedfix_to_port(). - */ - ts_type = TFLGS_TS_TYPE(c_p); - ts = write_ts(ts_type, local_heap, NULL, NULL); - - trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY; - do_send_to_port(seq_tracer, - trace_port, - c_p ? c_p->common.id : NIL, - SYS_MSG_TYPE_SEQTRACE, - message); - - if (trace_port->control_flags & PORT_CONTROL_FLAG_HEAVY) { - /* The driver has just informed us that the last write took a - * non-neglectible amount of time. - * - * We need to fake some trace messages to compensate for the time the - * current process had to sacrifice for the writing of the previous - * trace message. We pretend that the process got scheduled out - * just after writing the real trace message, and now gets scheduled - * in again. - */ - do_send_schedfix_to_port(trace_port, c_p->common.id, ts, ts_type); - } - - erts_port_release(trace_port); - - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE -#endif -} - -static ERTS_INLINE void -send_to_tracer(Process *tracee, - ERTS_TRACER_REF_TYPE tracer_ref, - Eterm msg, - Eterm **hpp, - ErlHeapFragment *bp, - int no_fake_sched) -{ - ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(tracee)); - - erts_smp_mtx_lock(&smq_mtx); - - if (is_internal_pid(ERTS_TRACER_PROC(tracee))) { - PATCH_TS(TFLGS_TS_TYPE(tracee), msg, *hpp, bp, tracer_ref); - ERTS_ENQ_TRACE_MSG(tracee->common.id, tracer_ref, msg, bp); - } - else { - ASSERT(is_internal_port(ERTS_TRACER_PROC(tracee))); - PATCH_TS(TFLGS_TS_TYPE(tracee), msg, *hpp, NULL, NULL); - send_to_port(no_fake_sched ? NULL : tracee, - msg, - &ERTS_TRACER_PROC(tracee), - &ERTS_TRACE_FLAGS(tracee)); - } - - erts_smp_mtx_unlock(&smq_mtx); - -} - static void -trace_sched_aux(Process *p, Eterm what, int never_fake_sched) +trace_sched_aux(Process *p, ErtsProcLocks locks, Eterm what) { -#define LOCAL_HEAP_SIZE (5+4+1+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p); - Eterm tmp, mess, *hp; - ErlHeapFragment *bp = NULL; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref = ERTS_NULL_TRACER_REF; - int sched_no, curr_func, to_port, no_fake_sched; + Eterm tmp, *hp; + int curr_func; + ErtsTracerNif *tnif = NULL; - if (is_nil(ERTS_TRACER_PROC(p))) + if (ERTS_TRACER_IS_NIL(ERTS_TRACER(p))) return; - no_fake_sched = never_fake_sched; - switch (what) { case am_out: case am_out_exiting: case am_out_exited: - no_fake_sched = 1; - break; case am_in: case am_in_exiting: break; @@ -1023,16 +766,8 @@ trace_sched_aux(Process *p, Eterm what, int never_fake_sched) break; } - sched_no = IS_TRACED_FL(p, F_TRACE_SCHED_NO); - to_port = is_internal_port(ERTS_TRACER_PROC(p)); - - if (!to_port) { - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); - } + if (!is_tracer_enabled(p, locks, &p->common, &tnif, TRACE_FUN_E_SCHED_PROC, what)) + return; if (ERTS_PROC_IS_EXITING(p)) curr_func = 0; @@ -1042,44 +777,16 @@ trace_sched_aux(Process *p, Eterm what, int never_fake_sched) curr_func = p->current != NULL; } - UseTmpHeap(LOCAL_HEAP_SIZE,p); - - if (to_port) - hp = local_heap; - else { - Uint size = 5; - if (curr_func) - size += 4; - if (sched_no) - size += 1; - size += PATCH_TS_SIZE(p); - hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); - } - if (!curr_func) { tmp = make_small(0); } else { + hp = HAlloc(p, 4); tmp = TUPLE3(hp,p->current[0],p->current[1],make_small(p->current[2])); hp += 4; } - if (!sched_no) { - mess = TUPLE4(hp, am_trace, p->common.id, what, tmp); - hp += 5; - } - else { -#ifdef ERTS_SMP - Eterm sched_id = make_small(p->scheduler_data->no); -#else - Eterm sched_id = make_small(1); -#endif - mess = TUPLE5(hp, am_trace, p->common.id, what, sched_id, tmp); - hp += 6; - } - - send_to_tracer(p, tracer_ref, mess, &hp, bp, no_fake_sched); - UnUseTmpHeap(LOCAL_HEAP_SIZE,p); -#undef LOCAL_HEAP_SIZE + send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_SCHED_PROC, + what, tmp, THE_NON_VALUE); } /* Send {trace_ts, Pid, What, {Mod, Func, Arity}, Timestamp} @@ -1089,9 +796,9 @@ trace_sched_aux(Process *p, Eterm what, int never_fake_sched) * 'out_exiting', or 'out_exited'. */ void -trace_sched(Process *p, Eterm what) +trace_sched(Process *p, ErtsProcLocks locks, Eterm what) { - trace_sched_aux(p, what, 0); + trace_sched_aux(p, locks, what); } /* Send {trace_ts, Pid, Send, Msg, DestPid, Timestamp} @@ -1102,140 +809,55 @@ trace_sched(Process *p, Eterm what) void trace_send(Process *p, Eterm to, Eterm msg) { - Eterm operation; - unsigned sz_msg; - unsigned sz_to; - Eterm* hp; - Eterm mess; - - if (!ARE_TRACE_FLAGS_ON(p, F_TRACE_SEND)) { - return; - } + Eterm operation = am_send; + ErtsTracerNif *tnif = NULL; + + ASSERT(ARE_TRACE_FLAGS_ON(p, F_TRACE_SEND)); - operation = am_send; if (is_internal_pid(to)) { if (!erts_proc_lookup(to)) goto send_to_non_existing_process; } else if(is_external_pid(to) && external_pid_dist_entry(to) == erts_this_dist_entry) { - char *s; send_to_non_existing_process: - s = "send_to_non_existing_process"; - operation = am_atom_put(s, sys_strlen(s)); + operation = am_send_to_non_existing_process; } - if (is_internal_port(ERTS_TRACER_PROC(p))) { -#define LOCAL_HEAP_SIZE (6 + ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - mess = TUPLE5(hp, am_trace, p->common.id, operation, msg, to); - hp += 6; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); - send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - Uint need; - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); - - sz_msg = size_object(msg); - sz_to = size_object(to); - need = sz_msg + sz_to + 6 + PATCH_TS_SIZE(p); - - hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref); - - to = copy_struct(to, - sz_to, - &hp, - off_heap); - msg = copy_struct(msg, - sz_msg, - &hp, - off_heap); - mess = TUPLE5(hp, am_trace, p->common.id, operation, msg, to); - hp += 6; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref); - ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } + if (is_tracer_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif, + TRACE_FUN_E_SEND, operation)) + send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_SEND, + operation, msg, to); } /* Send {trace_ts, Pid, receive, Msg, Timestamp} * or {trace, Pid, receive, Msg} */ void -trace_receive(Process *rp, Eterm msg) +trace_receive(Process *c_p, Eterm msg) { - Eterm mess; - size_t sz_msg; - Eterm* hp; - - if (is_internal_port(ERTS_TRACER_PROC(rp))) { -#define LOCAL_HEAP_SIZE (5+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - mess = TUPLE4(hp, am_trace, rp->common.id, am_receive, msg); - hp += 5; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(TFLGS_TS_TYPE(rp), mess, hp, NULL, NULL); - send_to_port(rp, mess, &ERTS_TRACER_PROC(rp), &ERTS_TRACE_FLAGS(rp)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - Uint hsz; - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - - ASSERT(is_internal_pid(ERTS_TRACER_PROC(rp))); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(rp), - ERTS_TRACE_FLAGS(rp)); - - sz_msg = size_object(msg); - - hsz = sz_msg + 5 + PATCH_TS_SIZE(rp); - - hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, tracer_ref); - - msg = copy_struct(msg, sz_msg, &hp, off_heap); - mess = TUPLE4(hp, am_trace, rp->common.id, am_receive, msg); - hp += 5; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(rp), mess, hp, bp, tracer_ref); - ERTS_ENQ_TRACE_MSG(rp->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } + ErtsTracerNif *tnif = NULL; + if (is_tracer_enabled(NULL, 0, &c_p->common, &tnif, + TRACE_FUN_E_RECEIVE, am_receive)) + send_to_tracer_nif(NULL, &c_p->common, c_p->common.id, + tnif, TRACE_FUN_T_RECEIVE, + am_receive, msg, THE_NON_VALUE); } int seq_trace_update_send(Process *p) { - Eterm seq_tracer = erts_get_system_seq_tracer(); + ErtsTracer seq_tracer = erts_get_system_seq_tracer(); ASSERT((is_tuple(SEQ_TRACE_TOKEN(p)) || is_nil(SEQ_TRACE_TOKEN(p)))); - if ((p->common.id == seq_tracer) || have_no_seqtrace(SEQ_TRACE_TOKEN(p))) { + if (have_no_seqtrace(SEQ_TRACE_TOKEN(p)) || + (seq_tracer != NIL && + call_enabled_tracer(NULL, seq_tracer, NULL, + TRACE_FUN_ENABLED, am_trace_status, + p ? p->common.id : am_undefined) != am_trace) +#ifdef USE_VM_PROBES + || (SEQ_TRACE_TOKEN(p) == am_have_dt_utag) +#endif + ) { return 0; } SEQ_TRACE_TOKEN_SENDER(p) = p->common.id; @@ -1263,20 +885,29 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, Eterm receiver, Process *process, Eterm exitfrom) { Eterm mess; - ErlHeapFragment* bp; Eterm* hp; Eterm label; Eterm lastcnt_serial; Eterm type_atom; - int sz_exit; - Eterm seq_tracer; - int ts_type; + ErtsTracer seq_tracer; + int seq_tracer_flags = 0; +#define LOCAL_HEAP_SIZE (64) + DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); seq_tracer = erts_get_system_seq_tracer(); ASSERT(is_tuple(token) || is_nil(token)); - if (SEQ_TRACE_T_SENDER(token) == seq_tracer || token == NIL || - (process && ERTS_TRACE_FLAGS(process) & F_SENSITIVE)) { + if (token == NIL || (process && ERTS_TRACE_FLAGS(process) & F_SENSITIVE) || + ERTS_TRACER_IS_NIL(seq_tracer) || + call_enabled_tracer(NULL, seq_tracer, + NULL, TRACE_FUN_ENABLED, + am_trace_status, + process ? process->common.id : am_undefined) != am_trace) { + return; + } + + if ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & type) == 0) { + /* No flags set, nothing to do */ return; } @@ -1289,151 +920,28 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, return; /* To avoid warning */ } - if ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & type) == 0) { - /* No flags set, nothing to do */ - return; - } + UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - if (seq_tracer == am_false) { - return; /* no need to send anything */ + hp = local_heap; + label = SEQ_TRACE_T_LABEL(token); + lastcnt_serial = TUPLE2(hp, SEQ_TRACE_T_LASTCNT(token), + SEQ_TRACE_T_SERIAL(token)); + hp += 3; + if (exitfrom != NIL) { + msg = TUPLE3(hp, am_EXIT, exitfrom, msg); + hp += 4; } + mess = TUPLE5(hp, type_atom, lastcnt_serial, SEQ_TRACE_T_SENDER(token), receiver, msg); + hp += 6; - ts_type = ERTS_SEQTFLGS2TSTYPE(unsigned_val(SEQ_TRACE_T_FLAGS(token))); - - if (is_internal_port(seq_tracer)) { -#define LOCAL_HEAP_SIZE (60 + ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); + seq_tracer_flags |= ERTS_SEQTFLGS2TFLGS(unsigned_val(SEQ_TRACE_T_FLAGS(token))); - hp = local_heap; - label = SEQ_TRACE_T_LABEL(token); - lastcnt_serial = TUPLE2(hp, SEQ_TRACE_T_LASTCNT(token), - SEQ_TRACE_T_SERIAL(token)); - hp += 3; - if (exitfrom != NIL) { - msg = TUPLE3(hp, am_EXIT, exitfrom, msg); - hp += 4; - } - mess = TUPLE5(hp, type_atom, lastcnt_serial, SEQ_TRACE_T_SENDER(token), - receiver, msg); - hp += 6; + send_to_tracer_nif_raw(NULL, process, seq_tracer, seq_tracer_flags, + label, NULL, TRACE_FUN_DEFAULT, am_seq_trace, mess, + THE_NON_VALUE, am_true); - erts_smp_mtx_lock(&smq_mtx); - if (!ts_type) { - mess = TUPLE3(hp, am_seq_trace, label, mess); - seq_trace_send_to_port(NULL, seq_tracer, mess); - } else { - mess = TUPLE4(hp, am_seq_trace, label, mess, - NIL /* Will be overwritten by timestamp */); - hp += 5; - hp[-1] = write_ts(ts_type, hp, NULL, NULL); - seq_trace_send_to_port(process, seq_tracer, mess); - } - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); + UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); #undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { -#ifndef ERTS_SMP - Process* tracer; -#endif - Eterm sender_copy; - Eterm receiver_copy; - Eterm m2; - Uint sz_label, sz_lastcnt_serial, sz_msg, sz_ts, sz_sender, - sz_exitfrom, sz_receiver; - - ASSERT(is_internal_pid(seq_tracer)); - -#ifndef ERTS_SMP - - tracer = erts_proc_lookup(seq_tracer); - if (!tracer) { - system_seq_tracer = am_false; - return; /* no need to send anything */ - } -#endif - if (receiver == seq_tracer) { - return; /* no need to send anything */ - } - - sz_label = size_object(SEQ_TRACE_T_LABEL(token)); - sz_sender = size_object(SEQ_TRACE_T_SENDER(token)); - sz_receiver = size_object(receiver); - sz_lastcnt_serial = 3; /* TUPLE2 */ - sz_msg = size_object(msg); - - sz_ts = patch_ts_size(ts_type); - if (exitfrom != NIL) { - sz_exit = 4; /* create {'EXIT',exitfrom,msg} */ - sz_exitfrom = size_object(exitfrom); - } - else { - sz_exit = 0; - sz_exitfrom = 0; - } - bp = new_message_buffer(4 /* TUPLE3 */ + sz_ts + 6 /* TUPLE5 */ - + sz_lastcnt_serial + sz_label + sz_msg - + sz_exit + sz_exitfrom - + sz_sender + sz_receiver); - hp = bp->mem; - label = copy_struct(SEQ_TRACE_T_LABEL(token), sz_label, &hp, &bp->off_heap); - lastcnt_serial = TUPLE2(hp,SEQ_TRACE_T_LASTCNT(token),SEQ_TRACE_T_SERIAL(token)); - hp += 3; - m2 = copy_struct(msg, sz_msg, &hp, &bp->off_heap); - if (sz_exit) { - Eterm exitfrom_copy = copy_struct(exitfrom, - sz_exitfrom, - &hp, - &bp->off_heap); - m2 = TUPLE3(hp, am_EXIT, exitfrom_copy, m2); - hp += 4; - } - sender_copy = copy_struct(SEQ_TRACE_T_SENDER(token), - sz_sender, - &hp, - &bp->off_heap); - receiver_copy = copy_struct(receiver, - sz_receiver, - &hp, - &bp->off_heap); - mess = TUPLE5(hp, - type_atom, - lastcnt_serial, - sender_copy, - receiver_copy, - m2); - hp += 6; - - erts_smp_mtx_lock(&smq_mtx); - - if (!ts_type) - mess = TUPLE3(hp, am_seq_trace, label, mess); - else { - mess = TUPLE4(hp, am_seq_trace, label, mess, - NIL /* Will be overwritten by timestamp */); - hp += 5; - /* Write timestamp in element 6 of the 'msg' tuple */ - hp[-1] = write_ts(ts_type, hp, bp, -#ifndef ERTS_SMP - tracer -#else - NULL -#endif - ); - } - -#ifdef ERTS_SMP - enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SEQTRACE, NIL, NIL, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); -#else - /* trace_token must be NIL here */ - { - ErtsMessage *mp = erts_alloc_message(0, NULL); - mp->data.heap_frag = bp; - erts_queue_message(tracer, NULL, mp, mess, NIL); - } -#endif - } } /* Send {trace_ts, Pid, return_to, {Mod, Func, Arity}, Timestamp} @@ -1442,63 +950,20 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, void erts_trace_return_to(Process *p, BeamInstr *pc) { -#define LOCAL_HEAP_SIZE (4+5+ERTS_TRACE_PATCH_TS_MAX_SIZE) - Eterm* hp; Eterm mfa; - Eterm mess; - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); BeamInstr *code_ptr = find_function_from_pc(pc); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - if (!code_ptr) { mfa = am_undefined; } else { + Eterm *hp = HAlloc(p, 4); mfa = TUPLE3(hp, code_ptr[0], code_ptr[1], make_small(code_ptr[2])); - hp += 4; } - - mess = TUPLE4(hp, am_trace, p->common.id, am_return_to, mfa); - hp += 5; - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); - - if (is_internal_port(ERTS_TRACER_PROC(p))) { - send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); - } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - unsigned size; - - /* - * Find the tracer. - */ - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); - - size = size_object(mess); - - hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); - - /* - * Copy the trace message into the buffer and enqueue it. - */ - mess = copy_struct(mess, size, &hp, off_heap); - ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); - } - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); + send_to_tracer_nif(p, &p->common, p->common.id, NULL, TRACE_FUN_T_CALL, + am_return_to, mfa, THE_NON_VALUE); } @@ -1506,114 +971,53 @@ erts_trace_return_to(Process *p, BeamInstr *pc) * or {trace, Pid, return_from, {Mod, Name, Arity}, Retval} */ void -erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid) +erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, ErtsTracer *tracer) { Eterm* hp; - Eterm mfa; - Eterm mess; - Eterm mod, name; + Eterm mfa, mod, name; int arity; Uint meta_flags, *tracee_flags; - int ts_type; -#ifdef ERTS_SMP - Eterm tracee; -#endif - - ASSERT(tracer_pid); - if (*tracer_pid == am_true) { + + ASSERT(tracer); + if (ERTS_TRACER_COMPARE(*tracer, erts_tracer_true)) { /* Breakpoint trace enabled without specifying tracer => * use process tracer and flags */ - tracer_pid = &ERTS_TRACER_PROC(p); + tracer = &ERTS_TRACER(p); } - if (is_nil(*tracer_pid)) { + if (ERTS_TRACER_IS_NIL(*tracer)) { /* Trace disabled */ return; } - ASSERT(is_internal_pid(*tracer_pid) || is_internal_port(*tracer_pid)); - if (*tracer_pid == p->common.id) { - /* Do not generate trace messages to oneself */ - return; - } - if (tracer_pid == &ERTS_TRACER_PROC(p)) { + ASSERT(IS_TRACER_VALID(*tracer)); + if (tracer == &ERTS_TRACER(p)) { /* Tracer specified in process structure => * non-breakpoint trace => * use process flags */ tracee_flags = &ERTS_TRACE_FLAGS(p); -#ifdef ERTS_SMP - tracee = p->common.id; -#endif + if (! (*tracee_flags & F_TRACE_CALLS)) { + return; + } } else { /* Tracer not specified in process structure => * tracer specified in breakpoint => * meta trace => * use fixed flag set instead of process flags - */ + */ meta_flags = F_TRACE_CALLS | F_NOW_TS; tracee_flags = &meta_flags; -#ifdef ERTS_SMP - tracee = NIL; -#endif - } - if (! (*tracee_flags & F_TRACE_CALLS)) { - return; } - + mod = fi[0]; name = fi[1]; arity = fi[2]; - - ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags); - - if (is_internal_port(*tracer_pid)) { -#define LOCAL_HEAP_SIZE (4+6+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - hp = local_heap; - mfa = TUPLE3(hp, mod, name, make_small(arity)); - hp += 4; - mess = TUPLE5(hp, am_trace, p->common.id, am_return_from, mfa, retval); - hp += 6; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(ts_type, mess, hp, NULL, NULL); - send_to_port(p, mess, tracer_pid, tracee_flags); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - unsigned size; - unsigned retval_size; - - ASSERT(is_internal_pid(*tracer_pid)); - - ERTS_GET_TRACER_REF(tracer_ref, *tracer_pid, *tracee_flags); - retval_size = size_object(retval); - size = 6 + 4 + retval_size + patch_ts_size(ts_type); - - hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); - - /* - * Build the trace tuple and put it into receive queue of the tracer process. - */ - - mfa = TUPLE3(hp, mod, name, make_small(arity)); - hp += 4; - retval = copy_struct(retval, retval_size, &hp, off_heap); - mess = TUPLE5(hp, am_trace, p->common.id, am_return_from, mfa, retval); - hp += 6; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(ts_type, mess, hp, bp, tracer_ref); - - ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } + hp = HAlloc(p, 4); + mfa = TUPLE3(hp, mod, name, make_small(arity)); + hp += 4; + send_to_tracer_nif_raw(p, NULL, *tracer, *tracee_flags, p->common.id, + NULL, TRACE_FUN_T_CALL, am_return_from, mfa, retval, am_true); } /* Send {trace_ts, Pid, exception_from, {Mod, Name, Arity}, {Class,Value}, @@ -1625,116 +1029,50 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid) */ void erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value, - Eterm *tracer_pid) + ErtsTracer *tracer) { Eterm* hp; - Eterm mfa_tuple; - Eterm cv; - Eterm mess; + Eterm mfa_tuple, cv; Uint meta_flags, *tracee_flags; - int ts_type; -#ifdef ERTS_SMP - Eterm tracee; -#endif - - ASSERT(tracer_pid); - if (*tracer_pid == am_true) { + + ASSERT(tracer); + if (ERTS_TRACER_COMPARE(*tracer, erts_tracer_true)) { /* Breakpoint trace enabled without specifying tracer => * use process tracer and flags */ - tracer_pid = &ERTS_TRACER_PROC(p); + tracer = &ERTS_TRACER(p); } - if (is_nil(*tracer_pid)) { + if (ERTS_TRACER_IS_NIL(*tracer)) { /* Trace disabled */ return; } - ASSERT(is_internal_pid(*tracer_pid) || is_internal_port(*tracer_pid)); - if (*tracer_pid == p->common.id) { - /* Do not generate trace messages to oneself */ - return; - } - if (tracer_pid == &ERTS_TRACER_PROC(p)) { + ASSERT(IS_TRACER_VALID(*tracer)); + if (tracer == &ERTS_TRACER(p)) { /* Tracer specified in process structure => * non-breakpoint trace => * use process flags */ tracee_flags = &ERTS_TRACE_FLAGS(p); -#ifdef ERTS_SMP - tracee = p->common.id; -#endif - if (! (*tracee_flags & F_TRACE_CALLS)) { - return; - } + if (! (*tracee_flags & F_TRACE_CALLS)) { + return; + } } else { /* Tracer not specified in process structure => * tracer specified in breakpoint => * meta trace => * use fixed flag set instead of process flags - */ + */ meta_flags = F_TRACE_CALLS | F_NOW_TS; tracee_flags = &meta_flags; -#ifdef ERTS_SMP - tracee = NIL; -#endif } - - ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags); - - if (is_internal_port(*tracer_pid)) { -#define LOCAL_HEAP_SIZE (4+3+6+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], make_small((Eterm)mfa[2])); - hp += 4; - cv = TUPLE2(hp, class, value); - hp += 3; - mess = TUPLE5(hp, am_trace, p->common.id, am_exception_from, mfa_tuple, cv); - hp += 6; - ASSERT((hp - local_heap) <= LOCAL_HEAP_SIZE); - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(ts_type, mess, hp, NULL, NULL); - send_to_port(p, mess, tracer_pid, tracee_flags); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - unsigned size; - unsigned value_size; - - ASSERT(is_internal_pid(*tracer_pid)); - - ERTS_GET_TRACER_REF(tracer_ref, *tracer_pid, *tracee_flags); - - value_size = size_object(value); - size = 6 + 4 + 3 + value_size + patch_ts_size(ts_type); - - hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); - - /* - * Build the trace tuple and put it into receive queue of the tracer process. - */ - - mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], make_small((Eterm) mfa[2])); - hp += 4; - value = copy_struct(value, value_size, &hp, off_heap); - cv = TUPLE2(hp, class, value); - hp += 3; - mess = TUPLE5(hp, am_trace, p->common.id, - am_exception_from, mfa_tuple, cv); - hp += 6; - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(ts_type, mess, hp, bp, tracer_ref); - - ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } + hp = HAlloc(p, 7);; + mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], make_small((Eterm)mfa[2])); + hp += 4; + cv = TUPLE2(hp, class, value); + hp += 3; + send_to_tracer_nif_raw(p, NULL, *tracer, *tracee_flags, p->common.id, + NULL, TRACE_FUN_T_CALL, am_exception_from, mfa_tuple, cv, am_true); } /* @@ -1753,7 +1091,7 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value, */ Uint32 erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, - Eterm* args, int local, Eterm *tracer_pid) + Eterm* args, int local, ErtsTracer *tracer) { Eterm* hp; Eterm mfa_tuple; @@ -1761,55 +1099,53 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, int i; Uint32 return_flags; Eterm pam_result = am_true; - Eterm mess; Uint meta_flags, *tracee_flags; - int ts_type; -#ifdef ERTS_SMP - Eterm tracee; -#endif + ErtsTracerNif *tnif = NULL; Eterm transformed_args[MAX_ARG]; - DeclareTypedTmpHeap(ErlSubBin,sub_bin_heap,p); + ErtsTracer pre_ms_tracer = erts_tracer_nil; - ASSERT(tracer_pid); - if (*tracer_pid == am_true) { - /* Breakpoint trace enabled without specifying tracer => + ASSERT(tracer); + if (ERTS_TRACER_COMPARE(*tracer, erts_tracer_true)) { + /* Breakpoint trace enabled without specifying tracer => * use process tracer and flags */ - tracer_pid = &ERTS_TRACER_PROC(p); - } - if (is_nil(*tracer_pid)) { - /* Trace disabled */ - return 0; + tracer = &ERTS_TRACER(p); } - ASSERT(is_internal_pid(*tracer_pid) || is_internal_port(*tracer_pid)); - if (*tracer_pid == p->common.id) { - /* Do not generate trace messages to oneself */ + if (ERTS_TRACER_IS_NIL(*tracer)) { + /* Trace disabled */ return 0; } - if (tracer_pid == &ERTS_TRACER_PROC(p)) { + ASSERT(IS_TRACER_VALID(*tracer)); + if (tracer == &ERTS_TRACER(p)) { /* Tracer specified in process structure => * non-breakpoint trace => * use process flags */ tracee_flags = &ERTS_TRACE_FLAGS(p); -#ifdef ERTS_SMP - tracee = p->common.id; -#endif + if (!is_tracer_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif, + TRACE_FUN_E_CALL, am_call)) { + return 0; + } } else { /* Tracer not specified in process structure => * tracer specified in breakpoint => * meta trace => * use fixed flag set instead of process flags - */ - if (ERTS_TRACE_FLAGS(p) & F_SENSITIVE) { - /* No trace messages for sensitive processes. */ - return 0; - } + */ + if (ERTS_TRACE_FLAGS(p) & F_SENSITIVE) { + /* No trace messages for sensitive processes. */ + return 0; + } meta_flags = F_TRACE_CALLS | F_NOW_TS; tracee_flags = &meta_flags; -#ifdef ERTS_SMP - tracee = NIL; -#endif + switch (call_enabled_tracer(p, *tracer, + &tnif, TRACE_FUN_T_CALL, + am_call, p->common.id)) { + default: + case am_remove: *tracer = erts_tracer_nil; + case am_discard: return 0; + case am_trace: break; + } } /* @@ -1820,18 +1156,13 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, * temporarily convert any match contexts to sub binaries. */ arity = (Eterm) mfa[2]; - UseTmpHeap(ERL_SUB_BIN_SIZE,p); -#ifdef DEBUG - sub_bin_heap->thing_word = 0; -#endif for (i = 0; i < arity; i++) { Eterm arg = args[i]; if (is_boxed(arg) && header_is_bin_matchstate(*boxed_val(arg))) { ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(arg); ErlBinMatchBuffer* mb = &ms->mb; Uint bit_size; - - ASSERT(sub_bin_heap->thing_word == 0); /* At most one of match context */ + ErlSubBin *sub_bin_heap = (ErlSubBin *)HAlloc(p, ERL_SUB_BIN_SIZE); bit_size = mb->size - mb->offset; sub_bin_heap->thing_word = HEADER_SUB_BIN; @@ -1848,275 +1179,98 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, } args = transformed_args; - ts_type = ERTS_TFLGS2TSTYPE(*tracee_flags); - - if (is_internal_port(*tracer_pid)) { - Eterm local_heap[64+ERTS_TRACE_PATCH_TS_MAX_SIZE+MAX_ARG]; - hp = local_heap; - - if (!erts_is_valid_tracer_port(*tracer_pid)) { -#ifdef ERTS_SMP - ASSERT(is_nil(tracee) || tracer_pid == &ERTS_TRACER_PROC(p)); - if (is_not_nil(tracee)) - erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); -#endif - *tracee_flags &= ~TRACEE_FLAGS; - *tracer_pid = NIL; -#ifdef ERTS_SMP - if (is_not_nil(tracee)) - erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); -#endif - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return 0; - } - - /* - * If there is a PAM program, run it. Return if it fails. - * - * Some precedence rules: - * - * - No proc flags, e.g 'silent' or 'return_to' - * has any effect on meta trace. - * - The 'silent' process trace flag silences all call - * related messages, e.g 'call', 'return_to' and 'return_from'. - * - The {message,_} PAM function does not affect {return_trace}. - * - The {message,false} PAM function shall give the same - * 'call' trace message as no PAM match. - * - The {message,true} PAM function shall give the same - * 'call' trace message as a nonexistent PAM program. - */ - - /* BEGIN this code should be the same for port and pid trace */ - return_flags = 0; - if (match_spec) { - pam_result = erts_match_set_run(p, match_spec, args, arity, - ERTS_PAM_TMP_RESULT, &return_flags); - if (is_non_value(pam_result)) { - erts_match_set_release_result(p); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return 0; - } - } - if (tracee_flags == &meta_flags) { - /* Meta trace */ - if (pam_result == am_false) { - erts_match_set_release_result(p); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return return_flags; - } - } else { - /* Non-meta trace */ - if (*tracee_flags & F_TRACE_SILENT) { - erts_match_set_release_result(p); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return 0; - } - if (pam_result == am_false) { - erts_match_set_release_result(p); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return return_flags; - } - if (local && (*tracee_flags & F_TRACE_RETURN_TO)) { - return_flags |= MATCH_SET_RETURN_TO_TRACE; - } - } - /* END this code should be the same for port and pid trace */ - - /* - * Build the the {M,F,A} tuple in the local heap. - * (A is arguments or arity.) - */ - - if (*tracee_flags & F_TRACE_ARITY_ONLY) { - mfa_tuple = make_small(arity); - } else { - mfa_tuple = NIL; - for (i = arity-1; i >= 0; i--) { - mfa_tuple = CONS(hp, args[i], mfa_tuple); - hp += 2; - } - } - mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], mfa_tuple); - hp += 4; - - /* - * Build the trace tuple and send it to the port. - */ - - mess = TUPLE4(hp, am_trace, p->common.id, am_call, mfa_tuple); - hp += 5; - if (pam_result != am_true) { - hp[-5] = make_arityval(5); - *hp++ = pam_result; - } - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(ts_type, mess, hp, NULL, NULL); - send_to_port(p, mess, tracer_pid, tracee_flags); - erts_smp_mtx_unlock(&smq_mtx); - erts_match_set_release_result(p); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return *tracer_pid == NIL ? 0 : return_flags; + /* + * If there is a PAM program, run it. Return if it fails. + * + * Some precedence rules: + * + * - No proc flags, e.g 'silent' or 'return_to' + * has any effect on meta trace. + * - The 'silent' process trace flag silences all call + * related messages, e.g 'call', 'return_to' and 'return_from'. + * - The {message,_} PAM function does not affect {return_trace}. + * - The {message,false} PAM function shall give the same + * 'call' trace message as no PAM match. + * - The {message,true} PAM function shall give the same + * 'call' trace message as a nonexistent PAM program. + */ + return_flags = 0; + if (match_spec) { + /* we have to make a copy of the tracer here as the match spec + may remove it, and we still want to generate a trace message */ + erts_tracer_update(&pre_ms_tracer, *tracer); + tracer = &pre_ms_tracer; + pam_result = erts_match_set_run(p, match_spec, args, arity, + ERTS_PAM_TMP_RESULT, &return_flags); + if (is_non_value(pam_result)) { + erts_match_set_release_result(p); + UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); + ERTS_TRACER_CLEAR(&pre_ms_tracer); + return 0; + } + } + + if (tracee_flags == &meta_flags) { + /* Meta trace */ + if (pam_result == am_false) { + erts_match_set_release_result(p); + UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); + ERTS_TRACER_CLEAR(&pre_ms_tracer); + return return_flags; + } } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - Process *tracer; - ERTS_TRACER_REF_TYPE tracer_ref; -#ifdef ERTS_SMP - Eterm tpid; -#endif - unsigned size; - unsigned sizes[MAX_ARG]; - unsigned pam_result_size = 0; - int invalid_tracer; + /* Non-meta trace */ + if (*tracee_flags & F_TRACE_SILENT) { + erts_match_set_release_result(p); + UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); + ERTS_TRACER_CLEAR(&pre_ms_tracer); + return 0; + } + if (pam_result == am_false) { + erts_match_set_release_result(p); + UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); + ERTS_TRACER_CLEAR(&pre_ms_tracer); + return return_flags; + } + if (local && (*tracee_flags & F_TRACE_RETURN_TO)) { + return_flags |= MATCH_SET_RETURN_TO_TRACE; + } + } + + ASSERT(!ERTS_TRACER_IS_NIL(*tracer)); - ASSERT(is_internal_pid(*tracer_pid)); - - tracer = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, - *tracer_pid, ERTS_PROC_LOCK_STATUS); - if (!tracer) - invalid_tracer = 1; - else { - invalid_tracer = !(ERTS_TRACE_FLAGS(tracer) & F_TRACER); - erts_smp_proc_unlock(tracer, ERTS_PROC_LOCK_STATUS); - } - - if (invalid_tracer) { -#ifdef ERTS_SMP - ASSERT(is_nil(tracee) - || tracer_pid == &ERTS_TRACER_PROC(p)); - if (is_not_nil(tracee)) - erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); -#endif - *tracee_flags &= ~TRACEE_FLAGS; - *tracer_pid = NIL; -#ifdef ERTS_SMP - if (is_not_nil(tracee)) - erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); -#endif - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return 0; - } - -#ifdef ERTS_SMP - tpid = *tracer_pid; /* Need to save tracer pid, - since *tracer_pid might - be reset by erts_match_set_run() */ - tracer_ref = tpid; -#else - tracer_ref = tracer; -#endif - - /* - * If there is a PAM program, run it. Return if it fails. - * - * See the rules above in the port trace code. - */ - - /* BEGIN this code should be the same for port and pid trace */ - return_flags = 0; - if (match_spec) { - pam_result = erts_match_set_run(p, match_spec, args, arity, - ERTS_PAM_TMP_RESULT, &return_flags); - if (is_non_value(pam_result)) { - erts_match_set_release_result(p); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return 0; - } - } - if (tracee_flags == &meta_flags) { - /* Meta trace */ - if (pam_result == am_false) { - erts_match_set_release_result(p); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return return_flags; - } - } else { - /* Non-meta trace */ - if (*tracee_flags & F_TRACE_SILENT) { - erts_match_set_release_result(p); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return 0; - } - if (pam_result == am_false) { - erts_match_set_release_result(p); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return return_flags; - } - if (local && (*tracee_flags & F_TRACE_RETURN_TO)) { - return_flags |= MATCH_SET_RETURN_TO_TRACE; - } - } - /* END this code should be the same for port and pid trace */ - - /* - * Calculate number of words needed on heap. - */ - - size = 4 + 5; /* Trace tuple + MFA tuple. */ - if (! (*tracee_flags & F_TRACE_ARITY_ONLY)) { - size += 2*arity; - for (i = arity-1; i >= 0; i--) { - sizes[i] = size_object(args[i]); - size += sizes[i]; - } - } - size += patch_ts_size(ts_type); - if (pam_result != am_true) { - pam_result_size = size_object(pam_result); - size += 1 + pam_result_size; - /* One element in trace tuple + term size. */ - } - - hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); + /* + * Build the the {M,F,A} tuple in the local heap. + * (A is arguments or arity.) + */ - /* - * Build the the {M,F,A} tuple in the message buffer. - * (A is arguments or arity.) - */ - - if (*tracee_flags & F_TRACE_ARITY_ONLY) { - mfa_tuple = make_small(arity); - } else { - mfa_tuple = NIL; - for (i = arity-1; i >= 0; i--) { - Eterm term = copy_struct(args[i], sizes[i], &hp, off_heap); - mfa_tuple = CONS(hp, term, mfa_tuple); - hp += 2; - } - } - mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], mfa_tuple); - hp += 4; - - /* - * Copy the PAM result (if any) onto the heap. - */ - - if (pam_result != am_true) { - pam_result = copy_struct(pam_result, pam_result_size, &hp, off_heap); - } - erts_match_set_release_result(p); + if (*tracee_flags & F_TRACE_ARITY_ONLY) { + hp = HAlloc(p, 4); + mfa_tuple = make_small(arity); + } else { + hp = HAlloc(p, 4 + arity * 2); + mfa_tuple = NIL; + for (i = arity-1; i >= 0; i--) { + mfa_tuple = CONS(hp, args[i], mfa_tuple); + hp += 2; + } + } + mfa_tuple = TUPLE3(hp, (Eterm) mfa[0], (Eterm) mfa[1], mfa_tuple); + hp += 4; - /* - * Build the trace tuple and enqueue it. - */ - - mess = TUPLE4(hp, am_trace, p->common.id, am_call, mfa_tuple); - hp += 5; - if (pam_result != am_true) { - hp[-5] = make_arityval(5); - *hp++ = pam_result; - } + /* + * Build the trace tuple and send it to the port. + */ + send_to_tracer_nif_raw(p, NULL, *tracer, *tracee_flags, p->common.id, + tnif, TRACE_FUN_T_CALL, am_call, mfa_tuple, THE_NON_VALUE, pam_result); + erts_match_set_release_result(p); - erts_smp_mtx_lock(&smq_mtx); + if (match_spec && tracer == &pre_ms_tracer) + ERTS_TRACER_CLEAR(&pre_ms_tracer); - PATCH_TS(ts_type, mess, hp, bp, tracer_ref); - ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - UnUseTmpHeap(ERL_SUB_BIN_SIZE,p); - return return_flags; - } + return return_flags; } /* Sends trace message: @@ -2128,69 +1282,14 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, * 't_p' is the traced process. */ void -trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data) +trace_proc(Process *c_p, ErtsProcLocks c_p_locks, + Process *t_p, Eterm what, Eterm data) { - Eterm mess; - Eterm* hp; - int need; - - ERTS_SMP_LC_ASSERT((erts_proc_lc_my_proc_locks(t_p) != 0) - || erts_thr_progress_is_blocking()); - if (is_internal_port(ERTS_TRACER_PROC(t_p))) { -#define LOCAL_HEAP_SIZE (5+5) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - - hp = local_heap; - mess = TUPLE4(hp, am_trace, t_p->common.id, what, data); - hp += 5; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, NULL, NULL); - send_to_port( -#ifndef ERTS_SMP - /* No fake schedule out and in again after an exit */ - what == am_exit ? NULL : c_p, -#else - /* Fake schedule out and in are never sent when smp enabled */ - c_p, -#endif - mess, - &ERTS_TRACER_PROC(t_p), - &ERTS_TRACE_FLAGS(t_p)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - Eterm tmp; - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - size_t sz_data; - - ASSERT(is_internal_pid(ERTS_TRACER_PROC(t_p))); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(t_p), - ERTS_TRACE_FLAGS(t_p)); - - sz_data = size_object(data); - - need = sz_data + 5 + PATCH_TS_SIZE(t_p); - - hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref); - - tmp = copy_struct(data, sz_data, &hp, off_heap); - mess = TUPLE4(hp, am_trace, t_p->common.id, what, tmp); - hp += 5; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, bp, tracer_ref); - - ERTS_ENQ_TRACE_MSG(t_p->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } + ErtsTracerNif *tnif = NULL; + if (is_tracer_enabled(c_p, c_p_locks, &t_p->common, &tnif, + TRACE_FUN_E_PROCS, what)) + send_to_tracer_nif(c_p, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_PROCS, + what, data, THE_NON_VALUE); } @@ -2202,62 +1301,21 @@ trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data) * and 'args' may be a deep term. */ void -trace_proc_spawn(Process *p, Eterm pid, +trace_proc_spawn(Process *p, Eterm what, Eterm pid, Eterm mod, Eterm func, Eterm args) { - Eterm mfa; - Eterm mess; - Eterm* hp; - - if (is_internal_port(ERTS_TRACER_PROC(p))) { -#define LOCAL_HEAP_SIZE (4+6+5) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - mfa = TUPLE3(hp, mod, func, args); - hp += 4; - mess = TUPLE5(hp, am_trace, p->common.id, am_spawn, pid, mfa); - hp += 6; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); - send_to_port(p, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - Eterm tmp; - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - size_t sz_args, sz_pid; - Uint need; - - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); + ErtsTracerNif *tnif = NULL; + if (is_tracer_enabled(p, ERTS_PROC_LOCKS_ALL & + ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE), + &p->common, &tnif, TRACE_FUN_E_PROCS, what)) { + Eterm mfa; + Eterm* hp; - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); - - sz_args = size_object(args); - sz_pid = size_object(pid); - need = sz_args + 4 + 6 + PATCH_TS_SIZE(p); - - hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref); - - tmp = copy_struct(args, sz_args, &hp, off_heap); - mfa = TUPLE3(hp, mod, func, tmp); - hp += 4; - tmp = copy_struct(pid, sz_pid, &hp, off_heap); - mess = TUPLE5(hp, am_trace, p->common.id, am_spawn, tmp, mfa); - hp += 6; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref); - - ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); + hp = HAlloc(p, 4); + mfa = TUPLE3(hp, mod, func, args); + hp += 4; + send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_PROCS, + what, pid, mfa); } } @@ -2289,68 +1347,26 @@ void save_calls(Process *p, Export *e) * are all small (atomic) integers. */ void -trace_gc(Process *p, Eterm what) +trace_gc(Process *p, Eterm what, Uint size) { - ErlHeapFragment *bp = NULL; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref = ERTS_NULL_TRACER_REF; /* Initialized - to eliminate - compiler - warning */ + ErtsTracerNif *tnif = NULL; Eterm* hp; Eterm msg = NIL; - Uint size; - -#define LOCAL_HEAP_SIZE \ - (ERTS_PROCESS_GC_INFO_MAX_SIZE) + \ - 5/*4-tuple */ + ERTS_TRACE_PATCH_TS_MAX_SIZE - DeclareTmpHeap(local_heap,LOCAL_HEAP_SIZE,p); - - UseTmpHeap(LOCAL_HEAP_SIZE,p); - - if (is_internal_port(ERTS_TRACER_PROC(p))) { - hp = local_heap; -#ifdef DEBUG - size = 0; - (void) erts_process_gc_info(p, &size, NULL); - - size += 5/*4-tuple*/ + PATCH_TS_SIZE(p); -#endif - } else { - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); + Uint sz = 0; + Eterm tup; - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); + if (is_tracer_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif, TRACE_FUN_E_GC, what)) { - size = 0; - (void) erts_process_gc_info(p, &size, NULL); + (void) erts_process_gc_info(p, &sz, NULL); + hp = HAlloc(p, sz + 3 + 2); - size += 5/*4-tuple*/ + PATCH_TS_SIZE(p); + msg = erts_process_gc_info(p, NULL, &hp); + tup = TUPLE2(hp, am_wordsize, make_small(size)); hp += 3; + msg = CONS(hp, tup, msg); hp += 2; - hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); + send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_GC, + what, msg, am_undefined); } - - ASSERT(size <= LOCAL_HEAP_SIZE); - - msg = erts_process_gc_info(p, NULL, &hp); - - msg = TUPLE4(hp, am_trace, p->common.id, what, msg); - hp += 5; - - erts_smp_mtx_lock(&smq_mtx); - - if (is_internal_port(ERTS_TRACER_PROC(p))) { - PATCH_TS(TFLGS_TS_TYPE(p), msg, hp, NULL, NULL); - send_to_port(p, msg, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); - } - else { - PATCH_TS(TFLGS_TS_TYPE(p), msg, hp, bp, tracer_ref); - ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, msg, bp); - } - erts_smp_mtx_unlock(&smq_mtx); - UnUseTmpHeap(LOCAL_HEAP_SIZE,p); -#undef LOCAL_HEAP_SIZE } void @@ -2412,7 +1428,7 @@ monitor_long_schedule_proc(Process *p, BeamInstr *in_fp, BeamInstr *out_fp, Uint { ErtsMessage *mp = erts_alloc_message(0, NULL); mp->data.heap_frag = bp; - erts_queue_message(monitor_p, NULL, mp, msg, NIL); + erts_queue_message(monitor_p, NULL, mp, msg); } #endif } @@ -2477,7 +1493,7 @@ monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time) { ErtsMessage *mp = erts_alloc_message(0, NULL); mp->data.heap_frag = bp; - erts_queue_message(monitor_p, NULL, mp, msg, NIL); + erts_queue_message(monitor_p, NULL, mp, msg); } #endif } @@ -2552,7 +1568,7 @@ monitor_long_gc(Process *p, Uint time) { { ErtsMessage *mp = erts_alloc_message(0, NULL); mp->data.heap_frag = bp; - erts_queue_message(monitor_p, NULL, mp, msg, NIL); + erts_queue_message(monitor_p, NULL, mp, msg); } #endif } @@ -2627,7 +1643,7 @@ monitor_large_heap(Process *p) { { ErtsMessage *mp = erts_alloc_message(0, NULL); mp->data.heap_frag = bp; - erts_queue_message(monitor_p, NULL, mp, msg, NIL); + erts_queue_message(monitor_p, NULL, mp, msg); } #endif } @@ -2659,7 +1675,7 @@ monitor_generic(Process *p, Eterm type, Eterm spec) { { ErtsMessage *mp = erts_alloc_message(0, NULL); mp->data.heap_frag = bp; - erts_queue_message(monitor_p, NULL, mp, msg, NIL); + erts_queue_message(monitor_p, NULL, mp, msg); } #endif @@ -2756,71 +1772,15 @@ profile_scheduler_q(Eterm scheduler_id, Eterm state, Eterm no_schedulers, Uint M } - -/* Send {trace_ts, Pid, What, {Mod, Func, Arity}, Timestamp} - * or {trace, Pid, What, {Mod, Func, Arity}} - * - * where 'What' is supposed to be 'in' or 'out'. - * - * Virtual scheduling do not fake scheduling for ports. - */ - - -void trace_virtual_sched(Process *p, Eterm what) -{ - trace_sched_aux(p, what, 1); -} - /* Port profiling */ void trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) { - Eterm mess; - Eterm* hp; - - if (is_internal_port(ERTS_TRACER_PROC(p))) { -#define LOCAL_HEAP_SIZE (6+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - - mess = TUPLE5(hp, am_trace, calling_pid, am_open, p->common.id, drv_name); - hp += 6; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); - /* No fake schedule */ - send_to_port(NULL, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - size_t sz_data; - ERTS_TRACER_REF_TYPE tracer_ref; - - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); - - sz_data = 6 + PATCH_TS_SIZE(p); - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); - - hp = ERTS_ALLOC_SYSMSG_HEAP(sz_data, &bp, &off_heap, tracer_ref); - - mess = TUPLE5(hp, am_trace, calling_pid, am_open, p->common.id, drv_name); - hp += 6; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref); - - ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } - + ErtsTracerNif *tnif = NULL; + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (is_tracer_enabled(NULL, 0, &p->common, &tnif, TRACE_FUN_E_PORTS, am_open)) + send_to_tracer_nif(NULL, &p->common, p->common.id, tnif, TRACE_FUN_T_PORTS, + am_open, calling_pid, drv_name); } /* Sends trace message: @@ -2832,52 +1792,208 @@ trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) { */ void trace_port(Port *t_p, Eterm what, Eterm data) { - Eterm mess; - Eterm* hp; + ErtsTracerNif *tnif = NULL; ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) || erts_thr_progress_is_blocking()); + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_PORTS, what)) + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_PORTS, + what, data, THE_NON_VALUE); +} - if (is_internal_port(ERTS_TRACER_PROC(t_p))) { -#define LOCAL_HEAP_SIZE (5+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - hp = local_heap; - mess = TUPLE4(hp, am_trace, t_p->common.id, what, data); - hp += 5; - erts_smp_mtx_lock(&smq_mtx); - PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, NULL, NULL); - /* No fake schedule */ - send_to_port(NULL,mess,&ERTS_TRACER_PROC(t_p),&ERTS_TRACE_FLAGS(t_p)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); +static Eterm +trace_port_tmp_binary(char *bin, Sint sz, Binary **bptrp, Eterm **hp) +{ + if (sz <= ERL_ONHEAP_BIN_LIMIT) { + ErlHeapBin *hb = (ErlHeapBin *)*hp; + hb->thing_word = header_heap_bin(sz); + hb->size = sz; + sys_memcpy(hb->data, bin, sz); + *hp += heap_bin_size(sz); + return make_binary(hb); } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - size_t sz_data; - ERTS_TRACER_REF_TYPE tracer_ref; + ProcBin* pb = (ProcBin *)*hp; + Binary *bptr = erts_bin_nrml_alloc(sz); + erts_refc_init(&bptr->refc, 1); + sys_memcpy(bptr->orig_bytes, bin, sz); + pb->thing_word = HEADER_PROC_BIN; + pb->size = sz; + pb->next = NULL; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + *bptrp = bptr; + *hp += PROC_BIN_SIZE; + return make_binary(pb); + } +} + +/* Sends trace message: + * {trace, PortPid, 'receive', {pid(), {command, iolist()}}} + * {trace, PortPid, 'receive', {pid(), {control, pid()}}} + * {trace, PortPid, 'receive', {pid(), exit}} + * + */ +void +trace_port_receive(Port *t_p, Eterm caller, Eterm what, ...) +{ + ErtsTracerNif *tnif = NULL; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) + || erts_thr_progress_is_blocking()); + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_RECEIVE, am_receive)) { + /* We can use a stack heap here, as the nif is called in the + context of a port */ +#define LOCAL_HEAP_SIZE (3 + 3 + heap_bin_size(ERL_ONHEAP_BIN_LIMIT) + 3) + DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); + + Eterm *hp, data, *orig_hp = NULL; + Binary *bptr = NULL; + va_list args; + UseTmpHeapNoproc(LOCAL_HEAP_SIZE); + hp = local_heap; + + if (what == am_close) { + data = what; + } else { + Eterm arg; + va_start(args, what); + if (what == am_command) { + char *bin = va_arg(args, char *); + Sint sz = va_arg(args, Sint); + va_end(args); + arg = trace_port_tmp_binary(bin, sz, &bptr, &hp); + } else if (what == am_call || what == am_control) { + unsigned int command = va_arg(args, unsigned int); + char *bin = va_arg(args, char *); + Sint sz = va_arg(args, Sint); + Eterm cmd; + va_end(args); + arg = trace_port_tmp_binary(bin, sz, &bptr, &hp); +#if defined(ARCH_32) + if (!IS_USMALL(0, command)) { + *hp = make_pos_bignum_header(1); + BIG_DIGIT(hp, 0) = (Uint)command; + cmd = make_big(hp); + hp += 2; + } else +#endif + { + cmd = make_small((Sint)command); + } + arg = TUPLE2(hp, cmd, arg); + hp += 3; + } else if (what == am_commandv) { + ErlIOVec *evp = va_arg(args, ErlIOVec*); + int i; + va_end(args); + if ((6 + evp->vsize * (2+PROC_BIN_SIZE+ERL_SUB_BIN_SIZE)) > LOCAL_HEAP_SIZE) { + hp = erts_alloc(ERTS_ALC_T_TMP, + (6 + evp->vsize * (2+PROC_BIN_SIZE+ERL_SUB_BIN_SIZE)) * sizeof(Eterm)); + orig_hp = hp; + } + arg = NIL; + /* Convert each element in the ErlIOVec to a sub bin that points + to a procbin. We don't have to increment the proc bin refc as + the port task keeps the reference alive. */ + for (i = evp->vsize-1; i >= 0; i--) { + if (evp->iov[i].iov_len) { + ProcBin* pb = (ProcBin*)hp; + ErlSubBin *sb; + ASSERT(evp->binv[i]); + pb->thing_word = HEADER_PROC_BIN; + pb->val = ErlDrvBinary2Binary(evp->binv[i]); + pb->size = pb->val->orig_size; + pb->next = NULL; + pb->bytes = (byte*) pb->val->orig_bytes; + pb->flags = 0; + hp += PROC_BIN_SIZE; + + sb = (ErlSubBin*) hp; + sb->thing_word = HEADER_SUB_BIN; + sb->size = evp->iov[i].iov_len; + sb->offs = (byte*)(evp->iov[i].iov_base) - pb->bytes; + sb->orig = make_binary(pb); + sb->bitoffs = 0; + sb->bitsize = 0; + sb->is_writable = 0; + hp += ERL_SUB_BIN_SIZE; + + arg = CONS(hp, make_binary(sb), arg); + hp += 2; + } + } + what = am_command; + } else { + arg = va_arg(args, Eterm); + va_end(args); + } + data = TUPLE2(hp, what, arg); + hp += 3; + } + + data = TUPLE2(hp, caller, data); + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_RECEIVE, + am_receive, data, THE_NON_VALUE); + + if (bptr && erts_refc_dectest(&bptr->refc, 1) == 0) + erts_bin_free(bptr); + + if (orig_hp) + erts_free(ERTS_ALC_T_TMP, orig_hp); + + UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); + } +#undef LOCAL_HEAP_SIZE +} - ASSERT(is_internal_pid(ERTS_TRACER_PROC(t_p))); +void +trace_port_send(Port *t_p, Eterm receiver, Eterm msg, int exists) +{ + ErtsTracerNif *tnif = NULL; + Eterm op = exists ? am_send : am_send_to_non_existing_process; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) + || erts_thr_progress_is_blocking()); + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SEND, op)) + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_SEND, + op, msg, receiver); +} - sz_data = 5 + PATCH_TS_SIZE(t_p); +void trace_port_send_binary(Port *t_p, Eterm to, Eterm what, char *bin, Sint sz) +{ + ErtsTracerNif *tnif = NULL; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) + || erts_thr_progress_is_blocking()); + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SEND, am_send)) { + Eterm msg; + Binary* bptr = NULL; +#define LOCAL_HEAP_SIZE (3 + 3 + heap_bin_size(ERL_ONHEAP_BIN_LIMIT)) + DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(t_p), - ERTS_TRACE_FLAGS(t_p)); + Eterm *hp; - hp = ERTS_ALLOC_SYSMSG_HEAP(sz_data, &bp, &off_heap, tracer_ref); + ERTS_CT_ASSERT(heap_bin_size(ERL_ONHEAP_BIN_LIMIT) >= PROC_BIN_SIZE); + UseTmpHeapNoproc(LOCAL_HEAP_SIZE); + hp = local_heap; - mess = TUPLE4(hp, am_trace, t_p->common.id, what, data); - hp += 5; + msg = trace_port_tmp_binary(bin, sz, &bptr, &hp); - erts_smp_mtx_lock(&smq_mtx); + msg = TUPLE2(hp, what, msg); + hp += 3; + msg = TUPLE2(hp, t_p->common.id, msg); + hp += 3; - PATCH_TS(TFLGS_TS_TYPE(t_p), mess, hp, bp, tracer_ref); + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_SEND, + am_send, msg, to); + if (bptr && erts_refc_dectest(&bptr->refc, 1) == 0) + erts_bin_free(bptr); - ERTS_ENQ_TRACE_MSG(t_p->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); + UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); +#undef LOCAL_HEAP_SIZE } } @@ -2891,83 +2007,19 @@ trace_port(Port *t_p, Eterm what, Eterm data) { void trace_sched_ports(Port *p, Eterm what) { - trace_sched_ports_where(p,what, make_small(0)); + trace_sched_ports_where(p, what, make_small(0)); } -void -trace_sched_ports_where(Port *p, Eterm what, Eterm where) { - Eterm mess; - Eterm* hp; - int ws = 5; - Eterm sched_id = am_undefined; - - if (is_internal_port(ERTS_TRACER_PROC(p))) { -#define LOCAL_HEAP_SIZE (6+ERTS_TRACE_PATCH_TS_MAX_SIZE) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; - - if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) { -#ifdef ERTS_SMP - ErtsSchedulerData *esd = erts_get_scheduler_data(); - if (esd) sched_id = make_small(esd->no); - else sched_id = am_undefined; -#else - sched_id = make_small(1); -#endif - mess = TUPLE5(hp, am_trace, p->common.id, what, sched_id, where); - ws = 6; - } else { - mess = TUPLE4(hp, am_trace, p->common.id, what, where); - ws = 5; - } - hp += ws; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, NULL, NULL); - - /* No fake scheduling */ - send_to_port(NULL, mess, &ERTS_TRACER_PROC(p), &ERTS_TRACE_FLAGS(p)); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE - erts_smp_mtx_unlock(&smq_mtx); - } else { - ErlHeapFragment *bp; - ErlOffHeap *off_heap; - ERTS_TRACER_REF_TYPE tracer_ref; - - ASSERT(is_internal_pid(ERTS_TRACER_PROC(p))); - - if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) ws = 6; /* Make place for scheduler id */ - - ERTS_GET_TRACER_REF(tracer_ref, - ERTS_TRACER_PROC(p), - ERTS_TRACE_FLAGS(p)); - - hp = ERTS_ALLOC_SYSMSG_HEAP(ws+PATCH_TS_SIZE(p), &bp, &off_heap, tracer_ref); - - if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) { -#ifdef ERTS_SMP - ErtsSchedulerData *esd = erts_get_scheduler_data(); - if (esd) sched_id = make_small(esd->no); - else sched_id = am_undefined; -#else - sched_id = make_small(1); -#endif - mess = TUPLE5(hp, am_trace, p->common.id, what, sched_id, where); - } else { - mess = TUPLE4(hp, am_trace, p->common.id, what, where); - } - hp += ws; - - erts_smp_mtx_lock(&smq_mtx); - - PATCH_TS(TFLGS_TS_TYPE(p), mess, hp, bp, tracer_ref); - ERTS_ENQ_TRACE_MSG(p->common.id, tracer_ref, mess, bp); - erts_smp_mtx_unlock(&smq_mtx); - } +void +trace_sched_ports_where(Port *t_p, Eterm what, Eterm where) { + ErtsTracerNif *tnif = NULL; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) + || erts_thr_progress_is_blocking()); + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SCHED_PORT, what)) + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, + tnif, TRACE_FUN_T_SCHED_PORT, + what, where, THE_NON_VALUE); } /* Port profiling */ @@ -3020,6 +2072,7 @@ profile_runnable_proc(Process *p, Eterm status){ Eterm *hp, msg; Eterm where = am_undefined; ErlHeapFragment *bp = NULL; + int use_current = 1; #ifndef ERTS_SMP #define LOCAL_HEAP_SIZE (4 + 6 + ERTS_TRACE_PATCH_TS_MAX_SIZE) @@ -3032,12 +2085,19 @@ profile_runnable_proc(Process *p, Eterm status){ Uint hsz = 4 + 6 + patch_ts_size(erts_system_profile_ts_type)-1; #endif - if (!p->current) { - p->current = find_function_from_pc(p->i); + if (ERTS_PROC_IS_EXITING(p)) { + use_current = 0; + /* could probably set 'where' to 'exiting' here, + * though it's not documented as such */ + } else { + if (!p->current) { + p->current = find_function_from_pc(p->i); + } + use_current = p->current != NULL; } #ifdef ERTS_SMP - if (!p->current) { + if (!use_current) { hsz -= 4; } @@ -3045,7 +2105,7 @@ profile_runnable_proc(Process *p, Eterm status){ hp = bp->mem; #endif - if (p->current) { + if (use_current) { where = TUPLE3(hp, p->current[0], p->current[1], make_small(p->current[2])); hp += 4; } else { where = make_small(0); @@ -3075,28 +2135,6 @@ profile_runnable_proc(Process *p, Eterm status){ #ifdef ERTS_SMP -void -erts_check_my_tracer_proc(Process *p) -{ - if (is_internal_pid(ERTS_TRACER_PROC(p))) { - Process *tracer = erts_pid2proc(p, - ERTS_PROC_LOCK_MAIN, - ERTS_TRACER_PROC(p), - ERTS_PROC_LOCK_STATUS); - int invalid_tracer = (!tracer - || !(ERTS_TRACE_FLAGS(tracer) & F_TRACER)); - if (tracer) - erts_smp_proc_unlock(tracer, ERTS_PROC_LOCK_STATUS); - if (invalid_tracer) { - erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); - ERTS_TRACE_FLAGS(p) &= ~TRACEE_FLAGS; - ERTS_TRACER_PROC(p) = NIL; - erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); - } - } -} - - typedef struct ErtsSysMsgQ_ ErtsSysMsgQ; struct ErtsSysMsgQ_ { ErtsSysMsgQ *next; @@ -3174,12 +2212,6 @@ static void print_msg_type(ErtsSysMsgQ *smqp) { switch (smqp->type) { - case SYS_MSG_TYPE_TRACE: - erts_fprintf(stderr, "TRACE "); - break; - case SYS_MSG_TYPE_SEQTRACE: - erts_fprintf(stderr, "SEQTRACE "); - break; case SYS_MSG_TYPE_SYSMON: erts_fprintf(stderr, "SYSMON "); break; @@ -3190,8 +2222,8 @@ print_msg_type(ErtsSysMsgQ *smqp) erts_fprintf(stderr, "ERRLGR "); break; case SYS_MSG_TYPE_PROC_MSG: - erts_fprintf(stderr, "PROC_MSG "); - break; + erts_fprintf(stderr, "PROC_MSG "); + break; default: erts_fprintf(stderr, "??? "); break; @@ -3203,17 +2235,6 @@ static void sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver) { switch (smqp->type) { - case SYS_MSG_TYPE_TRACE: - /* Invalid tracer_proc's are removed when processes - are scheduled in. */ - break; - case SYS_MSG_TYPE_SEQTRACE: - /* Reset seq_tracer if it hasn't changed */ - erts_smp_rwmtx_rwlock(&sys_trace_rwmtx); - if (system_seq_tracer == receiver) - system_seq_tracer = am_false; - erts_smp_rwmtx_rwunlock(&sys_trace_rwmtx); - break; case SYS_MSG_TYPE_SYSMON: if (receiver == NIL && !erts_system_monitor_long_gc @@ -3274,7 +2295,7 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver) break; } case SYS_MSG_TYPE_PROC_MSG: - break; + break; default: ASSERT(0); } @@ -3392,13 +2413,9 @@ sys_msg_dispatcher_func(void *unused) print_msg_type(smqp); #endif switch (smqp->type) { - case SYS_MSG_TYPE_TRACE: - case SYS_MSG_TYPE_PROC_MSG: - receiver = smqp->to; - break; - case SYS_MSG_TYPE_SEQTRACE: - receiver = erts_get_system_seq_tracer(); - break; + case SYS_MSG_TYPE_PROC_MSG: + receiver = smqp->to; + break; case SYS_MSG_TYPE_SYSMON: receiver = erts_get_system_monitor(); if (smqp->from == receiver) { @@ -3433,16 +2450,8 @@ sys_msg_dispatcher_func(void *unused) if (is_internal_pid(receiver)) { proc = erts_pid2proc(NULL, 0, receiver, proc_locks); - if (!proc - || (smqp->type == SYS_MSG_TYPE_TRACE - && !(ERTS_TRACE_FLAGS(proc) & F_TRACER))) { + if (!proc) { /* Bad tracer */ -#ifdef DEBUG_PRINTOUTS - if (smqp->type == SYS_MSG_TYPE_TRACE && proc) - erts_fprintf(stderr, - "<tracer alive but missing " - "F_TRACER flag> "); -#endif goto failure; } else { @@ -3450,7 +2459,7 @@ sys_msg_dispatcher_func(void *unused) queue_proc_msg: mp = erts_alloc_message(0, NULL); mp->data.heap_frag = smqp->bp; - erts_queue_message(proc,&proc_locks,mp,smqp->msg,NIL); + erts_queue_message(proc,&proc_locks,mp,smqp->msg); #ifdef DEBUG_PRINTOUTS erts_fprintf(stderr, "delivered\n"); #endif @@ -3516,12 +2525,6 @@ erts_foreach_sys_msg_in_q(void (*func)(Eterm, for (sm = sys_message_queue; sm; sm = sm->next) { Eterm to; switch (sm->type) { - case SYS_MSG_TYPE_TRACE: - to = sm->to; - break; - case SYS_MSG_TYPE_SEQTRACE: - to = erts_get_system_seq_tracer(); - break; case SYS_MSG_TYPE_SYSMON: to = erts_get_system_monitor(); break; @@ -3559,3 +2562,589 @@ init_sys_msg_dispatcher(void) } #endif + +#include "erl_nif.h" + +typedef struct { + char *name; + Uint arity; + ErlNifFunc *cb; +} ErtsTracerType; + +struct ErtsTracerNif_ { + HashBucket hb; + Eterm module; + struct erl_module_nif* nif_mod; + ErtsTracerType tracers[NIF_TRACER_TYPES]; +}; + +static void init_tracer_template(ErtsTracerNif *tnif) { + + /* default tracer functions */ + tnif->tracers[TRACE_FUN_DEFAULT].name = "trace"; + tnif->tracers[TRACE_FUN_DEFAULT].arity = 6; + tnif->tracers[TRACE_FUN_DEFAULT].cb = NULL; + + tnif->tracers[TRACE_FUN_ENABLED].name = "enabled"; + tnif->tracers[TRACE_FUN_ENABLED].arity = 3; + tnif->tracers[TRACE_FUN_ENABLED].cb = NULL; + + /* specific tracer functions */ + tnif->tracers[TRACE_FUN_T_SEND].name = "trace_send"; + tnif->tracers[TRACE_FUN_T_SEND].arity = 6; + tnif->tracers[TRACE_FUN_T_SEND].cb = NULL; + + tnif->tracers[TRACE_FUN_T_RECEIVE].name = "trace_receive"; + tnif->tracers[TRACE_FUN_T_RECEIVE].arity = 6; + tnif->tracers[TRACE_FUN_T_RECEIVE].cb = NULL; + + tnif->tracers[TRACE_FUN_T_CALL].name = "trace_call"; + tnif->tracers[TRACE_FUN_T_CALL].arity = 6; + tnif->tracers[TRACE_FUN_T_CALL].cb = NULL; + + tnif->tracers[TRACE_FUN_T_SCHED_PROC].name = "trace_running_procs"; + tnif->tracers[TRACE_FUN_T_SCHED_PROC].arity = 6; + tnif->tracers[TRACE_FUN_T_SCHED_PROC].cb = NULL; + + tnif->tracers[TRACE_FUN_T_SCHED_PORT].name = "trace_running_ports"; + tnif->tracers[TRACE_FUN_T_SCHED_PORT].arity = 6; + tnif->tracers[TRACE_FUN_T_SCHED_PORT].cb = NULL; + + tnif->tracers[TRACE_FUN_T_GC].name = "trace_garbage_collection"; + tnif->tracers[TRACE_FUN_T_GC].arity = 6; + tnif->tracers[TRACE_FUN_T_GC].cb = NULL; + + tnif->tracers[TRACE_FUN_T_PROCS].name = "trace_procs"; + tnif->tracers[TRACE_FUN_T_PROCS].arity = 6; + tnif->tracers[TRACE_FUN_T_PROCS].cb = NULL; + + tnif->tracers[TRACE_FUN_T_PORTS].name = "trace_ports"; + tnif->tracers[TRACE_FUN_T_PORTS].arity = 6; + tnif->tracers[TRACE_FUN_T_PORTS].cb = NULL; + + /* specific enabled functions */ + tnif->tracers[TRACE_FUN_E_SEND].name = "enabled_send"; + tnif->tracers[TRACE_FUN_E_SEND].arity = 3; + tnif->tracers[TRACE_FUN_E_SEND].cb = NULL; + + tnif->tracers[TRACE_FUN_E_RECEIVE].name = "enabled_receive"; + tnif->tracers[TRACE_FUN_E_RECEIVE].arity = 3; + tnif->tracers[TRACE_FUN_E_RECEIVE].cb = NULL; + + tnif->tracers[TRACE_FUN_E_CALL].name = "enabled_call"; + tnif->tracers[TRACE_FUN_E_CALL].arity = 3; + tnif->tracers[TRACE_FUN_E_CALL].cb = NULL; + + tnif->tracers[TRACE_FUN_E_SCHED_PROC].name = "enabled_running_procs"; + tnif->tracers[TRACE_FUN_E_SCHED_PROC].arity = 3; + tnif->tracers[TRACE_FUN_E_SCHED_PROC].cb = NULL; + + tnif->tracers[TRACE_FUN_E_SCHED_PORT].name = "enabled_running_ports"; + tnif->tracers[TRACE_FUN_E_SCHED_PORT].arity = 3; + tnif->tracers[TRACE_FUN_E_SCHED_PORT].cb = NULL; + + tnif->tracers[TRACE_FUN_E_GC].name = "enabled_garbage_collection"; + tnif->tracers[TRACE_FUN_E_GC].arity = 3; + tnif->tracers[TRACE_FUN_E_GC].cb = NULL; + + tnif->tracers[TRACE_FUN_E_PROCS].name = "enabled_procs"; + tnif->tracers[TRACE_FUN_E_PROCS].arity = 3; + tnif->tracers[TRACE_FUN_E_PROCS].cb = NULL; + + tnif->tracers[TRACE_FUN_E_PORTS].name = "enabled_ports"; + tnif->tracers[TRACE_FUN_E_PORTS].arity = 3; + tnif->tracers[TRACE_FUN_E_PORTS].cb = NULL; +} + +static Hash *tracer_hash = NULL; +static erts_smp_rwmtx_t tracer_mtx; + +static ErtsTracerNif * +load_tracer_nif(const ErtsTracer tracer) +{ + Module* mod = erts_get_module(ERTS_TRACER_MODULE(tracer), + erts_active_code_ix()); + struct erl_module_instance *instance; + ErlNifFunc *funcs; + int num_of_funcs; + ErtsTracerNif tnif_tmpl, *tnif; + ErtsTracerType *tracers; + int i,j; + + if (!mod || !mod->curr.nif) { + return NULL; + } + + instance = &mod->curr; + + init_tracer_template(&tnif_tmpl); + tnif_tmpl.nif_mod = instance->nif; + tnif_tmpl.module = ERTS_TRACER_MODULE(tracer); + tracers = tnif_tmpl.tracers; + + num_of_funcs = erts_nif_get_funcs(instance->nif, &funcs); + + for(i = 0; i < num_of_funcs; i++) { + for (j = 0; j < NIF_TRACER_TYPES; j++) { + if (strcmp(tracers[j].name, funcs[i].name) == 0 && tracers[j].arity == funcs[i].arity) { + tracers[j].cb = &(funcs[i]); + break; + } + } + } + + if (tracers[TRACE_FUN_DEFAULT].cb == NULL || tracers[TRACE_FUN_ENABLED].cb == NULL ) { + return NULL; + } + + erts_smp_rwmtx_rwlock(&tracer_mtx); + tnif = hash_put(tracer_hash, &tnif_tmpl); + erts_smp_rwmtx_rwunlock(&tracer_mtx); + + return tnif; +} + +static ERTS_INLINE ErtsTracerNif * +lookup_tracer_nif(const ErtsTracer tracer) +{ + ErtsTracerNif tnif_tmpl; + ErtsTracerNif *tnif; + tnif_tmpl.module = ERTS_TRACER_MODULE(tracer); + erts_smp_rwmtx_rlock(&tracer_mtx); + if ((tnif = hash_get(tracer_hash, &tnif_tmpl)) == NULL) { + erts_smp_rwmtx_runlock(&tracer_mtx); + tnif = load_tracer_nif(tracer); + ASSERT(!tnif || tnif->nif_mod); + return tnif; + } + erts_smp_rwmtx_runlock(&tracer_mtx); + ASSERT(tnif->nif_mod); + return tnif; +} + +/* This function converts an Erlang tracer term to ErtsTracer. + It returns THE_NON_VALUE if an invalid tracer term was given. + Accepted input is: + pid() || port() || {prefix, pid()} || {prefix, port()} || + {prefix, atom(), term()} || {atom(), term()} + */ +ErtsTracer +erts_term_to_tracer(Eterm prefix, Eterm t) +{ + ErtsTracer tracer = erts_tracer_nil; + ASSERT(is_atom(prefix) || prefix == THE_NON_VALUE); + if (!is_nil(t)) { + Eterm module = am_erl_tracer, state = THE_NON_VALUE; + Eterm hp[2]; + if (is_tuple(t)) { + Eterm *tp = tuple_val(t); + if (prefix != THE_NON_VALUE) { + if (arityval(tp[0]) == 2 && tp[1] == prefix) + t = tp[2]; + else if (arityval(tp[0]) == 3 && tp[1] == prefix && is_atom(tp[2])) { + module = tp[2]; + state = tp[3]; + } + } else { + if (arityval(tp[0]) == 2 && is_atom(tp[2])) { + module = tp[1]; + state = tp[2]; + } + } + } + if (state == THE_NON_VALUE && (is_internal_pid(t) || is_internal_port(t))) + state = t; + if (state == THE_NON_VALUE) + return THE_NON_VALUE; + erts_tracer_update(&tracer, CONS(hp, module, state)); + } + if (!lookup_tracer_nif(tracer)) { + ASSERT(ERTS_TRACER_MODULE(tracer) != am_erl_tracer); + ERTS_TRACER_CLEAR(&tracer); + return THE_NON_VALUE; + } + return tracer; +} + +Eterm +erts_tracer_to_term(Process *p, ErtsTracer tracer) +{ + if (ERTS_TRACER_IS_NIL(tracer)) + return am_false; + if (ERTS_TRACER_MODULE(tracer) == am_erl_tracer) + /* Have to manage these specifically in order to be + backwards compatible */ + return ERTS_TRACER_STATE(tracer); + else { + Eterm *hp = HAlloc(p, 3); + return TUPLE2(hp, ERTS_TRACER_MODULE(tracer), + copy_object(ERTS_TRACER_STATE(tracer), p)); + } +} + + +static ERTS_INLINE int +send_to_tracer_nif_raw(Process *c_p, Process *tracee, + const ErtsTracer tracer, Uint tracee_flags, + Eterm t_p_id, ErtsTracerNif *tnif, + enum ErtsTracerOpt topt, + Eterm tag, Eterm msg, Eterm extra, Eterm pam_result) +{ + if (tnif || (tnif = lookup_tracer_nif(tracer)) != NULL) { +#define MAP_SIZE 3 + Eterm argv[6], local_heap[3+MAP_SIZE /* values */ + (MAP_SIZE+1 /* keys */)]; + flatmap_t *map = (flatmap_t*)(local_heap+(MAP_SIZE+1)); + Eterm *map_values = flatmap_get_values(map); + + topt = (tnif->tracers[topt].cb) ? topt : TRACE_FUN_DEFAULT; + ASSERT(topt < NIF_TRACER_TYPES); + + argv[0] = tag; + argv[1] = ERTS_TRACER_STATE(tracer); + argv[2] = t_p_id; + argv[3] = msg; + argv[4] = extra == THE_NON_VALUE ? am_undefined : extra; + argv[5] = make_flatmap(map); + + map->thing_word = MAP_HEADER_FLATMAP; + map->size = MAP_SIZE; + map->keys = TUPLE3(local_heap, am_match_spec_result, am_scheduler_id, am_timestamp); + + *map_values++ = pam_result; + if (tracee_flags & F_TRACE_SCHED_NO) + *map_values++ = make_small(erts_get_scheduler_id()); + else + *map_values++ = am_undefined; + if (tracee_flags & F_NOW_TS) +#ifdef HAVE_ERTS_NOW_CPU + if (erts_cpu_timestamp) + *map_values++ = am_cpu_timestamp; + else +#endif + *map_values++ = am_timestamp; + else if (tracee_flags & F_STRICT_MON_TS) + *map_values++ = am_strict_monotonic; + else if (tracee_flags & F_MON_TS) + *map_values++ = am_monotonic; + else + *map_values++ = am_undefined; + +#undef MAP_SIZE + erts_nif_call_function(c_p, tracee ? tracee : c_p, + tnif->nif_mod, + tnif->tracers[topt].cb, + tnif->tracers[topt].arity, + argv); + } + return 1; +} + +static ERTS_INLINE int +send_to_tracer_nif(Process *c_p, ErtsPTabElementCommon *t_p, + Eterm t_p_id, ErtsTracerNif *tnif, enum ErtsTracerOpt topt, + Eterm tag, Eterm msg, Eterm extra) +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + if (c_p) { + /* We have to hold the main lock of the currently executing process */ + erts_proc_lc_chk_have_proc_locks(c_p, ERTS_PROC_LOCK_MAIN); + } + if (is_internal_pid(t_p->id)) { + /* We have to have at least one lock */ + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks((Process*)t_p) & ERTS_PROC_LOCKS_ALL); + } else { + ASSERT(is_internal_port(t_p->id)); + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked((Port*)t_p)); + } +#endif + + return send_to_tracer_nif_raw(c_p, + is_internal_pid(t_p->id) ? (Process*)t_p : NULL, + t_p->tracer, t_p->trace_flags, + t_p_id, tnif, topt, tag, msg, extra, + am_true); +} + +static ERTS_INLINE Eterm +call_enabled_tracer(Process *c_p, const ErtsTracer tracer, + ErtsTracerNif **tnif_ret, + enum ErtsTracerOpt topt, + Eterm tag, Eterm t_p_id) { + ErtsTracerNif *tnif = lookup_tracer_nif(tracer); + if (tnif) { + Eterm argv[] = {tag, ERTS_TRACER_STATE(tracer), t_p_id}; + topt = (tnif->tracers[topt].cb) ? topt : TRACE_FUN_ENABLED; + ASSERT(topt < NIF_TRACER_TYPES); + ASSERT(tnif->tracers[topt].cb != NULL); + if (tnif_ret) *tnif_ret = tnif; + return erts_nif_call_function(c_p, NULL, tnif->nif_mod, + tnif->tracers[topt].cb, + tnif->tracers[topt].arity, + argv); + } + return am_remove; +} + +static int +is_tracer_enabled(Process* c_p, ErtsProcLocks c_p_locks, + ErtsPTabElementCommon *t_p, + ErtsTracerNif **tnif_ret, + enum ErtsTracerOpt topt, Eterm tag) { + Eterm nif_result; + +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + if (c_p) + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == c_p_locks + || erts_thr_progress_is_blocking()); + if (is_internal_pid(t_p->id)) { + /* We have to have at least one lock */ + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks((Process*)t_p) & ERTS_PROC_LOCKS_ALL + || erts_thr_progress_is_blocking()); + } else { + ASSERT(is_internal_port(t_p->id)); + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked((Port*)t_p) + || erts_thr_progress_is_blocking()); + } +#endif + + nif_result = call_enabled_tracer(c_p, t_p->tracer, tnif_ret, topt, tag, t_p->id); + switch (nif_result) { + case am_discard: return 0; + case am_trace: return 1; + case THE_NON_VALUE: + case am_remove: break; + default: + /* only am_remove should be returned, but if + something else is returned we fall-through + and remove the tracer. */ + ASSERT(0); + } + + /* Only remove tracer on self() and ports */ + if (is_internal_port(t_p->id) || (c_p && c_p->common.id == t_p->id)) { + ErtsProcLocks c_p_xlocks = 0; + if (is_internal_pid(t_p->id)) { + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) & ERTS_PROC_LOCK_MAIN); + if (c_p_locks != ERTS_PROC_LOCKS_ALL) { + c_p_xlocks = ~c_p_locks & ERTS_PROC_LOCKS_ALL; + if (erts_smp_proc_trylock(c_p, c_p_xlocks) == EBUSY) { + erts_smp_proc_unlock(c_p, c_p_locks & ~ERTS_PROC_LOCK_MAIN); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + } + } + } + erts_tracer_replace(t_p, erts_tracer_nil); + t_p->trace_flags &= ~TRACEE_FLAGS; + + if (c_p_xlocks) + erts_smp_proc_unlock(c_p, c_p_xlocks); + } + + return 0; +} + +int erts_is_tracer_proc_enabled(Process* c_p, ErtsProcLocks c_p_locks, + ErtsPTabElementCommon *t_p, Eterm type) +{ + return is_tracer_enabled(c_p, c_p_locks, t_p, NULL, TRACE_FUN_ENABLED, am_trace_status); +} + +int erts_is_tracer_enabled(Process *c_p, const ErtsTracer tracer) +{ + ErtsTracerNif *tnif = lookup_tracer_nif(tracer); + if (tnif) { + Eterm nif_result = call_enabled_tracer(c_p, tracer, &tnif, + TRACE_FUN_ENABLED, am_trace_status, + c_p->common.id); + switch (nif_result) { + case am_discard: + case am_trace: return 1; + default: + break; + } + } + return 0; +} + +void erts_tracer_replace(ErtsPTabElementCommon *t_p, const ErtsTracer tracer) +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + if (is_internal_pid(t_p->id) && !erts_thr_progress_is_blocking()) { + erts_proc_lc_chk_have_proc_locks((Process*)t_p, ERTS_PROC_LOCKS_ALL); + } else if (is_internal_port(t_p->id)) { + ERTS_LC_ASSERT(erts_lc_is_port_locked((Port*)t_p) + || erts_thr_progress_is_blocking()); + } +#endif + if (ERTS_TRACER_COMPARE(t_p->tracer, tracer)) + return; + + erts_tracer_update(&t_p->tracer, tracer); +} + +static void free_tracer(void *p) +{ + ErtsTracer tracer = (ErtsTracer)p; + + if (is_immed(ERTS_TRACER_STATE(tracer))) { + erts_free(ERTS_ALC_T_HEAP_FRAG, ptr_val(tracer)); + } else { + ErlHeapFragment *hf = (void*)((char*)(ptr_val(tracer)) - offsetof(ErlHeapFragment, mem)); + free_message_buffer(hf); + } +} + +/* un-define erts_tracer_update before implementation */ +#ifdef erts_tracer_update +#undef erts_tracer_update +#endif + +/* + * ErtsTracer is either NIL, 'true' or [Mod | State] + * + * - If State is immediate then the memory for + * the cons cell is just two words + sizeof(ErtsThrPrgrLaterOp) large. + * - If State is a complex term then the cons cell + * is allocated in an ErlHeapFragment where the cons + * ptr points to the mem field. So in order to get the + * ptr to the fragment you do this: + * (char*)(ptr_val(tracer)) - offsetof(ErlHeapFragment, mem) + * Normally you shouldn't have to care about this though + * as erts_tracer_update takes care of it for you. + * + * When ErtsTracer is stored in the stack as part of a + * return trace, the cons cell is stored on the heap of + * the process. + * + * The cons cell is not always stored on the heap as: + * 1) for port/meta tracing there is no heap + * 2) we would need the main lock in order to + * read the tracer which is undesirable. + * + * One way to optimize this (memory wise) is to keep an refc and only bump + * the refc when *tracer is NIL. + */ +void +erts_tracer_update(ErtsTracer *tracer, const ErtsTracer new_tracer) +{ + ErlHeapFragment *hf; + + if (is_not_nil(*tracer)) { + Uint offs = 2; + UWord size = 2 * sizeof(Eterm) + sizeof(ErtsThrPrgrLaterOp); + ASSERT(is_list(*tracer)); + if (is_not_immed(ERTS_TRACER_STATE(*tracer))) { + hf = (void*)(((char*)(ptr_val(*tracer)) - offsetof(ErlHeapFragment, mem))); + offs = hf->used_size; + size = hf->alloc_size * sizeof(Eterm) + sizeof(ErlHeapFragment); + ASSERT(offs == size_object(*tracer)); + } + /* We schedule the free:ing of the tracer until after a thread progress + has been made so that we know that no schedulers have any references + to it. Because we do this, it is possible to release all locks of a + process/port and still use the ErtsTracer of that port/process + without having to worry if it is free'd. + */ + erts_schedule_thr_prgr_later_cleanup_op( + free_tracer, (void*)(*tracer), + (ErtsThrPrgrLaterOp*)(ptr_val(*tracer) + offs), + size); + } + + if (is_nil(new_tracer)) { + *tracer = new_tracer; + } else if (is_immed(ERTS_TRACER_STATE(new_tracer))) { + /* If tracer state is an immediate we only allocate a 2 Eterm heap. + Not sure if it is worth it, we save 4 words (sizeof(ErlHeapFragment)) + per tracer. */ + Eterm *hp = erts_alloc(ERTS_ALC_T_HEAP_FRAG, + 2*sizeof(Eterm) + sizeof(ErtsThrPrgrLaterOp)); + *tracer = CONS(hp, ERTS_TRACER_MODULE(new_tracer), + ERTS_TRACER_STATE(new_tracer)); + } else { + Eterm *hp, tracer_state = ERTS_TRACER_STATE(new_tracer), + tracer_module = ERTS_TRACER_MODULE(new_tracer); + Uint sz = size_object(tracer_state); + hf = new_message_buffer(sz + 2 /* cons cell */ + (sizeof(ErtsThrPrgrLaterOp)+sizeof(Eterm)-1)/sizeof(Eterm)); + hp = hf->mem + 2; + hf->used_size -= (sizeof(ErtsThrPrgrLaterOp)+sizeof(Eterm)-1)/sizeof(Eterm); + *tracer = copy_struct(tracer_state, sz, &hp, &hf->off_heap); + *tracer = CONS(hf->mem, tracer_module, *tracer); + ASSERT((void*)(((char*)(ptr_val(*tracer)) - offsetof(ErlHeapFragment, mem))) == hf); + } +} + +static void init_tracer_nif() +{ + erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER; + rwmtx_opt.type = ERTS_SMP_RWMTX_TYPE_EXTREMELY_FREQUENT_READ; + rwmtx_opt.lived = ERTS_SMP_RWMTX_LONG_LIVED; + erts_smp_rwmtx_init_opt(&tracer_mtx, &rwmtx_opt, "tracer_mtx"); + + erts_tracer_nif_clear(); + +} + +int erts_tracer_nif_clear() +{ + + erts_smp_rwmtx_rlock(&tracer_mtx); + if (!tracer_hash || tracer_hash->nobjs) { + + HashFunctions hf; + hf.hash = tracer_hash_fun; + hf.cmp = tracer_cmp_fun; + hf.alloc = tracer_alloc_fun; + hf.free = tracer_free_fun; + hf.meta_alloc = (HMALLOC_FUN) erts_alloc; + hf.meta_free = (HMFREE_FUN) erts_free; + hf.meta_print = (HMPRINT_FUN) erts_print; + + erts_smp_rwmtx_runlock(&tracer_mtx); + erts_smp_rwmtx_rwlock(&tracer_mtx); + + if (tracer_hash) + hash_delete(tracer_hash); + + tracer_hash = hash_new(ERTS_ALC_T_TRACER_NIF, "tracer_hash", 10, hf); + + erts_smp_rwmtx_rwunlock(&tracer_mtx); + return 1; + } + + erts_smp_rwmtx_runlock(&tracer_mtx); + return 0; +} + +static int tracer_cmp_fun(void* a, void* b) +{ + return ((ErtsTracerNif*)a)->module != ((ErtsTracerNif*)b)->module; +} + +static HashValue tracer_hash_fun(void* obj) +{ + return make_internal_hash(((ErtsTracerNif*)obj)->module); +} + +static void *tracer_alloc_fun(void* tmpl) +{ + ErtsTracerNif *obj = erts_alloc(ERTS_ALC_T_TRACER_NIF, + sizeof(ErtsTracerNif) + + sizeof(ErtsThrPrgrLaterOp)); + memcpy(obj, tmpl, sizeof(*obj)); + return obj; +} + +static void tracer_free_fun_cb(void* obj) +{ + erts_free(ERTS_ALC_T_TRACER_NIF, obj); +} + +static void tracer_free_fun(void* obj) +{ + ErtsTracerNif *tnif = obj; + erts_schedule_thr_prgr_later_op( + tracer_free_fun_cb, obj, + (ErtsThrPrgrLaterOp*)(tnif + 1)); + +} diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index 1da27ee128..9a007e62ec 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -46,6 +46,8 @@ #define ERTS_SEQTFLGS2TSTYPE(SEQTFLGS) \ ((int) (((SEQTFLGS) >> ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT) \ & ERTS_TRACE_TS_TYPE_MASK)) +#define ERTS_SEQTFLGS2TFLGS(SEQTFLGS) \ + (ERTS_SEQTFLGS2TSTYPE(SEQTFLGS) << ERTS_TRACE_FLAGS_TS_TYPE_SHIFT) #endif /* ERL_TRACE_H__FLAGS__ */ @@ -62,15 +64,19 @@ void erts_system_profile_clear(Process *c_p); /* erl_trace.c */ void erts_init_trace(void); void erts_trace_check_exiting(Eterm exiting); -Eterm erts_set_system_seq_tracer(Process *c_p, - ErtsProcLocks c_p_locks, - Eterm new); -Eterm erts_get_system_seq_tracer(void); -void erts_change_default_tracing(int setflags, Uint *flagsp, Eterm *tracerp); -void erts_get_default_tracing(Uint *flagsp, Eterm *tracerp); +ErtsTracer erts_set_system_seq_tracer(Process *c_p, + ErtsProcLocks c_p_locks, + ErtsTracer new); +ErtsTracer erts_get_system_seq_tracer(void); +void erts_change_default_proc_tracing(int setflags, Uint flagsp, + const ErtsTracer tracerp); +void erts_get_default_proc_tracing(Uint *flagsp, ErtsTracer *tracerp); +void erts_change_default_port_tracing(int setflags, Uint flagsp, + const ErtsTracer tracerp); +void erts_get_default_port_tracing(Uint *flagsp, ErtsTracer *tracerp); void erts_set_system_monitor(Eterm monitor); Eterm erts_get_system_monitor(void); -int erts_is_tracer_proc_valid(Process* p); +int erts_is_tracer_valid(Process* p); #ifdef ERTS_SMP void erts_check_my_tracer_proc(Process *); @@ -81,28 +87,32 @@ void erts_foreach_sys_msg_in_q(void (*func)(Eterm, Eterm, ErlHeapFragment *)); void erts_queue_error_logger_message(Eterm, Eterm, ErlHeapFragment *); +void erts_send_sys_msg_proc(Eterm, Eterm, Eterm, ErlHeapFragment *); #endif -void erts_send_sys_msg_proc(Eterm, Eterm, Eterm, ErlHeapFragment *); void trace_send(Process*, Eterm, Eterm); -void trace_receive(Process*, Eterm); -Uint32 erts_call_trace(Process *p, BeamInstr mfa[], struct binary *match_spec, Eterm* args, - int local, Eterm *tracer_pid); -void erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, Eterm *tracer_pid); +void trace_receive(Process *, Eterm); +Uint32 erts_call_trace(Process *p, BeamInstr mfa[], struct binary *match_spec, + Eterm* args, int local, ErtsTracer *tracer); +void erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, + ErtsTracer *tracer); void erts_trace_exception(Process* p, BeamInstr mfa[], Eterm class, Eterm value, - Eterm *tracer); + ErtsTracer *tracer); void erts_trace_return_to(Process *p, BeamInstr *pc); -void trace_sched(Process*, Eterm); -void trace_proc(Process*, Process*, Eterm, Eterm); -void trace_proc_spawn(Process*, Eterm pid, Eterm mod, Eterm func, Eterm args); +void trace_sched(Process*, ErtsProcLocks, Eterm); +void trace_proc(Process*, ErtsProcLocks, Process*, Eterm, Eterm); +void trace_proc_spawn(Process*, Eterm what, Eterm pid, Eterm mod, Eterm func, Eterm args); void save_calls(Process *p, Export *); -void trace_gc(Process *p, Eterm what); +void trace_gc(Process *p, Eterm what, Uint size); /* port tracing */ -void trace_virtual_sched(Process*, Eterm); +void trace_virtual_sched(Process*, ErtsProcLocks, Eterm); void trace_sched_ports(Port *pp, Eterm); void trace_sched_ports_where(Port *pp, Eterm, Eterm); void trace_port(Port *, Eterm what, Eterm data); void trace_port_open(Port *, Eterm calling_pid, Eterm drv_name); +void trace_port_receive(Port *, Eterm calling_pid, Eterm tag, ...); +void trace_port_send(Port *, Eterm to, Eterm msg, int exists); +void trace_port_send_binary(Port *, Eterm to, Eterm what, char *bin, Sint sz); /* system_profile */ void erts_set_system_profile(Eterm profile); @@ -121,7 +131,7 @@ void monitor_large_heap(Process *p); void monitor_generic(Process *p, Eterm type, Eterm spec); Uint erts_trace_flag2bit(Eterm flag); int erts_trace_flags(Eterm List, - Uint *pMask, Eterm *pTracer, int *pCpuTimestamp); + Uint *pMask, ErtsTracer *pTracer, int *pCpuTimestamp); Eterm erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr *I); #ifdef ERTS_SMP @@ -161,15 +171,53 @@ int erts_set_trace_pattern(Process*p, Eterm* mfa, int specified, struct binary* match_prog_set, struct binary *meta_match_prog_set, int on, struct trace_pattern_flags, - Eterm meta_tracer_pid, int is_blocking); + ErtsTracer meta_tracer, int is_blocking); void erts_get_default_trace_pattern(int *trace_pattern_is_on, struct binary **match_spec, struct binary **meta_match_spec, struct trace_pattern_flags *trace_pattern_flags, - Eterm *meta_tracer_pid); + ErtsTracer *meta_tracer); int erts_is_default_trace_enabled(void); void erts_bif_trace_init(void); int erts_finish_breakpointing(void); +/* Nif tracer functions */ +int erts_is_tracer_proc_enabled(Process *c_p, ErtsProcLocks c_p_locks, + ErtsPTabElementCommon *t_p, Eterm type); +int erts_is_tracer_enabled(Process *c_p, const ErtsTracer tracer); +Eterm erts_tracer_to_term(Process *p, ErtsTracer tracer); +ErtsTracer erts_term_to_tracer(Eterm prefix, Eterm term); +void erts_tracer_replace(ErtsPTabElementCommon *t_p, + const ErtsTracer new_tracer); +void erts_tracer_update(ErtsTracer *tracer, const ErtsTracer new_tracer); +int erts_tracer_nif_clear(void); + +#define erts_tracer_update(t,n) do { if (*(t) != (n)) erts_tracer_update(t,n); } while(0) +#define ERTS_TRACER_CLEAR(t) erts_tracer_update(t, erts_tracer_nil) + +static const ErtsTracer +ERTS_DECLARE_DUMMY(erts_tracer_true) = am_true; + +static const ErtsTracer +ERTS_DECLARE_DUMMY(erts_tracer_nil) = NIL; + +#define ERTS_TRACER_COMPARE(t1, t2) \ + (EQ((t1), (t2))) + +#define ERTS_TRACER_IS_NIL(t1) ERTS_TRACER_COMPARE(t1, erts_tracer_nil) + +#define IS_TRACER_VALID(tracer) \ + (ERTS_TRACER_COMPARE(tracer,erts_tracer_true) \ + || ERTS_TRACER_IS_NIL(tracer) \ + || (is_list(tracer) && is_atom(CAR(list_val(tracer))))) + +#define ERTS_TRACER_FROM_ETERM(termp) \ + ((ErtsTracer*)(termp)) + +#define ERTS_TRACER_PROC_IS_ENABLED(PROC) \ + (!ERTS_TRACER_IS_NIL(ERTS_TRACER(PROC)) \ + && erts_is_tracer_proc_enabled(PROC, ERTS_PROC_LOCK_MAIN, \ + &(PROC)->common, am_trace_status)) + #endif /* ERL_TRACE_H__ */ diff --git a/erts/emulator/beam/erlang_dtrace.d b/erts/emulator/beam/erlang_dtrace.d index 73ef5a108a..237889e0f5 100644 --- a/erts/emulator/beam/erlang_dtrace.d +++ b/erts/emulator/beam/erlang_dtrace.d @@ -700,6 +700,35 @@ provider erlang { */ probe efile_drv__return(int, int, char *, int, int, int); + +/* + * The set of probes called by the erlang tracer nif backend. In order + * to receive events on these you both have to enable tracing in erlang + * using the trace bifs and also from dtrace/systemtap. + */ + + + /** + * A trace message of type `event` was triggered by process `p`. + * + * + * @param p the PID (string form) of the process + * @param event the event that was triggered (i.e. call or spawn) + * @param state the state of the tracer nif as a string + * @param arg1 first argument to the trace event + * @param arg2 second argument to the trace event + */ + probe trace(char *p, char *event, char *state, char *arg1, char *arg2); + + /** + * A sequence trace message of type `label` was triggered. + * + * @param state the state of the tracer nif as a string + * @param label the seq trace label + * @param seq_info the seq trace info tuple as a string + */ + probe trace_seq(char *state, char *label, char *seq_info); + /* * NOTE: * For formatting int64_t arguments within a D script, see: diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 9f43240b7e..3c002d43a7 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -3958,9 +3958,13 @@ error: * Must unlink all off-heap objects that may have been * linked into the process. */ - if (factory->hp < hp) { /* Sometimes we used hp and sometimes factory->hp */ - factory->hp = hp; /* the largest must be the freshest */ + if (factory->mode != FACTORY_CLOSED) { + if (factory->hp < hp) { /* Sometimes we used hp and sometimes factory->hp */ + factory->hp = hp; /* the largest must be the freshest */ + } } + else ASSERT(factory->hp == hp); + error_hamt: erts_factory_undo(factory); PSTACK_DESTROY(hamt_array); @@ -4425,22 +4429,32 @@ init_done: SKIP(1+atom_extra_skip); atom_extra_skip = 0; break; - case PID_EXT: case NEW_PID_EXT: + atom_extra_skip = 12; + goto case_PID; + case PID_EXT: atom_extra_skip = 9; + case_PID: /* In case it is an external pid */ heap_size += EXTERNAL_THING_HEAD_SIZE + 1; terms++; break; - case PORT_EXT: case NEW_PORT_EXT: + atom_extra_skip = 8; + goto case_PORT; + case PORT_EXT: atom_extra_skip = 5; + case_PORT: /* In case it is an external port */ heap_size += EXTERNAL_THING_HEAD_SIZE + 1; terms++; break; - case NEW_REFERENCE_EXT: case NEWER_REFERENCE_EXT: + atom_extra_skip = 4; + goto case_NEW_REFERENCE; + case NEW_REFERENCE_EXT: + atom_extra_skip = 1; + case_NEW_REFERENCE: { int id_words; @@ -4451,7 +4465,7 @@ init_done: goto error; ep += 2; - atom_extra_skip = 1 + 4*id_words; + atom_extra_skip += 4*id_words; /* In case it is an external ref */ #if defined(ARCH_64) heap_size += EXTERNAL_THING_HEAD_SIZE + id_words/2 + 1; diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 1d3704f0af..a7bc990deb 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -44,6 +44,8 @@ #include "erl_port.h" #include "erl_gc.h" +struct enif_func_t; + struct enif_environment_t /* ErlNifEnv */ { struct erl_module_nif* mod_nif; @@ -54,14 +56,21 @@ struct enif_environment_t /* ErlNifEnv */ int fpe_was_unmasked; struct enif_tmp_obj_t* tmp_obj_list; int exception_thrown; /* boolean */ + Process *tracee; }; extern void erts_pre_nif(struct enif_environment_t*, Process*, - struct erl_module_nif*); + struct erl_module_nif*, Process* tracee); extern void erts_post_nif(struct enif_environment_t* env); extern Eterm erts_nif_taints(Process* p); extern void erts_print_nif_taints(int to, void* to_arg); void erts_unload_nif(struct erl_module_nif* nif); extern void erl_nif_init(void); +extern int erts_nif_get_funcs(struct erl_module_nif*, + struct enif_func_t **funcs); +extern Eterm erts_nif_call_function(Process *p, Process *tracee, + struct erl_module_nif*, + struct enif_func_t *, + int argc, Eterm *argv); /* Driver handle (wrapper for old plain handle) */ #define ERL_DE_OK 0 @@ -1532,10 +1541,15 @@ ERTS_GLB_INLINE void dtrace_fun_decode(Process *process, ERTS_GLB_INLINE void dtrace_pid_str(Eterm pid, char *process_buf) { - erts_snprintf(process_buf, DTRACE_TERM_BUF_SIZE, "<%lu.%lu.%lu>", - pid_channel_no(pid), - pid_number(pid), - pid_serial(pid)); + if (is_pid(pid)) + erts_snprintf(process_buf, DTRACE_TERM_BUF_SIZE, "<%lu.%lu.%lu>", + pid_channel_no(pid), + pid_number(pid), + pid_serial(pid)); + else if (is_port(pid)) + erts_snprintf(process_buf, DTRACE_TERM_BUF_SIZE, "#Port<%lu.%lu>", + port_channel_no(pid), + port_number(pid)); } ERTS_GLB_INLINE void @@ -1547,9 +1561,7 @@ dtrace_proc_str(Process *process, char *process_buf) ERTS_GLB_INLINE void dtrace_port_str(Port *port, char *port_buf) { - erts_snprintf(port_buf, DTRACE_TERM_BUF_SIZE, "#Port<%lu.%lu>", - port_channel_no(port->common.id), - port_number(port->common.id)); + dtrace_pid_str(port->common.id, port_buf); } ERTS_GLB_INLINE void diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index de73da8e22..b14ca77a04 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -88,7 +88,7 @@ int erts_port_parallelism = 0; static erts_atomic64_t bytes_in; static erts_atomic64_t bytes_out; -static void deliver_result(Eterm sender, Eterm pid, Eterm res); +static void deliver_result(Port *p, Eterm sender, Eterm pid, Eterm res); static int init_driver(erts_driver_t *, ErlDrvEntry *, DE_Handle *); static void terminate_port(Port *p); static void pdl_init(void); @@ -212,6 +212,7 @@ static ERTS_INLINE void kill_port(Port *pp) { ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); + ERTS_TRACER_CLEAR(&ERTS_TRACER(pp)); erts_ptab_delete_element(&erts_port, &pp->common); /* Time of death */ erts_port_task_free_port(pp); /* In non-smp case the port structure may have been deallocated now */ @@ -404,7 +405,7 @@ static Port *create_port(char *name, prt->os_pid = -1; /* Set default tracing */ - erts_get_default_tracing(&ERTS_TRACE_FLAGS(prt), &ERTS_TRACER_PROC(prt)); + erts_get_default_port_tracing(&ERTS_TRACE_FLAGS(prt), &ERTS_TRACER(prt)); ERTS_CT_ASSERT(offsetof(Port,common) == 0); @@ -709,7 +710,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ if (driver->start) { ERTS_MSACC_PUSH_STATE_M(); if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) { - trace_sched_ports_where(port, am_in, am_start); + trace_sched_ports_where(port, am_in, am_open); } port->caller = pid; #ifdef USE_VM_PROBES @@ -753,7 +754,7 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ ERTS_MSACC_POP_STATE_M(); port->caller = NIL; if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) { - trace_sched_ports_where(port, am_out, am_start); + trace_sched_ports_where(port, am_out, am_open); } #ifdef ERTS_SMP if (port->xports) @@ -1300,7 +1301,7 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp) reds_left_in = CONTEXT_REDS/10; else { if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) - trace_virtual_sched(c_p, am_out); + trace_sched(c_p, ERTS_PROC_LOCK_MAIN, am_out); /* * No status lock held while sending runnable * proc trace messages. It is however not needed @@ -1384,7 +1385,7 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp) } if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) - trace_virtual_sched(c_p, am_in); + trace_sched(c_p, ERTS_PROC_LOCK_MAIN, am_in); /* * No status lock held while sending runnable * proc trace messages. It is however not needed @@ -1447,7 +1448,7 @@ queue_port_sched_op_reply(Process *rp, erts_factory_trim_and_close(factory, &msg, 1); - erts_queue_message(rp, rp_locksp, factory->message, msg, NIL); + erts_queue_message(rp, rp_locksp, factory->message, msg); } static void @@ -1535,9 +1536,8 @@ erts_schedule_proc2port_signal(Process *c_p, ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); c_p->msg.save = c_p->msg.last; - erts_smp_proc_unlock(c_p, - (ERTS_PROC_LOCK_MAIN - | ERTS_PROC_LOCKS_MSG_RECEIVE)); + erts_smp_proc_unlock(c_p, (ERTS_PROC_LOCKS_MSG_RECEIVE + | ERTS_PROC_LOCK_MAIN)); } @@ -1742,6 +1742,10 @@ call_driver_outputv(int bang_op, ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt) || ERTS_IS_CRASH_DUMPING); + + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, caller, am_commandv, evp); + #ifdef USE_VM_PROBES if (DTRACE_ENABLED(driver_outputv)) { DTRACE_FORMAT_COMMON_PID_AND_PORT(caller, prt); @@ -1868,6 +1872,9 @@ call_driver_output(int bang_op, } #endif + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, caller, am_command, bufp, size); + prt->caller = caller; (*drv->output)((ErlDrvData) prt->drv_data, bufp, size); prt->caller = NIL; @@ -2589,7 +2596,10 @@ call_deliver_port_exit(int bang_op, return ERTS_PORT_OP_DROPPED; } - if (!erts_deliver_port_exit(prt, from, reason, bang_op)) + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, from, am_close); + + if (!erts_deliver_port_exit(prt, from, reason, bang_op, broken_link)) return ERTS_PORT_OP_DROPPED; #ifdef USE_VM_PROBES @@ -2660,13 +2670,13 @@ erts_port_exit(Process *c_p, ERTS_PORT_SFLGS_INVALID_LOOKUP, 0, !refp, - am_exit); + am_close); switch (try_imm_drv_call(&try_call_state)) { case ERTS_TRY_IMM_DRV_CALL_OK: { res = call_deliver_port_exit(flags & ERTS_PORT_SIG_FLG_BANG_OP, - from, + c_p ? c_p->common.id : from, prt, try_call_state.state, reason, @@ -2745,8 +2755,11 @@ set_port_connected(int bang_op, return ERTS_PORT_OP_DROPPED; } + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, from, am_connect, connect); + ERTS_PORT_SET_CONNECTED(prt, connect); - deliver_result(prt->common.id, from, am_connected); + deliver_result(prt, prt->common.id, from, am_connected); #ifdef USE_VM_PROBES if(DTRACE_ENABLED(port_command)) { @@ -2768,10 +2781,22 @@ set_port_connected(int bang_op, erts_add_link(&ERTS_P_LINKS(rp), LINK_PID, prt->common.id); erts_add_link(&ERTS_P_LINKS(prt), LINK_PID, connect); + if (IS_TRACED_FL(rp, F_TRACE_PROCS)) + trace_proc(NULL, 0, rp, am_getting_linked, prt->common.id); + ERTS_PORT_SET_CONNECTED(prt, connect); erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + if (IS_TRACED_FL(prt, F_TRACE_PORTS)) + trace_port(prt, am_getting_linked, connect); + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, from, am_connect, connect); + if (IS_TRACED_FL(prt, F_TRACE_SEND)) { + Eterm hp[3]; + trace_port_send(prt, from, TUPLE2(hp, prt->common.id, am_connected), 1); + } + #ifdef USE_VM_PROBES if (DTRACE_ENABLED(port_connect)) { DTRACE_CHARBUF(process_str, DTRACE_TERM_BUF_SIZE); @@ -2874,8 +2899,11 @@ static void port_unlink(Port *prt, Eterm from) { ErtsLink *lnk = erts_remove_link(&ERTS_P_LINKS(prt), from); - if (lnk) + if (lnk) { + if (IS_TRACED_FL(prt, F_TRACE_PORTS)) + trace_port(prt, am_getting_unlinked, from); erts_destroy_link(lnk); + } } static int @@ -2945,10 +2973,10 @@ port_link_failure(Eterm port_id, Eterm linker) NIL, NULL, 0); - if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { + if (xres >= 0) { /* We didn't exit the process and it is traced */ if (IS_TRACED_FL(rp, F_TRACE_PROCS)) - trace_proc(NULL, rp, am_getting_unlinked, port_id); + trace_proc(NULL, 0, rp, am_getting_unlinked, port_id); } if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); @@ -2959,10 +2987,15 @@ port_link_failure(Eterm port_id, Eterm linker) static void port_link(Port *prt, erts_aint32_t state, Eterm to) { - if (!(state & ERTS_PORT_SFLGS_INVALID_LOOKUP)) + if (IS_TRACED_FL(prt, F_TRACE_PORTS)) + trace_port(prt, am_getting_linked, to); + if (!(state & ERTS_PORT_SFLGS_INVALID_LOOKUP)) { erts_add_link(&ERTS_P_LINKS(prt), LINK_PID, to); - else + } else { port_link_failure(prt->common.id, to); + if (IS_TRACED_FL(prt, F_TRACE_PORTS)) + trace_port(prt, am_unlink, to); + } } static int @@ -2970,8 +3003,9 @@ port_sig_link(Port *prt, erts_aint32_t state, int op, ErtsProc2PortSigData *sigd { if (op == ERTS_PROC2PORT_SIG_EXEC) port_link(prt, state, sigdp->u.link.to); - else + else { port_link_failure(sigdp->u.link.port, sigdp->u.link.to); + } if (sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY) port_sched_op_reply(sigdp->caller, sigdp->ref, am_true); return ERTS_PORT_REDS_LINK; @@ -3391,7 +3425,7 @@ static int read_linebuf(LineBufContext *bp) } static void -deliver_result(Eterm sender, Eterm pid, Eterm res) +deliver_result(Port *prt, Eterm sender, Eterm pid, Eterm res) { Process *rp; ErtsProcLocks rp_locks = 0; @@ -3399,12 +3433,22 @@ deliver_result(Eterm sender, Eterm pid, Eterm res) ERTS_SMP_CHK_NO_PROC_LOCKS; + ASSERT(!prt || prt->common.id == sender); +#ifdef ERTS_SMP + ASSERT(!prt || erts_lc_is_port_locked(prt)); +#endif + ASSERT(is_internal_port(sender) && is_internal_pid(pid)); rp = (scheduler ? erts_proc_lookup(pid) : erts_pid2proc_opt(NULL, 0, pid, 0, ERTS_P2P_FLG_INC_REFC)); + if (prt && IS_TRACED_FL(prt, F_TRACE_SEND)) { + Eterm hp[3]; + trace_port_send(prt, pid, TUPLE2(hp, sender, res), !!rp); + } + if (rp) { Eterm tuple; ErtsMessage *mp; @@ -3417,7 +3461,7 @@ deliver_result(Eterm sender, Eterm pid, Eterm res) sz_res + 3, &hp, &ohp); res = copy_struct(res, sz_res, &hp, ohp); tuple = TUPLE2(hp, sender, res); - erts_queue_message(rp, &rp_locks, mp, tuple, NIL); + erts_queue_message(rp, &rp_locks, mp, tuple); if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); @@ -3449,6 +3493,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, ErlOffHeap *ohp; ErtsProcLocks rp_locks = 0; int scheduler = erts_get_scheduler_id() != 0; + int trace_send = IS_TRACED_FL(prt, F_TRACE_SEND); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); ERTS_SMP_CHK_NO_PROC_LOCKS; @@ -3471,7 +3516,7 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, if (!rp) return; - mp = erts_alloc_message_heap(rp, &rp_locks, need, &hp, &ohp); + mp = erts_alloc_message_heap(trace_send ? NULL : rp, &rp_locks, need, &hp, &ohp); listp = NIL; if ((state & ERTS_PORT_SFLG_BINARY_IO) == 0) { @@ -3513,7 +3558,11 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, tuple = TUPLE2(hp, prt->common.id, tuple); hp += 3; - erts_queue_message(rp, &rp_locks, mp, tuple, am_undefined); + if (trace_send) + trace_port_send(prt, to, tuple, 1); + + ERL_MESSAGE_TOKEN(mp) = am_undefined; + erts_queue_message(rp, &rp_locks, mp, tuple); if (rp_locks) erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) @@ -3592,6 +3641,7 @@ deliver_vec_message(Port* prt, /* Port */ ErtsProcLocks rp_locks = 0; int scheduler = erts_get_scheduler_id() != 0; erts_aint32_t state; + int trace_send = IS_TRACED_FL(prt, F_TRACE_SEND); ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); ERTS_SMP_CHK_NO_PROC_LOCKS; @@ -3619,7 +3669,7 @@ deliver_vec_message(Port* prt, /* Port */ need += (hlen+csize)*2; } - mp = erts_alloc_message_heap(rp, &rp_locks, need, &hp, &ohp); + mp = erts_alloc_message_heap(trace_send ? NULL : rp, &rp_locks, need, &hp, &ohp); listp = NIL; iov += vsize; @@ -3680,7 +3730,11 @@ deliver_vec_message(Port* prt, /* Port */ tuple = TUPLE2(hp, prt->common.id, tuple); hp += 3; - erts_queue_message(rp, &rp_locks, mp, tuple, am_undefined); + if (IS_TRACED_FL(prt, F_TRACE_SEND)) + trace_port_send(prt, to, tuple, 1); + + ERL_MESSAGE_TOKEN(mp) = am_undefined; + erts_queue_message(rp, &rp_locks, mp, tuple); erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) erts_proc_dec_refc(rp); @@ -3820,6 +3874,11 @@ terminate_port(Port *prt) ASSERT(!prt->xports); #endif } + + if (is_internal_port(send_closed_port_id) + && IS_TRACED_FL(prt, F_TRACE_SEND)) + trace_port_send(prt, connected_id, am_closed, 1); + if(drv->handle != NULL) { erts_smp_rwmtx_rlock(&erts_driver_list_lock); erts_ddll_decrement_port_count(drv->handle); @@ -3851,7 +3910,7 @@ terminate_port(Port *prt) erts_flush_async_exit(erts_halt_code, ""); } if (is_internal_port(send_closed_port_id)) - deliver_result(send_closed_port_id, connected_id, am_closed); + deliver_result(NULL, send_closed_port_id, connected_id, am_closed); } void @@ -3884,7 +3943,7 @@ static void sweep_one_monitor(ErtsMonitor *mon, void *vpsc) typedef struct { - Eterm port; + Port *port; Eterm reason; } SweepContext; @@ -3893,10 +3952,13 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc) SweepContext *psc = vpsc; DistEntry *dep; Process *rp; - + Eterm port_id = psc->port->common.id; ASSERT(lnk->type == LINK_PID); - + + if (IS_TRACED_FL(psc->port, F_TRACE_PORTS)) + trace_port(psc->port, am_unlink, lnk->pid); + if (is_external_pid(lnk->pid)) { dep = external_pid_dist_entry(lnk->pid); if(dep != erts_this_dist_entry) { @@ -3909,9 +3971,9 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc) case ERTS_DSIG_PREP_NOT_CONNECTED: break; case ERTS_DSIG_PREP_CONNECTED: - erts_remove_dist_link(&dld, psc->port, lnk->pid, dep); + erts_remove_dist_link(&dld, port_id, lnk->pid, dep); erts_destroy_dist_link(&dld); - code = erts_dsig_send_exit(&dsd, psc->port, lnk->pid, + code = erts_dsig_send_exit(&dsd, port_id, lnk->pid, psc->reason); ASSERT(code == ERTS_DSIG_SEND_OK); break; @@ -3925,23 +3987,25 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc) ASSERT(is_internal_pid(lnk->pid)); rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks); if (rp) { - ErtsLink *rlnk = erts_remove_link(&ERTS_P_LINKS(rp), psc->port); + ErtsLink *rlnk = erts_remove_link(&ERTS_P_LINKS(rp), port_id); if (rlnk) { int xres = erts_send_exit_signal(NULL, - psc->port, + port_id, rp, &rp_locks, psc->reason, NIL, NULL, 0); - if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { + if (xres >= 0) { + if (rp_locks & ERTS_PROC_LOCKS_XSIG_SEND) { + erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_XSIG_SEND); + rp_locks &= ~ERTS_PROC_LOCKS_XSIG_SEND; + } /* We didn't exit the process and it is traced */ - if (IS_TRACED_FL(rp, F_TRACE_PROCS)) { - trace_proc(NULL, rp, am_getting_unlinked, - psc->port); - } + if (IS_TRACED_FL(rp, F_TRACE_PROCS)) + trace_proc(NULL, 0, rp, am_getting_unlinked, port_id); } erts_destroy_link(rlnk); } @@ -3963,7 +4027,8 @@ static void sweep_one_link(ErtsLink *lnk, void *vpsc) */ int -erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) +erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed, + int drop_normal) { ErtsLink *lnk; Eterm rreason; @@ -3993,8 +4058,10 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) | ERTS_PORT_SFLG_CLOSING)) return 0; - if (reason == am_normal && from != ERTS_PORT_GET_CONNECTED(p) && from != p->common.id) + if (reason == am_normal && from != ERTS_PORT_GET_CONNECTED(p) + && from != p->common.id && drop_normal) { return 0; + } set_state_flags = ERTS_PORT_SFLG_EXITING; if (send_closed) @@ -4005,9 +4072,8 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) state = erts_atomic32_read_bor_mb(&p->state, set_state_flags); state |= set_state_flags; - if (IS_TRACED_FL(p, F_TRACE_PORTS)) { + if (IS_TRACED_FL(p, F_TRACE_PORTS)) trace_port(p, am_closed, reason); - } erts_trace_check_exiting(p->common.id); @@ -4017,7 +4083,7 @@ erts_deliver_port_exit(Port *p, Eterm from, Eterm reason, int send_closed) (void) erts_unregister_name(NULL, 0, p, p->common.u.alive.reg->name); { - SweepContext sc = {p->common.id, rreason}; + SweepContext sc = {p, rreason}; lnk = ERTS_P_LINKS(p); ERTS_P_LINKS(p) = NULL; erts_sweep_links(lnk, &sweep_one_link, &sc); @@ -4139,7 +4205,10 @@ call_driver_control(Eterm caller, command, size); } #endif - + + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, caller, am_control, command, bufp, size); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); #ifdef USE_LTTNG_VM_TRACEPOINTS @@ -4166,6 +4235,9 @@ call_driver_control(Eterm caller, if (cres < 0) return ERTS_PORT_OP_BADARG; + if (IS_TRACED_FL(prt, F_TRACE_SEND)) + trace_port_send_binary(prt, caller, am_control, *resp_bufp, cres); + *from_size = (ErlDrvSizeT) cres; return ERTS_PORT_OP_DONE; @@ -4575,6 +4647,9 @@ call_driver_call(Eterm caller, } #endif + if (IS_TRACED_FL(prt, F_TRACE_RECEIVE)) + trace_port_receive(prt, caller, am_call, command, bufp, size); + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); prt->caller = caller; @@ -4593,6 +4668,9 @@ call_driver_call(Eterm caller, || ((byte) (*resp_bufp)[0]) != VERSION_MAGIC) return ERTS_PORT_OP_BADARG; + if (IS_TRACED_FL(prt, F_TRACE_SEND)) + trace_port_send_binary(prt, caller, am_call, *resp_bufp, cres); + *from_size = (ErlDrvSizeT) cres; return ERTS_PORT_OP_DONE; @@ -5036,7 +5114,8 @@ reply_io_bytes(void *vreq) eout = erts_bld_uint64(&hp, NULL, out); msg = TUPLE4(hp, ref, make_small(sched_id), ein, eout); - erts_queue_message(rp, &rp_locks, mp, msg, NIL); + + erts_queue_message(rp, &rp_locks, mp, msg); if (req->sched_id == sched_id) rp_locks &= ~ERTS_PROC_LOCK_MAIN; @@ -5507,6 +5586,7 @@ void driver_report_exit(ErlDrvPort ix, int status) ErtsProcLocks rp_locks = 0; int scheduler = erts_get_scheduler_id() != 0; Port* prt = erts_drvport2port(ix); + int trace_send = IS_TRACED_FL(prt, F_TRACE_SEND); if (prt == ERTS_INVALID_ERL_DRV_PORT) return; @@ -5523,13 +5603,17 @@ void driver_report_exit(ErlDrvPort ix, int status) if (!rp) return; - mp = erts_alloc_message_heap(rp, &rp_locks, 3+3, &hp, &ohp); + mp = erts_alloc_message_heap(trace_send ? NULL : rp, &rp_locks, 3+3, &hp, &ohp); tuple = TUPLE2(hp, am_exit_status, make_small(status)); hp += 3; tuple = TUPLE2(hp, prt->common.id, tuple); - erts_queue_message(rp, &rp_locks, mp, tuple, am_undefined); + if (IS_TRACED_FL(prt, F_TRACE_SEND)) + trace_port_send(prt, pid, tuple, 1); + + ERL_MESSAGE_TOKEN(mp) = am_undefined; + erts_queue_message(rp, &rp_locks, mp, tuple); erts_smp_proc_unlock(rp, rp_locks); if (!scheduler) @@ -5623,13 +5707,13 @@ cleanup_b2t_states(struct b2t_states__ *b2tsp) */ static int -driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) +driver_deliver_term(Port *prt, Eterm to, ErlDrvTermData* data, int len) { #define HEAP_EXTRA 200 #define ERTS_DDT_FAIL do { res = -1; goto done; } while (0) Uint need = 0; int depth = 0; - int res; + int res = 0; ErlDrvTermData* ptr; ErlDrvTermData* ptr_end; DECLARE_ESTACK(stack); @@ -5848,11 +5932,26 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) ? erts_proc_lookup(to) : erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_INC_REFC)); if (!rp) { - res = 0; - goto done; - } + if (!prt || !IS_TRACED_FL(prt, F_TRACE_SEND)) + goto done; + if (!erts_is_tracer_proc_enabled(NULL, 0, &prt->common, am_send)) + goto done; - (void) erts_factory_message_create(&factory, rp, &rp_locks, need); + res = -2; + + /* We allocate a temporary heap to be used to create + the message that may be sent using tracing */ + erts_factory_tmp_init(&factory, erts_alloc(ERTS_ALC_T_DRIVER, need*sizeof(Eterm)), + need, ERTS_ALC_T_DRIVER); + + } else { + /* We force the creation of a heap fragment (rp == NULL) when send + tracing so that we don't have the main lock of the process while + tracing */ + Process *trace_rp = prt && IS_TRACED_FL(prt, F_TRACE_SEND) ? NULL : rp; + (void) erts_factory_message_create(&factory, trace_rp, &rp_locks, need); + res = 1; + } /* * Interpret the instructions and build the term. @@ -6115,22 +6214,40 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) ESTACK_PUSH(stack, mess); } - res = 1; - done: if (res > 0) { mess = ESTACK_POP(stack); /* get resulting value */ erts_factory_trim_and_close(&factory, &mess, 1); + + if (prt && IS_TRACED_FL(prt, F_TRACE_SEND)) + trace_port_send(prt, to, mess, 1); + /* send message */ - erts_queue_message(rp, &rp_locks, factory.message, mess, am_undefined); + ERL_MESSAGE_TOKEN(factory.message) = am_undefined; + erts_queue_message(rp, &rp_locks, factory.message, mess); + } + else if (res == -2) { + /* this clause only happens when we were requested to + generate a send trace, but the process to send to + did not exist any more */ + mess = ESTACK_POP(stack); /* get resulting value */ + + trace_port_send(prt, to, mess, 0); + + erts_factory_trim_and_close(&factory, &mess, 1); + erts_free(ERTS_ALC_T_DRIVER, factory.hp_start); + res = 0; } else { if (b2t.ix > b2t.used) b2t.used = b2t.ix; for (b2t.ix = 0; b2t.ix < b2t.used; b2t.ix++) erts_binary2term_abort(&b2t.state[b2t.ix]); - erts_factory_undo(&factory); + if (factory.mode != FACTORY_CLOSED) { + ERL_MESSAGE_TERM(factory.message) = am_undefined; + erts_factory_undo(&factory); + } } if (rp) { if (rp_locks) @@ -6146,7 +6263,8 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) } static ERTS_INLINE int -deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p) +deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p, + Port **trace_prt) { #ifdef ERTS_SMP ErtsThrPrgrDelayHandle dhndl = erts_thr_progress_unmanaged_delay(); @@ -6174,8 +6292,11 @@ deliver_term_check_port(ErlDrvTermData port_id, Eterm *connected_p) if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED) { erts_thr_progress_unmanaged_continue(dhndl); ETHR_MEMBAR(ETHR_LoadLoad|ETHR_LoadStore); - } + } else #endif + { + *trace_prt = prt; + } ERTS_SMP_LC_ASSERT(dhndl == ERTS_THR_PRGR_DHANDLE_MANAGED ? erts_lc_is_port_locked(prt) : !erts_lc_is_port_locked(prt)); @@ -6186,10 +6307,11 @@ int erl_drv_output_term(ErlDrvTermData port_id, ErlDrvTermData* data, int len) { /* May be called from arbitrary thread */ Eterm connected; - int res = deliver_term_check_port(port_id, &connected); + Port *prt = NULL; + int res = deliver_term_check_port(port_id, &connected, &prt); if (res <= 0) return res; - return driver_deliver_term(connected, data, len); + return driver_deliver_term(prt, connected, data, len); } /* @@ -6213,7 +6335,7 @@ driver_output_term(ErlDrvPort drvport, ErlDrvTermData* data, int len) if (state & ERTS_PORT_SFLG_CLOSING) return 0; - return driver_deliver_term(ERTS_PORT_GET_CONNECTED(prt), data, len); + return driver_deliver_term(prt, ERTS_PORT_GET_CONNECTED(prt), data, len); } int erl_drv_send_term(ErlDrvTermData port_id, @@ -6222,10 +6344,11 @@ int erl_drv_send_term(ErlDrvTermData port_id, int len) { /* May be called from arbitrary thread */ - int res = deliver_term_check_port(port_id, NULL); + Port *prt = NULL; + int res = deliver_term_check_port(port_id, NULL, &prt); if (res <= 0) return res; - return driver_deliver_term(to, data, len); + return driver_deliver_term(prt, to, data, len); } /* @@ -6244,20 +6367,21 @@ driver_send_term(ErlDrvPort drvport, * to make this access safe without using a less efficient * internal data representation for ErlDrvPort. */ + Port* prt = NULL; ERTS_SMP_CHK_NO_PROC_LOCKS; #ifdef ERTS_SMP if (erts_thr_progress_is_managed_thread()) #endif { erts_aint32_t state; - Port* prt = erts_drvport2port_state(drvport, &state); + prt = erts_drvport2port_state(drvport, &state); if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; /* invalid (dead) */ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if (state & ERTS_PORT_SFLG_CLOSING) return 0; } - return driver_deliver_term(to, data, len); + return driver_deliver_term(prt, to, data, len); } @@ -7433,7 +7557,7 @@ driver_failure_term(ErlDrvPort ix, Eterm term, int eof) if (state & ERTS_PORT_SFLG_CLOSING) { terminate_port(prt); } else if (eof && (state & ERTS_PORT_SFLG_SOFT_EOF)) { - deliver_result(prt->common.id, ERTS_PORT_GET_CONNECTED(prt), am_eof); + deliver_result(prt, prt->common.id, ERTS_PORT_GET_CONNECTED(prt), am_eof); } else { /* XXX UGLY WORK AROUND, Let erts_deliver_port_exit() terminate the port */ if (prt->port_data_lock) @@ -7441,7 +7565,7 @@ driver_failure_term(ErlDrvPort ix, Eterm term, int eof) prt->ioq.size = 0; if (prt->port_data_lock) driver_pdl_unlock(prt->port_data_lock); - erts_deliver_port_exit(prt, prt->common.id, eof ? am_normal : term, 0); + erts_deliver_port_exit(prt, prt->common.id, eof ? am_normal : term, 0, 0); } return 0; } diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 69d06094ee..879daaca0a 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -229,6 +229,9 @@ i_get_tuple_element y P y %macro: i_get_tuple_element2 GetTupleElement2 -pack i_get_tuple_element2 x P x +%macro: i_get_tuple_element2y GetTupleElement2Y -pack +i_get_tuple_element2y x P y y + %macro: i_get_tuple_element3 GetTupleElement3 -pack i_get_tuple_element3 x P x @@ -529,9 +532,9 @@ i_put_tuple x I i_put_tuple y I # -# The instruction "put_list Const [] Dst" will not be generated by -# the current BEAM compiler. But until R15A, play it safe by handling -# that instruction with the following transformation. +# The instruction "put_list Const [] Dst" were generated in rare +# circumstances up to and including OTP 18. Starting with OTP 19, +# AFAIK, it should never be generated. # put_list Const=c n Dst => move Const x | put_list x n Dst @@ -649,6 +652,9 @@ get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \ get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \ succ(P1, P2) | succ(D1, D2) => i_get_tuple_element2 Reg P1 D1 +get_tuple_element Reg=x P1 D1=y | get_tuple_element Reg=x P2 D2=y | \ + succ(P1, P2) => i_get_tuple_element2y Reg P1 D1 D2 + get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst is_integer Fail=f i => diff --git a/erts/emulator/beam/register.c b/erts/emulator/beam/register.c index 071f6aee08..77f79fcea4 100644 --- a/erts/emulator/beam/register.c +++ b/erts/emulator/beam/register.c @@ -226,7 +226,8 @@ int erts_register_name(Process *c_p, Eterm name, Eterm id) rp = (RegProc*) hash_put(&process_reg, (void*) &r); if (proc && rp->p == proc) { if (IS_TRACED_FL(proc, F_TRACE_PROCS)) { - trace_proc(c_p, proc, am_register, name); + trace_proc(proc, ERTS_PROC_LOCK_MAIN, + proc, am_register, name); } proc->common.u.alive.reg = rp; } @@ -470,8 +471,8 @@ int erts_unregister_name(Process *c_p, int res = 0; RegProc r, *rp; Port *port = c_prt; + ErtsProcLocks current_c_p_locks = 0; #ifdef ERTS_SMP - ErtsProcLocks current_c_p_locks; /* * SMP note: If 'c_prt != NULL' and 'c_prt->reg->name == name', @@ -537,8 +538,12 @@ int erts_unregister_name(Process *c_p, ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(port)); rp->pt->common.u.alive.reg = NULL; - + if (IS_TRACED_FL(port, F_TRACE_PORTS)) { + if (current_c_p_locks) { + erts_smp_proc_unlock(c_p, current_c_p_locks); + current_c_p_locks = 0; + } trace_port(port, am_unregister, r.name); } @@ -555,7 +560,8 @@ int erts_unregister_name(Process *c_p, #endif rp->p->common.u.alive.reg = NULL; if (IS_TRACED_FL(rp->p, F_TRACE_PROCS)) { - trace_proc(c_p, rp->p, am_unregister, r.name); + trace_proc(rp->p, (c_p == rp->p) ? c_p_locks : ERTS_PROC_LOCK_MAIN, + rp->p, am_unregister, r.name); } #ifdef ERTS_SMP if (rp->p != c_p) { diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 8b3eb2db1d..748fba15c7 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -644,6 +644,15 @@ typedef struct preload { unsigned char* code; /* Code pointer */ } Preload; +/* + * ErtsTracer is either NIL, 'true' or [Mod | State] + * + * If set to NIL, it means no tracer. + * If set to 'true' it means the current process' tracer. + * If set to [Mod | State], there is a tracer. + * See erts_tracer_update for more details + */ +typedef Eterm ErtsTracer; /* * This structure contains options to all built in drivers. diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 384b340a1c..b280995488 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2298,7 +2298,7 @@ static void do_send_logger_message(Eterm *hp, ErlOffHeap *ohp, ErlHeapFragment * { ErtsMessage *mp = erts_alloc_message(0, NULL); mp->data.heap_frag = bp; - erts_queue_message(p, NULL /* only used for smp build */, mp, message, NIL); + erts_queue_message(p, NULL /* only used for smp build */, mp, message); } #endif } diff --git a/erts/emulator/hipe/hipe_amd64.c b/erts/emulator/hipe/hipe_amd64.c index 55bfd26b29..62739d2a78 100644 --- a/erts/emulator/hipe/hipe_amd64.c +++ b/erts/emulator/hipe/hipe_amd64.c @@ -83,21 +83,6 @@ int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline) return 0; } -/* - * Memory allocator for executable code. - * - * This is required on AMD64 because some Linux kernels - * (including 2.6.10-rc1 and newer www.kernel.org ones) - * default to non-executable memory mappings, causing - * ordinary malloc() memory to be non-executable. - * - * Implementing this properly also allows us to ensure that - * executable code ends up in the low 2GB of the address space, - * as required by HiPE/AMD64's small code model. - */ -static unsigned int code_bytes; -static char *code_next; - #if 0 /* change to non-zero to get allocation statistics at exit() */ static unsigned int total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs, nr_large, total_lost; static unsigned int atexit_done; @@ -121,101 +106,20 @@ static void atexit_alloc_code_stats(void) #define ALLOC_CODE_STATS(X) do{}while(0) #endif -/* FreeBSD 6.1 breakage */ -#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) -#define MAP_ANONYMOUS MAP_ANON -#endif - -static int morecore(unsigned int alloc_bytes) -{ - unsigned int map_bytes; - char *map_hint, *map_start; - - /* Page-align the amount to allocate. */ - map_bytes = (alloc_bytes + 4095) & ~4095; - - /* Round up small allocations. */ - if (map_bytes < 1024*1024) - map_bytes = 1024*1024; - else - ALLOC_CODE_STATS(++nr_large); - - /* Create a new memory mapping, ensuring it is executable - and in the low 2GB of the address space. Also attempt - to make it adjacent to the previous mapping. */ - map_hint = code_next + code_bytes; -#if !defined(MAP_32BIT) - /* FreeBSD doesn't have MAP_32BIT, and it doesn't respect - a plain map_hint (returns high mappings even though the - hint refers to a free area), so we have to use both map_hint - and MAP_FIXED to get addresses below the 2GB boundary. - This is even worse than the Linux/ppc64 case. - Similarly, Solaris 10 doesn't have MAP_32BIT, - and it doesn't respect a plain map_hint. */ - if (!map_hint) /* first call */ - map_hint = (char*)(512*1024*1024); /* 0.5GB */ -#endif - if ((unsigned long)map_hint & 4095) - abort(); - map_start = mmap(map_hint, map_bytes, - PROT_EXEC|PROT_READ|PROT_WRITE, - MAP_PRIVATE|MAP_ANONYMOUS -#if defined(MAP_32BIT) - |MAP_32BIT -#elif defined(__FreeBSD__) || defined(__sun__) - |MAP_FIXED -#endif - , - -1, 0); - ALLOC_CODE_STATS(fprintf(stderr, "%s: mmap(%p,%u,...) == %p\r\n", __FUNCTION__, map_hint, map_bytes, map_start)); -#if !defined(MAP_32BIT) - if (map_start != MAP_FAILED && - (((unsigned long)map_start + (map_bytes-1)) & ~0x7FFFFFFFUL)) { - fprintf(stderr, "mmap with hint %p returned code memory %p\r\n", map_hint, map_start); - abort(); - } -#endif - if (map_start == MAP_FAILED) - return -1; - - ALLOC_CODE_STATS(total_mapped += map_bytes); - - /* Merge adjacent mappings, so the trailing portion of the previous - mapping isn't lost. In practice this is quite successful. */ - if (map_start == map_hint) { - ALLOC_CODE_STATS(++nr_joins); - code_bytes += map_bytes; -#if !defined(MAP_32BIT) - if (!code_next) /* first call */ - code_next = map_start; -#endif - } else { - ALLOC_CODE_STATS(++nr_splits); - ALLOC_CODE_STATS(total_lost += code_bytes); - code_next = map_start; - code_bytes = map_bytes; - } - - ALLOC_CODE_STATS(atexit_alloc_code_stats()); - - return 0; -} - +/* + * Memory allocator for executable code. + * + * We use a dedicated allocator for executable code (from OTP 19.0) + * to make sure the memory we get is executable (PROT_EXEC) + * and to ensure that executable code ends up in the low 2GB + * of the address space, as required by HiPE/AMD64's small code model. + */ static void *alloc_code(unsigned int alloc_bytes) { - void *res; - - /* Align function entries. */ - alloc_bytes = (alloc_bytes + 3) & ~3; - - if (code_bytes < alloc_bytes && morecore(alloc_bytes) != 0) - return NULL; ALLOC_CODE_STATS(++nr_allocs); ALLOC_CODE_STATS(total_alloc += alloc_bytes); - res = code_next; - code_next += alloc_bytes; - code_bytes -= alloc_bytes; - return res; + + return erts_alloc(ERTS_ALC_T_HIPE_EXEC, alloc_bytes); } void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p) diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c index ba41f34012..ace489452f 100644 --- a/erts/emulator/hipe/hipe_debug.c +++ b/erts/emulator/hipe/hipe_debug.c @@ -195,7 +195,7 @@ void hipe_print_pcb(Process *p) U("rcount ", rcount); U("id ", common.id); U("reds ", reds); - U("tracer_pr..", common.tracer_proc); + U("tracer ", common.tracer); U("trace_fla..", common.trace_flags); U("group_lea..", group_leader); U("flags ", flags); diff --git a/erts/emulator/nifs/common/erl_tracer_nif.c b/erts/emulator/nifs/common/erl_tracer_nif.c new file mode 100644 index 0000000000..1bb6b940c4 --- /dev/null +++ b/erts/emulator/nifs/common/erl_tracer_nif.c @@ -0,0 +1,256 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson 2015. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +/* + * Purpose: NIF library for process/port tracer + * + */ + + +#define STATIC_ERLANG_NIF 1 + +#include "erl_nif.h" +#include "config.h" +#include "sys.h" + +#ifdef VALGRIND +# include <valgrind/memcheck.h> +#endif + +/* NIF interface declarations */ +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); +static void unload(ErlNifEnv* env, void* priv_data); + +/* The NIFs: */ +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ErlNifFunc nif_funcs[] = { + {"enabled", 3, enabled}, + {"trace", 6, trace} +}; + + +ERL_NIF_INIT(erl_tracer, nif_funcs, load, NULL, upgrade, unload) + +#define ATOMS \ + ATOM_DECL(call); \ + ATOM_DECL(command); \ + ATOM_DECL(cpu_timestamp); \ + ATOM_DECL(discard); \ + ATOM_DECL(exception_from); \ + ATOM_DECL(match_spec_result); \ + ATOM_DECL(monotonic); \ + ATOM_DECL(ok); \ + ATOM_DECL(remove); \ + ATOM_DECL(return_from); \ + ATOM_DECL(scheduler_id); \ + ATOM_DECL(send); \ + ATOM_DECL(send_to_non_existing_process); \ + ATOM_DECL(seq_trace); \ + ATOM_DECL(spawn); \ + ATOM_DECL(strict_monotonic); \ + ATOM_DECL(timestamp); \ + ATOM_DECL(trace); \ + ATOM_DECL(trace_ts); \ + ATOM_DECL(true); \ + ATOM_DECL(gc_start); \ + ATOM_DECL(gc_end); \ + ATOM_DECL(gc_minor_start); \ + ATOM_DECL(gc_minor_end); \ + ATOM_DECL(gc_major_start); \ + ATOM_DECL(gc_major_end); \ + ATOM_DECL(undefined); + +#define ATOM_DECL(A) static ERL_NIF_TERM atom_##A +ATOMS +#undef ATOM_DECL + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + +#define ATOM_DECL(A) atom_##A = enif_make_atom(env, #A) +ATOMS +#undef ATOM_DECL + + *priv_data = NULL; + + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ + +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, + ERL_NIF_TERM load_info) +{ + if (*old_priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (*priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (load(env, priv_data, load_info)) { + return -1; + } + return 0; +} + +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifPid to_pid; + ErlNifPort to_port; + ASSERT(argc == 3); + + if (enif_get_local_pid(env, argv[1], &to_pid)) { + if (!enif_is_process_alive(env, &to_pid)) + /* tracer is dead so we should remove this trace point */ + return atom_remove; + } else if (enif_get_local_port(env, argv[1], &to_port)) { + if (!enif_is_port_alive(env, &to_port)) + /* tracer is dead so we should remove this trace point */ + return atom_remove; + } + + /* Only generate trace for when tracer != tracee */ + if (enif_is_identical(argv[1], argv[2])) { + return atom_discard; + } + + return atom_trace; +} + +/* + -spec trace(seq_trace, TracerState :: pid() | port(), + Label :: non_neg_integer(), + Msg :: term(), + Opts :: map()) -> ignored(); + trace(Tag :: atom(), TracerState :: pid() | port(), + Tracee :: pid() || port() || undefined, + Msg :: term(), + Opts :: map()) -> ignored(). + -spec trace(Tag :: atom(), TracerState :: pid() | port(), + Tracee :: pid() || port() || undefined, + Msg :: term(), + Extra :: term(), + Opts :: map()) -> ignored(). +*/ +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM value, msg, tt[8], opts; + ErlNifPid to_pid; + ErlNifPort to_port; + size_t tt_sz = 0; + int is_port = 0; + ASSERT(argc == 6); + + if (!enif_get_local_pid(env, argv[1], &to_pid)) { + if (!enif_get_local_port(env, argv[1], &to_port)) { + /* This only fails if argv[1] is a not a local port/pid + which should not happen as it is checked in enabled */ + ASSERT(0); + return atom_ok; + } + is_port = 1; + } + + if (!enif_is_identical(argv[4], atom_undefined)) { + tt[tt_sz++] = atom_trace; + tt[tt_sz++] = argv[2]; + tt[tt_sz++] = argv[0]; + tt[tt_sz++] = argv[3]; + tt[tt_sz++] = argv[4]; + } else { + if (enif_is_identical(argv[0], atom_seq_trace)) { + tt[tt_sz++] = atom_seq_trace; + tt[tt_sz++] = argv[2]; + tt[tt_sz++] = argv[3]; + } else { + tt[tt_sz++] = atom_trace; + tt[tt_sz++] = argv[2]; + tt[tt_sz++] = argv[0]; + tt[tt_sz++] = argv[3]; + } + } + + opts = argv[5]; + + if (enif_get_map_value(env, opts, atom_match_spec_result, + &value) + && !enif_is_identical(value, atom_true)) { + tt[tt_sz++] = value; + } + + if (enif_get_map_value(env, opts, atom_scheduler_id, &value) + && !enif_is_identical(value, atom_undefined)) { + tt[tt_sz++] = value; + } + + if (enif_get_map_value(env, opts, atom_timestamp, &value) + && !enif_is_identical(value, atom_undefined)) { + ERL_NIF_TERM ts; + if (enif_is_identical(value, atom_monotonic)) { + ErlNifTime mon = enif_monotonic_time(ERL_NIF_NSEC); + ts = enif_make_int64(env, mon); + } else if (enif_is_identical(value, atom_strict_monotonic)) { + ErlNifTime mon = enif_monotonic_time(ERL_NIF_NSEC); + ERL_NIF_TERM unique = enif_make_unique_integer( + env, ERL_NIF_UNIQUE_MONOTONIC); + ts = enif_make_tuple2(env, enif_make_int64(env, mon), unique); + } else if (enif_is_identical(value, atom_timestamp)) { + ts = enif_now_time(env); + } else if (enif_is_identical(value, atom_cpu_timestamp)) { + ts = enif_cpu_time(env); + } else { + ASSERT(0); + goto error; + } + tt[tt_sz++] = ts; + if (tt[0] == atom_trace) + tt[0] = atom_trace_ts; + } + + msg = enif_make_tuple_from_array(env, tt, tt_sz); + + if (is_port) { + ErlNifBinary bin; + + if (!enif_term_to_binary(env, msg, &bin)) + goto error; + + msg = enif_make_binary(env, &bin); + + if (!enif_port_command(env, &to_port, NULL, msg)) + /* port has probably died, enabled will clean up */; + + enif_release_binary(&bin); + } else { + + if (!enif_send(env, &to_pid, NULL, msg)) + /* process has probably died, enabled will clean up */; + } + +error: + + return atom_ok; +} diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c index 867ab6f3c1..a7e710070b 100644 --- a/erts/emulator/sys/common/erl_mmap.c +++ b/erts/emulator/sys/common/erl_mmap.c @@ -294,12 +294,13 @@ typedef struct { }ErtsFreeSegMap; struct ErtsMemMapper_ { - int (*reserve_physical)(char *, UWord); + int (*reserve_physical)(char *, UWord, int exec); void (*unreserve_physical)(char *, UWord); int supercarrier; int no_os_mmap; + int executable; /* is client a native code allocator? */ /* - * Super unaligend area is located above super aligned + * Super unaligned area is located above super aligned * area. That is, `sa.bot` is beginning of the super * carrier, `sua.top` is the end of the super carrier, * and sa.top and sua.bot moves towards eachother. @@ -355,6 +356,12 @@ char* erts_literals_start; UWord erts_literals_size; #endif +#ifdef ERTS_ALC_A_EXEC +ErtsMemMapper erts_exec_mmapper; +#endif + + + #define ERTS_MMAP_SIZE_SC_SA_INC(SZ) \ do { \ mm->size.supercarrier.used.total += (SZ); \ @@ -1232,6 +1239,7 @@ Eterm build_free_seg_list(Process* p, ErtsFreeSegMap* map) #if HAVE_MMAP # define ERTS_MMAP_PROT (PROT_READ|PROT_WRITE) +# define ERTS_MMAP_PROT_EXEC (PROT_READ|PROT_WRITE|PROT_EXEC) # if defined(MAP_ANONYMOUS) # define ERTS_MMAP_FLAGS (MAP_ANON|MAP_PRIVATE) # define ERTS_MMAP_FD (-1) @@ -1245,24 +1253,26 @@ Eterm build_free_seg_list(Process* p, ErtsFreeSegMap* map) #endif static ERTS_INLINE void * -os_mmap(void *hint_ptr, UWord size, int try_superalign) +os_mmap(void *hint_ptr, UWord size, int try_superalign, int executable) { #if HAVE_MMAP + const int prot = executable ? ERTS_MMAP_PROT_EXEC : ERTS_MMAP_PROT; void *res; #ifdef MAP_ALIGN if (try_superalign) - res = mmap((void *) ERTS_SUPERALIGNED_SIZE, size, ERTS_MMAP_PROT, + res = mmap((void *) ERTS_SUPERALIGNED_SIZE, size, prot, ERTS_MMAP_FLAGS|MAP_ALIGN, ERTS_MMAP_FD, 0); else #endif - res = mmap((void *) hint_ptr, size, ERTS_MMAP_PROT, + res = mmap((void *) hint_ptr, size, prot, ERTS_MMAP_FLAGS, ERTS_MMAP_FD, 0); if (res == MAP_FAILED) return NULL; return res; #elif HAVE_VIRTUALALLOC + const DWORD prot = executable ? PAGE_EXECUTE_READWRITE : PAGE_READWRITE; return (void *) VirtualAlloc(NULL, (SIZE_T) size, - MEM_COMMIT|MEM_RESERVE, PAGE_READWRITE); + MEM_COMMIT|MEM_RESERVE, prot); #else # error "missing mmap() or similar" #endif @@ -1319,6 +1329,7 @@ os_mremap(void *ptr, UWord old_size, UWord new_size, int try_superalign) #if HAVE_MMAP #define ERTS_MMAP_RESERVE_PROT (ERTS_MMAP_PROT) +#define ERTS_MMAP_RESERVE_PROT_EXEC (ERTS_MMAP_PROT_EXEC) #define ERTS_MMAP_RESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_FIXED) #define ERTS_MMAP_UNRESERVE_PROT (PROT_NONE) #define ERTS_MMAP_UNRESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_NORESERVE|MAP_FIXED) @@ -1326,9 +1337,10 @@ os_mremap(void *ptr, UWord old_size, UWord new_size, int try_superalign) #define ERTS_MMAP_VIRTUAL_FLAGS (ERTS_MMAP_FLAGS|MAP_NORESERVE) static int -os_reserve_physical(char *ptr, UWord size) +os_reserve_physical(char *ptr, UWord size, int exec) { - void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_RESERVE_PROT, + const int prot = exec ? ERTS_MMAP_RESERVE_PROT_EXEC : ERTS_MMAP_RESERVE_PROT; + void *res = mmap((void *) ptr, (size_t) size, prot, ERTS_MMAP_RESERVE_FLAGS, ERTS_MMAP_FD, 0); if (res == (void *) MAP_FAILED) return 0; @@ -1345,10 +1357,39 @@ os_unreserve_physical(char *ptr, UWord size) } static void * -os_mmap_virtual(char *ptr, UWord size) +os_mmap_virtual(char *ptr, UWord size, int exec) { - void *res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_VIRTUAL_PROT, - ERTS_MMAP_VIRTUAL_FLAGS, ERTS_MMAP_FD, 0); + int flags = ERTS_MMAP_VIRTUAL_FLAGS; + void* res; + +#ifdef ERTS_ALC_A_EXEC + if (exec) { + ASSERT(!ptr); + /* OTP-19.0: Nice hack below cut-and-pasted from hipe_amd64.c */ + +# ifdef MAP_32BIT + /* If we got MAP_32BIT (Linux), then use that to ask for low memory */ + flags |= MAP_32BIT; +# else + /* FreeBSD doesn't have MAP_32BIT, and it doesn't respect + a plain map_hint (returns high mappings even though the + hint refers to a free area), so we have to use both map_hint + and MAP_FIXED to get addresses below the 2GB boundary. + This is even worse than the Linux/ppc64 case. + Similarly, Solaris 10 doesn't have MAP_32BIT, + and it doesn't respect a plain map_hint. */ + ptr = (char*)(512*1024*1024); /* 0.5GB */ + +# if defined(__FreeBSD__) || defined(__sun__) + flags |= MAP_FIXED; +# endif +# endif /* !MAP_32BIT */ + } +#else /* !ERTS_ALC_A_EXEC */ + ASSERT(!exec); +#endif + res = mmap((void *) ptr, (size_t) size, ERTS_MMAP_VIRTUAL_PROT, + flags, ERTS_MMAP_FD, 0); if (res == (void *) MAP_FAILED) return NULL; return res; @@ -1361,7 +1402,7 @@ os_mmap_virtual(char *ptr, UWord size) #endif /* ERTS_HAVE_OS_MMAP */ -static int reserve_noop(char *ptr, UWord size) +static int reserve_noop(char *ptr, UWord size, int exec) { #ifdef ERTS_MMAP_DEBUG_FILL_AREAS Uint32 *uip, *end = (Uint32 *) (ptr + size); @@ -1404,7 +1445,7 @@ alloc_desc_insert_free_seg(ErtsMemMapper* mm, #if ERTS_HAVE_OS_MMAP if (!mm->no_os_mmap) { - ptr = os_mmap(mm->desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0); + ptr = os_mmap(mm->desc.new_area_hint, ERTS_PAGEALIGNED_SIZE, 0, 0); if (ptr) { mm->desc.new_area_hint = ptr+ERTS_PAGEALIGNED_SIZE; ERTS_MMAP_SIZE_OS_INC(ERTS_PAGEALIGNED_SIZE); @@ -1423,7 +1464,7 @@ alloc_desc_insert_free_seg(ErtsMemMapper* mm, da_map = &mm->sua.map; desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE); if (desc) { - if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE)) + if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE, 0)) ERTS_MMAP_SIZE_SC_SUA_INC(ERTS_PAGEALIGNED_SIZE); else desc = NULL; @@ -1433,7 +1474,7 @@ alloc_desc_insert_free_seg(ErtsMemMapper* mm, da_map = &mm->sa.map; desc = lookup_free_seg(da_map, ERTS_PAGEALIGNED_SIZE); if (desc) { - if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE)) + if (mm->reserve_physical(desc->start, ERTS_PAGEALIGNED_SIZE, 0)) ERTS_MMAP_SIZE_SC_SA_INC(ERTS_PAGEALIGNED_SIZE); else desc = NULL; @@ -1494,7 +1535,7 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep) if (desc) { seg = desc->start; end = seg+asize; - if (!mm->reserve_physical(seg, asize)) + if (!mm->reserve_physical(seg, asize, mm->executable)) goto supercarrier_reserve_failure; if (desc->end == end) { delete_free_seg(&mm->sua.map, desc); @@ -1509,8 +1550,8 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep) } if (asize <= mm->sua.bot - mm->sa.top) { - if (!mm->reserve_physical(mm->sua.bot - asize, - asize)) + if (!mm->reserve_physical(mm->sua.bot - asize, asize, + mm->executable)) goto supercarrier_reserve_failure; mm->sua.bot -= asize; seg = mm->sua.bot; @@ -1526,7 +1567,8 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep) char *start = seg = desc->start; seg = (char *) ERTS_SUPERALIGNED_CEILING(seg); end = seg+asize; - if (!mm->reserve_physical(start, (UWord) (end - start))) + if (!mm->reserve_physical(start, (UWord) (end - start), + mm->executable)) goto supercarrier_reserve_failure; ERTS_MMAP_SIZE_SC_SA_INC(asize); if (desc->end == end) { @@ -1558,7 +1600,8 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep) if (asize + (seg - start) <= mm->sua.bot - start) { end = seg + asize; - if (!mm->reserve_physical(start, (UWord) (end - start))) + if (!mm->reserve_physical(start, (UWord) (end - start), + mm->executable)) goto supercarrier_reserve_failure; mm->sa.top = end; ERTS_MMAP_SIZE_SC_SA_INC(asize); @@ -1580,7 +1623,8 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep) seg = (char *) ERTS_SUPERALIGNED_CEILING(org_start); end = seg + asize; - if (!mm->reserve_physical(seg, (UWord) (org_end - seg))) + if (!mm->reserve_physical(seg, (UWord) (org_end - seg), + mm->executable)) goto supercarrier_reserve_failure; ERTS_MMAP_SIZE_SC_SUA_INC(asize); if (org_start != seg) { @@ -1613,13 +1657,13 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep) /* Map using OS primitives */ if (!(ERTS_MMAPFLG_SUPERCARRIER_ONLY & flags) && !mm->no_os_mmap) { if (!(ERTS_MMAPFLG_SUPERALIGNED & flags)) { - seg = os_mmap(NULL, asize, 0); + seg = os_mmap(NULL, asize, 0, mm->executable); if (!seg) goto failure; } else { asize = ERTS_SUPERALIGNED_CEILING(*sizep); - seg = os_mmap(NULL, asize, 1); + seg = os_mmap(NULL, asize, 1, mm->executable); if (!seg) goto failure; @@ -1629,7 +1673,8 @@ erts_mmap(ErtsMemMapper* mm, Uint32 flags, UWord *sizep) os_munmap(seg, asize); - ptr = os_mmap(NULL, asize + ERTS_SUPERALIGNED_SIZE, 1); + ptr = os_mmap(NULL, asize + ERTS_SUPERALIGNED_SIZE, 1, + mm->executable); if (!ptr) goto failure; @@ -1964,7 +2009,8 @@ erts_mremap(ErtsMemMapper* mm, if (next && new_end <= next->end) { if (!mm->reserve_physical(((char *) ptr) + old_size, - asize - old_size)) + asize - old_size, + mm->executable)) goto supercarrier_reserve_failure; if (new_end < next->end) resize_free_seg(&mm->sua.map, next, new_end, next->end); @@ -1982,7 +2028,8 @@ erts_mremap(ErtsMemMapper* mm, if (end == mm->sa.top) { if (new_end <= mm->sua.bot) { if (!mm->reserve_physical(((char *) ptr) + old_size, - asize - old_size)) + asize - old_size, + mm->executable)) goto supercarrier_reserve_failure; mm->sa.top = new_end; new_ptr = ptr; @@ -1994,7 +2041,8 @@ erts_mremap(ErtsMemMapper* mm, adjacent_free_seg(&mm->sa.map, start, end, &prev, &next); if (next && new_end <= next->end) { if (!mm->reserve_physical(((char *) ptr) + old_size, - asize - old_size)) + asize - old_size, + mm->executable)) goto supercarrier_reserve_failure; if (new_end < next->end) resize_free_seg(&mm->sa.map, next, new_end, next->end); @@ -2112,7 +2160,7 @@ static void hard_dbg_mseg_init(void); #endif void -erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init) +erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init, int executable) { static int is_first_call = 1; int virtual_map = 0; @@ -2144,6 +2192,7 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init) mm->supercarrier = 0; mm->reserve_physical = reserve_noop; mm->unreserve_physical = unreserve_noop; + mm->executable = executable; #if HAVE_MMAP && !defined(MAP_ANON) mm->mmap_fd = open("/dev/zero", O_RDWR); @@ -2163,7 +2212,7 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init) ptr = (char *) ERTS_PAGEALIGNED_CEILING(init->virtual_range.start); end = (char *) ERTS_PAGEALIGNED_FLOOR(init->virtual_range.end); sz = end - ptr; - start = os_mmap_virtual(ptr, sz); + start = os_mmap_virtual(ptr, sz, executable); if (!start || start > ptr || start >= end) erts_exit(1, "erts_mmap: Failed to create virtual range for super carrier\n"); @@ -2188,7 +2237,7 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init) sz = ERTS_PAGEALIGNED_CEILING(init->scs); #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION if (!init->scrpm) { - start = os_mmap_virtual(NULL, sz); + start = os_mmap_virtual(NULL, sz, executable); mm->reserve_physical = os_reserve_physical; mm->unreserve_physical = os_unreserve_physical; virtual_map = 1; @@ -2200,7 +2249,7 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init) * The whole supercarrier will by physically * reserved all the time. */ - start = os_mmap(NULL, sz, 1); + start = os_mmap(NULL, sz, 1, executable); } if (!start) erts_exit(1, @@ -2274,7 +2323,7 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init) mm->sua.top -= ERTS_PAGEALIGNED_SIZE; mm->size.supercarrier.used.total += ERTS_PAGEALIGNED_SIZE; #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION - if (!virtual_map || os_reserve_physical(mm->sua.top, ERTS_PAGEALIGNED_SIZE)) + if (!virtual_map || os_reserve_physical(mm->sua.top, ERTS_PAGEALIGNED_SIZE, 0)) #endif add_free_desc_area(mm, mm->sua.top, end); mm->desc.reserved += (end - mm->sua.top) / sizeof(ErtsFreeSegDesc); @@ -2287,7 +2336,7 @@ erts_mmap_init(ErtsMemMapper* mm, ErtsMMapInit *init) * will be used for free segment descritors. */ #ifdef ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION - if (virtual_map && !os_reserve_physical(start, mm->sa.bot - start)) + if (virtual_map && !os_reserve_physical(start, mm->sa.bot - start, 0)) erts_exit(1, "erts_mmap: Failed to reserve physical memory for descriptors\n"); #endif mm->desc.unused_start = start; diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h index 1341a0b7eb..b3c45ba116 100644 --- a/erts/emulator/sys/common/erl_mmap.h +++ b/erts/emulator/sys/common/erl_mmap.h @@ -53,7 +53,12 @@ typedef struct { #define ERTS_LITERAL_VIRTUAL_AREA_SIZE (UWORD_CONSTANT(1)*1024*1024*1024) #define ERTS_MMAP_INIT_LITERAL_INITER \ - {{NULL, NULL}, {NULL, NULL}, ERTS_LITERAL_VIRTUAL_AREA_SIZE, 1, (1 << 16), 0} + {{NULL, NULL}, {NULL, NULL}, ERTS_LITERAL_VIRTUAL_AREA_SIZE, 1, (1 << 10), 0} + +#define ERTS_HIPE_EXEC_VIRTUAL_AREA_SIZE (UWORD_CONSTANT(512)*1024*1024) + +#define ERTS_MMAP_INIT_HIPE_EXEC_INITER \ + {{NULL, NULL}, {NULL, NULL}, ERTS_HIPE_EXEC_VIRTUAL_AREA_SIZE, 1, (1 << 10), 0} typedef struct ErtsMemMapper_ ErtsMemMapper; @@ -61,7 +66,7 @@ void *erts_mmap(ErtsMemMapper*, Uint32 flags, UWord *sizep); void erts_munmap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord size); void *erts_mremap(ErtsMemMapper*, Uint32 flags, void *ptr, UWord old_size, UWord *sizep); int erts_mmap_in_supercarrier(ErtsMemMapper*, void *ptr); -void erts_mmap_init(ErtsMemMapper*, ErtsMMapInit*); +void erts_mmap_init(ErtsMemMapper*, ErtsMMapInit*, int executable); struct erts_mmap_info_struct { UWord sizes[6]; @@ -126,10 +131,17 @@ Eterm erts_mmap_debug_info(ErtsMemMapper*, struct process*); # define ERTS_HAVE_OS_MMAP 1 #endif +#ifdef ERTS_WANT_MEM_MAPPERS +# include "erl_alloc_types.h" + extern ErtsMemMapper erts_dflt_mmapper; -#if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) +# if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) extern ErtsMemMapper erts_literal_mmapper; -#endif +# endif +# ifdef ERTS_ALC_A_EXEC +extern ErtsMemMapper erts_exec_mmapper; +# endif +#endif /* ERTS_WANT_MEM_MAPPERS */ /*#define HARD_DEBUG_MSEG*/ #ifdef HARD_DEBUG_MSEG diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index c8b72c6e77..43e75e2573 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -31,6 +31,7 @@ # include "config.h" #endif +#define ERTS_WANT_MEM_MAPPERS #include "sys.h" #include "erl_mseg.h" #include "global.h" @@ -1402,9 +1403,15 @@ erts_mseg_init(ErtsMsegInit_t *init) erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms"); - erts_mmap_init(&erts_dflt_mmapper, &init->dflt_mmap); +#ifdef ERTS_ALC_A_EXEC + /* Initialize erts_exec_mapper *FIRST*, to increase probability + * of getting low memory for HiPE AMD64's small code model. + */ + erts_mmap_init(&erts_exec_mmapper, &init->exec_mmap, 1); +#endif + erts_mmap_init(&erts_dflt_mmapper, &init->dflt_mmap, 0); #if defined(ARCH_64) && defined(ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION) - erts_mmap_init(&erts_literal_mmapper, &init->literal_mmap); + erts_mmap_init(&erts_literal_mmapper, &init->literal_mmap, 0); #endif if (!IS_2POW(GET_PAGE_SIZE)) diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h index 7615d19f09..192e5767e4 100644 --- a/erts/emulator/sys/common/erl_mseg.h +++ b/erts/emulator/sys/common/erl_mseg.h @@ -61,6 +61,7 @@ typedef struct { Uint nos; ErtsMMapInit dflt_mmap; ErtsMMapInit literal_mmap; + ErtsMMapInit exec_mmap; } ErtsMsegInit_t; #define ERTS_MSEG_INIT_DEFAULT_INITIALIZER \ @@ -70,7 +71,8 @@ typedef struct { 10, /* mcs: Max cache size */ \ 1000, /* cci: Cache check interval */ \ ERTS_MMAP_INIT_DEFAULT_INITER, \ - ERTS_MMAP_INIT_LITERAL_INITER \ + ERTS_MMAP_INIT_LITERAL_INITER, \ + ERTS_MMAP_INIT_HIPE_EXEC_INITER \ } typedef struct { diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c index 60661d9016..6435da086f 100644 --- a/erts/emulator/sys/unix/sys_float.c +++ b/erts/emulator/sys/unix/sys_float.c @@ -53,7 +53,7 @@ static void erts_init_fp_exception(void) void erts_thread_init_fp_exception(void) { unsigned long *fpe = erts_alloc(ERTS_ALC_T_FP_EXCEPTION, sizeof(*fpe)); - *fpe = 0L; + *fpe = 0; erts_tsd_set(fpe_key, fpe); } @@ -102,6 +102,17 @@ void erts_fp_check_init_error(volatile unsigned long *fpexnp) #define __DARWIN__ 1 #endif +/* + * Define two processor and possibly OS-specific primitives: + * + * static void unmask_fpe(void); + * -- unmask invalid, overflow, and divide-by-zero exceptions + * + * static int mask_fpe(void); + * -- mask invalid, overflow, and divide-by-zero exceptions + * -- return non-zero if the previous state was unmasked + */ + #if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) static void unmask_x87(void) @@ -113,7 +124,6 @@ static void unmask_x87(void) __asm__ __volatile__("fldcw %0" : : "m"(cw)); } -/* mask x87 FPE, return true if the previous state was unmasked */ static int mask_x87(void) { unsigned short cw; @@ -136,7 +146,6 @@ static void unmask_sse2(void) __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr)); } -/* mask SSE2 FPE, return true if the previous state was unmasked */ static int mask_sse2(void) { unsigned int mxcsr; @@ -257,21 +266,19 @@ static int cpu_has_sse2(void) } #endif /* !__x86_64__ */ -static void unmask_fpe(void) +static void unmask_fpe_internal(void) { - __asm__ __volatile__("fnclex"); unmask_x87(); if (cpu_has_sse2()) unmask_sse2(); } -static void unmask_fpe_conditional(int unmasked) +static void unmask_fpe(void) { - if (unmasked) - unmask_fpe(); + __asm__ __volatile__("fnclex"); + unmask_fpe_internal(); } -/* mask x86 FPE, return true if the previous state was unmasked */ static int mask_fpe(void) { int unmasked; @@ -285,9 +292,7 @@ static int mask_fpe(void) void erts_restore_fpu(void) { __asm__ __volatile__("fninit"); - unmask_x87(); - if (cpu_has_sse2()) - unmask_sse2(); + unmask_fpe_internal(); } #elif defined(__sparc__) && defined(__linux__) @@ -310,13 +315,6 @@ static void unmask_fpe(void) __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr)); } -static void unmask_fpe_conditional(int unmasked) -{ - if (unmasked) - unmask_fpe(); -} - -/* mask SPARC FPE, return true if the previous state was unmasked */ static int mask_fpe(void) { unsigned long fsr; @@ -431,13 +429,6 @@ static void unmask_fpe(void) set_fpscr(0x80|0x40|0x10); /* VE, OE, ZE; not UE or XE */ } -static void unmask_fpe_conditional(int unmasked) -{ - if (unmasked) - unmask_fpe(); -} - -/* mask PowerPC FPE, return true if the previous state was unmasked */ static int mask_fpe(void) { int unmasked; @@ -447,20 +438,13 @@ static int mask_fpe(void) return unmasked; } -#else +#else /* !(x86 || (sparc && linux) || (powerpc && (linux || darwin))) */ static void unmask_fpe(void) { fpsetmask(FP_X_INV | FP_X_OFL | FP_X_DZ); } -static void unmask_fpe_conditional(int unmasked) -{ - if (unmasked) - unmask_fpe(); -} - -/* mask IEEE FPE, return true if previous state was unmasked */ static int mask_fpe(void) { const fp_except unmasked_mask = FP_X_INV | FP_X_OFL | FP_X_DZ; @@ -472,6 +456,16 @@ static int mask_fpe(void) #endif +/* + * Define a processor and OS-specific SIGFPE handler. + * + * The effect of receiving a SIGFPE should be: + * 1. Update the processor context: + * a) on x86: mask FP exceptions, do not skip faulting instruction + * b) on SPARC and PowerPC: unmask FP exceptions, skip faulting instruction + * 2. call set_current_fp_exception with the PC of the faulting instruction + */ + #if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__x86_64__) || defined(__i386__))) || ((defined(__NetBSD__) || defined(__OpenBSD__)) && defined(__x86_64__)) || (defined(__sun__) && defined(__x86_64__)) #if defined(__linux__) && defined(__i386__) @@ -520,8 +514,7 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) ucontext_t *uc = puc; unsigned long pc; -#if defined(__linux__) -#if defined(__x86_64__) +#if defined(__linux__) && defined(__x86_64__) mcontext_t *mc = &uc->uc_mcontext; fpregset_t fpstate = mc->fpregs; pc = mc_pc(mc); @@ -533,26 +526,26 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) set encoding makes that a poor solution here. */ fpstate->mxcsr = 0x1F80; fpstate->swd &= ~0xFF; -#elif defined(__i386__) +#elif defined(__linux__) && defined(__i386__) mcontext_t *mc = &uc->uc_mcontext; fpregset_t fpstate = mc->fpregs; pc = mc_pc(mc); if ((fpstate->status >> 16) == X86_FXSR_MAGIC) ((struct _fpstate*)fpstate)->mxcsr = 0x1F80; fpstate->sw &= ~0xFF; -#elif defined(__sparc__) && defined(__arch64__) +#elif defined(__linux__) && defined(__sparc__) && defined(__arch64__) /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ struct sigcontext *sc = (struct sigcontext*)puc; pc = sc->sigc_regs.tpc; sc->sigc_regs.tpc = sc->sigc_regs.tnpc; sc->sigc_regs.tnpc += 4; -#elif defined(__sparc__) +#elif defined(__linux__) && defined(__sparc__) /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ struct sigcontext *sc = (struct sigcontext*)puc; pc = sc->si_regs.pc; sc->si_regs.pc = sc->si_regs.npc; sc->si_regs.npc = (unsigned long)sc->si_regs.npc + 4; -#elif defined(__powerpc__) +#elif defined(__linux__) && defined(__powerpc__) #if defined(__powerpc64__) mcontext_t *mc = &uc->uc_mcontext; unsigned long *regs = &mc->gp_regs[0]; @@ -563,7 +556,6 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) pc = regs[PT_NIP]; regs[PT_NIP] += 4; regs[PT_FPSCR] = 0x80|0x40|0x10; /* VE, OE, ZE; not UE or XE */ -#endif #elif defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__)) # error "Floating-point exceptions not supported on MacOS X" #elif defined(__DARWIN__) && defined(__ppc__) @@ -621,7 +613,7 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) #endif #if 0 { - char buf[64]; + char buf[128]; snprintf(buf, sizeof buf, "%s: FPE at %p\r\n", __FUNCTION__, (void*)pc); write(2, buf, strlen(buf)); } @@ -706,7 +698,8 @@ int erts_sys_block_fpe(void) void erts_sys_unblock_fpe(int unmasked) { - unmask_fpe_conditional(unmasked); + if (unmasked) + unmask_fpe(); } #endif @@ -818,11 +811,6 @@ sys_chars_to_double(char* buf, double* fp) int matherr(struct exception *exc) { -#if !defined(NO_FPE_SIGNALS) - volatile unsigned long *fpexnp = erts_get_current_fp_exception(); - if (fpexnp != NULL) - *fpexnp = (unsigned long)__builtin_return_address(0); -#endif return 1; } diff --git a/erts/emulator/sys/win32/sys_float.c b/erts/emulator/sys/win32/sys_float.c index a2b9bd1263..2b2d6ab7d3 100644 --- a/erts/emulator/sys/win32/sys_float.c +++ b/erts/emulator/sys/win32/sys_float.c @@ -139,8 +139,7 @@ sys_double_to_chars_ext(double fp, char *buffer, size_t buffer_size, size_t deci int matherr(struct _exception *exc) { - erl_fp_exception = 1; - DEBUGF(("FP exception (matherr) (0x%x) (%d)\n", exc->type, erl_fp_exception)); + DEBUGF(("FP exception (matherr) (0x%x)\n", exc->type)); return 1; } diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 2221b5830c..de395dfb97 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -110,8 +110,11 @@ MODULES= \ trace_meta_SUITE \ trace_call_count_SUITE \ trace_call_time_SUITE \ + tracer_SUITE \ + tracer_test \ scheduler_SUITE \ old_scheduler_SUITE \ + port_trace_SUITE \ unique_SUITE \ z_SUITE \ old_mod \ diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl index b11afbdc08..6a54fa87e0 100644 --- a/erts/emulator/test/beam_SUITE.erl +++ b/erts/emulator/test/beam_SUITE.erl @@ -29,6 +29,7 @@ -export([applied/2,swap_temp_applied/1]). -include_lib("common_test/include/ct.hrl"). +-include_lib("syntax_tools/include/merl.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -93,48 +94,46 @@ applied(Starter, N) -> apply_last_bif(Config) when is_list(Config) -> apply(erlang, abs, [1]). -%% Test three high register numbers in a put_list instruction -%% (to test whether packing works properly). +%% Test whether packing works properly. packed_registers(Config) when is_list(Config) -> - PrivDir = proplists:get_value(priv_dir, Config), - Mod = packed_regs, - Name = filename:join(PrivDir, atom_to_list(Mod) ++ ".erl"), - - %% Generate a module which generates a list of tuples. - %% put_list(A) -> [{A, 600}, {A, 999}, ... {A, 0}]. - Code = gen_packed_regs(600, ["-module("++atom_to_list(Mod)++").\n", - "-export([put_list/1]).\n", - "put_list(A) ->\n["]), - ok = file:write_file(Name, Code), - - %% Compile the module. - io:format("Compiling: ~s\n", [Name]), - CompRc = compile:file(Name, [{outdir, PrivDir}, report]), - io:format("Result: ~p\n",[CompRc]), - {ok, Mod} = CompRc, - - %% Load it. - io:format("Loading...\n",[]), - LoadRc = code:load_abs(filename:join(PrivDir, atom_to_list(Mod))), - {module,_Module} = LoadRc, - - %% Call it and verify result. - Term = {a, b}, - L = Mod:put_list(Term), - verify_packed_regs(L, Term, 600), + Mod = ?FUNCTION_NAME, + + %% Generate scrambled sequence. + Seq0 = [{erlang:phash2(I),I} || I <- lists:seq(0, 260)], + Seq = [I || {_,I} <- lists:sort(Seq0)], + + %% Generate a test modules that uses get_list/3 instructions + %% with high register numbers. + S0 = [begin + VarName = list_to_atom("V"++integer_to_list(V)), + {merl:var(VarName),V} + end || V <- Seq], + Vars = [V || {V,_} <- S0], + NewVars = [begin + VarName = list_to_atom("M"++integer_to_list(V)), + merl:var(VarName) + end || V <- Seq], + S = [?Q("_@Var = id(_@Value@)") || {Var,Value} <- S0], + Code = ?Q(["-module('@Mod@').\n" + "-export([f/0]).\n" + "f() ->\n" + "_@S,\n" + "_ = id(0),\n" + "L = [_@Vars],\n" + "_ = id(1),\n" + "[_@NewVars] = L,\n" %Test get_list/3. + "_ = id(2),\n" + "id([_@Vars,_@NewVars]).\n" + "id(I) -> I.\n"]), + merl:compile_and_load(Code), + CombinedSeq = Seq ++ Seq, + CombinedSeq = Mod:f(), + + %% Clean up. + true = code:delete(Mod), + false = code:purge(Mod), ok. -gen_packed_regs(0, Acc) -> - [Acc|"{A,0}].\n"]; -gen_packed_regs(N, Acc) -> - gen_packed_regs(N-1, [Acc,"{A,",integer_to_list(N)|"},\n"]). - -verify_packed_regs([], _, -1) -> ok; -verify_packed_regs([{Term, N}| T], Term, N) -> - verify_packed_regs(T, Term, N-1); -verify_packed_regs(L, Term, N) -> - ct:fail("Expected [{~p, ~p}|T]; got\n~p\n", [Term, N, L]). - buildo_mucho(Config) when is_list(Config) -> buildo_mucho_1(), ok. diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl index 2159546054..6ba6301c7c 100644 --- a/erts/emulator/test/call_trace_SUITE.erl +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -84,32 +84,46 @@ process_specs(Config) when is_list(Config) -> {tracer,Tracer} = trace_info(self(), tracer), trace_func({?MODULE,worker_foo,1}, []), - %% Test the 'new' flag. - - {Work1A,Work1B} = start_and_trace(new, [1,2,3], A1B={3,2,1}), - {flags,[]} = trace_info(Work1A, flags), - {tracer,[]} = trace_info(Work1A, tracer), - {tracer,Tracer} = trace_info(Work1B, tracer), - {flags,[call]} = trace_info(Work1B, flags), - expect({trace,Work1B,call,{?MODULE,worker_foo,[A1B]}}), - unlink(Work1B), - Mref = erlang:monitor(process, Work1B), - exit(Work1B, kill), - receive - {'DOWN',Mref,_,_,_} -> ok - end, - undefined = trace_info(Work1B, flags), - {flags,[]} = trace_info(new, flags), - {tracer,[]} = trace_info(new, tracer), - - %% Test the 'existing' flag. - {Work2A,_Work2B} = start_and_trace(existing, A2A=[5,6,7], [7,6,5]), - expect({trace,Work2A,call,{?MODULE,worker_foo,[A2A]}}), - - %% Test the 'all' flag. - {Work3A,Work3B} = start_and_trace(all, A3A=[12,13], A3B=[13,12]), - expect({trace,Work3A,call,{?MODULE,worker_foo,[A3A]}}), - expect({trace,Work3B,call,{?MODULE,worker_foo,[A3B]}}), + %% Test the 'new' and 'new_processes' flags. + + New = fun(Flag) -> + {Work1A,Work1B} = start_and_trace(Flag, [1,2,3], A1B={3,2,1}), + {flags,[]} = trace_info(Work1A, flags), + {tracer,[]} = trace_info(Work1A, tracer), + {tracer,Tracer} = trace_info(Work1B, tracer), + {flags,[call]} = trace_info(Work1B, flags), + expect({trace,Work1B,call,{?MODULE,worker_foo,[A1B]}}), + unlink(Work1B), + Mref = erlang:monitor(process, Work1B), + exit(Work1B, kill), + receive + {'DOWN',Mref,_,_,_} -> ok + end, + undefined = trace_info(Work1B, flags), + {flags,[]} = trace_info(Flag, flags), + {tracer,[]} = trace_info(Flag, tracer) + end, + New(new), + New(new_processes), + + %% Test the 'existing' and 'existing_processes' flags. + Existing = + fun(Flag) -> + {Work2A,_Work2B} = start_and_trace(Flag, A2A=[5,6,7], [7,6,5]), + expect({trace,Work2A,call,{?MODULE,worker_foo,[A2A]}}) + end, + Existing(existing), + Existing(existing_processes), + + %% Test the 'all' and 'processes' flags. + All = + fun(Flag) -> + {Work3A,Work3B} = start_and_trace(Flag, A3A=[12,13], A3B=[13,12]), + expect({trace,Work3A,call,{?MODULE,worker_foo,[A3A]}}), + expect({trace,Work3B,call,{?MODULE,worker_foo,[A3B]}}) + end, + All(all), + All(processes), ok. diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 956b82335c..b3870f0313 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -48,6 +48,7 @@ t_bif_map_new/1, t_bif_map_put/1, t_bif_map_remove/1, + t_bif_map_take/1, t_bif_map_take_large/1, t_bif_map_update/1, t_bif_map_values/1, t_bif_map_to_list/1, @@ -112,7 +113,9 @@ all() -> [t_build_and_match_literals, t_build_and_match_literals_large, 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, t_bif_map_put, - t_bif_map_remove, t_bif_map_update, + t_bif_map_remove, + t_bif_map_take, t_bif_map_take_large, + t_bif_map_update, t_bif_map_values, t_bif_map_to_list, t_bif_map_from_list, @@ -1970,7 +1973,7 @@ t_bif_map_remove(Config) when is_list(Config) -> 0 = erlang:map_size(maps:remove(some_key, #{})), M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, - 4 => number, 18446744073709551629 => wat}, + 4 => number, 18446744073709551629 => wat}, M1 = maps:remove("hi", M0), true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)), @@ -1999,10 +2002,71 @@ t_bif_map_remove(Config) when is_list(Config) -> %% error case do_badmap(fun(T) -> - {'EXIT',{{badmap,T},[{maps,remove,_,_}|_]}} = - (catch maps:remove(a, T)) + {'EXIT',{{badmap,T},[{maps,remove,_,_}|_]}} = (catch maps:remove(a, T)) end), - ok. + ok. + +t_bif_map_take(Config) when is_list(Config) -> + error = maps:take(some_key, #{}), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + 5 = maps:size(M0), + {"hello", M1} = maps:take("hi", M0), + true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)), + true = is_members([number,wat,3,<<"value">>],maps:values(M1)), + error = maps:take("hi", M1), + 4 = maps:size(M1), + + {3, M2} = maps:take(int, M1), + true = is_members([4,18446744073709551629,<<"key">>],maps:keys(M2)), + true = is_members([number,wat,<<"value">>],maps:values(M2)), + error = maps:take(int, M2), + 3 = maps:size(M2), + + {<<"value">>,M3} = maps:take(<<"key">>, M2), + true = is_members([4,18446744073709551629],maps:keys(M3)), + true = is_members([number,wat],maps:values(M3)), + error = maps:take(<<"key">>, M3), + 2 = maps:size(M3), + + {wat,M4} = maps:take(18446744073709551629, M3), + true = is_members([4],maps:keys(M4)), + true = is_members([number],maps:values(M4)), + error = maps:take(18446744073709551629, M4), + 1 = maps:size(M4), + + {number,M5} = maps:take(4, M4), + [] = maps:keys(M5), + [] = maps:values(M5), + error = maps:take(4, M5), + 0 = maps:size(M5), + + {wat,#{ "hi" := "hello", int := 3, 4 := number, <<"key">> := <<"value">>}} = maps:take(18446744073709551629,M0), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,take,_,_}|_]}} = (catch maps:take(a, T)) + end), + ok. + +t_bif_map_take_large(Config) when is_list(Config) -> + KVs = [{{erlang:md5(<<I:64>>),I}, I}|| I <- lists:seq(1,500)], + M0 = maps:from_list(KVs), + ok = bif_map_take_all(KVs, M0), + ok. + +bif_map_take_all([], M0) -> + 0 = maps:size(M0), + ok; +bif_map_take_all([{K,V}|KVs],M0) -> + {ok,V} = maps:find(K,M0), + {V,M1} = maps:take(K,M0), + error = maps:find(K,M1), + error = maps:take(K,M1), + bif_map_take_all(KVs,M1). + t_bif_map_update(Config) when is_list(Config) -> M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 6b8d14b487..ea973276db 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -23,7 +23,7 @@ -export([all/0, suite/0, not_run/1]). -export([test_1/1, test_2/1, test_3/1, bad_match_spec_bin/1, trace_control_word/1, silent/1, silent_no_ms/1, silent_test/1, - ms_trace2/1, ms_trace3/1, boxed_and_small/1, + ms_trace2/1, ms_trace3/1, ms_trace_dead/1, boxed_and_small/1, destructive_in_test_bif/1, guard_exceptions/1, empty_list/1, unary_plus/1, unary_minus/1, moving_labels/1]). @@ -49,7 +49,7 @@ all() -> false -> [test_1, test_2, test_3, bad_match_spec_bin, trace_control_word, silent, silent_no_ms, silent_test, ms_trace2, - ms_trace3, boxed_and_small, destructive_in_test_bif, + ms_trace3, ms_trace_dead, boxed_and_small, destructive_in_test_bif, guard_exceptions, unary_plus, unary_minus, fpe, moving_labels, faulty_seq_trace, @@ -500,6 +500,8 @@ ms_trace2(Config) when is_list(Config) -> [[call,return_to],[]]}, ms_trace2}] end), + %% Silence valgrind + erlang:trace_pattern({?MODULE,fn,'_'},[],[]), ok. @@ -595,7 +597,35 @@ ms_trace3(Config) when is_list(Config) -> end), ok. - +ms_trace_dead(doc) -> + ["Test that a dead tracer is removed using ms"]; +ms_trace_dead(suite) -> []; +ms_trace_dead(Config) when is_list(Config) -> + Self = self(), + TFun = fun F() -> receive M -> Self ! M, F() end end, + {Tracer, MRef} = spawn_monitor(TFun), + MetaTracer = spawn_link(TFun), + erlang:trace_pattern({?MODULE, f1, '_'}, + [{'_',[],[{trace,[], + [call,{const,{tracer,Tracer}}]}]}], + [{meta, MetaTracer}]), + erlang:trace_pattern({?MODULE, f2, '_'}, []), + ?MODULE:f2(1,2), + ?MODULE:f1(1), + {tracer,Tracer} = erlang:trace_info(self(), tracer), + {flags,[call]} = erlang:trace_info(self(), flags), + ?MODULE:f2(2,3), + receive {trace, Self, call, {?MODULE, f2, _}} -> ok end, + exit(Tracer, stop), + receive {'DOWN',MRef,_,_,_} -> ok end, + ?MODULE:f1(2), + {tracer,[]} = erlang:trace_info(self(), tracer), + ?MODULE:f2(3,4), + TRef = erlang:trace_delivered(all), + receive {trace_delivered, _, TRef} -> ok end, + receive {trace_ts, Self, call, {?MODULE, f1, _}, _} -> ok end, + receive {trace_ts, Self, call, {?MODULE, f1, _}, _} -> ok end, + receive M -> ct:fail({unexpected, M}) after 10 -> ok end. %% Test that destructive operations in test bif does not really happen destructive_in_test_bif(Config) when is_list(Config) -> @@ -905,34 +935,40 @@ collect([]) -> collect([TM | TMs]) -> io:format( "Expecting: ~p~n", [TM]), receive - M0 -> - M = case element(1, M0) of - trace_ts -> - list_to_tuple(lists:reverse( - tl(lists:reverse(tuple_to_list(M0))))); - _ -> M0 - end, - case is_function(TM,1) of - true -> - case (catch TM(M)) of - true -> - io:format("Got: ~p~n", [M]), - collect(TMs); - _ -> - io:format("Got unexpected: ~p~n", [M]), - flush({got_unexpected,M}) - end; - - false -> - case M of - TM -> - io:format("Got: ~p~n", [M]), - collect(TMs); - _ -> - io:format("Got unexpected: ~p~n", [M]), - flush({got_unexpected,M}) - end - end + %% We only look at trace messages with the same tracee + %% as the message we are looking for. This because + %% the order of trace messages is only guaranteed from + %% within a single process. + M0 when element(2, M0) =:= element(2, TM); is_function(TM, 1) -> + M = case element(1, M0) of + trace_ts -> + list_to_tuple(lists:reverse( + tl(lists:reverse(tuple_to_list(M0))))); + _ -> M0 + end, + case is_function(TM,1) of + true -> + case (catch TM(M)) of + true -> + io:format("Got: ~p~n", [M]), + collect(TMs); + _ -> + io:format("Got unexpected: ~p~n", [M]), + flush({got_unexpected,M}) + end; + + false -> + case M of + TM -> + io:format("Got: ~p~n", [M]), + collect(TMs); + _ -> + io:format("Got unexpected: ~p~n", [M]), + flush({got_unexpected,M}) + end + end + after 15000 -> + flush(timeout) end. flush(Reason) -> diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index d616b058bc..a7767132ee 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1282,9 +1282,10 @@ send3_make_blob() -> repeat(N bsr 1, fun(_) -> grow_blob(MsgEnv,other_term(),rand:uniform(1 bsl 20)) end, void), - case (N band 1) of + case (N band 3) of 0 -> {term,copy_blob(MsgEnv)}; - 1 -> {msgenv,MsgEnv} + 1 -> {copy,copy_blob(MsgEnv)}; + _ -> {msgenv,MsgEnv} end end. @@ -1297,6 +1298,9 @@ send3_send(Pid, Msg) -> send3_send_nif(Pid, {term,Blob}) -> %%io:format("~p send term nif\n",[self()]), send_term(Pid, {blob, Blob}) =:= 1; +send3_send_nif(Pid, {copy,Blob}) -> + %%io:format("~p send term nif\n",[self()]), + send_copy_term(Pid, {blob, Blob}) =:= 1; send3_send_nif(Pid, {msgenv,MsgEnv}) -> %%io:format("~p send blob nif\n",[self()]), send3_blob(MsgEnv, Pid, blob) =:= 1. @@ -1305,6 +1309,10 @@ send3_send_bang(Pid, {term,Blob}) -> %%io:format("~p send term bang\n",[self()]), Pid ! {blob, Blob}, true; +send3_send_bang(Pid, {copy,Blob}) -> + %%io:format("~p send term bang\n",[self()]), + Pid ! {blob, Blob}, + true; send3_send_bang(Pid, {msgenv,MsgEnv}) -> %%io:format("~p send blob bang\n",[self()]), Pid ! {blob, copy_blob(MsgEnv)}, @@ -2062,6 +2070,7 @@ send_blob_thread(_,_,_) -> ?nif_stub. join_send_thread(_) -> ?nif_stub. copy_blob(_) -> ?nif_stub. send_term(_,_) -> ?nif_stub. +send_copy_term(_,_) -> ?nif_stub. reverse_list(_) -> ?nif_stub. echo_int(_) -> ?nif_stub. type_sizes() -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 2b68c38008..11e5dab58e 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1466,6 +1466,18 @@ static ERL_NIF_TERM send_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ return enif_make_int(env, ret); } +static ERL_NIF_TERM send_copy_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ErlNifEnv* menv; + ErlNifPid pid; + int ret; + if (!enif_get_local_pid(env, argv[0], &pid)) { + return enif_make_badarg(env); + } + ret = enif_send(env, &pid, NULL, argv[1]); + return enif_make_int(env, ret); +} + static ERL_NIF_TERM reverse_list(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ERL_NIF_TERM rev_list; @@ -2142,6 +2154,7 @@ static ErlNifFunc nif_funcs[] = {"join_send_thread", 1, join_send_thread}, {"copy_blob", 1, copy_blob}, {"send_term", 2, send_term}, + {"send_copy_term", 2, send_copy_term}, {"reverse_list",1, reverse_list}, {"echo_int", 1, echo_int}, {"type_sizes", 0, type_sizes}, diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 0c43283cad..79abcbde5f 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -87,6 +87,7 @@ name1/1, t_binary/1, parallell/1, t_exit/1, env/1, huge_env/1, bad_env/1, cd/1, exit_status/1, + bad_args/1, tps_16_bytes/1, tps_1K/1, line/1, stderr_to_stdout/1, otp_3906/1, otp_4389/1, win_massive/1, win_massive_client/1, mix_up_ports/1, otp_5112/1, otp_5119/1, otp_6224/1, @@ -115,6 +116,7 @@ all() -> {group, multiple_packets}, parallell, dying_port, port_program_with_path, open_input_file_port, open_output_file_port, name1, env, huge_env, bad_env, cd, + bad_args, exit_status, iter_max_ports, count_fds, t_exit, {group, tps}, line, stderr_to_stdout, otp_3906, otp_4389, win_massive, mix_up_ports, otp_5112, otp_5119, @@ -901,10 +903,11 @@ bad_env(Config) when is_list(Config) -> ok. try_bad_env(Env) -> - try open_port({spawn,"ls"}, [{env,Env}]) - catch - error:badarg -> ok - end. + badarg = try open_port({spawn,"ls"}, [{env,Env}]) + catch + error:badarg -> badarg + end. + %% Test that we can handle a very very large environment gracefully. huge_env(Config) when is_list(Config) -> @@ -940,6 +943,24 @@ huge_env(Config) when is_list(Config) -> end. +%% Test bad 'args' options. +bad_args(Config) when is_list(Config) -> + try_bad_args({args, [self()]}), + try_bad_args({args, ["head" | "tail"]}), + try_bad_args({args, ["head", "body" | "tail"]}), + try_bad_args({args, [<<"head">>, <<"body">> | <<"tail">>]}), + try_bad_args({args, not_a_list}), + try_bad_args({args, ["string",<<"binary">>, 1472, "string"]}), + try_bad_args({args, ["string",<<"binary">>], "element #3"}), + ok. + +try_bad_args(Args) -> + badarg = try open_port({spawn_executable,"ls"}, [Args]) + catch + error:badarg -> badarg + end. + + %% 'cd' option %% (Can perhaps be made smaller by calling the other utility functions diff --git a/erts/emulator/test/port_trace_SUITE.erl b/erts/emulator/test/port_trace_SUITE.erl new file mode 100644 index 0000000000..41e8a316c4 --- /dev/null +++ b/erts/emulator/test/port_trace_SUITE.erl @@ -0,0 +1,600 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + + +-module(port_trace_SUITE). + +-export([all/0, suite/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]). +-export([port_specs/1, ports/1, open_close/1, + command/1, control/1, connect/1, call/1, + output/1, output2/1, output_binary/1, + outputv/1, set_timer/1, failure_eof/1, + failure_atom/1, failure_posix/1, + failure/1, output_term/1, + driver_output_term/1, + send_term/1, driver_send_term/1]). + +-define(ECHO_DRV_NOOP, 0). +-define(ECHO_DRV_OUTPUT, 1). +-define(ECHO_DRV_OUTPUT2, 2). +-define(ECHO_DRV_OUTPUT_BINARY, 3). +-define(ECHO_DRV_OUTPUTV, 4). +-define(ECHO_DRV_SET_TIMER, 5). +-define(ECHO_DRV_FAILURE_EOF, 6). +-define(ECHO_DRV_FAILURE_ATOM, 7). +-define(ECHO_DRV_FAILURE_POSIX, 8). +-define(ECHO_DRV_FAILURE, 9). +-define(ECHO_DRV_OUTPUT_TERM, 10). +-define(ECHO_DRV_DRIVER_OUTPUT_TERM, 11). +-define(ECHO_DRV_SEND_TERM, 12). +-define(ECHO_DRV_DRIVER_SEND_TERM, 13). +-define(ECHO_DRV_SAVE_CALLER, 14). + +suite() -> [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 30}}]. + +all() -> + [port_specs, ports, open_close, + command, control, connect, call, + output, output2, output_binary, + outputv, set_timer, failure_eof, + failure_atom, failure_posix, + failure, output_term, + driver_output_term, + send_term, driver_send_term]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + erlang:trace(all, false, [all]), + os:unsetenv("OUTPUTV"), + reload_drv(Config), + Config. + +end_per_testcase(_Func, _Config) -> + erlang:trace(all, false, [all]), + ok. + +%% Test the first argument of trace/3 +port_specs(_Config) -> + + S = self(), + + Tracer = fun F() -> + receive + stop -> + ok; + M -> + S ! M, + F() + end + end, + + Test = fun(TraceSpec, Info1, Info2) -> + {TracerPid,Ref} = spawn_monitor(Tracer), + Prt1 = erlang:open_port({spawn, echo_drv}, [binary]), + erlang:trace(TraceSpec, true, ['receive', {tracer, TracerPid}]), + %% We disable trace messages from the testcase process + erlang:trace(self(), false, ['receive']), + Prt2 = erlang:open_port({spawn, echo_drv}, [binary]), + + InfoCheck = + fun(Info, Prt) -> + if + Info -> + {tracer, TracerPid} = erlang:trace_info(Prt, tracer), + {flags,['receive']} = erlang:trace_info(Prt, flags); + not Info -> + {tracer,[]} = erlang:trace_info(Prt, tracer), + {flags,[]} = erlang:trace_info(Prt, flags) + end + end, + InfoCheck(Info1, Prt1), + InfoCheck(Info2, Prt2), + + %% These may create trace messages + erlang:port_command(Prt1, <<?ECHO_DRV_NOOP>>), + erlang:port_command(Prt2, <<?ECHO_DRV_NOOP>>), + + %% Test what happens when the tracer dies + trace_delivered(), + TracerPid ! stop, + receive {'DOWN', Ref, process, TracerPid, normal} -> ok end, + + %% These should not generate any trace messages + erlang:port_command(Prt1, <<?ECHO_DRV_NOOP>>), + erlang:port_command(Prt2, <<?ECHO_DRV_NOOP>>), + + InfoCheck(false, Prt1), + InfoCheck(false, Prt2), + + erlang:port_close(Prt1), + erlang:port_close(Prt2), + erlang:trace(all, false, [all]), + {Prt1, Prt2} + end, + + {_Prt11, Prt12} = Test(new, false, true), + [{trace, Prt12, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt12), + + {_Prt21, Prt22} = Test(new_ports, false, true), + [{trace, Prt22, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt22), + + {Prt31, _Prt32} = Test(existing, true, false), + [{trace, Prt31, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt31), + + {Prt41, _Prt42} = Test(existing_ports, true, false), + [{trace, Prt41, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt41), + + {Prt51, Prt52} = Test(all, true, true), + [{trace, Prt51, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt51), + [{trace, Prt52, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt52), + + {Prt61, Prt62} = Test(ports, true, true), + [{trace, Prt61, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt61), + [{trace, Prt62, 'receive', {S, {command,<<?ECHO_DRV_NOOP>>}}}] + = flush(Prt62), + + ok. + +%% Test that the 'ports' trace flag works +ports(_Config) -> + + {Prt, S} = trace_and_open([ports],[binary]), + + [{trace, Prt, open, S, echo_drv}, + {trace, Prt, getting_linked, S}] = flush(), + + register(?MODULE, Prt), + unregister(?MODULE), + register(?MODULE, Prt), + + [{trace,Prt,register,port_trace_SUITE}, + {trace,Prt,unregister,port_trace_SUITE}, + {trace,Prt,register,port_trace_SUITE}] = flush(), + + unlink(Prt), + link(Prt), + + [{trace,Prt,getting_unlinked,S}, + {trace,Prt,getting_linked,S}] = flush(), + + erlang:port_close(Prt), + + [{trace,Prt,closed,normal}, + {trace,Prt,unregister,port_trace_SUITE}, + {trace,Prt,unlink,S}] = flush(), + + ok. + +%% Test that port_close and ! close generate correct trace messages +open_close(_Config) -> + + S = trace_ports([send,'receive']), + + Prt = erlang:open_port({spawn, echo_drv}, [binary]), + erlang:port_close(Prt), + [{trace, Prt, 'receive', {S, close}}] = flush(), + + Prt2 = erlang:open_port({spawn, echo_drv}, [binary]), + Prt2 ! {S, close}, + recv({Prt2, closed}), + [{trace, Prt2, 'receive', {S, close}}, + {trace, Prt2, send, closed, S}] = flush(), + + catch erlang:port_close(Prt2), + [] = flush(), + + ok. + +%% Test that port_command and ! command generate correct trace messages +command(Config) -> + + Flags = [send,'receive'], + S = trace_ports(Flags), + Prt = erlang:open_port({spawn, echo_drv}, [binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_NOOP:8>>), + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8>>}}}] = flush(), + + erlang:port_command(Prt, [?ECHO_DRV_NOOP, <<0:8>>]), + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8,0:8>>}}}] = flush(), + + Prt ! {S, {command, <<?ECHO_DRV_NOOP:8>>}}, + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8>>}}}] = flush(), + + close(Prt, Flags), + + os:putenv("OUTPUTV","true"), + reload_drv(Config), + + Prt2 = erlang:open_port({spawn, echo_drv}, [binary]), + Msg = [<<0:8>>,<<0:(8*512)>>,<<0:(8*256)>>,<<0:8>>], + + erlang:port_command(Prt2, Msg), + [{trace, Prt2, 'receive', {S, {command, Msg}}}] = flush(), + + Prt2 ! {S, {command, Msg}}, + [{trace, Prt2, 'receive', {S, {command, Msg}}}] = flush(), + + close(Prt2, Flags), + + os:unsetenv("OUTPUTV"), + + ok. + +%% Test that port_control generate correct trace messages +control(_Config) -> + + Flags = [send,'receive'], + {Prt, S} = trace_and_open(Flags,[binary]), + + [0] = erlang:port_control(Prt, 1, <<?ECHO_DRV_NOOP:8, 0:8>>), + [{trace, Prt, 'receive', {S, {control, {1, <<?ECHO_DRV_NOOP:8, 0:8>>}}}}, + {trace, Prt, send, {Prt, {control, <<0:8>>}}, S}] = flush(), + + [0] = erlang:port_control(Prt, (1 bsl 32) - 1, <<?ECHO_DRV_NOOP:8, 0:8>>), + [{trace, Prt, 'receive', {S, {control, {(1 bsl 32) - 1, <<?ECHO_DRV_NOOP:8, 0:8>>}}}}, + {trace, Prt, send, {Prt, {control, <<0:8>>}}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that port_connect and ! connect generate correct trace messages +%% This includes that the proper getting_linked messages are sent +connect(_Config) -> + + + {Prt, S} = trace_and_open([send, 'receive', ports],[binary]), + + flush(), + + {Pid,Ref} = spawn_monitor( + fun() -> + receive + go -> + Prt ! {self(), {connect, S}}, + receive {Prt, connected} -> unlink(Prt) end + end + end), + erlang:trace(Pid, true, [send, 'receive', procs]), + + erlang:port_connect(Prt, Pid), + unlink(Prt), + + [{trace,Prt,getting_linked,Pid}, + {trace,Prt,'receive',{S,{connect,Pid}}}, + {trace,Prt,send,{Prt,connected},S}, + {trace,Prt,getting_unlinked, S}] = flush(Prt), + + [{trace,Pid,getting_linked,Prt}] = flush(), + + Pid ! go, + recv({'DOWN',Ref,process,Pid,normal}), + + [{trace,Prt,'receive',{Pid,{connect,S}}}, + {trace,Prt,send,{Prt,connected},Pid}, + {trace,Prt,getting_unlinked,Pid}] = flush(Prt), + + [{trace,Pid,'receive',go}, + {trace,Pid,send,{Pid,{connect,S}}, Prt}, + {trace,Pid,'receive',{Prt,connected}}, + {trace,Pid,unlink,Prt}, + {trace,Pid,exit,normal}] = flush(), + + erlang:port_close(Prt), + [{trace, Prt, 'receive', {S, close}}, + {trace, Prt, closed, normal}] = flush(), + ok. + +%% Test that port_call generate correct trace messages +call(_Config) -> + + Flags = [send,'receive'], + {Prt, S} = trace_and_open(Flags,[binary]), + + Msg = {hello, world, make_ref()}, + BinMsg = term_to_binary(Msg), + + Msg = erlang:port_call(Prt, 0, Msg), + [{trace, Prt, 'receive', {S, {call, {0, BinMsg}}}}, + {trace, Prt, send, {Prt, {call, BinMsg}}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_output generate correct trace messages +output(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT, 123456:32>>), + recv({Prt,{data,<<123456:32>>}}), + + [{trace, Prt, send, {Prt, {data, <<123456:32>>}}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_output2 generate correct trace messages +output2(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT2, 123456:32>>), + recv({Prt,{data,[$a|<<123456:32>>]}}), + [{trace, Prt, send, {Prt, {data, [$a|<<123456:32>>]}}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_output_binary generate correct trace messages +output_binary(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT_BINARY, 0, 123456:32>>), + recv({Prt,{data,[$a|<<123456:32>>]}}), + [{trace, Prt, send, {Prt, {data, [$a|<<123456:32>>]}}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_outputv generate correct trace messages +outputv(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUTV, 123456:32>>), + recv({Prt,{data,[$a|<<123456:32>>]}}), + + [{trace, Prt, send, {Prt, {data, [$a|<<123456:32>>]}}, S}] = flush(), + + erlang:port_close(Prt), + [] = flush(), + + ok. + +%% Test that driver_set_timer generate correct trace messages +set_timer(_Config) -> + + Flags = [send,'receive'], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_SET_TIMER>>), + timer:sleep(100), + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_SET_TIMER>>}}}, + {trace, Prt, 'receive', timeout}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_failure* generate correct trace messages +failure_eof(_Config) -> + + Flags = [send,'receive', ports], + S = trace_ports(Flags), + + Prt = erlang:open_port({spawn, echo_drv}, [eof, binary]), + [{trace, Prt, open, S, echo_drv}, + {trace, Prt, getting_linked, S}] = flush(), + + erlang:port_command(Prt, <<?ECHO_DRV_FAILURE_EOF>>), + recv({Prt,eof}), + [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_FAILURE_EOF>>}}}, + {trace, Prt, send, {Prt, eof}, S}] = flush(), + + close(Prt, Flags), + + %% Run same test without eof option + failure_test(<<?ECHO_DRV_FAILURE_EOF>>, normal). + +failure_atom(_Config) -> + failure_test(<<?ECHO_DRV_FAILURE_ATOM, "failure\0">>, failure). +failure_posix(_Config) -> + failure_test(<<?ECHO_DRV_FAILURE_POSIX>>, eagain). +failure(_Config) -> + failure_test(<<?ECHO_DRV_FAILURE, 1>>, 1). + +failure_test(Failure, Reason) -> + + {Prt, S} = trace_and_open([send, 'receive', ports],[binary]), + + [{trace, Prt, open, S, echo_drv}, + {trace, Prt, getting_linked, S}] = flush(), + + process_flag(trap_exit, true), + erlang:port_command(Prt, Failure), + try + recv({'EXIT',Prt,Reason}) + after + process_flag(trap_exit, false) + end, + [{trace, Prt, 'receive', {S, {command, Failure}}}, + {trace, Prt, closed, Reason}, + {trace, Prt, unlink, S}] = flush(), + + ok. + +%% Test that erl_drv_output_term generate correct trace messages +output_term(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_OUTPUT_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_output_term generate correct trace messages +driver_output_term(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_DRIVER_OUTPUT_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that erl_drv_send_term generate correct trace messages +send_term(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_SEND_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(), + + {Pid, Ref} = spawn_monitor(fun() -> erlang:port_command(Prt, <<?ECHO_DRV_SAVE_CALLER>>) end), + recv({'DOWN',Ref,process,Pid,normal}), + erlang:port_command(Prt, <<?ECHO_DRV_SEND_TERM, 123456:32>>), + [{trace, Prt, send_to_non_existing_process, {echo, Prt, <<123456:32>>}, Pid}] = flush(), + + close(Prt, Flags), + + ok. + +%% Test that driver_send_term generate correct trace messages +driver_send_term(_Config) -> + + Flags = [send], + {Prt, S} = trace_and_open(Flags,[binary]), + + erlang:port_command(Prt, <<?ECHO_DRV_DRIVER_SEND_TERM, 123456:32>>), + recv({echo, Prt, <<123456:32>>}), + [{trace, Prt, send, {echo, Prt, <<123456:32>>}, S}] = flush(), + + {Pid, Ref} = spawn_monitor(fun() -> erlang:port_command(Prt, <<?ECHO_DRV_SAVE_CALLER>>) end), + recv({'DOWN',Ref,process,Pid,normal}), + erlang:port_command(Prt, <<?ECHO_DRV_SEND_TERM, 123456:32>>), + [{trace, Prt, send_to_non_existing_process, {echo, Prt, <<123456:32>>}, Pid}] = flush(), + + close(Prt, Flags), + + ok. + +%%%%%%%%%%%%%%%%%%% +%% Helper functions +%%%%%%%%%%%%%%%%%%% + +trace_ports(TraceFlags) -> + erlang:trace(new_ports, true, TraceFlags), + self(). + +trace_and_open(TraceFlags, OpenFlags) -> + S = self(), + Ports = proplists:get_value(ports, TraceFlags), + [trace_ports(TraceFlags) || Ports], + Prt = erlang:open_port({spawn, echo_drv}, OpenFlags), + [erlang:trace(Prt, true, TraceFlags) || Ports == undefined], + {Prt, S}. + +close(Prt, Flags) -> + Recv = proplists:get_value('receive', Flags), + Ports = proplists:get_value(ports, Flags), + S = self(), + + erlang:port_close(Prt), + + if Recv, Ports -> + [{trace, Prt, 'receive', {S, close}}, + {trace, Prt, closed, normal}, + {trace, Prt, unlink, S}] = flush(); + Recv -> + [{trace, Prt, 'receive', {S, close}}] = flush(); + Ports -> + [{trace, Prt, closed, normal}, + {trace, Prt, unlink, S}] = flush(); + true -> + [] = flush() + end. + +trace_delivered() -> + Ref = erlang:trace_delivered(all), + receive {trace_delivered, all, Ref} -> ok end. + +flush() -> + flush(all). +flush(From) -> + trace_delivered(), + f(From). + +f(From) -> + receive + M when From =:= all; element(2, M) == From -> + [M | f(From)] + after 0 -> + [] + end. + +recv(Msg) -> + receive Msg -> ok after 100 -> ct:fail({did_not_get_data,Msg,flush()}) end. + +load_drv(Config) -> + Path = proplists:get_value(data_dir, Config), + case erl_ddll:load_driver(Path, echo_drv) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + ct:fail(Res) + end. + +reload_drv(Config) -> + erl_ddll:unload_driver(echo_drv), + load_drv(Config). diff --git a/erts/emulator/test/port_trace_SUITE_data/Makefile.src b/erts/emulator/test/port_trace_SUITE_data/Makefile.src new file mode 100644 index 0000000000..c1bf142ccf --- /dev/null +++ b/erts/emulator/test/port_trace_SUITE_data/Makefile.src @@ -0,0 +1,3 @@ +all: echo_drv@dll@ + +@SHLIB_RULES@ diff --git a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c new file mode 100644 index 0000000000..b5728bc170 --- /dev/null +++ b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c @@ -0,0 +1,237 @@ +#include <stdio.h> +#include "erl_driver.h" +#include <errno.h> +#include <string.h> + + +/* ------------------------------------------------------------------------- +** Data types +**/ + + +typedef struct _erl_drv_data { + ErlDrvPort erlang_port; + ErlDrvTermData caller; +} EchoDrvData; + +#define ECHO_DRV_NOOP 0 +#define ECHO_DRV_OUTPUT 1 +#define ECHO_DRV_OUTPUT2 2 +#define ECHO_DRV_OUTPUT_BINARY 3 +#define ECHO_DRV_OUTPUTV 4 +#define ECHO_DRV_SET_TIMER 5 +#define ECHO_DRV_FAILURE_EOF 6 +#define ECHO_DRV_FAILURE_ATOM 7 +#define ECHO_DRV_FAILURE_POSIX 8 +#define ECHO_DRV_FAILURE 9 +#define ECHO_DRV_OUTPUT_TERM 10 +#define ECHO_DRV_DRIVER_OUTPUT_TERM 11 +#define ECHO_DRV_SEND_TERM 12 +#define ECHO_DRV_DRIVER_SEND_TERM 13 +#define ECHO_DRV_SAVE_CALLER 14 + + +/* ------------------------------------------------------------------------- +** Entry struct +**/ + +static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command); +static void echo_drv_stop(ErlDrvData drv_data); +static void echo_drv_output(ErlDrvData drv_data, char *buf, + ErlDrvSizeT len); +static void echo_drv_outputv(ErlDrvData drv_data, ErlIOVec *iov); +static void echo_drv_finish(void); +static ErlDrvSSizeT echo_drv_control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen); +static void echo_drv_timeout(ErlDrvData drv_data); +static ErlDrvSSizeT echo_drv_call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags); + +static ErlDrvEntry echo_drv_entry = { + NULL, /* init */ + echo_drv_start, + echo_drv_stop, + echo_drv_output, + NULL, /* ready_input */ + NULL, /* ready_output */ + "echo_drv", + echo_drv_finish, + NULL, /* handle */ + echo_drv_control, + echo_drv_timeout, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + echo_drv_call, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, + NULL, + NULL, + NULL +}; + +/* ------------------------------------------------------------------------- +** Entry functions +**/ + +DRIVER_INIT(echo_drv) +{ + char buff[5]; + size_t size = sizeof(buff); + + if (erl_drv_getenv("OUTPUTV", buff, &size) == -1) { + echo_drv_entry.outputv = NULL; + } else { + echo_drv_entry.outputv = echo_drv_outputv; + } + + return &echo_drv_entry; +} + +static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command) +{ + EchoDrvData *echo_drv_data_p = driver_alloc(sizeof(EchoDrvData)); + echo_drv_data_p->erlang_port = port; + echo_drv_data_p->caller = driver_caller(port); + return echo_drv_data_p; +} + +static void echo_drv_stop(EchoDrvData *data_p) { + driver_free(data_p); +} + +static void echo_drv_outputv(ErlDrvData drv_data, ErlIOVec *iov) +{ + return; +} + +static void echo_drv_output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) { + EchoDrvData* data_p = (EchoDrvData *) drv_data; + ErlDrvPort port = data_p->erlang_port; + + switch (buf[0]) { + case ECHO_DRV_OUTPUT: + { + driver_output(port, buf+1, len-1); + break; + } + case ECHO_DRV_OUTPUT2: + { + driver_output2(port, "a", 1, buf+1, len-1); + break; + } + case ECHO_DRV_OUTPUT_BINARY: + { + ErlDrvBinary *bin = driver_alloc_binary(len-1); + memcpy(&bin->orig_bytes, buf+1, len-1); + driver_output_binary(port, "a", 1, bin, 1, len - 2); + driver_free_binary(bin); + break; + } + case ECHO_DRV_OUTPUTV: + { + ErlIOVec iov; + ErlDrvSizeT sz; + driver_enq(port, buf + 1, len - 1); + sz = driver_peekqv(port, &iov); + driver_outputv(port, "a", 1, &iov, 0); + driver_deq(port, sz); + break; + } + case ECHO_DRV_SET_TIMER: + { + driver_set_timer(port, 10); + break; + } + case ECHO_DRV_FAILURE_EOF: + { + driver_failure_eof(port); + break; + } + case ECHO_DRV_FAILURE_ATOM: + { + driver_failure_atom(port, buf+1); + break; + } + case ECHO_DRV_FAILURE_POSIX: + { + driver_failure_posix(port, EAGAIN); + break; + } + case ECHO_DRV_FAILURE: + { + driver_failure(port, buf[1]); + break; + } + case ECHO_DRV_OUTPUT_TERM: + case ECHO_DRV_DRIVER_OUTPUT_TERM: + case ECHO_DRV_SEND_TERM: + case ECHO_DRV_DRIVER_SEND_TERM: + { + ErlDrvTermData term[] = { + ERL_DRV_ATOM, driver_mk_atom("echo"), + ERL_DRV_PORT, driver_mk_port(port), + ERL_DRV_BUF2BINARY, (ErlDrvTermData)(buf+1), + (ErlDrvTermData)(len - 1), + ERL_DRV_TUPLE, 3}; + switch (buf[0]) { + case ECHO_DRV_OUTPUT_TERM: + erl_drv_output_term(driver_mk_port(port), term, sizeof(term) / sizeof(ErlDrvTermData)); + break; + case ECHO_DRV_DRIVER_OUTPUT_TERM: + driver_output_term(port, term, sizeof(term) / sizeof(ErlDrvTermData)); + break; + case ECHO_DRV_SEND_TERM: + driver_send_term(port, data_p->caller, + term, sizeof(term) / sizeof(ErlDrvTermData)); + break; + case ECHO_DRV_DRIVER_SEND_TERM: + erl_drv_send_term(driver_mk_port(port), data_p->caller, + term, sizeof(term) / sizeof(ErlDrvTermData)); + break; + } + break; + } + case ECHO_DRV_SAVE_CALLER: + data_p->caller = driver_caller(port); + break; + default: + break; + } +} + +static void echo_drv_finish() { + +} + +static ErlDrvSSizeT echo_drv_control(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen) +{ + memcpy(*rbuf, buf+1, len-1); + return len-1; +} + +static void echo_drv_timeout(ErlDrvData drv_data) +{ + +} + +static ErlDrvSSizeT echo_drv_call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags) +{ + memcpy(*rbuf, buf+command, len-command); + return len-command; +} diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl index b7ff4c109c..c3e303bbd1 100644 --- a/erts/emulator/test/sensitive_SUITE.erl +++ b/erts/emulator/test/sensitive_SUITE.erl @@ -311,7 +311,7 @@ gc_trace(Config) when is_list(Config) -> wait_trace(Self), {messages,Messages} = process_info(Tracer, messages), - [{trace,Self,gc_start,_},{trace,Self,gc_end,_}] = Messages, + [{trace,Self,gc_major_start,_},{trace,Self,gc_major_end,_}] = Messages, unlink(Tracer), exit(Tracer, kill), ok. diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl index a56b394765..2e359b11ce 100644 --- a/erts/emulator/test/system_profile_SUITE.erl +++ b/erts/emulator/test/system_profile_SUITE.erl @@ -27,7 +27,7 @@ system_profile_on_and_off/1, runnable_procs/1, runnable_ports/1, dont_profile_profiler/1, - scheduler/1]). + scheduler/1, sane_location/1]). -export([profiler_process/1, ring_loop/1, port_echo_start/0, list_load/0, run_load/2]). @@ -40,7 +40,8 @@ suite() -> all() -> [system_profile_on_and_off, runnable_procs, - runnable_ports, scheduler, dont_profile_profiler]. + runnable_ports, scheduler, dont_profile_profiler, + sane_location]. %% No specification clause needed for an init function in a conf case!!! @@ -183,6 +184,33 @@ dont_profile_profiler(Config) when is_list(Config) -> exit(Pid,kill), ok. +%% Check sane location (of exits) +sane_location(Config) when is_list(Config) -> + Check = spawn_link(fun() -> flush_sane_location() end), + erlang:system_profile(Check, [runnable_procs]), + Me = self(), + Pids = [spawn_link(fun() -> wat(Me) end) || _ <- lists:seq(1,100)], + [receive {Pid,ok} -> ok end || Pid <- Pids], + Check ! {Me, done}, + receive {Check,ok} -> ok end, + ok. + +wat(Pid) -> + Pid ! {self(), ok}. + +flush_sane_location() -> + receive + {profile,_,_,{M,F,A},_} when is_atom(M), is_atom(F), + is_integer(A) -> + flush_sane_location(); + {profile,_,_,0,_} -> + flush_sane_location(); + {Pid,done} when is_pid(Pid) -> + Pid ! {self(), ok}; + M -> + ct:fail({badness,M}) + end. + %%% Check scheduler profiling diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index 7aece926e3..b7f312635e 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -24,8 +24,8 @@ %%% Tests the trace BIF. %%% --export([all/0, suite/0, - receive_trace/1, self_send/1, +-export([all/0, suite/0, link_receive_call_correlation/0, + receive_trace/1, link_receive_call_correlation/1, self_send/1, timeout_trace/1, send_trace/1, procs_trace/1, dist_procs_trace/1, suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1, @@ -48,7 +48,8 @@ suite() -> {timetrap, {seconds, 5}}]. all() -> - [cpu_timestamp, receive_trace, self_send, timeout_trace, + [cpu_timestamp, receive_trace, link_receive_call_correlation, + self_send, timeout_trace, send_trace, procs_trace, dist_procs_trace, suspend, mutual_suspend, suspend_exit, suspender_exit, suspend_system_limit, suspend_opts, suspend_waiting, @@ -87,10 +88,10 @@ receive_trace(Config) when is_list(Config) -> 1 = erlang:trace(Receiver, true, ['receive']), Hello = {hello, world}, Receiver ! Hello, - {trace, Receiver, 'receive', Hello} = receive_first(), + {trace, Receiver, 'receive', Hello} = receive_first_trace(), Hello2 = {hello, again, world}, Receiver ! Hello2, - {trace, Receiver, 'receive', Hello2} = receive_first(), + {trace, Receiver, 'receive', Hello2} = receive_first_trace(), receive_nothing(), %% Another process should not be able to trace Receiver. @@ -104,6 +105,112 @@ receive_trace(Config) when is_list(Config) -> receive_nothing(), ok. +%% Tests that receive of a message always happens before a call with +%% that message and that links/unlinks are ordered together with the +%% 'receive'. +link_receive_call_correlation() -> + [{timetrap, {minutes, 5}}]. +link_receive_call_correlation(Config) when is_list(Config) -> + Receiver = fun_spawn(fun F() -> + receive + stop -> ok; + M -> receive_msg(M), F() + end + end), + process_flag(trap_exit, true), + + %% Trace the process; make sure that we receive the trace messages. + 1 = erlang:trace(Receiver, true, ['receive', procs, call, timestamp, scheduler_id]), + 1 = erlang:trace_pattern({?MODULE, receive_msg, '_'}, [], [local]), + + Num = 100000, + + (fun F(0) -> []; + F(N) -> + if N rem 2 == 0 -> + link(Receiver); + true -> + unlink(Receiver) + end, + [Receiver ! N | F(N-1)] + end)(Num), + + Receiver ! stop, + MonRef = erlang:monitor(process, Receiver), + receive {'DOWN', MonRef, _, _, _} -> ok end, + Ref = erlang:trace_delivered(Receiver), + receive {trace_delivered, _, Ref} -> ok end, + + Msgs = (fun F() -> receive M -> [M | F()] after 1 -> [] end end)(), + + case check_consistent(Receiver, Num, Num, Num, Msgs) of + ok -> + ok; + {error, Reason} -> + ct:log("~p", [Msgs]), + ct:fail({error, Reason}) + end. + +-define(schedid, , _). + +check_consistent(_Pid, Recv, Call, _LU, [Msg | _]) when Recv > Call -> + {error, Msg}; +check_consistent(Pid, Recv, Call, LU, [Msg | Msgs]) -> + + case Msg of + {trace, Pid, 'receive', Recv ?schedid} -> + check_consistent(Pid,Recv - 1, Call, LU, Msgs); + {trace_ts, Pid, 'receive', Recv ?schedid, _} -> + check_consistent(Pid,Recv - 1, Call, LU, Msgs); + + {trace, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid} -> + check_consistent(Pid,Recv, Call - 1, LU, Msgs); + {trace_ts, Pid, call, {?MODULE, receive_msg, [Call]} ?schedid, _} -> + check_consistent(Pid,Recv, Call - 1, LU, Msgs); + + %% We check that for each receive we have gotten a + %% getting_linked or getting_unlinked message. Also + %% if we receive a getting_linked, then the next + %% message we expect to receive is an even number + %% and odd number for getting_unlinked. + {trace, Pid, getting_linked, _Self ?schedid} + when Recv rem 2 == 0, Recv == LU -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs); + {trace_ts, Pid, getting_linked, _Self ?schedid, _} + when Recv rem 2 == 0, Recv == LU -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs); + + {trace, Pid, getting_unlinked, _Self ?schedid} + when Recv rem 2 == 1, Recv == LU -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs); + {trace_ts, Pid, getting_unlinked, _Self ?schedid, _} + when Recv rem 2 == 1, Recv == LU -> + check_consistent(Pid, Recv, Call, LU - 1, Msgs); + + {trace,Pid,'receive',Ignore ?schedid} + when Ignore == stop; Ignore == timeout -> + check_consistent(Pid, Recv, Call, LU, Msgs); + {trace_ts,Pid,'receive',Ignore ?schedid,_} + when Ignore == stop; Ignore == timeout -> + check_consistent(Pid, Recv, Call, LU, Msgs); + + {trace, Pid, exit, normal ?schedid} -> + check_consistent(Pid, Recv, Call, LU, Msgs); + {trace_ts, Pid, exit, normal ?schedid, _} -> + check_consistent(Pid, Recv, Call, LU, Msgs); + {'EXIT', Pid, normal} -> + check_consistent(Pid, Recv, Call, LU, Msgs); + Msg -> + {error, Msg} + end; +check_consistent(_, 0, 0, 0, []) -> + ok; +check_consistent(_, Recv, Call, LU, []) -> + {error,{Recv, Call, LU}}. + +receive_msg(M) -> + M. + %% Test that traces are generated for messages sent %% and received to/from self(). self_send(Config) when is_list(Config) -> @@ -134,8 +241,8 @@ timeout_trace(Config) when is_list(Config) -> Process = fun_spawn(fun process/0), 1 = erlang:trace(Process, true, ['receive']), Process ! timeout_please, - {trace, Process, 'receive', timeout_please} = receive_first(), - {trace, Process, 'receive', timeout} = receive_first(), + {trace, Process, 'receive', timeout_please} = receive_first_trace(), + {trace, Process, 'receive', timeout} = receive_first_trace(), receive_nothing(), ok. @@ -149,13 +256,13 @@ send_trace(Config) when is_list(Config) -> %% Check that a message sent to another process is traced. 1 = erlang:trace(Sender, true, [send]), Sender ! {send_please, Receiver, to_receiver}, - {trace, Sender, send, to_receiver, Receiver} = receive_first(), + {trace, Sender, send, to_receiver, Receiver} = receive_first_trace(), receive_nothing(), %% Check that a message sent to another registered process is traced. register(?MODULE,Receiver), Sender ! {send_please, ?MODULE, to_receiver}, - {trace, Sender, send, to_receiver, ?MODULE} = receive_first(), + {trace, Sender, send, to_receiver, ?MODULE} = receive_first_trace(), receive_nothing(), unregister(?MODULE), @@ -163,14 +270,14 @@ send_trace(Config) when is_list(Config) -> Sender ! {send_please, self(), to_myself}, receive to_myself -> ok end, Self = self(), - {trace, Sender, send, to_myself, Self} = receive_first(), + {trace, Sender, send, to_myself, Self} = receive_first_trace(), receive_nothing(), %% Check that a message sent to dead process is traced. {Pid,Ref} = spawn_monitor(fun() -> ok end), receive {'DOWN',Ref,_,_,_} -> ok end, Sender ! {send_please, Pid, to_dead}, - {trace, Sender, send_to_non_existing_process, to_dead, Pid} = receive_first(), + {trace, Sender, send_to_non_existing_process, to_dead, Pid} = receive_first_trace(), receive_nothing(), %% Check that a message sent to unknown registrated process is traced. @@ -178,7 +285,7 @@ send_trace(Config) when is_list(Config) -> 1 = erlang:trace(BadargSender, true, [send]), unlink(BadargSender), BadargSender ! {send_please, not_registered, to_unknown}, - {trace, BadargSender, send, to_unknown, not_registered} = receive_first(), + {trace, BadargSender, send, to_unknown, not_registered} = receive_first_trace(), receive_nothing(), %% Another process should not be able to trace Sender. @@ -205,15 +312,17 @@ procs_trace(Config) when is_list(Config) -> Proc2 = spawn(?MODULE, process, [Self]), io:format("Proc2 = ~p ~n", [Proc2]), %% - 1 = erlang:trace(Proc1, true, [procs]), + 1 = erlang:trace(Proc1, true, [procs, set_on_first_spawn]), MFA = {?MODULE, process, [Self]}, %% %% spawn, link Proc1 ! {spawn_link_please, Self, MFA}, Proc3 = receive {spawned, Proc1, P3} -> P3 end, - {trace, Proc1, spawn, Proc3, MFA} = receive_first(), + receive {trace, Proc3, spawned, Proc1, MFA} -> ok end, + receive {trace, Proc3, getting_linked, Proc1} -> ok end, + {trace, Proc1, spawn, Proc3, MFA} = receive_first_trace(), io:format("Proc3 = ~p ~n", [Proc3]), - {trace, Proc1, link, Proc3} = receive_first(), + {trace, Proc1, link, Proc3} = receive_first_trace(), receive_nothing(), %% %% getting_unlinked by exit() @@ -221,60 +330,61 @@ procs_trace(Config) when is_list(Config) -> Reason3 = make_ref(), Proc1 ! {send_please, Proc3, {exit_please, Reason3}}, receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end, - {trace, Proc1, getting_unlinked, Proc3} = receive_first(), + receive {trace, Proc3, exit, Reason3} -> ok end, + {trace, Proc1, getting_unlinked, Proc3} = receive_first_trace(), Proc1 ! {trap_exit_please, false}, receive_nothing(), %% %% link Proc1 ! {link_please, Proc2}, - {trace, Proc1, link, Proc2} = receive_first(), + {trace, Proc1, link, Proc2} = receive_first_trace(), receive_nothing(), %% %% unlink Proc1 ! {unlink_please, Proc2}, - {trace, Proc1, unlink, Proc2} = receive_first(), + {trace, Proc1, unlink, Proc2} = receive_first_trace(), receive_nothing(), %% %% getting_linked Proc2 ! {link_please, Proc1}, - {trace, Proc1, getting_linked, Proc2} = receive_first(), + {trace, Proc1, getting_linked, Proc2} = receive_first_trace(), receive_nothing(), %% %% getting_unlinked Proc2 ! {unlink_please, Proc1}, - {trace, Proc1, getting_unlinked, Proc2} = receive_first(), + {trace, Proc1, getting_unlinked, Proc2} = receive_first_trace(), receive_nothing(), %% %% register true = register(Name, Proc1), - {trace, Proc1, register, Name} = receive_first(), + {trace, Proc1, register, Name} = receive_first_trace(), receive_nothing(), %% %% unregister true = unregister(Name), - {trace, Proc1, unregister, Name} = receive_first(), + {trace, Proc1, unregister, Name} = receive_first_trace(), receive_nothing(), %% %% exit (with registered name, due to link) Reason4 = make_ref(), Proc1 ! {spawn_link_please, Self, MFA}, Proc4 = receive {spawned, Proc1, P4} -> P4 end, - {trace, Proc1, spawn, Proc4, MFA} = receive_first(), + {trace, Proc1, spawn, Proc4, MFA} = receive_first_trace(), io:format("Proc4 = ~p ~n", [Proc4]), - {trace, Proc1, link, Proc4} = receive_first(), + {trace, Proc1, link, Proc4} = receive_first_trace(), Proc1 ! {register_please, Name, Proc1}, - {trace, Proc1, register, Name} = receive_first(), + {trace, Proc1, register, Name} = receive_first_trace(), Proc4 ! {exit_please, Reason4}, receive {'EXIT', Proc1, Reason4} -> ok end, - {trace, Proc1, exit, Reason4} = receive_first(), - {trace, Proc1, unregister, Name} = receive_first(), + {trace, Proc1, exit, Reason4} = receive_first_trace(), + {trace, Proc1, unregister, Name} = receive_first_trace(), receive_nothing(), %% %% exit (not linked to tracing process) 1 = erlang:trace(Proc2, true, [procs]), Reason2 = make_ref(), Proc2 ! {exit_please, Reason2}, - {trace, Proc2, exit, Reason2} = receive_first(), + {trace, Proc2, exit, Reason2} = receive_first_trace(), receive_nothing(), ok. @@ -299,45 +409,45 @@ dist_procs_trace(Config) when is_list(Config) -> Proc1 ! {trap_exit_please, true}, Proc3 = receive {spawned, Proc1, P3} -> P3 end, io:format("Proc3 = ~p ~n", [Proc3]), - {trace, Proc1, getting_linked, Proc3} = receive_first(), + {trace, Proc1, getting_linked, Proc3} = receive_first_trace(), Reason3 = make_ref(), Proc1 ! {send_please, Proc3, {exit_please, Reason3}}, receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end, - {trace, Proc1, getting_unlinked, Proc3} = receive_first(), + {trace, Proc1, getting_unlinked, Proc3} = receive_first_trace(), Proc1 ! {trap_exit_please, false}, receive_nothing(), %% %% link Proc1 ! {link_please, Proc2}, - {trace, Proc1, link, Proc2} = receive_first(), + {trace, Proc1, link, Proc2} = receive_first_trace(), receive_nothing(), %% %% unlink Proc1 ! {unlink_please, Proc2}, - {trace, Proc1, unlink, Proc2} = receive_first(), + {trace, Proc1, unlink, Proc2} = receive_first_trace(), receive_nothing(), %% %% getting_linked Proc2 ! {link_please, Proc1}, - {trace, Proc1, getting_linked, Proc2} = receive_first(), + {trace, Proc1, getting_linked, Proc2} = receive_first_trace(), receive_nothing(), %% %% getting_unlinked Proc2 ! {unlink_please, Proc1}, - {trace, Proc1, getting_unlinked, Proc2} = receive_first(), + {trace, Proc1, getting_unlinked, Proc2} = receive_first_trace(), receive_nothing(), %% %% exit (with registered name, due to link) Name = list_to_atom(OtherName), Reason2 = make_ref(), Proc1 ! {link_please, Proc2}, - {trace, Proc1, link, Proc2} = receive_first(), + {trace, Proc1, link, Proc2} = receive_first_trace(), Proc1 ! {register_please, Name, Proc1}, - {trace, Proc1, register, Name} = receive_first(), + {trace, Proc1, register, Name} = receive_first_trace(), Proc2 ! {exit_please, Reason2}, receive {'EXIT', Proc1, Reason2} -> ok end, - {trace, Proc1, exit, Reason2} = receive_first(), - {trace, Proc1, unregister, Name} = receive_first(), + {trace, Proc1, exit, Reason2} = receive_first_trace(), + {trace, Proc1, unregister, Name} = receive_first_trace(), receive_nothing(), %% %% Done. @@ -1247,7 +1357,8 @@ existing_clear(Config) when is_list(Config) -> [N, M]), {flags, []} = erlang:trace_info(Self, flags), {tracer, []} = erlang:trace_info(Self, tracer), - M = N + 1, % Since trace could not be enabled on the tracer. + M = N, % Used to be N + 1, but from 19.0 the tracer is also traced + ok. %% Test that an invalid flag cause badarg @@ -1317,6 +1428,13 @@ receive_first() -> Any -> Any end. +%% Waits for and returns the first message in the message queue. + +receive_first_trace() -> + receive + Any when element(1,Any) =:= trace; element(1,Any) =:= trace_ts -> Any + end. + %% Ensures that there is no message in the message queue. receive_nothing() -> @@ -1421,7 +1539,7 @@ fun_spawn(Fun, Args) -> start_node(Name) -> Pa = filename:dirname(code:which(?MODULE)), Cookie = atom_to_list(erlang:get_cookie()), - test_server:start_node(Name, slave, + test_server:start_node(Name, slave, [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]). stop_node(Node) -> diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl index a2edf0662d..8c3ffccc45 100644 --- a/erts/emulator/test/trace_bif_SUITE.erl +++ b/erts/emulator/test/trace_bif_SUITE.erl @@ -247,7 +247,8 @@ receive_trace_msg(Mess) -> receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, call, {erlang, F, A}, Ts} -> + {trace_ts, Pid, call, {erlang, F, A}, Ts} = M -> + io:format("~p (PrevTs: ~p)~n",[M, PrevTs]), check_ts(TsType, PrevTs, Ts), Ts; Other -> @@ -260,7 +261,8 @@ receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}, PrevTs, TsType) -> receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, return_from, {erlang, F, A}, _Value, Ts} -> + {trace_ts, Pid, return_from, {erlang, F, A}, _Value, Ts} = M -> + io:format("~p (PrevTs: ~p)~n",[M, PrevTs]), check_ts(TsType, PrevTs, Ts), Ts; Other -> @@ -272,7 +274,8 @@ receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}, Pre receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}, PrevTs, TsType) -> receive - {trace_ts, Pid, return_to, {M, F, A}, Ts} -> + {trace_ts, Pid, return_to, {M, F, A}, Ts} = Msg -> + io:format("~p (PrevTs: ~p)~n",[Msg, PrevTs]), check_ts(TsType, PrevTs, Ts), Ts; Other -> diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl index 8901beebca..74c05f24e0 100644 --- a/erts/emulator/test/trace_local_SUITE.erl +++ b/erts/emulator/test/trace_local_SUITE.erl @@ -1224,18 +1224,22 @@ setup(ProcFlags) -> shutdown() -> trace_off(), - {Pid,Mref} = get(slave), - try erlang:is_process_alive(Pid) of - true -> - Pid ! die, - receive - {'DOWN',Mref,process,Pid,Reason} -> - Reason + case get(slave) of + {Pid,Mref} -> + try erlang:is_process_alive(Pid) of + true -> + Pid ! die, + receive + {'DOWN',Mref,process,Pid,Reason} -> + Reason + end; + _ -> + not_alive + catch _:_ -> + undefined end; _ -> - not_alive - catch _:_ -> - undefined + undefined end. trace_off() -> diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl index 98dc96bfa7..a66563d15b 100644 --- a/erts/emulator/test/trace_port_SUITE.erl +++ b/erts/emulator/test/trace_port_SUITE.erl @@ -28,10 +28,6 @@ receive_trace/1, process_events/1, schedule/1, - fake_schedule/1, - fake_schedule_after_register/1, - fake_schedule_after_getting_linked/1, - fake_schedule_after_getting_unlinked/1, gc/1, default_tracer/1, tracer_port_crash/1]). @@ -44,10 +40,7 @@ suite() -> all() -> [call_trace, return_trace, send, receive_trace, - process_events, schedule, fake_schedule, - fake_schedule_after_register, - fake_schedule_after_getting_linked, - fake_schedule_after_getting_unlinked, gc, + process_events, schedule, gc, default_tracer, tracer_port_crash]. %% Test sending call trace messages to a port. @@ -234,162 +227,6 @@ schedule(Config) when is_list(Config) -> ok. -run_fake_sched_test(Fun, Config) when is_function(Fun), is_list(Config) -> - case catch erlang:system_info(smp_support) of - true -> - {skipped, - "No need for faked schedule out/in trace messages " - "when smp support is enabled"}; - _ -> - Fun(Config) - end. - -%% Tests time compensating fake out/in scheduling. -fake_schedule(Config) when is_list(Config) -> - run_fake_sched_test(fun fake_schedule_test/1, Config). - -fake_schedule_test(Config) when is_list(Config) -> - Tracer = start_tracer(Config), - Port = get(tracer_port), - General = fun_spawn(fun general/0), - %% - trac(General, true, [send, running]), - %% - %% Test that fake out/in scheduling is not generated unless - %% both 'running' and 'timestamp' is active. - [] = erlang:port_control(Port, $h, []), - General ! nop, - expect({trace, General, in, {?MODULE, general, 0}}), - expect({trace, General, out, {?MODULE, general, 0}}), - expect(), - %% - trac(General, false, [running]), - trac(General, true, [timestamp]), - %% - Ref1 = make_ref(), - Msg1 = {Port, {data, term_to_binary(Ref1)}}, - [] = erlang:port_control(Port, $h, []), - General ! {send, Tracer, Msg1}, - expect({trace_ts, General, send, Msg1, Tracer, ts}), - expect(Ref1), - expect(), - %% - trac(General, true, [running]), - %% - %% Test that fake out/in scheduling can be generated by the driver - Ref2 = make_ref(), - Msg2 = {Port, {data, term_to_binary(Ref2)}}, - [] = erlang:port_control(Port, $h, []), - General ! {send, Tracer, Msg2}, - {_,_,_,_,Ts} = - expect({trace_ts, General, in, {?MODULE, general, 0}, ts}), - expect({trace_ts, General, out, 0, Ts}), - expect({trace_ts, General, in, 0, ts}), - expect({trace_ts, General, send, Msg2, Tracer, ts}), - expect(Ref2), - expect({trace_ts, General, out, {?MODULE, general, 0}, ts}), - expect(), - %% - %% Test that fake out/in scheduling is not generated after an - %% 'out' scheduling event - Ref3 = make_ref(), - Msg3 = {Port, {data, term_to_binary(Ref3)}}, - General ! {apply, {erlang, port_control, [Port, $h, []]}}, - expect({trace_ts, General, in, {?MODULE, general, 0}, ts}), - expect({trace_ts, General, out, {?MODULE, general, 0}, ts}), - General ! {send, Tracer, Msg3}, - expect({trace_ts, General, in, {?MODULE, general, 0}, ts}), - expect({trace_ts, General, send, Msg3, Tracer, ts}), - expect(Ref3), - expect({trace_ts, General, out, {?MODULE, general, 0}, ts}), - expect(), - %% - ok. - -%% Tests fake out/in scheduling contents. -fake_schedule_after_register(Config) when is_list(Config) -> - run_fake_sched_test(fun fake_schedule_after_register_test/1, Config). - -fake_schedule_after_register_test(Config) when is_list(Config) -> - start_tracer(Config), - Port = get(tracer_port), - G1 = fun_spawn(fun general/0), - G2 = fun_spawn(fun general/0), - %% - trac(G1, true, [running, timestamp, procs]), - trac(G2, true, [running, timestamp]), - %% - %% Test fake out/in scheduling after certain messages - erlang:yield(), - G2 ! {apply, {erlang, port_control, [Port, $h, []]}}, - G2 ! {apply, {erlang, register, [fake_schedule_after_register, G1]}}, - expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}), - {_,_,_,_,Ts} = - expect({trace_ts, G1, register, fake_schedule_after_register, ts}), - expect({trace_ts, G2, out, 0, Ts}), - expect({trace_ts, G2, in, 0, ts}), - expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}), - expect(), - %% - ok. - -%% Tests fake out/in scheduling contents. -fake_schedule_after_getting_linked(Config) when is_list(Config) -> - run_fake_sched_test(fun fake_schedule_after_getting_linked_test/1, - Config). - -fake_schedule_after_getting_linked_test(Config) when is_list(Config) -> - start_tracer(Config), - Port = get(tracer_port), - G1 = fun_spawn(fun general/0), - G2 = fun_spawn(fun general/0), - %% - trac(G1, true, [running, timestamp, procs]), - trac(G2, true, [running, timestamp]), - %% - %% Test fake out/in scheduling after certain messages - erlang:yield(), - G2 ! {apply, {erlang, port_control, [Port, $h, []]}}, - G2 ! {apply, {erlang, link, [G1]}}, - expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}), - {_,_,_,_,Ts} = - expect({trace_ts, G1, getting_linked, G2, ts}), - expect({trace_ts, G2, out, 0, Ts}), - expect({trace_ts, G2, in, 0, ts}), - expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}), - expect(), - %% - ok. - -%% Tests fake out/in scheduling contents. -fake_schedule_after_getting_unlinked(Config) when is_list(Config) -> - run_fake_sched_test(fun fake_schedule_after_getting_unlinked_test/1, - Config). - -fake_schedule_after_getting_unlinked_test(Config) when is_list(Config) -> - start_tracer(Config), - Port = get(tracer_port), - G1 = fun_spawn(fun general/0), - G2 = fun_spawn(fun general/0), - %% - trac(G1, true, [running, procs]), - trac(G2, true, [running, timestamp]), - %% - %% Test fake out/in scheduling after certain messages - erlang:yield(), - G2 ! {apply, {erlang, link, [G1]}}, - G2 ! {apply, {erlang, port_control, [Port, $h, []]}}, - G2 ! {apply, {erlang, unlink, [G1]}}, - expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}), - expect({trace, G1, getting_linked, G2}), - expect({trace, G1, getting_unlinked, G2}), - expect({trace_ts, G2, out, 0, ts}), - expect({trace_ts, G2, in, 0, ts}), - expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}), - expect(), - %% - ok. - %% Test sending garbage collection events to a port. gc(Config) when is_list(Config) -> start_tracer(Config), @@ -399,13 +236,13 @@ gc(Config) when is_list(Config) -> trace_info(Garber, flags), Garber ! hi, - expect({trace,Garber,gc_start,info}), - expect({trace,Garber,gc_end,info}), + expect({trace,Garber,gc_major_start,info}), + expect({trace,Garber,gc_major_end,info}), trac(Garber, true, [garbage_collection,timestamp]), Garber ! hi, - expect({trace_ts,Garber,gc_start,info,ts}), - expect({trace_ts,Garber,gc_end,info,ts}), + expect({trace_ts,Garber,gc_major_start,info,ts}), + expect({trace_ts,Garber,gc_major_end,info,ts}), ok. @@ -440,7 +277,7 @@ default_tracer(Config) when is_list(Config) -> {tracer, []} = erlang:trace_info(G1, tracer), G1 ! {apply,{erlang,exit,[normal]}}, io:format("~p = ~p.~n", [M, N]), - M = N, + M = N - 1, % G1 has been started, but Tracer and Port have died ok. tracer_port_crash(Config) when is_list(Config) -> diff --git a/erts/emulator/test/tracer_SUITE.erl b/erts/emulator/test/tracer_SUITE.erl new file mode 100644 index 0000000000..de44d6656a --- /dev/null +++ b/erts/emulator/test/tracer_SUITE.erl @@ -0,0 +1,627 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(tracer_SUITE). + +%%% +%%% Tests the tracer module interface +%%% + +-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]). +-export([load/1, unload/1, reload/1, invalid_tracers/1]). +-export([send/1, recv/1, spawn/1, exit/1, link/1, unlink/1, + getting_linked/1, getting_unlinked/1, register/1, unregister/1, + in/1, out/1, gc_start/1, gc_end/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. + +all() -> + [load, unload, reload, invalid_tracers, {group, basic}]. + +groups() -> + [{ basic, [], [send, recv, spawn, exit, link, unlink, getting_linked, + getting_unlinked, register, unregister, in, out, + gc_start, gc_end]}]. + +init_per_suite(Config) -> + purge(), + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(TC, Config) when TC =:= load; TC =:= reload -> + + DataDir = proplists:get_value(data_dir, Config), + + Pid = erlang:spawn(fun F() -> + receive + {get, Pid} -> + Pid ! DataDir, + F() + end + end), + register(tracer_test_config, Pid), + Config; +init_per_testcase(_, Config) -> + DataDir = proplists:get_value(data_dir, Config), + case catch tracer_test:enabled(trace_status, self(), self()) of + discard -> + ok; + _ -> + tracer_test:load(DataDir) + end, + Config. + +end_per_testcase(TC, _Config) when TC =:= load; TC =:= reload -> + purge(), + exit(whereis(tracer_test_config), kill), + ok; +end_per_testcase(_, _Config) -> + purge(), + ok. + +load(_Config) -> + purge(), + 1 = erlang:trace(self(), true, [{tracer, tracer_test, []}, call]), + purge(), + 1 = erlang:trace_pattern({?MODULE, all, 0}, [], + [{meta, tracer_test, []}]), + ok. + +unload(_Config) -> + + ServerFun = fun F(0, undefined) -> + receive + {N, Pid} -> F(N, Pid) + end; + F(0, Pid) -> + Pid ! done, + F(0, undefined); + F(N, Pid) -> + ?MODULE:all(), + F(N-1, Pid) + end, + + Pid = erlang:spawn_link(fun() -> ServerFun(0, undefined) end), + + + Tc = fun(N) -> + Pid ! {N, self()}, + receive done -> ok after 1000 -> ct:fail(timeout) end, + trace_delivered(Pid) + end, + + 1 = erlang:trace(Pid, true, [{tracer, tracer_test, + {#{ call => trace}, self(), []}}, + call]), + 1 = erlang:trace_pattern({?MODULE, all, 0}, [], []), + + Tc(1), + receive _ -> ok after 0 -> ct:fail(timeout) end, + + code:purge(tracer_test), + code:delete(tracer_test), + + Tc(1), + receive M1 -> ct:fail({unexpected_message, M1}) after 0 -> ok end, + + code:purge(tracer_test), + + Tc(1), + receive M2 -> ct:fail({unexpected_message, M2}) after 0 -> ok end, + + ok. + +%% This testcase is here to make sure there are not +%% segfaults when reloading the current nifs. +reload(_Config) -> + + Tracer = spawn_opt(fun F() -> receive _M -> F() end end, + [{message_queue_data, off_heap}]), + erlang:link(Tracer), + Tracee = spawn_link(fun reload_loop/0), + + [begin + Ref = make_ref(), + State = {#{ call => trace }, Tracer, [Ref]}, + erlang:trace(Tracee, true, [{tracer, tracer_test,State}, call]), + erlang:trace_pattern({?MODULE, all, 0}, []), + + false = code:purge(tracer_test), + {module, _} = code:load_file(tracer_test), + + %% There is a race involved in between when the internal nif cache + %% is purged and when the reload_loop needs the tracer module + %% so the tracer may be removed or still there. + case erlang:trace_info(Tracee, tracer) of + {tracer, []} -> ok; + {tracer, {tracer_test, State}} -> ok + end, + + false = code:purge(tracer_test), + true = code:delete(tracer_test), + false = code:purge(tracer_test) + end || _ <- lists:seq(1,15)], + + ok. + +reload_loop() -> + ?MODULE:all(), + reload_loop(). + +invalid_tracers(_Config) -> + FailTrace = fun(A) -> + try erlang:trace(self(), true, A) of + _ -> ct:fail(A) + catch _:_ -> ok end + end, + + FailTrace([{tracer, foobar}, call]), + FailTrace([{tracer, foobar, []}, call]), + FailTrace([{tracer, make_ref(), []}, call]), + FailTrace([{tracer, lists, []}, call]), + + FailTP = fun(MS,FL) -> + try erlang:trace_pattern({?MODULE,all,0}, MS, FL) of + _ -> ct:fail({MS, FL}) + catch _:_ -> ok end + end, + + FailTP([],[{meta, foobar}]), + FailTP([],[{meta, foobar, []}]), + FailTP([],[{meta, make_ref(), []}]), + FailTP([],[{meta, lists, []}]), + + ok. + + + +send(_Config) -> + + Self = self(), + Tc = fun(Pid) -> + Pid ! fun() -> Self ! ok end, + receive ok -> ok after 100 -> ct:fail(timeout) end + end, + + Expect = fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, send, State, Pid, ok, Self, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + test(send, Tc, Expect). + + +recv(_Config) -> + + Tc = fun(Pid) -> + Pid ! ok + end, + + Expect = fun(Pid, State, EOpts) -> + receive + Msg -> + {undefined, 'receive', State, Pid, ok, undefined, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test('receive', Tc, Expect, false). + +spawn(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> erlang:spawn(lists,seq,[1,10]), ok end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, spawn, State, Pid, NewPid, + {lists,seq,[1,10]}, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(spawn, procs, Tc, Expect, true). + +exit(_Config) -> + Tc = fun(Pid) -> + Pid ! fun() -> exit end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, exit, State, Pid, normal, undefined, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(exit, procs, Tc, Expect, true, true). + +link(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + SPid = erlang:spawn(fun() -> receive _ -> ok end end), + erlang:link(SPid), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, link, State, Pid, NewPid, undefined, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(link, procs, Tc, Expect, true). + +unlink(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + SPid = erlang:spawn(fun() -> receive _ -> ok end end), + erlang:link(SPid), + erlang:unlink(SPid), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, unlink, State, Pid, NewPid, undefined, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(unlink, procs, Tc, Expect, true). + +getting_linked(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + Self = self(), + erlang:spawn(fun() -> erlang:link(Self) end), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {NewPid, getting_linked, State, Pid, NewPid, undefined, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(getting_linked, procs, Tc, Expect, false). + +getting_unlinked(_Config) -> + Tc = fun(Pid) -> + Pid ! fun() -> + Self = self(), + erlang:spawn(fun() -> + erlang:link(Self), + erlang:unlink(Self) + end), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {NewPid, getting_unlinked, State, Pid, NewPid, undefined, Opts} = Msg, + check_opts(EOpts, Opts), + true = is_pid(NewPid) andalso NewPid /= Pid + end + end, + + test(getting_unlinked, procs, Tc, Expect, false). + +register(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + erlang:register(?MODULE, self()), + erlang:unregister(?MODULE), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, register, State, Pid, ?MODULE, undefined, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(register, procs, Tc, Expect, true). + +unregister(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + erlang:register(?MODULE, self()), + erlang:unregister(?MODULE), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, unregister, State, Pid, ?MODULE, undefined, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(unregister, procs, Tc, Expect, true). + +in(_Config) -> + + Tc = fun(Pid) -> + Self = self(), + Pid ! fun() -> receive after 1 -> Self ! ok end end, + receive ok -> ok end + end, + + Expect = + fun(Pid, State, EOpts) -> + N = (fun F(N) -> + receive + Msg -> + {Pid, in, State, Pid, _, + undefined, Opts} = Msg, + check_opts(EOpts, Opts), + F(N+1) + after 0 -> N + end + end)(0), + true = N > 0 + end, + + test(in, running, Tc, Expect, true). + +out(_Config) -> + Tc = fun(Pid) -> + Pid ! fun() -> receive after 10 -> exit end end, + Ref = erlang:monitor(process, Pid), + receive {'DOWN', Ref, _, _, _} -> ok end + end, + + Expect = + fun(Pid, State, EOpts) -> + %% We cannot predict how many out schedules there will be + N = (fun F(N) -> + receive + Msg -> + {Pid, out, State, Pid, _, + undefined, Opts} = Msg, + check_opts(EOpts, Opts), + F(N+1) + after 0 -> N + end + end)(0), + true = N > 0 + end, + + test(out, running, Tc, Expect, true, true). + +gc_start(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + erlang:garbage_collect(), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, gc_major_start, State, Pid, _, undefined, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(gc_major_start, garbage_collection, Tc, Expect, true). + +gc_end(_Config) -> + + Tc = fun(Pid) -> + Pid ! fun() -> + erlang:garbage_collect(), + ok + end + end, + + Expect = + fun(Pid, State, EOpts) -> + receive + Msg -> + {Pid, gc_major_end, State, Pid, _, undefined, Opts} = Msg, + check_opts(EOpts, Opts) + end + end, + + test(gc_major_end, garbage_collection, Tc, Expect, true). + +test(Event, Tc, Expect) -> + test(Event, Tc, Expect, true). +test(Event, Tc, Expect, Removes) -> + test(Event, Event, Tc, Expect, Removes). +test(Event, TraceFlag, Tc, Expect, Removes) -> + test(Event, TraceFlag, Tc, Expect, Removes, false). +test(Event, TraceFlag, Tc, Expect, Removes, Dies) -> + + ComplexState = {fun() -> ok end, <<0:(128*8)>>}, + Opts = #{ timestamp => undefined, + scheduler_id => undefined, + match_spec_result => true }, + + %% Test that trace works + State1 = {#{ Event => trace }, self(), ComplexState}, + Pid1 = start_tracee(), + 1 = erlang:trace(Pid1, true, [TraceFlag, {tracer, tracer_test, State1}]), + Tc(Pid1), + ok = trace_delivered(Pid1), + + Expect(Pid1, State1, Opts), + receive M11 -> ct:fail({unexpected, M11}) after 0 -> ok end, + if not Dies -> + {flags, [TraceFlag]} = erlang:trace_info(Pid1, flags), + {tracer, {tracer_test, State1}} = erlang:trace_info(Pid1, tracer), + erlang:trace(Pid1, false, [TraceFlag]); + true -> ok + end, + + %% Test that trace works with scheduler id and timestamp + Pid1T = start_tracee(), + 1 = erlang:trace(Pid1T, true, [TraceFlag, {tracer, tracer_test, State1}, + timestamp, scheduler_id]), + Tc(Pid1T), + ok = trace_delivered(Pid1T), + + Expect(Pid1T, State1, Opts#{ scheduler_id := number, + timestamp := timestamp}), + receive M11T -> ct:fail({unexpected, M11T}) after 0 -> ok end, + if not Dies -> + {flags, [scheduler_id, TraceFlag, timestamp]} + = erlang:trace_info(Pid1T, flags), + {tracer, {tracer_test, State1}} = erlang:trace_info(Pid1T, tracer), + erlang:trace(Pid1T, false, [TraceFlag]); + true -> ok + end, + + %% Test that discard works + Pid2 = start_tracee(), + State2 = {#{ Event => discard }, self(), ComplexState}, + 1 = erlang:trace(Pid2, true, [TraceFlag, {tracer, tracer_test, State2}]), + Tc(Pid2), + ok = trace_delivered(Pid2), + receive M2 -> ct:fail({unexpected, M2}) after 0 -> ok end, + if not Dies -> + {flags, [TraceFlag]} = erlang:trace_info(Pid2, flags), + {tracer, {tracer_test, State2}} = erlang:trace_info(Pid2, tracer), + erlang:trace(Pid2, false, [TraceFlag]); + true -> + ok + end, + + %% Test that remove works + Pid3 = start_tracee(), + State3 = {#{ Event => remove }, self(), ComplexState}, + 1 = erlang:trace(Pid3, true, [TraceFlag, {tracer, tracer_test, State3}]), + Tc(Pid3), + ok = trace_delivered(Pid3), + receive M3 -> ct:fail({unexpected, M3}) after 0 -> ok end, + if not Dies -> + if Removes -> + {flags, []} = erlang:trace_info(Pid3, flags), + {tracer, []} = erlang:trace_info(Pid3, tracer); + true -> + {flags, [TraceFlag]} = erlang:trace_info(Pid3, flags), + {tracer, {tracer_test, State3}} = erlang:trace_info(Pid3, tracer) + end, + erlang:trace(Pid3, false, [TraceFlag]); + true -> + ok + end, + ok. + +check_opts(#{ scheduler_id := number } = E, #{ scheduler_id := N } = O) + when is_integer(N) -> + E1 = maps:remove(scheduler_id, E), + O1 = maps:remove(scheduler_id, O), + if E1 == O1 -> ok; + true -> ct:fail({invalid_opts, E, O}) + end; +check_opts(Opts, Opts) -> + ok; +check_opts(E,O) -> + ct:fail({invalid_opts, E, O}). + +start_tracee() -> + spawn_link( + fun F() -> + receive + Action when is_function(Action) -> + case Action() of + ok -> + F(); + Err -> + Err + end; + _ -> + F() + end + end). + +trace_delivered(Pid) -> + Ref = erlang:trace_delivered(Pid), + receive + {trace_delivered, Pid, Ref} -> + ok + after 1000 -> + timeout + end. + +purge() -> + %% Make sure module is not loaded + case erlang:module_loaded(tracer_test) of + true -> + code:purge(tracer_test), + true = code:delete(tracer_test), + code:purge(tracer_test); + _ -> + ok + end. diff --git a/erts/emulator/test/tracer_SUITE_data/Makefile.src b/erts/emulator/test/tracer_SUITE_data/Makefile.src new file mode 100644 index 0000000000..154bd70ccc --- /dev/null +++ b/erts/emulator/test/tracer_SUITE_data/Makefile.src @@ -0,0 +1,8 @@ + +NIF_LIBS = tracer_test@dll@ + +all: $(NIF_LIBS) + +@SHLIB_RULES@ + +$(NIF_LIBS): tracer_test.c diff --git a/erts/emulator/test/tracer_SUITE_data/tracer_test.c b/erts/emulator/test/tracer_SUITE_data/tracer_test.c new file mode 100644 index 0000000000..8b4be1345d --- /dev/null +++ b/erts/emulator/test/tracer_SUITE_data/tracer_test.c @@ -0,0 +1,122 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#include "erl_nif.h" + +#include <stdio.h> +#include <string.h> +#include <assert.h> +#include <limits.h> + +/* NIF interface declarations */ +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); +static void unload(ErlNifEnv* env, void* priv_data); + +/* The NIFs: */ +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ErlNifFunc nif_funcs[] = { + {"enabled", 3, enabled}, + {"trace", 6, trace} +}; + +ERL_NIF_INIT(tracer_test, nif_funcs, load, NULL, upgrade, unload) + +static ERL_NIF_TERM atom_discard; +static ERL_NIF_TERM atom_ok; + +#define ASSERT(expr) assert(expr) + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + + atom_discard = enif_make_atom(env, "discard"); + atom_ok = enif_make_atom(env, "ok"); + + *priv_data = NULL; + + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ + +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, + ERL_NIF_TERM load_info) +{ + if (*old_priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (*priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (load(env, priv_data, load_info)) { + return -1; + } + return 0; +} + +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int state_arity; + const ERL_NIF_TERM *state_tuple; + ERL_NIF_TERM value; + ASSERT(argc == 3); + + if (!enif_get_tuple(env, argv[1], &state_arity, &state_tuple)) + return atom_discard; + + if (enif_get_map_value(env, state_tuple[0], argv[0], &value)) { + return value; + } else { + return atom_discard; + } +} + +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int state_arity; + ErlNifPid self, to; + ERL_NIF_TERM *tuple, msg; + const ERL_NIF_TERM *state_tuple; + ASSERT(argc == 6); + + enif_get_tuple(env, argv[1], &state_arity, &state_tuple); + + tuple = enif_alloc(sizeof(ERL_NIF_TERM)*(argc+1)); + memcpy(tuple+1,argv,sizeof(ERL_NIF_TERM)*argc); + + if (enif_self(env, &self)) { + tuple[0] = enif_make_pid(env, &self); + } else { + tuple[0] = enif_make_atom(env, "undefined"); + } + + msg = enif_make_tuple_from_array(env, tuple, argc + 1); + enif_get_local_pid(env, state_tuple[1], &to); + enif_send(env, &to, NULL, msg); + enif_free(tuple); + + return atom_ok; +} diff --git a/erts/emulator/test/tracer_test.erl b/erts/emulator/test/tracer_test.erl new file mode 100644 index 0000000000..d4778f4531 --- /dev/null +++ b/erts/emulator/test/tracer_test.erl @@ -0,0 +1,55 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(tracer_test). + +%%% +%%% Test tracer +%%% + +-export([enabled/3, trace/6]). +-export([load/1, load/2]). +-on_load(load/0). + +enabled(_, _, _) -> + erlang:nif_error(nif_not_loaded). + +trace(_, _, _, _, _, _) -> + erlang:nif_error(nif_not_loaded). + +load() -> + case whereis(tracer_test_config) of + undefined -> + ok; + Pid -> + Pid ! {get, self()}, + receive + {Conf, Postfix} -> + load(Conf, Postfix); + Conf -> + load(Conf) + end + end. + +load(DataDir) -> + load(DataDir, ""). +load(DataDir, Postfix) -> + SoFile = atom_to_list(?MODULE) ++ Postfix, + erlang:load_nif(filename:join(DataDir, SoFile) , 0). diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 1a5bbe0d33..4407f7e289 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -48,7 +48,7 @@ $pack_shift[4] = ['0', 'BEAM_LOOSE_SHIFT', # Only for 64 bit wordsize '(3*BEAM_LOOSE_SHIFT)']; $pack_mask[2] = ['BEAM_LOOSE_MASK', $WHOLE_WORD]; -$pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD]; +$pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK']; $pack_mask[4] = ['BEAM_LOOSE_MASK', # Only for 64 bit wordsize 'BEAM_LOOSE_MASK', 'BEAM_LOOSE_MASK', @@ -251,6 +251,7 @@ $args_per_word[5] = 3; $args_per_word[6] = 3; if ($wordsize == 64) { + $pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', $WHOLE_WORD]; $args_per_word[4] = 4; } @@ -624,19 +625,25 @@ sub emulator_output { print "#define NUM_SPECIFIC_OPS ", scalar(@op_to_name), "\n"; print "#define SCRATCH_X_REG 1023\n"; print "\n"; - print "#ifdef ARCH_64\n"; - print "# define BEAM_WIDE_MASK 0xFFFFUL\n"; - print "# define BEAM_LOOSE_MASK 0xFFFFUL\n"; - print "# define BEAM_TIGHT_MASK 0xFFFFUL\n"; - print "# define BEAM_WIDE_SHIFT 32\n"; - print "# define BEAM_LOOSE_SHIFT 16\n"; - print "# define BEAM_TIGHT_SHIFT 16\n"; - print "#else\n"; - print "# define BEAM_LOOSE_MASK 0xFFF\n"; - print "# define BEAM_TIGHT_MASK 0xFFC\n"; - print "# define BEAM_LOOSE_SHIFT 16\n"; - print "# define BEAM_TIGHT_SHIFT 10\n"; - print "#endif\n"; + if ($wordsize == 32) { + print "#if defined(ARCH_64)\n"; + print qq[ #error "32-bit architecture assumed, but ARCH_64 is defined"\n]; + print "#endif\n"; + print "#define BEAM_LOOSE_MASK 0xFFF\n"; + print "#define BEAM_TIGHT_MASK 0xFFC\n"; + print "#define BEAM_LOOSE_SHIFT 16\n"; + print "#define BEAM_TIGHT_SHIFT 10\n"; + } elsif ($wordsize == 64) { + print "#if !defined(ARCH_64)\n"; + print qq[ #error "64-bit architecture assumed, but ARCH_64 not defined"\n]; + print "#endif\n"; + print "#define BEAM_WIDE_MASK 0xFFFFUL\n"; + print "#define BEAM_LOOSE_MASK 0xFFFFUL\n"; + print "#define BEAM_TIGHT_MASK 0xFFFFUL\n"; + print "#define BEAM_WIDE_SHIFT 32\n"; + print "#define BEAM_LOOSE_SHIFT 16\n"; + print "#define BEAM_TIGHT_SHIFT 16\n"; + } print "\n"; # diff --git a/erts/emulator/utils/make_driver_tab b/erts/emulator/utils/make_driver_tab index 646959e8b2..ffb5f58ebf 100755 --- a/erts/emulator/utils/make_driver_tab +++ b/erts/emulator/utils/make_driver_tab @@ -31,7 +31,7 @@ my $file = ""; my $nif = ""; my @emu_drivers = (); my @static_drivers = (); -my @nifs = (); +my @static_nifs = (); my $mode = 1; while (@ARGV) { @@ -55,9 +55,14 @@ while (@ARGV) { push(@static_drivers, $d); } if ($mode == 2) { - push(@nifs, $d); + push(@static_nifs, $d); } next; + } elsif ($mode == 2) { + $d = basename $d; + $d =~ s/_nif(\..*|)$//; # strip nif.* or just nif + push(@static_nifs, $d); + next; } $d = basename $d; $d =~ s/drv(\..*|)$//; # strip drv.* or just drv @@ -120,7 +125,7 @@ typedef struct ErtsStaticNifEntry_ { EOF # prototypes -foreach (@nifs) { +foreach (@static_nifs) { my $d = ${_}; $d =~ s/\.debug//; # strip .debug print "void *".$d."_nif_init(void);\n"; @@ -129,7 +134,7 @@ foreach (@nifs) { # The array itself print "static ErtsStaticNifEntry static_nif_tab[] =\n{\n"; -foreach (@nifs) { +foreach (@static_nifs) { my $d = ${_}; $d =~ s/\.debug//; # strip .debug print "{\"${_}\",&".$d."_nif_init},\n"; diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c index b36f4ccd40..44e997e609 100644 --- a/erts/epmd/src/epmd.c +++ b/erts/epmd/src/epmd.c @@ -592,8 +592,10 @@ void epmd_cleanup_exit(EpmdVars *g, int exitval) free(g->argv); } #ifdef HAVE_SYSTEMD_DAEMON - sd_notifyf(0, "STATUS=Exited.\n" - "ERRNO=%i", exitval); + if (g->is_systemd){ + sd_notifyf(0, "STATUS=Exited.\n" + "ERRNO=%i", exitval); + } #endif /* HAVE_SYSTEMD_DAEMON */ exit(exitval); } diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index 38ed137575..66c10a65bc 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -447,9 +447,11 @@ void run(EpmdVars *g) num_sockets = bound; #ifdef HAVE_SYSTEMD_DAEMON } - sd_notifyf(0, "READY=1\n" - "STATUS=Processing port mapping requests...\n" - "MAINPID=%lu", (unsigned long) getpid()); + if (g->is_systemd) { + sd_notifyf(0, "READY=1\n" + "STATUS=Processing port mapping requests...\n" + "MAINPID=%lu", (unsigned long) getpid()); + } #endif /* HAVE_SYSTEMD_DAEMON */ dbg_tty_printf(g,2,"entering the main select() loop"); diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 086c5af8c7..82a0303f86 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -74,6 +74,7 @@ static const char plusM_au_allocs[]= { 'R', /* driver_alloc */ 'S', /* sl_alloc */ 'T', /* temp_alloc */ + 'X', /* exec_alloc */ 'Z', /* test_alloc */ '\0' }; @@ -123,6 +124,7 @@ static char *plusM_other_switches[] = { "Ytp", "Ytt", "Iscs", + "Xscs", NULL }; diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex f224178c4f..77685013ae 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erl_tracer.beam b/erts/preloaded/ebin/erl_tracer.beam Binary files differnew file mode 100644 index 0000000000..b8f3f6d8c2 --- /dev/null +++ b/erts/preloaded/ebin/erl_tracer.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 7ceb6daaa3..15e4ca82a7 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam Binary files differindex 4188e5fd9b..3e95b1e42e 100644 --- a/erts/preloaded/ebin/erts_code_purger.beam +++ b/erts/preloaded/ebin/erts_code_purger.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 88da34b192..53dd2897de 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex 7d73ca2234..ee32066f53 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex 3cd2515ba8..51a412b7f7 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.beam diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam Binary files differindex 9a208d1545..45bed5cf7e 100644 --- a/erts/preloaded/ebin/prim_eval.beam +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 426e764127..c25bffb6a5 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex d68d18ecba..85d74de065 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex 01b3b1feb8..1f8fe6f03b 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 7252d866bb..059585ec99 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile index 1e3de9f1d7..4a447d3a09 100644 --- a/erts/preloaded/src/Makefile +++ b/erts/preloaded/src/Makefile @@ -43,7 +43,8 @@ PRE_LOADED_ERL_MODULES = \ otp_ring0 \ erts_code_purger \ erlang \ - erts_internal + erts_internal \ + erl_tracer PRE_LOADED_BEAM_MODULES = \ prim_eval diff --git a/erts/preloaded/src/erl_tracer.erl b/erts/preloaded/src/erl_tracer.erl new file mode 100644 index 0000000000..de1e9ca01e --- /dev/null +++ b/erts/preloaded/src/erl_tracer.erl @@ -0,0 +1,59 @@ +-module(erl_tracer). + +-export([enabled/3, trace/6, on_load/0]). + +-type tracee() :: port() | pid() | undefined. + +-type trace_tag_running_ports() :: in | out | in_exiting | out_exiting | out_exited. +-type trace_tag_running_procs() :: in | out | in_exiting | out_exiting | out_exited. +-type trace_tag_send() :: send | send_to_non_existing_process. +-type trace_tag_receive() :: 'receive'. +-type trace_tag_call() :: call | return_to | return_from | exception_from. +-type trace_tag_procs() :: spawn | spawned | exit | link | unlink + | getting_linked | getting_unlinked + | register | unregister. +-type trace_tag_ports() :: open | closed | link | unlink + | getting_linked | getting_unlinked. +-type trace_tag_gc() :: gc_minor_start | gc_minor_end + | gc_major_start | gc_major_end. + +-type trace_tag() :: trace_tag_send() + | trace_tag_receive() + | trace_tag_call() + | trace_tag_procs() + | trace_tag_ports() + | trace_tag_running_procs() + | trace_tag_running_ports() + | trace_tag_gc(). + +-type trace_opts() :: #{ match_spec_result => true | term(), + scheduler_id => undefined | non_neg_integer(), + timestamp => undefined | timestamp | cpu_timestamp | + monotonic | strict_monotonic }. +-type tracer_state() :: term(). + +on_load() -> + case erlang:load_nif(atom_to_list(?MODULE), 0) of + ok -> ok + end. + +%%% +%%% NIF placeholders +%%% + +-spec enabled(Tag :: trace_tag() | seq_trace | trace_status, + TracerState :: tracer_state(), + Tracee :: tracee()) -> + trace | discard | remove. +enabled(_, _, _) -> + erlang:nif_error(nif_not_loaded). + +-spec trace(Tag :: trace_tag() | seq_trace, + TracerState :: tracer_state(), + Tracee :: tracee(), + Msg :: term(), + Extra :: term(), + Opts :: trace_opts()) -> any(). + +trace(_, _, _, _, _, _) -> + erlang:nif_error(nif_not_loaded). diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 4374bdcd89..20a64e81b4 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -230,27 +230,32 @@ send | 'receive' | procs | + ports | call | - silent | + arity | return_to | + silent | running | exiting | + running_procs | + running_ports | garbage_collection | timestamp | cpu_timestamp | monotonic_timestamp | strict_monotonic_timestamp | - arity | set_on_spawn | set_on_first_spawn | set_on_link | set_on_first_link | - {tracer, pid() | port()}. + {tracer, pid() | port()} | + {tracer, module(), term()}. -type trace_info_item_result() :: {traced, global | local | false | undefined} | {match_spec, trace_match_spec() | false | undefined} | {meta, pid() | port() | false | undefined | []} | + {meta, module(), term() } | {meta_match_spec, trace_match_spec() | false | undefined} | {call_count, non_neg_integer() | boolean() | undefined} | {call_time, [{pid(), non_neg_integer(), @@ -276,6 +281,7 @@ undefined | {flags, [trace_info_flag()]} | {tracer, pid() | port() | []} | + {tracer, module(), term()} | trace_info_item_result() | {all, [ trace_info_item_result() ] | false | undefined}. @@ -1157,10 +1163,10 @@ map_size(_Map) -> erlang:nif_error(undefined). %% match_spec_test/3 --spec erlang:match_spec_test(P1, P2, P3) -> TestResult when - P1 :: [term()] | tuple(), - P2 :: term(), - P3 :: table | trace, +-spec erlang:match_spec_test(MatchAgainst, MatchSpec, Type) -> TestResult when + MatchAgainst :: [term()] | tuple(), + MatchSpec :: term(), + Type :: table | trace, TestResult :: {ok, term(), [return_trace], [ {error | warning, string()} ]} | {error, [ {error | warning, string()} ]}. match_spec_test(_P1, _P2, _P3) -> erlang:nif_error(undefined). @@ -1705,12 +1711,35 @@ time() -> erlang:nif_error(undefined). %% trace/3 --spec erlang:trace(PidSpec, How, FlagList) -> integer() when - PidSpec :: pid() | existing | new | all, +-spec erlang:trace(PidPortSpec, How, FlagList) -> integer() when + PidPortSpec :: pid() | port() + | all | processes | ports + | existing | existing_processes | existing_ports + | new | new_processes | new_ports, How :: boolean(), FlagList :: [trace_flag()]. -trace(_PidSpec, _How, _FlagList) -> - erlang:nif_error(undefined). +trace(PidPortSpec, How, FlagList) -> + %% Make sure that we have loaded the tracer module + case lists:keyfind(tracer, 1, FlagList) of + {tracer, Module, State} when erlang:is_atom(Module) -> + case erlang:module_loaded(Module) of + false -> + Module:enabled(trace_status, erlang:self(), State); + true -> + ok + end; + _ -> + ignore + end, + + try erts_internal:trace(PidPortSpec, How, FlagList) of + Res -> Res + catch E:R -> + {_, [_ | CST]} = erlang:process_info( + erlang:self(), current_stacktrace), + erlang:raise( + E, R, [{?MODULE, trace, [PidPortSpec, How, FlagList], []} | CST]) + end. %% trace_delivered/1 -spec erlang:trace_delivered(Tracee) -> Ref when @@ -1720,14 +1749,16 @@ trace_delivered(_Tracee) -> erlang:nif_error(undefined). %% trace_info/2 --spec erlang:trace_info(PidOrFunc, Item) -> Res when - PidOrFunc :: pid() | new | {Module, Function, Arity} | on_load, +-spec erlang:trace_info(PidPortOrFunc, Item) -> Res when + PidPortOrFunc :: pid() | port() | new | new_processes | new_ports + | {Module, Function, Arity} | on_load, Module :: module(), Function :: atom(), Arity :: arity(), - Item :: flags | tracer | traced | match_spec | meta | meta_match_spec | call_count | call_time | all, + Item :: flags | tracer | traced | match_spec + | meta | meta_match_spec | call_count | call_time | all, Res :: trace_info_return(). -trace_info(_PidOrFunc, _Item) -> +trace_info(_PidPortOrFunc, _Item) -> erlang:nif_error(undefined). %% trunc/1 @@ -2226,9 +2257,9 @@ spawn_opt(_Tuple) -> Input :: non_neg_integer(), Output :: non_neg_integer(); (microstate_accounting) -> [MSAcc_Thread] | undefined when - MSAcc_Thread :: #{ type => MSAcc_Thread_Type, - id => MSAcc_Thread_Id, - counters => MSAcc_Counters}, + MSAcc_Thread :: #{ type := MSAcc_Thread_Type, + id := MSAcc_Thread_Id, + counters := MSAcc_Counters}, MSAcc_Thread_Type :: scheduler | async | aux, MSAcc_Thread_Id :: non_neg_integer(), MSAcc_Counters :: #{ MSAcc_Thread_State => non_neg_integer() }, @@ -2319,7 +2350,7 @@ subtract(_,_) -> OldState :: preliminary | final | volatile; %% These are deliberately not documented (internal_cpu_topology, term()) -> term(); - (sequential_tracer, pid() | port() | false) -> pid() | port() | false; + (sequential_tracer, pid() | port() | {module(), term()} | false) -> pid() | port() | false; (1,0) -> true. system_flag(_Flag, _Value) -> @@ -2355,12 +2386,20 @@ tl(_List) -> | boolean() | restart | pause. -trace_pattern(_MFA, _MatchSpec) -> - erlang:nif_error(undefined). +trace_pattern(MFA, MatchSpec) -> + try erts_internal:trace_pattern(MFA, MatchSpec, []) of + Res -> Res + catch E:R -> + {_, [_ | CST]} = erlang:process_info( + erlang:self(), current_stacktrace), + erlang:raise( + E, R, [{?MODULE, trace_pattern, [MFA, MatchSpec], []} | CST]) + end. -type trace_pattern_flag() :: global | local | meta | {meta, Pid :: pid()} | + {meta, TracerModule :: module(), TracerState :: term()} | call_count | call_time. @@ -2371,8 +2410,28 @@ trace_pattern(_MFA, _MatchSpec) -> | restart | pause, FlagList :: [ trace_pattern_flag() ]. -trace_pattern(_MFA, _MatchSpec, _FlagList) -> - erlang:nif_error(undefined). +trace_pattern(MFA, MatchSpec, FlagList) -> + %% Make sure that we have loaded the tracer module + case lists:keyfind(meta, 1, FlagList) of + {meta, Module, State} when erlang:is_atom(Module) -> + case erlang:module_loaded(Module) of + false -> + Module:enabled(trace_status, erlang:self(), State); + true -> + ok + end; + _ -> + ignore + end, + + try erts_internal:trace_pattern(MFA, MatchSpec, FlagList) of + Res -> Res + catch E:R -> + {_, [_ | CST]} = erlang:process_info( + erlang:self(), current_stacktrace), + erlang:raise( + E, R, [{?MODULE, trace_pattern, [MFA, MatchSpec, FlagList], []} | CST]) + end. %% Shadowed by erl_bif_types: erlang:tuple_to_list/1 -spec tuple_to_list(Tuple) -> [term()] when diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index 769757ba75..2459ea2a2c 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -55,7 +55,9 @@ -export([await_microstate_accounting_modifications/3, gather_microstate_accounting_result/2]). -%% Auto-import name clash +-export([trace/3, trace_pattern/3]). + +%% Auto import name clash -export([check_process_code/2]). %% @@ -403,3 +405,28 @@ microstate_accounting(Ref, Threads) -> {Ref, Res} -> [Res | microstate_accounting(Ref, Threads - 1)] end. + +-spec trace(PidPortSpec, How, FlagList) -> integer() when + PidPortSpec :: pid() | port() + | all | processes | ports + | existing | existing_processes | existing_ports + | new | new_processes | new_ports, + How :: boolean(), + FlagList :: []. +trace(_PidSpec, _How, _FlagList) -> + erlang:nif_error(undefined). + +-type trace_pattern_mfa() :: + {atom(),atom(),arity() | '_'} | on_load. +-type trace_match_spec() :: + [{[term()] | '_' ,[term()],[term()]}]. + +-spec trace_pattern(MFA, MatchSpec, FlagList) -> non_neg_integer() when + MFA :: trace_pattern_mfa(), + MatchSpec :: (MatchSpecList :: trace_match_spec()) + | boolean() + | restart + | pause, + FlagList :: [ ]. +trace_pattern(_MFA, _MatchSpec, _FlagList) -> + erlang:nif_error(undefined). diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl index 5d5d2f8012..618b53f6bb 100644 --- a/erts/preloaded/src/init.erl +++ b/erts/preloaded/src/init.erl @@ -41,6 +41,7 @@ %% -s : Start own processes. %% %% Experimental flags: +%% -profile_boot : Use an 'eprof light' to profile boot sequence %% -init_debug : Activate debug printouts in init %% -loader_debug : Activate debug printouts in erl_prim_loader %% -code_path_choice : strict | relaxed @@ -179,7 +180,16 @@ stop(Status) -> init ! {stop,{stop,Status}}, ok. boot(BootArgs) -> register(init, self()), process_flag(trap_exit, true), + + %% Load the tracer nif + erl_tracer:on_load(), + {Start0,Flags,Args} = parse_boot_args(BootArgs), + %% We don't get to profile parsing of BootArgs + case get_flag(profile_boot, Flags, false) of + false -> ok; + true -> debug_profile_start() + end, Start = map(fun prepare_run_args/1, Start0), boot(Start, Flags, Args). @@ -761,7 +771,14 @@ do_boot(Init,Flags,Start) -> %% print the node name into the Purify log. (catch erlang:system_info({purify, "Node: " ++ atom_to_list(node())})), - start_em(Start). + start_em(Start), + case get_flag(profile_boot,Flags,false) of + false -> ok; + true -> + debug_profile_format_mfas(debug_profile_mfas()), + debug_profile_stop() + end, + ok. get_root(Flags) -> case get_argument(root, Flags) of @@ -1335,3 +1352,64 @@ run_on_load_handlers([M|Ms], Debug) -> end end; run_on_load_handlers([], _) -> ok. + + +%% debug profile (light variant of eprof) +debug_profile_start() -> + _ = erlang:trace_pattern({'_','_','_'},true,[call_time]), + _ = erlang:trace_pattern(on_load,true,[call_time]), + _ = erlang:trace(all,true,[call]), + ok. + +debug_profile_stop() -> + _ = erlang:trace_pattern({'_','_','_'},false,[call_time]), + _ = erlang:trace_pattern(on_load,false,[call_time]), + _ = erlang:trace(all,false,[call]), + ok. + +debug_profile_mfas() -> + _ = erlang:trace_pattern({'_','_','_'},pause,[call_time]), + _ = erlang:trace_pattern(on_load,pause,[call_time]), + MFAs = collect_loaded_mfas() ++ erlang:system_info(snifs), + collect_mfas(MFAs,[]). + +%% debug_profile_format_mfas should be called at the end of the boot phase +%% so all pertinent modules should be loaded at that point. +debug_profile_format_mfas(MFAs0) -> + MFAs = lists:sort(MFAs0), + lists:foreach(fun({{Us,C},{M,F,A}}) -> + Str = io_lib:format("~w:~w/~w", [M,F,A]), + io:format(standard_error,"~55s - ~6w : ~w us~n", [Str,C,Us]) + end, MFAs), + ok. + +collect_loaded_mfas() -> + Ms = [M || M <- [element(1, Mi) || Mi <- code:all_loaded()]], + collect_loaded_mfas(Ms,[]). + +collect_loaded_mfas([],MFAs) -> MFAs; +collect_loaded_mfas([M|Ms],MFAs0) -> + MFAs = [{M,F,A} || {F,A} <- M:module_info(functions)], + collect_loaded_mfas(Ms,MFAs ++ MFAs0). + + +collect_mfas([], Info) -> Info; +collect_mfas([MFA|MFAs],Info) -> + case erlang:trace_info(MFA,call_time) of + {call_time, []} -> + collect_mfas(MFAs,Info); + {call_time, false} -> + collect_mfas(MFAs,Info); + {call_time, Data} -> + case collect_mfa(MFA,Data,0,0) of + {{0,_},_} -> + %% ignore mfas with zero time + collect_mfas(MFAs,Info); + MfaData -> + collect_mfas(MFAs,[MfaData|Info]) + end + end. + +collect_mfa(Mfa,[],Count,Time) -> {{Time,Count},Mfa}; +collect_mfa(Mfa,[{_Pid,C,S,Us}|Data],Count,Time) -> + collect_mfa(Mfa,Data,Count + C,Time + S * 1000000 + Us). diff --git a/erts/test/nt_SUITE.erl b/erts/test/nt_SUITE.erl index f798a40a6c..624e5484ba 100644 --- a/erts/test/nt_SUITE.erl +++ b/erts/test/nt_SUITE.erl @@ -37,13 +37,13 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 3}}]. -all() -> - case os:type() of - {win32, nt} -> - [nt, service_basic, service_env, user_env, synced, - service_prio, logout, debug, restart, restart_always, - stopaction]; - _ -> [nt] +all() -> + case {os:type(), os:version()} of + {{win32, nt}, Vsn} when Vsn =< {6,1,999999} -> + [nt, service_basic, service_env, user_env, synced, + service_prio, logout, debug, restart, restart_always, + stopaction]; + _ -> [nt] end. init_per_testcase(_Func, Config) -> @@ -367,11 +367,13 @@ stopaction(Config) when is_list(Config) -> %%% other platforms than NT. nt(Config) when is_list(Config) -> - case os:type() of - {win32,nt} -> - nt_run(); - _ -> - {skipped, "This test case is intended for Win NT only."} + case {os:type(), os:version()} of + {{win32, nt}, Vsn} when Vsn =< {6,1,999999} -> + nt_run(); + {{win32, nt}, _} -> + {skipped, "This test case requires admin privileges on Win 8 and later."}; + _ -> + {skipped, "This test case is intended for Win NT only."} end. diff --git a/lib/common_test/test_server/ts_run.erl b/lib/common_test/test_server/ts_run.erl index a856fc6f8d..66db1ff9a7 100644 --- a/lib/common_test/test_server/ts_run.erl +++ b/lib/common_test/test_server/ts_run.erl @@ -261,7 +261,7 @@ run_batch(Vars, _Spec, State) -> Command = State#state.command ++ " -noinput -s erlang halt", ts_lib:progress(Vars, 1, "Command: ~ts~n", [Command]), io:format(user, "Command: ~ts~n",[Command]), - Port = open_port({spawn, Command}, [stream, in, eof]), + Port = open_port({spawn, Command}, [stream, in, eof, exit_status]), Timeout = 30000 * case os:getenv("TS_RUN_VALGRIND") of false -> 1; _ -> 100 @@ -284,7 +284,16 @@ tricky_print_data(Port, Timeout) -> ok after 1 -> % force context switch ok - end + end, + receive + {Port, {exit_status, 0}} -> + ok; + {Port, {exit_status, N}} -> + io:format(user, "Test run exited with status ~p~n", [N]) + after 1 -> + %% This shouldn't happen, but better safe then hanging + ok + end after Timeout -> case erl_epmd:names() of {ok,Names} -> diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 9a81537006..f6ca7a0afb 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -230,9 +230,7 @@ build_attributes(Opts, SourceFile, Attr, MD5) -> [_|_] -> [{source,SourceFile}] end, Misc = case member(slim, Opts) of - false -> - {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(), - [{time,{Y,Mo,D,H,Mi,S}}|Misc0]; + false -> Misc0; true -> [] end, Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc], diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index 1e430b4ed5..c8bef31824 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -83,6 +83,9 @@ peep([{gc_bif,_,_,_,_,Dst}=I|Is], SeenTests0, Acc) -> %% Kill all remembered tests that depend on the destination register. SeenTests = kill_seen(Dst, SeenTests0), peep(Is, SeenTests, [I|Acc]); +peep([{jump,{f,L}},{label,L}=I|Is], _, Acc) -> + %% Sometimes beam_jump has missed this optimization. + peep(Is, gb_sets:empty(), [I|Acc]); peep([{select,Op,R,F,Vls0}|Is], _, Acc) -> case prune_redundant_values(Vls0, F) of [] -> diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index b338286a16..37f89dd677 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -484,6 +484,17 @@ check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> Other end end; +check_liveness(R, [{put_map,{f,_},_,Src,_D,Live,{list,_}}|_], St0) -> + case R of + Src -> + {used,St0}; + {x,X} when X < Live -> + {used,St0}; + {x,_} -> + {killed,St0}; + {y,_} -> + {unknown,St0} + end; check_liveness(R, [{test_heap,N,Live}|Is], St) -> I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]}, check_liveness(R, [I|Is], St); @@ -570,9 +581,9 @@ check_killed_block(R, [{set,Ds,Ss,_Op}|Is]) -> false -> check_killed_block(R, Is) end end; -check_killed_block(R, [{'%live',Live,_}|Is]) -> +check_killed_block(R, [{'%live',_,Regs}|Is]) -> case R of - {x,X} when X >= Live -> killed; + {x,X} when (Regs bsr X) band 1 =:= 0 -> killed; _ -> check_killed_block(R, Is) end; check_killed_block(_, []) -> transparent. diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index d033050d3c..6dc162db40 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -126,6 +126,7 @@ %% keep map exports here for now c_map_pattern/1, is_c_map/1, + is_c_map_pattern/1, map_es/1, map_arg/1, update_c_map/3, @@ -134,7 +135,7 @@ ann_c_map_pattern/2, map_pair_op/1,map_pair_key/1,map_pair_val/1, update_c_map_pair/4, - c_map_pair/2, + c_map_pair/2, c_map_pair_exact/2, ann_c_map_pair/4 ]). @@ -1636,6 +1637,11 @@ is_c_map_empty(#c_map{ es=[] }) -> true; is_c_map_empty(#c_literal{val=M}) when is_map(M),map_size(M) =:= 0 -> true; is_c_map_empty(_) -> false. +-spec is_c_map_pattern(c_map()) -> boolean(). + +is_c_map_pattern(#c_map{is_pat=IsPat}) -> + IsPat. + -spec ann_c_map([term()], [c_map_pair()]) -> c_map() | c_literal(). ann_c_map(As, Es) -> @@ -1688,6 +1694,11 @@ map_pair_op(#c_map_pair{op=Op}) -> Op. c_map_pair(Key,Val) -> #c_map_pair{op=#c_literal{val=assoc},key=Key,val=Val}. +-spec c_map_pair_exact(cerl(), cerl()) -> c_map_pair(). + +c_map_pair_exact(Key,Val) -> + #c_map_pair{op=#c_literal{val=exact},key=Key,val=Val}. + -spec ann_c_map_pair([term()], cerl(), cerl(), cerl()) -> c_map_pair(). diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index 6d38748964..b3decbec1f 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -61,6 +61,7 @@ map_arg/1, map_es/1, ann_c_map/3, update_c_map/3, + is_c_map_pattern/1, ann_c_map_pattern/2, map_pair_key/1,map_pair_val/1,map_pair_op/1, ann_c_map_pair/4, update_c_map_pair/4 @@ -752,10 +753,17 @@ label(T, N, Env) -> {As, N2} = label_ann(T, N1), {ann_c_tuple_skel(As, Ts), N2}; map -> - {M, N1} = label(map_arg(T), N, Env), - {Ts, N2} = label_list(map_es(T), N1, Env), - {As, N3} = label_ann(T, N2), - {ann_c_map(As, M, Ts), N3}; + case is_c_map_pattern(T) of + false -> + {M, N1} = label(map_arg(T), N, Env), + {Ts, N2} = label_list(map_es(T), N1, Env), + {As, N3} = label_ann(T, N2), + {ann_c_map(As, M, Ts), N3}; + true -> + {Ts, N1} = label_list(map_es(T), N, Env), + {As, N2} = label_ann(T, N1), + {ann_c_map_pattern(As, Ts), N2} + end; map_pair -> {Op, N1} = label(map_pair_op(T), N, Env), {Key, N2} = label(map_pair_key(T), N1, Env), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 65566df025..149086152a 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1317,7 +1317,7 @@ generate_key(String) when is_list(String) -> encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> Bin1 = case byte_size(Bin0) rem BlockSize of 0 -> Bin0; - N -> list_to_binary([Bin0,crypto:rand_bytes(BlockSize-N)]) + N -> list_to_binary([Bin0,crypto:strong_rand_bytes(BlockSize-N)]) end, Bin = crypto:block_encrypt(Type, Key, IVec, Bin1), TypeString = atom_to_list(Type), @@ -1798,4 +1798,5 @@ pre_load() -> v3_core, v3_kernel, v3_life], - code:ensure_modules_loaded(L). + _ = code:ensure_modules_loaded(L), + ok. diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl index 315324e906..8028aa99bb 100644 --- a/lib/compiler/src/core_parse.yrl +++ b/lib/compiler/src/core_parse.yrl @@ -47,12 +47,14 @@ receive_expr timeout try_expr sequence catch_expr variable clause clause_pattern -map_expr map_pairs map_pair map_pair_assoc map_pair_exact +map_expr anno_map_expr map_pairs anno_map_pair map_pair map_pair_assoc map_pair_exact map_pattern map_pair_patterns map_pair_pattern -annotation anno_fun anno_expression anno_expressions +annotation anno_atom anno_fun anno_expression anno_expressions anno_variable anno_variables anno_pattern anno_patterns anno_function_name +anno_literal +anno_segment anno_segment_pattern anno_clause anno_clauses. Terminals @@ -90,7 +92,7 @@ module_definition -> module_definition -> '(' 'module' atom module_export module_attribute module_defs 'end' '-|' annotation ')' : - #c_module{anno='$9',name=tok_val('$3'),exports='$4', + #c_module{anno='$9',name=#c_literal{val=tok_val('$3')},exports='$4', attrs='$5',defs='$6'}. module_export -> '[' ']' : []. @@ -99,7 +101,7 @@ module_export -> '[' exported_names ']' : '$2'. exported_names -> exported_name ',' exported_names : ['$1' | '$3']. exported_names -> exported_name : ['$1']. -exported_name -> function_name : '$1'. +exported_name -> anno_function_name : '$1'. module_attribute -> 'attributes' '[' ']' : []. module_attribute -> 'attributes' '[' attribute_list ']' : '$3'. @@ -107,8 +109,16 @@ module_attribute -> 'attributes' '[' attribute_list ']' : '$3'. attribute_list -> attribute ',' attribute_list : ['$1' | '$3']. attribute_list -> attribute : ['$1']. -attribute -> atom '=' literal : - {#c_literal{val=tok_val('$1')},'$3'}. +attribute -> anno_atom '=' anno_literal : + {'$1','$3'}. + +anno_atom -> atom : + cerl:c_atom(tok_val('$1')). +anno_atom -> '(' atom '-|' annotation ')' : + cerl:ann_c_atom('$4', tok_val('$2')). + +anno_literal -> literal : '$1'. +anno_literal -> '(' literal '-|' annotation ')' : cerl:set_ann('$2', '$4'). module_defs -> function_definitions : '$1'. @@ -186,7 +196,9 @@ tuple_pattern -> '{' anno_patterns '}' : c_tuple('$2'). map_pattern -> '~' '{' '}' '~' : c_map_pattern([]). map_pattern -> '~' '{' map_pair_patterns '}' '~' : - c_map_pattern(lists:sort('$3')). + c_map_pattern('$3'). +map_pattern -> '~' '{' map_pair_patterns '|' anno_map_expr '}' '~' : + ann_c_map_pattern('$5', '$3'). map_pair_patterns -> map_pair_pattern : ['$1']. map_pair_patterns -> map_pair_pattern ',' map_pair_patterns : ['$1' | '$3']. @@ -194,6 +206,9 @@ map_pair_patterns -> map_pair_pattern ',' map_pair_patterns : ['$1' | '$3']. map_pair_pattern -> anno_expression ':=' anno_pattern : #c_map_pair{op=#c_literal{val=exact}, key='$1',val='$3'}. +map_pair_pattern -> '(' anno_expression ':=' anno_pattern '-|' annotation ')' : + #c_map_pair{anno='$6',op=#c_literal{val=exact}, + key='$2',val='$4'}. cons_pattern -> '[' anno_pattern tail_pattern : c_cons('$2', '$3'). @@ -206,8 +221,12 @@ tail_pattern -> ',' anno_pattern tail_pattern : binary_pattern -> '#' '{' '}' '#' : #c_binary{segments=[]}. binary_pattern -> '#' '{' segment_patterns '}' '#' : #c_binary{segments='$3'}. -segment_patterns -> segment_pattern ',' segment_patterns : ['$1' | '$3']. -segment_patterns -> segment_pattern : ['$1']. +segment_patterns -> anno_segment_pattern ',' segment_patterns : ['$1' | '$3']. +segment_patterns -> anno_segment_pattern : ['$1']. + +anno_segment_pattern -> segment_pattern : '$1'. +anno_segment_pattern -> '(' segment_pattern '-|' annotation ')' : + cerl:set_ann('$2', '$4'). segment_pattern -> '#' '<' anno_pattern '>' '(' anno_expressions ')': case '$6' of @@ -289,11 +308,17 @@ tuple -> '{' anno_expressions '}' : c_tuple('$2'). map_expr -> '~' '{' '}' '~' : c_map([]). map_expr -> '~' '{' map_pairs '}' '~' : c_map('$3'). -map_expr -> '~' '{' map_pairs '|' variable '}' '~' : ann_c_map([], '$5', '$3'). -map_expr -> '~' '{' map_pairs '|' map_expr '}' '~' : ann_c_map([], '$5', '$3'). +map_expr -> '~' '{' map_pairs '|' anno_variable '}' '~' : ann_c_map([], '$5', '$3'). +map_expr -> '~' '{' map_pairs '|' anno_map_expr '}' '~' : ann_c_map([], '$5', '$3'). -map_pairs -> map_pair : ['$1']. -map_pairs -> map_pair ',' map_pairs : ['$1' | '$3']. +anno_map_expr -> map_expr : '$1'. +anno_map_expr -> '(' map_expr '-|' annotation ')' : cerl:set_ann('$2', '$4'). + +map_pairs -> anno_map_pair : ['$1']. +map_pairs -> anno_map_pair ',' map_pairs : ['$1' | '$3']. + +anno_map_pair -> map_pair : '$1'. +anno_map_pair -> '(' map_pair '-|' annotation ')' : cerl:set_ann('$2', '$4'). map_pair -> map_pair_assoc : '$1'. map_pair -> map_pair_exact : '$1'. @@ -312,8 +337,11 @@ tail -> ',' anno_expression tail : c_cons('$2', '$3'). binary -> '#' '{' '}' '#' : #c_literal{val = <<>>}. binary -> '#' '{' segments '}' '#' : make_binary('$3'). -segments -> segment ',' segments : ['$1' | '$3']. -segments -> segment : ['$1']. +segments -> anno_segment ',' segments : ['$1' | '$3']. +segments -> anno_segment : ['$1']. + +anno_segment -> segment : '$1'. +anno_segment -> '(' segment '-|' annotation ')' : cerl:set_ann('$2', '$4'). segment -> '#' '<' anno_expression '>' '(' anno_expressions ')': case '$6' of @@ -413,7 +441,8 @@ Erlang code. -include("core_parse.hrl"). --import(cerl, [ann_c_map/3,c_cons/2,c_map/1,c_map_pattern/1,c_tuple/1]). +-import(cerl, [ann_c_map/3,ann_c_map_pattern/2,c_cons/2,c_map/1, + c_map_pattern/1,c_tuple/1]). tok_val(T) -> element(3, T). tok_line(T) -> element(2, T). diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index 78a081e9ca..f34a5c034f 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -21,7 +21,7 @@ -module(core_pp). --export([format/1]). +-export([format/1,format_all/1]). -include("core_parse.hrl"). @@ -37,21 +37,32 @@ indent = 0 :: integer(), item_indent = 2 :: integer(), body_indent = 4 :: integer(), - tab_width = 8 :: non_neg_integer(), - line = 0 :: integer()}). + line = 0 :: integer(), + clean = true :: boolean()}). + +-define(TAB_WIDTH, 8). -spec format(cerl:cerl()) -> iolist(). format(Node) -> format(Node, #ctxt{}). -maybe_anno(Node, Fun, Ctxt) -> +-spec format_all(cerl:cerl()) -> iolist(). + +format_all(Node) -> + format(Node, #ctxt{clean=false}). + +maybe_anno(Node, Fun, #ctxt{clean=false}=Ctxt) -> As = cerl:get_ann(Node), - case get_line(As) of + maybe_anno(Node, Fun, Ctxt, As); +maybe_anno(Node, Fun, #ctxt{clean=true}=Ctxt) -> + As0 = cerl:get_ann(Node), + case get_line(As0) of none -> - maybe_anno(Node, Fun, Ctxt, As); + maybe_anno(Node, Fun, Ctxt, As0); Line -> - if Line > Ctxt#ctxt.line -> + As = strip_line(As0), + if Line > Ctxt#ctxt.line -> [io_lib:format("%% Line ~w",[Line]), nl_indent(Ctxt), maybe_anno(Node, Fun, Ctxt#ctxt{line = Line}, As) @@ -61,22 +72,22 @@ maybe_anno(Node, Fun, Ctxt) -> end end. -maybe_anno(Node, Fun, Ctxt, As) -> - case strip_line(As) of - [] -> - Fun(Node, Ctxt); - List -> - Ctxt1 = add_indent(Ctxt, 2), - Ctxt2 = add_indent(Ctxt1, 3), - ["( ", - Fun(Node, Ctxt1), - nl_indent(Ctxt1), - "-| ",format_anno(List, Ctxt2)," )" - ] - end. +maybe_anno(Node, Fun, Ctxt, []) -> + Fun(Node, Ctxt); +maybe_anno(Node, Fun, Ctxt, List) -> + Ctxt1 = add_indent(Ctxt, 2), + Ctxt2 = add_indent(Ctxt1, 3), + ["( ", + Fun(Node, Ctxt1), + nl_indent(Ctxt1), + "-| ",format_anno(List, Ctxt2)," )" + ]. format_anno([_|_]=List, Ctxt) -> [$[,format_anno_list(List, Ctxt),$]]; +format_anno({file,Name}, _Ctxt) -> + %% Optimization: Reduces file size considerably. + io_lib:format("{'file',~p}", [Name]); format_anno(Tuple, Ctxt) when is_tuple(Tuple) -> [${,format_anno_list(tuple_to_list(Tuple), Ctxt),$}]; format_anno(Val, Ctxt) when is_atom(Val) -> @@ -172,7 +183,8 @@ format_1(#c_tuple{es=Es}, Ctxt) -> format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), $} ]; -format_1(#c_map{arg=#c_literal{val=M},es=Es}, Ctxt) when is_map(M),map_size(M)=:=0 -> +format_1(#c_map{arg=#c_literal{anno=[],val=M},es=Es}, Ctxt) + when is_map(M), map_size(M) =:= 0 -> ["~{", format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), "}~" @@ -195,9 +207,16 @@ format_1(#c_values{es=Es}, Ctxt) -> format_1(#c_alias{var=V,pat=P}, Ctxt) -> Txt = [format(V, Ctxt)|" = "], [Txt|format(P, add_indent(Ctxt, width(Txt, Ctxt)))]; -format_1(#c_let{vars=Vs0,arg=A,body=B}, Ctxt) -> - Vs = [cerl:set_ann(V, []) || V <- Vs0], - case is_simple_term(A) of +format_1(#c_let{anno=Anno0,vars=Vs0,arg=A0,body=B}, #ctxt{clean=Clean}=Ctxt) -> + {Vs,A,Anno} = case Clean of + false -> + {Vs0,A0,Anno0}; + true -> + {[cerl:set_ann(V, []) || V <- Vs0], + cerl:set_ann(A0, []), + []} + end, + case is_simple_term(A) andalso Anno =:= [] of false -> Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent), ["let ", @@ -214,7 +233,7 @@ format_1(#c_let{vars=Vs0,arg=A,body=B}, Ctxt) -> ["let ", format_values(Vs, add_indent(Ctxt, 4)), " = ", - format(cerl:set_ann(A, []), Ctxt1), + format(A, Ctxt1), nl_indent(Ctxt), "in " | format(B, add_indent(Ctxt, 4)) @@ -362,7 +381,10 @@ format_values(Vs, Ctxt) -> format_hseq(Vs, ",", add_indent(Ctxt, 1), fun format/2), $>]. -format_bitstr(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Ctxt0) -> +format_bitstr(Node, Ctxt) -> + maybe_anno(Node, fun do_format_bitstr/2, Ctxt). + +do_format_bitstr(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Ctxt0) -> Vs = [S, U, T, Fs], Ctxt1 = add_indent(Ctxt0, 2), Val = format(V, Ctxt1), @@ -387,7 +409,7 @@ format_clause_1(#c_clause{pats=Ps,guard=G,body=B}, Ctxt) -> width(Ptxt, Ctxt) + 6))]; false -> [nl_indent(Ctxt2), "when ", - format_guard(G, add_indent(Ctxt2, 2))] + format_guard(G, add_indent(set_class(Ctxt2, expr), 2))] end++ " ->", nl_indent(Ctxt2) @@ -449,37 +471,46 @@ format_map_pair(Op, K, V, Ctxt0) -> Ctxt2 = add_indent(Ctxt0, width(Txt, Ctxt1)), [Txt,Op,format(V, Ctxt2)]. -indent(Ctxt) -> indent(Ctxt#ctxt.indent, Ctxt). - -indent(N, _) when N =< 0 -> ""; -indent(N, Ctxt) -> - T = Ctxt#ctxt.tab_width, - string:chars($\t, N div T, string:chars($\s, N rem T)). +indent(#ctxt{indent=N}) -> + if + N =< 0 -> + ""; + true -> + string:chars($\t, N div ?TAB_WIDTH, spaces(N rem ?TAB_WIDTH)) + end. nl_indent(Ctxt) -> [$\n|indent(Ctxt)]. +spaces(0) -> ""; +spaces(1) -> " "; +spaces(2) -> " "; +spaces(3) -> " "; +spaces(4) -> " "; +spaces(5) -> " "; +spaces(6) -> " "; +spaces(7) -> " ". unindent(T, Ctxt) -> - unindent(T, Ctxt#ctxt.indent, Ctxt, []). + unindent(T, Ctxt#ctxt.indent, []). -unindent(T, N, _, C) when N =< 0 -> +unindent(T, N, C) when N =< 0 -> [T|C]; -unindent([$\s|T], N, Ctxt, C) -> - unindent(T, N - 1, Ctxt, C); -unindent([$\t|T], N, Ctxt, C) -> - Tab = Ctxt#ctxt.tab_width, +unindent([$\s|T], N, C) -> + unindent(T, N - 1, C); +unindent([$\t|T], N, C) -> + Tab = ?TAB_WIDTH, if N >= Tab -> - unindent(T, N - Tab, Ctxt, C); + unindent(T, N - Tab, C); true -> - unindent([string:chars($\s, Tab - N)|T], 0, Ctxt, C) + unindent([spaces(Tab - N)|T], 0, C) end; -unindent([L|T], N, Ctxt, C) when is_list(L) -> - unindent(L, N, Ctxt, [T|C]); -unindent([H|T], _, _, C) -> +unindent([L|T], N, C) when is_list(L) -> + unindent(L, N, [T|C]); +unindent([H|T], _, C) -> [H|[T|C]]; -unindent([], N, Ctxt, [H|T]) -> - unindent(H, N, Ctxt, T); -unindent([], _, _, []) -> []. +unindent([], N, [H|T]) -> + unindent(H, N, T); +unindent([], _, []) -> []. width(Txt, Ctxt) -> @@ -488,7 +519,7 @@ width(Txt, Ctxt) -> end. width([$\t|T], A, Ctxt, C) -> - width(T, A + Ctxt#ctxt.tab_width, Ctxt, C); + width(T, A + ?TAB_WIDTH, Ctxt, C); width([$\n|T], _, Ctxt, C) -> width(unindent([T|C], Ctxt), Ctxt); width([H|T], A, Ctxt, C) when is_list(H) -> diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl index 2b89dc628c..936c5f6106 100644 --- a/lib/compiler/src/rec_env.erl +++ b/lib/compiler/src/rec_env.erl @@ -603,7 +603,8 @@ generate(_N, Range) -> %% same BEAM code. case rand:export_seed() of undefined -> - rand:seed(exsplus, {1,42,2053}); + _ = rand:seed(exsplus, {1,42,2053}), + ok; _ -> ok end, diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index de775097e3..83b3650180 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -510,8 +510,16 @@ unforce(_, Vs) -> Vs. exprs([E0|Es0], St0) -> {E1,Eps,St1} = expr(E0, St0), - {Es1,St2} = exprs(Es0, St1), - {Eps ++ [E1] ++ Es1,St2}; + case E1 of + #iprimop{name=#c_literal{val=match_fail}} -> + %% Must discard the rest of the body, because it + %% may refer to variables that have not been bound. + %% Example: {ok={error,E}} = foo(), E. + {Eps ++ [E1],St1}; + _ -> + {Es1,St2} = exprs(Es0, St1), + {Eps ++ [E1] ++ Es1,St2} + end; exprs([], St) -> {[],St}. %% expr(Expr, State) -> {Cexpr,[PreExp],State}. @@ -681,9 +689,14 @@ expr({match,L,P0,E0}, St0) -> Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])), case P2 of nomatch -> - St = add_warning(L, nomatch, St5), - {#icase{anno=#a{anno=Lanno}, - args=[E2],clauses=[],fc=Fc},Eps1++Eps2,St}; + St6 = add_warning(L, nomatch, St5), + {Expr,Eps3,St} = safe(E1, St6), + Eps = Eps1 ++ Eps2 ++ Eps3, + Badmatch = c_tuple([#c_literal{val=badmatch},Expr]), + Fail = #iprimop{anno=#a{anno=Lanno}, + name=#c_literal{val=match_fail}, + args=[Badmatch]}, + {Fail,Eps,St}; Other when not is_atom(Other) -> {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5} end; @@ -784,7 +797,7 @@ badmap_term(_Map, #core{in_guard=true}) -> %% since it is not user-visible. #c_literal{val=badmap}; badmap_term(Map, #core{in_guard=false}) -> - #c_tuple{es=[#c_literal{val=badmap},Map]}. + c_tuple([#c_literal{val=badmap},Map]). map_build_pairs(Map, Es0, Ann, St0) -> {Es,Pre,St1} = map_build_pairs_1(Es0, St0), diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 4446d5ff1d..4a6330fce4 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -401,7 +401,7 @@ expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) -> Call = #c_call{anno=A, module=#c_literal{val=erlang}, name=#c_literal{val=apply}, - args=[M0,F0,make_list(Cargs)]}, + args=[M0,F0,cerl:make_list(Cargs)]}, expr(Call, Sub, St1); _ -> {[M1,F1|Kargs],Ap,St} = atomic_list([M0,F0|Cargs], Sub, St1), @@ -496,7 +496,7 @@ translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) -> end. translate_fc(Args) -> - [#c_literal{val=function_clause},make_list(Args)]. + [#c_literal{val=function_clause},cerl:make_list(Args)]. expr_map(A,Var0,Ces,Sub,St0) -> {Var,Mps,St1} = expr(Var0, Sub, St0), @@ -1988,11 +1988,6 @@ pat_list_vars(Ps) -> {union(Used0, Used),union(New0, New)} end, {[],[]}, Ps). -make_list(Es) -> - foldr(fun(E, Acc) -> - #c_cons{hd=E,tl=Acc} - end, #c_literal{val=[]}, Es). - %% List of integers in interval [N,M]. Empty list if N > M. integers(N, M) when N =< M -> diff --git a/lib/compiler/test/beam_block_SUITE.erl b/lib/compiler/test/beam_block_SUITE.erl index a9bbe31b59..81f8d10687 100644 --- a/lib/compiler/test/beam_block_SUITE.erl +++ b/lib/compiler/test/beam_block_SUITE.erl @@ -21,7 +21,11 @@ -export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, init_per_group/2,end_per_group/2, - get_map_elements/1]). + get_map_elements/1,otp_7345/1]). + +%% The only test for the following functions is that +%% the code compiles and is accepted by beam_validator. +-export([encode_wildcards3/4,find_operands/4]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -64,3 +68,114 @@ get_map_elements([{Pred,Var}|Left], Map, Acc) -> end; get_map_elements([], _Map, Acc) -> Acc. + +%% The following code +%% +%% {get_list,{x,2},{x,0},{x,1}}. +%% {gc_bif,length,{f,0},1,[{x,0}],{x,0}}. +%% {move,{x,0},{x,1}}. +%% +%% was incorrectly optimized to +%% +%% {get_list,{x,2},{x,0},{y,0}}. +%% {gc_bif,length,{f,0},3,[{x,0}],{x,1}}. +%% +%% because beam_block:is_transparent({x,1}, +%% {gc_bif,length,{f,0},3,[{x,0}],{x,1}} +%% incorrectly returned true. + +-record(contextId,{cid,device_type,contextRef}). +-record(dpRef,{cid,tlli,ms_device_context_id}). +-record(qosProfileBssgp,{peak_bit_rate_msb, + peak_bit_rate_lsb, + t_a_precedence}). +-record(llUnitdataReq,{sapi, + l3_pdu_length, + pdu_life}). +-record(ptmsi,{value}). + +otp_7345(_Config) -> + #llUnitdataReq{l3_pdu_length=3,pdu_life=4} = + otp_7345(#contextId{}, 0, [[1,2,3],4,5]). + + +otp_7345(ObjRef, _RdEnv, Args) -> + Cid = ObjRef#contextId.cid, + _ = #dpRef{cid = Cid, + ms_device_context_id = cid_id, + tlli = #ptmsi{value = 0}}, + _ = #qosProfileBssgp{peak_bit_rate_msb = 0, + peak_bit_rate_lsb = 80, + t_a_precedence = 49}, + [Cpdu|_] = Args, + LlUnitdataReq = + #llUnitdataReq{sapi = 7, + l3_pdu_length = length(Cpdu), + pdu_life = + id(42) + div + 10}, + id(LlUnitdataReq). + +%%% +%%% The only test of the following code is that it compiles. +%%% + +%% Slightly simplifed from megaco_binary_term_id_gen. +%% beam_block failed to note that the {gc_bif,'-'...} instruction could +%% fail, and that therefore {y,0} need to be initialized. +%% {allocate,8,6}. +%% %% {init,{y,0}} needed here. +%% {get_list,{x,1},{x,6},{x,7}}. +%% {'catch',{y,7},{f,3}}. +%% {move,{x,4},{y,1}}. +%% {move,{x,3},{y,2}}. +%% {move,{x,2},{y,3}}. +%% {move,{x,5},{y,4}}. +%% {move,{x,7},{y,5}}. +%% {move,{x,6},{y,6}}. +%% {gc_bif,'-',{f,0},8,[{x,3},{x,6}],{x,0}}. +%% {move,{x,0},{y,0}}. + +encode_wildcards3([],[],_,_) -> []; +encode_wildcards3([Level|Levels],[BitsInLevel|BitsRest],LevelNo,TotSize) -> + case (catch ?MODULE:encode_wildcard(Level,BitsInLevel,TotSize-BitsInLevel, + length(Levels))) of + {'EXIT',{Reason,Info}} -> + exit({Reason,{LevelNo,Info}}); + + no_wildcard -> + encode_wildcards3(Levels,BitsRest,LevelNo+1,TotSize-BitsInLevel); + + {level,Wl} -> + [Wl| + encode_wildcards3(Levels,BitsRest,LevelNo+1,TotSize-BitsInLevel)]; + + {recursive,Wr} -> + [Wr] + end. + +%% Slightly simplified code from hipe_rtl_ssapre. +%% beam_block used to do the following incorrect optimization: +%% +%% {gc_bif,length,{f,0},1,[{x,0}],{x,3}}. +%% ^^^^^ Was {x,0} - changing to {x,3} is not safe. +%% {gc_bif,'+',{f,0},0,[{y,2},{integer,1}],{x,0}}. +%% ^^^ Only one register live +%% . . . +%% {call_last,4,{f,2},4}. %% beam_validator noted that {x,3} wasn't live. + +find_operands(Cfg,XsiGraph,[],_Count) -> + {Cfg,XsiGraph}; +find_operands(Cfg,XsiGraph,ActiveList,Count) -> + {NewCfg,TempActiveList}=?MODULE:find_operands_for_active_list(Cfg,XsiGraph, + ActiveList,[]), + NewActiveList=lists:reverse(TempActiveList), + [Count+1, length(NewActiveList), length(digraph:vertices(XsiGraph))], + find_operands(NewCfg,XsiGraph,NewActiveList,Count+1). + +%%% +%%% Common functions. +%%% + +id(I) -> I. diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl index 70c00f163c..6353ed3242 100644 --- a/lib/compiler/test/beam_utils_SUITE.erl +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -23,7 +23,7 @@ init_per_group/2,end_per_group/2, apply_fun/1,apply_mf/1,bs_init/1,bs_save/1, is_not_killed/1,is_not_used_at/1, - select/1,y_catch/1]). + select/1,y_catch/1,otp_8949_b/1,liveopt/1]). -export([id/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -41,7 +41,9 @@ groups() -> is_not_killed, is_not_used_at, select, - y_catch + y_catch, + otp_8949_b, + liveopt ]}]. init_per_suite(Config) -> @@ -232,6 +234,40 @@ do_y_catch_1(<<_,_/binary>>, _) -> do_y_catch_2(_) -> {a,b,c}. +otp_8949_b(_Config) -> + self() ! something, + value = otp_8949_b([], false), + {'EXIT',_} = (catch otp_8949_b([], true)), + ok. + +%% Would cause an endless loop in beam_utils. +otp_8949_b(A, B) -> + Var = id(value), + if + A == [], B == false -> + ok + end, + receive + something -> + id(Var) + end. + +-record(alarmInfo, {type,cause,origin}). + +liveopt(_Config) -> + F = liveopt_fun(42, pebkac, user), + void = F(42, #alarmInfo{type=sctp,cause=pebkac,origin=user}), + ok. + +liveopt_fun(Peer, Cause, Origin) -> + fun(PeerNo, AlarmInfo) + when PeerNo == Peer andalso + AlarmInfo == #alarmInfo{type=sctp, + cause=Cause, + origin=Origin} -> + void + end. + %% The identity function. id(I) -> I. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index c2d146a0b1..224abf6c29 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -24,11 +24,11 @@ -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, - fun_shadow/1,int_float/1,otp_5269/1,null_fields/1,wiger/1, + size_shadow/1,int_float/1,otp_5269/1,null_fields/1,wiger/1, bin_tail/1,save_restore/1, partitioned_bs_match/1,function_clause/1, unit/1,shared_sub_bins/1,bin_and_float/1, - dec_subidentifiers/1,skip_optional_tag/1, + dec_subidentifiers/1,skip_optional_tag/1,decode_integer/1, wfbm/1,degenerated_match/1,bs_sum/1,coverage/1, multiple_uses/1,zero_label/1,followed_by_catch/1, matching_meets_construction/1,simon/1,matching_and_andalso/1, @@ -38,7 +38,7 @@ no_partition/1,calling_a_binary/1,binary_in_map/1, match_string_opt/1,select_on_integer/1, map_and_binary/1,unsafe_branch_caching/1, - bad_literals/1,good_literals/1]). + bad_literals/1,good_literals/1,constant_propagation/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -56,11 +56,11 @@ all() -> groups() -> [{p,[parallel], - [fun_shadow,int_float,otp_5269,null_fields,wiger, + [size_shadow,int_float,otp_5269,null_fields,wiger, bin_tail,save_restore, partitioned_bs_match,function_clause,unit, shared_sub_bins,bin_and_float,dec_subidentifiers, - skip_optional_tag,wfbm,degenerated_match,bs_sum, + skip_optional_tag,decode_integer,wfbm,degenerated_match,bs_sum, coverage,multiple_uses,zero_label,followed_by_catch, matching_meets_construction,simon, matching_and_andalso,otp_7188,otp_7233,otp_7240, @@ -69,7 +69,7 @@ groups() -> no_partition,calling_a_binary,binary_in_map, match_string_opt,select_on_integer, map_and_binary,unsafe_branch_caching, - bad_literals,good_literals]}]. + bad_literals,good_literals,constant_propagation]}]. init_per_suite(Config) -> @@ -91,33 +91,54 @@ init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> ok. -fun_shadow(Config) when is_list(Config) -> - %% OTP-5270 - 7 = fun_shadow_1(), - 7 = fun_shadow_2(8), - 7 = fun_shadow_3(), - no = fun_shadow_4(8), +size_shadow(Config) when is_list(Config) -> + %% Originally OTP-5270. + 7 = size_shadow_1(), + 7 = size_shadow_2(8), + 7 = size_shadow_3(), + no = size_shadow_4(8), + Any = {any,term,goes}, + {2577,Any,-175,whatever} = + (size_shadow_5(Any, 12))(<<2577:12>>, -175, whatever), + {7777,Any,42,whatever} = + (size_shadow_6(Any, 13))(42, <<7777:13>>, whatever), + {<<45>>,<<>>} = size_shadow_7({int,1}, <<1:16,45>>), + {'EXIT',{function_clause,_}} = + (catch size_shadow_7({int,42}, <<1:16,45>>)), ok. -fun_shadow_1() -> +size_shadow_1() -> L = 8, F = fun(<<L:L,B:L>>) -> B end, F(<<16:8, 7:16>>). -fun_shadow_2(L) -> +size_shadow_2(L) -> F = fun(<<L:L,B:L>>) -> B end, F(<<16:8, 7:16>>). -fun_shadow_3() -> +size_shadow_3() -> L = 8, F = fun(<<L:L,B:L,L:L>>) -> B end, F(<<16:8, 7:16,16:16>>). -fun_shadow_4(L) -> +size_shadow_4(L) -> F = fun(<<L:L,B:L,L:L>>) -> B; (_) -> no end, F(<<16:8, 7:16,15:16>>). +size_shadow_5(X, Y) -> + fun (<< A:Y >>, Y, B) -> fum(A, X, Y, B) end. + +size_shadow_6(X, Y) -> + fun (Y, << A:Y >>, B) -> fum(A, X, Y, B) end. + +fum(A, B, C, D) -> + {A,B,C,D}. + +size_shadow_7({int,N}, <<N:16,B:N/binary,T/binary>>) -> + {B,T}. + + int_float(Config) when is_list(Config) -> %% OTP-5323 <<103133.0:64/float>> = <<103133:64/float>>, @@ -504,6 +525,23 @@ skip_optional_tag(<<Tag,RestTag/binary>>, <<Tag,Rest/binary>>) -> skip_optional_tag(RestTag, Rest); skip_optional_tag(_, _) -> missing. +decode_integer(_Config) -> + {10795,<<43>>,whatever} = decode_integer(1, <<42,43>>, whatever), + {-28909,<<19>>,whatever} = decode_integer(1, <<143,19>>, whatever), + ok. + +decode_integer(Len, <<B1:1,B2:7,Bs/binary>>, RemovedBytes) when B1 == 0 -> + Bin = <<_Skip:Len/unit:8, Buffer2/binary>> = <<B1:1,B2:7,Bs/binary>>, + Size = byte_size(Bin), + <<Int:Size/unit:8>> = Bin, + {Int,Buffer2,RemovedBytes}; +decode_integer(Len, <<B1:1,B2:7,Bs/binary>>, RemovedBytes) -> + Bin = <<_Skip:Len/unit:8,Buffer2/binary>> = <<B1:1,B2:7,Bs/binary>>, + Size = byte_size(Bin), + <<N:Size/unit:8>> = <<B2,Bs/binary>>, + Int = N - (1 bsl (8 * size(Bin) -1)), + {Int,Buffer2,RemovedBytes}. + -define(DATELEN, 16). wfbm(Config) when is_list(Config) -> @@ -1387,6 +1425,32 @@ good_literals(_Config) -> <<16#cafebeef:4/unit:8>> = id(<<16#cafebeef:32>>), ok. +constant_propagation(_Config) -> + <<5>> = constant_propagation_a(a, <<5>>), + {'EXIT',{{case_clause,b},_}} = (catch constant_propagation_a(b, <<5>>)), + 258 = constant_propagation_b(<<1,2>>), + F = constant_propagation_c(), + 259 = F(<<1,3>>), + ok. + +constant_propagation_a(X, Y) -> + case X of + a -> Y2 = 8 + end, + <<5:Y2>> = Y. + +constant_propagation_b(B) -> + Sz = 16, + <<X:Sz/integer>> = B, + X. + +constant_propagation_c() -> + Size = 16, + fun(Bin) -> + <<X:Size/integer>> = Bin, + X + end. + check(F, R) -> R = F(). diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 6961e625fd..cd1bc099e9 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -19,11 +19,48 @@ %%% Purpose : Compiles various modules with tough code -module(compilation_SUITE). +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + beam_compiler_4/1, + beam_compiler_6/1, + beam_compiler_7/1, + beam_compiler_8/1, + beam_compiler_9/1, + beam_compiler_10/1, + beam_compiler_11/1, + compiler_1/1, + const_list_256/1, + convopts/1, + live_var/1, + on_load/1, + on_load_inline/1, + opt_crash/1, + otp_2330/1, + otp_2380/1, + otp_4790/1, + otp_5151/1, + otp_5235/1, + otp_5404/1, + otp_5436/1, + otp_5481/1, + otp_5553/1, + otp_5632/1, + otp_5714/1, + otp_5872/1, + otp_6121/1, + otp_7202/1, + otp_8949_a/1, + redundant_case/1, + self_compile/1, + self_compile_old_inliner/1, + split_cases/1, + string_table/1, + vsn_1/1, + vsn_2/1, + vsn_3/1]). -include_lib("common_test/include/ct.hrl"). --compile(export_all). - suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,10}}]. @@ -37,23 +74,18 @@ groups() -> [{vsn,[parallel],[vsn_1,vsn_2,vsn_3]}, {p,test_lib:parallel(), [compiler_1, - compiler_3,compiler_5,beam_compiler_1, - beam_compiler_2,beam_compiler_3,beam_compiler_4, - beam_compiler_5,beam_compiler_6,beam_compiler_7, + beam_compiler_4,beam_compiler_6,beam_compiler_7, beam_compiler_8,beam_compiler_9,beam_compiler_10, - beam_compiler_11,beam_compiler_12, - nested_tuples_in_case_expr,otp_2330,guards, - {group,vsn},otp_2380,otp_2141,otp_2173,otp_4790, - const_list_256,bin_syntax_1,bin_syntax_2, - bin_syntax_3,bin_syntax_4,bin_syntax_5,bin_syntax_6, - live_var,convopts, - catch_in_catch,redundant_case,long_string,otp_5076, - complex_guard,otp_5092,otp_5151,otp_5235,otp_5244, - trycatch_4,opt_crash,otp_5404,otp_5436,otp_5481, + beam_compiler_11, + otp_2330, + {group,vsn},otp_2380,otp_4790, + const_list_256,live_var,convopts, + redundant_case, + otp_5151,otp_5235, + opt_crash,otp_5404,otp_5436,otp_5481, otp_5553,otp_5632,otp_5714,otp_5872,otp_6121, - otp_6121a,otp_6121b,otp_7202,otp_7345,on_load, - string_table,otp_8949_a,otp_8949_b,split_cases, - beam_utils_liveopt]}]. + otp_7202,on_load,on_load_inline, + string_table,otp_8949_a,split_cases]}]. init_per_suite(Config) -> Config. @@ -70,85 +102,25 @@ end_per_group(_GroupName, Config) -> -define(comp(N), N(Config) when is_list(Config) -> try_it(N, Config)). --define(comp_fail(N), - N(Config) when is_list(Config) -> failure(N, Config)). - ?comp(compiler_1). -?comp(compiler_3). -?comp(compiler_4). -?comp(compiler_5). -?comp(beam_compiler_1). -?comp(beam_compiler_2). -?comp(beam_compiler_3). ?comp(beam_compiler_4). -?comp(beam_compiler_5). ?comp(beam_compiler_6). ?comp(beam_compiler_8). ?comp(beam_compiler_9). ?comp(beam_compiler_10). ?comp(beam_compiler_11). -?comp(beam_compiler_12). -?comp(beam_compiler_13). - -?comp(nested_tuples_in_case_expr). ?comp(otp_2330). ?comp(otp_2380). -?comp(otp_2141). -?comp(otp_2173). ?comp(otp_4790). ?comp(otp_5235). -?comp(otp_5244). - -?comp(guards). - -?comp(pattern_expr). - ?comp(const_list_256). -?comp(bin_syntax_1). -?comp(bin_syntax_2). -?comp(bin_syntax_3). -?comp(bin_syntax_4). - -?comp(bin_syntax_6). - -?comp(otp_5076). - -?comp(complex_guard). - -?comp(otp_5092). ?comp(otp_5151). -%%% By Per Gustafsson <[email protected]> - -bin_syntax_5(Config) when is_list(Config) -> - {<<45>>,<<>>} = split({int, 1}, <<1:16,45>>). - -split({int, N}, <<N:16,B:N/binary,T/binary>>) -> - {B,T}. - -%% This program works with the old version of the compiler -%% but, the core erlang that it produces have the same variable appearing -%% looks like this: -%% -%% split({int, N}, <<_core1:16, B:N/binary, T/binary>>) when _core1==N -%% -%% with my change it will look like this: -%% -%% split({int, N}, <<_core1:16, B:_core1/binary, T/binary>>) when _core1==N -%% -%% This means that everything worked fine as long as the pattern -%% matching order was left-to-right but on core erlang any order should be possible - ?comp(live_var). - -?comp(trycatch_4). - -?comp(catch_in_catch). - ?comp(opt_crash). ?comp(otp_5404). @@ -159,8 +131,6 @@ split({int, N}, <<N:16,B:N/binary,T/binary>>) -> ?comp(otp_5714). ?comp(otp_5872). ?comp(otp_6121). -?comp(otp_6121a). -?comp(otp_6121b). ?comp(convopts). ?comp(otp_7202). ?comp(on_load). @@ -193,91 +163,38 @@ redundant_case_1(3) -> d; redundant_case_1(4) -> d; redundant_case_1(_) -> d. -failure(Module, Conf) -> - Src = filename:join(proplists:get_value(data_dir, Conf), - atom_to_list(Module)), - Out = proplists:get_value(priv_dir, Conf), - io:format("Compiling: ~ts\n", [Src]), - CompRc = compile:file(Src, [{outdir,Out},return,time]), - io:format("Result: ~p\n",[CompRc]), - case CompRc of - error -> ok; - {error,Errors,_} -> check_errors(Errors); - _ -> ct:fail({no_error, CompRc}) - end, - ok. - -check_errors([{_,Eds}|T]) -> - check_error(Eds), - check_errors(T); -check_errors([]) -> ok. - -check_error([{_,Mod,Error}|T]) -> - check_error_1(Mod:format_error(Error)), - check_error(T); -check_error([{Mod,Error}|T]) -> - check_error_1(Mod:format_error(Error)), - check_error(T); -check_error([]) -> ok. - -check_error_1(Str0) -> - Str = lists:flatten(Str0), - io:format("~s\n", [Str]), - case Str of - "internal"++_=Str -> - ct:fail(internal_compiler_error); - _ -> - ok - end. - --define(TC(Body), tc(fun() -> Body end, ?LINE)). - try_it(Module, Conf) -> - %% Change 'false' to 'true' to start a new node for every module. - try_it(false, Module, Conf). - -try_it(StartNode, Module, Conf) -> - try_it(StartNode, Module, {minutes,10}, Conf). - -try_it(StartNode, Module, Timetrap, Conf) -> + Timetrap = {minutes,10}, OtherOpts = [], %Can be changed to [time] if needed Src = filename:join(proplists:get_value(data_dir, Conf), atom_to_list(Module)), Out = proplists:get_value(priv_dir,Conf), io:format("Compiling: ~s\n", [Src]), - CompRc0 = compile:file(Src, [clint,{outdir,Out},report, - bin_opt_info|OtherOpts]), + CompRc0 = compile:file(Src, [clint0,clint,{outdir,Out},report, + bin_opt_info|OtherOpts]), io:format("Result: ~p\n",[CompRc0]), {ok,_Mod} = CompRc0, - Node = case StartNode of - false -> - node(); - true -> - Pa = "-pa " ++ filename:dirname(code:which(?MODULE)), - {ok,Node0} = start_node(compiler, Pa), - Node0 - end, - - ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), load_and_call(Out, Module), ct:timetrap(Timetrap), io:format("Compiling (without optimization): ~s\n", [Src]), CompRc1 = compile:file(Src, - [no_copt,no_postopt,{outdir,Out},report|OtherOpts]), + [no_copt,no_postopt, + {outdir,Out},report|OtherOpts]), io:format("Result: ~p\n",[CompRc1]), {ok,_Mod} = CompRc1, - ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), + load_and_call(Out, Module), ct:timetrap(Timetrap), io:format("Compiling (with old inliner): ~s\n", [Src]), - CompRc2 = compile:file(Src, [{outdir,Out},report,bin_opt_info, - {inline,1000}|OtherOpts]), + CompRc2 = compile:file(Src, [clint, + {outdir,Out},report,bin_opt_info, + {inline,1000}|OtherOpts]), io:format("Result: ~p\n",[CompRc2]), {ok,_Mod} = CompRc2, - ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), + load_and_call(Out, Module), ct:timetrap(Timetrap), io:format("Compiling (from assembly): ~s\n", [Src]), @@ -286,12 +203,8 @@ try_it(StartNode, Module, Timetrap, Conf) -> CompRc3 = compile:file(Asm, [from_asm,{outdir,Out},report|OtherOpts]), io:format("Result: ~p\n",[CompRc3]), {ok,_} = CompRc3, - ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), + load_and_call(Out, Module), - case StartNode of - false -> ok; - true -> test_server:stop_node(Node) - end, ok. load_and_call(Out, Module) -> @@ -319,24 +232,6 @@ load_and_call(Out, Module) -> ok. -tc(F, Line) -> - {Diff,Value} = timer:tc(erlang, apply, [F,[]]), - io:format("~p: ~p\n", [Line,Diff]), - Value. - -start_node(Name, Args) -> - case test_server:start_node(Name, slave, [{args, Args}]) of - {ok, Node} -> - {ok, Node}; - Error -> - ct:fail(Error) - end. - -from(H, [H | T]) -> T; -from(H, [_ | T]) -> from(H, T); -from(_, []) -> []. - - %% Test generation of 'vsn' attribute. vsn_1(Conf) when is_list(Conf) -> M = vsn_1, @@ -397,11 +292,6 @@ get_vsn(M) -> {vsn,V} = lists:keyfind(vsn, 1, M:module_info(attributes)), V. -long_string(Config) when is_list(Config) -> - %% The test must complete in one minute - it should be plenty of time. - try_it(false, long_string, {minutes,1}, Config), - ok. - compile_load(Module, Dir, Conf) -> Src = filename:join(Dir, atom_to_list(Module)), Out = proplists:get_value(priv_dir,Conf), @@ -465,6 +355,7 @@ compile_compiler(Files, OutDir, Version, InlineOpts) -> io:format("~ts", [code:which(compile)]), io:format("Compiling ~s into ~ts", [Version,OutDir]), Opts = [report, + clint0,clint, bin_opt_info, {outdir,OutDir}, {d,'COMPILER_VSN',"\""++Version++"\""}, @@ -480,10 +371,6 @@ compile_compiler(Files, OutDir, Version, InlineOpts) -> compiler_src() -> filelib:wildcard(filename:join([code:lib_dir(compiler), "src", "*.erl"])). -compiler_modules(Dir) -> - Files = filelib:wildcard(filename:join(Dir, "*.beam")), - [list_to_atom(filename:rootname(filename:basename(F))) || F <- Files]. - make_compiler_dir(Priv, Dir0) -> Dir = filename:join(Priv, Dir0), ok = file:make_dir(Dir), @@ -502,112 +389,6 @@ compare_compilers(ADir, BDir) -> ["beam_asm.beam"] = [filename:basename(A) || {A,_} <- D], ok. -%%% -%%% The only test of the following code is that it compiles. -%%% - -%% Slightly simplifed from megaco_binary_term_id_gen. -%% beam_block failed to note that the {gc_bif,'-'...} instruction could -%% fail, and that therefore {y,0} need to be initialized. -%% {allocate,8,6}. -%% %% {init,{y,0}} needed here. -%% {get_list,{x,1},{x,6},{x,7}}. -%% {'catch',{y,7},{f,3}}. -%% {move,{x,4},{y,1}}. -%% {move,{x,3},{y,2}}. -%% {move,{x,2},{y,3}}. -%% {move,{x,5},{y,4}}. -%% {move,{x,7},{y,5}}. -%% {move,{x,6},{y,6}}. -%% {gc_bif,'-',{f,0},8,[{x,3},{x,6}],{x,0}}. -%% {move,{x,0},{y,0}}. - -encode_wildcards3([],[],_,_) -> []; -encode_wildcards3([Level|Levels],[BitsInLevel|BitsRest],LevelNo,TotSize) -> - case (catch ?MODULE:encode_wildcard(Level,BitsInLevel,TotSize-BitsInLevel, - length(Levels))) of - {'EXIT',{Reason,Info}} -> - exit({Reason,{LevelNo,Info}}); - - no_wildcard -> - encode_wildcards3(Levels,BitsRest,LevelNo+1,TotSize-BitsInLevel); - - {level,Wl} -> - [Wl| - encode_wildcards3(Levels,BitsRest,LevelNo+1,TotSize-BitsInLevel)]; - - {recursive,Wr} -> - [Wr] - end. - -%% Slightly simplified code from hipe_rtl_ssapre. -%% beam_block used to do the following incorrect optimization: -%% -%% {gc_bif,length,{f,0},1,[{x,0}],{x,3}}. -%% ^^^^^ Was {x,0} - changing to {x,3} is not safe. -%% {gc_bif,'+',{f,0},0,[{y,2},{integer,1}],{x,0}}. -%% ^^^ Only one register live -%% . . . -%% {call_last,4,{f,2},4}. %% beam_validator noted that {x,3} wasn't live. - -find_operands(Cfg,XsiGraph,[],_Count) -> - {Cfg,XsiGraph}; -find_operands(Cfg,XsiGraph,ActiveList,Count) -> - {NewCfg,TempActiveList}=?MODULE:find_operands_for_active_list(Cfg,XsiGraph, - ActiveList,[]), - NewActiveList=lists:reverse(TempActiveList), - [Count+1, length(NewActiveList), length(digraph:vertices(XsiGraph))], - find_operands(NewCfg,XsiGraph,NewActiveList,Count+1). - - -%% The following code -%% -%% {get_list,{x,2},{x,0},{x,1}}. -%% {gc_bif,length,{f,0},1,[{x,0}],{x,0}}. -%% {move,{x,0},{x,1}}. -%% -%% was incorrectly optimized to -%% -%% {get_list,{x,2},{x,0},{y,0}}. -%% {gc_bif,length,{f,0},3,[{x,0}],{x,1}}. -%% -%% because beam_block:is_transparent({x,1}, -%% {gc_bif,length,{f,0},3,[{x,0}],{x,1}} -%% incorrectly returned true. - --record(contextId,{cid,device_type,contextRef}). --record(dpRef,{cid,tlli,ms_device_context_id}). --record(qosProfileBssgp,{peak_bit_rate_msb, - peak_bit_rate_lsb, - t_a_precedence}). --record(llUnitdataReq,{sapi, - l3_pdu_length, - pdu_life}). --record(ptmsi,{value}). - -otp_7345(Config) when is_list(Config) -> - #llUnitdataReq{l3_pdu_length=3,pdu_life=4} = - otp_7345(#contextId{}, 0, [[1,2,3],4,5]). - - -otp_7345(ObjRef, _RdEnv, Args) -> - Cid = ObjRef#contextId.cid, - _ = #dpRef{cid = Cid, - ms_device_context_id = cid_id, - tlli = #ptmsi{value = 0}}, - _ = #qosProfileBssgp{peak_bit_rate_msb = 0, - peak_bit_rate_lsb = 80, - t_a_precedence = 49}, - [Cpdu|_] = Args, - LlUnitdataReq = - #llUnitdataReq{sapi = 7, - l3_pdu_length = length(Cpdu), - pdu_life = - id(42) - div - 10}, - id(LlUnitdataReq). - %% Check the generation of the string table. string_table(Config) when is_list(Config) -> @@ -640,24 +421,6 @@ do_otp_8949_a() -> end end. -otp_8949_b(Config) when is_list(Config) -> - self() ! something, - value = otp_8949_b([], false), - {'EXIT',_} = (catch otp_8949_b([], true)), - ok. - -%% Would cause an endless loop in beam_utils. -otp_8949_b(A, B) -> - Var = id(value), - if - A == [], B == false -> - ok - end, - receive - something -> - id(Var) - end. - split_cases(_) -> dummy1 = do_split_cases(x), {'EXIT',{{badmatch,b},_}} = (catch do_split_cases(y)), @@ -673,21 +436,5 @@ do_split_cases(A) -> end, Z. --record(alarmInfo, {type,cause,origin}). - -beam_utils_liveopt(Config) -> - F = beam_utils_liveopt_fun(42, pebkac, user), - void = F(42, #alarmInfo{type=sctp,cause=pebkac,origin=user}), - ok. - -beam_utils_liveopt_fun(Peer, Cause, Origin) -> - fun(PeerNo, AlarmInfo) - when PeerNo == Peer andalso - AlarmInfo == #alarmInfo{type=sctp, - cause=Cause, - origin=Origin} -> - void - end. - id(I) -> I. diff --git a/lib/compiler/test/compilation_SUITE_data/beam_compiler_1.erl b/lib/compiler/test/compilation_SUITE_data/beam_compiler_1.erl deleted file mode 100644 index 3e2891a28d..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/beam_compiler_1.erl +++ /dev/null @@ -1,32 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(beam_compiler_1). --export([beam_compiler_1/0]). - -beam_compiler_1() -> - ok. - --record(foo,{a,b}). - -try_me() -> - X = #foo{}, - Y = #foo{}, - {X#foo.a == Y#foo.a,X#foo.b}. - diff --git a/lib/compiler/test/compilation_SUITE_data/beam_compiler_12.erl b/lib/compiler/test/compilation_SUITE_data/beam_compiler_12.erl deleted file mode 100644 index d34291159a..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/beam_compiler_12.erl +++ /dev/null @@ -1,30 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(beam_compiler_12). - --export([?MODULE/0,t/1]). - -?MODULE() -> - ok. - -t(Name) -> - {ok = {file_info,_,regular,_,AccTime1,ModTime1,_,_,_,_,_,_,_,_}} = - prim_file:read_file_info(Name). - diff --git a/lib/compiler/test/compilation_SUITE_data/beam_compiler_2.erl b/lib/compiler/test/compilation_SUITE_data/beam_compiler_2.erl deleted file mode 100644 index 473529bb58..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/beam_compiler_2.erl +++ /dev/null @@ -1,36 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(beam_compiler_2). --export([beam_compiler_2/0]). - -beam_compiler_2() -> - ok. - --record(foo,{a,b}). - -try_me() -> - try_me({foo,x,z},{foo,y,z}). - -try_me(X,Y) -> - f(X#foo.a =/= Y#foo.a,X#foo.b =/= X#foo.b). - -f(A,B) -> - A. - diff --git a/lib/compiler/test/compilation_SUITE_data/beam_compiler_3.erl b/lib/compiler/test/compilation_SUITE_data/beam_compiler_3.erl deleted file mode 100644 index bdc4ec06e5..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/beam_compiler_3.erl +++ /dev/null @@ -1,30 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(beam_compiler_3). --export([beam_compiler_3/0, f/0]). - -%% From Ulf Wiger. - -beam_compiler_3() -> - ok. - -f() -> - [_|T] = lists:reverse("xxx"), - T. diff --git a/lib/compiler/test/compilation_SUITE_data/beam_compiler_5.erl b/lib/compiler/test/compilation_SUITE_data/beam_compiler_5.erl deleted file mode 100644 index 7289d2b553..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/beam_compiler_5.erl +++ /dev/null @@ -1,29 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(beam_compiler_5). --export([beam_compiler_5/0]). - --compile(export_all). - -beam_compiler_5() -> - ok. - -t() -> - [_|_] = x. diff --git a/lib/compiler/test/compilation_SUITE_data/bin_syntax_1.erl b/lib/compiler/test/compilation_SUITE_data/bin_syntax_1.erl deleted file mode 100644 index 72f6a0cee6..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/bin_syntax_1.erl +++ /dev/null @@ -1,32 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(bin_syntax_1). - --export([f/2,?MODULE/0]). - -?MODULE() -> - ok. - -f(X, Y) -> - case X of - a -> - Y2 = 8 - end, - <<5:Y2>> = Y. diff --git a/lib/compiler/test/compilation_SUITE_data/bin_syntax_2.erl b/lib/compiler/test/compilation_SUITE_data/bin_syntax_2.erl deleted file mode 100644 index cd0c2a4b0e..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/bin_syntax_2.erl +++ /dev/null @@ -1,42 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(bin_syntax_2). - --export([?MODULE/0]). - -%% This module tests that constant propagation is done properly. - -?MODULE() -> - 258 = b(<<1,2>>), - F = c(), - 259 = F(<<1,3>>), - ok. - -b(B) -> - Sz = 16, - <<X:Sz/integer>> = B, - X. - -c() -> - Size = 16, - fun(Bin) -> - <<X:Size/integer>> = Bin, - X - end. diff --git a/lib/compiler/test/compilation_SUITE_data/bin_syntax_3.erl b/lib/compiler/test/compilation_SUITE_data/bin_syntax_3.erl deleted file mode 100644 index b3118e0adc..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/bin_syntax_3.erl +++ /dev/null @@ -1,36 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(bin_syntax_3). --export([?MODULE/0,decode_integer/3]). - -?MODULE() -> - ok. - -decode_integer(Len, <<B1:1,B2:7,Bs/binary>>, RemovedBytes) when B1 == 0 -> - Bin = <<Skip:Len/unit:8, Buffer2/binary>> = <<B1:1,B2:7,Bs/binary>>, - Size = size(Bin), - <<Int:Size/unit:8>> = Bin, - {Int,Buffer2,RemovedBytes}; -decode_integer(Len,<<B1:1,B2:7,Bs/binary>>,RemovedBytes) -> - Bin = <<Skip:Len/unit:8,Buffer2/binary>> = <<B1:1,B2:7,Bs/binary>>, - Size = size(Bin), - <<N:Size/unit:8>> = <<B2,Bs/binary>>, - Int = N - (1 bsl (8 * size(Bin) -1)), - {Int,Buffer2,RemovedBytes}. diff --git a/lib/compiler/test/compilation_SUITE_data/bin_syntax_4.erl b/lib/compiler/test/compilation_SUITE_data/bin_syntax_4.erl deleted file mode 100644 index 185d6ec3b0..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/bin_syntax_4.erl +++ /dev/null @@ -1,33 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(bin_syntax_4). --export([?MODULE/0,f4b/2,f4c/2]). - -?MODULE() -> - ok. - -f4b(X, Y) -> - fun (<< A:Y >>, Y, B) -> fum(A, X, Y, B) end. - -f4c(X, Y) -> - fun (Y, << A:Y >>, B) -> fum(A, X, Y, B) end. - -fum(A, B, C, D) -> - {A,B,C,D}. diff --git a/lib/compiler/test/compilation_SUITE_data/bin_syntax_6.erl b/lib/compiler/test/compilation_SUITE_data/bin_syntax_6.erl deleted file mode 100644 index 1841a2ee0a..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/bin_syntax_6.erl +++ /dev/null @@ -1,40 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(bin_syntax_6). --export([?MODULE/0,x/1,y/1]). - -?MODULE() -> - ok. - -x(X) -> - blurf(), - B = {X,"OK",<<>>}, - catch b({a,B}). - -y(X) -> - blurf(), - B = {X,"OK",<<42>>}, - catch b({a,B}). - -blurf() -> - ok. - -b(_) -> - ok. diff --git a/lib/compiler/test/compilation_SUITE_data/catch_in_catch.erl b/lib/compiler/test/compilation_SUITE_data/catch_in_catch.erl deleted file mode 100644 index 05ef45f105..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/catch_in_catch.erl +++ /dev/null @@ -1,52 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(catch_in_catch). - --export([?MODULE/0,do_start/1]). - -?MODULE() -> - process_flag(trap_exit, true), - Pid = spawn_link(?MODULE, do_start, [x]), - receive - {'EXIT',Pid,good_exit} -> ok; - Other -> - io:format("Unexpected: ~p\n", [Other]), - error - after 32000 -> - io:format("No message received\n"), - error - end. - -do_start(Param) -> - init(Param), - exit(good_exit). - -init(Param) -> - process_flag(trap_exit, true), - %% The catches were improperly nested, causing a "No catch found" crash. - (catch begin - foo(Param), - (catch exit(bar)) - end - ), - ignore. - -foo(_) -> - ok. diff --git a/lib/compiler/test/compilation_SUITE_data/compiler_3.erl b/lib/compiler/test/compilation_SUITE_data/compiler_3.erl deleted file mode 100644 index 698a0f26f3..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/compiler_3.erl +++ /dev/null @@ -1,34 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(compiler_3). --export([compiler_3/0]). --record(rec,{a}). - -compiler_3() -> - guard_record(). - -guard_record() -> - 1=func(#rec{}), - {'EXIT',_} = (catch func({rec})), - ok. - -func(X) when record(X, -rec) -> - 1. diff --git a/lib/compiler/test/compilation_SUITE_data/compiler_5.erl b/lib/compiler/test/compilation_SUITE_data/compiler_5.erl deleted file mode 100644 index de3c2ec4ce..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/compiler_5.erl +++ /dev/null @@ -1,50 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(compiler_5). --export([compiler_5/0]). - -compiler_5() -> - f0(), - f1(), - f2(), - ok. - -%% compiler treats records with 1 and 2 fields differently... --record(nil, {}). --record(foo, {hello=1}). --record(bar, {hello=2,there=3}). - -f0() -> - R1 = #nil{}, - R2 = R1#nil{}, %% stupid code, but compiler shouldn't crash - R1 = R2, - ok. - -f1() -> - R1 = #foo{}, - R2 = R1#foo{}, %% stupid code, but compiler shouldn't crash - R1 = R2, - ok. - -f2() -> - R1 = #bar{}, - R2 = R1#bar{}, %% stupid code, but compiler shouldn't crash - R1 = R2, - ok. diff --git a/lib/compiler/test/compilation_SUITE_data/complex_guard.erl b/lib/compiler/test/compilation_SUITE_data/complex_guard.erl deleted file mode 100644 index f1b88c2bd2..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/complex_guard.erl +++ /dev/null @@ -1,32 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(complex_guard). - --compile(export_all). - -?MODULE() -> - ok. - -f(X1,Y1,Z1) -> - if - ((X1 =:= 4) or (X1 =:= 5)) and ((Y1 =:= 4) or (Y1 =:= 5)) and ((Z1 =:= 4) or (Z1 =:= 5)) or ((X1 =:= 1) or (X1 =:= 2) or (X1 =:= 3)) and ((Y1 =:= 1) or (Y1 =:= 2) or (Y1 =:= 3)) and ((Z1 =:= 1) or (Z1 =:= 2) or (Z1 =:= 3)) -> - true - end. - diff --git a/lib/compiler/test/compilation_SUITE_data/guards.erl b/lib/compiler/test/compilation_SUITE_data/guards.erl deleted file mode 100644 index a507add790..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/guards.erl +++ /dev/null @@ -1,107 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(guards). - --export([guards/0]). - -guards() -> - ok = t(), - ok = f(), - ok = ct(1), - ok = multi(1), - ok = multi(2), - ok = multi(3). - -%% The following tests are always true. -t() when integer(42) -> - ok; -t() when float(2.0) -> - ok; -t() when number(7) -> - ok; -t() when number(3.14) -> - ok; -t() when atom(error) -> - ok; -t() when list([a]) -> - ok; -t() when tuple({}) -> - ok; -t() when tuple({1, 2}) -> - ok. - -%% The following tests are always false. -f() when integer(a) -> - ok; -f() when float(b) -> - ok; -f() when number(c) -> - ok; -f() when atom(42) -> - ok; -f() when list(33) -> - ok; -f() when list({}) -> - ok; -f() when list({1, 2}) -> - ok; -f() when tuple(33) -> - ok; -f() when tuple([a]) -> - ok; -f() when tuple([]) -> - ok; -f() when tuple(35) -> - ok; -f() -> - ok. - -%% The following tests are always true. -ct(X) -> - case X of - Y when integer(42) -> - ok; - Y when float(2.0) -> - ok; - Y when number(7) -> - ok; - Y when number(3.14) -> - ok; - Y when atom(error) -> - ok; - Y when list([a]) -> - ok; - Y when tuple({}) -> - ok; - Y when tuple({1, 2}) -> - ok - end. - -multi(X) -> - case X of - Y when float(Y) ; integer(Y) -> - ok; - Y when Y > 1, Y < 10 ; atom(Y) -> - ok; - Y when Y == 4, number(Y) ; list(Y) -> - pannkaka; - Y when Y==3 ; Y==5 ; Y==6 -> - ok - end. diff --git a/lib/compiler/test/compilation_SUITE_data/long_string.erl b/lib/compiler/test/compilation_SUITE_data/long_string.erl deleted file mode 100644 index fe109c8e4f..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/long_string.erl +++ /dev/null @@ -1,671 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(long_string). - --export([?MODULE/0]). - -?MODULE() -> - Options = "some stupid long string", - 49252 = length(generate(Options, "348927432097sfkjfkljf329")), - ok. - -generate(Options, Glurf) -> - "asdhfaslfdjhhwleirsk e4kjhr430usduy fdk;///s llsjkf;laskjfsdfkjasdfkj -sdkljflasdfkjasldkfjasd" ++ Options ++ -"CSAgICAgICBWZXJzaW9uIDIsIEp1bmUgMTk5MQoKIENvcHlyaWdodCAoQykgMTk4OSwgMTk5MSBG -cmVlIFNvZnR3YXJlIEZvdW5kYXRpb24sIEluYy4KICAgICAgICAgICAgICAgICAgICAgICA1OSBU -ZW1wbGUgUGxhY2UsIFN1aXRlIDMzMCwgQm9zdG9uLCBNQSAgMDIxMTEtMTMwNyAgVVNBCiBFdmVy -eW9uZSBpcyBwZXJtaXR0ZWQgdG8gY29weSBhbmQgZGlzdHJpYnV0ZSB2ZXJiYXRpbSBjb3BpZXMK -IG9mIHRoaXMgbGljZW5zZSBkb2N1bWVudCwgYnV0IGNoYW5naW5nIGl0IGlzIG5vdCBhbGxvd2Vk -LgoKCQkJICAgIFByZWFtYmxlCgogIFRoZSBsaWNlbnNlcyBmb3IgbW9zdCBzb2Z0d2FyZSBhcmUg -ZGVzaWduZWQgdG8gdGFrZSBhd2F5IHlvdXIKZnJlZWRvbSB0byBzaGFyZSBhbmQgY2hhbmdlIGl0 -LiAgQnkgY29udHJhc3QsIHRoZSBHTlUgR2VuZXJhbCBQdWJsaWMKTGljZW5zZSBpcyBpbnRlbmRl -ZCB0byBndWFyYW50ZWUgeW91ciBmcmVlZG9tIHRvIHNoYXJlIGFuZCBjaGFuZ2UgZnJlZQpzb2Z0 -d2FyZS0tdG8gbWFrZSBzdXJlIHRoZSBzb2Z0d2FyZSBpcyBmcmVlIGZvciBhbGwgaXRzIHVzZXJz -LiAgVGhpcwpHZW5lcmFsIFB1YmxpYyBMaWNlbnNlIGFwcGxpZXMgdG8gbW9zdCBvZiB0aGUgRnJl -ZSBTb2Z0d2FyZQpGb3VuZGF0aW9uJ3Mgc29mdHdhcmUgYW5kIHRvIGFueSBvdGhlciBwcm9ncmFt -IHdob3NlIGF1dGhvcnMgY29tbWl0IHRvCnVzaW5nIGl0LiAgKFNvbWUgb3RoZXIgRnJlZSBTb2Z0 -d2FyZSBGb3VuZGF0aW9uIHNvZnR3YXJlIGlzIGNvdmVyZWQgYnkKdGhlIEdOVSBMaWJyYXJ5IEdl -bmVyYWwgUHVibGljIExpY2Vuc2UgaW5zdGVhZC4pICBZb3UgY2FuIGFwcGx5IGl0IHRvCnlvdXIg -cHJvZ3JhbXMsIHRvby4KCiAgV2hlbiB3ZSBzcGVhayBvZiBmcmVlIHNvZnR3YXJlLCB3ZSBhcmUg -cmVmZXJyaW5nIHRvIGZyZWVkb20sIG5vdApwcmljZS4gIE91ciBHZW5lcmFsIFB1YmxpYyBMaWNl -bnNlcyBhcmUgZGVzaWduZWQgdG8gbWFrZSBzdXJlIHRoYXQgeW91CmhhdmUgdGhlIGZyZWVkb20g -dG8gZGlzdHJpYnV0ZSBjb3BpZXMgb2YgZnJlZSBzb2Z0d2FyZSAoYW5kIGNoYXJnZSBmb3IKdGhp -cyBzZXJ2aWNlIGlmIHlvdSB3aXNoKSwgdGhhdCB5b3UgcmVjZWl2ZSBzb3VyY2UgY29kZSBvciBj -YW4gZ2V0IGl0CmlmIHlvdSB3YW50IGl0LCB0aGF0IHlvdSBjYW4gY2hhbmdlIHRoZSBzb2Z0d2Fy -ZSBvciB1c2UgcGllY2VzIG9mIGl0CmluIG5ldyBmcmVlIHByb2dyYW1zOyBhbmQgdGhhdCB5b3Ug -a25vdyB5b3UgY2FuIGRvIHRoZXNlIHRoaW5ncy4KCiAgVG8gcHJvdGVjdCB5b3VyIHJpZ2h0cywg -d2UgbmVlZCB0byBtYWtlIHJlc3RyaWN0aW9ucyB0aGF0IGZvcmJpZAphbnlvbmUgdG8gZGVueSB5 -b3UgdGhlc2UgcmlnaHRzIG9yIHRvIGFzayB5b3UgdG8gc3VycmVuZGVyIHRoZSByaWdodHMuClRo -ZXNlIHJlc3RyaWN0aW9ucyB0cmFuc2xhdGUgdG8gY2VydGFpbiByZXNwb25zaWJpbGl0aWVzIGZv -ciB5b3UgaWYgeW91CmRpc3RyaWJ1dGUgY29waWVzIG9mIHRoZSBzb2Z0d2FyZSwgb3IgaWYgeW91 -IG1vZGlmeSBpdC4KCiAgRm9yIGV4YW1wbGUsIGlmIHlvdSBkaXN0cmlidXRlIGNvcGllcyBvZiBz -dWNoIGEgcHJvZ3JhbSwgd2hldGhlcgpncmF0aXMgb3IgZm9yIGEgZmVlLCB5b3UgbXVzdCBnaXZl -IHRoZSByZWNpcGllbnRzIGFsbCB0aGUgcmlnaHRzIHRoYXQKeW91IGhhdmUuICBZb3UgbXVzdCBt -YWtlIHN1cmUgdGhhdCB0aGV5LCB0b28sIHJlY2VpdmUgb3IgY2FuIGdldCB0aGUKc291cmNlIGNv -ZGUuICBBbmQgeW91IG11c3Qgc2hvdyB0aGVtIHRoZXNlIHRlcm1zIHNvIHRoZXkga25vdyB0aGVp -cgpyaWdodHMuCgogIFdlIHByb3RlY3QgeW91ciByaWdodHMgd2l0aCB0d28gc3RlcHM6ICgxKSBj -b3B5cmlnaHQgdGhlIHNvZnR3YXJlLCBhbmQKKDIpIG9mZmVyIHlvdSB0aGlzIGxpY2Vuc2Ugd2hp -Y2ggZ2l2ZXMgeW91IGxlZ2FsIHBlcm1pc3Npb24gdG8gY29weSwKZGlzdHJpYnV0ZSBhbmQvb3Ig -bW9kaWZ5IHRoZSBzb2Z0d2FyZS4KCiAgQWxzbywgZm9yIGVhY2ggYXV0aG9yJ3MgcHJvdGVjdGlv -biBhbmQgb3Vycywgd2Ugd2FudCB0byBtYWtlIGNlcnRhaW4KdGhhdCBldmVyeW9uZSB1bmRlcnN0 -YW5kcyB0aGF0IHRoZXJlIGlzIG5vIHdhcnJhbnR5IGZvciB0aGlzIGZyZWUKc29mdHdhcmUuICBJ -ZiB0aGUgc29mdHdhcmUgaXMgbW9kaWZpZWQgYnkgc29tZW9uZSBlbHNlIGFuZCBwYXNzZWQgb24s -IHdlCndhbnQgaXRzIHJlY2lwaWVudHMgdG8ga25vdyB0aGF0IHdoYXQgdGhleSBoYXZlIGlzIG5v -dCB0aGUgb3JpZ2luYWwsIHNvCnRoYXQgYW55IHByb2JsZW1zIGludHJvZHVjZWQgYnkgb3RoZXJz -IHdpbGwgbm90IHJlZmxlY3Qgb24gdGhlIG9yaWdpbmFsCmF1dGhvcnMnIHJlcHV0YXRpb25zLgoK -ICBGaW5hbGx5LCBhbnkgZnJlZSBwcm9ncmFtIGlzIHRocmVhdGVuZWQgY29uc3RhbnRseSBieSBz -b2Z0d2FyZQpwYXRlbnRzLiAgV2Ugd2lzaCB0byBhdm9pZCB0aGUgZGFuZ2VyIHRoYXQgcmVkaXN0 -cmlidXRvcnMgb2YgYSBmcmVlCnByb2dyYW0gd2lsbCBpbmRpdmlkdWFsbHkgb2J0YWluIHBhdGVu -dCBsaWNlbnNlcywgaW4gZWZmZWN0IG1ha2luZyB0aGUKcHJvZ3JhbSBwcm9wcmlldGFyeS4gIFRv -IHByZXZlbnQgdGhpcywgd2UgaGF2ZSBtYWRlIGl0IGNsZWFyIHRoYXQgYW55CnBhdGVudCBtdXN0 -IGJlIGxpY2Vuc2VkIGZvciBldmVyeW9uZSdzIGZyZWUgdXNlIG9yIG5vdCBsaWNlbnNlZCBhdCBh -bGwuCgogIFRoZSBwcmVjaXNlIHRlcm1zIGFuZCBjb25kaXRpb25zIGZvciBjb3B5aW5nLCBkaXN0 -cmlidXRpb24gYW5kCm1vZGlmaWNhdGlvbiBmb2xsb3cuCgwKCQkgICAgR05VIEdFTkVSQUwgUFVC -TElDIExJQ0VOU0UKICAgVEVSTVMgQU5EIENPTkRJVElPTlMgRk9SIENPUFlJTkcsIERJU1RSSUJV -VElPTiBBTkQgTU9ESUZJQ0FUSU9OCgogIDAuIFRoaXMgTGljZW5zZSBhcHBsaWVzIHRvIGFueSBw -cm9ncmFtIG9yIG90aGVyIHdvcmsgd2hpY2ggY29udGFpbnMKYSBub3RpY2UgcGxhY2VkIGJ5IHRo -ZSBjb3B5cmlnaHQgaG9sZGVyIHNheWluZyBpdCBtYXkgYmUgZGlzdHJpYnV0ZWQKdW5kZXIgdGhl -IHRlcm1zIG9mIHRoaXMgR2VuZXJhbCBQdWJsaWMgTGljZW5zZS4gIFRoZSAiUHJvZ3JhbSIsIGJl -bG93LApyZWZlcnMgdG8gYW55IHN1Y2ggcHJvZ3JhbSBvciB3b3JrLCBhbmQgYSAid29yayBiYXNl -ZCBvbiB0aGUgUHJvZ3JhbSIKbWVhbnMgZWl0aGVyIHRoZSBQcm9ncmFtIG9yIGFueSBkZXJpdmF0 -aXZlIHdvcmsgdW5kZXIgY29weXJpZ2h0IGxhdzoKdGhhdCBpcyB0byBzYXksIGEgd29yayBjb250 -YWluaW5nIHRoZSBQcm9ncmFtIG9yIGEgcG9ydGlvbiBvZiBpdCwKZWl0aGVyIHZlcmJhdGltIG9y -IHdpdGggbW9kaWZpY2F0aW9ucyBhbmQvb3IgdHJhbnNsYXRlZCBpbnRvIGFub3RoZXIKbGFuZ3Vh -Z2UuICAoSGVyZWluYWZ0ZXIsIHRyYW5zbGF0aW9uIGlzIGluY2x1ZGVkIHdpdGhvdXQgbGltaXRh -dGlvbiBpbgp0aGUgdGVybSAibW9kaWZpY2F0aW9uIi4pICBFYWNoIGxpY2Vuc2VlIGlzIGFkZHJl -c3NlZCBhcyAieW91Ii4KCkFjdGl2aXRpZXMgb3RoZXIgdGhhbiBjb3B5aW5nLCBkaXN0cmlidXRp -b24gYW5kIG1vZGlmaWNhdGlvbiBhcmUgbm90CmNvdmVyZWQgYnkgdGhpcyBMaWNlbnNlOyB0aGV5 -IGFyZSBvdXRzaWRlIGl0cyBzY29wZS4gIFRoZSBhY3Qgb2YKcnVubmluZyB0aGUgUHJvZ3JhbSBp -cyBub3QgcmVzdHJpY3RlZCwgYW5kIHRoZSBvdXRwdXQgZnJvbSB0aGUgUHJvZ3JhbQppcyBjb3Zl -cmVkIG9ubHkgaWYgaXRzIGNvbnRlbnRzIGNvbnN0aXR1dGUgYSB3b3JrIGJhc2VkIG9uIHRoZQpQ -cm9ncmFtIChpbmRlcGVuZGVudCBvZiBoYXZpbmcgYmVlbiBtYWRlIGJ5IHJ1bm5pbmcgdGhlIFBy -b2dyYW0pLgpXaGV0aGVyIHRoYXQgaXMgdHJ1ZSBkZXBlbmRzIG9uIHdoYXQgdGhlIFByb2dyYW0g -ZG9lcy4KCiAgMS4gWW91IG1heSBjb3B5IGFuZCBkaXN0cmlidXRlIHZlcmJhdGltIGNvcGllcyBv -ZiB0aGUgUHJvZ3JhbSdzCnNvdXJjZSBjb2RlIGFzIHlvdSByZWNlaXZlIGl0LCBpbiBhbnkgbWVk -aXVtLCBwcm92aWRlZCB0aGF0IHlvdQpjb25zcGljdW91c2x5IGFuZCBhcHByb3ByaWF0ZWx5IHB1 -Ymxpc2ggb24gZWFjaCBjb3B5IGFuIGFwcHJvcHJpYXRlCmNvcHlyaWdodCBub3RpY2UgYW5kIGRp -c2NsYWltZXIgb2Ygd2FycmFudHk7IGtlZXAgaW50YWN0IGFsbCB0aGUKbm90aWNlcyB0aGF0IHJl -ZmVyIHRvIHRoaXMgTGljZW5zZSBhbmQgdG8gdGhlIGFic2VuY2Ugb2YgYW55IHdhcnJhbnR5Owph -bmQgZ2l2ZSBhbnkgb3RoZXIgcmVjaXBpZW50cyBvZiB0aGUgUHJvZ3JhbSBhIGNvcHkgb2YgdGhp -cyBMaWNlbnNlCmFsb25nIHdpdGggdGhlIFByb2dyYW0uCgpZb3UgbWF5IGNoYXJnZSBhIGZlZSBm -b3IgdGhlIHBoeXNpY2FsIGFjdCBvZiB0cmFuc2ZlcnJpbmcgYSBjb3B5LCBhbmQKeW91IG1heSBh -dCB5b3VyIG9wdGlvbiBvZmZlciB3YXJyYW50eSBwcm90ZWN0aW9uIGluIGV4Y2hhbmdlIGZvciBh -IGZlZS4KCiAgMi4gWW91IG1heSBtb2RpZnkgeW91ciBjb3B5IG9yIGNvcGllcyBvZiB0aGUgUHJv -Z3JhbSBvciBhbnkgcG9ydGlvbgpvZiBpdCwgdGh1cyBmb3JtaW5nIGEgd29yayBiYXNlZCBvbiB0 -aGUgUHJvZ3JhbSwgYW5kIGNvcHkgYW5kCmRpc3RyaWJ1dGUgc3VjaCBtb2RpZmljYXRpb25zIG9y -IHdvcmsgdW5kZXIgdGhlIHRlcm1zIG9mIFNlY3Rpb24gMQphYm92ZSwgcHJvdmlkZWQgdGhhdCB5 -b3UgYWxzbyBtZWV0IGFsbCBvZiB0aGVzZSBjb25kaXRpb25zOgoKICAgIGEpIFlvdSBtdXN0IGNh -dXNlIHRoZSBtb2RpZmllZCBmaWxlcyB0byBjYXJyeSBwcm9taW5lbnQgbm90aWNlcwogICAgc3Rh -dGluZyB0aGF0IHlvdSBjaGFuZ2VkIHRoZSBmaWxlcyBhbmQgdGhlIGRhdGUgb2YgYW55IGNoYW5n -ZS4KCiAgICBiKSBZb3UgbXVzdCBjYXVzZSBhbnkgd29yayB0aGF0IHlvdSBkaXN0cmlidXRlIG9y -IHB1Ymxpc2gsIHRoYXQgaW4KICAgIHdob2xlIG9yIGluIHBhcnQgY29udGFpbnMgb3IgaXMgZGVy -aXZlZCBmcm9tIHRoZSBQcm9ncmFtIG9yIGFueQogICAgcGFydCB0aGVyZW9mLCB0byBiZSBsaWNl -bnNlZCBhcyBhIHdob2xlIGF0IG5vIGNoYXJnZSB0byBhbGwgdGhpcmQKICAgIHBhcnRpZXMgdW5k -ZXIgdGhlIHRlcm1zIG9mIHRoaXMgTGljZW5zZS4KCiAgICBjKSBJZiB0aGUgbW9kaWZpZWQgcHJv -Z3JhbSBub3JtYWxseSByZWFkcyBjb21tYW5kcyBpbnRlcmFjdGl2ZWx5CiAgICB3aGVuIHJ1biwg -eW91IG11c3QgY2F1c2UgaXQsIHdoZW4gc3RhcnRlZCBydW5uaW5nIGZvciBzdWNoCiAgICBpbnRl -cmFjdGl2ZSB1c2UgaW4gdGhlIG1vc3Qgb3JkaW5hcnkgd2F5LCB0byBwcmludCBvciBkaXNwbGF5 -IGFuCiAgICBhbm5vdW5jZW1lbnQgaW5jbHVkaW5nIGFuIGFwcHJvcHJpYXRlIGNvcHlyaWdodCBu -b3RpY2UgYW5kIGEKICAgIG5vdGljZSB0aGF0IHRoZXJlIGlzIG5vIHdhcnJhbnR5IChvciBlbHNl -LCBzYXlpbmcgdGhhdCB5b3UgcHJvdmlkZQogICAgYSB3YXJyYW50eSkgYW5kIHRoYXQgdXNlcnMg -bWF5IHJlZGlzdHJpYnV0ZSB0aGUgcHJvZ3JhbSB1bmRlcgogICAgdGhlc2UgY29uZGl0aW9ucywg -YW5kIHRlbGxpbmcgdGhlIHVzZXIgaG93IHRvIHZpZXcgYSBjb3B5IG9mIHRoaXMKICAgIExpY2Vu -c2UuICAoRXhjZXB0aW9uOiBpZiB0aGUgUHJvZ3JhbSBpdHNlbGYgaXMgaW50ZXJhY3RpdmUgYnV0 -CiAgICBkb2VzIG5vdCBub3JtYWxseSBwcmludCBzdWNoIGFuIGFubm91bmNlbWVudCwgeW91ciB3 -b3JrIGJhc2VkIG9uCiAgICB0aGUgUHJvZ3JhbSBpcyBub3QgcmVxdWlyZWQgdG8gcHJpbnQgYW4g -YW5ub3VuY2VtZW50LikKDApUaGVzZSByZXF1aXJlbWVudHMgYXBwbHkgdG8gdGhlIG1vZGlmaWVk -IHdvcmsgYXMgYSB3aG9sZS4gIElmCmlkZW50aWZpYWJsZSBzZWN0aW9ucyBvZiB0aGF0IHdvcmsg -YXJlIG5vdCBkZXJpdmVkIGZyb20gdGhlIFByb2dyYW0sCmFuZCBjYW4gYmUgcmVhc29uYWJseSBj -b25zaWRlcmVkIGluZGVwZW5kZW50IGFuZCBzZXBhcmF0ZSB3b3JrcyBpbgp0aGVtc2VsdmVzLCB0 -aGVuIHRoaXMgTGljZW5zZSwgYW5kIGl0cyB0ZXJtcywgZG8gbm90IGFwcGx5IHRvIHRob3NlCnNl -Y3Rpb25zIHdoZW4geW91IGRpc3RyaWJ1dGUgdGhlbSBhcyBzZXBhcmF0ZSB3b3Jrcy4gIEJ1dCB3 -aGVuIHlvdQpkaXN0cmlidXRlIHRoZSBzYW1lIHNlY3Rpb25zIGFzIHBhcnQgb2YgYSB3aG9sZSB3 -aGljaCBpcyBhIHdvcmsgYmFzZWQKb24gdGhlIFByb2dyYW0sIHRoZSBkaXN0cmlidXRpb24gb2Yg -dGhlIHdob2xlIG11c3QgYmUgb24gdGhlIHRlcm1zIG9mCnRoaXMgTGljZW5zZSwgd2hvc2UgcGVy -bWlzc2lvbnMgZm9yIG90aGVyIGxpY2Vuc2VlcyBleHRlbmQgdG8gdGhlCmVudGlyZSB3aG9sZSwg -YW5kIHRodXMgdG8gZWFjaCBhbmQgZXZlcnkgcGFydCByZWdhcmRsZXNzIG9mIHdobyB3cm90ZSBp -dC4KClRodXMsIGl0IGlzIG5vdCB0aGUgaW50ZW50IG9mIHRoaXMgc2VjdGlvbiB0byBjbGFpbSBy -aWdodHMgb3IgY29udGVzdAp5b3VyIHJpZ2h0cyB0byB3b3JrIHdyaXR0ZW4gZW50aXJlbHkgYnkg -eW91OyByYXRoZXIsIHRoZSBpbnRlbnQgaXMgdG8KZXhlcmNpc2UgdGhlIHJpZ2h0IHRvIGNvbnRy -b2wgdGhlIGRpc3RyaWJ1dGlvbiBvZiBkZXJpdmF0aXZlIG9yCmNvbGxlY3RpdmUgd29ya3MgYmFz -ZWQgb24gdGhlIFByb2dyYW0uCgpJbiBhZGRpdGlvbiwgbWVyZSBhZ2dyZWdhdGlvbiBvZiBhbm90 -aGVyIHdvcmsgbm90IGJhc2VkIG9uIHRoZSBQcm9ncmFtCndpdGggdGhlIFByb2dyYW0gKG9yIHdp -dGggYSB3b3JrIGJhc2VkIG9uIHRoZSBQcm9ncmFtKSBvbiBhIHZvbHVtZSBvZgphIHN0b3JhZ2Ug -b3IgZGlzdHJpYnV0aW9uIG1lZGl1bSBkb2VzIG5vdCBicmluZyB0aGUgb3RoZXIgd29yayB1bmRl -cgp0aGUgc2NvcGUgb2YgdGhpcyBMaWNlbnNlLgoKICAzLiBZb3UgbWF5IGNvcHkgYW5kIGRpc3Ry -aWJ1dGUgdGhlIFByb2dyYW0gKG9yIGEgd29yayBiYXNlZCBvbiBpdCwKdW5kZXIgU2VjdGlvbiAy -KSBpbiBvYmplY3QgY29kZSBvciBleGVjdXRhYmxlIGZvcm0gdW5kZXIgdGhlIHRlcm1zIG9mClNl -Y3Rpb25zIDEgYW5kIDIgYWJvdmUgcHJvdmlkZWQgdGhhdCB5b3UgYWxzbyBkbyBvbmUgb2YgdGhl -IGZvbGxvd2luZzoKCiAgICBhKSBBY2NvbXBhbnkgaXQgd2l0aCB0aGUgY29tcGxldGUgY29ycmVz -cG9uZGluZyBtYWNoaW5lLXJlYWRhYmxlCiAgICBzb3VyY2UgY29kZSwgd2hpY2ggbXVzdCBiZSBk -aXN0cmlidXRlZCB1bmRlciB0aGUgdGVybXMgb2YgU2VjdGlvbnMKICAgIDEgYW5kIDIgYWJvdmUg -b24gYSBtZWRpdW0gY3VzdG9tYXJpbHkgdXNlZCBmb3Igc29mdHdhcmUgaW50ZXJjaGFuZ2U7IG9y -LAoKICAgIGIpIEFjY29tcGFueSBpdCB3aXRoIGEgd3JpdHRlbiBvZmZlciwgdmFsaWQgZm9yIGF0 -IGxlYXN0IHRocmVlCiAgICB5ZWFycywgdG8gZ2l2ZSBhbnkgdGhpcmQgcGFydHksIGZvciBhIGNo -YXJnZSBubyBtb3JlIHRoYW4geW91cgogICAgY29zdCBvZiBwaHlzaWNhbGx5IHBlcmZvcm1pbmcg -c291cmNlIGRpc3RyaWJ1dGlvbiwgYSBjb21wbGV0ZQogICAgbWFjaGluZS1yZWFkYWJsZSBjb3B5 -IG9mIHRoZSBjb3JyZXNwb25kaW5nIHNvdXJjZSBjb2RlLCB0byBiZQogICAgZGlzdHJpYnV0ZWQg -dW5kZXIgdGhlIHRlcm1zIG9mIFNlY3Rpb25zIDEgYW5kIDIgYWJvdmUgb24gYSBtZWRpdW0KICAg -IGN1c3RvbWFyaWx5IHVzZWQgZm9yIHNvZnR3YXJlIGludGVyY2hhbmdlOyBvciwKCiAgICBjKSBB -Y2NvbXBhbnkgaXQgd2l0aCB0aGUgaW5mb3JtYXRpb24geW91IHJlY2VpdmVkIGFzIHRvIHRoZSBv -ZmZlcgogICAgdG8gZGlzdHJpYnV0ZSBjb3JyZXNwb25kaW5nIHNvdXJjZSBjb2RlLiAgKFRoaXMg -YWx0ZXJuYXRpdmUgaXMKICAgIGFsbG93ZWQgb25seSBmb3Igbm9uY29tbWVyY2lhbCBkaXN0cmli -dXRpb24gYW5kIG9ubHkgaWYgeW91CiAgICByZWNlaXZlZCB0aGUgcHJvZ3JhbSBpbiBvYmplY3Qg -Y29kZSBvciBleGVjdXRhYmxlIGZvcm0gd2l0aCBzdWNoCiAgICBhbiBvZmZlciwgaW4gYWNjb3Jk -IHdpdGggU3Vic2VjdGlvbiBiIGFib3ZlLikKClRoZSBzb3VyY2UgY29kZSBmb3IgYSB3b3JrIG1l -YW5zIHRoZSBwcmVmZXJyZWQgZm9ybSBvZiB0aGUgd29yayBmb3IKbWFraW5nIG1vZGlmaWNhdGlv -bnMgdG8gaXQuICBGb3IgYW4gZXhlY3V0YWJsZSB3b3JrLCBjb21wbGV0ZSBzb3VyY2UKY29kZSBt -ZWFucyBhbGwgdGhlIHNvdXJjZSBjb2RlIGZvciBhbGwgbW9kdWxlcyBpdCBjb250YWlucywgcGx1 -cyBhbnkKYXNzb2NpYXRlZCBpbnRlcmZhY2UgZGVmaW5pdGlvbiBmaWxlcywgcGx1cyB0aGUgc2Ny -aXB0cyB1c2VkIHRvCmNvbnRyb2wgY29tcGlsYXRpb24gYW5kIGluc3RhbGxhdGlvbiBvZiB0aGUg -ZXhlY3V0YWJsZS4gIEhvd2V2ZXIsIGFzIGEKc3BlY2lhbCBleGNlcHRpb24sIHRoZSBzb3VyY2Ug -Y29kZSBkaXN0cmlidXRlZCBuZWVkIG5vdCBpbmNsdWRlCmFueXRoaW5nIHRoYXQgaXMgbm9ybWFs -bHkgZGlzdHJpYnV0ZWQgKGluIGVpdGhlciBzb3VyY2Ugb3IgYmluYXJ5CmZvcm0pIHdpdGggdGhl -IG1ham9yIGNvbXBvbmVudHMgKGNvbXBpbGVyLCBrZXJuZWwsIGFuZCBzbyBvbikgb2YgdGhlCm9w -ZXJhdGluZyBzeXN0ZW0gb24gd2hpY2ggdGhlIGV4ZWN1dGFibGUgcnVucywgdW5sZXNzIHRoYXQg -Y29tcG9uZW50Cml0c2VsZiBhY2NvbXBhbmllcyB0aGUgZXhlY3V0YWJsZS4KCklmIGRpc3RyaWJ1 -dGlvbiBvZiBleGVjdXRhYmxlIG9yIG9iamVjdCBjb2RlIGlzIG1hZGUgYnkgb2ZmZXJpbmcKYWNj -ZXNzIHRvIGNvcHkgZnJvbSBhIGRlc2lnbmF0ZWQgcGxhY2UsIHRoZW4gb2ZmZXJpbmcgZXF1aXZh -bGVudAphY2Nlc3MgdG8gY29weSB0aGUgc291cmNlIGNvZGUgZnJvbSB0aGUgc2FtZSBwbGFjZSBj -b3VudHMgYXMKZGlzdHJpYnV0aW9uIG9mIHRoZSBzb3VyY2UgY29kZSwgZXZlbiB0aG91Z2ggdGhp -cmQgcGFydGllcyBhcmUgbm90CmNvbXBlbGxlZCB0byBjb3B5IHRoZSBzb3VyY2UgYWxvbmcgd2l0 -aCB0aGUgb2JqZWN0IGNvZGUuCgwKICA0LiBZb3UgbWF5IG5vdCBjb3B5LCBtb2RpZnksIHN1Ymxp -Y2Vuc2UsIG9yIGRpc3RyaWJ1dGUgdGhlIFByb2dyYW0KZXhjZXB0IGFzIGV4cHJlc3NseSBwcm92 -aWRlZCB1bmRlciB0aGlzIExpY2Vuc2UuICBBbnkgYXR0ZW1wdApvdGhlcndpc2UgdG8gY29weSwg -bW9kaWZ5LCBzdWJsaWNlbnNlIG9yIGRpc3RyaWJ1dGUgdGhlIFByb2dyYW0gaXMKdm9pZCwgYW5k -IHdpbGwgYXV0b21hdGljYWxseSB0ZXJtaW5hdGUgeW91ciByaWdodHMgdW5kZXIgdGhpcyBMaWNl -bnNlLgpIb3dldmVyLCBwYXJ0aWVzIHdobyBoYXZlIHJlY2VpdmVkIGNvcGllcywgb3IgcmlnaHRz -LCBmcm9tIHlvdSB1bmRlcgp0aGlzIExpY2Vuc2Ugd2lsbCBub3QgaGF2ZSB0aGVpciBsaWNlbnNl -cyB0ZXJtaW5hdGVkIHNvIGxvbmcgYXMgc3VjaApwYXJ0aWVzIHJlbWFpbiBpbiBmdWxsIGNvbXBs -aWFuY2UuCgogIDUuIFlvdSBhcmUgbm90IHJlcXVpcmVkIHRvIGFjY2VwdCB0aGlzIExpY2Vuc2Us -IHNpbmNlIHlvdSBoYXZlIG5vdApzaWduZWQgaXQuICBIb3dldmVyLCBub3RoaW5nIGVsc2UgZ3Jh -bnRzIHlvdSBwZXJtaXNzaW9uIHRvIG1vZGlmeSBvcgpkaXN0cmlidXRlIHRoZSBQcm9ncmFtIG9y -IGl0cyBkZXJpdmF0aXZlIHdvcmtzLiAgVGhlc2UgYWN0aW9ucyBhcmUKcHJvaGliaXRlZCBieSBs -YXcgaWYgeW91IGRvIG5vdCBhY2NlcHQgdGhpcyBMaWNlbnNlLiAgVGhlcmVmb3JlLCBieQptb2Rp -Znlpbmcgb3IgZGlzdHJpYnV0aW5nIHRoZSBQcm9ncmFtIChvciBhbnkgd29yayBiYXNlZCBvbiB0 -aGUKUHJvZ3JhbSksIHlvdSBpbmRpY2F0ZSB5b3VyIGFjY2VwdGFuY2Ugb2YgdGhpcyBMaWNlbnNl -IHRvIGRvIHNvLCBhbmQKYWxsIGl0cyB0ZXJtcyBhbmQgY29uZGl0aW9ucyBmb3IgY29weWluZywg -ZGlzdHJpYnV0aW5nIG9yIG1vZGlmeWluZwp0aGUgUHJvZ3JhbSBvciB3b3JrcyBiYXNlZCBvbiBp -dC4KCiAgNi4gRWFjaCB0aW1lIHlvdSByZWRpc3RyaWJ1dGUgdGhlIFByb2dyYW0gKG9yIGFueSB3 -b3JrIGJhc2VkIG9uIHRoZQpQcm9ncmFtKSwgdGhlIHJlY2lwaWVudCBhdXRvbWF0aWNhbGx5IHJl -Y2VpdmVzIGEgbGljZW5zZSBmcm9tIHRoZQpvcmlnaW5hbCBsaWNlbnNvciB0byBjb3B5LCBkaXN0 -cmlidXRlIG9yIG1vZGlmeSB0aGUgUHJvZ3JhbSBzdWJqZWN0IHRvCnRoZXNlIHRlcm1zIGFuZCBj -b25kaXRpb25zLiAgWW91IG1heSBub3QgaW1wb3NlIGFueSBmdXJ0aGVyCnJlc3RyaWN0aW9ucyBv -biB0aGUgcmVjaXBpZW50cycgZXhlcmNpc2Ugb2YgdGhlIHJpZ2h0cyBncmFudGVkIGhlcmVpbi4K -WW91IGFyZSBub3QgcmVzcG9uc2libGUgZm9yIGVuZm9yY2luZyBjb21wbGlhbmNlIGJ5IHRoaXJk -IHBhcnRpZXMgdG8KdGhpcyBMaWNlbnNlLgoKICA3LiBJZiwgYXMgYSBjb25zZXF1ZW5jZSBvZiBh -IGNvdXJ0IGp1ZGdtZW50IG9yIGFsbGVnYXRpb24gb2YgcGF0ZW50CmluZnJpbmdlbWVudCBvciBm -b3IgYW55IG90aGVyIHJlYXNvbiAobm90IGxpbWl0ZWQgdG8gcGF0ZW50IGlzc3VlcyksCmNvbmRp -dGlvbnMgYXJlIGltcG9zZWQgb24geW91ICh3aGV0aGVyIGJ5IGNvdXJ0IG9yZGVyLCBhZ3JlZW1l -bnQgb3IKb3RoZXJ3aXNlKSB0aGF0IGNvbnRyYWRpY3QgdGhlIGNvbmRpdGlvbnMgb2YgdGhpcyBM -aWNlbnNlLCB0aGV5IGRvIG5vdApleGN1c2UgeW91IGZyb20gdGhlIGNvbmRpdGlvbnMgb2YgdGhp -cyBMaWNlbnNlLiAgSWYgeW91IGNhbm5vdApkaXN0cmlidXRlIHNvIGFzIHRvIHNhdGlzZnkgc2lt -dWx0YW5lb3VzbHkgeW91ciBvYmxpZ2F0aW9ucyB1bmRlciB0aGlzCkxpY2Vuc2UgYW5kIGFueSBv -dGhlciBwZXJ0aW5lbnQgb2JsaWdhdGlvbnMsIHRoZW4gYXMgYSBjb25zZXF1ZW5jZSB5b3UKbWF5 -IG5vdCBkaXN0cmlidXRlIHRoZSBQcm9ncmFtIGF0IGFsbC4gIEZvciBleGFtcGxlLCBpZiBhIHBh -dGVudApsaWNlbnNlIHdvdWxkIG5vdCBwZXJtaXQgcm95YWx0eS1mcmVlIHJlZGlzdHJpYnV0aW9u -IG9mIHRoZSBQcm9ncmFtIGJ5CmFsbCB0aG9zZSB3aG8gcmVjZWl2ZSBjb3BpZXMgZGlyZWN0bHkg -b3IgaW5kaXJlY3RseSB0aHJvdWdoIHlvdSwgdGhlbgp0aGUgb25seSB3YXkgeW91IGNvdWxkIHNh -dGlzZnkgYm90aCBpdCBhbmQgdGhpcyBMaWNlbnNlIHdvdWxkIGJlIHRvCnJlZnJhaW4gZW50aXJl -bHkgZnJvbSBkaXN0cmlidXRpb24gb2YgdGhlIFByb2dyYW0uCgpJZiBhbnkgcG9ydGlvbiBvZiB0 -aGlzIHNlY3Rpb24gaXMgaGVsZCBpbnZhbGlkIG9yIHVuZW5mb3JjZWFibGUgdW5kZXIKYW55IHBh -cnRpY3VsYXIgY2lyY3Vtc3RhbmNlLCB0aGUgYmFsYW5jZSBvZiB0aGUgc2VjdGlvbiBpcyBpbnRl -bmRlZCB0bwphcHBseSBhbmQgdGhlIHNlY3Rpb24gYXMgYSB3aG9sZSBpcyBpbnRlbmRlZCB0byBh -cHBseSBpbiBvdGhlcgpjaXJjdW1zdGFuY2VzLgoKSXQgaXMgbm90IHRoZSBwdXJwb3NlIG9mIHRo -aXMgc2VjdGlvbiB0byBpbmR1Y2UgeW91IHRvIGluZnJpbmdlIGFueQpwYXRlbnRzIG9yIG90aGVy -IHByb3BlcnR5IHJpZ2h0IGNsYWltcyBvciB0byBjb250ZXN0IHZhbGlkaXR5IG9mIGFueQpzdWNo -IGNsYWltczsgdGhpcyBzZWN0aW9uIGhhcyB0aGUgc29sZSBwdXJwb3NlIG9mIHByb3RlY3Rpbmcg -dGhlCmludGVncml0eSBvZiB0aGUgZnJlZSBzb2Z0d2FyZSBkaXN0cmlidXRpb24gc3lzdGVtLCB3 -aGljaCBpcwppbXBsZW1lbnRlZCBieSBwdWJsaWMgbGljZW5zZSBwcmFjdGljZXMuICBNYW55IHBl -b3BsZSBoYXZlIG1hZGUKZ2VuZXJvdXMgY29udHJpYnV0aW9ucyB0byB0aGUgd2lkZSByYW5nZSBv -ZiBzb2Z0d2FyZSBkaXN0cmlidXRlZAp0aHJvdWdoIHRoYXQgc3lzdGVtIGluIHJlbGlhbmNlIG9u -IGNvbnNpc3RlbnQgYXBwbGljYXRpb24gb2YgdGhhdApzeXN0ZW07IGl0IGlzIHVwIHRvIHRoZSBh -dXRob3IvZG9ub3IgdG8gZGVjaWRlIGlmIGhlIG9yIHNoZSBpcyB3aWxsaW5nCnRvIGRpc3RyaWJ1 -dGUgc29mdHdhcmUgdGhyb3VnaCBhbnkgb3RoZXIgc3lzdGVtIGFuZCBhIGxpY2Vuc2VlIGNhbm5v -dAppbXBvc2UgdGhhdCBjaG9pY2UuCgpUaGlzIHNlY3Rpb24gaXMgaW50ZW5kZWQgdG8gbWFrZSB0 -aG9yb3VnaGx5IGNsZWFyIHdoYXQgaXMgYmVsaWV2ZWQgdG8KYmUgYSBjb25zZXF1ZW5jZSBvZiB0 -aGUgcmVzdCBvZiB0aGlzIExpY2Vuc2UuCgwKICA4LiBJZiB0aGUgZGlzdHJpYnV0aW9uIGFuZC9v -ciB1c2Ugb2YgdGhlIFByb2dyYW0gaXMgcmVzdHJpY3RlZCBpbgpjZXJ0YWluIGNvdW50cmllcyBl -aXRoZXIgYnkgcGF0ZW50cyBvciBieSBjb3B5cmlnaHRlZCBpbnRlcmZhY2VzLCB0aGUKb3JpZ2lu -YWwgY29weXJpZ2h0IGhvbGRlciB3aG8gcGxhY2VzIHRoZSBQcm9ncmFtIHVuZGVyIHRoaXMgTGlj -ZW5zZQptYXkgYWRkIGFuIGV4cGxpY2l0IGdlb2dyYXBoaWNhbCBkaXN0cmlidXRpb24gbGltaXRh -dGlvbiBleGNsdWRpbmcKdGhvc2UgY291bnRyaWVzLCBzbyB0aGF0IGRpc3RyaWJ1dGlvbiBpcyBw -ZXJtaXR0ZWQgb25seSBpbiBvciBhbW9uZwpjb3VudHJpZXMgbm90IHRodXMgZXhjbHVkZWQuICBJ -biBzdWNoIGNhc2UsIHRoaXMgTGljZW5zZSBpbmNvcnBvcmF0ZXMKdGhlIGxpbWl0YXRpb24gYXMg -aWYgd3JpdHRlbiBpbiB0aGUgYm9keSBvZiB0aGlzIExpY2Vuc2UuCgogIDkuIFRoZSBGcmVlIFNv -ZnR3YXJlIEZvdW5kYXRpb24gbWF5IHB1Ymxpc2ggcmV2aXNlZCBhbmQvb3IgbmV3IHZlcnNpb25z -Cm9mIHRoZSBHZW5lcmFsIFB1YmxpYyBMaWNlbnNlIGZyb20gdGltZSB0byB0aW1lLiAgU3VjaCBu -ZXcgdmVyc2lvbnMgd2lsbApiZSBzaW1pbGFyIGluIHNwaXJpdCB0byB0aGUgcHJlc2VudCB2ZXJz -aW9uLCBidXQgbWF5IGRpZmZlciBpbiBkZXRhaWwgdG8KYWRkcmVzcyBuZXcgcHJvYmxlbXMgb3Ig -Y29uY2VybnMuCgpFYWNoIHZlcnNpb24gaXMgZ2l2ZW4gYSBkaXN0aW5ndWlzaGluZyB2ZXJzaW9u -IG51bWJlci4gIElmIHRoZSBQcm9ncmFtCnNwZWNpZmllcyBhIHZlcnNpb24gbnVtYmVyIG9mIHRo -aXMgTGljZW5zZSB3aGljaCBhcHBsaWVzIHRvIGl0IGFuZCAiYW55CmxhdGVyIHZlcnNpb24iLCB5 -b3UgaGF2ZSB0aGUgb3B0aW9uIG9mIGZvbGxvd2luZyB0aGUgdGVybXMgYW5kIGNvbmRpdGlvbnMK -ZWl0aGVyIG9mIHRoYXQgdmVyc2lvbiBvciBvZiBhbnkgbGF0ZXIgdmVyc2lvbiBwdWJsaXNoZWQg -YnkgdGhlIEZyZWUKU29mdHdhcmUgRm91bmRhdGlvbi4gIElmIHRoZSBQcm9ncmFtIGRvZXMgbm90 -IHNwZWNpZnkgYSB2ZXJzaW9uIG51bWJlciBvZgp0aGlzIExpY2Vuc2UsIHlvdSBtYXkgY2hvb3Nl -IGFueSB2ZXJzaW9uIGV2ZXIgcHVibGlzaGVkIGJ5IHRoZSBGcmVlIFNvZnR3YXJlCkZvdW5kYXRp -b24uCgogIDEwLiBJZiB5b3Ugd2lzaCB0byBpbmNvcnBvcmF0ZSBwYXJ0cyBvZiB0aGUgUHJvZ3Jh -bSBpbnRvIG90aGVyIGZyZWUKcHJvZ3JhbXMgd2hvc2UgZGlzdHJpYnV0aW9uIGNvbmRpdGlvbnMg -YXJlIGRpZmZlcmVudCwgd3JpdGUgdG8gdGhlIGF1dGhvcgp0byBhc2sgZm9yIHBlcm1pc3Npb24u -ICBGb3Igc29mdHdhcmUgd2hpY2ggaXMgY29weXJpZ2h0ZWQgYnkgdGhlIEZyZWUKU29mdHdhcmUg -Rm91bmRhdGlvbiwgd3JpdGUgdG8gdGhlIEZyZWUgU29mdHdhcmUgRm91bmRhdGlvbjsgd2Ugc29t -ZXRpbWVzCm1ha2UgZXhjZXB0aW9ucyBmb3IgdGhpcy4gIE91ciBkZWNpc2lvbiB3aWxsIGJlIGd1 -aWRlZCBieSB0aGUgdHdvIGdvYWxzCm9mIHByZXNlcnZpbmcgdGhlIGZyZWUgc3RhdHVzIG9mIGFs -bCBkZXJpdmF0aXZlcyBvZiBvdXIgZnJlZSBzb2Z0d2FyZSBhbmQKb2YgcHJvbW90aW5nIHRoZSBz -aGFyaW5nIGFuZCByZXVzZSBvZiBzb2Z0d2FyZSBnZW5lcmFsbHkuCgoJCQkgICAgTk8gV0FSUkFO -VFkKCiAgMTEuIEJFQ0FVU0UgVEhFIFBST0dSQU0gSVMgTElDRU5TRUQgRlJFRSBPRiBDSEFSR0Us -IFRIRVJFIElTIE5PIFdBUlJBTlRZCkZPUiBUSEUgUFJPR1JBTSwgVE8gVEhFIEVYVEVOVCBQRVJN -SVRURUQgQlkgQVBQTElDQUJMRSBMQVcuICBFWENFUFQgV0hFTgpPVEhFUldJU0UgU1RBVEVEIElO -IFdSSVRJTkcgVEhFIENPUFlSSUdIVCBIT0xERVJTIEFORC9PUiBPVEhFUiBQQVJUSUVTClBST1ZJ -REUgVEhFIFBST0dSQU0gIkFTIElTIiBXSVRIT1VUIFdBUlJBTlRZIE9GIEFOWSBLSU5ELCBFSVRI -RVIgRVhQUkVTU0VECk9SIElNUExJRUQsIElOQ0xVRElORywgQlVUIE5PVCBMSU1JVEVEIFRPLCBU -SEUgSU1QTElFRCBXQVJSQU5USUVTIE9GCk1FUkNIQU5UQUJJTElUWSBBTkQgRklUTkVTUyBGT1Ig -QSBQQVJUSUNVTEFSIFBVUlBPU0UuICBUSEUgRU5USVJFIFJJU0sgQVMKVE8gVEhFIFFVQUxJVFkg -QU5EIFBFUkZPUk1BTkNFIE9GIFRIRSBQUk9HUkFNIElTIFdJVEggWU9VLiAgU0hPVUxEIFRIRQpQ -Uk9HUkFNIFBST1ZFIERFRkVDVElWRSwgWU9VIEFTU1VNRSBUSEUgQ09TVCBPRiBBTEwgTkVDRVNT -QVJZIFNFUlZJQ0lORywKUkVQQUlSIE9SIENPUlJFQ1RJT04uCgogIDEyLiBJTiBOTyBFVkVOVCBV -TkxFU1MgUkVRVUlSRUQgQlkgQVBQTElDQUJMRSBMQVcgT1IgQUdSRUVEIFRPIElOIFdSSVRJTkcK -V0lMTCBBTlkgQ09QWVJJR0hUIEhPTERFUiwgT1IgQU5ZIE9USEVSIFBBUlRZIFdITyBNQVkgTU9E -SUZZIEFORC9PUgpSRURJU1RSSUJVVEUgVEhFIFBST0dSQU0gQVMgUEVSTUlUVEVEIEFCT1ZFLCBC -RSBMSUFCTEUgVE8gWU9VIEZPUiBEQU1BR0VTLApJTkNMVURJTkcgQU5ZIEdFTkVSQUwsIFNQRUNJ -QUwsIElOQ0lERU5UQUwgT1IgQ09OU0VRVUVOVElBTCBEQU1BR0VTIEFSSVNJTkcKT1VUIE9GIFRI -RSBVU0UgT1IgSU5BQklMSVRZIFRPIFVTRSBUSEUgUFJPR1JBTSAoSU5DTFVESU5HIEJVVCBOT1Qg -TElNSVRFRApUTyBMT1NTIE9GIERBVEEgT1IgREFUQSBCRUlORyBSRU5ERVJFRCBJTkFDQ1VSQVRF -IE9SIExPU1NFUyBTVVNUQUlORUQgQlkKWU9VIE9SIFRISVJEIFBBUlRJRVMgT1IgQSBGQUlMVVJF -IE9GIFRIRSBQUk9HUkFNIFRPIE9QRVJBVEUgV0lUSCBBTlkgT1RIRVIKUFJPR1JBTVMpLCBFVkVO -IElGIFNVQ0ggSE9MREVSIE9SIE9USEVSIFBBUlRZIEhBUyBCRUVOIEFEVklTRUQgT0YgVEhFClBP -U1NJQklMSVRZIE9GIFNVQ0ggREFNQUdFUy4KCgkJICAgICBFTkQgT0YgVEVSTVMgQU5EIENPTkRJ -VElPTlMKDAoJICAgIEhvdyB0byBBcHBseSBUaGVzZSBUZXJtcyB0byBZb3VyIE5ldyBQcm9ncmFt -cwoKICBJZiB5b3UgZGV2ZWxvcCBhIG5ldyBwcm9ncmFtLCBhbmQgeW91IHdhbnQgaXQgdG8gYmUg -b2YgdGhlIGdyZWF0ZXN0CnBvc3NpYmxlIHVzZSB0byB0aGUgcHVibGljLCB0aGUgYmVzdCB3YXkg -dG8gYWNoaWV2ZSB0aGlzIGlzIHRvIG1ha2UgaXQKZnJlZSBzb2Z0d2FyZSB3aGljaCBldmVyeW9u -ZSBjYW4gcmVkaXN0cmlidXRlIGFuZCBjaGFuZ2UgdW5kZXIgdGhlc2UgdGVybXMuCgogIFRvIGRv -IHNvLCBhdHRhY2ggdGhlIGZvbGxvd2luZyBub3RpY2VzIHRvIHRoZSBwcm9ncmFtLiAgSXQgaXMg -c2FmZXN0CnRvIGF0dGFjaCB0aGVtIHRvIHRoZSBzdGFydCBvZiBlYWNoIHNvdXJjZSBmaWxlIHRv -IG1vc3QgZWZmZWN0aXZlbHkKY29udmV5IHRoZSBleGNsdXNpb24gb2Ygd2FycmFudHk7IGFuZCBl -YWNoIGZpbGUgc2hvdWxkIGhhdmUgYXQgbGVhc3QKdGhlICJjb3B5cmlnaHQiIGxpbmUgYW5kIGEg -cG9pbnRlciB0byB3aGVyZSB0aGUgZnVsbCBub3RpY2UgaXMgZm91bmQuCgogICAgPG9uZSBsaW5l -IHRvIGdpdmUgdGhlIHByb2dyYW0ncyBuYW1lIGFuZCBhIGJyaWVmIGlkZWEgb2Ygd2hhdCBpdCBk -b2VzLj4KICAgIENvcHlyaWdodCAoQykgPHllYXI+ICA8bmFtZSBvZiBhdXRob3I+CgogICAgVGhp -cyBwcm9ncmFtIGlzIGZyZWUgc29mdHdhcmU7IHlvdSBjYW4gcmVkaXN0cmlidXRlIGl0IGFuZC9v -ciBtb2RpZnkKICAgIGl0IHVuZGVyIHRoZSB0ZXJtcyBvZiB0aGUgR05VIEdlbmVyYWwgUHVibGlj -IExpY2Vuc2UgYXMgcHVibGlzaGVkIGJ5CiAgICB0aGUgRnJlZSBTb2Z0d2FyZSBGb3VuZGF0aW9u -OyBlaXRoZXIgdmVyc2lvbiAyIG9mIHRoZSBMaWNlbnNlLCBvcgogICAgKGF0IHlvdXIgb3B0aW9u -KSBhbnkgbGF0ZXIgdmVyc2lvbi4KCiAgICBUaGlzIHByb2dyYW0gaXMgZGlzdHJpYnV0ZWQgaW4g -dGhlIGhvcGUgdGhhdCBpdCB3aWxsIGJlIHVzZWZ1bCwKICAgIGJ1dCBXSVRIT1VUIEFOWSBXQVJS -QU5UWTsgd2l0aG91dCBldmVuIHRoZSBpbXBsaWVkIHdhcnJhbnR5IG9mCiAgICBNRVJDSEFOVEFC -SUxJVFkgb3IgRklUTkVTUyBGT1IgQSBQQVJUSUNVTEFSIFBVUlBPU0UuICBTZWUgdGhlCiAgICBH -TlUgR2VuZXJhbCBQdWJsaWMgTGljZW5zZSBmb3IgbW9yZSBkZXRhaWxzLgoKICAgIFlvdSBzaG91 -bGQgaGF2ZSByZWNlaXZlZCBhIGNvcHkgb2YgdGhlIEdOVSBHZW5lcmFsIFB1YmxpYyBMaWNlbnNl -CiAgICBhbG9uZyB3aXRoIHRoaXMgcHJvZ3JhbTsgaWYgbm90LCB3cml0ZSB0byB0aGUgRnJlZSBT -b2Z0d2FyZQogICAgRm91bmRhdGlvbiwgSW5jLiwgNTkgVGVtcGxlIFBsYWNlLCBTdWl0ZSAzMzAs -IEJvc3RvbiwgTUEgIDAyMTExLTEzMDcgIFVTQQoKCkFsc28gYWRkIGluZm9ybWF0aW9uIG9uIGhv -dyB0byBjb250YWN0IHlvdSBieSBlbGVjdHJvbmljIGFuZCBwYXBlciBtYWlsLgoKSWYgdGhlIHBy -b2dyYW0gaXMgaW50ZXJhY3RpdmUsIG1ha2UgaXQgb3V0cHV0IGEgc2hvcnQgbm90aWNlIGxpa2Ug -dGhpcwp3aGVuIGl0IHN0YXJ0cyBpbiBhbiBpbnRlcmFjdGl2ZSBtb2RlOgoKICAgIEdub21vdmlz -aW9uIHZlcnNpb24gNjksIENvcHlyaWdodCAoQykgeWVhciBuYW1lIG9mIGF1dGhvcgogICAgR25v -bW92aXNpb24gY29tZXMgd2l0aCBBQlNPTFVURUxZIE5PIFdBUlJBTlRZOyBmb3IgZGV0YWlscyB0 -eXBlIGBzaG93IHcnLgogICAgVGhpcyBpcyBmcmVlIHNvZnR3YXJlLCBhbmQgeW91IGFyZSB3ZWxj -b21lIHRvIHJlZGlzdHJpYnV0ZSBpdAogICAgdW5kZXIgY2VydGFpbiBjb25kaXRpb25zOyB0eXBl -IGBzaG93IGMnIGZvciBkZXRhaWxzLgoKVGhlIGh5cG90aGV0aWNhbCBjb21tYW5kcyBgc2hvdyB3 -JyBhbmQgYHNob3cgYycgc2hvdWxkIHNob3cgdGhlIGFwcHJvcHJpYXRlCnBhcnRzIG9mIHRoZSBH -ZW5lcmFsIFB1YmxpYyBMaWNlbnNlLiAgT2YgY291cnNlLCB0aGUgY29tbWFuZHMgeW91IHVzZSBt -YXkKYmUgY2FsbGVkIHNvbWV0aGluZyBvdGhlciB0aGFuIGBzaG93IHcnIGFuZCBgc2hvdyBjJzsg -dGhleSBjb3VsZCBldmVuIGJlCm1vdXNlLWNsaWNrcyBvciBtZW51IGl0ZW1zLS13aGF0ZXZlciBz -dWl0cyB5b3VyIHByb2dyYW0uCgpZb3Ugc2hvdWxkIGFsc28gZ2V0IHlvdXIgZW1wbG95ZXIgKGlm -IHlvdSB3b3JrIGFzIGEgcHJvZ3JhbW1lcikgb3IgeW91cgpzY2hvb2wsIGlmIGFueSwgdG8gc2ln -biBhICJjb3B5cmlnaHQgZGlzY2xhaW1lciIgZm9yIHRoZSBwcm9ncmFtLCBpZgpuZWNlc3Nhcnku -ICBIZXJlIGlzIGEgc2FtcGxlOyBhbHRlciB0aGUgbmFtZXM6CgogIFlveW9keW5lLCBJbmMuLCBo -ZXJlYnkgZGlzY2xhaW1zIGFsbCBjb3B5cmlnaHQgaW50ZXJlc3QgaW4gdGhlIHByb2dyYW0KICBg -R25vbW92aXNpb24nICh3aGljaCBtYWtlcyBwYXNzZXMgYXQgY29tcGlsZXJzKSB3cml0dGVuIGJ5 -IEphbWVzIEhhY2tlci4KCiAgPHNpZ25hdHVyZSBvZiBUeSBDb29uPiwgMSBBcHJpbCAxOTg5CiAg -VHkgQ29vbiwgUHJlc2lkZW50IG9mIFZpY2UKClRoaXMgR2VuZXJhbCBQdWJsaWMgTGljZW5zZSBk -b2VzIG5vdCBwZXJtaXQgaW5jb3Jwb3JhdGluZyB5b3VyIHByb2dyYW0gaW50bwpwcm9wcmlldGFy -eSBwcm9ncmFtcy4gIElmIHlvdXIgcHJvZ3JhbSBpcyBhIHN1YnJvdXRpbmUgbGlicmFyeSwgeW91 -IG1heQpjb25zaWRlciBpdCBtb3JlIHVzZWZ1bCB0byBwZXJtaXQgbGlua2luZyBwcm9wcmlldGFy -eSBhcHBsaWNhdGlvbnMgd2l0aCB0aGUKbGlicmFyeS4gIElmIHRoaXMgaXMgd2hhdCB5b3Ugd2Fu -dCB0byBkbywgdXNlIHRoZSBHTlUgTGlicmFyeSBHZW5lcmFsClB1YmxpYyBMaWNlbnNlIGluc3Rl -YWQgb2YgdGhpcyBMaWNlbnNlLgo= -ClxjaGFwdGVye1RoZSBHTlUgR2VuZXJhbCBQdWJsaWMgTGljZW5zZX0KClxiZWdpbntjZW50ZXJ9 -CntccGFyaW5kZW50IDBpbgoKVmVyc2lvbiAyLCBKdW5lIDE5OTEKCkNvcHlyaWdodCBcY29weXJp -Z2h0XCAxOTg5LCAxOTkxIEZyZWUgU29mdHdhcmUgRm91bmRhdGlvbiwgSW5jLgoKXGJpZ3NraXAK -CjU5IFRlbXBsZSBQbGFjZSAtIFN1aXRlIDMzMCwgQm9zdG9uLCBNQSAgMDIxMTEtMTMwNywgVVNB -CgpcYmlnc2tpcAoKRXZlcnlvbmUgaXMgcGVybWl0dGVkIHRvIGNvcHkgYW5kIGRpc3RyaWJ1dGUg -dmVyYmF0aW0gY29waWVzCm9mIHRoaXMgbGljZW5zZSBkb2N1bWVudCwgYnV0IGNoYW5naW5nIGl0 -IGlzIG5vdCBhbGxvd2VkLgp9ClxlbmR7Y2VudGVyfQoKXGJlZ2lue2NlbnRlcn0Ke1xiZlxsYXJn -ZSBQcmVhbWJsZX0KXGVuZHtjZW50ZXJ9CgoKVGhlIGxpY2Vuc2VzIGZvciBtb3N0IHNvZnR3YXJl -IGFyZSBkZXNpZ25lZCB0byB0YWtlIGF3YXkgeW91ciBmcmVlZG9tIHRvCnNoYXJlIGFuZCBjaGFu -Z2UgaXQuICBCeSBjb250cmFzdCwgdGhlIEdOVSBHZW5lcmFsIFB1YmxpYyBMaWNlbnNlIGlzCmlu -dGVuZGVkIHRvIGd1YXJhbnRlZSB5b3VyIGZyZWVkb20gdG8gc2hhcmUgYW5kIGNoYW5nZSBmcmVl -IHNvZnR3YXJlLS0tdG8KbWFrZSBzdXJlIHRoZSBzb2Z0d2FyZSBpcyBmcmVlIGZvciBhbGwgaXRz -IHVzZXJzLiAgVGhpcyBHZW5lcmFsIFB1YmxpYwpMaWNlbnNlIGFwcGxpZXMgdG8gbW9zdCBvZiB0 -aGUgRnJlZSBTb2Z0d2FyZSBGb3VuZGF0aW9uJ3Mgc29mdHdhcmUgYW5kIHRvCmFueSBvdGhlciBw -cm9ncmFtIHdob3NlIGF1dGhvcnMgY29tbWl0IHRvIHVzaW5nIGl0LiAgKFNvbWUgb3RoZXIgRnJl -ZQpTb2Z0d2FyZSBGb3VuZGF0aW9uIHNvZnR3YXJlIGlzIGNvdmVyZWQgYnkgdGhlIEdOVSBMaWJy -YXJ5IEdlbmVyYWwgUHVibGljCkxpY2Vuc2UgaW5zdGVhZC4pICBZb3UgY2FuIGFwcGx5IGl0IHRv -IHlvdXIgcHJvZ3JhbXMsIHRvby4KCldoZW4gd2Ugc3BlYWsgb2YgZnJlZSBzb2Z0d2FyZSwgd2Ug -YXJlIHJlZmVycmluZyB0byBmcmVlZG9tLCBub3QgcHJpY2UuCk91ciBHZW5lcmFsIFB1YmxpYyBM -aWNlbnNlcyBhcmUgZGVzaWduZWQgdG8gbWFrZSBzdXJlIHRoYXQgeW91IGhhdmUgdGhlCmZyZWVk -b20gdG8gZGlzdHJpYnV0ZSBjb3BpZXMgb2YgZnJlZSBzb2Z0d2FyZSAoYW5kIGNoYXJnZSBmb3Ig -dGhpcyBzZXJ2aWNlCmlmIHlvdSB3aXNoKSwgdGhhdCB5b3UgcmVjZWl2ZSBzb3VyY2UgY29kZSBv -ciBjYW4gZ2V0IGl0IGlmIHlvdSB3YW50IGl0LAp0aGF0IHlvdSBjYW4gY2hhbmdlIHRoZSBzb2Z0 -d2FyZSBvciB1c2UgcGllY2VzIG9mIGl0IGluIG5ldyBmcmVlIHByb2dyYW1zOwphbmQgdGhhdCB5 -b3Uga25vdyB5b3UgY2FuIGRvIHRoZXNlIHRoaW5ncy4KClRvIHByb3RlY3QgeW91ciByaWdodHMs -IHdlIG5lZWQgdG8gbWFrZSByZXN0cmljdGlvbnMgdGhhdCBmb3JiaWQgYW55b25lIHRvCmRlbnkg -eW91IHRoZXNlIHJpZ2h0cyBvciB0byBhc2sgeW91IHRvIHN1cnJlbmRlciB0aGUgcmlnaHRzLiAg -VGhlc2UKcmVzdHJpY3Rpb25zIHRyYW5zbGF0ZSB0byBjZXJ0YWluIHJlc3BvbnNpYmlsaXRpZXMg -Zm9yIHlvdSBpZiB5b3UKZGlzdHJpYnV0ZSBjb3BpZXMgb2YgdGhlIHNvZnR3YXJlLCBvciBpZiB5 -b3UgbW9kaWZ5IGl0LgoKRm9yIGV4YW1wbGUsIGlmIHlvdSBkaXN0cmlidXRlIGNvcGllcyBvZiBz -dWNoIGEgcHJvZ3JhbSwgd2hldGhlciBncmF0aXMgb3IKZm9yIGEgZmVlLCB5b3UgbXVzdCBnaXZl -IHRoZSByZWNpcGllbnRzIGFsbCB0aGUgcmlnaHRzIHRoYXQgeW91IGhhdmUuICBZb3UKbXVzdCBt -YWtlIHN1cmUgdGhhdCB0aGV5LCB0b28sIHJlY2VpdmUgb3IgY2FuIGdldCB0aGUgc291cmNlIGNv -ZGUuICBBbmQKeW91IG11c3Qgc2hvdyB0aGVtIHRoZXNlIHRlcm1zIHNvIHRoZXkga25vdyB0aGVp -ciByaWdodHMuCgpXZSBwcm90ZWN0IHlvdXIgcmlnaHRzIHdpdGggdHdvIHN0ZXBzOiAoMSkgY29w -eXJpZ2h0IHRoZSBzb2Z0d2FyZSwgYW5kICgyKQpvZmZlciB5b3UgdGhpcyBsaWNlbnNlIHdoaWNo -IGdpdmVzIHlvdSBsZWdhbCBwZXJtaXNzaW9uIHRvIGNvcHksCmRpc3RyaWJ1dGUgYW5kL29yIG1v -ZGlmeSB0aGUgc29mdHdhcmUuCgpBbHNvLCBmb3IgZWFjaCBhdXRob3IncyBwcm90ZWN0aW9uIGFu -ZCBvdXJzLCB3ZSB3YW50IHRvIG1ha2UgY2VydGFpbiB0aGF0CmV2ZXJ5b25lIHVuZGVyc3RhbmRz -IHRoYXQgdGhlcmUgaXMgbm8gd2FycmFudHkgZm9yIHRoaXMgZnJlZSBzb2Z0d2FyZS4gIElmCnRo -ZSBzb2Z0d2FyZSBpcyBtb2RpZmllZCBieSBzb21lb25lIGVsc2UgYW5kIHBhc3NlZCBvbiwgd2Ug -d2FudCBpdHMKcmVjaXBpZW50cyB0byBrbm93IHRoYXQgd2hhdCB0aGV5IGhhdmUgaXMgbm90IHRo -ZSBvcmlnaW5hbCwgc28gdGhhdCBhbnkKcHJvYmxlbXMgaW50cm9kdWNlZCBieSBvdGhlcnMgd2ls -bCBub3QgcmVmbGVjdCBvbiB0aGUgb3JpZ2luYWwgYXV0aG9ycycKcmVwdXRhdGlvbnMuCgpGaW5h -bGx5LCBhbnkgZnJlZSBwcm9ncmFtIGlzIHRocmVhdGVuZWQgY29uc3RhbnRseSBieSBzb2Z0d2Fy -ZSBwYXRlbnRzLgpXZSB3aXNoIHRvIGF2b2lkIHRoZSBkYW5nZXIgdGhhdCByZWRpc3RyaWJ1dG9y -cyBvZiBhIGZyZWUgcHJvZ3JhbSB3aWxsCmluZGl2aWR1YWxseSBvYnRhaW4gcGF0ZW50IGxpY2Vu -c2VzLCBpbiBlZmZlY3QgbWFraW5nIHRoZSBwcm9ncmFtCnByb3ByaWV0YXJ5LiAgVG8gcHJldmVu -dCB0aGlzLCB3ZSBoYXZlIG1hZGUgaXQgY2xlYXIgdGhhdCBhbnkgcGF0ZW50IG11c3QKYmUgbGlj -ZW5zZWQgZm9yIGV2ZXJ5b25lJ3MgZnJlZSB1c2Ugb3Igbm90IGxpY2Vuc2VkIGF0IGFsbC4KClRo -ZSBwcmVjaXNlIHRlcm1zIGFuZCBjb25kaXRpb25zIGZvciBjb3B5aW5nLCBkaXN0cmlidXRpb24g -YW5kCm1vZGlmaWNhdGlvbiBmb2xsb3cuCgpcYmVnaW57Y2VudGVyfQp7XExhcmdlIFxzYyBUZXJt -cyBhbmQgQ29uZGl0aW9ucyBGb3IgQ29weWluZywgRGlzdHJpYnV0aW9uIGFuZAogIE1vZGlmaWNh -dGlvbn0KXGVuZHtjZW50ZXJ9CgoKJVxyZW5ld2NvbW1hbmR7XHRoZWVudW1pfXtcYWxwaGF7ZW51 -bWl9fQpcYmVnaW57ZW51bWVyYXRlfQoKXGFkZHRvY291bnRlcntlbnVtaX17LTF9CgpcaXRlbSAK -ClRoaXMgTGljZW5zZSBhcHBsaWVzIHRvIGFueSBwcm9ncmFtIG9yIG90aGVyIHdvcmsgd2hpY2gg -Y29udGFpbnMgYSBub3RpY2UKcGxhY2VkIGJ5IHRoZSBjb3B5cmlnaHQgaG9sZGVyIHNheWluZyBp -dCBtYXkgYmUgZGlzdHJpYnV0ZWQgdW5kZXIgdGhlCnRlcm1zIG9mIHRoaXMgR2VuZXJhbCBQdWJs -aWMgTGljZW5zZS4gIFRoZSBgYFByb2dyYW0nJywgYmVsb3csIHJlZmVycyB0bwphbnkgc3VjaCBw -cm9ncmFtIG9yIHdvcmssIGFuZCBhIGBgd29yayBiYXNlZCBvbiB0aGUgUHJvZ3JhbScnIG1lYW5z -IGVpdGhlcgp0aGUgUHJvZ3JhbSBvciBhbnkgZGVyaXZhdGl2ZSB3b3JrIHVuZGVyIGNvcHlyaWdo -dCBsYXc6IHRoYXQgaXMgdG8gc2F5LCBhCndvcmsgY29udGFpbmluZyB0aGUgUHJvZ3JhbSBvciBh -IHBvcnRpb24gb2YgaXQsIGVpdGhlciB2ZXJiYXRpbSBvciB3aXRoCm1vZGlmaWNhdGlvbnMgYW5k -L29yIHRyYW5zbGF0ZWQgaW50byBhbm90aGVyIGxhbmd1YWdlLiAgKEhlcmVpbmFmdGVyLAp0cmFu -c2xhdGlvbiBpcyBpbmNsdWRlZCB3aXRob3V0IGxpbWl0YXRpb24gaW4gdGhlIHRlcm0gYGBtb2Rp -ZmljYXRpb24nJy4pCkVhY2ggbGljZW5zZWUgaXMgYWRkcmVzc2VkIGFzIGBgeW91JycuCgpBY3Rp -dml0aWVzIG90aGVyIHRoYW4gY29weWluZywgZGlzdHJpYnV0aW9uIGFuZCBtb2RpZmljYXRpb24g -YXJlIG5vdApjb3ZlcmVkIGJ5IHRoaXMgTGljZW5zZTsgdGhleSBhcmUgb3V0c2lkZSBpdHMgc2Nv -cGUuICBUaGUgYWN0IG9mCnJ1bm5pbmcgdGhlIFByb2dyYW0gaXMgbm90IHJlc3RyaWN0ZWQsIGFu -ZCB0aGUgb3V0cHV0IGZyb20gdGhlIFByb2dyYW0KaXMgY292ZXJlZCBvbmx5IGlmIGl0cyBjb250 -ZW50cyBjb25zdGl0dXRlIGEgd29yayBiYXNlZCBvbiB0aGUKUHJvZ3JhbSAoaW5kZXBlbmRlbnQg -b2YgaGF2aW5nIGJlZW4gbWFkZSBieSBydW5uaW5nIHRoZSBQcm9ncmFtKS4KV2hldGhlciB0aGF0 -IGlzIHRydWUgZGVwZW5kcyBvbiB3aGF0IHRoZSBQcm9ncmFtIGRvZXMuCgpcaXRlbSBZb3UgbWF5 -IGNvcHkgYW5kIGRpc3RyaWJ1dGUgdmVyYmF0aW0gY29waWVzIG9mIHRoZSBQcm9ncmFtJ3Mgc291 -cmNlCiAgY29kZSBhcyB5b3UgcmVjZWl2ZSBpdCwgaW4gYW55IG1lZGl1bSwgcHJvdmlkZWQgdGhh -dCB5b3UgY29uc3BpY3VvdXNseQogIGFuZCBhcHByb3ByaWF0ZWx5IHB1Ymxpc2ggb24gZWFjaCBj -b3B5IGFuIGFwcHJvcHJpYXRlIGNvcHlyaWdodCBub3RpY2UKICBhbmQgZGlzY2xhaW1lciBvZiB3 -YXJyYW50eTsga2VlcCBpbnRhY3QgYWxsIHRoZSBub3RpY2VzIHRoYXQgcmVmZXIgdG8KICB0aGlz -IExpY2Vuc2UgYW5kIHRvIHRoZSBhYnNlbmNlIG9mIGFueSB3YXJyYW50eTsgYW5kIGdpdmUgYW55 -IG90aGVyCiAgcmVjaXBpZW50cyBvZiB0aGUgUHJvZ3JhbSBhIGNvcHkgb2YgdGhpcyBMaWNlbnNl -IGFsb25nIHdpdGggdGhlIFByb2dyYW0uCgpZb3UgbWF5IGNoYXJnZSBhIGZlZSBmb3IgdGhlIHBo -eXNpY2FsIGFjdCBvZiB0cmFuc2ZlcnJpbmcgYSBjb3B5LCBhbmQgeW91Cm1heSBhdCB5b3VyIG9w -dGlvbiBvZmZlciB3YXJyYW50eSBwcm90ZWN0aW9uIGluIGV4Y2hhbmdlIGZvciBhIGZlZS4KClxp -dGVtCgpZb3UgbWF5IG1vZGlmeSB5b3VyIGNvcHkgb3IgY29waWVzIG9mIHRoZSBQcm9ncmFtIG9y -IGFueSBwb3J0aW9uCm9mIGl0LCB0aHVzIGZvcm1pbmcgYSB3b3JrIGJhc2VkIG9uIHRoZSBQcm9n -cmFtLCBhbmQgY29weSBhbmQKZGlzdHJpYnV0ZSBzdWNoIG1vZGlmaWNhdGlvbnMgb3Igd29yayB1 -bmRlciB0aGUgdGVybXMgb2YgU2VjdGlvbiAxCmFib3ZlLCBwcm92aWRlZCB0aGF0IHlvdSBhbHNv -IG1lZXQgYWxsIG9mIHRoZXNlIGNvbmRpdGlvbnM6CgpcYmVnaW57ZW51bWVyYXRlfQoKXGl0ZW0g -CgpZb3UgbXVzdCBjYXVzZSB0aGUgbW9kaWZpZWQgZmlsZXMgdG8gY2FycnkgcHJvbWluZW50IG5v -dGljZXMgc3RhdGluZyB0aGF0CnlvdSBjaGFuZ2VkIHRoZSBmaWxlcyBhbmQgdGhlIGRhdGUgb2Yg -YW55IGNoYW5nZS4KClxpdGVtCgpZb3UgbXVzdCBjYXVzZSBhbnkgd29yayB0aGF0IHlvdSBkaXN0 -cmlidXRlIG9yIHB1Ymxpc2gsIHRoYXQgaW4Kd2hvbGUgb3IgaW4gcGFydCBjb250YWlucyBvciBp -cyBkZXJpdmVkIGZyb20gdGhlIFByb2dyYW0gb3IgYW55CnBhcnQgdGhlcmVvZiwgdG8gYmUgbGlj -ZW5zZWQgYXMgYSB3aG9sZSBhdCBubyBjaGFyZ2UgdG8gYWxsIHRoaXJkCnBhcnRpZXMgdW5kZXIg -dGhlIHRlcm1zIG9mIHRoaXMgTGljZW5zZS4KClxpdGVtCklmIHRoZSBtb2RpZmllZCBwcm9ncmFt -IG5vcm1hbGx5IHJlYWRzIGNvbW1hbmRzIGludGVyYWN0aXZlbHkKd2hlbiBydW4sIHlvdSBtdXN0 -IGNhdXNlIGl0LCB3aGVuIHN0YXJ0ZWQgcnVubmluZyBmb3Igc3VjaAppbnRlcmFjdGl2ZSB1c2Ug -aW4gdGhlIG1vc3Qgb3JkaW5hcnkgd2F5LCB0byBwcmludCBvciBkaXNwbGF5IGFuCmFubm91bmNl -bWVudCBpbmNsdWRpbmcgYW4gYXBwcm9wcmlhdGUgY29weXJpZ2h0IG5vdGljZSBhbmQgYQpub3Rp -Y2UgdGhhdCB0aGVyZSBpcyBubyB3YXJyYW50eSAob3IgZWxzZSwgc2F5aW5nIHRoYXQgeW91IHBy -b3ZpZGUKYSB3YXJyYW50eSkgYW5kIHRoYXQgdXNlcnMgbWF5IHJlZGlzdHJpYnV0ZSB0aGUgcHJv -Z3JhbSB1bmRlcgp0aGVzZSBjb25kaXRpb25zLCBhbmQgdGVsbGluZyB0aGUgdXNlciBob3cgdG8g -dmlldyBhIGNvcHkgb2YgdGhpcwpMaWNlbnNlLiAgKEV4Y2VwdGlvbjogaWYgdGhlIFByb2dyYW0g -aXRzZWxmIGlzIGludGVyYWN0aXZlIGJ1dApkb2VzIG5vdCBub3JtYWxseSBwcmludCBzdWNoIGFu -IGFubm91bmNlbWVudCwgeW91ciB3b3JrIGJhc2VkIG9uCnRoZSBQcm9ncmFtIGlzIG5vdCByZXF1 -aXJlZCB0byBwcmludCBhbiBhbm5vdW5jZW1lbnQuKQoKXGVuZHtlbnVtZXJhdGV9CgoKVGhlc2Ug -cmVxdWlyZW1lbnRzIGFwcGx5IHRvIHRoZSBtb2RpZmllZCB3b3JrIGFzIGEgd2hvbGUuICBJZgpp -ZGVudGlmaWFibGUgc2VjdGlvbnMgb2YgdGhhdCB3b3JrIGFyZSBub3QgZGVyaXZlZCBmcm9tIHRo -ZSBQcm9ncmFtLAphbmQgY2FuIGJlIHJlYXNvbmFibHkgY29uc2lkZXJlZCBpbmRlcGVuZGVudCBh -bmQgc2VwYXJhdGUgd29ya3MgaW4KdGhlbXNlbHZlcywgdGhlbiB0aGlzIExpY2Vuc2UsIGFuZCBp -dHMgdGVybXMsIGRvIG5vdCBhcHBseSB0byB0aG9zZQpzZWN0aW9ucyB3aGVuIHlvdSBkaXN0cmli -dXRlIHRoZW0gYXMgc2VwYXJhdGUgd29ya3MuICBCdXQgd2hlbiB5b3UKZGlzdHJpYnV0ZSB0aGUg -c2FtZSBzZWN0aW9ucyBhcyBwYXJ0IG9mIGEgd2hvbGUgd2hpY2ggaXMgYSB3b3JrIGJhc2VkCm9u -IHRoZSBQcm9ncmFtLCB0aGUgZGlzdHJpYnV0aW9uIG9mIHRoZSB3aG9sZSBtdXN0IGJlIG9uIHRo -ZSB0ZXJtcyBvZgp0aGlzIExpY2Vuc2UsIHdob3NlIHBlcm1pc3Npb25zIGZvciBvdGhlciBsaWNl -bnNlZXMgZXh0ZW5kIHRvIHRoZQplbnRpcmUgd2hvbGUsIGFuZCB0aHVzIHRvIGVhY2ggYW5kIGV2 -ZXJ5IHBhcnQgcmVnYXJkbGVzcyBvZiB3aG8gd3JvdGUgaXQuCgpUaHVzLCBpdCBpcyBub3QgdGhl -IGludGVudCBvZiB0aGlzIHNlY3Rpb24gdG8gY2xhaW0gcmlnaHRzIG9yIGNvbnRlc3QKeW91ciBy -aWdodHMgdG8gd29yayB3cml0dGVuIGVudGlyZWx5IGJ5IHlvdTsgcmF0aGVyLCB0aGUgaW50ZW50 -IGlzIHRvCmV4ZXJjaXNlIHRoZSByaWdodCB0byBjb250cm9sIHRoZSBkaXN0cmlidXRpb24gb2Yg -ZGVyaXZhdGl2ZSBvcgpjb2xsZWN0aXZlIHdvcmtzIGJhc2VkIG9uIHRoZSBQcm9ncmFtLgoKSW4g -YWRkaXRpb24sIG1lcmUgYWdncmVnYXRpb24gb2YgYW5vdGhlciB3b3JrIG5vdCBiYXNlZCBvbiB0 -aGUgUHJvZ3JhbQp3aXRoIHRoZSBQcm9ncmFtIChvciB3aXRoIGEgd29yayBiYXNlZCBvbiB0aGUg -UHJvZ3JhbSkgb24gYSB2b2x1bWUgb2YKYSBzdG9yYWdlIG9yIGRpc3RyaWJ1dGlvbiBtZWRpdW0g -ZG9lcyBub3QgYnJpbmcgdGhlIG90aGVyIHdvcmsgdW5kZXIKdGhlIHNjb3BlIG9mIHRoaXMgTGlj -ZW5zZS4KClxpdGVtCllvdSBtYXkgY29weSBhbmQgZGlzdHJpYnV0ZSB0aGUgUHJvZ3JhbSAob3Ig -YSB3b3JrIGJhc2VkIG9uIGl0LAp1bmRlciBTZWN0aW9uIDIpIGluIG9iamVjdCBjb2RlIG9yIGV4 -ZWN1dGFibGUgZm9ybSB1bmRlciB0aGUgdGVybXMgb2YKU2VjdGlvbnMgMSBhbmQgMiBhYm92ZSBw -cm92aWRlZCB0aGF0IHlvdSBhbHNvIGRvIG9uZSBvZiB0aGUgZm9sbG93aW5nOgoKXGJlZ2lue2Vu -dW1lcmF0ZX0KClxpdGVtCgpBY2NvbXBhbnkgaXQgd2l0aCB0aGUgY29tcGxldGUgY29ycmVzcG9u -ZGluZyBtYWNoaW5lLXJlYWRhYmxlCnNvdXJjZSBjb2RlLCB3aGljaCBtdXN0IGJlIGRpc3RyaWJ1 -dGVkIHVuZGVyIHRoZSB0ZXJtcyBvZiBTZWN0aW9ucwoxIGFuZCAyIGFib3ZlIG9uIGEgbWVkaXVt -IGN1c3RvbWFyaWx5IHVzZWQgZm9yIHNvZnR3YXJlIGludGVyY2hhbmdlOyBvciwKClxpdGVtCgpB -Y2NvbXBhbnkgaXQgd2l0aCBhIHdyaXR0ZW4gb2ZmZXIsIHZhbGlkIGZvciBhdCBsZWFzdCB0aHJl -ZQp5ZWFycywgdG8gZ2l2ZSBhbnkgdGhpcmQgcGFydHksIGZvciBhIGNoYXJnZSBubyBtb3JlIHRo -YW4geW91cgpjb3N0IG9mIHBoeXNpY2FsbHkgcGVyZm9ybWluZyBzb3VyY2UgZGlzdHJpYnV0aW9u -LCBhIGNvbXBsZXRlCm1hY2hpbmUtcmVhZGFibGUgY29weSBvZiB0aGUgY29ycmVzcG9uZGluZyBz -b3VyY2UgY29kZSwgdG8gYmUKZGlzdHJpYnV0ZWQgdW5kZXIgdGhlIHRlcm1zIG9mIFNlY3Rpb25z -IDEgYW5kIDIgYWJvdmUgb24gYSBtZWRpdW0KY3VzdG9tYXJpbHkgdXNlZCBmb3Igc29mdHdhcmUg -aW50ZXJjaGFuZ2U7IG9yLAoKXGl0ZW0KCkFjY29tcGFueSBpdCB3aXRoIHRoZSBpbmZvcm1hdGlv -biB5b3UgcmVjZWl2ZWQgYXMgdG8gdGhlIG9mZmVyCnRvIGRpc3RyaWJ1dGUgY29ycmVzcG9uZGlu -ZyBzb3VyY2UgY29kZS4gIChUaGlzIGFsdGVybmF0aXZlIGlzCmFsbG93ZWQgb25seSBmb3Igbm9u -Y29tbWVyY2lhbCBkaXN0cmlidXRpb24gYW5kIG9ubHkgaWYgeW91CnJlY2VpdmVkIHRoZSBwcm9n -cmFtIGluIG9iamVjdCBjb2RlIG9yIGV4ZWN1dGFibGUgZm9ybSB3aXRoIHN1Y2gKYW4gb2ZmZXIs -IGluIGFjY29yZCB3aXRoIFN1YnNlY3Rpb24gYiBhYm92ZS4pCgpcZW5ke2VudW1lcmF0ZX0KCgpU -aGUgc291cmNlIGNvZGUgZm9yIGEgd29yayBtZWFucyB0aGUgcHJlZmVycmVkIGZvcm0gb2YgdGhl -IHdvcmsgZm9yCm1ha2luZyBtb2RpZmljYXRpb25zIHRvIGl0LiAgRm9yIGFuIGV4ZWN1dGFibGUg -d29yaywgY29tcGxldGUgc291cmNlCmNvZGUgbWVhbnMgYWxsIHRoZSBzb3VyY2UgY29kZSBmb3Ig -YWxsIG1vZHVsZXMgaXQgY29udGFpbnMsIHBsdXMgYW55CmFzc29jaWF0ZWQgaW50ZXJmYWNlIGRl -ZmluaXRpb24gZmlsZXMsIHBsdXMgdGhlIHNjcmlwdHMgdXNlZCB0bwpjb250cm9sIGNvbXBpbGF0 -aW9uIGFuZCBpbnN0YWxsYXRpb24gb2YgdGhlIGV4ZWN1dGFibGUuICBIb3dldmVyLCBhcyBhCnNw -ZWNpYWwgZXhjZXB0aW9uLCB0aGUgc291cmNlIGNvZGUgZGlzdHJpYnV0ZWQgbmVlZCBub3QgaW5j -bHVkZQphbnl0aGluZyB0aGF0IGlzIG5vcm1hbGx5IGRpc3RyaWJ1dGVkIChpbiBlaXRoZXIgc291 -cmNlIG9yIGJpbmFyeQpmb3JtKSB3aXRoIHRoZSBtYWpvciBjb21wb25lbnRzIChjb21waWxlciwg -a2VybmVsLCBhbmQgc28gb24pIG9mIHRoZQpvcGVyYXRpbmcgc3lzdGVtIG9uIHdoaWNoIHRoZSBl -eGVjdXRhYmxlIHJ1bnMsIHVubGVzcyB0aGF0IGNvbXBvbmVudAppdHNlbGYgYWNjb21wYW5pZXMg -dGhlIGV4ZWN1dGFibGUuCgpJZiBkaXN0cmlidXRpb24gb2YgZXhlY3V0YWJsZSBvciBvYmplY3Qg -Y29kZSBpcyBtYWRlIGJ5IG9mZmVyaW5nCmFjY2VzcyB0byBjb3B5IGZyb20gYSBkZXNpZ25hdGVk -IHBsYWNlLCB0aGVuIG9mZmVyaW5nIGVxdWl2YWxlbnQKYWNjZXNzIHRvIGNvcHkgdGhlIHNvdXJj -ZSBjb2RlIGZyb20gdGhlIHNhbWUgcGxhY2UgY291bnRzIGFzCmRpc3RyaWJ1dGlvbiBvZiB0aGUg -c291cmNlIGNvZGUsIGV2ZW4gdGhvdWdoIHRoaXJkIHBhcnRpZXMgYXJlIG5vdApjb21wZWxsZWQg -dG8gY29weSB0aGUgc291cmNlIGFsb25nIHdpdGggdGhlIG9iamVjdCBjb2RlLgoKXGl0ZW0KWW91 -IG1heSBub3QgY29weSwgbW9kaWZ5LCBzdWJsaWNlbnNlLCBvciBkaXN0cmlidXRlIHRoZSBQcm9n -cmFtCmV4Y2VwdCBhcyBleHByZXNzbHkgcHJvdmlkZWQgdW5kZXIgdGhpcyBMaWNlbnNlLiAgQW55 -IGF0dGVtcHQKb3RoZXJ3aXNlIHRvIGNvcHksIG1vZGlmeSwgc3VibGljZW5zZSBvciBkaXN0cmli -dXRlIHRoZSBQcm9ncmFtIGlzCnZvaWQsIGFuZCB3aWxsIGF1dG9tYXRpY2FsbHkgdGVybWluYXRl -IHlvdXIgcmlnaHRzIHVuZGVyIHRoaXMgTGljZW5zZS4KSG93ZXZlciwgcGFydGllcyB3aG8gaGF2 -ZSByZWNlaXZlZCBjb3BpZXMsIG9yIHJpZ2h0cywgZnJvbSB5b3UgdW5kZXIKdGhpcyBMaWNlbnNl -IHdpbGwgbm90IGhhdmUgdGhlaXIgbGljZW5zZXMgdGVybWluYXRlZCBzbyBsb25nIGFzIHN1Y2gK -cGFydGllcyByZW1haW4gaW4gZnVsbCBjb21wbGlhbmNlLgoKXGl0ZW0KWW91IGFyZSBub3QgcmVx -dWlyZWQgdG8gYWNjZXB0IHRoaXMgTGljZW5zZSwgc2luY2UgeW91IGhhdmUgbm90CnNpZ25lZCBp -dC4gIEhvd2V2ZXIsIG5vdGhpbmcgZWxzZSBncmFudHMgeW91IHBlcm1pc3Npb24gdG8gbW9kaWZ5 -IG9yCmRpc3RyaWJ1dGUgdGhlIFByb2dyYW0gb3IgaXRzIGRlcml2YXRpdmUgd29ya3MuICBUaGVz -ZSBhY3Rpb25zIGFyZQpwcm9oaWJpdGVkIGJ5IGxhdyBpZiB5b3UgZG8gbm90IGFjY2VwdCB0aGlz -IExpY2Vuc2UuICBUaGVyZWZvcmUsIGJ5Cm1vZGlmeWluZyBvciBkaXN0cmlidXRpbmcgdGhlIFBy -b2dyYW0gKG9yIGFueSB3b3JrIGJhc2VkIG9uIHRoZQpQcm9ncmFtKSwgeW91IGluZGljYXRlIHlv -dXIgYWNjZXB0YW5jZSBvZiB0aGlzIExpY2Vuc2UgdG8gZG8gc28sIGFuZAphbGwgaXRzIHRlcm1z -IGFuZCBjb25kaXRpb25zIGZvciBjb3B5aW5nLCBkaXN0cmlidXRpbmcgb3IgbW9kaWZ5aW5nCnRo -ZSBQcm9ncmFtIG9yIHdvcmtzIGJhc2VkIG9uIGl0LgoKXGl0ZW0KRWFjaCB0aW1lIHlvdSByZWRp -c3RyaWJ1dGUgdGhlIFByb2dyYW0gKG9yIGFueSB3b3JrIGJhc2VkIG9uIHRoZQpQcm9ncmFtKSwg -dGhlIHJlY2lwaWVudCBhdXRvbWF0aWNhbGx5IHJlY2VpdmVzIGEgbGljZW5zZSBmcm9tIHRoZQpv -cmlnaW5hbCBsaWNlbnNvciB0byBjb3B5LCBkaXN0cmlidXRlIG9yIG1vZGlmeSB0aGUgUHJvZ3Jh -bSBzdWJqZWN0IHRvCnRoZXNlIHRlcm1zIGFuZCBjb25kaXRpb25zLiAgWW91IG1heSBub3QgaW1w -b3NlIGFueSBmdXJ0aGVyCnJlc3RyaWN0aW9ucyBvbiB0aGUgcmVjaXBpZW50cycgZXhlcmNpc2Ug -b2YgdGhlIHJpZ2h0cyBncmFudGVkIGhlcmVpbi4KWW91IGFyZSBub3QgcmVzcG9uc2libGUgZm9y -IGVuZm9yY2luZyBjb21wbGlhbmNlIGJ5IHRoaXJkIHBhcnRpZXMgdG8KdGhpcyBMaWNlbnNlLgoK -XGl0ZW0KSWYsIGFzIGEgY29uc2VxdWVuY2Ugb2YgYSBjb3VydCBqdWRnbWVudCBvciBhbGxlZ2F0 -aW9uIG9mIHBhdGVudAppbmZyaW5nZW1lbnQgb3IgZm9yIGFueSBvdGhlciByZWFzb24gKG5vdCBs -aW1pdGVkIHRvIHBhdGVudCBpc3N1ZXMpLApjb25kaXRpb25zIGFyZSBpbXBvc2VkIG9uIHlvdSAo -d2hldGhlciBieSBjb3VydCBvcmRlciwgYWdyZWVtZW50IG9yCm90aGVyd2lzZSkgdGhhdCBjb250 -cmFkaWN0IHRoZSBjb25kaXRpb25zIG9mIHRoaXMgTGljZW5zZSwgdGhleSBkbyBub3QKZXhjdXNl -IHlvdSBmcm9tIHRoZSBjb25kaXRpb25zIG9mIHRoaXMgTGljZW5zZS4gIElmIHlvdSBjYW5ub3QK -ZGlzdHJpYnV0ZSBzbyBhcyB0byBzYXRpc2Z5IHNpbXVsdGFuZW91c2x5IHlvdXIgb2JsaWdhdGlv -bnMgdW5kZXIgdGhpcwpMaWNlbnNlIGFuZCBhbnkgb3RoZXIgcGVydGluZW50IG9ibGlnYXRpb25z -LCB0aGVuIGFzIGEgY29uc2VxdWVuY2UgeW91Cm1heSBub3QgZGlzdHJpYnV0ZSB0aGUgUHJvZ3Jh -bSBhdCBhbGwuICBGb3IgZXhhbXBsZSwgaWYgYSBwYXRlbnQKbGljZW5zZSB3b3VsZCBub3QgcGVy -bWl0IHJveWFsdHktZnJlZSByZWRpc3RyaWJ1dGlvbiBvZiB0aGUgUHJvZ3JhbSBieQphbGwgdGhv -c2Ugd2hvIHJlY2VpdmUgY29waWVzIGRpcmVjdGx5IG9yIGluZGlyZWN0bHkgdGhyb3VnaCB5b3Us -IHRoZW4KdGhlIG9ubHkgd2F5IHlvdSBjb3VsZCBzYXRpc2Z5IGJvdGggaXQgYW5kIHRoaXMgTGlj -ZW5zZSB3b3VsZCBiZSB0bwpyZWZyYWluIGVudGlyZWx5IGZyb20gZGlzdHJpYnV0aW9uIG9mIHRo -ZSBQcm9ncmFtLgoKSWYgYW55IHBvcnRpb24gb2YgdGhpcyBzZWN0aW9uIGlzIGhlbGQgaW52YWxp -ZCBvciB1bmVuZm9yY2VhYmxlIHVuZGVyCmFueSBwYXJ0aWN1bGFyIGNpcmN1bXN0YW5jZSwgdGhl -IGJhbGFuY2Ugb2YgdGhlIHNlY3Rpb24gaXMgaW50ZW5kZWQgdG8KYXBwbHkgYW5kIHRoZSBzZWN0 -aW9uIGFzIGEgd2hvbGUgaXMgaW50ZW5kZWQgdG8gYXBwbHkgaW4gb3RoZXIKY2lyY3Vtc3RhbmNl -cy4KCkl0IGlzIG5vdCB0aGUgcHVycG9zZSBvZiB0aGlzIHNlY3Rpb24gdG8gaW5kdWNlIHlvdSB0 -byBpbmZyaW5nZSBhbnkKcGF0ZW50cyBvciBvdGhlciBwcm9wZXJ0eSByaWdodCBjbGFpbXMgb3Ig -dG8gY29udGVzdCB2YWxpZGl0eSBvZiBhbnkKc3VjaCBjbGFpbXM7IHRoaXMgc2VjdGlvbiBoYXMg -dGhlIHNvbGUgcHVycG9zZSBvZiBwcm90ZWN0aW5nIHRoZQppbnRlZ3JpdHkgb2YgdGhlIGZyZWUg -c29mdHdhcmUgZGlzdHJpYnV0aW9uIHN5c3RlbSwgd2hpY2ggaXMKaW1wbGVtZW50ZWQgYnkgcHVi -bGljIGxpY2Vuc2UgcHJhY3RpY2VzLiAgTWFueSBwZW9wbGUgaGF2ZSBtYWRlCmdlbmVyb3VzIGNv -bnRyaWJ1dGlvbnMgdG8gdGhlIHdpZGUgcmFuZ2Ugb2Ygc29mdHdhcmUgZGlzdHJpYnV0ZWQKdGhy -b3VnaCB0aGF0IHN5c3RlbSBpbiByZWxpYW5jZSBvbiBjb25zaXN0ZW50IGFwcGxpY2F0aW9uIG9m -IHRoYXQKc3lzdGVtOyBpdCBpcyB1cCB0byB0aGUgYXV0aG9yL2Rvbm9yIHRvIGRlY2lkZSBpZiBo -ZSBvciBzaGUgaXMgd2lsbGluZwp0byBkaXN0cmlidXRlIHNvZnR3YXJlIHRocm91Z2ggYW55IG90 -aGVyIHN5c3RlbSBhbmQgYSBsaWNlbnNlZSBjYW5ub3QKaW1wb3NlIHRoYXQgY2hvaWNlLgoKVGhp -cyBzZWN0aW9uIGlzIGludGVuZGVkIHRvIG1ha2UgdGhvcm91Z2hseSBjbGVhciB3aGF0IGlzIGJl -bGlldmVkIHRvCmJlIGEgY29uc2VxdWVuY2Ugb2YgdGhlIHJlc3Qgb2YgdGhpcyBMaWNlbnNlLgoK -XGl0ZW0KSWYgdGhlIGRpc3RyaWJ1dGlvbiBhbmQvb3IgdXNlIG9mIHRoZSBQcm9ncmFtIGlzIHJl -c3RyaWN0ZWQgaW4KY2VydGFpbiBjb3VudHJpZXMgZWl0aGVyIGJ5IHBhdGVudHMgb3IgYnkgY29w -eXJpZ2h0ZWQgaW50ZXJmYWNlcywgdGhlCm9yaWdpbmFsIGNvcHlyaWdodCBob2xkZXIgd2hvIHBs -YWNlcyB0aGUgUHJvZ3JhbSB1bmRlciB0aGlzIExpY2Vuc2UKbWF5IGFkZCBhbiBleHBsaWNpdCBn -ZW9ncmFwaGljYWwgZGlzdHJpYnV0aW9uIGxpbWl0YXRpb24gZXhjbHVkaW5nCnRob3NlIGNvdW50 -cmllcywgc28gdGhhdCBkaXN0cmlidXRpb24gaXMgcGVybWl0dGVkIG9ubHkgaW4gb3IgYW1vbmcK -Y291bnRyaWVzIG5vdCB0aHVzIGV4Y2x1ZGVkLiAgSW4gc3VjaCBjYXNlLCB0aGlzIExpY2Vuc2Ug -aW5jb3Jwb3JhdGVzCnRoZSBsaW1pdGF0aW9uIGFzIGlmIHdyaXR0ZW4gaW4gdGhlIGJvZHkgb2Yg -dGhpcyBMaWNlbnNlLgoKXGl0ZW0KVGhlIEZyZWUgU29mdHdhcmUgRm91bmRhdGlvbiBtYXkgcHVi -bGlzaCByZXZpc2VkIGFuZC9vciBuZXcgdmVyc2lvbnMKb2YgdGhlIEdlbmVyYWwgUHVibGljIExp -Y2Vuc2UgZnJvbSB0aW1lIHRvIHRpbWUuICBTdWNoIG5ldyB2ZXJzaW9ucyB3aWxsCmJlIHNpbWls -YXIgaW4gc3Bpcml0IHRvIHRoZSBwcmVzZW50IHZlcnNpb24sIGJ1dCBtYXkgZGlmZmVyIGluIGRl -dGFpbCB0bwphZGRyZXNzIG5ldyBwcm9ibGVtcyBvciBjb25jZXJucy4KCkVhY2ggdmVyc2lvbiBp -cyBnaXZlbiBhIGRpc3Rpbmd1aXNoaW5nIHZlcnNpb24gbnVtYmVyLiAgSWYgdGhlIFByb2dyYW0K -c3BlY2lmaWVzIGEgdmVyc2lvbiBudW1iZXIgb2YgdGhpcyBMaWNlbnNlIHdoaWNoIGFwcGxpZXMg -dG8gaXQgYW5kIGBgYW55CmxhdGVyIHZlcnNpb24nJywgeW91IGhhdmUgdGhlIG9wdGlvbiBvZiBm -b2xsb3dpbmcgdGhlIHRlcm1zIGFuZCBjb25kaXRpb25zCmVpdGhlciBvZiB0aGF0IHZlcnNpb24g -b3Igb2YgYW55IGxhdGVyIHZlcnNpb24gcHVibGlzaGVkIGJ5IHRoZSBGcmVlClNvZnR3YXJlIEZv -dW5kYXRpb24uICBJZiB0aGUgUHJvZ3JhbSBkb2VzIG5vdCBzcGVjaWZ5IGEgdmVyc2lvbiBudW1i -ZXIgb2YKdGhpcyBMaWNlbnNlLCB5b3UgbWF5IGNob29zZSBhbnkgdmVyc2lvbiBldmVyIHB1Ymxp -c2hlZCBieSB0aGUgRnJlZSBTb2Z0d2FyZQpGb3VuZGF0aW9uLgoKXGl0ZW0KSWYgeW91IHdpc2gg -dG8gaW5jb3Jwb3JhdGUgcGFydHMgb2YgdGhlIFByb2dyYW0gaW50byBvdGhlciBmcmVlCnByb2dy -YW1zIHdob3NlIGRpc3RyaWJ1dGlvbiBjb25kaXRpb25zIGFyZSBkaWZmZXJlbnQsIHdyaXRlIHRv -IHRoZSBhdXRob3IKdG8gYXNrIGZvciBwZXJtaXNzaW9uLiAgRm9yIHNvZnR3YXJlIHdoaWNoIGlz -IGNvcHlyaWdodGVkIGJ5IHRoZSBGcmVlClNvZnR3YXJlIEZvdW5kYXRpb24sIHdyaXRlIHRvIHRo -ZSBGcmVlIFNvZnR3YXJlIEZvdW5kYXRpb247IHdlIHNvbWV0aW1lcwptYWtlIGV4Y2VwdGlvbnMg -Zm9yIHRoaXMuICBPdXIgZGVjaXNpb24gd2lsbCBiZSBndWlkZWQgYnkgdGhlIHR3byBnb2Fscwpv -ZiBwcmVzZXJ2aW5nIHRoZSBmcmVlIHN0YXR1cyBvZiBhbGwgZGVyaXZhdGl2ZXMgb2Ygb3VyIGZy -ZWUgc29mdHdhcmUgYW5kCm9mIHByb21vdGluZyB0aGUgc2hhcmluZyBhbmQgcmV1c2Ugb2Ygc29m -dHdhcmUgZ2VuZXJhbGx5LgoKXGJlZ2lue2NlbnRlcn0Ke1xMYXJnZVxzYwpObyBXYXJyYW50eQp9 -ClxlbmR7Y2VudGVyfQoKXGl0ZW0Ke1xzYyBCZWNhdXNlIHRoZSBwcm9ncmFtIGlzIGxpY2Vuc2Vk -IGZyZWUgb2YgY2hhcmdlLCB0aGVyZSBpcyBubyB3YXJyYW50eQpmb3IgdGhlIHByb2dyYW0sIHRv -IHRoZSBleHRlbnQgcGVybWl0dGVkIGJ5IGFwcGxpY2FibGUgbGF3LiAgRXhjZXB0IHdoZW4Kb3Ro -ZXJ3aXNlIHN0YXRlZCBpbiB3cml0aW5nIHRoZSBjb3B5cmlnaHQgaG9sZGVycyBhbmQvb3Igb3Ro -ZXIgcGFydGllcwpwcm92aWRlIHRoZSBwcm9ncmFtIGBgYXMgaXMnJyB3aXRob3V0IHdhcnJhbnR5 -IG9mIGFueSBraW5kLCBlaXRoZXIgZXhwcmVzc2VkCm9yIGltcGxpZWQsIGluY2x1ZGluZywgYnV0 -IG5vdCBsaW1pdGVkIHRvLCB0aGUgaW1wbGllZCB3YXJyYW50aWVzIG9mCm1lcmNoYW50YWJpbGl0 -eSBhbmQgZml0bmVzcyBmb3IgYSBwYXJ0aWN1bGFyIHB1cnBvc2UuICBUaGUgZW50aXJlIHJpc2sg -YXMKdG8gdGhlIHF1YWxpdHkgYW5kIHBlcmZvcm1hbmNlIG9mIHRoZSBwcm9ncmFtIGlzIHdpdGgg -eW91LiAgU2hvdWxkIHRoZQpwcm9ncmFtIHByb3ZlIGRlZmVjdGl2ZSwgeW91IGFzc3VtZSB0aGUg -Y29zdCBvZiBhbGwgbmVjZXNzYXJ5IHNlcnZpY2luZywKcmVwYWlyIG9yIGNvcnJlY3Rpb24ufQoK -XGl0ZW0Ke1xzYyBJbiBubyBldmVudCB1bmxlc3MgcmVxdWlyZWQgYnkgYXBwbGljYWJsZSBsYXcg -b3IgYWdyZWVkIHRvIGluIHdyaXRpbmcKd2lsbCBhbnkgY29weXJpZ2h0IGhvbGRlciwgb3IgYW55 -IG90aGVyIHBhcnR5IHdobyBtYXkgbW9kaWZ5IGFuZC9vcgpyZWRpc3RyaWJ1dGUgdGhlIHByb2dy -YW0gYXMgcGVybWl0dGVkIGFib3ZlLCBiZSBsaWFibGUgdG8geW91IGZvciBkYW1hZ2VzLAppbmNs -dWRpbmcgYW55IGdlbmVyYWwsIHNwZWNpYWwsIGluY2lkZW50YWwgb3IgY29uc2VxdWVudGlhbCBk -YW1hZ2VzIGFyaXNpbmcKb3V0IG9mIHRoZSB1c2Ugb3IgaW5hYmlsaXR5IHRvIHVzZSB0aGUgcHJv -Z3JhbSAoaW5jbHVkaW5nIGJ1dCBub3QgbGltaXRlZAp0byBsb3NzIG9mIGRhdGEgb3IgZGF0YSBi -ZWluZyByZW5kZXJlZCBpbmFjY3VyYXRlIG9yIGxvc3NlcyBzdXN0YWluZWQgYnkKeW91IG9yIHRo -aXJkIHBhcnRpZXMgb3IgYSBmYWlsdXJlIG9mIHRoZSBwcm9ncmFtIHRvIG9wZXJhdGUgd2l0aCBh -bnkgb3RoZXIKcHJvZ3JhbXMpLCBldmVuIGlmIHN1Y2ggaG9sZGVyIG9yIG90aGVyIHBhcnR5IGhh -cyBiZWVuIGFkdmlzZWQgb2YgdGhlCnBvc3NpYmlsaXR5IG9mIHN1Y2ggZGFtYWdlcy59CgpcZW5k -e2VudW1lcmF0ZX0KCgpcYmVnaW57Y2VudGVyfQp7XExhcmdlXHNjIEVuZCBvZiBUZXJtcyBhbmQg -Q29uZGl0aW9uc30KXGVuZHtjZW50ZXJ9CgoKXHBhZ2VicmVha1syXQoKXHNlY3Rpb24qe0FwcGVu -ZGl4OiBIb3cgdG8gQXBwbHkgVGhlc2UgVGVybXMgdG8gWW91ciBOZXcgUHJvZ3JhbXN9CgpJZiB5 -b3UgZGV2ZWxvcCBhIG5ldyBwcm9ncmFtLCBhbmQgeW91IHdhbnQgaXQgdG8gYmUgb2YgdGhlIGdy -ZWF0ZXN0CnBvc3NpYmxlIHVzZSB0byB0aGUgcHVibGljLCB0aGUgYmVzdCB3YXkgdG8gYWNoaWV2 -ZSB0aGlzIGlzIHRvIG1ha2UgaXQKZnJlZSBzb2Z0d2FyZSB3aGljaCBldmVyeW9uZSBjYW4gcmVk -aXN0cmlidXRlIGFuZCBjaGFuZ2UgdW5kZXIgdGhlc2UKdGVybXMuCgogIFRvIGRvIHNvLCBhdHRh -Y2ggdGhlIGZvbGxvd2luZyBub3RpY2VzIHRvIHRoZSBwcm9ncmFtLiAgSXQgaXMgc2FmZXN0IHRv -CiAgYXR0YWNoIHRoZW0gdG8gdGhlIHN0YXJ0IG9mIGVhY2ggc291cmNlIGZpbGUgdG8gbW9zdCBl -ZmZlY3RpdmVseSBjb252ZXkKICB0aGUgZXhjbHVzaW9uIG9mIHdhcnJhbnR5OyBhbmQgZWFjaCBm -aWxlIHNob3VsZCBoYXZlIGF0IGxlYXN0IHRoZQogIGBgY29weXJpZ2h0JycgbGluZSBhbmQgYSBw -b2ludGVyIHRvIHdoZXJlIHRoZSBmdWxsIG5vdGljZSBpcyBmb3VuZC4KClxiZWdpbntxdW90ZX0K -b25lIGxpbmUgdG8gZ2l2ZSB0aGUgcHJvZ3JhbSdzIG5hbWUgYW5kIGEgYnJpZWYgaWRlYSBvZiB3 -aGF0IGl0IGRvZXMuIFxcCkNvcHlyaWdodCAoQykgeXl5eSAgbmFtZSBvZiBhdXRob3IgXFwKClRo -aXMgcHJvZ3JhbSBpcyBmcmVlIHNvZnR3YXJlOyB5b3UgY2FuIHJlZGlzdHJpYnV0ZSBpdCBhbmQv -b3IgbW9kaWZ5Cml0IHVuZGVyIHRoZSB0ZXJtcyBvZiB0aGUgR05VIEdlbmVyYWwgUHVibGljIExp -Y2Vuc2UgYXMgcHVibGlzaGVkIGJ5CnRoZSBGcmVlIFNvZnR3YXJlIEZvdW5kYXRpb247IGVpdGhl -ciB2ZXJzaW9uIDIgb2YgdGhlIExpY2Vuc2UsIG9yCihhdCB5b3VyIG9wdGlvbikgYW55IGxhdGVy -IHZlcnNpb24uCgpUaGlzIHByb2dyYW0gaXMgZGlzdHJpYnV0ZWQgaW4gdGhlIGhvcGUgdGhhdCBp -dCB3aWxsIGJlIHVzZWZ1bCwKYnV0IFdJVEhPVVQgQU5ZIFdBUlJBTlRZOyB3aXRob3V0IGV2ZW4g -dGhlIGltcGxpZWQgd2FycmFudHkgb2YKTUVSQ0hBTlRBQklMSVRZIG9yIEZJVE5FU1MgRk9SIEEg -UEFSVElDVUxBUiBQVVJQT1NFLiAgU2VlIHRoZQpHTlUgR2VuZXJhbCBQdWJsaWMgTGljZW5zZSBm -b3IgbW9yZSBkZXRhaWxzLgoKWW91IHNob3VsZCBoYXZlIHJlY2VpdmVkIGEgY29weSBvZiB0aGUg -R05VIEdlbmVyYWwgUHVibGljIExpY2Vuc2UKYWxvbmcgd2l0aCB0aGlzIHByb2dyYW07IGlmIG5v -dCwgd3JpdGUgdG8gdGhlIEZyZWUgU29mdHdhcmUKRm91bmRhdGlvbiwgSW5jLiwgNTkgVGVtcGxl -IFBsYWNlIC0gU3VpdGUgMzMwLCBCb3N0b24sIE1BICAwMjExMS0xMzA3LCBVU0EuClxlbmR7cXVv -dGV9CgpBbHNvIGFkZCBpbmZvcm1hdGlvbiBvbiBob3cgdG8gY29udGFjdCB5b3UgYnkgZWxlY3Ry -b25pYyBhbmQgcGFwZXIgbWFpbC4KCklmIHRoZSBwcm9ncmFtIGlzIGludGVyYWN0aXZlLCBtYWtl -IGl0IG91dHB1dCBhIHNob3J0IG5vdGljZSBsaWtlIHRoaXMKd2hlbiBpdCBzdGFydHMgaW4gYW4g -aW50ZXJhY3RpdmUgbW9kZToKClxiZWdpbntxdW90ZX0KR25vbW92aXNpb24gdmVyc2lvbiA2OSwg -Q29weXJpZ2h0IChDKSB5eXl5ICBuYW1lIG9mIGF1dGhvciBcXApHbm9tb3Zpc2lvbiBjb21lcyB3 -aXRoIEFCU09MVVRFTFkgTk8gV0FSUkFOVFk7IGZvciBkZXRhaWxzIHR5cGUgYHNob3cgdycuIFxc -ClRoaXMgaXMgZnJlZSBzb2Z0d2FyZSwgYW5kIHlvdSBhcmUgd2VsY29tZSB0byByZWRpc3RyaWJ1 -dGUgaXQKdW5kZXIgY2VydGFpbiBjb25kaXRpb25zOyB0eXBlIGBzaG93IGMnIGZvciBkZXRhaWxz -LgpcZW5ke3F1b3RlfQoKClRoZSBoeXBvdGhldGljYWwgY29tbWFuZHMge1x0dCBzaG93IHd9IGFu -ZCB7XHR0IHNob3cgY30gc2hvdWxkIHNob3cgdGhlCmFwcHJvcHJpYXRlIHBhcnRzIG9mIHRoZSBH -ZW5lcmFsIFB1YmxpYyBMaWNlbnNlLiAgT2YgY291cnNlLCB0aGUgY29tbWFuZHMKeW91IHVzZSBt -YXkgYmUgY2FsbGVkIHNvbWV0aGluZyBvdGhlciB0aGFuIHtcdHQgc2hvdyB3fSBhbmQge1x0dCBz -aG93IGN9Owp0aGV5IGNvdWxkIGV2ZW4gYmUgbW91c2UtY2xpY2tzIG9yIG1lbnUgaXRlbXMtLS13 -aGF0ZXZlciBzdWl0cyB5b3VyCnByb2dyYW0uCgpZb3Ugc2hvdWxkIGFsc28gZ2V0IHlvdXIgZW1w -bG95ZXIgKGlmIHlvdSB3b3JrIGFzIGEgcHJvZ3JhbW1lcikgb3IgeW91cgpzY2hvb2wsIGlmIGFu -eSwgdG8gc2lnbiBhIGBgY29weXJpZ2h0IGRpc2NsYWltZXInJyBmb3IgdGhlIHByb2dyYW0sIGlm -Cm5lY2Vzc2FyeS4gIEhlcmUgaXMgYSBzYW1wbGU7IGFsdGVyIHRoZSBuYW1lczoKClxiZWdpbntx -dW90ZX0KWW95b2R5bmUsIEluYy4sIGhlcmVieSBkaXNjbGFpbXMgYWxsIGNvcHlyaWdodCBpbnRl -cmVzdCBpbiB0aGUgcHJvZ3JhbSBcXApgR25vbW92aXNpb24nICh3aGljaCBtYWtlcyBwYXNzZXMg -YXQgY29tcGlsZXJzKSB3cml0dGVuIGJ5IEphbWVzIEhhY2tlci4gXFwKCnNpZ25hdHVyZSBvZiBU -eSBDb29uLCAxIEFwcmlsIDE5ODkgXFwKVHkgQ29vbiwgUHJlc2lkZW50IG9mIFZpY2UKXGVuZHtx -dW90ZX0KCgpUaGlzIEdlbmVyYWwgUHVibGljIExpY2Vuc2UgZG9lcyBub3QgcGVybWl0IGluY29y -cG9yYXRpbmcgeW91ciBwcm9ncmFtCmludG8gcHJvcHJpZXRhcnkgcHJvZ3JhbXMuICBJZiB5b3Vy -IHByb2dyYW0gaXMgYSBzdWJyb3V0aW5lIGxpYnJhcnksIHlvdQptYXkgY29uc2lkZXIgaXQgbW9y -ZSB1c2VmdWwgdG8gcGVybWl0IGxpbmtpbmcgcHJvcHJpZXRhcnkgYXBwbGljYXRpb25zCndpdGgg -dGhlIGxpYnJhcnkuICBJZiB0aGlzIGlzIHdoYXQgeW91IHdhbnQgdG8gZG8sIHVzZSB0aGUgR05V -IExpYnJhcnkKR2VuZXJhbCBQdWJsaWMgTGljZW5zZSBpbnN0ZWFkIG9mIHRoaXMgTGljZW5zZS4K -Cgo= -" ++ Glurf ++ lists:reverse(Glurf++"kalle"). diff --git a/lib/compiler/test/compilation_SUITE_data/nested_tuples_in_case_expr.erl b/lib/compiler/test/compilation_SUITE_data/nested_tuples_in_case_expr.erl deleted file mode 100644 index bbacb7cf14..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/nested_tuples_in_case_expr.erl +++ /dev/null @@ -1,37 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(nested_tuples_in_case_expr). --export([nested_tuples_in_case_expr/0,t/2]). - -nested_tuples_in_case_expr() -> - ok. - -t(A, B) -> - case {{element(1, A),element(2, B)},{element(2, A),element(2, B)}} of - {Same,Same} -> ok; - {{0,1},{up,X}} -> bar(X); - {_,{X,_}} -> bar(X) - end. - -bar(X) -> X. - - - - diff --git a/lib/compiler/test/compilation_SUITE_data/otp_2141.erl b/lib/compiler/test/compilation_SUITE_data/otp_2141.erl deleted file mode 100644 index 4737d0972e..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_2141.erl +++ /dev/null @@ -1,25 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_2141). --export([otp_2141/0]). - - -otp_2141() -> - ok. diff --git a/lib/compiler/test/compilation_SUITE_data/otp_2173.erl b/lib/compiler/test/compilation_SUITE_data/otp_2173.erl deleted file mode 100644 index 5479700d1d..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_2173.erl +++ /dev/null @@ -1,32 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_2173). --compile(export_all). - --record(t, {a = fun(X) -> X*X end}). - -otp_2173() -> - ok. - -t() -> - #t{}. - - - diff --git a/lib/compiler/test/compilation_SUITE_data/otp_5076.erl b/lib/compiler/test/compilation_SUITE_data/otp_5076.erl deleted file mode 100644 index 19f974bb5b..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_5076.erl +++ /dev/null @@ -1,28 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_5076). --export([?MODULE/0]). - -?MODULE() -> - [] = t(), - ok. - -t() -> - [3 || {3=4} <- []]. diff --git a/lib/compiler/test/compilation_SUITE_data/otp_5092.erl b/lib/compiler/test/compilation_SUITE_data/otp_5092.erl deleted file mode 100644 index 88c4519cc6..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_5092.erl +++ /dev/null @@ -1,40 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_5092). --export([?MODULE/0]). - -?MODULE() -> - [] = t(), - [] = t2(), - [t] = t4(), - [] = t5(), - ok. - -t() -> - [t || {C=D}={_,_} <- []]. - -t2() -> - [X || {X,{Y}={X,X}} <- []]. - -t4() -> - [t || "a"++"b" = "ab" <- ["ab"]]. - -t5() -> - [{X,Y} || {X} <- [], begin Y = X, Y =:= X end]. diff --git a/lib/compiler/test/compilation_SUITE_data/otp_5244.erl b/lib/compiler/test/compilation_SUITE_data/otp_5244.erl deleted file mode 100644 index 8144e5a225..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_5244.erl +++ /dev/null @@ -1,48 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_5244). --export([?MODULE/0]). - -?MODULE() -> - L = [{stretch,0,0}, - {bad,[]}, - {bad,atom}, - {bad,0}, - {bad,16#AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA}, - {bad,16#555555555555555555555555555555555555555555555555555}], - remove_failure(L, unit, 0). - -remove_failure([], _Unit, _MaxFailure) -> - ok; -remove_failure([{bad,Bad}|_], _Unit, _MaxFailure) -> - Bad; -remove_failure([{stretch,_,Mi}=Stretch | Specs], Unit, _MaxFailure) -> - {MinMax,NewMaxFailure} = max_failure(), - case {MinMax,remove_failure(Specs, Unit, NewMaxFailure)} of - {min,{NewMaxFailure,Rest}} -> - {done,[{fixed,Mi} | Rest]}; - {min,_} when Specs =/= [] -> - remove_failure([Stretch|tl(Specs)], Unit, NewMaxFailure); - {min,_} -> - ok - end. - -max_failure() -> - {min,1}. diff --git a/lib/compiler/test/compilation_SUITE_data/otp_6121a.erl b/lib/compiler/test/compilation_SUITE_data/otp_6121a.erl deleted file mode 100644 index a8fc5f3bb5..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_6121a.erl +++ /dev/null @@ -1,33 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_6121a). --export([?MODULE/0]). - -%% Thanks to Martin Bjorklund. - -?MODULE() -> - G = fun() -> ok end, - try - fun() -> ok end - after - fun({A, B}) -> A + B end - end, - ok. - diff --git a/lib/compiler/test/compilation_SUITE_data/otp_6121b.erl b/lib/compiler/test/compilation_SUITE_data/otp_6121b.erl deleted file mode 100644 index df2e60deb5..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_6121b.erl +++ /dev/null @@ -1,34 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_6121b). --export([?MODULE/0]). - -%% Thanks to Tim Rath. - -?MODULE() -> - A = {6}, - try - io:fwrite("") - after - fun () -> - fun () -> {B} = A end - end - end. - diff --git a/lib/compiler/test/compilation_SUITE_data/pattern_expr.erl b/lib/compiler/test/compilation_SUITE_data/pattern_expr.erl deleted file mode 100644 index a78b3501d1..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/pattern_expr.erl +++ /dev/null @@ -1,31 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(pattern_expr). - --export(pattern_expr/0). - -pattern_expr() -> - f(). - -f() -> - case 4 of - 2+2 -> - ok - end. diff --git a/lib/compiler/test/compilation_SUITE_data/trycatch_4.erl b/lib/compiler/test/compilation_SUITE_data/trycatch_4.erl deleted file mode 100644 index f465376bdc..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/trycatch_4.erl +++ /dev/null @@ -1,51 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(trycatch_4). --export([trycatch_4/0]). --record(state, {foo}). - -trycatch_4() -> - handle_info({foo}, #state{}), - ok. - -handle_info({_}, State) -> - foo(), - State#state{foo = bar}, - case ok of - _ -> - case catch foo() of - ok -> - {stop, State} - end - end; -handle_info(_, State) -> - (catch begin - foo(), - State#state{foo = bar} - end), - case ok of - _ -> - case catch foo() of - ok -> - {stop, State} - end - end. - -foo() -> ok. diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index e1db99b357..e634f0fcc2 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -31,13 +31,12 @@ binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1, other_output/1, encrypted_abstr/1, strict_record/1, - missing_testheap/1, cover/1, env/1, core/1, asm/1, + cover/1, env/1, core/1, + core_roundtrip/1, asm/1, sys_pre_attributes/1, dialyzer/1, warnings/1, pre_load_check/1 ]). --export([init/3]). - suite() -> [{ct_hooks,[ts_install_cth]}]. %% To cover the stripping of 'type' and 'spec' in beam_asm. @@ -50,7 +49,7 @@ all() -> binary, makedep, cond_and_ifdef, listings, listings_big, other_output, encrypted_abstr, strict_record, - missing_testheap, cover, env, core, asm, + cover, env, core, core_roundtrip, asm, sys_pre_attributes, dialyzer, warnings, pre_load_check]. groups() -> @@ -545,7 +544,6 @@ verify_abstract(Target) -> has_crypto() -> try crypto:start(), - <<_,_,_,_,_>> = crypto:rand_bytes(5), crypto:stop(), true catch @@ -649,46 +647,6 @@ test_sloppy() -> {1,2} = record_access:test(Turtle), Turtle. -missing_testheap(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - PrivDir = proplists:get_value(priv_dir, Config), - Opts = [{outdir,PrivDir}], - OldPath = code:get_path(), - try - code:add_patha(PrivDir), - c:c(filename:join(DataDir, "missing_testheap1"), Opts), - c:c(filename:join(DataDir, "missing_testheap2"), Opts), - ok = test(fun() -> - missing_testheap1:f({a,self()},{state,true,b}) - end, {a,b}), - ok = test(fun() -> - missing_testheap2:f({a,self()},16#80000000) end, - bigger) - after - code:set_path(OldPath), - file:delete(filename:join(PrivDir, "missing_testheap1.beam")), - file:delete(filename:join(PrivDir, "missing_testheap2.beam")) - end, - ok. - -test(Fun, Result) -> - test(500, Fun, Result, []). - -test(0, _, _, _) -> - ok; -test(Iter, Fun, Result, Filler) -> - spawn(?MODULE, init, [self(), Fun, list_to_tuple(Filler)]), - receive - {result, Result} -> - test(Iter-1, Fun, Result, [0|Filler]); - {result, Other} -> - io:format("Expected ~p; got ~p~n", [Result, Other]), - ct:fail(failed) - end. - -init(ReplyTo, Fun, _Filler) -> - ReplyTo ! {result, Fun()}. - env(Config) when is_list(Config) -> {Simple,Target} = get_files(Config, simple, env), {ok,Cwd} = file:get_cwd(), @@ -790,6 +748,120 @@ compile_forms(Forms, Opts) -> Other -> throw({error,Other}) end. +%% Pretty-print core and read it back. Should be identical. + +core_roundtrip(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + Outdir = filename:join(PrivDir, atom_to_list(?FUNCTION_NAME)), + ok = file:make_dir(Outdir), + + Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"), + TestBeams = filelib:wildcard(Wc), + test_lib:p_run(fun(F) -> do_core_roundtrip(F, Outdir) end, TestBeams). + +do_core_roundtrip(Beam, Outdir) -> + try + {ok,{Mod,[{abstract_code,{raw_abstract_v1,Abstr}}]}} = + beam_lib:chunks(Beam, [abstract_code]), + do_core_roundtrip_1(Mod, Abstr, Outdir) + catch + throw:{error,Error} -> + io:format("*** compilation failure '~p' for file ~s\n", + [Error,Beam]), + error; + Class:Error -> + io:format("~p: ~p ~p\n~p\n", + [Beam,Class,Error,erlang:get_stacktrace()]), + error + end. + +do_core_roundtrip_1(Mod, Abstr, Outdir) -> + {ok,Mod,Core0} = compile:forms(Abstr, [to_core0]), + do_core_roundtrip_2(Mod, Core0, Outdir), + + %% Primarily, test that annotations are accepted for all + %% constructs. Secondarily, smoke test cerl_trees:label/1. + {Core,_} = cerl_trees:label(Core0), + do_core_roundtrip_2(Mod, Core, Outdir). + +do_core_roundtrip_2(M, Core0, Outdir) -> + CoreFile = filename:join(Outdir, atom_to_list(M)++".core"), + CorePP = core_pp:format_all(Core0), + ok = file:write_file(CoreFile, CorePP), + + %% Parse the .core file and return the result as Core Erlang Terms. + Core2 = case compile:file(CoreFile, [report_errors,from_core, + no_copt,to_core,binary]) of + {ok,M,Core1} -> Core1; + Other -> throw({error,Other}) + end, + Core = undo_var_translation(Core2), + ok = file:delete(CoreFile), + + case cmp_core(Core0, Core, M) of + true -> ok; + false -> error + end, + + ok. + +undo_var_translation(Tree) -> + F = fun(Node) -> + case cerl:is_c_var(Node) of + true -> + Name0 = cerl:var_name(Node), + try atom_to_list(Name0) of + "_X"++Name -> + cerl:update_c_var(Node, list_to_atom(Name)); + "_"++Name -> + cerl:update_c_var(Node, list_to_atom(Name)); + _ -> + Node + catch + error:badarg -> + Node + + end; + false -> + Node + end + end, + cerl_trees:map(F, Tree). + +cmp_core(E, E, _Mod) -> + true; +cmp_core(M1, M2, Mod) -> + cmp_core_fs(cerl:module_defs(M1), cerl:module_defs(M2), Mod). + +cmp_core_fs([F1|T1], [F2|T2], Mod) -> + cmp_core_f(F1, F2, Mod) andalso cmp_core_fs(T1, T2, Mod); +cmp_core_fs([], [], _Mod) -> + true; +cmp_core_fs(_, _, _Mod) -> + false. + +cmp_core_f(E, E, _Mod) -> + true; +cmp_core_f({Name,F1}, {Name,F2}, Mod) -> + case diff(F1, F2) of + F1 -> + true; + Diff -> + io:format("~p ~p:\n~p\n", [Mod,Name,Diff]), + false + end. + +diff(E, E) -> + E; +diff([H1|T1], [H2|T2]) -> + [diff(H1, H2)|diff(T1, T2)]; +diff(T1, T2) when tuple_size(T1) =:= tuple_size(T2) -> + L = diff(tuple_to_list(T1), tuple_to_list(T2)), + list_to_tuple(L); +diff(E1, E2) -> + {'DIFF',E1,E2}. + + %% Compile to Beam assembly language (.S) and then try to %% run .S through the compiler again. diff --git a/lib/compiler/test/compile_SUITE_data/missing_testheap1.erl b/lib/compiler/test/compile_SUITE_data/missing_testheap1.erl deleted file mode 100644 index 2c1eb8a3ae..0000000000 --- a/lib/compiler/test/compile_SUITE_data/missing_testheap1.erl +++ /dev/null @@ -1,36 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(missing_testheap1). - --compile(export_all). -%%-export([Function/Arity, ...]). --record(state,{e1,e2}). - -f({a,DpId},State) when State == -#state{e1=true, - e2=a} -> - {a,a}; - -f({a,DpId},State) when State == -#state{e1=true, - e2=b} -> - {a,b}. - - diff --git a/lib/compiler/test/compile_SUITE_data/missing_testheap2.erl b/lib/compiler/test/compile_SUITE_data/missing_testheap2.erl deleted file mode 100644 index b2aa9b5a5a..0000000000 --- a/lib/compiler/test/compile_SUITE_data/missing_testheap2.erl +++ /dev/null @@ -1,30 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(missing_testheap2). - --compile(export_all). - -f({a,DpId},16#7fffffff) -> - big; - -f({a,DpId},16#80000000) -> - bigger. - - diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index ffbf59f0ee..13d274d98a 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -28,7 +28,7 @@ or_guard/1,more_or_guards/1, complex_or_guards/1,and_guard/1, xor_guard/1,more_xor_guards/1, - old_guard_tests/1, + old_guard_tests/1,complex_guard/1, build_in_guard/1,gbif/1, t_is_boolean/1,is_function_2/1, tricky/1,rel_ops/1,rel_op_combinations/1,literal_type_tests/1, @@ -48,7 +48,8 @@ groups() -> [misc,const_cond,basic_not,complex_not,nested_nots, semicolon,complex_semicolon,comma,or_guard, more_or_guards,complex_or_guards,and_guard,xor_guard, - more_xor_guards,build_in_guard,old_guard_tests,gbif, + more_xor_guards,build_in_guard, + old_guard_tests,complex_guard,gbif, t_is_boolean,is_function_2,tricky, rel_ops,rel_op_combinations, literal_type_tests,basic_andalso_orelse,traverse_dcd, @@ -947,6 +948,26 @@ og(_) -> what. on(V) when number(V) -> number; on(_) -> not_number. +complex_guard(_Config) -> + _ = [true = do_complex_guard(X, Y, Z) || + X <- [4,5], Y <- [4,5], Z <- [4,5]], + _ = [true = do_complex_guard(X, Y, Z) || + X <- [1,2,3], Y <- [1,2,3], Z <- [1,2,3]], + _ = [catch do_complex_guard(X, Y, Z) || + X <- [1,2,3,4,5], Y <- [0,6], Z <- [1,2,3,4,5]], + ok. + +do_complex_guard(X1, Y1, Z1) -> + if + ((X1 =:= 4) or (X1 =:= 5)) and + ((Y1 =:= 4) or (Y1 =:= 5)) and + ((Z1 =:= 4) or (Z1 =:= 5)) or + ((X1 =:= 1) or (X1 =:= 2) or (X1 =:= 3)) and + ((Y1 =:= 1) or (Y1 =:= 2) or (Y1 =:= 3)) and + ((Z1 =:= 1) or (Z1 =:= 2) or (Z1 =:= 3)) -> + true + end. + gbif(Config) when is_list(Config) -> error = gbif_1(1, {false,true}), ok = gbif_1(2, {false,true}), diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index dd0bcb4245..3cb49433ce 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -89,6 +89,18 @@ basic(Config) when is_list(Config) -> %% Filter expressions with andalso/orelse. "abc123" = alphanum("?abc123.;"), + %% Aliased patterns. + [] = [t || {C=D}={_,_} <- []], + [] = [X || {X,{Y}={X,X}} <- []], + [t] = [t || "a"++"b" = "ab" <- ["ab"]], + + %% Strange filter block. + [] = [{X,Y} || {X} <- [], begin Y = X, Y =:= X end], + [{a,a}] = [{X,Y} || {X} <- [{a}], begin Y = X, Y =:= X end], + + %% Not matching. + [] = [3 || {3=4} <- []], + %% Error cases. [] = [{xx,X} || X <- L0, element(2, X) == no_no_no], {'EXIT',_} = (catch [X || X <- L1, list_to_atom(X) == dum]), diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index f6a24b3211..92a9802cad 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -24,7 +24,7 @@ pmatch/1,mixed/1,aliases/1,match_in_call/1, untuplify/1,shortcut_boolean/1,letify_guard/1, selectify/1,underscore/1,match_map/1,map_vars_used/1, - coverage/1]). + coverage/1,grab_bag/1]). -include_lib("common_test/include/ct.hrl"). @@ -38,7 +38,8 @@ groups() -> [{p,[parallel], [pmatch,mixed,aliases,match_in_call,untuplify, shortcut_boolean,letify_guard,selectify, - underscore,match_map,map_vars_used,coverage]}]. + underscore,match_map,map_vars_used,coverage, + grab_bag]}]. init_per_suite(Config) -> @@ -93,9 +94,9 @@ mixit(X) -> 2 -> b; 3 -> 42; 4 -> 77; - 5 -> blurf; - 6 -> 87987987; - 7 -> {a,b,c} + 4+1 -> blurf; + 5+1 -> 87987987; + 6+1 -> {a,b,c} end of a -> glufs; b -> klafs; @@ -149,6 +150,9 @@ aliases(Config) when is_list(Config) -> none = mixed_aliases({a,42}), none = mixed_aliases(42), + %% Non-matching aliases. + {'EXIT',{{badmatch,42},_}} = (catch nomatch_alias(42)), + ok. str_alias(V) -> @@ -258,6 +262,10 @@ mixed_aliases(<<X:8>> = {a,X}) -> {c,X}; mixed_aliases([X] = <<X:8>>) -> {d,X}; mixed_aliases(_) -> none. +nomatch_alias(I) -> + {ok={A,B}} = id(I), + {A,B}. + %% OTP-7018. match_in_call(Config) when is_list(Config) -> @@ -465,4 +473,53 @@ coverage_2(2, b, x) -> ok. coverage_3([$a]++[]++"bc") -> ok. +grab_bag(_Config) -> + [_|T] = id([a,b,c]), + [b,c] = id(T), + + T1 = fun() -> + [_|_] = x + end, + {'EXIT',_} = (catch T1()), + + T2 = fun(A, B) -> + case {{element(1, A),element(2, B)}, + {element(2, A),element(2, B)}} of + {Same,Same} -> ok; + {{0,1},{up,X}} -> id(X); + {_,{X,_}} -> id(X) + end + end, + ok = T2({a,a,z,z}, {z,a,z}), + 1 = T2({0,up}, {zzz,1}), + y = T2({x,y}, {a,z,z}), + + %% OTP-5244. + L = [{stretch,0,0}, + {bad,[]}, + {bad,atom}, + {bad,0}, + {bad,16#AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA}, + {bad,16#555555555555555555555555555555555555555555555555555}], + ok = grab_bag_remove_failure(L, unit, 0), + + ok. + +grab_bag_remove_failure([], _Unit, _MaxFailure) -> + ok; +grab_bag_remove_failure([{bad,Bad}|_], _Unit, _MaxFailure) -> + Bad; +grab_bag_remove_failure([{stretch,_,Mi}=Stretch | Specs], Unit, _MaxFailure) -> + {MinMax,NewMaxFailure} = id({min,1}), + case {MinMax,grab_bag_remove_failure(Specs, Unit, NewMaxFailure)} of + {min,{NewMaxFailure,Rest}} -> + {done,[{fixed,Mi} | Rest]}; + {min,_} when Specs =/= [] -> + grab_bag_remove_failure([Stretch|tl(Specs)], Unit, NewMaxFailure); + {min,_} -> + ok + end. + + + id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 8f9ed685bf..f05fe6c943 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -23,7 +23,8 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, tobias/1,empty_string/1,md5/1,silly_coverage/1, - confused_literals/1,integer_encoding/1,override_bif/1]). + confused_literals/1,integer_encoding/0,integer_encoding/1, + override_bif/1]). -include_lib("common_test/include/ct.hrl"). diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl index 4f048f5080..5546765f26 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -28,7 +28,7 @@ init_per_testcase/2,end_per_testcase/2, errors/1,record_test_2/1,record_test_3/1,record_access_in_guards/1, guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1, - nested_access/1,coverage/1]). + nested_access/1,coverage/1,grab_bag/1]). init_per_testcase(_Case, Config) -> Config. @@ -48,7 +48,7 @@ groups() -> [{p,test_lib:parallel(), [errors,record_test_2,record_test_3, record_access_in_guards,guard_opt,eval_once,foobar, - missing_test_heap,nested_access,coverage]}]. + missing_test_heap,nested_access,coverage,grab_bag]}]. init_per_suite(Config) -> @@ -601,4 +601,60 @@ coverage(Config) when is_list(Config) -> #rr{a=1,b=2,c=42} = id(R), %Test for correctness. ok. + +-record(default_fun, {a = fun(X) -> X*X end}). + +%% compiler treats records with 1 and 2 fields differently... +-record(gb_nil, {}). +-record(gb_foo, {hello=1}). +-record(gb_bar, {hello=2,there=3}). + +%% Taken from compilation_SUITE. +grab_bag(_Config) -> + T1 = fun() -> + X = #foo{}, + Y = #foo{}, + {X#foo.a == Y#foo.a,X#foo.b} + end, + {true,undefined} = T1(), + + T2 = fun(X, Y) -> + first_arg(X#foo.a =/= Y#foo.a, X#foo.b =/= X#foo.b) + end, + true = T2(#foo{a=x,b=z}, #foo{a=y,b=z}), + + T3 = fun() -> + #default_fun{a=Fun} = id(#default_fun{}), + 9 = Fun(3) + end, + T3(), + + %% Stupid code, but the compiler used to crash. + T4 = fun() -> + F0 = fun() -> + R1 = #gb_nil{}, + R2 = R1#gb_nil{}, + R1 = R2 + end, + F1 = fun() -> + R1 = #gb_foo{}, + R2 = R1#gb_foo{}, + R1 = R2 + end, + + F2 = fun() -> + R1 = #gb_bar{}, + R2 = R1#gb_bar{}, + R1 = R2 + end, + F0(), + F1(), + F2() + end, + T4(), + + ok. + +first_arg(First, _) -> First. + id(I) -> I. diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 5e0bb6d00a..f7ad78cb8d 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -26,7 +26,7 @@ nested_of/1,nested_catch/1,nested_after/1, nested_horrid/1,last_call_optimization/1,bool/1, plain_catch_coverage/1,andalso_orelse/1,get_in_try/1, - hockey/1]). + hockey/1,handle_info/1,catch_in_catch/1,grab_bag/1]). -include_lib("common_test/include/ct.hrl"). @@ -42,7 +42,7 @@ groups() -> after_oops,eclectic,rethrow,nested_of,nested_catch, nested_after,nested_horrid,last_call_optimization, bool,plain_catch_coverage,andalso_orelse,get_in_try, - hockey]}]. + hockey,handle_info,catch_in_catch,grab_bag]}]. init_per_suite(Config) -> @@ -919,8 +919,6 @@ andalso_orelse_1(A, B) -> catched end,B}. -id(I) -> I. - andalso_orelse_2({Type,Keyval}) -> try if is_atom(Type) andalso length(Keyval) > 0 -> ok; @@ -957,3 +955,86 @@ hockey() -> receive _ -> (b = fun() -> ok end) + hockey, +x after 0 -> ok end, try (a = fun() -> ok end) + hockey, + y catch _ -> ok end. + + +-record(state, {foo}). + +handle_info(_Config) -> + do_handle_info({foo}, #state{}), + ok. + +do_handle_info({_}, State) -> + handle_info_ok(), + State#state{foo = bar}, + case ok of + _ -> + case catch handle_info_ok() of + ok -> + {stop, State} + end + end; +do_handle_info(_, State) -> + (catch begin + handle_info_ok(), + State#state{foo = bar} + end), + case ok of + _ -> + case catch handle_info_ok() of + ok -> + {stop, State} + end + end. + +handle_info_ok() -> ok. + +'catch_in_catch'(_Config) -> + process_flag(trap_exit, true), + Pid = spawn_link(fun() -> + catch_in_catch_init(x), + exit(good_exit) + end), + receive + {'EXIT',Pid,good_exit} -> + ok; + Other -> + io:format("Unexpected: ~p\n", [Other]), + error + after 32000 -> + io:format("No message received\n"), + error + end. + +'catch_in_catch_init'(Param) -> + process_flag(trap_exit, true), + %% The catches were improperly nested, causing a "No catch found" crash. + (catch begin + id(Param), + (catch exit(bar)) + end + ), + ignore. + +grab_bag(_Config) -> + %% Thanks to Martin Bjorklund. + _ = fun() -> ok end, + try + fun() -> ok end + after + fun({A, B}) -> A + B end + end, + + %% Thanks to Tim Rath. + A = {6}, + try + io:fwrite("") + after + fun () -> + fun () -> {_} = A end + end + end, + + ok. + + +id(I) -> I. diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 768922d57a..067e220863 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -214,7 +214,6 @@ static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -285,7 +284,6 @@ static ErlNifFunc nif_funcs[] = { {"aes_ctr_stream_decrypt", 2, aes_ctr_stream_encrypt}, {"rand_bytes", 1, rand_bytes_1}, {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif}, - {"rand_bytes", 3, rand_bytes_3}, {"strong_rand_mpint_nif", 3, strong_rand_mpint_nif}, {"rand_uniform_nif", 2, rand_uniform_nif}, {"mod_exp_nif", 4, mod_exp_nif}, @@ -314,7 +312,7 @@ static ErlNifFunc nif_funcs[] = { {"rand_seed_nif", 1, rand_seed_nif}, - {"aes_gcm_encrypt", 4, aes_gcm_encrypt}, + {"aes_gcm_encrypt", 5, aes_gcm_encrypt}, {"aes_gcm_decrypt", 5, aes_gcm_decrypt}, {"chacha20_poly1305_encrypt", 4, chacha20_poly1305_encrypt}, @@ -1648,6 +1646,7 @@ static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM EVP_CIPHER_CTX ctx; const EVP_CIPHER *cipher = NULL; ErlNifBinary key, iv, aad, in; + unsigned int tag_len; unsigned char *outp, *tagp; ERL_NIF_TERM out, out_tag; int len; @@ -1656,7 +1655,8 @@ static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM || (key.size != 16 && key.size != 24 && key.size != 32) || !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[3], &in) + || !enif_get_uint(env, argv[4], &tag_len) || tag_len < 1 || tag_len > 16) { return enif_make_badarg(env); } @@ -1688,9 +1688,9 @@ static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM if (EVP_EncryptFinal_ex(&ctx, outp+len, &len) != 1) goto out_err; - tagp = enif_make_new_binary(env, EVP_GCM_TLS_TAG_LEN, &out_tag); + tagp = enif_make_new_binary(env, tag_len, &out_tag); - if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_GET_TAG, EVP_GCM_TLS_TAG_LEN, tagp) != 1) + if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_GET_TAG, tag_len, tagp) != 1) goto out_err; EVP_CIPHER_CTX_cleanup(&ctx); @@ -1723,7 +1723,7 @@ static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM || !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) { + || !enif_inspect_iolist_as_binary(env, argv[4], &tag)) { return enif_make_badarg(env); } @@ -1749,7 +1749,7 @@ static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM if (EVP_DecryptUpdate(&ctx, outp, &len, in.data, in.size) != 1) goto out_err; - if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_TAG, EVP_GCM_TLS_TAG_LEN, tag.data) != 1) + if (EVP_CIPHER_CTX_ctrl(&ctx, EVP_CTRL_GCM_SET_TAG, tag.size, tag.data) != 1) goto out_err; if (EVP_DecryptFinal_ex(&ctx, outp+len, &len) != 1) goto out_err; @@ -1925,27 +1925,7 @@ static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NI return ret; } -static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Bytes, TopMask, BottomMask) */ - unsigned bytes; - unsigned char* data; - unsigned top_mask, bot_mask; - ERL_NIF_TERM ret; - if (!enif_get_uint(env, argv[0], &bytes) - || !enif_get_uint(env, argv[1], &top_mask) - || !enif_get_uint(env, argv[2], &bot_mask)) { - return enif_make_badarg(env); - } - data = enif_make_new_binary(env, bytes, &ret); - RAND_pseudo_bytes(data, bytes); - ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes); - if (bytes > 0) { - data[bytes-1] |= top_mask; - data[0] |= bot_mask; - } - return ret; -} static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Bytes, TopMask, BottomMask) */ unsigned bits; diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 60fdc627fd..5a5627747c 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -203,6 +203,7 @@ <func> <name>block_encrypt(Type, Key, Ivec, PlainText) -> CipherText</name> <name>block_encrypt(AeadType, Key, Ivec, {AAD, PlainText}) -> {CipherText, CipherTag}</name> + <name>block_encrypt(aes_gcm, Key, Ivec, {AAD, PlainText, TagLength}) -> {CipherText, CipherTag}</name> <fsummary>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher</fsummary> <type> <v>Type = block_cipher() </v> @@ -210,6 +211,7 @@ <v>Key = block_key() </v> <v>PlainText = iodata() </v> <v>AAD = IVec = CipherText = CipherTag = binary()</v> + <v>TagLength = 1..16</v> </type> <desc> <p>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher. @@ -306,6 +308,8 @@ <desc> <p>Generates public keys of type <c>Type</c>. See also <seealso marker="public_key:public_key#generate_key-1">public_key:generate_key/1</seealso> + May throw exception <c>low_entropy</c> in case the random generator + failed due to lack of secure "randomness". </p> </desc> </func> @@ -594,22 +598,6 @@ </func> <func> - <name>rand_bytes(N) -> binary()</name> - <fsummary>Generate a binary of random bytes</fsummary> - <type> - <v>N = integer()</v> - </type> - <desc> - <p>Generates N bytes randomly uniform 0..255, and returns the - result in a binary. Uses the <c>crypto</c> library pseudo-random - number generator.</p> - <p>This function is not recommended for cryptographic purposes. - Please use <seealso marker="#strong_rand_bytes/1"> - strong_rand_bytes/1</seealso> instead.</p> - </desc> - </func> - - <func> <name>rand_seed(Seed) -> ok</name> <fsummary>Set the seed for random bytes generation</fsummary> <type> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index fb252118a3..025d57e9c5 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -28,7 +28,7 @@ -export([generate_key/2, generate_key/3, compute_key/4]). -export([hmac/3, hmac/4, hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]). -export([exor/2, strong_rand_bytes/1, mod_pow/3]). --export([rand_bytes/1, rand_bytes/3, rand_uniform/2]). +-export([rand_uniform/2]). -export([block_encrypt/3, block_decrypt/3, block_encrypt/4, block_decrypt/4]). -export([next_iv/2, next_iv/3]). -export([stream_init/2, stream_init/3, stream_encrypt/2, stream_decrypt/2]). @@ -39,6 +39,9 @@ -export([rand_seed/1]). %% DEPRECATED +-export([rand_bytes/1]). +-deprecated({rand_bytes, 1, next_major_release}). + %% Replaced by hash_* -export([md4/1, md4_init/0, md4_update/2, md4_final/1]). -export([md5/1, md5_init/0, md5_update/2, md5_final/1]). @@ -302,6 +305,8 @@ block_encrypt(aes_ige256, Key, Ivec, Data) -> aes_ige_crypt_nif(Key, Ivec, Data, true); block_encrypt(aes_gcm, Key, Ivec, {AAD, Data}) -> aes_gcm_encrypt(Key, Ivec, AAD, Data); +block_encrypt(aes_gcm, Key, Ivec, {AAD, Data, TagLength}) -> + aes_gcm_encrypt(Key, Ivec, AAD, Data, TagLength); block_encrypt(chacha20_poly1305, Key, Ivec, {AAD, Data}) -> chacha20_poly1305_encrypt(Key, Ivec, AAD, Data). @@ -405,8 +410,6 @@ strong_rand_bytes(Bytes) -> end. strong_rand_bytes_nif(_Bytes) -> ?nif_stub. -rand_bytes(_Bytes, _Topmask, _Bottommask) -> ?nif_stub. - rand_uniform(From,To) when is_binary(From), is_binary(To) -> case rand_uniform_nif(From,To) of @@ -544,7 +547,7 @@ generate_key(dh, DHParameters, PrivateKey) -> generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, PrivArg) when is_binary(Verifier), is_binary(Generator), is_binary(Prime), is_atom(Version) -> Private = case PrivArg of - undefined -> random_bytes(32); + undefined -> strong_rand_bytes(32); _ -> ensure_int_as_bin(PrivArg) end, host_srp_gen_key(Private, Verifier, Generator, Prime, Version); @@ -552,7 +555,7 @@ generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, PrivArg) generate_key(srp, {user, [Generator, Prime, Version]}, PrivateArg) when is_binary(Generator), is_binary(Prime), is_atom(Version) -> Private = case PrivateArg of - undefined -> random_bytes(32); + undefined -> strong_rand_bytes(32); _ -> PrivateArg end, user_srp_gen_key(Private, Generator, Prime); @@ -604,16 +607,6 @@ compute_key(ecdh, Others, My, Curve) -> nif_curve_params(Curve), ensure_int_as_bin(My)). - -random_bytes(N) -> - try strong_rand_bytes(N) of - RandBytes -> - RandBytes - catch - error:low_entropy -> - rand_bytes(N) - end. - %%-------------------------------------------------------------------- %%% On load %%-------------------------------------------------------------------- @@ -917,7 +910,10 @@ aes_cfb_128_decrypt(Key, IVec, Data) -> %% %% AES - in Galois/Counter Mode (GCM) %% -aes_gcm_encrypt(_Key, _Ivec, _AAD, _In) -> ?nif_stub. +%% The default tag length is EVP_GCM_TLS_TAG_LEN(16), +aes_gcm_encrypt(Key, Ivec, AAD, In) -> + aes_gcm_encrypt(Key, Ivec, AAD, In, 16). +aes_gcm_encrypt(_Key, _Ivec, _AAD, _In, _TagLength) -> ?nif_stub. aes_gcm_decrypt(_Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub. %% diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index fc85019705..6732f27824 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -269,7 +269,6 @@ rand_uniform() -> [{doc, "rand_uniform and random_bytes testing"}]. rand_uniform(Config) when is_list(Config) -> rand_uniform_aux_test(10), - 10 = byte_size(crypto:rand_bytes(10)), 10 = byte_size(crypto:strong_rand_bytes(10)). %%-------------------------------------------------------------------- @@ -462,6 +461,21 @@ aead_cipher({Type, Key, PlainText, IV, AAD, CipherText, CipherTag}) -> ok; Other1 -> ct:fail({{crypto, block_decrypt, [CipherText]}, {expected, Plain}, {got, Other1}}) + end; +aead_cipher({Type, Key, PlainText, IV, AAD, CipherText, CipherTag, TagLen}) -> + <<TruncatedCipherTag:TagLen/binary, _/binary>> = CipherTag, + Plain = iolist_to_binary(PlainText), + case crypto:block_encrypt(Type, Key, IV, {AAD, Plain, TagLen}) of + {CipherText, TruncatedCipherTag} -> + ok; + Other0 -> + ct:fail({{crypto, block_encrypt, [Plain, PlainText]}, {expected, {CipherText, TruncatedCipherTag}}, {got, Other0}}) + end, + case crypto:block_decrypt(Type, Key, IV, {AAD, CipherText, TruncatedCipherTag}) of + Plain -> + ok; + Other1 -> + ct:fail({{crypto, block_decrypt, [CipherText]}, {expected, Plain}, {got, Other1}}) end. do_sign_verify({Type, Hash, Public, Private, Msg}) -> @@ -634,8 +648,8 @@ ipow(A, B, M, Prod) -> do_exor(B) -> Z1 = zero_bin(B), Z1 = crypto:exor(B, B), - B1 = crypto:rand_bytes(100), - B2 = crypto:rand_bytes(100), + B1 = crypto:strong_rand_bytes(100), + B2 = crypto:strong_rand_bytes(100), Z2 = zero_bin(B1), Z2 = crypto:exor(B1, B1), Z2 = crypto:exor(B2, B2), @@ -1938,7 +1952,36 @@ aes_gcm() -> "eeb2b22aafde6419a058ab4f6f746bf4" "0fc0c3b780f244452da3ebf1c5d82cde" "a2418997200ef82e44ae7e3f"), - hexstr2bin("a44a8266ee1c8eb0c8b5d4cf5ae9f19a")} %% CipherTag + hexstr2bin("a44a8266ee1c8eb0c8b5d4cf5ae9f19a")}, %% CipherTag + + %% Test Case 0 for TagLength = 1 + {aes_gcm, hexstr2bin("00000000000000000000000000000000"), %% Key + hexstr2bin(""), %% PlainText + hexstr2bin("000000000000000000000000"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin(""), %% CipherText + hexstr2bin("58"), %% CipherTag + 1}, %% TagLength + + %% Test Case 18 for TagLength = 1 + {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("a4"), %% CipherTag + 1} %% TagLength ]. %% http://tools.ietf.org/html/draft-agl-tls-chacha20poly1305-04 diff --git a/lib/crypto/test/old_crypto_SUITE.erl b/lib/crypto/test/old_crypto_SUITE.erl index f57e9ff341..0d97290d10 100644 --- a/lib/crypto/test/old_crypto_SUITE.erl +++ b/lib/crypto/test/old_crypto_SUITE.erl @@ -2068,8 +2068,8 @@ exor_test(Config) when is_list(Config) -> B = <<1, 2, 3, 4, 5, 6, 7, 8, 9, 10>>, Z1 = zero_bin(B), Z1 = crypto:exor(B, B), - B1 = crypto:rand_bytes(100), - B2 = crypto:rand_bytes(100), + B1 = crypto:strong_rand_bytes(100), + B2 = crypto:strong_rand_bytes(100), Z2 = zero_bin(B1), Z2 = crypto:exor(B1, B1), Z2 = crypto:exor(B2, B2), diff --git a/lib/debugger/test/andor_SUITE.erl b/lib/debugger/test/andor_SUITE.erl index f776451865..d7bbd4fccb 100644 --- a/lib/debugger/test/andor_SUITE.erl +++ b/lib/debugger/test/andor_SUITE.erl @@ -29,7 +29,9 @@ -include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> cases(). @@ -46,17 +48,14 @@ end_per_group(_GroupName, Config) -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - ?line Dog = test_server:timetrap(?t:minutes(1)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> @@ -71,23 +70,23 @@ t_andalso(Config) when is_list(Config) -> Ps = [{X,Y} || X <- Bs, Y <- Bs], lists:foreach(fun (P) -> t_andalso_1(P) end, Ps), - ?line true = true andalso true, - ?line false = true andalso false, - ?line false = false andalso true, - ?line false = false andalso false, + true = true andalso true, + false = true andalso false, + false = false andalso true, + false = false andalso false, - ?line false = false andalso glurf, - ?line false = false andalso exit(exit_now), + false = false andalso glurf, + false = false andalso exit(exit_now), - ?line true = not id(false) andalso not id(false), - ?line false = not id(false) andalso not id(true), - ?line false = not id(true) andalso not id(false), - ?line false = not id(true) andalso not id(true), + true = not id(false) andalso not id(false), + false = not id(false) andalso not id(true), + false = not id(true) andalso not id(false), + false = not id(true) andalso not id(true), - ?line {'EXIT',{badarg,_}} = (catch not id(glurf) andalso id(true)), - ?line {'EXIT',{badarg,_}} = (catch not id(false) andalso not id(glurf)), - ?line false = id(false) andalso not id(glurf), - ?line false = false andalso not id(glurf), + {'EXIT',{badarg,_}} = (catch not id(glurf) andalso id(true)), + {'EXIT',{badarg,_}} = (catch not id(false) andalso not id(glurf)), + false = id(false) andalso not id(glurf), + false = false andalso not id(glurf), ok. @@ -96,23 +95,23 @@ t_orelse(Config) when is_list(Config) -> Ps = [{X,Y} || X <- Bs, Y <- Bs], lists:foreach(fun (P) -> t_orelse_1(P) end, Ps), - ?line true = true orelse true, - ?line true = true orelse false, - ?line true = false orelse true, - ?line false = false orelse false, + true = true orelse true, + true = true orelse false, + true = false orelse true, + false = false orelse false, - ?line true = true orelse glurf, - ?line true = true orelse exit(exit_now), + true = true orelse glurf, + true = true orelse exit(exit_now), - ?line true = not id(false) orelse not id(false), - ?line true = not id(false) orelse not id(true), - ?line true = not id(true) orelse not id(false), - ?line false = not id(true) orelse not id(true), + true = not id(false) orelse not id(false), + true = not id(false) orelse not id(true), + true = not id(true) orelse not id(false), + false = not id(true) orelse not id(true), - ?line {'EXIT',{badarg,_}} = (catch not id(glurf) orelse id(true)), - ?line {'EXIT',{badarg,_}} = (catch not id(true) orelse not id(glurf)), - ?line true = id(true) orelse not id(glurf), - ?line true = true orelse not id(glurf), + {'EXIT',{badarg,_}} = (catch not id(glurf) orelse id(true)), + {'EXIT',{badarg,_}} = (catch not id(true) orelse not id(glurf)), + true = id(true) orelse not id(glurf), + true = true orelse not id(glurf), ok. @@ -135,16 +134,16 @@ t_orelse_1({X,Y}) -> check(V1, X or Y). inside(Config) when is_list(Config) -> - ?line true = inside(-8, 1), - ?line false = inside(-53.5, -879798), - ?line false = inside(1.0, -879), - ?line false = inside(59, -879), - ?line false = inside(-11, 1.0), - ?line false = inside(100, 0.2), - ?line false = inside(100, 1.2), - ?line false = inside(-53.5, 4), - ?line false = inside(1.0, 5.3), - ?line false = inside(59, 879), + true = inside(-8, 1), + false = inside(-53.5, -879798), + false = inside(1.0, -879), + false = inside(59, -879), + false = inside(-11, 1.0), + false = inside(100, 0.2), + false = inside(100, 1.2), + false = inside(-53.5, 4), + false = inside(1.0, 5.3), + false = inside(59, 879), ok. inside(Xm, Ym) -> @@ -179,15 +178,15 @@ inside_guard(Xm, Ym, X, Y, W, H) -> {false,Xm,Ym,X,Y,W,H}. overlap(Config) when is_list(Config) -> - ?line true = overlap(7.0, 2.0, 8.0, 0.5), - ?line true = overlap(7.0, 2.0, 8.0, 2.5), - ?line true = overlap(7.0, 2.0, 5.3, 2), - ?line true = overlap(7.0, 2.0, 0.0, 100.0), - - ?line false = overlap(-1, 2, -35, 0.5), - ?line false = overlap(-1, 2, 777, 0.5), - ?line false = overlap(-1, 2, 2, 10), - ?line false = overlap(2, 10, 12, 55.3), + true = overlap(7.0, 2.0, 8.0, 0.5), + true = overlap(7.0, 2.0, 8.0, 2.5), + true = overlap(7.0, 2.0, 5.3, 2), + true = overlap(7.0, 2.0, 0.0, 100.0), + + false = overlap(-1, 2, -35, 0.5), + false = overlap(-1, 2, 777, 0.5), + false = overlap(-1, 2, 2, 10), + false = overlap(2, 10, 12, 55.3), ok. overlap(Pos1, Len1, Pos2, Len2) -> @@ -211,33 +210,33 @@ overlap(Pos1, Len1, Pos2, Len2) -> -define(COMB(A,B,C), (A andalso B orelse C)). combined(Config) when is_list(Config) -> - ?line false = comb(false, false, false), - ?line true = comb(false, false, true), - ?line false = comb(false, true, false), - ?line true = comb(false, true, true), - - ?line false = comb(true, false, false), - ?line true = comb(true, true, false), - ?line true = comb(true, false, true), - ?line true = comb(true, true, true), - - ?line false = comb(false, blurf, false), - ?line true = comb(false, blurf, true), - ?line true = comb(true, true, blurf), - - ?line false = ?COMB(false, false, false), - ?line true = ?COMB(false, false, true), - ?line false = ?COMB(false, true, false), - ?line true = ?COMB(false, true, true), - - ?line false = ?COMB(true, false, false), - ?line true = ?COMB(true, true, false), - ?line true = ?COMB(true, false, true), - ?line true = ?COMB(true, true, true), - - ?line false = ?COMB(false, blurf, false), - ?line true = ?COMB(false, blurf, true), - ?line true = ?COMB(true, true, blurf), + false = comb(false, false, false), + true = comb(false, false, true), + false = comb(false, true, false), + true = comb(false, true, true), + + false = comb(true, false, false), + true = comb(true, true, false), + true = comb(true, false, true), + true = comb(true, true, true), + + false = comb(false, blurf, false), + true = comb(false, blurf, true), + true = comb(true, true, blurf), + + false = ?COMB(false, false, false), + true = ?COMB(false, false, true), + false = ?COMB(false, true, false), + true = ?COMB(false, true, true), + + false = ?COMB(true, false, false), + true = ?COMB(true, true, false), + true = ?COMB(true, false, true), + true = ?COMB(true, true, true), + + false = ?COMB(false, blurf, false), + true = ?COMB(false, blurf, true), + true = ?COMB(true, true, blurf), ok. -undef(COMB). @@ -268,13 +267,13 @@ comb(A, B, C) -> %% Test that a boolean expression in a case expression is properly %% optimized (in particular, that the error behaviour is correct). in_case(Config) when is_list(Config) -> - ?line edge_rings = in_case_1(1, 1, 1, 1, 1), - ?line not_loop = in_case_1(0.5, 1, 1, 1, 1), - ?line loop = in_case_1(0.5, 0.9, 1.1, 1, 4), - ?line {'EXIT',{badarith,_}} = (catch in_case_1(1, 1, 1, 1, 0)), - ?line {'EXIT',{badarith,_}} = (catch in_case_1(1, 1, 1, 1, nan)), - ?line {'EXIT',{badarg,_}} = (catch in_case_1(1, 1, 1, blurf, 1)), - ?line {'EXIT',{badarith,_}} = (catch in_case_1([nan], 1, 1, 1, 1)), + edge_rings = in_case_1(1, 1, 1, 1, 1), + not_loop = in_case_1(0.5, 1, 1, 1, 1), + loop = in_case_1(0.5, 0.9, 1.1, 1, 4), + {'EXIT',{badarith,_}} = (catch in_case_1(1, 1, 1, 1, 0)), + {'EXIT',{badarith,_}} = (catch in_case_1(1, 1, 1, 1, nan)), + {'EXIT',{badarg,_}} = (catch in_case_1(1, 1, 1, blurf, 1)), + {'EXIT',{badarith,_}} = (catch in_case_1([nan], 1, 1, 1, 1)), ok. in_case_1(LenUp, LenDw, LenN, Rotation, Count) -> @@ -302,14 +301,14 @@ in_case_1_guard(LenUp, LenDw, LenN, Rotation, Count) -> (abs(Rotation) > 0.707) of true -> edge_rings; false when LenUp >= 1 orelse LenDw >= 1 orelse - LenN =< 1 orelse Count < 4 -> not_loop; + LenN =< 1 orelse Count < 4 -> not_loop; false -> loop end. check(V1, V0) -> if V1 /= V0 -> io:fwrite("error: ~w.\n", [V1]), - ?t:fail(); + ct:fail(failed); true -> io:fwrite("ok: ~w.\n", [V1]) end. diff --git a/lib/debugger/test/bs_bincomp_SUITE.erl b/lib/debugger/test/bs_bincomp_SUITE.erl index 269b59909b..39e2240f2d 100644 --- a/lib/debugger/test/bs_bincomp_SUITE.erl +++ b/lib/debugger/test/bs_bincomp_SUITE.erl @@ -34,15 +34,14 @@ init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(1)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> [byte_aligned, bit_aligned, extended_byte_aligned, @@ -66,62 +65,62 @@ end_per_group(_GroupName, Config) -> byte_aligned(Config) when is_list(Config) -> - ?line <<"abcdefg">> = << <<(X+32)>> || <<X>> <= <<"ABCDEFG">> >>, - ?line <<1:32/little,2:32/little,3:32/little,4:32/little>> = + <<"abcdefg">> = << <<(X+32)>> || <<X>> <= <<"ABCDEFG">> >>, + <<1:32/little,2:32/little,3:32/little,4:32/little>> = << <<X:32/little>> || <<X:32>> <= <<1:32,2:32,3:32,4:32>> >>, - ?line <<1:32/little,2:32/little,3:32/little,4:32/little>> = + <<1:32/little,2:32/little,3:32/little,4:32/little>> = << <<X:32/little>> || <<X:16>> <= <<1:16,2:16,3:16,4:16>> >>, - ok. + ok. bit_aligned(Config) when is_list(Config) -> - ?line <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = << <<(X+32):7>> || <<X>> <= <<"ABCDEFG">> >>, - ?line <<"ABCDEFG">> = + <<"ABCDEFG">> = << <<(X-32)>> || <<X:7>> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> >>, - ?line <<1:31/little,2:31/little,3:31/little,4:31/little>> = + <<1:31/little,2:31/little,3:31/little,4:31/little>> = << <<X:31/little>> || <<X:31>> <= <<1:31,2:31,3:31,4:31>> >>, - ?line <<1:31/little,2:31/little,3:31/little,4:31/little>> = + <<1:31/little,2:31/little,3:31/little,4:31/little>> = << <<X:31/little>> || <<X:15>> <= <<1:15,2:15,3:15,4:15>> >>, - ok. + ok. extended_byte_aligned(Config) when is_list(Config) -> - ?line <<"abcdefg">> = << <<(X+32)>> || X <- "ABCDEFG" >>, - ?line "abcdefg" = [(X+32) || <<X>> <= <<"ABCDEFG">>], - ?line <<1:32/little,2:32/little,3:32/little,4:32/little>> = + <<"abcdefg">> = << <<(X+32)>> || X <- "ABCDEFG" >>, + "abcdefg" = [(X+32) || <<X>> <= <<"ABCDEFG">>], + <<1:32/little,2:32/little,3:32/little,4:32/little>> = << <<X:32/little>> || X <- [1,2,3,4] >>, - ?line [256,512,768,1024] = + [256,512,768,1024] = [X || <<X:16/little>> <= <<1:16,2:16,3:16,4:16>>], - ok. + ok. extended_bit_aligned(Config) when is_list(Config) -> - ?line <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = << <<(X+32):7>> || X <- "ABCDEFG" >>, - ?line "ABCDEFG" = [(X-32) || <<X:7>> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>>], - ?line <<1:31/little,2:31/little,3:31/little,4:31/little>> = + "ABCDEFG" = [(X-32) || <<X:7>> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>>], + <<1:31/little,2:31/little,3:31/little,4:31/little>> = << <<X:31/little>> || X <- [1,2,3,4] >>, - ?line [256,512,768,1024] = + [256,512,768,1024] = [X || <<X:15/little>> <= <<1:15,2:15,3:15,4:15>>], ok. mixed(Config) when is_list(Config) -> - ?line <<2,3,3,4,4,5,5,6>> = + <<2,3,3,4,4,5,5,6>> = << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>> >>, - ?line <<2,3,3,4,4,5,5,6>> = + <<2,3,3,4,4,5,5,6>> = << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, Y <- [1,2] >>, - ?line <<2,3,3,4,4,5,5,6>> = + <<2,3,3,4,4,5,5,6>> = << <<(X+Y)>> || X <- [1,2,3,4], Y <- [1,2] >>, - ?line [2,3,3,4,4,5,5,6] = + [2,3,3,4,4,5,5,6] = [(X+Y) || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>>], - ?line [2,3,3,4,4,5,5,6] = + [2,3,3,4,4,5,5,6] = [(X+Y) || <<X>> <= <<1,2,3,4>>, Y <- [1,2]], - ?line <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>> >>, - ?line <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2] >>, - ?line <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = << <<(X+Y):3>> || X <- [1,2,3,4], Y <- [1,2] >>, - ?line [2,3,3,4,4,5,5,6] = + [2,3,3,4,4,5,5,6] = [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>>], - ?line [2,3,3,4,4,5,5,6] = + [2,3,3,4,4,5,5,6] = [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2]], ok. diff --git a/lib/debugger/test/bs_construct_SUITE.erl b/lib/debugger/test/bs_construct_SUITE.erl index bd604929c0..6c6435c61a 100644 --- a/lib/debugger/test/bs_construct_SUITE.erl +++ b/lib/debugger/test/bs_construct_SUITE.erl @@ -38,7 +38,9 @@ -include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,15}}]. all() -> [test1, test2, test3, test4, test5, testf, not_used, @@ -57,17 +59,14 @@ end_per_group(_GroupName, Config) -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(15)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> @@ -84,9 +83,9 @@ r(L) -> -define(T(B, L), {B, ??B, L}). -define(N(B), {B, ??B, unknown}). --define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])). +-define(FAIL(Expr), fail_check(catch Expr, ??Expr, [])). --define(FAIL_VARS(Expr, Vars), ?line fail_check(catch Expr, ??Expr, Vars)). +-define(FAIL_VARS(Expr, Vars), fail_check(catch Expr, ??Expr, Vars)). l(I_13, I_big1) -> [ @@ -162,7 +161,7 @@ l(I_13, I_big1) -> ?T(<<<<344:17>>/binary-unit:17>>, <<344:17>>), ?T(<<<<42,3,7656:16>>/binary-unit:16>>, <<42,3,7656:16>>) - ]. + ]. native_3798() -> case <<1:16/native>> of @@ -205,7 +204,7 @@ one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) -> true -> io:format("ERROR: Compiled: ~p. Expected ~p. Got ~p.~n", [Str, Bytes, binary_to_list(C_bin)]), - test_server:fail(comp) + ct:fail(comp) end, if E_bin == Bin -> @@ -213,7 +212,7 @@ one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) -> true -> io:format("ERROR: Interpreted: ~p. Expected ~p. Got ~p.~n", [Str, Bytes, binary_to_list(E_bin)]), - test_server:fail(comp) + ct:fail(comp) end; one_test({C_bin, E_bin, Str, Result}) -> io:format(" ~s ~p~n", [Str, C_bin]), @@ -234,7 +233,7 @@ one_test({C_bin, E_bin, Str, Result}) -> io:format("ERROR: Compiled not equal to interpreted:" "~n ~p, ~p.~n", [binary_to_list(C_bin), binary_to_list(E_bin)]), - test_server:fail(comp); + ct:fail(comp); 0 -> ok; %% For situations where the final bits may not matter, like @@ -269,23 +268,22 @@ fail_check({'EXIT',{badarg,_}}, Str, Vars) -> try evaluate(Str, Vars) of Res -> io:format("Interpreted result: ~p", [Res]), - ?t:fail(did_not_fail_in_intepreted_code) + ct:fail(did_not_fail_in_intepreted_code) catch error:badarg -> ok end; fail_check(Res, _, _) -> io:format("Compiled result: ~p", [Res]), - ?t:fail(did_not_fail_in_compiled_code). + ct:fail(did_not_fail_in_compiled_code). %%% Simple working cases -test1(suite) -> []; test1(Config) when is_list(Config) -> - ?line I_13 = i(13), - ?line I_big1 = big(1), - ?line Vars = [{'I_13', I_13}, - {'I_big1', I_big1}], - ?line lists:foreach(fun one_test/1, eval_list(l(I_13, I_big1), Vars)). + I_13 = i(13), + I_big1 = big(1), + Vars = [{'I_13', I_13}, + {'I_big1', I_big1}], + lists:foreach(fun one_test/1, eval_list(l(I_13, I_big1), Vars)). %%% Misc @@ -301,10 +299,9 @@ gen(N, S, A) -> gen_l(N, S, A) -> [?T(<<A:S/little, A:(N-S)/little>>, comp(N, A, S))]. -test2(suite) -> []; test2(Config) when is_list(Config) -> - ?line test2(0, 8, 2#10101010101010101), - ?line test2(0, 8, 2#1111111111). + test2(0, 8, 2#10101010101010101), + test2(0, 8, 2#1111111111). test2(End, End, _) -> ok; @@ -329,10 +326,9 @@ t3() -> ?N(<<>>) ]. -test3(suite) -> []; test3(Config) when is_list(Config) -> - ?line Vars = [], - ?line lists:foreach(fun one_test/1, eval_list(t3(), Vars)). + Vars = [], + lists:foreach(fun one_test/1, eval_list(t3(), Vars)). gen_u(N, S, A) -> [?N(<<A:S, A:(N-S)>>)]. @@ -340,10 +336,9 @@ gen_u(N, S, A) -> gen_u_l(N, S, A) -> [?N(<<A:S/little, A:(N-S)/little>>)]. -test4(suite) -> []; test4(Config) when is_list(Config) -> - ?line test4(0, 16, 2#10101010101010101), - ?line test4(0, 16, 2#1111111111). + test4(0, 16, 2#10101010101010101), + test4(0, 16, 2#1111111111). test4(End, End, _) -> ok; @@ -361,11 +356,10 @@ gen_b(N, S, A) -> [?T(<<A:S/binary-unit:1, A:(N-S)/binary-unit:1>>, binary_to_list(<<A:S/binary-unit:1, A:(N-S)/binary-unit:1>>))]. -test5(suite) -> []; -test5(doc) -> ["OTP-3995"]; +%% OTP-3995. test5(Config) when is_list(Config) -> - ?line test5(0, 8, <<73>>), - ?line test5(0, 8, <<68>>). + test5(0, 8, <<73>>), + test5(0, 8, <<68>>). test5(End, End, _) -> ok; @@ -379,47 +373,46 @@ test5(S, A) -> lists:foreach(fun one_test/1, eval_list(gen_b(N, S, A), Vars)). %%% Failure cases -testf(suite) -> []; testf(Config) when is_list(Config) -> - ?line ?FAIL(<<3.14>>), - ?line ?FAIL(<<<<1,2>>>>), + ?FAIL(<<3.14>>), + ?FAIL(<<<<1,2>>>>), - ?line ?FAIL(<<2.71/binary>>), - ?line ?FAIL(<<24334/binary>>), - ?line ?FAIL(<<24334344294788947129487129487219847/binary>>), + ?FAIL(<<2.71/binary>>), + ?FAIL(<<24334/binary>>), + ?FAIL(<<24334344294788947129487129487219847/binary>>), BigInt = id(24334344294788947129487129487219847), - ?line ?FAIL_VARS(<<BigInt/binary>>, [{'BigInt',BigInt}]), - ?line ?FAIL_VARS(<<42,BigInt/binary>>, [{'BigInt',BigInt}]), - ?line ?FAIL_VARS(<<BigInt:2/binary>>, [{'BigInt',BigInt}]), + ?FAIL_VARS(<<BigInt/binary>>, [{'BigInt',BigInt}]), + ?FAIL_VARS(<<42,BigInt/binary>>, [{'BigInt',BigInt}]), + ?FAIL_VARS(<<BigInt:2/binary>>, [{'BigInt',BigInt}]), %% One negative field size, but the sum of field sizes will be 1 byte. %% Make sure that we reject that properly. I_minus_777 = id(-777), I_minus_2047 = id(-2047), - ?line ?FAIL_VARS(<<I_minus_777:2048/unit:8,57:I_minus_2047/unit:8>>, - ordsets:from_list([{'I_minus_777',I_minus_777}, - {'I_minus_2047',I_minus_2047}])), - ?line ?FAIL(<<<<1,2,3>>/float>>), + ?FAIL_VARS(<<I_minus_777:2048/unit:8,57:I_minus_2047/unit:8>>, + ordsets:from_list([{'I_minus_777',I_minus_777}, + {'I_minus_2047',I_minus_2047}])), + ?FAIL(<<<<1,2,3>>/float>>), %% Negative field widths. - ?line testf_1(-8, <<1,2,3,4,5>>), - ?line ?FAIL(<<0:(-(1 bsl 100))>>), + testf_1(-8, <<1,2,3,4,5>>), + ?FAIL(<<0:(-(1 bsl 100))>>), - ?line ?FAIL(<<42:(-16)>>), - ?line ?FAIL(<<3.14:(-8)/float>>), - ?line ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>), - ?line ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>), - ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>), - ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>), + ?FAIL(<<42:(-16)>>), + ?FAIL(<<3.14:(-8)/float>>), + ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>), + ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>), + ?FAIL(<<<<23,56,0,2>>:(anka)>>), + ?FAIL(<<<<23,56,0,2>>:(anka)>>), %% Unit failures. - ?line ?FAIL(<<<<1:1>>/binary>>), + ?FAIL(<<<<1:1>>/binary>>), Sz = id(1), - ?line ?FAIL_VARS(<<<<1:Sz>>/binary>>, [{'Sz',Sz}]), - ?line {'EXIT',{badarg,_}} = (catch <<<<1:(id(1))>>/binary>>), - ?line ?FAIL(<<<<7,8,9>>/binary-unit:16>>), - ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:16>>), - ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:17>>), + ?FAIL_VARS(<<<<1:Sz>>/binary>>, [{'Sz',Sz}]), + {'EXIT',{badarg,_}} = (catch <<<<1:(id(1))>>/binary>>), + ?FAIL(<<<<7,8,9>>/binary-unit:16>>), + ?FAIL(<<<<7,8,9,3:7>>/binary-unit:16>>), + ?FAIL(<<<<7,8,9,3:7>>/binary-unit:17>>), ok. @@ -429,14 +422,13 @@ testf_1(W, B) -> ?FAIL_VARS(<<3.14:W/float>>, Vars), ?FAIL_VARS(<<B:W/binary>>, [{'B',B}|Vars]). -not_used(doc) -> - "Test that constructed binaries that are not used will still give an exception."; +%% Test that constructed binaries that are not used will still give an exception. not_used(Config) when is_list(Config) -> - ?line ok = not_used1(3, <<"dum">>), - ?line {'EXIT',{badarg,_}} = (catch not_used1(3, "dum")), - ?line {'EXIT',{badarg,_}} = (catch not_used2(444, -2)), - ?line {'EXIT',{badarg,_}} = (catch not_used2(444, anka)), - ?line {'EXIT',{badarg,_}} = (catch not_used3(444)), + ok = not_used1(3, <<"dum">>), + {'EXIT',{badarg,_}} = (catch not_used1(3, "dum")), + {'EXIT',{badarg,_}} = (catch not_used2(444, -2)), + {'EXIT',{badarg,_}} = (catch not_used2(444, anka)), + {'EXIT',{badarg,_}} = (catch not_used3(444)), ok. not_used1(I, BinString) -> @@ -452,11 +444,11 @@ not_used3(I) -> ok. in_guard(Config) when is_list(Config) -> - ?line 1 = in_guard(<<16#74ad:16>>, 16#e95, 5), - ?line 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), - ?line 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), - ?line 3 = in_guard(<<16#FBCD:14,3/float,3:2>>, 16#FBCD, 3), - ?line 3 = in_guard(<<16#FBCD:14,(2 bsl 226)/float,3:2>>, 16#FBCD, 2 bsl 226), + 1 = in_guard(<<16#74ad:16>>, 16#e95, 5), + 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), + 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), + 3 = in_guard(<<16#FBCD:14,3/float,3:2>>, 16#FBCD, 3), + 3 = in_guard(<<16#FBCD:14,(2 bsl 226)/float,3:2>>, 16#FBCD, 2 bsl 226), nope = in_guard(<<1>>, 42, b), nope = in_guard(<<1>>, a, b), nope = in_guard(<<1,2>>, 1, 1), @@ -470,16 +462,16 @@ in_guard(Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3; in_guard(Bin, A, B) when {a,b,<<A:14,B/float,3:2>>} == Bin -> cant_happen; in_guard(_, _, _) -> nope. -mem_leak(doc) -> "Make sure that construction has no memory leak"; +%% Make sure that construction has no memory leak. mem_leak(Config) when is_list(Config) -> - ?line B = make_bin(16, <<0>>), - ?line mem_leak(1024, B), + B = make_bin(16, <<0>>), + mem_leak(1024, B), ok. mem_leak(0, _) -> ok; mem_leak(N, B) -> - ?line big_bin(B, <<23>>), - ?line {'EXIT',{badarg,_}} = (catch big_bin(B, bad)), + big_bin(B, <<23>>), + {'EXIT',{badarg,_}} = (catch big_bin(B, bad)), mem_leak(N-1, B). big_bin(B1, B2) -> @@ -493,18 +485,18 @@ make_bin(0, Acc) -> Acc; make_bin(N, Acc) -> make_bin(N-1, <<Acc/binary,Acc/binary>>). -define(COF(Int0), - ?line (fun(Int) -> - true = <<Int:32/float>> =:= <<(float(Int)):32/float>>, - true = <<Int:64/float>> =:= <<(float(Int)):64/float>> - end)(nonliteral(Int0)), - ?line true = <<Int0:32/float>> =:= <<(float(Int0)):32/float>>, - ?line true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>). + (fun(Int) -> + true = <<Int:32/float>> =:= <<(float(Int)):32/float>>, + true = <<Int:64/float>> =:= <<(float(Int)):64/float>> + end)(nonliteral(Int0)), + true = <<Int0:32/float>> =:= <<(float(Int0)):32/float>>, + true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>). -define(COF64(Int0), - ?line (fun(Int) -> - true = <<Int:64/float>> =:= <<(float(Int)):64/float>> - end)(nonliteral(Int0)), - ?line true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>). + (fun(Int) -> + true = <<Int:64/float>> =:= <<(float(Int)):64/float>> + end)(nonliteral(Int0)), + true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>). nonliteral(X) -> X. @@ -523,7 +515,7 @@ coerce_to_float(Config) when is_list(Config) -> ok. bjorn(Config) when is_list(Config) -> - ?line error = bjorn_1(), + error = bjorn_1(), ok. bjorn_1() -> @@ -551,30 +543,30 @@ do_something() -> throw(blurf). huge_float_field(Config) when is_list(Config) -> - ?line {'EXIT',{badarg,_}} = (catch <<0.0:9/float-unit:8>>), - ?line huge_float_check(catch <<0.0:67108865/float-unit:64>>), - ?line huge_float_check(catch <<0.0:((1 bsl 26)+1)/float-unit:64>>), - ?line huge_float_check(catch <<0.0:(id(67108865))/float-unit:64>>), -%% ?line huge_float_check(catch <<0.0:((1 bsl 60)+1)/float-unit:64>>), - ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 26)+1)/float-unit:64>>), -%% ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 60)+1)/float-unit:64>>), + {'EXIT',{badarg,_}} = (catch <<0.0:9/float-unit:8>>), + huge_float_check(catch <<0.0:67108865/float-unit:64>>), + huge_float_check(catch <<0.0:((1 bsl 26)+1)/float-unit:64>>), + huge_float_check(catch <<0.0:(id(67108865))/float-unit:64>>), + %% huge_float_check(catch <<0.0:((1 bsl 60)+1)/float-unit:64>>), + huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 26)+1)/float-unit:64>>), + %% huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 60)+1)/float-unit:64>>), ok. huge_float_check({'EXIT',{system_limit,_}}) -> ok; huge_float_check({'EXIT',{badarg,_}}) -> ok. huge_binary(Config) when is_list(Config) -> - ?line 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), + 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), ok. system_limit(Config) when is_list(Config) -> WordSize = erlang:system_info(wordsize), BitsPerWord = WordSize * 8, - ?line {'EXIT',{system_limit,_}} = + {'EXIT',{system_limit,_}} = (catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>), - ?line {'EXIT',{system_limit,_}} = + {'EXIT',{system_limit,_}} = (catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>), - ?line {'EXIT',{system_limit,_}} = + {'EXIT',{system_limit,_}} = (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>), case WordSize of @@ -585,13 +577,13 @@ system_limit(Config) when is_list(Config) -> end. system_limit_32() -> - ?line {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), - ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), - ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), - ?line {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), - ?line {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), - ?line {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), - ?line {'EXIT',{system_limit,_}} = + {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), ok. @@ -601,34 +593,34 @@ badarg(Config) when is_list(Config) -> %% but the debugger will generate a system_limit exception. %% It does not seems worthwhile to fix the debugger. - ?line {'EXIT',{badarg,_}} = + {'EXIT',{badarg,_}} = (catch <<(id(<<>>))/binary,0:(id(-(1 bsl 100)))>>), ok. copy_writable_binary(Config) when is_list(Config) -> - ?line [copy_writable_binary_1(I) || I <- lists:seq(0, 256)], + [copy_writable_binary_1(I) || I <- lists:seq(0, 256)], ok. copy_writable_binary_1(_) -> - ?line Bin0 = <<(id(<<>>))/binary,0,1,2,3,4,5,6,7>>, - ?line SubBin = make_sub_bin(Bin0), - ?line id(<<42,34,55,Bin0/binary>>), %Make reallocation likelier. - ?line Pid = spawn(fun() -> - copy_writable_binary_holder(Bin0, SubBin) - end), - ?line Tab = ets:new(holder, []), - ?line ets:insert(Tab, {17,Bin0}), - ?line ets:insert(Tab, {42,SubBin}), - ?line id(<<Bin0/binary,0:(64*1024*8)>>), - ?line Pid ! self(), - ?line [{17,Bin0}] = ets:lookup(Tab, 17), - ?line [{42,Bin0}] = ets:lookup(Tab, 42), + Bin0 = <<(id(<<>>))/binary,0,1,2,3,4,5,6,7>>, + SubBin = make_sub_bin(Bin0), + id(<<42,34,55,Bin0/binary>>), %Make reallocation likelier. + Pid = spawn(fun() -> + copy_writable_binary_holder(Bin0, SubBin) + end), + Tab = ets:new(holder, []), + ets:insert(Tab, {17,Bin0}), + ets:insert(Tab, {42,SubBin}), + id(<<Bin0/binary,0:(64*1024*8)>>), + Pid ! self(), + [{17,Bin0}] = ets:lookup(Tab, 17), + [{42,Bin0}] = ets:lookup(Tab, 42), receive {Pid,Bin0,Bin0} -> ok; Other -> io:format("Unexpected message: ~p", [Other]), - ?line ?t:fail() + ct:fail(failed) end, ok. @@ -656,7 +648,7 @@ dynamic(Config) when is_list(Config) -> {'DOWN',Ref,process,Pid,normal} -> ok; {'DOWN',Ref,process,Pid,Exit} -> - ?t:fail({Pid,Exit}) + ct:fail({Pid,Exit}) end || {Pid,Ref} <- Ps], ok. @@ -743,17 +735,17 @@ otp_7422_bin(N) when N < 512 -> otp_7422_bin(_) -> ok. zero_width(Config) when is_list(Config) -> - ?line Z = id(0), + Z = id(0), Small = id(42), Big = id(1 bsl 128), - ?line <<>> = <<Small:Z>>, - ?line <<>> = <<Small:0>>, - ?line <<>> = <<Big:Z>>, - ?line <<>> = <<Big:0>>, - - ?line {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>), - ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>), - ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>), + <<>> = <<Small:Z>>, + <<>> = <<Small:0>>, + <<>> = <<Big:Z>>, + <<>> = <<Big:0>>, + + {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>), + {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>), + {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>), ok. diff --git a/lib/debugger/test/bs_match_bin_SUITE.erl b/lib/debugger/test/bs_match_bin_SUITE.erl index f805df61c0..cd62874a9d 100644 --- a/lib/debugger/test/bs_match_bin_SUITE.erl +++ b/lib/debugger/test/bs_match_bin_SUITE.erl @@ -29,7 +29,9 @@ -include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> [byte_split_binary, bit_split_binary, match_huge_bin]. @@ -45,50 +47,47 @@ end_per_group(_GroupName, Config) -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(1)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> ok. -byte_split_binary(doc) -> "Tries to split a binary at all byte-aligned positions."; +%% Tries to split a binary at all byte-aligned positions. byte_split_binary(Config) when is_list(Config) -> - ?line L = lists:seq(0, 57), - ?line B = mkbin(L), - ?line byte_split(L, B, size(B)), - ?line Unaligned = make_unaligned_sub_binary(B), - ?line byte_split(L, Unaligned, size(Unaligned)). + L = lists:seq(0, 57), + B = mkbin(L), + byte_split(L, B, size(B)), + Unaligned = make_unaligned_sub_binary(B), + byte_split(L, Unaligned, size(Unaligned)). byte_split(L, B, Pos) when Pos >= 0 -> - ?line Sz1 = Pos, - ?line Sz2 = size(B) - Pos, - ?line <<B1:Sz1/binary,B2:Sz2/binary>> = B, - ?line B1 = list_to_binary(lists:sublist(L, 1, Pos)), - ?line B2 = list_to_binary(lists:nthtail(Pos, L)), - ?line byte_split(L, B, Pos-1); + Sz1 = Pos, + Sz2 = size(B) - Pos, + <<B1:Sz1/binary,B2:Sz2/binary>> = B, + B1 = list_to_binary(lists:sublist(L, 1, Pos)), + B2 = list_to_binary(lists:nthtail(Pos, L)), + byte_split(L, B, Pos-1); byte_split(_, _, _) -> ok. -bit_split_binary(doc) -> "Tries to split a binary at all positions."; +%% Tries to split a binary at all positions. bit_split_binary(Config) when is_list(Config) -> Fun = fun(Bin, List, SkipBef, N) -> - ?line SkipAft = 8*size(Bin) - N - SkipBef, + SkipAft = 8*size(Bin) - N - SkipBef, %%io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]), - ?line <<_:SkipBef,OutBin:N/binary-unit:1,_:SkipAft>> = Bin, - ?line OutBin = make_bin_from_list(List, N) + <<_:SkipBef,OutBin:N/binary-unit:1,_:SkipAft>> = Bin, + OutBin = make_bin_from_list(List, N) end, - ?line bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)), - ?line bit_split_binary1(Fun, - make_unaligned_sub_binary(erlang:md5(<<1,2,3>>))), + bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)), + bit_split_binary1(Fun, + make_unaligned_sub_binary(erlang:md5(<<1,2,3>>))), ok. bit_split_binary1(Action, Bin) -> @@ -133,19 +132,19 @@ make_unaligned_sub_binary(Bin0) -> id(I) -> I. match_huge_bin(Config) when is_list(Config) -> - ?line Bin = <<0:(1 bsl 27),13:8>>, - ?line skip_huge_bin_1(1 bsl 27, Bin), - ?line 16777216 = match_huge_bin_1(1 bsl 27, Bin), + Bin = <<0:(1 bsl 27),13:8>>, + skip_huge_bin_1(1 bsl 27, Bin), + 16777216 = match_huge_bin_1(1 bsl 27, Bin), %% Test overflowing the size of a binary field. - ?line nomatch = overflow_huge_bin_skip_32(Bin), - ?line nomatch = overflow_huge_bin_32(Bin), - ?line nomatch = overflow_huge_bin_skip_64(Bin), - ?line nomatch = overflow_huge_bin_64(Bin), + nomatch = overflow_huge_bin_skip_32(Bin), + nomatch = overflow_huge_bin_32(Bin), + nomatch = overflow_huge_bin_skip_64(Bin), + nomatch = overflow_huge_bin_64(Bin), %% Size in variable - ?line ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)), - ?line ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), ok. diff --git a/lib/debugger/test/bs_match_int_SUITE.erl b/lib/debugger/test/bs_match_int_SUITE.erl index 9d2490eea2..8ff5fe260e 100644 --- a/lib/debugger/test/bs_match_int_SUITE.erl +++ b/lib/debugger/test/bs_match_int_SUITE.erl @@ -30,7 +30,9 @@ -import(lists, [seq/2]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,4}}]. all() -> [integer, signed_integer, dynamic, more_dynamic, mml, @@ -47,39 +49,36 @@ end_per_group(_GroupName, Config) -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(4)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> ok. integer(Config) when is_list(Config) -> - ?line 0 = get_int(mkbin([])), - ?line 0 = get_int(mkbin([0])), - ?line 42 = get_int(mkbin([42])), - ?line 255 = get_int(mkbin([255])), - ?line 256 = get_int(mkbin([1,0])), - ?line 257 = get_int(mkbin([1,1])), - ?line 258 = get_int(mkbin([1,2])), - ?line 258 = get_int(mkbin([1,2])), - ?line 65534 = get_int(mkbin([255,254])), - ?line 16776455 = get_int(mkbin([255,253,7])), - ?line 4245492555 = get_int(mkbin([253,13,19,75])), - ?line 4294967294 = get_int(mkbin([255,255,255,254])), - ?line 4294967295 = get_int(mkbin([255,255,255,255])), - ?line Eight = [200,1,19,128,222,42,97,111], - ?line cmp128(Eight, uint(Eight)), - ?line fun_clause(catch get_int(mkbin(seq(1,5)))), + 0 = get_int(mkbin([])), + 0 = get_int(mkbin([0])), + 42 = get_int(mkbin([42])), + 255 = get_int(mkbin([255])), + 256 = get_int(mkbin([1,0])), + 257 = get_int(mkbin([1,1])), + 258 = get_int(mkbin([1,2])), + 258 = get_int(mkbin([1,2])), + 65534 = get_int(mkbin([255,254])), + 16776455 = get_int(mkbin([255,253,7])), + 4245492555 = get_int(mkbin([253,13,19,75])), + 4294967294 = get_int(mkbin([255,255,255,254])), + 4294967295 = get_int(mkbin([255,255,255,255])), + Eight = [200,1,19,128,222,42,97,111], + cmp128(Eight, uint(Eight)), + fun_clause(catch get_int(mkbin(seq(1,5)))), ok. get_int(Bin) -> @@ -102,13 +101,13 @@ cmp128(<<I:128>>, I) -> equal; cmp128(_, _) -> not_equal. signed_integer(Config) when is_list(Config) -> - ?line {no_match,_} = sint(mkbin([])), - ?line {no_match,_} = sint(mkbin([1,2,3])), - ?line 127 = sint(mkbin([127])), - ?line -1 = sint(mkbin([255])), - ?line -128 = sint(mkbin([128])), - ?line 42 = sint(mkbin([42,255])), - ?line 127 = sint(mkbin([127,255])). + {no_match,_} = sint(mkbin([])), + {no_match,_} = sint(mkbin([1,2,3])), + 127 = sint(mkbin([127])), + -1 = sint(mkbin([255])), + -128 = sint(mkbin([128])), + 42 = sint(mkbin([42,255])), + 127 = sint(mkbin([127,255])). sint(Bin) -> case Bin of @@ -135,7 +134,7 @@ dynamic(Bin, S1) when S1 >= 0 -> dynamic(_, _) -> ok. dynamic(Bin, S1, S2, A, B) -> -% io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), + %% io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), case Bin of <<A:S1,B:S2>> -> io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), @@ -143,16 +142,16 @@ dynamic(Bin, S1, S2, A, B) -> _Other -> erlang:error(badmatch, [Bin,S1,S2,A,B]) end. -more_dynamic(doc) -> "Extract integers at different alignments and of different sizes."; +%% Extract integers at different alignments and of different sizes. more_dynamic(Config) when is_list(Config) -> - % Unsigned big-endian numbers. + %% Unsigned big-endian numbers. Unsigned = fun(Bin, List, SkipBef, N) -> SkipAft = 8*size(Bin) - N - SkipBef, <<_:SkipBef,Int:N,_:SkipAft>> = Bin, Int = make_int(List, N, 0) end, - ?line more_dynamic1(Unsigned, funny_binary(42)), + more_dynamic1(Unsigned, funny_binary(42)), %% Signed big-endian numbers. Signed = fun(Bin, List, SkipBef, N) -> @@ -164,10 +163,10 @@ more_dynamic(Config) when is_list(Config) -> io:format("Bin = ~p,", [Bin]), io:format("SkipBef = ~p, N = ~p", [SkipBef,N]), io:format("Expected ~p, got ~p", [Int,Other]), - ?t:fail() + ct:fail(failed) end end, - ?line more_dynamic1(Signed, funny_binary(43)), + more_dynamic1(Signed, funny_binary(43)), %% Unsigned little-endian numbers. UnsLittle = fun(Bin, List, SkipBef, N) -> @@ -175,7 +174,7 @@ more_dynamic(Config) when is_list(Config) -> <<_:SkipBef,Int:N/little,_:SkipAft>> = Bin, Int = make_int(big_to_little(List, N), N, 0) end, - ?line more_dynamic1(UnsLittle, funny_binary(44)), + more_dynamic1(UnsLittle, funny_binary(44)), %% Signed little-endian numbers. SignLittle = fun(Bin, List, SkipBef, N) -> @@ -184,7 +183,7 @@ more_dynamic(Config) when is_list(Config) -> Little = big_to_little(List, N), Int = make_signed_int(Little, N) end, - ?line more_dynamic1(SignLittle, funny_binary(45)), + more_dynamic1(SignLittle, funny_binary(45)), ok. @@ -198,7 +197,7 @@ more_dynamic2(Action, Bin, [_|T]=List, Bef) -> more_dynamic2(_, _, [], _) -> ok. more_dynamic3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> -%% io:format("~p, ~p", [Bef,Aft-Bef]), + %% io:format("~p, ~p", [Bef,Aft-Bef]), Action(Bin, List, Bef, Aft-Bef), more_dynamic3(Action, Bin, List, Bef, Aft-1); more_dynamic3(_, _, _, _, _) -> ok. @@ -244,23 +243,23 @@ funny_binary(N) -> B1. mml(Config) when is_list(Config) -> - ?line single_byte_binary = mml_choose(<<42>>), - ?line multi_byte_binary = mml_choose(<<42,43>>). + single_byte_binary = mml_choose(<<42>>), + multi_byte_binary = mml_choose(<<42,43>>). mml_choose(<<_A:8>>) -> single_byte_binary; mml_choose(<<_A:8,_T/binary>>) -> multi_byte_binary. match_huge_int(Config) when is_list(Config) -> Sz = 1 bsl 27, - ?line Bin = <<0:Sz,13:8>>, - ?line skip_huge_int_1(Sz, Bin), - ?line 0 = match_huge_int_1(Sz, Bin), + Bin = <<0:Sz,13:8>>, + skip_huge_int_1(Sz, Bin), + 0 = match_huge_int_1(Sz, Bin), %% Test overflowing the size of an integer field. - ?line nomatch = overflow_huge_int_skip_32(Bin), + nomatch = overflow_huge_int_skip_32(Bin), case erlang:system_info(wordsize) of 4 -> - ?line nomatch = overflow_huge_int_32(Bin); + nomatch = overflow_huge_int_32(Bin); 8 -> %% An attempt will be made to allocate heap space for %% the bignum (which will probably fail); only if the @@ -268,15 +267,15 @@ match_huge_int(Config) when is_list(Config) -> %% the binary is too small. ok end, - ?line nomatch = overflow_huge_int_skip_64(Bin), - ?line nomatch = overflow_huge_int_64(Bin), + nomatch = overflow_huge_int_skip_64(Bin), + nomatch = overflow_huge_int_64(Bin), %% Test overflowing the size of an integer field using variables as sizes. - ?line Sizes = case erlang:system_info(wordsize) of - 4 -> lists:seq(25, 32); - 8 -> [] - end ++ lists:seq(50, 64), - ?line ok = overflow_huge_int_unit128(Bin, Sizes), + Sizes = case erlang:system_info(wordsize) of + 4 -> lists:seq(25, 32); + 8 -> [] + end ++ lists:seq(50, 64), + ok = overflow_huge_int_unit128(Bin, Sizes), ok. @@ -343,19 +342,19 @@ overflow_huge_int_64(<<Int:9223372036854775808/unit:128,0,_/binary>>) -> {8,Int} overflow_huge_int_64(_) -> nomatch. bignum(Config) when is_list(Config) -> - ?line Bin = id(<<42,0:1024/unit:8,43>>), - ?line <<42:1025/little-integer-unit:8,_:8>> = Bin, - ?line <<_:8,43:1025/integer-unit:8>> = Bin, + Bin = id(<<42,0:1024/unit:8,43>>), + <<42:1025/little-integer-unit:8,_:8>> = Bin, + <<_:8,43:1025/integer-unit:8>> = Bin, - ?line BignumBin = id(<<0:512/unit:8,258254417031933722623:9/unit:8>>), - ?line <<258254417031933722623:(512+9)/unit:8>> = BignumBin, + BignumBin = id(<<0:512/unit:8,258254417031933722623:9/unit:8>>), + <<258254417031933722623:(512+9)/unit:8>> = BignumBin, erlang:garbage_collect(), %Search for holes in debug-build. ok. unaligned_32_bit(Config) when is_list(Config) -> %% There used to be a risk for heap overflow (fixed in R11B-5). - ?line L = unaligned_32_bit_1(<<-1:(64*1024)>>), - ?line unaligned_32_bit_verify(L, 1638). + L = unaligned_32_bit_1(<<-1:(64*1024)>>), + unaligned_32_bit_verify(L, 1638). unaligned_32_bit_1(<<1:1,U:32,_:7,T/binary>>) -> [U|unaligned_32_bit_1(T)]; diff --git a/lib/debugger/test/bs_match_misc_SUITE.erl b/lib/debugger/test/bs_match_misc_SUITE.erl index ff636383be..fe86b54992 100644 --- a/lib/debugger/test/bs_match_misc_SUITE.erl +++ b/lib/debugger/test/bs_match_misc_SUITE.erl @@ -31,7 +31,9 @@ -include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,15}}]. all() -> [bound_var, bound_tail, t_float, little_float, sean, @@ -49,8 +51,8 @@ end_per_group(_GroupName, Config) -> Config. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> @@ -58,31 +60,28 @@ end_per_suite(Config) when is_list(Config) -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(15)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. -bound_var(doc) -> "Test matching of bound variables."; +%% Test matching of bound variables. bound_var(Config) when is_list(Config) -> - ?line ok = bound_var(42, 13, <<42,13>>), - ?line nope = bound_var(42, 13, <<42,255>>), - ?line nope = bound_var(42, 13, <<154,255>>), + ok = bound_var(42, 13, <<42,13>>), + nope = bound_var(42, 13, <<42,255>>), + nope = bound_var(42, 13, <<154,255>>), ok. bound_var(A, B, <<A:8,B:8>>) -> ok; bound_var(_, _, _) -> nope. -bound_tail(doc) -> "Test matching of a bound tail."; +%% Test matching of a bound tail. bound_tail(Config) when is_list(Config) -> - ?line ok = bound_tail(<<>>, <<13,14>>), - ?line ok = bound_tail(<<2,3>>, <<1,1,2,3>>), - ?line nope = bound_tail(<<2,3>>, <<1,1,2,7>>), - ?line nope = bound_tail(<<2,3>>, <<1,1,2,3,4>>), - ?line nope = bound_tail(<<2,3>>, <<>>), + ok = bound_tail(<<>>, <<13,14>>), + ok = bound_tail(<<2,3>>, <<1,1,2,3>>), + nope = bound_tail(<<2,3>>, <<1,1,2,7>>), + nope = bound_tail(<<2,3>>, <<1,1,2,3,4>>), + nope = bound_tail(<<2,3>>, <<>>), ok. bound_tail(T, <<_:16,T/binary>>) -> ok; @@ -92,26 +91,26 @@ t_float(Config) when is_list(Config) -> F = f1(), G = f_one(), - ?line G = match_float(<<63,128,0,0>>, 32, 0), - ?line G = match_float(<<63,240,0,0,0,0,0,0>>, 64, 0), + G = match_float(<<63,128,0,0>>, 32, 0), + G = match_float(<<63,240,0,0,0,0,0,0>>, 64, 0), - ?line fcmp(F, match_float(<<F:32/float>>, 32, 0)), - ?line fcmp(F, match_float(<<F:64/float>>, 64, 0)), - ?line fcmp(F, match_float(<<1:1,F:32/float,127:7>>, 32, 1)), - ?line fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), - ?line fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)), - ?line fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), + fcmp(F, match_float(<<F:32/float>>, 32, 0)), + fcmp(F, match_float(<<F:64/float>>, 64, 0)), + fcmp(F, match_float(<<1:1,F:32/float,127:7>>, 32, 1)), + fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), + fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)), + fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), - ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16, 0)), - ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16#7fffffff, 0)), + {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16, 0)), + {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16#7fffffff, 0)), ok. float_middle_endian(Config) when is_list(Config) -> F = 9007199254740990.0, % turns to -NaN when word-swapped - ?line fcmp(F, match_float(<<F:64/float>>, 64, 0)), - ?line fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), - ?line fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), + fcmp(F, match_float(<<F:64/float>>, 64, 0)), + fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), + fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), ok. @@ -128,15 +127,15 @@ little_float(Config) when is_list(Config) -> F = f2(), G = f_one(), - ?line G = match_float_little(<<0,0,0,0,0,0,240,63>>, 64, 0), - ?line G = match_float_little(<<0,0,128,63>>, 32, 0), + G = match_float_little(<<0,0,0,0,0,0,240,63>>, 64, 0), + G = match_float_little(<<0,0,128,63>>, 32, 0), - ?line fcmp(F, match_float_little(<<F:32/float-little>>, 32, 0)), - ?line fcmp(F, match_float_little(<<F:64/float-little>>, 64, 0)), - ?line fcmp(F, match_float_little(<<1:1,F:32/float-little,127:7>>, 32, 1)), - ?line fcmp(F, match_float_little(<<1:1,F:64/float-little,127:7>>, 64, 1)), - ?line fcmp(F, match_float_little(<<1:13,F:32/float-little,127:3>>, 32, 13)), - ?line fcmp(F, match_float_little(<<1:13,F:64/float-little,127:3>>, 64, 13)), + fcmp(F, match_float_little(<<F:32/float-little>>, 32, 0)), + fcmp(F, match_float_little(<<F:64/float-little>>, 64, 0)), + fcmp(F, match_float_little(<<1:1,F:32/float-little,127:7>>, 32, 1)), + fcmp(F, match_float_little(<<1:1,F:64/float-little,127:7>>, 64, 1)), + fcmp(F, match_float_little(<<1:13,F:32/float-little,127:3>>, 32, 13)), + fcmp(F, match_float_little(<<1:13,F:64/float-little,127:3>>, 64, 13)), ok. @@ -164,16 +163,16 @@ f_one() -> 1.0. sean(Config) when is_list(Config) -> - ?line small = sean1(<<>>), - ?line small = sean1(<<1>>), - ?line small = sean1(<<1,2>>), - ?line small = sean1(<<1,2,3>>), - ?line large = sean1(<<1,2,3,4>>), - - ?line small = sean1(<<4>>), - ?line small = sean1(<<4,5>>), - ?line small = sean1(<<4,5,6>>), - ?line {'EXIT',{function_clause,_}} = (catch sean1(<<4,5,6,7>>)), + small = sean1(<<>>), + small = sean1(<<1>>), + small = sean1(<<1,2>>), + small = sean1(<<1,2,3>>), + large = sean1(<<1,2,3,4>>), + + small = sean1(<<4>>), + small = sean1(<<4,5>>), + small = sean1(<<4,5,6>>), + {'EXIT',{function_clause,_}} = (catch sean1(<<4,5,6,7>>)), ok. sean1(<<B/binary>>) when byte_size(B) < 4 -> small; @@ -188,11 +187,11 @@ msisdn_internal_storage(<<>>,MSISDN) -> msisdn_internal_storage(<<2#11111111:8,_Rest/binary>>,MSISDN) -> {ok,lists:reverse(MSISDN)}; msisdn_internal_storage(<<2#1111:4,DigitN:4,_Rest/binary>>,MSISDN) when - DigitN < 10 -> + DigitN < 10 -> {ok,lists:reverse([(DigitN bor 2#11110000)|MSISDN])}; msisdn_internal_storage(<<DigitNplus1:4,DigitN:4,Rest/binary>>,MSISDN) when - DigitNplus1 < 10, - DigitN < 10 -> + DigitNplus1 < 10, + DigitN < 10 -> NewMSISDN=[((DigitNplus1 bsl 4) bor DigitN)|MSISDN], msisdn_internal_storage(Rest,NewMSISDN); msisdn_internal_storage(_Rest,_MSISDN) -> @@ -297,36 +296,36 @@ getBase64Char(62) -> "+"; getBase64Char(63) -> "/"; getBase64Char(_Else) -> %% This is an illegal input. -% cgLogEM:log(error, ?MODULE, getBase64Char, [Else], -% "illegal input", -% ?LINE, version()), + %% cgLogEM:log(error, ?MODULE, getBase64Char, [Else], + %% "illegal input", + %% ?LINE, version()), "**". -define(M(F), <<F>> = <<F>>). native(Config) when is_list(Config) -> - ?line ?M(3.14:64/native-float), - ?line ?M(333:16/native), - ?line ?M(38658345:32/native), + ?M(3.14:64/native-float), + ?M(333:16/native), + ?M(38658345:32/native), case <<1:16/native>> of <<0,1>> -> native_big(); <<1,0>> -> native_little() end. native_big() -> - ?line <<37.33:64/native-float>> = <<37.33:64/big-float>>, - ?line <<3974:16/native-integer>> = <<3974:16/big-integer>>, + <<37.33:64/native-float>> = <<37.33:64/big-float>>, + <<3974:16/native-integer>> = <<3974:16/big-integer>>, {comment,"Big endian"}. native_little() -> - ?line <<37869.32343:64/native-float>> = <<37869.32343:64/little-float>>, - ?line <<7974:16/native-integer>> = <<7974:16/little-integer>>, + <<37869.32343:64/native-float>> = <<37869.32343:64/little-float>>, + <<7974:16/native-integer>> = <<7974:16/little-integer>>, {comment,"Little endian"}. happi(Config) when is_list(Config) -> Bin = <<".123">>, - ?line <<"123">> = lex_digits1(Bin, 1, []), - ?line <<"123">> = lex_digits2(Bin, 1, []), + <<"123">> = lex_digits1(Bin, 1, []), + <<"123">> = lex_digits2(Bin, 1, []), ok. lex_digits1(<<$., Rest/binary>>,_Val,_Acc) -> @@ -347,16 +346,16 @@ dec(A) -> A-$0. size_var(Config) when is_list(Config) -> - ?line {<<45>>,<<>>} = split(<<1:16,45>>), - ?line {<<45>>,<<46,47>>} = split(<<1:16,45,46,47>>), - ?line {<<45,46>>,<<47>>} = split(<<2:16,45,46,47>>), + {<<45>>,<<>>} = split(<<1:16,45>>), + {<<45>>,<<46,47>>} = split(<<1:16,45,46,47>>), + {<<45,46>>,<<47>>} = split(<<2:16,45,46,47>>), - ?line {<<45,46,47>>,<<48>>} = split_2(<<16:8,3:16,45,46,47,48>>), + {<<45,46,47>>,<<48>>} = split_2(<<16:8,3:16,45,46,47,48>>), - ?line {<<45,46>>,<<47>>} = split(2, <<2:16,45,46,47>>), - ?line {'EXIT',{function_clause,_}} = (catch split(42, <<2:16,45,46,47>>)), + {<<45,46>>,<<47>>} = split(2, <<2:16,45,46,47>>), + {'EXIT',{function_clause,_}} = (catch split(42, <<2:16,45,46,47>>)), - ?line <<"cdef">> = skip(<<2:8,"abcdef">>), + <<"cdef">> = skip(<<2:8,"abcdef">>), ok. @@ -372,11 +371,11 @@ split_2(<<N0:8,N:N0,B:N/binary,T/binary>>) -> skip(<<N:8,_:N/binary,T/binary>>) -> T. wiger(Config) when is_list(Config) -> - ?line ok1 = wcheck(<<3>>), - ?line ok2 = wcheck(<<1,2,3>>), - ?line ok3 = wcheck(<<4>>), - ?line {error,<<1,2,3,4>>} = wcheck(<<1,2,3,4>>), - ?line {error,<<>>} = wcheck(<<>>), + ok1 = wcheck(<<3>>), + ok2 = wcheck(<<1,2,3>>), + ok3 = wcheck(<<4>>), + {error,<<1,2,3,4>>} = wcheck(<<1,2,3,4>>), + {error,<<>>} = wcheck(<<>>), ok. wcheck(<<A>>) when A==3-> @@ -410,9 +409,9 @@ x0_2(_, Bin) -> x0_3(_, Bin) -> case Bin of <<_:72,7:8,_/binary>> -> - ?line ?t:fail(); + ct:fail(failed); <<_:64,0:16,_/binary>> -> - ?line ?t:fail(); + ct:fail(failed); <<_:64,42:16,123456:32,_/binary>> -> ok end. @@ -420,13 +419,13 @@ x0_3(_, Bin) -> huge_float_field(Config) when is_list(Config) -> Sz = 1 bsl 27, - ?line Bin = <<0:Sz>>, + Bin = <<0:Sz>>, - ?line nomatch = overflow_huge_float_skip_32(Bin), - ?line nomatch = overflow_huge_float_32(Bin), + nomatch = overflow_huge_float_skip_32(Bin), + nomatch = overflow_huge_float_32(Bin), - ?line ok = overflow_huge_float(Bin, lists:seq(25, 32)++lists:seq(50, 64)), - ?line ok = overflow_huge_float_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok = overflow_huge_float(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok = overflow_huge_float_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), ok. overflow_huge_float_skip_32(<<_:4294967296/float,0,_/binary>>) -> 1; % 1 bsl 32 @@ -486,36 +485,36 @@ overflow_huge_float_unit128(_, []) -> ok. %% writable_binary_matched(Config) when is_list(Config) -> - ?line WritableBin = create_writeable_binary(), - ?line writable_binary_matched(WritableBin, WritableBin, 500). + WritableBin = create_writeable_binary(), + writable_binary_matched(WritableBin, WritableBin, 500). writable_binary_matched(<<0>>, _, N) -> if N =:= 0 -> ok; true -> put(grow_heap, [N|get(grow_heap)]), - ?line WritableBin = create_writeable_binary(), - ?line writable_binary_matched(WritableBin, WritableBin, N-1) + WritableBin = create_writeable_binary(), + writable_binary_matched(WritableBin, WritableBin, N-1) end; writable_binary_matched(<<B:8,T/binary>>, WritableBin0, N) -> - ?line WritableBin = writable_binary(WritableBin0, B), + WritableBin = writable_binary(WritableBin0, B), writable_binary_matched(T, WritableBin, N). writable_binary(WritableBin0, B) when is_binary(WritableBin0) -> %% Heavy append to force the binary to move. - ?line WritableBin = <<WritableBin0/binary,0:(size(WritableBin0))/unit:8,B>>, - ?line id(<<(id(0)):128/unit:8>>), + WritableBin = <<WritableBin0/binary,0:(size(WritableBin0))/unit:8,B>>, + id(<<(id(0)):128/unit:8>>), WritableBin. create_writeable_binary() -> - <<(id(<<>>))/binary,1,2,3,4,5,6,0>>. + <<(id(<<>>))/binary,1,2,3,4,5,6,0>>. otp_7198(Config) when is_list(Config) -> %% When a match context was reused, and grown at the same time to %% increase the number of saved positions, the thing word was not updated %% to account for the new size. Therefore, if there was a garbage collection, %% the new slots would be included in the garbage collection. - ?line [do_otp_7198(FillerSize) || FillerSize <- lists:seq(0, 256)], + [do_otp_7198(FillerSize) || FillerSize <- lists:seq(0, 256)], ok. do_otp_7198(FillerSize) -> @@ -526,7 +525,7 @@ do_otp_7198(FillerSize) -> ok; {'DOWN',Ref,process,Pid,Reason} -> io:format("unexpected: ~p", [Reason]), - ?line ?t:fail() + ct:fail(failed) end. do_otp_7198_test(_) -> @@ -548,32 +547,32 @@ do_otp_7198_test(_) -> otp_7198_scan(<<>>, TokAcc) -> - lists:reverse(['$thats_all_folks$' | TokAcc]); + lists:reverse(['$thats_all_folks$' | TokAcc]); otp_7198_scan(<<D, Z, Rest/binary>>, TokAcc) when - (D =:= $D orelse D =:= $d) and - ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> - otp_7198_scan(<<Z, Rest/binary>>, ['AND' | TokAcc]); + (D =:= $D orelse D =:= $d) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + otp_7198_scan(<<Z, Rest/binary>>, ['AND' | TokAcc]); otp_7198_scan(<<D>>, TokAcc) when - (D =:= $D) or (D =:= $d) -> - otp_7198_scan(<<>>, ['AND' | TokAcc]); + (D =:= $D) or (D =:= $d) -> + otp_7198_scan(<<>>, ['AND' | TokAcc]); otp_7198_scan(<<N, Z, Rest/binary>>, TokAcc) when - (N =:= $N orelse N =:= $n) and - ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> - otp_7198_scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]); + (N =:= $N orelse N =:= $n) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + otp_7198_scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]); otp_7198_scan(<<C, Rest/binary>>, TokAcc) when - (C >= $A) and (C =< $Z); - (C >= $a) and (C =< $z); - (C >= $0) and (C =< $9) -> - case Rest of - <<$:, R/binary>> -> - otp_7198_scan(R, [{'FIELD', C} | TokAcc]); - _ -> - otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc]) - end. + (C >= $A) and (C =< $Z); + (C >= $a) and (C =< $z); + (C >= $0) and (C =< $9) -> + case Rest of + <<$:, R/binary>> -> + otp_7198_scan(R, [{'FIELD', C} | TokAcc]); + _ -> + otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc]) + end. unordered_bindings(Config) when is_list(Config) -> {<<1,2,3,4>>,<<42,42>>,<<3,3,3>>} = @@ -582,7 +581,7 @@ unordered_bindings(Config) when is_list(Config) -> unordered_bindings(CompressedLength, HashSize, PadLength, T) -> <<Content:CompressedLength/binary,Mac:HashSize/binary, - Padding:PadLength/binary,PadLength>> = T, + Padding:PadLength/binary,PadLength>> = T, {Content,Mac,Padding}. diff --git a/lib/debugger/test/bs_match_tail_SUITE.erl b/lib/debugger/test/bs_match_tail_SUITE.erl index cf36f41840..4faa0360ce 100644 --- a/lib/debugger/test/bs_match_tail_SUITE.erl +++ b/lib/debugger/test/bs_match_tail_SUITE.erl @@ -28,7 +28,9 @@ -include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> cases(). @@ -48,51 +50,48 @@ cases() -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(1)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> ok. -aligned(doc) -> "Test aligned tails."; +%% Test aligned tails. aligned(Config) when is_list(Config) -> - ?line Tail1 = mkbin([]), - ?line {258,Tail1} = al_get_tail_used(mkbin([1,2])), - ?line Tail2 = mkbin(lists:seq(1, 127)), - ?line {35091,Tail2} = al_get_tail_used(mkbin([137,19|Tail2])), - - ?line 64896 = al_get_tail_unused(mkbin([253,128])), - ?line 64895 = al_get_tail_unused(mkbin([253,127|lists:seq(42, 255)])), - - ?line Tail3 = mkbin(lists:seq(0, 19)), - ?line {0,Tail1} = get_dyn_tail_used(Tail1, 0), - ?line {0,Tail3} = get_dyn_tail_used(mkbin([Tail3]), 0), - ?line {73,Tail3} = get_dyn_tail_used(mkbin([73|Tail3]), 8), - - ?line 0 = get_dyn_tail_unused(mkbin([]), 0), - ?line 233 = get_dyn_tail_unused(mkbin([233]), 8), - ?line 23 = get_dyn_tail_unused(mkbin([23,22,2]), 8), + Tail1 = mkbin([]), + {258,Tail1} = al_get_tail_used(mkbin([1,2])), + Tail2 = mkbin(lists:seq(1, 127)), + {35091,Tail2} = al_get_tail_used(mkbin([137,19|Tail2])), + + 64896 = al_get_tail_unused(mkbin([253,128])), + 64895 = al_get_tail_unused(mkbin([253,127|lists:seq(42, 255)])), + + Tail3 = mkbin(lists:seq(0, 19)), + {0,Tail1} = get_dyn_tail_used(Tail1, 0), + {0,Tail3} = get_dyn_tail_used(mkbin([Tail3]), 0), + {73,Tail3} = get_dyn_tail_used(mkbin([73|Tail3]), 8), + + 0 = get_dyn_tail_unused(mkbin([]), 0), + 233 = get_dyn_tail_unused(mkbin([233]), 8), + 23 = get_dyn_tail_unused(mkbin([23,22,2]), 8), ok. al_get_tail_used(<<A:16,T/binary>>) -> {A,T}. al_get_tail_unused(<<A:16,_/binary>>) -> A. -unaligned(doc) -> "Test that an non-aligned tail cannot be matched out."; +%% Test that an non-aligned tail cannot be matched out. unaligned(Config) when is_list(Config) -> - ?line {'EXIT',{function_clause,_}} = (catch get_tail_used(mkbin([42]))), - ?line {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)), - ?line {'EXIT',{function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))), - ?line {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_unused(mkbin([44]), 7)), + {'EXIT',{function_clause,_}} = (catch get_tail_used(mkbin([42]))), + {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)), + {'EXIT',{function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))), + {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_unused(mkbin([44]), 7)), ok. get_tail_used(<<A:1,T/binary>>) -> {A,T}. @@ -107,11 +106,11 @@ get_dyn_tail_unused(Bin, Sz) -> <<A:Sz,_/binary>> = Bin, A. -zero_tail(doc) -> "Test that zero tails are tested correctly."; +%% Test that zero tails are tested correctly. zero_tail(Config) when is_list(Config) -> - ?line 7 = (catch test_zero_tail(mkbin([7]))), - ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail(mkbin([1,2]))), - ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail2(mkbin([1,2,3]))), + 7 = (catch test_zero_tail(mkbin([7]))), + {'EXIT',{function_clause,_}} = (catch test_zero_tail(mkbin([1,2]))), + {'EXIT',{function_clause,_}} = (catch test_zero_tail2(mkbin([1,2,3]))), ok. test_zero_tail(<<A:8>>) -> A. diff --git a/lib/debugger/test/bs_utf_SUITE.erl b/lib/debugger/test/bs_utf_SUITE.erl index 12ab2c8ac6..ccedc42064 100644 --- a/lib/debugger/test/bs_utf_SUITE.erl +++ b/lib/debugger/test/bs_utf_SUITE.erl @@ -31,7 +31,9 @@ -include_lib("common_test/include/ct.hrl"). -compile([no_jopt,time]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> cases(). @@ -52,31 +54,28 @@ cases() -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(1)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> ok. utf8_roundtrip(Config) when is_list(Config) -> - ?line [utf8_roundtrip_1(P) || P <- utf_data()], + [utf8_roundtrip_1(P) || P <- utf_data()], ok. utf8_roundtrip_1({Str,Bin,Bin}) -> - ?line Str = utf8_to_list(Bin), - ?line Bin = list_to_utf8(Str), - ?line [ok = utf8_guard(C, <<42,C/utf8>>) || C <- Str], - ?line [error = utf8_guard(C, <<C/utf8>>) || C <- Str], + Str = utf8_to_list(Bin), + Bin = list_to_utf8(Str), + [ok = utf8_guard(C, <<42,C/utf8>>) || C <- Str], + [error = utf8_guard(C, <<C/utf8>>) || C <- Str], ok. utf8_guard(C, Bin) when <<42,C/utf8>> =:= Bin -> ok; @@ -106,14 +105,14 @@ utf8_len(<<_/utf8,T/binary>>, N) -> utf8_len(<<>>, N) -> N. utf16_roundtrip(Config) when is_list(Config) -> - ?line {Str,Big,Big,Little,Little} = utf16_data(), - ?line 4 = utf16_big_len(Big), - ?line 4 = utf16_little_len(Little), - ?line Str = big_utf16_to_list(Big), - ?line Str = little_utf16_to_list(Little), + {Str,Big,Big,Little,Little} = utf16_data(), + 4 = utf16_big_len(Big), + 4 = utf16_little_len(Little), + Str = big_utf16_to_list(Big), + Str = little_utf16_to_list(Little), - ?line Big = list_to_big_utf16(Str), - ?line Little = list_to_little_utf16(Str), + Big = list_to_big_utf16(Str), + Little = list_to_little_utf16(Str), ok. @@ -154,14 +153,14 @@ little_utf16_to_list(<<H/little-utf16,T/binary>>) -> little_utf16_to_list(<<>>) -> []. utf32_roundtrip(Config) when is_list(Config) -> - ?line {Str,Big,Big,Little,Little} = utf32_data(), - ?line 4 = utf32_big_len(Big), - ?line 4 = utf32_little_len(Little), - ?line Str = big_utf32_to_list(Big), - ?line Str = little_utf32_to_list(Little), + {Str,Big,Big,Little,Little} = utf32_data(), + 4 = utf32_big_len(Big), + 4 = utf32_little_len(Little), + Str = big_utf32_to_list(Big), + Str = little_utf32_to_list(Little), - ?line Big = list_to_big_utf32(Str), - ?line Little = list_to_little_utf32(Str), + Big = list_to_big_utf32(Str), + Little = list_to_little_utf32(Str), ok. @@ -203,7 +202,7 @@ little_utf32_to_list(<<>>) -> []. guard(Config) when is_list(Config) -> - ?line error = do_guard(16#D800), + error = do_guard(16#D800), ok. do_guard(C) when byte_size(<<C/utf8>>) =/= 42 -> ok; @@ -215,13 +214,13 @@ do_guard(_) -> error. %% the delayed creation of sub-binaries works. extreme_tripping(Config) when is_list(Config) -> - ?line Unicode = lists:seq(0, 1024), - ?line Utf8 = unicode_to_utf8(Unicode, <<>>), - ?line Utf16 = utf8_to_utf16(Utf8, <<>>), - ?line Utf32 = utf8_to_utf32(Utf8, <<>>), - ?line Utf32 = utf16_to_utf32(Utf16, <<>>), - ?line Utf8 = utf32_to_utf8(Utf32, <<>>), - ?line Unicode = utf32_to_unicode(Utf32), + Unicode = lists:seq(0, 1024), + Utf8 = unicode_to_utf8(Unicode, <<>>), + Utf16 = utf8_to_utf16(Utf8, <<>>), + Utf32 = utf8_to_utf32(Utf8, <<>>), + Utf32 = utf16_to_utf32(Utf16, <<>>), + Utf8 = utf32_to_utf8(Utf32, <<>>), + Unicode = utf32_to_unicode(Utf32), ok. unicode_to_utf8([C|T], Bin) -> @@ -249,7 +248,7 @@ utf32_to_unicode(<<C/utf32,T/binary>>) -> utf32_to_unicode(<<>>) -> []. utf_data() -> -%% From RFC-3629. + %% From RFC-3629. %% Give the compiler a change to do some constant propagation. NotIdentical = 16#2262, @@ -287,7 +286,7 @@ utf16_data() -> %% Little endian (the two binaries should be equal). <<RaHieroglyph/little-utf16,16#3D/little-utf16, - 16#52/little-utf16,16#61/little-utf16>>, + 16#52/little-utf16,16#61/little-utf16>>, <<16#08,16#D8,16#45,16#DF,16#3D,16#00,16#52,16#00,16#61,16#00>>}. utf32_data() -> @@ -301,6 +300,6 @@ utf32_data() -> %% Little endian. <<16#0041/little-utf32,NotIdentical/little-utf32, - 16#0391/little-utf32,16#002E/little-utf32>>, + 16#0391/little-utf32,16#002E/little-utf32>>, <<16#41:32/little,NotIdentical:32/little, - 16#0391:32/little,16#2E:32/little>>}. + 16#0391:32/little,16#2E:32/little>>}. diff --git a/lib/debugger/test/bug_SUITE.erl b/lib/debugger/test/bug_SUITE.erl index eeb94f5992..ac73672d2a 100644 --- a/lib/debugger/test/bug_SUITE.erl +++ b/lib/debugger/test/bug_SUITE.erl @@ -28,7 +28,9 @@ -export([otp2163/1, otp4845/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> [{group, ticket_tests}]. @@ -43,54 +45,52 @@ end_per_suite(_Config) -> ok. init_per_group(_GroupName, Config) -> - Config. + Config. end_per_group(_GroupName, Config) -> - Config. + Config. -otp2163(doc) -> ["BIF exit reason"]; -otp2163(suite) -> []; +%% BIF exit reason. otp2163(Config) when is_list(Config) -> - ?line DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), %% First compile and get the expected results: - ?line FileName = filename:join(DataDir, "otp2163"), - ?line {module,otp2163} = code:load_abs(FileName), + FileName = filename:join(DataDir, "otp2163"), + {module,otp2163} = code:load_abs(FileName), - ?line {'EXIT',{badarg,[ApplyRes|_]}} = (catch otp2163:apply_test()), - ?line {'EXIT',{badarg,[ListRes|_]}} = (catch otp2163:list_to_atom_test()), + {'EXIT',{badarg,[ApplyRes|_]}} = (catch otp2163:apply_test()), + {'EXIT',{badarg,[ListRes|_]}} = (catch otp2163:list_to_atom_test()), %% Then interpret, and check if the results are OK. - ?line {module,otp2163} = int:i(FileName), + {module,otp2163} = int:i(FileName), - ?line ok = io:format("Expecting ~p", [ApplyRes]), - ?line {'EXIT',{badarg,[ApplyRes|_]}} = (catch otp2163:apply_test()), - ?line ok = io:format("Expecting ~p", [ListRes]), - ?line {'EXIT',{badarg,[ListRes|_]}} = (catch otp2163:list_to_atom_test()), + ok = io:format("Expecting ~p", [ApplyRes]), + {'EXIT',{badarg,[ApplyRes|_]}} = (catch otp2163:apply_test()), + ok = io:format("Expecting ~p", [ListRes]), + {'EXIT',{badarg,[ListRes|_]}} = (catch otp2163:list_to_atom_test()), ok. -otp4845(doc) -> ["BIF not loading and not bug compatible, OTP-4845 OTP-4859"]; -otp4845(suite) -> []; +%% BIF not loading and not bug compatible, OTP-4845 OTP-4859. otp4845(Config) when is_list(Config) -> - ?line DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), %% First compile and get the expected results: - ?line FileName = filename:join(DataDir, "otp4845"), - ?line {module,otp4845} = code:load_abs(FileName), + FileName = filename:join(DataDir, "otp4845"), + {module,otp4845} = code:load_abs(FileName), - ?line CompiledRes = (catch otp4845:test()), - ?line ok = io:format("Compiled ~p", [CompiledRes]), + CompiledRes = (catch otp4845:test()), + ok = io:format("Compiled ~p", [CompiledRes]), %% Then interpret, and check if the results are OK. - ?line {module,otp4845} = int:i(FileName), + {module,otp4845} = int:i(FileName), - ?line IntRes = (catch otp4845:test()), - ?line ok = io:format("Interpreted ~p", [IntRes]), + IntRes = (catch otp4845:test()), + ok = io:format("Interpreted ~p", [IntRes]), - ?line CompiledRes = IntRes, + CompiledRes = IntRes, ok. diff --git a/lib/debugger/test/cleanup.erl b/lib/debugger/test/cleanup.erl index 8b41b45d59..7970b53086 100644 --- a/lib/debugger/test/cleanup.erl +++ b/lib/debugger/test/cleanup.erl @@ -26,22 +26,21 @@ -include_lib("common_test/include/ct.hrl"). all() -> -[cleanup]. + [cleanup]. groups() -> []. init_per_group(_GroupName, Config) -> - Config. + Config. end_per_group(_GroupName, Config) -> - Config. + Config. -cleanup(suite) -> []; cleanup(_) -> - ?line Mods = int:interpreted(), - ?line ok = int:n(Mods), + Mods = int:interpreted(), + ok = int:n(Mods), case whereis(interpret) of undefined -> ok; diff --git a/lib/debugger/test/dbg_ui_SUITE.erl b/lib/debugger/test/dbg_ui_SUITE.erl index da0aa34afa..32577d48cd 100644 --- a/lib/debugger/test/dbg_ui_SUITE.erl +++ b/lib/debugger/test/dbg_ui_SUITE.erl @@ -25,14 +25,14 @@ -include_lib("common_test/include/ct.hrl"). -% Test server specific exports +%% 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]). -% Test cases must be exported. +%% Test cases must be exported. -export ([dbg_ui/1]). -% Manual test suites/cases exports +%% Manual test suites/cases exports -export([start1/1, interpret1/1, quit1/1, start2/1, interpret2/1, break2/1, options2/1, quit2/1, interpret3/1, all_step3/1,all_next3/1,save3/1,restore3/1,finish3/1, @@ -44,15 +44,14 @@ -export([init_per_testcase/2, end_per_testcase/2]). init_per_testcase(_Func, Config) -> - Dog=test_server:timetrap(60*1000), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Func, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog). + Config. +end_per_testcase(_Func, _Config) -> + ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> [dbg_ui, {group, manual_tests}]. @@ -78,22 +77,17 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. -dbg_ui (doc) -> - ["Debugger GUI"]; - -dbg_ui (suite) -> - []; - +%% Test Debugger GUI. dbg_ui (_Config) -> case os:getenv("DISPLAY") of false -> {skipped,"No display"}; Other when is_list(Other) -> -% ?line {ok, Pid} = debugger:start (), -% ?line ok = is_pid (Pid), -% ?line true = erlang:is_process_alive(Pid), -% ?line ok = debugger:stop(), -% ?line false = erlang:is_process_alive(Pid) + %% {ok, Pid} = debugger:start (), + %% ok = is_pid (Pid), + %% true = erlang:is_process_alive(Pid), + %% ok = debugger:stop(), + %% false = erlang:is_process_alive(Pid) {skipped,"Gunilla: Workaround"} end. @@ -105,11 +99,11 @@ dbg_ui (_Config) -> check(Case, Config) -> - ?line DataDir = ?config(data_dir, Config), - ?line ResultFileName = filename:join([DataDir, "manual_results.erl"]), + DataDir = proplists:get_value(data_dir, Config), + ResultFileName = filename:join([DataDir, "manual_results.erl"]), case file:consult(ResultFileName) of {ok, Results} -> - ?line io:format("Results: ~p~n",[Results]), + io:format("Results: ~p~n",[Results]), case Results of [] -> no_result; @@ -136,29 +130,27 @@ check(Case, Config) -> -define(MAN_CASE(Name,Doc, Description), - Name(doc) -> [Doc]; - Name(suite) -> []; Name(Config) -> - ?line io:format("Checking ~p~n",[Name]), - ?line io:format("Config = ~p~n",[Config]), + io:format("Checking ~p~n",[Name]), + io:format("Config = ~p~n",[Config]), case check(Name, Config) of pass -> - ?line ok; + ok; fail -> - ?line test_server:fail("Manual test failed"); + ct:fail("Manual test failed"); unknown -> - ?line {skipped, "Manual test result unknown"}; + {skipped, "Manual test result unknown"}; no_result -> - ?line {skipped, Description}; + {skipped, Description}; {error, _Reason} -> -%% Text = lists:flatten( -%% io_lib:format("[File problem: ~s]~s", -%% [Reason,Description])), - ?line {skipped, Description} + %% Text = lists:flatten( + %% io_lib:format("[File problem: ~s]~s", + %% [Reason,Description])), + {skipped, Description} end - ). + ). %% SET 1 @@ -170,101 +162,101 @@ please start the debugger from the toolbar"). ?MAN_CASE(interpret1, "Interpreting modules", "In this test case and all of the ones following, the source code files to use can be found in the test data directory for this debugger test - suite (probably in -/clearcase/otp/tools/debugger/test/dbg_ui_SUITE_data/manual_data/src ). + suite (probably in + /clearcase/otp/tools/debugger/test/dbg_ui_SUITE_data/manual_data/src ). Interpret one module"). ?MAN_CASE(quit1, "Quit the debugger", -"Quit the debugger using File->Exit in the main window"). + "Quit the debugger using File->Exit in the main window"). %% SET 2 ?MAN_CASE(start2, "Start the debugger from the shell", -"Start the debugger from the shell. Use debugger:start()"). + "Start the debugger from the shell. Use debugger:start()"). ?MAN_CASE(interpret2, "Interpret all modules", -"Interpret all modules"). + "Interpret all modules"). ?MAN_CASE(break2, "Set break points", -"Set break points"). + "Set break points"). ?MAN_CASE(options2, "Set options to attach on break", -"Set options to attach on break"). + "Set options to attach on break"). ?MAN_CASE(quit2, "Quit the debugger", -"Quit the debugger using the close box in the main window title frame"). + "Quit the debugger using the close box in the main window title frame"). %% SET3 ?MAN_CASE(interpret3, "Test attach options", -"Start the debugger and interpret the modules [test, lists1, ordsets1]. Close the Interpret dialog. Set Attach on First Call and Attach on Break."). + "Start the debugger and interpret the modules [test, lists1, ordsets1]. Close the Interpret dialog. Set Attach on First Call and Attach on Break."). ?MAN_CASE(all_step3, "Click Step through all evaluation", -"In the shell, call test:test1(). Use the Step button, the Process->Step menu item and the ctrl-s shortcut to step through the *entire* execution of the call. (Approx 36 steps). Then close the Attach window. The result printed in the shell should be: {\"peter\",[1,2,4,a,b,c],\"olin\"}"). + "In the shell, call test:test1(). Use the Step button, the Process->Step menu item and the ctrl-s shortcut to step through the *entire* execution of the call. (Approx 36 steps). Then close the Attach window. The result printed in the shell should be: {\"peter\",[1,2,4,a,b,c],\"olin\"}"). ?MAN_CASE(all_next3,"Click Next through all evaluation", -"Again call test:test1() in the shell. This time Use the Next button, the Process->Next menu and the ctrl-n shortcut to quickly step over the execution of the four lines in the test1-function. The result printed in the shell should be: {\"peter\",[1,2,4,a,b,c],\"olin\"}"). + "Again call test:test1() in the shell. This time Use the Next button, the Process->Next menu and the ctrl-n shortcut to quickly step over the execution of the four lines in the test1-function. The result printed in the shell should be: {\"peter\",[1,2,4,a,b,c],\"olin\"}"). ?MAN_CASE(save3, "Save the debugger state", -"Use File->Save Settings to save the debugger state with the name 'three.state'"). + "Use File->Save Settings to save the debugger state with the name 'three.state'"). ?MAN_CASE(restore3,"Quit the debugger, restart and restore the state", -"Quit the debugger. Start it again. Use File->Load Settings to restore the state saved in 'three.state'. Check that the Attach-options are the same as what you set them to in the interpret3 test case. Check that the three modules [test,lists1,ordsets1] are interpreted."). + "Quit the debugger. Start it again. Use File->Load Settings to restore the state saved in 'three.state'. Check that the Attach-options are the same as what you set them to in the interpret3 test case. Check that the three modules [test,lists1,ordsets1] are interpreted."). ?MAN_CASE(finish3, "Finish the current function body", -"Call the fucntion test:test1() from the shell. Press Finish to evaluate the remaining lines in the function. The result printed in the shell should be: {\"peter\",[1,2,4,a,b,c],\"olin\"}"). + "Call the fucntion test:test1() from the shell. Press Finish to evaluate the remaining lines in the function. The result printed in the shell should be: {\"peter\",[1,2,4,a,b,c],\"olin\"}"). ?MAN_CASE(killinit3,"Set up for killing and clearing processes", -"Call test:test2() from the shell. Set a break point at the last line of test:test2. Click Continue. This should open three new attach windows. One for each spawn called in test:test2/0. "). + "Call test:test2() from the shell. Set a break point at the last line of test:test2. Click Continue. This should open three new attach windows. One for each spawn called in test:test2/0. "). ?MAN_CASE(killone3, "Kill a process and clear it", -"In one of the newly openend Attach windows: select Process->Kill. A message should appear above the Code Area in the Attach window. Use Windows->Monitor to verify that the Monitor window also shows that the process has been killed. In the Monitor window: select Edit->Clear. This should do two things: 1) close/remove the window of the killed process. 2) Remove the entry of the killed process from the monitor window."). + "In one of the newly openend Attach windows: select Process->Kill. A message should appear above the Code Area in the Attach window. Use Windows->Monitor to verify that the Monitor window also shows that the process has been killed. In the Monitor window: select Edit->Clear. This should do two things: 1) close/remove the window of the killed process. 2) Remove the entry of the killed process from the monitor window."). ?MAN_CASE(killall3,"KIll all processes, and clear them", -"In the Monitor window: Select Edit->Kill All. Verify that all processes have been killed (in their respective windows and in the monitor window). Windows will be raised as their processes die. Next select, Edit->Clear. All attach windows should now be closed. Their entris should also disappear from the monitor window. The shell should have reported: ** exited: killed **"). + "In the Monitor window: Select Edit->Kill All. Verify that all processes have been killed (in their respective windows and in the monitor window). Windows will be raised as their processes die. Next select, Edit->Clear. All attach windows should now be closed. Their entris should also disappear from the monitor window. The shell should have reported: ** exited: killed **"). ?MAN_CASE(deleteone3,"Delete/uniterpret one module", -"In the Monitor window: Select Module->test->Delete. This should remove the breakpoints set in the test module, and the test module should disappear from the Module menu."). + "In the Monitor window: Select Module->test->Delete. This should remove the breakpoints set in the test module, and the test module should disappear from the Module menu."). ?MAN_CASE(deleteall3,"Delete/uniterpret all modules", -"In the Monitor window: Select Module->Delete All Modules. This should remove all modules from the Module menu. "). + "In the Monitor window: Select Module->Delete All Modules. This should remove all modules from the Module menu. "). %% SET 4 ?MAN_CASE(viewbreak4, "Test the View window", -"Restore the settings from the three.state file again. In the Monitor window: Use Module->test->View to view the source code of the test module. In the View window, select Break->Line Break and set a break at line 53. Check that it appears in the View window and in the Monitor Window Break-menu. Also in the View window, select Break->Function Break and set a break at function test:test4. Check that the break (at line 59) appears in the View Window and in the Monitor Window Break-menu."). + "Restore the settings from the three.state file again. In the Monitor window: Use Module->test->View to view the source code of the test module. In the View window, select Break->Line Break and set a break at line 53. Check that it appears in the View window and in the Monitor Window Break-menu. Also in the View window, select Break->Function Break and set a break at function test:test4. Check that the break (at line 59) appears in the View Window and in the Monitor Window Break-menu."). ?MAN_CASE(delete4, "Remove breaks", -"Use the Break->Delete All function in the View window to remove all breaks in the test module. Check that they are all removed. Close the View window."). + "Use the Break->Delete All function in the View window to remove all breaks in the test module. Check that they are all removed. Close the View window."). %% SET 5 ?MAN_CASE(attach5,"Set attach options", -"Set the attach options to only attach on exit"). + "Set the attach options to only attach on exit"). ?MAN_CASE(normal5, "Test normal exit", -"Call test:test12(normal) in the shell. This should return the atom 'done', and no windows should be opened."). + "Call test:test12(normal) in the shell. This should return the atom 'done', and no windows should be opened."). ?MAN_CASE(exit5, "Test abnormal exit", -"Call test:test12(crash) in the shell. This should give the error message ** exited: crash **, and an attach window should be opened highlighting the last line in the test12-function."). + "Call test:test12(crash) in the shell. This should give the error message ** exited: crash **, and an attach window should be opened highlighting the last line in the test12-function."). ?MAN_CASE(options5, "Experiment with the frames in the attach window", -"Try all possible configurations of the [Button, Evaluator, Bindings, Trace] Frames in the attach window and see that the expected frames are shown/hidden."). + "Try all possible configurations of the [Button, Evaluator, Bindings, Trace] Frames in the attach window and see that the expected frames are shown/hidden."). %% SET 6 (Distribution) ?MAN_CASE(distsetup6,"Set up distribution", -"Start two erlang systems [foo,bar] (with option -sname), make them aware of eachother using net_adm:ping/1. Start the debugger on foo. Interpret the modules [test, lists1, ordsets1]. Set attach on First call. "). + "Start two erlang systems [foo,bar] (with option -sname), make them aware of eachother using net_adm:ping/1. Start the debugger on foo. Interpret the modules [test, lists1, ordsets1]. Set attach on First call. "). ?MAN_CASE(all_step6, "Click Step through all evaluation", -"In the bar shell, call test:test1().This should open an attach window. Use the Step button, the Process->Step menu item and the ctrl-s shortcut to step through the *entire* execution of the call. (Approx 36 steps). Then close the Attach window. The result printed in the bar shell should be: {\"peter\",[1,2,4,a,b,c],\"olin\"}"). + "In the bar shell, call test:test1().This should open an attach window. Use the Step button, the Process->Step menu item and the ctrl-s shortcut to step through the *entire* execution of the call. (Approx 36 steps). Then close the Attach window. The result printed in the bar shell should be: {\"peter\",[1,2,4,a,b,c],\"olin\"}"). ?MAN_CASE(all_next6,"Click Next through all evaluation", -"Again, in the bar shell, call test:test1(). This time Use the Next button, the Process->Next menu and the ctrl-n shortcut to quickly step over the execution of the four lines in the test1-function. The result printed in the shell should be: {\"peter\",[1,2,4,a,b,c],\"olin\"}"). + "Again, in the bar shell, call test:test1(). This time Use the Next button, the Process->Next menu and the ctrl-n shortcut to quickly step over the execution of the four lines in the test1-function. The result printed in the shell should be: {\"peter\",[1,2,4,a,b,c],\"olin\"}"). diff --git a/lib/debugger/test/debugger_SUITE.erl b/lib/debugger/test/debugger_SUITE.erl index 66d1b04f5c..c72f154928 100644 --- a/lib/debugger/test/debugger_SUITE.erl +++ b/lib/debugger/test/debugger_SUITE.erl @@ -31,7 +31,9 @@ app_test/1,appup_test/1,erts_debug/1,encrypted_debug_info/1, no_abstract_code/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> [app_test, appup_test, erts_debug, no_abstract_code, @@ -54,39 +56,37 @@ end_per_group(_GroupName, Config) -> init_per_testcase(_Case, Config) -> - Dog=test_server:timetrap(?t:minutes(0.5)), - [{watchdog, Dog}|Config]. -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), + Config. + +end_per_testcase(_Case, _Config) -> ok. app_test(Config) when is_list(Config) -> - ?line ?t:app_test(debugger), + test_server:app_test(debugger), ok. appup_test(Config) when is_list(Config) -> - ok = ?t:appup_test(debugger). + ok = test_server:appup_test(debugger). erts_debug(Config) when is_list(Config) -> c:l(erts_debug), ok. no_abstract_code(Config) when is_list(Config) -> - ?line PrivDir = ?config(priv_dir, Config), - ?line Simple = filename:join(PrivDir, "simple"), - ?line Source = Simple ++ ".erl", - ?line BeamFile = Simple ++ ".beam", - ?line simple_file(Source), + PrivDir = proplists:get_value(priv_dir, Config), + Simple = filename:join(PrivDir, "simple"), + Source = Simple ++ ".erl", + BeamFile = Simple ++ ".beam", + simple_file(Source), %% Compile module without abstract code. CompileFlags = [{outdir,PrivDir}], - ?line {ok,_} = compile:file(Source, CompileFlags), - ?line error = int:i(Simple), + {ok,_} = compile:file(Source, CompileFlags), + error = int:i(Simple), %% Cleanup. - ?line ok = file:delete(Source), - ?line ok = file:delete(BeamFile), + ok = file:delete(Source), + ok = file:delete(BeamFile), ok. @@ -100,28 +100,28 @@ encrypted_debug_info(Config) when is_list(Config) -> end. encrypted_debug_info_1(Config) -> - ?line PrivDir = ?config(priv_dir, Config), - ?line Simple = filename:join(PrivDir, "simple"), - ?line Source = Simple ++ ".erl", - ?line BeamFile = Simple ++ ".beam", - ?line simple_file(Source), + PrivDir = proplists:get_value(priv_dir, Config), + Simple = filename:join(PrivDir, "simple"), + Source = Simple ++ ".erl", + BeamFile = Simple ++ ".beam", + simple_file(Source), %% Compile module. Key = "_This a Crypto Key_", CompileFlags = [{outdir,PrivDir},debug_info,{debug_info_key,Key}], - ?line {ok,_} = compile:file(Source, CompileFlags), + {ok,_} = compile:file(Source, CompileFlags), %% Interpret module - ?line ok = beam_lib:crypto_key_fun(simple_crypto_fun(Key)), - ?line {module,simple} = int:i(Simple), + ok = beam_lib:crypto_key_fun(simple_crypto_fun(Key)), + {module,simple} = int:i(Simple), %% Remove key. - ?line {ok,_} = beam_lib:clear_crypto_key_fun(), - ?line error = int:i(Simple), + {ok,_} = beam_lib:clear_crypto_key_fun(), + error = int:i(Simple), %% Cleanup. - ?line ok = file:delete(Source), - ?line ok = file:delete(BeamFile), + ok = file:delete(Source), + ok = file:delete(BeamFile), ok. diff --git a/lib/debugger/test/erl_eval_SUITE.erl b/lib/debugger/test/erl_eval_SUITE.erl index ab1a465085..8907856583 100644 --- a/lib/debugger/test/erl_eval_SUITE.erl +++ b/lib/debugger/test/erl_eval_SUITE.erl @@ -19,6 +19,7 @@ -module(erl_eval_SUITE). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2, init_per_group/2,end_per_group/2]). -export([guard_1/1, guard_2/1, @@ -43,38 +44,23 @@ eval_expr_5/1, eep37/1]). -%% -%% Define to run outside of test server -%% -%%-define(STANDALONE,1). +-include_lib("common_test/include/ct.hrl"). -import(lists,[concat/1, sort/1]). -export([count_down/2, count_down_fun/0, do_apply/2, local_func/3, local_func_value/2]). --ifdef(STANDALONE). --define(config(A,B),config(A,B)). --export([config/2]). --define(line, noop, ). -config(priv_dir,_) -> - ".". --else. --include_lib("common_test/include/ct.hrl"). --export([init_per_testcase/2, end_per_testcase/2]). -% Default timetrap timeout (set in init_per_testcase). --define(default_timeout, ?t:minutes(1)). init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - ?line Dog = ?t:timetrap(?default_timeout), - [{watchdog, Dog} | Config]. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - test_server:timetrap_cancel(Dog), + Config. + +end_per_testcase(_Case, _Config) -> ok. --endif. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> [guard_1, guard_2, match_pattern, string_plusplus, @@ -99,125 +85,101 @@ end_per_group(_GroupName, Config) -> Config. -guard_1(doc) -> - ["(OTP-2405)"]; -guard_1(suite) -> - []; +%% (OTP-2405). guard_1(Config) when is_list(Config) -> - ?line {ok,Tokens ,_} = + {ok,Tokens ,_} = erl_scan:string("if a+4 == 4 -> yes; true -> no end. "), - ?line {ok, [Expr]} = erl_parse:parse_exprs(Tokens), - ?line no = guard_1_compiled(), - ?line {value, no, []} = erl_eval:expr(Expr, []), + {ok, [Expr]} = erl_parse:parse_exprs(Tokens), + no = guard_1_compiled(), + {value, no, []} = erl_eval:expr(Expr, []), ok. guard_1_compiled() -> if a+4 == 4 -> yes; true -> no end. -guard_2(doc) -> - ["Similar to guard_1, but type-correct"]; -guard_2(suite) -> - []; +%% Similar to guard_1, but type-correct. guard_2(Config) when is_list(Config) -> - ?line {ok,Tokens ,_} = + {ok,Tokens ,_} = erl_scan:string("if 6+4 == 4 -> yes; true -> no end. "), - ?line {ok, [Expr]} = erl_parse:parse_exprs(Tokens), - ?line no = guard_2_compiled(), - ?line {value, no, []} = erl_eval:expr(Expr, []), + {ok, [Expr]} = erl_parse:parse_exprs(Tokens), + no = guard_2_compiled(), + {value, no, []} = erl_eval:expr(Expr, []), ok. guard_2_compiled() -> if 6+4 == 4 -> yes; true -> no end. -string_plusplus(doc) -> - ["OTP-3069: syntactic sugar string ++ ..."]; -string_plusplus(suite) -> - []; +%% OTP-3069: syntactic sugar string ++ ... string_plusplus(Config) when is_list(Config) -> - ?line check(fun() -> case "abc" of "ab" ++ L -> L end end, - "case \"abc\" of \"ab\" ++ L -> L end. ", - "c"), - ?line check(fun() -> case "abcde" of "ab" ++ "cd" ++ L -> L end end, - "case \"abcde\" of \"ab\" ++ \"cd\" ++ L -> L end. ", - "e"), - ?line check(fun() -> case "abc" of [97, 98] ++ L -> L end end, - "case \"abc\" of [97, 98] ++ L -> L end. ", - "c"), + check(fun() -> case "abc" of "ab" ++ L -> L end end, + "case \"abc\" of \"ab\" ++ L -> L end. ", + "c"), + check(fun() -> case "abcde" of "ab" ++ "cd" ++ L -> L end end, + "case \"abcde\" of \"ab\" ++ \"cd\" ++ L -> L end. ", + "e"), + check(fun() -> case "abc" of [97, 98] ++ L -> L end end, + "case \"abc\" of [97, 98] ++ L -> L end. ", + "c"), ok. -match_pattern(doc) -> - ["OTP-2983: match operator in pattern"]; -match_pattern(suite) -> - []; +%% OTP-2983: match operator in pattern. match_pattern(Config) when is_list(Config) -> - ?line check(fun() -> case {a, b} of {a, _X}=Y -> {x,Y} end end, - "case {a, b} of {a, X}=Y -> {x,Y} end. ", - {x, {a, b}}), - ?line check(fun() -> case {a, b} of Y={a, _X} -> {x,Y} end end, - "case {a, b} of Y={a, X} -> {x,Y} end. ", - {x, {a, b}}), - ?line check(fun() -> case {a, b} of Y={a, _X}=Z -> {Z,Y} end end, - "case {a, b} of Y={a, X}=Z -> {Z,Y} end. ", - {{a, b}, {a, b}}), - ?line check(fun() -> A = 4, B = 28, <<13:(A+(X=B))>>, X end, - "begin A = 4, B = 28, <<13:(A+(X=B))>>, X end.", - 28), + check(fun() -> case {a, b} of {a, _X}=Y -> {x,Y} end end, + "case {a, b} of {a, X}=Y -> {x,Y} end. ", + {x, {a, b}}), + check(fun() -> case {a, b} of Y={a, _X} -> {x,Y} end end, + "case {a, b} of Y={a, X} -> {x,Y} end. ", + {x, {a, b}}), + check(fun() -> case {a, b} of Y={a, _X}=Z -> {Z,Y} end end, + "case {a, b} of Y={a, X}=Z -> {Z,Y} end. ", + {{a, b}, {a, b}}), + check(fun() -> A = 4, B = 28, <<13:(A+(X=B))>>, X end, + "begin A = 4, B = 28, <<13:(A+(X=B))>>, X end.", + 28), ok. -match_bin(doc) -> - ["binary match problems"]; -match_bin(suite) -> - []; +%% binary match problems. match_bin(Config) when is_list(Config) -> - ?line check(fun() -> <<"abc">> = <<"abc">> end, - "<<\"abc\">> = <<\"abc\">>. ", - <<"abc">>), - ?line check(fun() -> - <<Size,B:Size/binary,Rest/binary>> = <<2,"AB","CD">>, - {Size,B,Rest} - end, - "begin <<Size,B:Size/binary,Rest/binary>> = <<2,\"AB\",\"CD\">>, " - "{Size,B,Rest} end. ", - {2,<<"AB">>,<<"CD">>}), + check(fun() -> <<"abc">> = <<"abc">> end, + "<<\"abc\">> = <<\"abc\">>. ", + <<"abc">>), + check(fun() -> + <<Size,B:Size/binary,Rest/binary>> = <<2,"AB","CD">>, + {Size,B,Rest} + end, + "begin <<Size,B:Size/binary,Rest/binary>> = <<2,\"AB\",\"CD\">>, " + "{Size,B,Rest} end. ", + {2,<<"AB">>,<<"CD">>}), ok. -pattern_expr(doc) -> - ["OTP-3144: compile-time expressions in pattern"]; -pattern_expr(suite) -> - []; +%% OTP-3144: compile-time expressions in pattern. pattern_expr(Config) when is_list(Config) -> - ?line check(fun() -> case 4 of 2+2 -> ok end end, - "case 4 of 2+2 -> ok end. ", - ok), - ?line check(fun() -> case 2 of +2 -> ok end end, - "case 2 of +2 -> ok end. ", - ok), + check(fun() -> case 4 of 2+2 -> ok end end, + "case 4 of 2+2 -> ok end. ", + ok), + check(fun() -> case 2 of +2 -> ok end end, + "case 2 of +2 -> ok end. ", + ok), ok. -guard_3(doc) -> - ["OTP-4518."]; -guard_3(suite) -> - []; +%% OTP-4518. guard_3(Config) when is_list(Config) -> - ?line check(fun() -> if false -> false; true -> true end end, - "if false -> false; true -> true end.", - true), - ?line check(fun() -> if <<"hej">> == <<"hopp">> -> true; - true -> false end end, - "begin if <<\"hej\">> == <<\"hopp\">> -> true; + check(fun() -> if false -> false; true -> true end end, + "if false -> false; true -> true end.", + true), + check(fun() -> if <<"hej">> == <<"hopp">> -> true; + true -> false end end, + "begin if <<\"hej\">> == <<\"hopp\">> -> true; true -> false end end.", false), - ?line check(fun() -> if <<"hej">> == <<"hej">> -> true; - true -> false end end, - "begin if <<\"hej\">> == <<\"hej\">> -> true; + check(fun() -> if <<"hej">> == <<"hej">> -> true; + true -> false end end, + "begin if <<\"hej\">> == <<\"hej\">> -> true; true -> false end end.", true), ok. -guard_4(doc) -> - ["OTP-4885."]; -guard_4(suite) -> - []; +%% OTP-4885. guard_4(Config) when is_list(Config) -> check(fun() -> if erlang:'+'(3,a) -> true ; true -> false end end, "if erlang:'+'(3,a) -> true ; true -> false end.", @@ -226,315 +188,300 @@ guard_4(Config) when is_list(Config) -> end, "if erlang:is_integer(3) -> true ; true -> false end.", true), - ?line check(fun() -> [X || X <- [1,2,3], erlang:is_integer(X)] end, - "[X || X <- [1,2,3], erlang:is_integer(X)].", - [1,2,3]), - ?line check(fun() -> if is_atom(is_integer(a)) -> true ; true -> false end - end, - "if is_atom(is_integer(a)) -> true ; true -> false end.", - true), + check(fun() -> [X || X <- [1,2,3], erlang:is_integer(X)] end, + "[X || X <- [1,2,3], erlang:is_integer(X)].", + [1,2,3]), + check(fun() -> if is_atom(is_integer(a)) -> true ; true -> false end + end, + "if is_atom(is_integer(a)) -> true ; true -> false end.", + true), check(fun() -> if erlang:is_atom(erlang:is_integer(a)) -> true; true -> false end end, "if erlang:is_atom(erlang:is_integer(a)) -> true; " "true -> false end.", true), - ?line check(fun() -> if is_atom(3+a) -> true ; true -> false end end, - "if is_atom(3+a) -> true ; true -> false end.", - false), - ?line check(fun() -> if erlang:is_atom(3+a) -> true ; true -> false end - end, - "if erlang:is_atom(3+a) -> true ; true -> false end.", - false), + check(fun() -> if is_atom(3+a) -> true ; true -> false end end, + "if is_atom(3+a) -> true ; true -> false end.", + false), + check(fun() -> if erlang:is_atom(3+a) -> true ; true -> false end + end, + "if erlang:is_atom(3+a) -> true ; true -> false end.", + false), ok. -lc(doc) -> - ["OTP-4518."]; -lc(suite) -> - []; +%% OTP-4518. lc(Config) when is_list(Config) -> - ?line check(fun() -> X = 32, [X || X <- [1,2,3]] end, - "begin X = 32, [X || X <- [1,2,3]] end.", - [1,2,3]), - ?line check(fun() -> X = 32, - [X || <<X:X>> <- [<<1:32>>,<<2:32>>,<<3:8>>]] end, - %% "binsize variable" ^ - "begin X = 32, + check(fun() -> X = 32, [X || X <- [1,2,3]] end, + "begin X = 32, [X || X <- [1,2,3]] end.", + [1,2,3]), + check(fun() -> X = 32, + [X || <<X:X>> <- [<<1:32>>,<<2:32>>,<<3:8>>]] end, + %% "binsize variable" ^ + "begin X = 32, [X || <<X:X>> <- [<<1:32>>,<<2:32>>,<<3:8>>]] end.", [1,2]), - ?line check(fun() -> Y = 13,[X || {X,Y} <- [{1,2}]] end, - "begin Y = 13,[X || {X,Y} <- [{1,2}]] end.", - [1]), - ?line error_check("begin [A || X <- [{1,2}], 1 == A] end.", - {unbound_var,'A'}), - ?line error_check("begin X = 32, + check(fun() -> Y = 13,[X || {X,Y} <- [{1,2}]] end, + "begin Y = 13,[X || {X,Y} <- [{1,2}]] end.", + [1]), + error_check("begin [A || X <- [{1,2}], 1 == A] end.", + {unbound_var,'A'}), + error_check("begin X = 32, [{Y,W} || X <- [1,2,32,Y=4], Z <- [1,2,W=3]] end.", {unbound_var,'Y'}), - ?line error_check("begin X = 32,<<A:B>> = <<100:X>> end.", - {unbound_var,'B'}), - ?line check(fun() -> [X || X <- [1,2,3,4], not (X < 2)] end, - "begin [X || X <- [1,2,3,4], not (X < 2)] end.", - [2,3,4]), - ?line check(fun() -> [X || X <- [true,false], X] end, - "[X || X <- [true,false], X].", [true]), + error_check("begin X = 32,<<A:B>> = <<100:X>> end.", + {unbound_var,'B'}), + check(fun() -> [X || X <- [1,2,3,4], not (X < 2)] end, + "begin [X || X <- [1,2,3,4], not (X < 2)] end.", + [2,3,4]), + check(fun() -> [X || X <- [true,false], X] end, + "[X || X <- [true,false], X].", [true]), ok. -simple_cases(doc) -> - ["Simple cases, just to cover some code."]; -simple_cases(suite) -> - []; +%% Simple cases, just to cover some code. simple_cases(Config) when is_list(Config) -> - ?line check(fun() -> A = $C end, "A = $C.", $C), - %% ?line check(fun() -> A = 3.14 end, "A = 3.14.", 3.14), - ?line check(fun() -> self() ! a, A = receive a -> true end end, - "begin self() ! a, A = receive a -> true end end.", - true), - ?line check(fun() -> c:flush(), self() ! a, self() ! b, self() ! c, - receive b -> b end, - {messages, [a,c]} = - erlang:process_info(self(), messages), - c:flush() end, - "begin c:flush(), self() ! a, self() ! b, self() ! c," - "receive b -> b end," - "{messages, [a,c]} =" - " erlang:process_info(self(), messages), c:flush() end.", - ok), - ?line check(fun() -> self() ! a, A = receive a -> true - after 0 -> false end end, - "begin self() ! a, A = receive a -> true" - " after 0 -> false end end.", - true), - ?line check(fun() -> c:flush(), self() ! a, self() ! b, self() ! c, - receive b -> b after 0 -> true end, - {messages, [a,c]} = - erlang:process_info(self(), messages), - c:flush() end, - "begin c:flush(), self() ! a, self() ! b, self() ! c," - "receive b -> b after 0 -> true end," - "{messages, [a,c]} =" - " erlang:process_info(self(), messages), c:flush() end.", - ok), - ?line check(fun() -> receive _ -> true after 10 -> false end end, - "receive _ -> true after 10 -> false end.", - false), - ?line check(fun() -> F = fun(A) -> A end, true = 3 == F(3) end, - "begin F = fun(A) -> A end, true = 3 == F(3) end.", - true), - ?line check(fun() -> F = fun(A) -> A end, true = 3 == apply(F, [3]) end, - "begin F = fun(A) -> A end, true = 3 == apply(F,[3]) end.", - true), - ?line check(fun() -> catch throw(a) end, "catch throw(a).", a), - ?line check(fun() -> catch a end, "catch a.", a), - ?line check(fun() -> 4 == 3 end, "4 == 3.", false), - ?line check(fun() -> not true end, "not true.", false), - ?line check(fun() -> -3 end, "-3.", -3), - - ?line error_check("3.0 = 4.0.", {badmatch,4.0}), - ?line check(fun() -> <<(3.0+2.0):32/float>> = <<5.0:32/float>> end, - "<<(3.0+2.0):32/float>> = <<5.0:32/float>>.", - <<5.0:32/float>>), - - ?line check(fun() -> false andalso kludd end, "false andalso kludd.", - false), - ?line check(fun() -> true andalso true end, "true andalso true.", - true), - ?line check(fun() -> true andalso false end, "true andalso false.", - false), - ?line check(fun() -> true andalso kludd end, "true andalso kludd.", - kludd), - ?line error_check("kladd andalso kludd.", {badarg,kladd}), - - ?line check(fun() -> if false andalso kludd -> a; true -> b end end, - "if false andalso kludd -> a; true -> b end.", - b), - ?line check(fun() -> if true andalso true -> a; true -> b end end, - "if true andalso true -> a; true -> b end.", - a), - ?line check(fun() -> if true andalso false -> a; true -> b end end, - "if true andalso false -> a; true -> b end.", - b), - - ?line check(fun() -> true orelse kludd end, - "true orelse kludd.", true), - ?line check(fun() -> false orelse false end, - "false orelse false.", false), - ?line check(fun() -> false orelse true end, - "false orelse true.", true), - ?line check(fun() -> false orelse kludd end, - "false orelse kludd.", kludd), - ?line error_check("kladd orelse kludd.", {badarg,kladd}), - ?line error_check("[X || X <- [1,2,3], begin 1 end].",{bad_filter,1}), - ?line error_check("[X || X <- a].",{bad_generator,a}), - - ?line check(fun() -> if true orelse kludd -> a; true -> b end end, - "if true orelse kludd -> a; true -> b end.", a), - ?line check(fun() -> if false orelse false -> a; true -> b end end, - "if false orelse false -> a; true -> b end.", b), - ?line check(fun() -> if false orelse true -> a; true -> b end end, - "if false orelse true -> a; true -> b end.", a), - - ?line check(fun() -> [X || X <- [1,2,3], X+2] end, - "[X || X <- [1,2,3], X+2].", []), - - ?line check(fun() -> [X || X <- [1,2,3], [X] == [X || X <- [2]]] end, - "[X || X <- [1,2,3], [X] == [X || X <- [2]]].", - [2]), - ?line check(fun() -> F = fun(1) -> ett; (2) -> zwei end, - ett = F(1), zwei = F(2) end, - "begin F = fun(1) -> ett; (2) -> zwei end, + check(fun() -> A = $C end, "A = $C.", $C), + %% check(fun() -> A = 3.14 end, "A = 3.14.", 3.14), + check(fun() -> self() ! a, A = receive a -> true end end, + "begin self() ! a, A = receive a -> true end end.", + true), + check(fun() -> c:flush(), self() ! a, self() ! b, self() ! c, + receive b -> b end, + {messages, [a,c]} = + erlang:process_info(self(), messages), + c:flush() end, + "begin c:flush(), self() ! a, self() ! b, self() ! c," + "receive b -> b end," + "{messages, [a,c]} =" + " erlang:process_info(self(), messages), c:flush() end.", + ok), + check(fun() -> self() ! a, A = receive a -> true + after 0 -> false end end, + "begin self() ! a, A = receive a -> true" + " after 0 -> false end end.", + true), + check(fun() -> c:flush(), self() ! a, self() ! b, self() ! c, + receive b -> b after 0 -> true end, + {messages, [a,c]} = + erlang:process_info(self(), messages), + c:flush() end, + "begin c:flush(), self() ! a, self() ! b, self() ! c," + "receive b -> b after 0 -> true end," + "{messages, [a,c]} =" + " erlang:process_info(self(), messages), c:flush() end.", + ok), + check(fun() -> receive _ -> true after 10 -> false end end, + "receive _ -> true after 10 -> false end.", + false), + check(fun() -> F = fun(A) -> A end, true = 3 == F(3) end, + "begin F = fun(A) -> A end, true = 3 == F(3) end.", + true), + check(fun() -> F = fun(A) -> A end, true = 3 == apply(F, [3]) end, + "begin F = fun(A) -> A end, true = 3 == apply(F,[3]) end.", + true), + check(fun() -> catch throw(a) end, "catch throw(a).", a), + check(fun() -> catch a end, "catch a.", a), + check(fun() -> 4 == 3 end, "4 == 3.", false), + check(fun() -> not true end, "not true.", false), + check(fun() -> -3 end, "-3.", -3), + + error_check("3.0 = 4.0.", {badmatch,4.0}), + check(fun() -> <<(3.0+2.0):32/float>> = <<5.0:32/float>> end, + "<<(3.0+2.0):32/float>> = <<5.0:32/float>>.", + <<5.0:32/float>>), + + check(fun() -> false andalso kludd end, "false andalso kludd.", + false), + check(fun() -> true andalso true end, "true andalso true.", + true), + check(fun() -> true andalso false end, "true andalso false.", + false), + check(fun() -> true andalso kludd end, "true andalso kludd.", + kludd), + error_check("kladd andalso kludd.", {badarg,kladd}), + + check(fun() -> if false andalso kludd -> a; true -> b end end, + "if false andalso kludd -> a; true -> b end.", + b), + check(fun() -> if true andalso true -> a; true -> b end end, + "if true andalso true -> a; true -> b end.", + a), + check(fun() -> if true andalso false -> a; true -> b end end, + "if true andalso false -> a; true -> b end.", + b), + + check(fun() -> true orelse kludd end, + "true orelse kludd.", true), + check(fun() -> false orelse false end, + "false orelse false.", false), + check(fun() -> false orelse true end, + "false orelse true.", true), + check(fun() -> false orelse kludd end, + "false orelse kludd.", kludd), + error_check("kladd orelse kludd.", {badarg,kladd}), + error_check("[X || X <- [1,2,3], begin 1 end].",{bad_filter,1}), + error_check("[X || X <- a].",{bad_generator,a}), + + check(fun() -> if true orelse kludd -> a; true -> b end end, + "if true orelse kludd -> a; true -> b end.", a), + check(fun() -> if false orelse false -> a; true -> b end end, + "if false orelse false -> a; true -> b end.", b), + check(fun() -> if false orelse true -> a; true -> b end end, + "if false orelse true -> a; true -> b end.", a), + + check(fun() -> [X || X <- [1,2,3], X+2] end, + "[X || X <- [1,2,3], X+2].", []), + + check(fun() -> [X || X <- [1,2,3], [X] == [X || X <- [2]]] end, + "[X || X <- [1,2,3], [X] == [X || X <- [2]]].", + [2]), + check(fun() -> F = fun(1) -> ett; (2) -> zwei end, + ett = F(1), zwei = F(2) end, + "begin F = fun(1) -> ett; (2) -> zwei end, ett = F(1), zwei = F(2) end.", zwei), - ?line check(fun() -> F = fun(X) when X == 1 -> ett; - (X) when X == 2 -> zwei end, - ett = F(1), zwei = F(2) end, - "begin F = fun(X) when X == 1 -> ett; + check(fun() -> F = fun(X) when X == 1 -> ett; + (X) when X == 2 -> zwei end, + ett = F(1), zwei = F(2) end, + "begin F = fun(X) when X == 1 -> ett; (X) when X == 2 -> zwei end, - ett = F(1), zwei = F(2) end.", + ett = F(1), zwei = F(2) end.", zwei), - ?line error_check("begin F = fun(1) -> ett end, zwei = F(2) end.", - function_clause), - ?line check(fun() -> if length([1]) == 1 -> yes; - true -> no end end, - "if length([1]) == 1 -> yes; + error_check("begin F = fun(1) -> ett end, zwei = F(2) end.", + function_clause), + check(fun() -> if length([1]) == 1 -> yes; + true -> no end end, + "if length([1]) == 1 -> yes; true -> no end.", yes), - ?line check(fun() -> if is_integer(3) -> true; true -> false end end, - "if is_integer(3) -> true; true -> false end.", true), - ?line check(fun() -> if integer(3) -> true; true -> false end end, - "if integer(3) -> true; true -> false end.", true), - ?line check(fun() -> if is_float(3) -> true; true -> false end end, - "if is_float(3) -> true; true -> false end.", false), - ?line check(fun() -> if float(3) -> true; true -> false end end, - "if float(3) -> true; true -> false end.", false), - ?line check(fun() -> if is_number(3) -> true; true -> false end end, - "if is_number(3) -> true; true -> false end.", true), - ?line check(fun() -> if number(3) -> true; true -> false end end, - "if number(3) -> true; true -> false end.", true), - ?line check(fun() -> if is_atom(a) -> true; true -> false end end, - "if is_atom(a) -> true; true -> false end.", true), - ?line check(fun() -> if atom(a) -> true; true -> false end end, - "if atom(a) -> true; true -> false end.", true), - ?line check(fun() -> if is_list([]) -> true; true -> false end end, - "if is_list([]) -> true; true -> false end.", true), - ?line check(fun() -> if list([]) -> true; true -> false end end, - "if list([]) -> true; true -> false end.", true), - ?line check(fun() -> if is_tuple({}) -> true; true -> false end end, - "if is_tuple({}) -> true; true -> false end.", true), - ?line check(fun() -> if tuple({}) -> true; true -> false end end, - "if tuple({}) -> true; true -> false end.", true), - ?line check(fun() -> if is_pid(self()) -> true; true -> false end end, - "if is_pid(self()) -> true; true -> false end.", true), - ?line check(fun() -> if pid(self()) -> true; true -> false end end, - "if pid(self()) -> true; true -> false end.", true), - ?line check(fun() -> R = make_ref(), if is_reference(R) -> true; - true -> false end end, - "begin R = make_ref(), if is_reference(R) -> true;" - "true -> false end end.", true), - ?line check(fun() -> R = make_ref(), if reference(R) -> true; - true -> false end end, - "begin R = make_ref(), if reference(R) -> true;" - "true -> false end end.", true), - ?line check(fun() -> if is_port(a) -> true; true -> false end end, - "if is_port(a) -> true; true -> false end.", false), - ?line check(fun() -> if port(a) -> true; true -> false end end, - "if port(a) -> true; true -> false end.", false), - ?line check(fun() -> if is_function(a) -> true; true -> false end end, - "if is_function(a) -> true; true -> false end.", false), - ?line check(fun() -> if function(a) -> true; true -> false end end, - "if function(a) -> true; true -> false end.", false), - ?line check(fun() -> if is_binary(<<>>) -> true; true -> false end end, - "if is_binary(<<>>) -> true; true -> false end.", true), - ?line check(fun() -> if binary(<<>>) -> true; true -> false end end, - "if binary(<<>>) -> true; true -> false end.", true), - ?line check(fun() -> if is_integer(a) == true -> yes; - true -> no end end, - "if is_integer(a) == true -> yes; + check(fun() -> if is_integer(3) -> true; true -> false end end, + "if is_integer(3) -> true; true -> false end.", true), + check(fun() -> if integer(3) -> true; true -> false end end, + "if integer(3) -> true; true -> false end.", true), + check(fun() -> if is_float(3) -> true; true -> false end end, + "if is_float(3) -> true; true -> false end.", false), + check(fun() -> if float(3) -> true; true -> false end end, + "if float(3) -> true; true -> false end.", false), + check(fun() -> if is_number(3) -> true; true -> false end end, + "if is_number(3) -> true; true -> false end.", true), + check(fun() -> if number(3) -> true; true -> false end end, + "if number(3) -> true; true -> false end.", true), + check(fun() -> if is_atom(a) -> true; true -> false end end, + "if is_atom(a) -> true; true -> false end.", true), + check(fun() -> if atom(a) -> true; true -> false end end, + "if atom(a) -> true; true -> false end.", true), + check(fun() -> if is_list([]) -> true; true -> false end end, + "if is_list([]) -> true; true -> false end.", true), + check(fun() -> if list([]) -> true; true -> false end end, + "if list([]) -> true; true -> false end.", true), + check(fun() -> if is_tuple({}) -> true; true -> false end end, + "if is_tuple({}) -> true; true -> false end.", true), + check(fun() -> if tuple({}) -> true; true -> false end end, + "if tuple({}) -> true; true -> false end.", true), + check(fun() -> if is_pid(self()) -> true; true -> false end end, + "if is_pid(self()) -> true; true -> false end.", true), + check(fun() -> if pid(self()) -> true; true -> false end end, + "if pid(self()) -> true; true -> false end.", true), + check(fun() -> R = make_ref(), if is_reference(R) -> true; + true -> false end end, + "begin R = make_ref(), if is_reference(R) -> true;" + "true -> false end end.", true), + check(fun() -> R = make_ref(), if reference(R) -> true; + true -> false end end, + "begin R = make_ref(), if reference(R) -> true;" + "true -> false end end.", true), + check(fun() -> if is_port(a) -> true; true -> false end end, + "if is_port(a) -> true; true -> false end.", false), + check(fun() -> if port(a) -> true; true -> false end end, + "if port(a) -> true; true -> false end.", false), + check(fun() -> if is_function(a) -> true; true -> false end end, + "if is_function(a) -> true; true -> false end.", false), + check(fun() -> if function(a) -> true; true -> false end end, + "if function(a) -> true; true -> false end.", false), + check(fun() -> if is_binary(<<>>) -> true; true -> false end end, + "if is_binary(<<>>) -> true; true -> false end.", true), + check(fun() -> if binary(<<>>) -> true; true -> false end end, + "if binary(<<>>) -> true; true -> false end.", true), + check(fun() -> if is_integer(a) == true -> yes; + true -> no end end, + "if is_integer(a) == true -> yes; true -> no end.", no), - ?line check(fun() -> if [] -> true; true -> false end end, - "if [] -> true; true -> false end.", false), - ?line error_check("if lists:member(1,[1]) -> true; true -> false end.", - illegal_guard_expr), - ?line error_check("if false -> true end.", if_clause), - ?line check(fun() -> if a+b -> true; true -> false end end, - "if a + b -> true; true -> false end.", false), - ?line check(fun() -> if + b -> true; true -> false end end, - "if + b -> true; true -> false end.", false), - ?line error_check("case foo of bar -> true end.", {case_clause,foo}), - ?line error_check("case 4 of 2+a -> true; _ -> false end.", - illegal_pattern), - ?line error_check("case 4 of +a -> true; _ -> false end.", - illegal_pattern), - ?line check(fun() -> case a of - X when X == b -> one; - X when X == a -> two - end end, - "begin case a of + check(fun() -> if [] -> true; true -> false end end, + "if [] -> true; true -> false end.", false), + error_check("if lists:member(1,[1]) -> true; true -> false end.", + illegal_guard_expr), + error_check("if false -> true end.", if_clause), + check(fun() -> if a+b -> true; true -> false end end, + "if a + b -> true; true -> false end.", false), + check(fun() -> if + b -> true; true -> false end end, + "if + b -> true; true -> false end.", false), + error_check("case foo of bar -> true end.", {case_clause,foo}), + error_check("case 4 of 2+a -> true; _ -> false end.", + illegal_pattern), + error_check("case 4 of +a -> true; _ -> false end.", + illegal_pattern), + check(fun() -> case a of + X when X == b -> one; + X when X == a -> two + end end, + "begin case a of X when X == b -> one; - X when X == a -> two - end end.", two), - ?line error_check("3 = 4.", {badmatch,4}), - ?line error_check("a = 3.", {badmatch,3}), - %% ?line error_check("3.1 = 2.7.",{badmatch,2.7}), - ?line error_check("$c = 4.", {badmatch,4}), - ?line check(fun() -> $c = $c end, "$c = $c.", $c), - ?line check(fun() -> _ = bar end, "_ = bar.", bar), - ?line check(fun() -> A = 14, A = 14 end, + X when X == a -> two + end end.", two), + error_check("3 = 4.", {badmatch,4}), + error_check("a = 3.", {badmatch,3}), + %% error_check("3.1 = 2.7.",{badmatch,2.7}), + error_check("$c = 4.", {badmatch,4}), + check(fun() -> $c = $c end, "$c = $c.", $c), + check(fun() -> _ = bar end, "_ = bar.", bar), + check(fun() -> A = 14, A = 14 end, "begin A = 14, A = 14 end.", 14), - ?line error_check("begin A = 14, A = 16 end.", {badmatch,16}), - ?line error_check("\"hej\" = \"san\".", {badmatch,"san"}), - ?line check(fun() -> "hej" = "hej" end, + error_check("begin A = 14, A = 16 end.", {badmatch,16}), + error_check("\"hej\" = \"san\".", {badmatch,"san"}), + check(fun() -> "hej" = "hej" end, "\"hej\" = \"hej\".", "hej"), - ?line error_check("[] = [a].", {badmatch,[a]}), - ?line check(fun() -> [] = [] end, "[] = [].", []), - ?line error_check("[a] = [].", {badmatch,[]}), - ?line error_check("{a,b} = 34.", {badmatch,34}), - ?line check(fun() -> <<X:7>> = <<8:7>>, X end, + error_check("[] = [a].", {badmatch,[a]}), + check(fun() -> [] = [] end, "[] = [].", []), + error_check("[a] = [].", {badmatch,[]}), + error_check("{a,b} = 34.", {badmatch,34}), + check(fun() -> <<X:7>> = <<8:7>>, X end, "begin <<X:7>> = <<8:7>>, X end.", 8), - ?line error_check("<<34:32>> = \"hej\".", {badmatch,"hej"}), - ?line check(fun() -> trunc((1 * 3 div 3 + 4 - 3) / 1) rem 2 end, + error_check("<<34:32>> = \"hej\".", {badmatch,"hej"}), + check(fun() -> trunc((1 * 3 div 3 + 4 - 3) / 1) rem 2 end, "begin trunc((1 * 3 div 3 + 4 - 3) / 1) rem 2 end.", 0), - ?line check(fun() -> (2#101 band 2#10101) bor (2#110 bxor 2#010) end, + check(fun() -> (2#101 band 2#10101) bor (2#110 bxor 2#010) end, "(2#101 band 2#10101) bor (2#110 bxor 2#010).", 5), - ?line check(fun() -> (2#1 bsl 4) + (2#10000 bsr 3) end, + check(fun() -> (2#1 bsl 4) + (2#10000 bsr 3) end, "(2#1 bsl 4) + (2#10000 bsr 3).", 18), - ?line check(fun() -> ((1<3) and ((1 =:= 2) or (1 =/= 2))) xor (1=<2) end, + check(fun() -> ((1<3) and ((1 =:= 2) or (1 =/= 2))) xor (1=<2) end, "((1<3) and ((1 =:= 2) or (1 =/= 2))) xor (1=<2).", false), - ?line check(fun() -> (a /= b) or (2 > 4) or (3 >= 3) end, + check(fun() -> (a /= b) or (2 > 4) or (3 >= 3) end, "(a /= b) or (2 > 4) or (3 >= 3).", true), - ?line check(fun() -> "hej" ++ "san" =/= "hejsan" -- "san" end, + check(fun() -> "hej" ++ "san" =/= "hejsan" -- "san" end, "\"hej\" ++ \"san\" =/= \"hejsan\" -- \"san\".", true), - ?line check(fun() -> (bnot 1) < -0 end, "(bnot (+1)) < -0.", true), - ok. + check(fun() -> (bnot 1) < -0 end, "(bnot (+1)) < -0.", true), + ok. -unary_plus(doc) -> - ["OTP-4929. Unary plus rejects non-numbers."]; -unary_plus(suite) -> - []; +%% OTP-4929. Unary plus rejects non-numbers. unary_plus(Config) when is_list(Config) -> - ?line check(fun() -> F = fun(X) -> + X end, - true = -1 == F(-1) end, - "begin F = fun(X) -> + X end," - " true = -1 == F(-1) end.", true, ['F'], none, none), - ?line error_check("+a.", badarith), + check(fun() -> F = fun(X) -> + X end, + true = -1 == F(-1) end, + "begin F = fun(X) -> + X end," + " true = -1 == F(-1) end.", true, ['F'], none, none), + error_check("+a.", badarith), ok. -apply_atom(doc) -> - ["OTP-5064. Can no longer apply atoms."]; -apply_atom(suite) -> - []; +%% OTP-5064. Can no longer apply atoms. apply_atom(Config) when is_list(Config) -> - ?line error_check("[X || X <- [[1],[2]], + error_check("[X || X <- [[1],[2]], begin L = length, L(X) =:= 1 end].", {badfun,length}), ok. -otp_5269(doc) -> - ["OTP-5269. Bugs in the bit syntax."]; -otp_5269(suite) -> - []; +%% OTP-5269. Bugs in the bit syntax. otp_5269(Config) when is_list(Config) -> - ?line check(fun() -> L = 8, + check(fun() -> L = 8, F = fun(<<A:L,B:A>>) -> B end, F(<<16:8, 7:16>>) end, @@ -542,7 +489,7 @@ otp_5269(Config) when is_list(Config) -> L = 8, F = fun(<<A:L,B:A>>) -> B end, F(<<16:8, 7:16>>) end.", 7), - ?line check(fun() -> L = 8, + check(fun() -> L = 8, F = fun(<<L:L,B:L>>) -> B end, F(<<16:8, 7:16>>) end, @@ -550,24 +497,24 @@ otp_5269(Config) when is_list(Config) -> L = 8, F = fun(<<L:L,B:L>>) -> B end, F(<<16:8, 7:16>>) end.", 7), - ?line check(fun() -> L = 8, <<A:L,B:A>> = <<16:8, 7:16>>, B end, + check(fun() -> L = 8, <<A:L,B:A>> = <<16:8, 7:16>>, B end, "begin L = 8, <<A:L,B:A>> = <<16:8, 7:16>>, B end.", 7), - ?line error_check("begin L = 8, <<L:L,B:L>> = <<16:8, 7:16>> end.", + error_check("begin L = 8, <<L:L,B:L>> = <<16:8, 7:16>> end.", {badmatch,<<16:8,7:16>>}), - ?line error_check("begin <<L:16,L:L>> = <<16:16,8:16>>, L end.", + error_check("begin <<L:16,L:L>> = <<16:16,8:16>>, L end.", {badmatch, <<16:16,8:16>>}), - ?line check(fun() -> U = 8, (fun(<<U:U>>) -> U end)(<<32:8>>) end, + check(fun() -> U = 8, (fun(<<U:U>>) -> U end)(<<32:8>>) end, "begin U = 8, (fun(<<U:U>>) -> U end)(<<32:8>>) end.", 32), - ?line check(fun() -> U = 8, [U || <<U:U>> <- [<<32:8>>]] end, + check(fun() -> U = 8, [U || <<U:U>> <- [<<32:8>>]] end, "begin U = 8, [U || <<U:U>> <- [<<32:8>>]] end.", [32]), - ?line error_check("(fun({3,<<A:32,A:32>>}) -> a end) + error_check("(fun({3,<<A:32,A:32>>}) -> a end) ({3,<<17:32,19:32>>}).", function_clause), - ?line check(fun() -> [X || <<A:8, + check(fun() -> [X || <<A:8, B:A>> <- [<<16:8,19:16>>], <<X:8>> <- [<<B:8>>]] end, "[X || <<A:8, @@ -576,12 +523,9 @@ otp_5269(Config) when is_list(Config) -> [19]), ok. -otp_6539(doc) -> - ["OTP-6539. try/catch bugs."]; -otp_6539(suite) -> - []; +%% OTP-6539. try/catch bugs. otp_6539(Config) when is_list(Config) -> - ?line check(fun() -> + check(fun() -> F = fun(A,B) -> try A+B catch _:_ -> dontthinkso @@ -600,152 +544,149 @@ otp_6539(Config) when is_list(Config) -> [3, 5]), ok. -otp_6543(doc) -> - ["OTP-6543. bitlevel binaries."]; -otp_6543(suite) -> - []; +%% OTP-6543. bitlevel binaries. otp_6543(Config) when is_list(Config) -> - ?line check(fun() -> + check(fun() -> << <<X>> || <<X>> <- [1,2,3] >> end, "<< <<X>> || <<X>> <- [1,2,3] >>.", <<>>), - ?line check(fun() -> + check(fun() -> << <<X>> || X <- [1,2,3] >> end, "<< <<X>> || X <- [1,2,3] >>.", <<1,2,3>>), - ?line check(fun() -> + check(fun() -> << <<X:8>> || <<X:2>> <= <<"hej">> >> end, "<< <<X:8>> || <<X:2>> <= <<\"hej\">> >>.", <<1,2,2,0,1,2,1,1,1,2,2,2>>), - ?line check(fun() -> + check(fun() -> << <<X:8>> || <<65,X:4>> <= <<65,7:4,65,3:4,66,8:4>> >> end, "<< <<X:8>> || <<65,X:4>> <= <<65,7:4,65,3:4,66,8:4>> >>.", <<7,3>>), - ?line check(fun() -> <<34:18/big>> end, + check(fun() -> <<34:18/big>> end, "<<34:18/big>>.", <<0,8,2:2>>), - ?line check(fun() -> <<34:18/big-unit:2>> end, + check(fun() -> <<34:18/big-unit:2>> end, "<<34:18/big-unit:2>>.", <<0,0,0,2,2:4>>), - ?line check(fun() -> <<34:18/little>> end, + check(fun() -> <<34:18/little>> end, "<<34:18/little>>.", <<34,0,0:2>>), - ?line case eval_string("<<34:18/native>>.") of + case eval_string("<<34:18/native>>.") of <<0,8,2:2>> -> ok; <<34,0,0:2>> -> ok end, - ?line check(fun() -> <<34:18/big-signed>> end, + check(fun() -> <<34:18/big-signed>> end, "<<34:18/big-signed>>.", <<0,8,2:2>>), - ?line check(fun() -> <<34:18/little-signed>> end, + check(fun() -> <<34:18/little-signed>> end, "<<34:18/little-signed>>.", <<34,0,0:2>>), - ?line case eval_string("<<34:18/native-signed>>.") of + case eval_string("<<34:18/native-signed>>.") of <<0,8,2:2>> -> ok; <<34,0,0:2>> -> ok end, - ?line check(fun() -> <<34:18/big-unsigned>> end, + check(fun() -> <<34:18/big-unsigned>> end, "<<34:18/big-unsigned>>.", <<0,8,2:2>>), - ?line check(fun() -> <<34:18/little-unsigned>> end, + check(fun() -> <<34:18/little-unsigned>> end, "<<34:18/little-unsigned>>.", <<34,0,0:2>>), - ?line case eval_string("<<34:18/native-unsigned>>.") of + case eval_string("<<34:18/native-unsigned>>.") of <<0,8,2:2>> -> ok; <<34,0,0:2>> -> ok end, - ?line check(fun() -> <<3.14:32/float-big>> end, + check(fun() -> <<3.14:32/float-big>> end, "<<3.14:32/float-big>>.", <<64,72,245,195>>), - ?line check(fun() -> <<3.14:32/float-little>> end, + check(fun() -> <<3.14:32/float-little>> end, "<<3.14:32/float-little>>.", <<195,245,72,64>>), - ?line case eval_string("<<3.14:32/float-native>>.") of + case eval_string("<<3.14:32/float-native>>.") of <<64,72,245,195>> -> ok; <<195,245,72,64>> -> ok end, - ?line error_check("<<(<<17,3:2>>)/binary>>.", badarg), - ?line check(fun() -> <<(<<17,3:2>>)/bitstring>> end, + error_check("<<(<<17,3:2>>)/binary>>.", badarg), + check(fun() -> <<(<<17,3:2>>)/bitstring>> end, "<<(<<17,3:2>>)/bitstring>>.", <<17,3:2>>), - ?line check(fun() -> <<(<<17,3:2>>):10/bitstring>> end, + check(fun() -> <<(<<17,3:2>>):10/bitstring>> end, "<<(<<17,3:2>>):10/bitstring>>.", <<17,3:2>>), - ?line check(fun() -> <<<<344:17>>/binary-unit:17>> end, + check(fun() -> <<<<344:17>>/binary-unit:17>> end, "<<<<344:17>>/binary-unit:17>>.", <<344:17>>), - ?line check(fun() -> <<X:18/big>> = <<34:18/big>>, X end, + check(fun() -> <<X:18/big>> = <<34:18/big>>, X end, "begin <<X:18/big>> = <<34:18/big>>, X end.", 34), - ?line check(fun() -> <<X:18/big-unit:2>> = <<34:18/big-unit:2>>, X end, + check(fun() -> <<X:18/big-unit:2>> = <<34:18/big-unit:2>>, X end, "begin <<X:18/big-unit:2>> = <<34:18/big-unit:2>>, X end.", 34), - ?line check(fun() -> <<X:18/little>> = <<34:18/little>>, X end, + check(fun() -> <<X:18/little>> = <<34:18/little>>, X end, "begin <<X:18/little>> = <<34:18/little>>, X end.", 34), - ?line check(fun() -> <<X:18/native>> = <<34:18/native>>, X end, + check(fun() -> <<X:18/native>> = <<34:18/native>>, X end, "begin <<X:18/native>> = <<34:18/native>>, X end.", 34), - ?line check(fun() -> <<X:18/big-signed>> = <<34:18/big-signed>>, X end, + check(fun() -> <<X:18/big-signed>> = <<34:18/big-signed>>, X end, "begin <<X:18/big-signed>> = <<34:18/big-signed>>, X end.", 34), - ?line check(fun() -> <<X:18/little-signed>> = <<34:18/little-signed>>, + check(fun() -> <<X:18/little-signed>> = <<34:18/little-signed>>, X end, "begin <<X:18/little-signed>> = <<34:18/little-signed>>, X end.", 34), - ?line check(fun() -> <<X:18/native-signed>> = <<34:18/native-signed>>, + check(fun() -> <<X:18/native-signed>> = <<34:18/native-signed>>, X end, "begin <<X:18/native-signed>> = <<34:18/native-signed>>, X end.", 34), - ?line check(fun() -> <<X:18/big-unsigned>> = <<34:18/big-unsigned>>, + check(fun() -> <<X:18/big-unsigned>> = <<34:18/big-unsigned>>, X end, "begin <<X:18/big-unsigned>> = <<34:18/big-unsigned>>, X end.", 34), - ?line check(fun() -> + check(fun() -> <<X:18/little-unsigned>> = <<34:18/little-unsigned>>, X end, "begin <<X:18/little-unsigned>> = <<34:18/little-unsigned>>, X end.", 34), - ?line check(fun() -> + check(fun() -> <<X:18/native-unsigned>> = <<34:18/native-unsigned>>, X end, "begin <<X:18/native-unsigned>> = <<34:18/native-unsigned>>, X end.", 34), - ?line check(fun() -> <<X:32/float-big>> = <<2.0:32/float-big>>, X end, + check(fun() -> <<X:32/float-big>> = <<2.0:32/float-big>>, X end, "begin <<X:32/float-big>> = <<2.0:32/float-big>>, X end.", 2.0), - ?line check(fun() -> <<X:32/float-little>> = <<2.0:32/float-little>>, + check(fun() -> <<X:32/float-little>> = <<2.0:32/float-little>>, X end, "begin <<X:32/float-little>> = <<2.0:32/float-little>>, X end.", 2.0), - ?line check(fun() -> <<X:32/float-native>> = <<2.0:32/float-native>>, + check(fun() -> <<X:32/float-native>> = <<2.0:32/float-native>>, X end, "begin <<X:32/float-native>> = <<2.0:32/float-native>>, X end.", 2.0), - ?line check( + check( fun() -> [X || <<"hej",X:8>> <= <<"hej",8,"san",9,"hej",17,"hej">>] end, "[X || <<\"hej\",X:8>> <= <<\"hej\",8,\"san\",9,\"hej\",17,\"hej\">>].", [8,17]), - ?line check( + check( fun() -> L = 8, << <<B:32>> || <<L:L,B:L>> <= <<16:8, 7:16>> >> end, @@ -754,41 +695,41 @@ otp_6543(Config) when is_list(Config) -> <<0,0,0,7>>), %% Test the Value part of a binary segment. %% "Old" bugs have been fixed (partial_eval is called on Value). - ?line check(fun() -> [ 3 || <<17/float>> <= <<17.0/float>>] end, + check(fun() -> [ 3 || <<17/float>> <= <<17.0/float>>] end, "[ 3 || <<17/float>> <= <<17.0/float>>].", [3]), - ?line check(fun() -> [ 3 || <<17/float>> <- [<<17.0/float>>]] end, + check(fun() -> [ 3 || <<17/float>> <- [<<17.0/float>>]] end, "[ 3 || <<17/float>> <- [<<17.0/float>>]].", [3]), - ?line check(fun() -> [ X || <<17/float,X:3>> <= <<17.0/float,2:3>>] end, + check(fun() -> [ X || <<17/float,X:3>> <= <<17.0/float,2:3>>] end, "[ X || <<17/float,X:3>> <= <<17.0/float,2:3>>].", [2]), - ?line check(fun() -> + check(fun() -> [ foo || <<(1 bsl 1023)/float>> <= <<(1 bsl 1023)/float>>] end, "[ foo || <<(1 bsl 1023)/float>> <= <<(1 bsl 1023)/float>>].", [foo]), - ?line check(fun() -> + check(fun() -> [ foo || <<(1 bsl 1023)/float>> <- [<<(1 bsl 1023)/float>>]] end, "[ foo || <<(1 bsl 1023)/float>> <- [<<(1 bsl 1023)/float>>]].", [foo]), - ?line error_check("[ foo || <<(1 bsl 1024)/float>> <- + error_check("[ foo || <<(1 bsl 1024)/float>> <- [<<(1 bsl 1024)/float>>]].", badarg), - ?line check(fun() -> + check(fun() -> [ foo || <<(1 bsl 1024)/float>> <- [<<(1 bsl 1023)/float>>]] end, "[ foo || <<(1 bsl 1024)/float>> <- [<<(1 bsl 1023)/float>>]].", []), - ?line check(fun() -> + check(fun() -> [ foo || <<(1 bsl 1024)/float>> <= <<(1 bsl 1023)/float>>] end, "[ foo || <<(1 bsl 1024)/float>> <= <<(1 bsl 1023)/float>>].", []), - ?line check(fun() -> + check(fun() -> L = 8, [{L,B} || <<L:L,B:L/float>> <= <<32:8,7:32/float>>] end, @@ -796,7 +737,7 @@ otp_6543(Config) when is_list(Config) -> [{L,B} || <<L:L,B:L/float>> <= <<32:8,7:32/float>>] end.", [{32,7.0}]), - ?line check(fun() -> + check(fun() -> L = 8, [{L,B} || <<L:L,B:L/float>> <- [<<32:8,7:32/float>>]] end, @@ -804,127 +745,117 @@ otp_6543(Config) when is_list(Config) -> [{L,B} || <<L:L,B:L/float>> <- [<<32:8,7:32/float>>]] end.", [{32,7.0}]), - ?line check(fun() -> + check(fun() -> [foo || <<"s">> <= <<"st">>] end, "[foo || <<\"s\">> <= <<\"st\">>].", [foo]), - ?line check(fun() -> <<_:32>> = <<17:32>> end, + check(fun() -> <<_:32>> = <<17:32>> end, "<<_:32>> = <<17:32>>.", <<17:32>>), - ?line check(fun() -> [foo || <<_:32>> <= <<17:32,20:32>>] end, + check(fun() -> [foo || <<_:32>> <= <<17:32,20:32>>] end, "[foo || <<_:32>> <= <<17:32,20:32>>].", [foo,foo]), - ?line check(fun() -> << <<X:32>> || X <- [1,2,3], X > 1 >> end, + check(fun() -> << <<X:32>> || X <- [1,2,3], X > 1 >> end, "<< <<X:32>> || X <- [1,2,3], X > 1 >>.", <<0,0,0,2,0,0,0,3>>), - ?line error_check("[X || <<X>> <= [a,b]].",{bad_generator,[a,b]}), + error_check("[X || <<X>> <= [a,b]].",{bad_generator,[a,b]}), ok. -otp_6787(doc) -> - ["OTP-6787. bitlevel binaries."]; -otp_6787(suite) -> - []; +%% OTP-6787. bitlevel binaries. otp_6787(Config) when is_list(Config) -> - ?line check( + check( fun() -> <<16:(1024*1024)>> = <<16:(1024*1024)>> end, "<<16:(1024*1024)>> = <<16:(1024*1024)>>.", <<16:1048576>>), ok. -otp_6977(doc) -> - ["OTP-6977. ++ bug."]; -otp_6977(suite) -> - []; +%% OTP-6977. ++ bug. otp_6977(Config) when is_list(Config) -> - ?line check( + check( fun() -> (fun([$X] ++ _) -> ok end)("X") end, "(fun([$X] ++ _) -> ok end)(\"X\").", ok), ok. -otp_7550(doc) -> - ["OTP-7550. Support for UTF-8, UTF-16, UTF-32."]; +%% OTP-7550. Support for UTF-8, UTF-16, UTF-32. otp_7550(Config) when is_list(Config) -> %% UTF-8. - ?line check( + check( fun() -> <<65>> = <<65/utf8>> end, "<<65>> = <<65/utf8>>.", <<65>>), - ?line check( + check( fun() -> <<350/utf8>> = <<197,158>> end, "<<350/utf8>> = <<197,158>>.", <<197,158>>), - ?line check( + check( fun() -> <<$b,$j,$\303,$\266,$r,$n>> = <<"bj\366rn"/utf8>> end, "<<$b,$j,$\303,$\266,$r,$n>> = <<\"bj\366rn\"/utf8>>.", <<$b,$j,$\303,$\266,$r,$n>>), %% UTF-16. - ?line check( + check( fun() -> <<0,65>> = <<65/utf16>> end, "<<0,65>> = <<65/utf16>>.", <<0,65>>), - ?line check( + check( fun() -> <<16#D8,16#08,16#DF,16#45>> = <<16#12345/utf16>> end, "<<16#D8,16#08,16#DF,16#45>> = <<16#12345/utf16>>.", <<16#D8,16#08,16#DF,16#45>>), - ?line check( + check( fun() -> <<16#08,16#D8,16#45,16#DF>> = <<16#12345/little-utf16>> end, "<<16#08,16#D8,16#45,16#DF>> = <<16#12345/little-utf16>>.", <<16#08,16#D8,16#45,16#DF>>), - ?line check( + check( fun() -> <<350/utf16>> = <<1,94>> end, "<<350/utf16>> = <<1,94>>.", <<1,94>>), - ?line check( + check( fun() -> <<350/little-utf16>> = <<94,1>> end, "<<350/little-utf16>> = <<94,1>>.", <<94,1>>), - ?line check( + check( fun() -> <<16#12345/utf16>> = <<16#D8,16#08,16#DF,16#45>> end, "<<16#12345/utf16>> = <<16#D8,16#08,16#DF,16#45>>.", <<16#D8,16#08,16#DF,16#45>>), - ?line check( + check( fun() -> <<16#12345/little-utf16>> = <<16#08,16#D8,16#45,16#DF>> end, "<<16#12345/little-utf16>> = <<16#08,16#D8,16#45,16#DF>>.", <<16#08,16#D8,16#45,16#DF>>), %% UTF-32. - ?line check( + check( fun() -> <<16#12345/utf32>> = <<16#0,16#01,16#23,16#45>> end, "<<16#12345/utf32>> = <<16#0,16#01,16#23,16#45>>.", <<16#0,16#01,16#23,16#45>>), - ?line check( + check( fun() -> <<16#0,16#01,16#23,16#45>> = <<16#12345/utf32>> end, "<<16#0,16#01,16#23,16#45>> = <<16#12345/utf32>>.", <<16#0,16#01,16#23,16#45>>), - ?line check( + check( fun() -> <<16#12345/little-utf32>> = <<16#45,16#23,16#01,16#00>> end, "<<16#12345/little-utf32>> = <<16#45,16#23,16#01,16#00>>.", <<16#45,16#23,16#01,16#00>>), - ?line check( + check( fun() -> <<16#12345/little-utf32>> end, "<<16#12345/little-utf32>>.", <<16#45,16#23,16#01,16#00>>), %% Mixed. - ?line check( + check( fun() -> <<16#41,16#12345/utf32,16#0391:16,16#2E:8>> end, "<<16#41,16#12345/utf32,16#0391:16,16#2E:8>>.", <<16#41,16#00,16#01,16#23,16#45,16#03,16#91,16#2E>>), ok. -otp_8133(doc) -> - ["OTP-8133. Bit comprehension bug."]; -otp_8133(suite) -> - []; +%% OTP-8133. Bit comprehension bug. otp_8133(Config) when is_list(Config) -> - ?line check( + check( fun() -> E = fun(N) -> if @@ -947,7 +878,7 @@ otp_8133(Config) when is_list(Config) -> end end.", ok), - ?line check( + check( fun() -> E = fun(N) -> if @@ -972,44 +903,41 @@ otp_8133(Config) when is_list(Config) -> ok), ok. -funs(doc) -> - ["Simple cases, just to cover some code."]; -funs(suite) -> - []; +%% Simple cases, just to cover some code. funs(Config) when is_list(Config) -> do_funs(none, none), do_funs(lfh(), none), do_funs(lfh(), efh()), - ?line error_check("nix:foo().", {access_not_allowed,nix}, lfh(), efh()), - ?line error_check("bar().", undef, none, none), + error_check("nix:foo().", {access_not_allowed,nix}, lfh(), efh()), + error_check("bar().", undef, none, none), - ?line check(fun() -> F1 = fun(F,N) -> ?MODULE:count_down(F, N) end, + check(fun() -> F1 = fun(F,N) -> ?MODULE:count_down(F, N) end, F1(F1, 1000) end, "begin F1 = fun(F,N) -> count_down(F, N) end," "F1(F1,1000) end.", 0, ['F1'], lfh(), none), - ?line check(fun() -> F1 = fun(F,N) -> ?MODULE:count_down(F, N) end, + check(fun() -> F1 = fun(F,N) -> ?MODULE:count_down(F, N) end, F1(F1, 1000) end, "begin F1 = fun(F,N) -> count_down(F, N) end," "F1(F1,1000) end.", 0, ['F1'], lfh_value(), none), - ?line check(fun() -> F1 = fun(F,N) -> ?MODULE:count_down(F, N) end, + check(fun() -> F1 = fun(F,N) -> ?MODULE:count_down(F, N) end, F1(F1, 1000) end, "begin F1 = fun(F,N) -> count_down(F, N) end," "F1(F1,1000) end.", 0, ['F1'], lfh_value_extra(), none), - ?line check(fun() -> F1 = fun(F,N) -> ?MODULE:count_down(F, N) end, + check(fun() -> F1 = fun(F,N) -> ?MODULE:count_down(F, N) end, F1(F1, 1000) end, "begin F1 = fun(F,N) -> count_down(F, N) end," "F1(F1,1000) end.", 0, ['F1'], {?MODULE,local_func_value}, none), %% This is not documented, and only for backward compatibility (good!). B0 = erl_eval:new_bindings(), - ?line check(fun() -> is_function(?MODULE:count_down_fun()) end, + check(fun() -> is_function(?MODULE:count_down_fun()) end, "begin is_function(count_down_fun()) end.", true, [], {?MODULE,local_func,[B0]},none), @@ -1017,16 +945,16 @@ funs(Config) when is_list(Config) -> ({M,F}, As) -> apply(M, F, As) end, EFH = {value, EF}, - ?line error_check("apply(timer, sleep, [1]).", got_it, none, EFH), - ?line error_check("begin F = fun(T) -> timer:sleep(T) end,F(1) end.", + error_check("apply(timer, sleep, [1]).", got_it, none, EFH), + error_check("begin F = fun(T) -> timer:sleep(T) end,F(1) end.", got_it, none, EFH), - ?line error_check("fun c/1.", undef), - ?line error_check("fun a:b/0().", undef), + error_check("fun c/1.", undef), + error_check("fun a:b/0().", undef), MaxArgs = 20, - ?line [true] = + [true] = lists:usort([run_many_args(SAs) || SAs <- many_args(MaxArgs)]), - ?line {'EXIT',{{argument_limit,_},_}} = + {'EXIT',{{argument_limit,_},_}} = (catch run_many_args(many_args1(MaxArgs+1))), ok. @@ -1053,17 +981,17 @@ do_funs(LFH, EFH) -> %% manually with 1000 replaced by 1000000. M = atom_to_list(?MODULE), - ?line check(fun() -> F1 = fun(F,N) -> ?MODULE:count_down(F, N) end, + check(fun() -> F1 = fun(F,N) -> ?MODULE:count_down(F, N) end, F1(F1, 1000) end, concat(["begin F1 = fun(F,N) -> ", M, ":count_down(F, N) end, F1(F1,1000) end."]), 0, ['F1'], LFH, EFH), - ?line check(fun() -> F1 = fun(F,N) -> apply(?MODULE,count_down,[F,N]) + check(fun() -> F1 = fun(F,N) -> apply(?MODULE,count_down,[F,N]) end, F1(F1, 1000) end, concat(["begin F1 = fun(F,N) -> apply(", M, ",count_down,[F, N]) end, F1(F1,1000) end."]), 0, ['F1'], LFH, EFH), - ?line check(fun() -> F = fun(F,N) when N > 0 -> apply(F,[F,N-1]); + check(fun() -> F = fun(F,N) when N > 0 -> apply(F,[F,N-1]); (_F,0) -> ok end, F(F, 1000) end, @@ -1071,7 +999,7 @@ do_funs(LFH, EFH) -> "(_F,0) -> ok end," "F(F, 1000) end.", ok, ['F'], LFH, EFH), - ?line check(fun() -> F = fun(F,N) when N > 0 -> + check(fun() -> F = fun(F,N) when N > 0 -> apply(erlang,apply,[F,[F,N-1]]); (_F,0) -> ok end, F(F, 1000) @@ -1081,7 +1009,7 @@ do_funs(LFH, EFH) -> "(_F,0) -> ok end," "F(F, 1000) end.", ok, ['F'], LFH, EFH), - ?line check(fun() -> F = count_down_fun(), + check(fun() -> F = count_down_fun(), SF = fun(SF, F1, N) -> F(SF, F1, N) end, SF(SF, F, 1000) end, concat(["begin F = ", M, ":count_down_fun()," @@ -1090,17 +1018,17 @@ do_funs(LFH, EFH) -> ok, ['F','SF'], LFH, EFH), - ?line check(fun() -> F = fun(X) -> A = 1+X, {X,A} end, + check(fun() -> F = fun(X) -> A = 1+X, {X,A} end, true = {2,3} == F(2) end, "begin F = fun(X) -> A = 1+X, {X,A} end, true = {2,3} == F(2) end.", true, ['F'], LFH, EFH), - ?line check(fun() -> F = fun(X) -> byte_size(X) end, + check(fun() -> F = fun(X) -> byte_size(X) end, ?MODULE:do_apply(F,<<"hej">>) end, concat(["begin F = fun(X) -> size(X) end,", M,":do_apply(F,<<\"hej\">>) end."]), 3, ['F'], LFH, EFH), - ?line check(fun() -> F1 = fun(X, Z) -> {X,Z} end, + check(fun() -> F1 = fun(X, Z) -> {X,Z} end, Z = 5, F2 = fun(X, Y) -> F1(Z,{X,Y}) end, F3 = fun(X, Y) -> {a,F1(Z,{X,Y})} end, @@ -1117,26 +1045,26 @@ do_funs(LFH, EFH) -> {5,{5,y}} = F2(Z,y), true = {5,{x,5}} == F2(x,Z) end.", true, ['F1','Z','F2','F3'], LFH, EFH), - ?line check(fun() -> F = fun(X) -> byte_size(X) end, + check(fun() -> F = fun(X) -> byte_size(X) end, F2 = fun(Y) -> F(Y) end, ?MODULE:do_apply(F2,<<"hej">>) end, concat(["begin F = fun(X) -> size(X) end,", "F2 = fun(Y) -> F(Y) end,", M,":do_apply(F2,<<\"hej\">>) end."]), 3, ['F','F2'], LFH, EFH), - ?line check(fun() -> Z = 5, F = fun(X) -> {Z,X} end, + check(fun() -> Z = 5, F = fun(X) -> {Z,X} end, F2 = fun(Z) -> F(Z) end, F2(3) end, "begin Z = 5, F = fun(X) -> {Z,X} end, F2 = fun(Z) -> F(Z) end, F2(3) end.", {5,3},['F','F2','Z'], LFH, EFH), - ?line check(fun() -> F = fun(Z) -> Z end, + check(fun() -> F = fun(Z) -> Z end, F2 = fun(X) -> F(X), Z = {X,X}, Z end, {1,1} = F2(1), Z = 7, Z end, "begin F = fun(Z) -> Z end, F2 = fun(X) -> F(X), Z = {X,X}, Z end, {1,1} = F2(1), Z = 7, Z end.", 7, ['F','F2','Z'], LFH, EFH), - ?line check(fun() -> F = fun(F, N) -> [?MODULE:count_down(F,N) || X <-[1]] + check(fun() -> F = fun(F, N) -> [?MODULE:count_down(F,N) || X <-[1]] end, F(F,2) end, concat(["begin F = fun(F, N) -> [", M, ":count_down(F,N) || X <-[1]] end, F(F,2) end."]), @@ -1195,45 +1123,42 @@ external_func({M,F}, As) -> -try_catch(doc) -> - ["Test try-of-catch-after-end statement"]; -try_catch(suite) -> - []; +%% Test try-of-catch-after-end statement. try_catch(Config) when is_list(Config) -> %% Match in of with catch - ?line check(fun() -> try 1 of 1 -> 2 catch _:_ -> 3 end end, + check(fun() -> try 1 of 1 -> 2 catch _:_ -> 3 end end, "try 1 of 1 -> 2 catch _:_ -> 3 end.", 2), - ?line check(fun() -> try 1 of 1 -> 2; 3 -> 4 catch _:_ -> 5 end end, + check(fun() -> try 1 of 1 -> 2; 3 -> 4 catch _:_ -> 5 end end, "try 1 of 1 -> 2; 3 -> 4 catch _:_ -> 5 end.", 2), - ?line check(fun() -> try 3 of 1 -> 2; 3 -> 4 catch _:_ -> 5 end end, + check(fun() -> try 3 of 1 -> 2; 3 -> 4 catch _:_ -> 5 end end, "try 3 of 1 -> 2; 3 -> 4 catch _:_ -> 5 end.", 4), %% Just after - ?line check(fun () -> X = try 1 after put(try_catch, 2) end, + check(fun () -> X = try 1 after put(try_catch, 2) end, {X,get(try_catch)} end, "begin X = try 1 after put(try_catch, 2) end, " "{X,get(try_catch)} end.", {1,2}), %% Match in of with after - ?line check(fun() -> X = try 1 of 1 -> 2 after put(try_catch, 3) end, + check(fun() -> X = try 1 of 1 -> 2 after put(try_catch, 3) end, {X,get(try_catch)} end, "begin X = try 1 of 1 -> 2 after put(try_catch, 3) end, " "{X,get(try_catch)} end.", {2,3}), - ?line check(fun() -> X = try 1 of 1 -> 2; 3 -> 4 + check(fun() -> X = try 1 of 1 -> 2; 3 -> 4 after put(try_catch, 5) end, {X,get(try_catch)} end, "begin X = try 1 of 1 -> 2; 3 -> 4 " " after put(try_catch, 5) end, " " {X,get(try_catch)} end.", {2,5}), - ?line check(fun() -> X = try 3 of 1 -> 2; 3 -> 4 + check(fun() -> X = try 3 of 1 -> 2; 3 -> 4 after put(try_catch, 5) end, {X,get(try_catch)} end, "begin X = try 3 of 1 -> 2; 3 -> 4 " " after put(try_catch, 5) end, " " {X,get(try_catch)} end.", {4,5}), %% Nomatch in of - ?line error_check("try 1 of 2 -> 3 catch _:_ -> 4 end.", + error_check("try 1 of 2 -> 3 catch _:_ -> 4 end.", {try_clause,1}), %% Nomatch in of with after - ?line check(fun () -> {'EXIT',{{try_clause,1},_}} = + check(fun () -> {'EXIT',{{try_clause,1},_}} = begin catch try 1 of 2 -> 3 after put(try_catch, 4) end end, get(try_catch) end, @@ -1242,14 +1167,14 @@ try_catch(Config) when is_list(Config) -> " after put(try_catch, 4) end end, " " get(try_catch) end. ", 4), %% Exception in try - ?line check(fun () -> try 1=2 catch error:{badmatch,2} -> 3 end end, + check(fun () -> try 1=2 catch error:{badmatch,2} -> 3 end end, "try 1=2 catch error:{badmatch,2} -> 3 end.", 3), - ?line check(fun () -> try 1=2 of 3 -> 4 + check(fun () -> try 1=2 of 3 -> 4 catch error:{badmatch,2} -> 5 end end, "try 1=2 of 3 -> 4 " "catch error:{badmatch,2} -> 5 end.", 5), %% Exception in try with after - ?line check(fun () -> X = try 1=2 + check(fun () -> X = try 1=2 catch error:{badmatch,2} -> 3 after put(try_catch, 4) end, {X,get(try_catch)} end, @@ -1257,7 +1182,7 @@ try_catch(Config) when is_list(Config) -> " catch error:{badmatch,2} -> 3 " " after put(try_catch, 4) end, " " {X,get(try_catch)} end. ", {3,4}), - ?line check(fun () -> X = try 1=2 of 3 -> 4 + check(fun () -> X = try 1=2 of 3 -> 4 catch error:{badmatch,2} -> 5 after put(try_catch, 6) end, {X,get(try_catch)} end, @@ -1266,12 +1191,12 @@ try_catch(Config) when is_list(Config) -> " after put(try_catch, 6) end, " " {X,get(try_catch)} end. ", {5,6}), %% Uncaught exception - ?line error_check("try 1=2 catch error:undefined -> 3 end. ", + error_check("try 1=2 catch error:undefined -> 3 end. ", {badmatch,2}), - ?line error_check("try 1=2 of 3 -> 4 catch error:undefined -> 5 end. ", + error_check("try 1=2 of 3 -> 4 catch error:undefined -> 5 end. ", {badmatch,2}), %% Uncaught exception with after - ?line check(fun () -> {'EXIT',{{badmatch,2},_}} = + check(fun () -> {'EXIT',{{badmatch,2},_}} = begin catch try 1=2 after put(try_catch, 3) end end, get(try_catch) end, @@ -1279,7 +1204,7 @@ try_catch(Config) when is_list(Config) -> " begin catch try 1=2 " " after put(try_catch, 3) end end, " " get(try_catch) end. ", 3), - ?line check(fun () -> {'EXIT',{{badmatch,2},_}} = + check(fun () -> {'EXIT',{{badmatch,2},_}} = begin catch try 1=2 of 3 -> 4 after put(try_catch, 5) end end, get(try_catch) end, @@ -1287,7 +1212,7 @@ try_catch(Config) when is_list(Config) -> " begin catch try 1=2 of 3 -> 4" " after put(try_catch, 5) end end, " " get(try_catch) end. ", 5), - ?line check(fun () -> {'EXIT',{{badmatch,2},_}} = + check(fun () -> {'EXIT',{{badmatch,2},_}} = begin catch try 1=2 catch error:undefined -> 3 after put(try_catch, 4) end end, get(try_catch) end, @@ -1295,7 +1220,7 @@ try_catch(Config) when is_list(Config) -> " begin catch try 1=2 catch error:undefined -> 3 " " after put(try_catch, 4) end end, " " get(try_catch) end. ", 4), - ?line check(fun () -> {'EXIT',{{badmatch,2},_}} = + check(fun () -> {'EXIT',{{badmatch,2},_}} = begin catch try 1=2 of 3 -> 4 catch error:undefined -> 5 after put(try_catch, 6) end end, @@ -1308,19 +1233,16 @@ try_catch(Config) when is_list(Config) -> ok. -eval_expr_5(doc) -> - ["(OTP-7933)"]; -eval_expr_5(suite) -> - []; +%% (OTP-7933). eval_expr_5(Config) when is_list(Config) -> - ?line {ok,Tokens ,_} = + {ok,Tokens ,_} = erl_scan:string("if a+4 == 4 -> yes; true -> no end. "), - ?line {ok, [Expr]} = erl_parse:parse_exprs(Tokens), - ?line {value, no, []} = erl_eval:expr(Expr, [], none, none, none), - ?line no = erl_eval:expr(Expr, [], none, none, value), + {ok, [Expr]} = erl_parse:parse_exprs(Tokens), + {value, no, []} = erl_eval:expr(Expr, [], none, none, none), + no = erl_eval:expr(Expr, [], none, none, value), try erl_eval:expr(Expr, [], none, none, 4711), - ?line function_clause = should_never_reach_here + function_clause = should_never_reach_here catch error:function_clause -> ok @@ -1362,7 +1284,7 @@ check1(F, String, Result) -> {value, Result, _} -> ok; Other -> - test_server:fail({eval, Other, Result}) + ct:fail({eval, Other, Result}) end. check(F, String, Result, BoundVars, LFH, EFH) -> @@ -1375,11 +1297,11 @@ check(F, String, Result, BoundVars, LFH, EFH) -> true -> ok; false -> - test_server:fail({check, BoundVars, Keys}) + ct:fail({check, BoundVars, Keys}) end, ok; Other -> - test_server:fail({check, Other, Result}) + ct:fail({check, Other, Result}) end. error_check(String, Result) -> @@ -1387,7 +1309,7 @@ error_check(String, Result) -> {'EXIT', {Result,_}} -> ok; Other -> - test_server:fail({eval, Other, Result}) + ct:fail({eval, Other, Result}) end. error_check(String, Result, LFH, EFH) -> @@ -1395,7 +1317,7 @@ error_check(String, Result, LFH, EFH) -> {'EXIT', {Result,_}} -> ok; Other -> - test_server:fail({eval, Other, Result}) + ct:fail({eval, Other, Result}) end. eval_string(String) -> diff --git a/lib/debugger/test/exception_SUITE.erl b/lib/debugger/test/exception_SUITE.erl index f698dd317b..ef824b00be 100644 --- a/lib/debugger/test/exception_SUITE.erl +++ b/lib/debugger/test/exception_SUITE.erl @@ -30,13 +30,13 @@ -include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. %% Filler. %% %% -%% -%% %% This is line 40. even(N) when is_integer(N), N > 1, (N rem 2) == 0 -> odd(N-1)++[N]. @@ -68,17 +68,14 @@ cases() -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(1)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> @@ -87,25 +84,25 @@ end_per_suite(Config) when is_list(Config) -> %% Test that deliberately bad matches are reported correctly. badmatch(Config) when is_list(Config) -> - ?line ?try_match(a), - ?line ?try_match(42), - ?line ?try_match({a, b, c}), - ?line ?try_match([]), - ?line ?try_match(1.0), + ?try_match(a), + ?try_match(42), + ?try_match({a, b, c}), + ?try_match([]), + ?try_match(1.0), ok. %% Test various exceptions, in the presence of a previous error suppressed %% in a guard. pending_errors(Config) when is_list(Config) -> - ?line pending(e_badmatch, {badmatch, b}), - ?line pending(x, function_clause), - ?line pending(e_case, {case_clause, xxx}), - ?line pending(e_if, if_clause), - ?line pending(e_badarith, badarith), - ?line pending(e_undef, undef), - ?line pending(e_timeoutval, timeout_value), - ?line pending(e_badarg, badarg), - ?line pending(e_badarg_spawn, badarg), + pending(e_badmatch, {badmatch, b}), + pending(x, function_clause), + pending(e_case, {case_clause, xxx}), + pending(e_if, if_clause), + pending(e_badarith, badarith), + pending(e_undef, undef), + pending(e_timeoutval, timeout_value), + pending(e_badarg, badarg), + pending(e_badarg_spawn, badarg), ok. bad_guy(pe_badarith, Other) when Other+1 == 0 -> % badarith (suppressed) @@ -126,9 +123,9 @@ bad_guy(_, e_undef) -> non_existing_module:foo(); % undef bad_guy(_, e_timeoutval) -> receive - after arne -> % timeout_value - ok - end; + after arne -> % timeout_value + ok + end; bad_guy(_, e_badarg) -> node(xxx); % badarg bad_guy(_, e_badarg_spawn) -> @@ -150,7 +147,7 @@ pending_catched(First, Second, Expected) -> {'EXIT', Reason} -> pending(Reason, bad_guy, [First, Second], Expected); Other -> - test_server:fail({not_exit, Other}) + ct:fail({not_exit, Other}) end. pending_exit_message(Args, Expected) -> @@ -162,9 +159,9 @@ pending_exit_message(Args, Expected) -> {'EXIT', Pid, Reason} -> pending(Reason, bad_guy, Args, Expected); Other -> - test_server:fail({unexpected_message, Other}) + ct:fail({unexpected_message, Other}) after 10000 -> - test_server:fail(timeout) + ct:fail(timeout) end, process_flag(trap_exit, false). @@ -180,67 +177,67 @@ pending({Code,[{?MODULE,Func,Arity,_}|_]}, Func, Args, Code) when length(Args) == Arity -> ok; pending(Reason, _Function, _Args, _Code) -> - test_server:fail({bad_exit_reason,Reason}). + ct:fail({bad_exit_reason,Reason}). %% Test that doing arithmetics on [] gives a badarith EXIT and not a crash. nil_arith(Config) when is_list(Config) -> - ?line ba_plus_minus_times([], []), - - ?line ba_plus_minus_times([], 0), - ?line ba_plus_minus_times([], 42), - ?line ba_plus_minus_times([], 38724978123478923784), - ?line ba_plus_minus_times([], 38.72), - - ?line ba_plus_minus_times(0, []), - ?line ba_plus_minus_times(334, []), - ?line ba_plus_minus_times(387249797813478923784, []), - ?line ba_plus_minus_times(344.22, []), - - ?line ba_div_rem([], []), - - ?line ba_div_rem([], 0), - ?line ba_div_rem([], 1), - ?line ba_div_rem([], 42), - ?line ba_div_rem([], 38724978123478923784), - ?line ba_div_rem(344.22, []), - - ?line ba_div_rem(0, []), - ?line ba_div_rem(1, []), - ?line ba_div_rem(334, []), - ?line ba_div_rem(387249797813478923784, []), - ?line ba_div_rem(344.22, []), - - ?line ba_div_rem(344.22, 0.0), - ?line ba_div_rem(1, 0.0), - ?line ba_div_rem(392873498733971, 0.0), - - ?line ba_bop([], []), - ?line ba_bop(0, []), - ?line ba_bop(42, []), - ?line ba_bop(-42342742987343, []), - ?line ba_bop(238.342, []), - ?line ba_bop([], 0), - ?line ba_bop([], -243), - ?line ba_bop([], 243), - ?line ba_bop([], 2438724982478933), - ?line ba_bop([], 3987.37), - - ?line ba_bnot([]), - ?line ba_bnot(23.33), - - ?line ba_shift([], []), - ?line ba_shift([], 0), - ?line ba_shift([], 4), - ?line ba_shift([], -4), - ?line ba_shift([], 2343333333333), - ?line ba_shift([], -333333333), - ?line ba_shift([], 234.00), - ?line ba_shift(23, []), - ?line ba_shift(0, []), - ?line ba_shift(-3433443433433323, []), - ?line ba_shift(433443433433323, []), - ?line ba_shift(343.93, []), + ba_plus_minus_times([], []), + + ba_plus_minus_times([], 0), + ba_plus_minus_times([], 42), + ba_plus_minus_times([], 38724978123478923784), + ba_plus_minus_times([], 38.72), + + ba_plus_minus_times(0, []), + ba_plus_minus_times(334, []), + ba_plus_minus_times(387249797813478923784, []), + ba_plus_minus_times(344.22, []), + + ba_div_rem([], []), + + ba_div_rem([], 0), + ba_div_rem([], 1), + ba_div_rem([], 42), + ba_div_rem([], 38724978123478923784), + ba_div_rem(344.22, []), + + ba_div_rem(0, []), + ba_div_rem(1, []), + ba_div_rem(334, []), + ba_div_rem(387249797813478923784, []), + ba_div_rem(344.22, []), + + ba_div_rem(344.22, 0.0), + ba_div_rem(1, 0.0), + ba_div_rem(392873498733971, 0.0), + + ba_bop([], []), + ba_bop(0, []), + ba_bop(42, []), + ba_bop(-42342742987343, []), + ba_bop(238.342, []), + ba_bop([], 0), + ba_bop([], -243), + ba_bop([], 243), + ba_bop([], 2438724982478933), + ba_bop([], 3987.37), + + ba_bnot([]), + ba_bnot(23.33), + + ba_shift([], []), + ba_shift([], 0), + ba_shift([], 4), + ba_shift([], -4), + ba_shift([], 2343333333333), + ba_shift([], -333333333), + ba_shift([], 234.00), + ba_shift(23, []), + ba_shift(0, []), + ba_shift(-3433443433433323, []), + ba_shift(433443433433323, []), + ba_shift(343.93, []), ok. ba_plus_minus_times(A, B) -> @@ -279,29 +276,29 @@ ba_bnot(A) -> stacktrace(Conf) when is_list(Conf) -> Tag = make_ref(), - ?line {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end), - ?line {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end, + {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end), + {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end, V = [make_ref()|self()], - ?line {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} = + {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} = stacktrace_1({'abs',V}, error, {value,V}), - ?line St1 = erase(stacktrace1), - ?line St1 = erase(stacktrace2), - ?line St1 = erlang:get_stacktrace(), - ?line {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} = + St1 = erase(stacktrace1), + St1 = erase(stacktrace2), + St1 = erlang:get_stacktrace(), + {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} = stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), - ?line [{?MODULE,my_div,2,_}|_] = erase(stacktrace1), - ?line St2 = erase(stacktrace2), - ?line St2 = erlang:get_stacktrace(), - ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} = + [{?MODULE,my_div,2,_}|_] = erase(stacktrace1), + St2 = erase(stacktrace2), + St2 = erlang:get_stacktrace(), + {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} = stacktrace_1({value,V}, error, {value,V}), - ?line St3 = erase(stacktrace1), - ?line St3 = erase(stacktrace2), - ?line St3 = erlang:get_stacktrace(), - ?line {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} = + St3 = erase(stacktrace1), + St3 = erase(stacktrace2), + St3 = erlang:get_stacktrace(), + {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} = stacktrace_1({value,V}, error, {throw,V}), - ?line [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1), - ?line St4 = erase(stacktrace2), - ?line St4 = erlang:get_stacktrace(), + [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1), + St4 = erase(stacktrace2), + St4 = erlang:get_stacktrace(), ok. stacktrace_1(X, C1, Y) -> @@ -326,19 +323,19 @@ stacktrace_1(X, C1, Y) -> nested_stacktrace(Conf) when is_list(Conf) -> V = [{make_ref()}|[self()]], - ?line value1 = + value1 = nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, {void,void,void}), - ?line {caught1, - [{?MODULE,my_add,2,_}|_], - value2, - [{?MODULE,my_add,2,_}|_]} = + {caught1, + [{?MODULE,my_add,2,_}|_], + value2, + [{?MODULE,my_add,2,_}|_]} = nested_stacktrace_1({{'add',{V,x1}},error,badarith}, {{value,{V,x2}},void,{V,x2}}), - ?line {caught1, - [{?MODULE,my_add,2,_}|_], - {caught2,[{erlang,abs,[V],_}|_]}, - [{erlang,abs,[V],_}|_]} = + {caught1, + [{?MODULE,my_add,2,_}|_], + {caught2,[{erlang,abs,[V],_}|_]}, + [{erlang,abs,[V],_}|_]} = nested_stacktrace_1({{'add',{V,x1}},error,badarith}, {{'abs',V},error,badarg}), ok. @@ -361,42 +358,42 @@ nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> raise(Conf) when is_list(Conf) -> - ?line erase(raise), - ?line A = + erase(raise), + A = try - ?line try foo({'div',{1,0}}) - catch - error:badarith -> - put(raise, A0 = erlang:get_stacktrace()), - ?line erlang:raise(error, badarith, A0) - end + try foo({'div',{1,0}}) + catch + error:badarith -> + put(raise, A0 = erlang:get_stacktrace()), + erlang:raise(error, badarith, A0) + end catch error:badarith -> - ?line A1 = erlang:get_stacktrace(), - ?line A1 = get(raise) + A1 = erlang:get_stacktrace(), + A1 = get(raise) end, - ?line A = erlang:get_stacktrace(), - ?line A = get(raise), - ?line [{?MODULE,my_div,2,_}|_] = A, + A = erlang:get_stacktrace(), + A = get(raise), + [{?MODULE,my_div,2,_}|_] = A, %% N = 8, % Must be even - ?line N = erlang:system_flag(backtrace_depth, N), - ?line try even(N) - catch error:function_clause -> ok - end, - ?line B = odd_even(N, []), - ?line B = erlang:get_stacktrace(), + N = erlang:system_flag(backtrace_depth, N), + try even(N) + catch error:function_clause -> ok + end, + B = odd_even(N, []), + B = erlang:get_stacktrace(), %% - ?line C0 = odd_even(N+1, []), - ?line C = lists:sublist(C0, N), - ?line try odd(N+1) - catch error:function_clause -> ok - end, - ?line C = erlang:get_stacktrace(), - ?line try erlang:raise(error, function_clause, C0) - catch error:function_clause -> ok - end, - ?line C = erlang:get_stacktrace(), + C0 = odd_even(N+1, []), + C = lists:sublist(C0, N), + try odd(N+1) + catch error:function_clause -> ok + end, + C = erlang:get_stacktrace(), + try erlang:raise(error, function_clause, C0) + catch error:function_clause -> ok + end, + C = erlang:get_stacktrace(), ok. odd_even(N, R) when is_integer(N), N > 1 -> @@ -438,8 +435,8 @@ my_add(A, B) -> my_abs(X) -> abs(X). gunilla(Config) when is_list(Config) -> - ?line {throw,kalle} = gunilla_1(), - ?line [] = erlang:get_stacktrace(), + {throw,kalle} = gunilla_1(), + [] = erlang:get_stacktrace(), ok. gunilla_1() -> @@ -466,9 +463,9 @@ per(Config) when is_list(Config) -> end. t1(_,X,_) -> - (1 bsl X) + 1. + (1 bsl X) + 1. t2(_,X,_) -> - (X bsl 1) + 1. + (X bsl 1) + 1. id(I) -> I. diff --git a/lib/debugger/test/fun_SUITE.erl b/lib/debugger/test/fun_SUITE.erl index 176f1d4d41..7eb53e4ce4 100644 --- a/lib/debugger/test/fun_SUITE.erl +++ b/lib/debugger/test/fun_SUITE.erl @@ -32,7 +32,9 @@ -include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> cases(). @@ -53,43 +55,38 @@ cases() -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(1)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> ok. good_call(Config) when is_list(Config) -> - ?line F = fun() -> ok end, - ?line ok = F(), - ?line FF = fun ?MODULE:nothing/0, - ?line ok = FF(), + F = fun() -> ok end, + ok = F(), + FF = fun ?MODULE:nothing/0, + ok = FF(), ok. -bad_apply(doc) -> - "Test that the correct EXIT code is returned for all types of bad funs."; -bad_apply(suite) -> []; +%% Test that the correct EXIT code is returned for all types of bad funs. bad_apply(Config) when is_list(Config) -> - ?line bad_apply_fc(42, [0]), - ?line bad_apply_fc(xx, [1]), - ?line bad_apply_fc({}, [2]), - ?line bad_apply_fc({1}, [3]), - ?line bad_apply_fc({1,2,3}, [4]), - ?line bad_apply_fc({1,2,3}, [5]), - ?line bad_apply_fc({1,2,3,4}, [6]), - ?line bad_apply_fc({1,2,3,4,5,6}, [7]), - ?line bad_apply_fc({1,2,3,4,5}, [8]), - ?line bad_apply_badarg({1,2}, [9]), + bad_apply_fc(42, [0]), + bad_apply_fc(xx, [1]), + bad_apply_fc({}, [2]), + bad_apply_fc({1}, [3]), + bad_apply_fc({1,2,3}, [4]), + bad_apply_fc({1,2,3}, [5]), + bad_apply_fc({1,2,3,4}, [6]), + bad_apply_fc({1,2,3,4,5,6}, [7]), + bad_apply_fc({1,2,3,4,5}, [8]), + bad_apply_badarg({1,2}, [9]), ok. bad_apply_fc(Fun, Args) -> @@ -101,7 +98,7 @@ bad_apply_fc(Fun, Args) -> ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]); Other -> ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]), - ?t:fail({bad_result,Other}) + ct:fail({bad_result,Other}) end. bad_apply_badarg(Fun, Args) -> @@ -113,23 +110,21 @@ bad_apply_badarg(Fun, Args) -> ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]); Other -> ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]), - ?t:fail({bad_result, Other}) + ct:fail({bad_result, Other}) end. -bad_fun_call(doc) -> - "Try directly calling bad funs."; -bad_fun_call(suite) -> []; +%% Try directly calling bad funs. bad_fun_call(Config) when is_list(Config) -> - ?line bad_call_fc(42), - ?line bad_call_fc(xx), - ?line bad_call_fc({}), - ?line bad_call_fc({1}), - ?line bad_call_fc({1,2,3}), - ?line bad_call_fc({1,2,3}), - ?line bad_call_fc({1,2,3,4}), - ?line bad_call_fc({1,2,3,4,5,6}), - ?line bad_call_fc({1,2,3,4,5}), - ?line bad_call_fc({1,2}), + bad_call_fc(42), + bad_call_fc(xx), + bad_call_fc({}), + bad_call_fc({1}), + bad_call_fc({1,2,3}), + bad_call_fc({1,2,3}), + bad_call_fc({1,2,3,4}), + bad_call_fc({1,2,3,4,5,6}), + bad_call_fc({1,2,3,4,5}), + bad_call_fc({1,2}), ok. bad_call_fc(Fun) -> @@ -140,104 +135,101 @@ bad_call_fc(Fun) -> ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); Other -> ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), - ?t:fail({bad_result,Other}) + ct:fail({bad_result,Other}) end. %% Call and apply valid external funs with wrong number of arguments. badarity(Config) when is_list(Config) -> - ?line Fun = fun() -> ok end, - ?line Stupid = {stupid,arguments}, - ?line Args = [some,{stupid,arguments},here], + Fun = fun() -> ok end, + Stupid = {stupid,arguments}, + Args = [some,{stupid,arguments},here], %% Simple call. - ?line Res = (catch Fun(some, Stupid, here)), + Res = (catch Fun(some, Stupid, here)), erlang:garbage_collect(), erlang:yield(), case Res of {'EXIT',{{badarity,{Fun,Args}},[_|_]}} -> - ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); _ -> - ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), - ?line ?t:fail({bad_result,Res}) + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), + ct:fail({bad_result,Res}) end, %% Apply. - ?line Res2 = (catch apply(Fun, Args)), + Res2 = (catch apply(Fun, Args)), erlang:garbage_collect(), erlang:yield(), case Res2 of {'EXIT',{{badarity,{Fun,Args}},[_|_]}} -> - ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); _ -> - ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), - ?line ?t:fail({bad_result,Res2}) + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), + ct:fail({bad_result,Res2}) end, ok. %% Call and apply valid external funs with wrong number of arguments. ext_badarity(Config) when is_list(Config) -> - ?line Fun = fun ?MODULE:nothing/0, - ?line Stupid = {stupid,arguments}, - ?line Args = [some,{stupid,arguments},here], + Fun = fun ?MODULE:nothing/0, + Stupid = {stupid,arguments}, + Args = [some,{stupid,arguments},here], %% Simple call. - ?line Res = (catch Fun(some, Stupid, here)), + Res = (catch Fun(some, Stupid, here)), erlang:garbage_collect(), erlang:yield(), case Res of {'EXIT',{{badarity,{Fun,Args}},_}} -> - ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); _ -> - ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), - ?line ?t:fail({bad_result,Res}) + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), + ct:fail({bad_result,Res}) end, %% Apply. - ?line Res2 = (catch apply(Fun, Args)), + Res2 = (catch apply(Fun, Args)), erlang:garbage_collect(), erlang:yield(), case Res2 of {'EXIT',{{badarity,{Fun,Args}},_}} -> - ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); _ -> - ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), - ?line ?t:fail({bad_result,Res2}) + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), + ct:fail({bad_result,Res2}) end, ok. nothing() -> ok. -otp_6061(suite) -> - []; -otp_6061(doc) -> - ["Test handling of fun expression referring to uninterpreted code"]; +%% Test handling of fun expression referring to uninterpreted code. otp_6061(Config) when is_list(Config) -> - ?line OrigFlag = process_flag(trap_exit, true), + OrigFlag = process_flag(trap_exit, true), - ?line Self = self(), - ?line Pid = spawn_link(fun() -> test_otp_6061(Self) end), + Self = self(), + Pid = spawn_link(fun() -> test_otp_6061(Self) end), receive working -> - ?line ok; + ok; not_working -> - ?line ?t:fail(not_working); + ct:fail(not_working); {'EXIT', Pid, Reason} -> - ?line ?t:fail({crash, Reason}) + ct:fail({crash, Reason}) after 5000 -> - ?line ?t:fail(timeout) + ct:fail(timeout) end, - ?line process_flag(trap_exit, OrigFlag), + process_flag(trap_exit, OrigFlag), ok. diff --git a/lib/debugger/test/guard_SUITE.erl b/lib/debugger/test/guard_SUITE.erl index 5c184c46d5..f7874f79df 100644 --- a/lib/debugger/test/guard_SUITE.erl +++ b/lib/debugger/test/guard_SUITE.erl @@ -44,7 +44,9 @@ -export([init/4]). -import(lists, [member/2]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> cases(). @@ -72,29 +74,25 @@ cases() -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - ?line Dog = test_server:timetrap(?t:minutes(1)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> ok. -bad_arith(doc) -> "Test that a bad arithmetic operation in a guard works correctly."; -bad_arith(suite) -> []; +%% Test that a bad arithmetic operation in a guard works correctly. bad_arith(Config) when list(Config) -> - ?line 5 = bad_arith1(2, 3), - ?line 10 = bad_arith1(1, infinity), - ?line 10 = bad_arith1(infinity, 1), - ?line 42 = bad_div(24, 0), + 5 = bad_arith1(2, 3), + 10 = bad_arith1(1, infinity), + 10 = bad_arith1(infinity, 1), + 42 = bad_div(24, 0), ok. bad_arith1(T1, T2) when T1+T2 < 10 -> @@ -109,37 +107,35 @@ bad_div(A, B) when A div B > 0 -> bad_div(_A, _B) -> 42. -bad_tuple(doc) -> "Test that bad arguments to element/2 are handled correctly."; -bad_tuple(suite) -> []; +%% Test that bad arguments to element/2 are handled correctly. bad_tuple(Config) when list(Config) -> - ?line error = bad_tuple1(a), - ?line error = bad_tuple1({a, b}), - ?line x = bad_tuple1({x, b}), - ?line y = bad_tuple1({a, b, y}), + error = bad_tuple1(a), + error = bad_tuple1({a, b}), + x = bad_tuple1({x, b}), + y = bad_tuple1({a, b, y}), ok. bad_tuple1(T) when element(1, T) == x -> x; bad_tuple1(T) when element(3, T) == y -> y; bad_tuple1(_) -> error. -test_heap_guards(doc) -> ""; -test_heap_guards(suite) -> []; +%% . test_heap_guards(Config) when list(Config) -> - ?line process_flag(trap_exit, true), - ?line Tuple = {a, tuple, is, built, here, xxx}, - ?line List = [a, list, is, built, here], + process_flag(trap_exit, true), + Tuple = {a, tuple, is, built, here, xxx}, + List = [a, list, is, built, here], - ?line try_fun(fun a_case/1, [Tuple], [Tuple]), - ?line try_fun(fun a_case/1, [List], [List, List]), - ?line try_fun(fun a_case/1, [a], [a]), + try_fun(fun a_case/1, [Tuple], [Tuple]), + try_fun(fun a_case/1, [List], [List, List]), + try_fun(fun a_case/1, [a], [a]), - ?line try_fun(fun an_if/1, [Tuple], [Tuple]), - ?line try_fun(fun an_if/1, [List], [List, List]), - ?line try_fun(fun an_if/1, [a], [a]), + try_fun(fun an_if/1, [Tuple], [Tuple]), + try_fun(fun an_if/1, [List], [List, List]), + try_fun(fun an_if/1, [a], [a]), - ?line try_fun(fun receive_test/1, [Tuple], [Tuple]), - ?line try_fun(fun receive_test/1, [List], [List, List]), - ?line try_fun(fun receive_test/1, [a], [a]), + try_fun(fun receive_test/1, [Tuple], [Tuple]), + try_fun(fun receive_test/1, [List], [List, List]), + try_fun(fun receive_test/1, [a], [a]), ok. a_case(V) -> @@ -185,12 +181,12 @@ try_fun(Iter, Fun, Args, Result, Filler) -> Pid = spawn_link(?MODULE, init, [self(),Fun,Args,list_to_tuple(Filler)]), receive {'EXIT',Pid,{result,Result}} -> - ?line try_fun(Iter-1, Fun, Args, Result, [0|Filler]); + try_fun(Iter-1, Fun, Args, Result, [0|Filler]); {'EXIT',Pid,{result,Other}} -> - ?line io:format("Expected ~p; got ~p~n", [Result,Other]), - ?line test_server:fail(); + io:format("Expected ~p; got ~p~n", [Result,Other]), + ct:fail(failed); Other -> - ?line test_server:fail({unexpected_message,Other}) + ct:fail({unexpected_message,Other}) end. init(_ReplyTo, Fun, Args, Filler) -> @@ -202,87 +198,86 @@ init(_ReplyTo, Fun, Args, Filler) -> dummy(_) -> ok. -guard_bifs(doc) -> "Test all guard bifs with nasty (but legal arguments)."; -guard_bifs(suite) -> []; +%% Test all guard bifs with nasty (but legal arguments). guard_bifs(Config) when list(Config) -> - ?line Big = -237849247829874297658726487367328971246284736473821617265433, - ?line Float = 387924.874, + Big = -237849247829874297658726487367328971246284736473821617265433, + Float = 387924.874, %% Succeding use of guard bifs. - ?line try_gbif('abs/1', Big, -Big), - ?line try_gbif('float/1', Big, float(Big)), - ?line try_gbif('trunc/1', Float, 387924.0), - ?line try_gbif('round/1', Float, 387925.0), - ?line try_gbif('length/1', [], 0), + try_gbif('abs/1', Big, -Big), + try_gbif('float/1', Big, float(Big)), + try_gbif('trunc/1', Float, 387924.0), + try_gbif('round/1', Float, 387925.0), + try_gbif('length/1', [], 0), - ?line try_gbif('length/1', [a], 1), - ?line try_gbif('length/1', [a, b], 2), - ?line try_gbif('length/1', lists:seq(0, 31), 32), + try_gbif('length/1', [a], 1), + try_gbif('length/1', [a, b], 2), + try_gbif('length/1', lists:seq(0, 31), 32), - ?line try_gbif('hd/1', [a], a), - ?line try_gbif('hd/1', [a, b], a), + try_gbif('hd/1', [a], a), + try_gbif('hd/1', [a, b], a), - ?line try_gbif('tl/1', [a], []), - ?line try_gbif('tl/1', [a, b], [b]), - ?line try_gbif('tl/1', [a, b, c], [b, c]), + try_gbif('tl/1', [a], []), + try_gbif('tl/1', [a, b], [b]), + try_gbif('tl/1', [a, b, c], [b, c]), - ?line try_gbif('size/1', {}, 0), - ?line try_gbif('size/1', {a}, 1), - ?line try_gbif('size/1', {a, b}, 2), - ?line try_gbif('size/1', {a, b, c}, 3), - ?line try_gbif('size/1', list_to_binary([]), 0), - ?line try_gbif('size/1', list_to_binary([1]), 1), - ?line try_gbif('size/1', list_to_binary([1, 2]), 2), - ?line try_gbif('size/1', list_to_binary([1, 2, 3]), 3), + try_gbif('size/1', {}, 0), + try_gbif('size/1', {a}, 1), + try_gbif('size/1', {a, b}, 2), + try_gbif('size/1', {a, b, c}, 3), + try_gbif('size/1', list_to_binary([]), 0), + try_gbif('size/1', list_to_binary([1]), 1), + try_gbif('size/1', list_to_binary([1, 2]), 2), + try_gbif('size/1', list_to_binary([1, 2, 3]), 3), - ?line try_gbif('element/2', {x}, {1, x}), - ?line try_gbif('element/2', {x, y}, {1, x}), - ?line try_gbif('element/2', {x, y}, {2, y}), + try_gbif('element/2', {x}, {1, x}), + try_gbif('element/2', {x, y}, {1, x}), + try_gbif('element/2', {x, y}, {2, y}), - ?line try_gbif('self/0', 0, self()), - ?line try_gbif('node/0', 0, node()), - ?line try_gbif('node/1', self(), node()), + try_gbif('self/0', 0, self()), + try_gbif('node/0', 0, node()), + try_gbif('node/1', self(), node()), %% Failing use of guard bifs. - ?line try_fail_gbif('abs/1', Big, 1), - ?line try_fail_gbif('abs/1', [], 1), + try_fail_gbif('abs/1', Big, 1), + try_fail_gbif('abs/1', [], 1), - ?line try_fail_gbif('float/1', Big, 42), - ?line try_fail_gbif('float/1', [], 42), + try_fail_gbif('float/1', Big, 42), + try_fail_gbif('float/1', [], 42), - ?line try_fail_gbif('trunc/1', Float, 0.0), - ?line try_fail_gbif('trunc/1', [], 0.0), + try_fail_gbif('trunc/1', Float, 0.0), + try_fail_gbif('trunc/1', [], 0.0), - ?line try_fail_gbif('round/1', Float, 1.0), - ?line try_fail_gbif('round/1', [], a), + try_fail_gbif('round/1', Float, 1.0), + try_fail_gbif('round/1', [], a), - ?line try_fail_gbif('length/1', [], 1), - ?line try_fail_gbif('length/1', [a], 0), - ?line try_fail_gbif('length/1', a, 0), - ?line try_fail_gbif('length/1', {a}, 0), + try_fail_gbif('length/1', [], 1), + try_fail_gbif('length/1', [a], 0), + try_fail_gbif('length/1', a, 0), + try_fail_gbif('length/1', {a}, 0), - ?line try_fail_gbif('hd/1', [], 0), - ?line try_fail_gbif('hd/1', [a], x), - ?line try_fail_gbif('hd/1', x, x), + try_fail_gbif('hd/1', [], 0), + try_fail_gbif('hd/1', [a], x), + try_fail_gbif('hd/1', x, x), - ?line try_fail_gbif('tl/1', [], 0), - ?line try_fail_gbif('tl/1', [a], x), - ?line try_fail_gbif('tl/1', x, x), + try_fail_gbif('tl/1', [], 0), + try_fail_gbif('tl/1', [a], x), + try_fail_gbif('tl/1', x, x), - ?line try_fail_gbif('size/1', {}, 1), - ?line try_fail_gbif('size/1', [], 0), - ?line try_fail_gbif('size/1', [a], 1), + try_fail_gbif('size/1', {}, 1), + try_fail_gbif('size/1', [], 0), + try_fail_gbif('size/1', [a], 1), - ?line try_fail_gbif('element/2', {}, {1, x}), - ?line try_fail_gbif('element/2', {x}, {1, y}), - ?line try_fail_gbif('element/2', [], {1, z}), + try_fail_gbif('element/2', {}, {1, x}), + try_fail_gbif('element/2', {x}, {1, y}), + try_fail_gbif('element/2', [], {1, z}), - ?line try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")), - ?line try_fail_gbif('node/0', 0, xxxx), - ?line try_fail_gbif('node/1', self(), xxx), - ?line try_fail_gbif('node/1', yyy, xxx), + try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")), + try_fail_gbif('node/0', 0, xxxx), + try_fail_gbif('node/1', self(), xxx), + try_fail_gbif('node/1', yyy, xxx), ok. try_gbif(Id, X, Y) -> @@ -290,9 +285,9 @@ try_gbif(Id, X, Y) -> {Id, X, Y} -> io:format("guard_bif(~p, ~p, ~p) -- ok", [Id, X, Y]); Other -> - ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", - [Id, X, Y, Other]), - ?line test_server:fail() + ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + ct:fail(failed) end. try_fail_gbif(Id, X, Y) -> @@ -300,9 +295,9 @@ try_fail_gbif(Id, X, Y) -> {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y],_}|_]}} -> io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]); Other -> - ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", - [Id, X, Y, Other]), - ?line test_server:fail() + ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + ct:fail(failed) end. guard_bif('abs/1', X, Y) when abs(X) == Y -> @@ -330,24 +325,23 @@ guard_bif('node/0', X, Y) when node() == Y -> guard_bif('node/1', X, Y) when node(X) == Y -> {'node/1', X, Y}. -type_tests(doc) -> "Test the type tests."; -type_tests(suite) -> []; +%% Test the type tests. type_tests(Config) when list(Config) -> - ?line Types = all_types(), - ?line Tests = type_test_desc(), - ?line put(errors, 0), - ?line put(violations, 0), - ?line type_tests(Tests, Types), - ?line case {get(errors), get(violations)} of - {0, 0} -> - ok; - {0, N} -> - {comment, integer_to_list(N) ++ " standard violation(s)"}; - {Errors, Violations} -> - io:format("~p sub test(s) failed, ~p violation(s)", - [Errors, Violations]), - ?line test_server:fail() - end. + Types = all_types(), + Tests = type_test_desc(), + put(errors, 0), + put(violations, 0), + type_tests(Tests, Types), + case {get(errors), get(violations)} of + {0, 0} -> + ok; + {0, N} -> + {comment, integer_to_list(N) ++ " standard violation(s)"}; + {Errors, Violations} -> + io:format("~p sub test(s) failed, ~p violation(s)", + [Errors, Violations]), + ct:fail(failed) + end. type_tests([{Test, AllowedTypes}| T], AllTypes) -> type_tests(Test, AllTypes, AllowedTypes), @@ -372,7 +366,7 @@ type_tests(Test, [Type|T], Allowed) -> [{?MODULE,type_test,[Test,Value],_}|_]}} -> ok; {'EXIT',Other} -> - ?line test_server:fail({unexpected_error_reason,Other}); + ct:fail({unexpected_error_reason,Other}); tuple when function(Value) -> io:format("Standard violation: Test ~p(~p) should fail", [Test, Value]), @@ -442,18 +436,18 @@ type_test(function, X) when function(X) -> function. const_guard(Config) when is_list(Config) -> - ?line if - (0 == 0) and ((0 == 0) or (0 == 0)) -> - ok - end. + if + (0 == 0) and ((0 == 0) or (0 == 0)) -> + ok + end. const_cond(Config) when is_list(Config) -> - ?line ok = const_cond({}, 0), - ?line ok = const_cond({a}, 1), - ?line error = const_cond({a,b}, 3), - ?line error = const_cond({a}, 0), - ?line error = const_cond({a,b}, 1), + ok = const_cond({}, 0), + ok = const_cond({a}, 1), + error = const_cond({a,b}, 3), + error = const_cond({a}, 0), + error = const_cond({a,b}, 1), ok. const_cond(T, Sz) -> @@ -474,59 +468,59 @@ basic_not(Config) when is_list(Config) -> D = id(5), ATuple = {False,True,Glurf}, - ?line check(fun() -> if not false -> ok; true -> error end end, ok), - ?line check(fun() -> if not true -> ok; true -> error end end, error), - ?line check(fun() -> if not False -> ok; true -> error end end, ok), - ?line check(fun() -> if not True -> ok; true -> error end end, error), + check(fun() -> if not false -> ok; true -> error end end, ok), + check(fun() -> if not true -> ok; true -> error end end, error), + check(fun() -> if not False -> ok; true -> error end end, ok), + check(fun() -> if not True -> ok; true -> error end end, error), - ?line check(fun() -> if A > B -> gt; A < B -> lt; A == B -> eq end end, lt), - ?line check(fun() -> if A > C -> gt; A < C -> lt; A == C -> eq end end, gt), - ?line check(fun() -> if A > D -> gt; A < D -> lt; A == D -> eq end end, eq), + check(fun() -> if A > B -> gt; A < B -> lt; A == B -> eq end end, lt), + check(fun() -> if A > C -> gt; A < C -> lt; A == C -> eq end end, gt), + check(fun() -> if A > D -> gt; A < D -> lt; A == D -> eq end end, eq), - ?line check(fun() -> if not (7 > 453) -> le; not (7 < 453) -> ge; - not (7 == 453) -> ne; true -> eq end end, le), - ?line check(fun() -> if not (7 > -8) -> le; not (7 < -8) -> ge; - not (7 == -8) -> ne; true -> eq end end, ge), - ?line check(fun() -> if not (7 > 7) -> le; not (7 < 7) -> ge; - not (7 == 7) -> ne; true -> eq end end, le), + check(fun() -> if not (7 > 453) -> le; not (7 < 453) -> ge; + not (7 == 453) -> ne; true -> eq end end, le), + check(fun() -> if not (7 > -8) -> le; not (7 < -8) -> ge; + not (7 == -8) -> ne; true -> eq end end, ge), + check(fun() -> if not (7 > 7) -> le; not (7 < 7) -> ge; + not (7 == 7) -> ne; true -> eq end end, le), - ?line check(fun() -> if not (A > B) -> le; not (A < B) -> ge; - not (A == B) -> ne; true -> eq end end, le), - ?line check(fun() -> if not (A > C) -> le; not (A < C) -> ge; - not (A == C) -> ne; true -> eq end end, ge), - ?line check(fun() -> if not (A > D) -> le; not (A < D) -> ge; - not (A == D) -> ne; true -> eq end end, le), + check(fun() -> if not (A > B) -> le; not (A < B) -> ge; + not (A == B) -> ne; true -> eq end end, le), + check(fun() -> if not (A > C) -> le; not (A < C) -> ge; + not (A == C) -> ne; true -> eq end end, ge), + check(fun() -> if not (A > D) -> le; not (A < D) -> ge; + not (A == D) -> ne; true -> eq end end, le), - ?line check(fun() -> if not element(1, ATuple) -> ok; true -> error end end, ok), - ?line check(fun() -> if not element(2, ATuple) -> ok; true -> error end end, error), - ?line check(fun() -> if not element(3, ATuple) -> ok; true -> error end end, error), + check(fun() -> if not element(1, ATuple) -> ok; true -> error end end, ok), + check(fun() -> if not element(2, ATuple) -> ok; true -> error end end, error), + check(fun() -> if not element(3, ATuple) -> ok; true -> error end end, error), - ?line check(fun() -> if not glurf -> ok; true -> error end end, error), - ?line check(fun() -> if not Glurf -> ok; true -> error end end, error), + check(fun() -> if not glurf -> ok; true -> error end end, error), + check(fun() -> if not Glurf -> ok; true -> error end end, error), ok. complex_not(Config) when is_list(Config) -> ATuple = id({false,true,gurka}), - ?line check(fun() -> if not(element(1, ATuple)) -> ok; true -> error end end, ok), - ?line check(fun() -> if not(element(2, ATuple)) -> ok; true -> error end end, error), + check(fun() -> if not(element(1, ATuple)) -> ok; true -> error end end, ok), + check(fun() -> if not(element(2, ATuple)) -> ok; true -> error end end, error), - ?line check(fun() -> if not(element(3, ATuple) == gurka) -> ok; - true -> error end end, error), - ?line check(fun() -> if not(element(3, ATuple) =/= gurka) -> ok; - true -> error end end, ok), + check(fun() -> if not(element(3, ATuple) == gurka) -> ok; + true -> error end end, error), + check(fun() -> if not(element(3, ATuple) =/= gurka) -> ok; + true -> error end end, ok), - ?line check(fun() -> if {a,not(element(2, ATuple))} == {a,false} -> ok; - true -> error end end, ok), - ?line check(fun() -> if {a,not(element(1, ATuple))} == {a,false} -> ok; - true -> error end end, error), + check(fun() -> if {a,not(element(2, ATuple))} == {a,false} -> ok; + true -> error end end, ok), + check(fun() -> if {a,not(element(1, ATuple))} == {a,false} -> ok; + true -> error end end, error), - ?line check(fun() -> if not(element(1, ATuple) or element(3, ATuple)) -> ok; - true -> error end end, error), + check(fun() -> if not(element(1, ATuple) or element(3, ATuple)) -> ok; + true -> error end end, error), %% orelse - ?line check(fun() -> if not(element(1, ATuple) orelse element(3, ATuple)) -> ok; - true -> error end end, error), + check(fun() -> if not(element(1, ATuple) orelse element(3, ATuple)) -> ok; + true -> error end end, error), ok. @@ -534,100 +528,100 @@ semicolon(Config) when is_list(Config) -> %% True/false combined using ';' (literal atoms). - ?line check(fun() -> if true; false -> ok end end, ok), - ?line check(fun() -> if false; true -> ok end end, ok), - ?line check(fun() -> if true; true -> ok end end, ok), - ?line check(fun() -> if false; false -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = (catch if false; false -> ok end), - exit - end, exit), + check(fun() -> if true; false -> ok end end, ok), + check(fun() -> if false; true -> ok end end, ok), + check(fun() -> if true; true -> ok end end, ok), + check(fun() -> if false; false -> ok; true -> error end end, error), + check(fun() -> + {'EXIT',{if_clause,_}} = (catch if false; false -> ok end), + exit + end, exit), %% True/false combined used ';'. True = id(true), False = id(false), - ?line check(fun() -> if True; False -> ok end end, ok), - ?line check(fun() -> if False; True -> ok end end, ok), - ?line check(fun() -> if True; True -> ok end end, ok), - ?line check(fun() -> if False; False -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = (catch if False; False -> ok end), - exit - end, exit), + check(fun() -> if True; False -> ok end end, ok), + check(fun() -> if False; True -> ok end end, ok), + check(fun() -> if True; True -> ok end end, ok), + check(fun() -> if False; False -> ok; true -> error end end, error), + check(fun() -> + {'EXIT',{if_clause,_}} = (catch if False; False -> ok end), + exit + end, exit), %% Combine true/false with a non-boolean value. Glurf = id(glurf), - ?line check(fun() -> if True; Glurf -> ok end end, ok), - ?line check(fun() -> if Glurf; True -> ok end end, ok), - ?line check(fun() -> if Glurf; Glurf -> ok; true -> error end end, error), - ?line check(fun() -> if False; Glurf -> ok; true -> error end end, error), - ?line check(fun() -> if Glurf; False -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = (catch if Glurf; Glurf -> ok end), - exit - end, exit), + check(fun() -> if True; Glurf -> ok end end, ok), + check(fun() -> if Glurf; True -> ok end end, ok), + check(fun() -> if Glurf; Glurf -> ok; true -> error end end, error), + check(fun() -> if False; Glurf -> ok; true -> error end end, error), + check(fun() -> if Glurf; False -> ok; true -> error end end, error), + check(fun() -> + {'EXIT',{if_clause,_}} = (catch if Glurf; Glurf -> ok end), + exit + end, exit), %% Combine true/false with errors. ATuple = id({false,true,gurka}), - ?line check(fun() -> if True; element(42, ATuple) -> ok end end, ok), - ?line check(fun() -> if element(42, ATuple); True -> ok end end, ok), - ?line check(fun() -> if element(42, ATuple); element(42, ATuple) -> ok; - true -> error end end, error), - ?line check(fun() -> if False; element(42, ATuple) -> ok; - true -> error end end, error), - ?line check(fun() -> if element(42, ATuple); - False -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = - (catch if element(42, ATuple); - element(42, ATuple) -> ok end), - exit - end, exit), + check(fun() -> if True; element(42, ATuple) -> ok end end, ok), + check(fun() -> if element(42, ATuple); True -> ok end end, ok), + check(fun() -> if element(42, ATuple); element(42, ATuple) -> ok; + true -> error end end, error), + check(fun() -> if False; element(42, ATuple) -> ok; + true -> error end end, error), + check(fun() -> if element(42, ATuple); + False -> ok; true -> error end end, error), + check(fun() -> + {'EXIT',{if_clause,_}} = + (catch if element(42, ATuple); + element(42, ATuple) -> ok end), + exit + end, exit), ok. complex_semicolon(Config) when is_list(Config) -> - ?line ok = csemi1(int, {blurf}), - ?line ok = csemi1(string, {blurf}), - ?line ok = csemi1(float, [a]), - ?line error = csemi1(35, 42), + ok = csemi1(int, {blurf}), + ok = csemi1(string, {blurf}), + ok = csemi1(float, [a]), + error = csemi1(35, 42), %% 2 - ?line ok = csemi2({}, {a,b,c}), - ?line ok = csemi2({1,3.5}, {a,b,c}), - ?line ok = csemi2(dum, {a,b,c}), + ok = csemi2({}, {a,b,c}), + ok = csemi2({1,3.5}, {a,b,c}), + ok = csemi2(dum, {a,b,c}), - ?line ok = csemi2({45,-19.3}, {}), - ?line ok = csemi2({45,-19.3}, {dum}), - ?line ok = csemi2({45,-19.3}, {dum,dum}), + ok = csemi2({45,-19.3}, {}), + ok = csemi2({45,-19.3}, {dum}), + ok = csemi2({45,-19.3}, {dum,dum}), - ?line error = csemi2({45}, {dum}), - ?line error = csemi2([], {dum}), - ?line error = csemi2({dum}, []), - ?line error = csemi2([], []), + error = csemi2({45}, {dum}), + error = csemi2([], {dum}), + error = csemi2({dum}, []), + error = csemi2([], []), %% 3 - ?line csemi3(fun csemi3a/4), - ?line csemi3(fun csemi3b/4), - ?line csemi3(fun csemi3c/4), + csemi3(fun csemi3a/4), + csemi3(fun csemi3b/4), + csemi3(fun csemi3c/4), %% 4 - ?line csemi4(fun csemi4a/4), - ?line csemi4(fun csemi4b/4), - ?line csemi4(fun csemi4c/4), - ?line csemi4(fun csemi4d/4), + csemi4(fun csemi4a/4), + csemi4(fun csemi4b/4), + csemi4(fun csemi4c/4), + csemi4(fun csemi4d/4), %% 4, 'orelse' instead of 'or' - ?line csemi4_orelse(fun csemi4_orelse_a/4), - ?line csemi4_orelse(fun csemi4_orelse_b/4), - ?line csemi4_orelse(fun csemi4_orelse_c/4), - ?line csemi4_orelse(fun csemi4_orelse_d/4), + csemi4_orelse(fun csemi4_orelse_a/4), + csemi4_orelse(fun csemi4_orelse_b/4), + csemi4_orelse(fun csemi4_orelse_c/4), + csemi4_orelse(fun csemi4_orelse_d/4), ok. @@ -713,24 +707,24 @@ csemi4_orelse(Test) -> ok = Test({}, 2, blurf, 0), ok = Test({}, 2, {1}, 2), - ?line error = Test([], 1, {}, 0), + error = Test([], 1, {}, 0), ok. csemi4_orelse_a(A, X, B, Y) when (size(A) > 1) orelse (X > 1); - (size(B) > 1) orelse (Y > 1) -> ok; + (size(B) > 1) orelse (Y > 1) -> ok; csemi4_orelse_a(_, _, _, _) -> error. csemi4_orelse_b(A, X, B, Y) when (X > 1) orelse (size(A) > 1); - (size(B) > 1) orelse (Y > 1) -> ok; + (size(B) > 1) orelse (Y > 1) -> ok; csemi4_orelse_b(_, _, _, _) -> error. csemi4_orelse_c(A, X, B, Y) when (size(A) > 1) orelse (X > 1); - (Y > 1) orelse (size(B) > 1) -> ok; + (Y > 1) orelse (size(B) > 1) -> ok; csemi4_orelse_c(_, _, _, _) -> error. csemi4_orelse_d(A, X, B, Y) when (X > 1) or (size(A) > 1); - (Y > 1) or (size(B) > 1) -> ok; + (Y > 1) or (size(B) > 1) -> ok; csemi4_orelse_d(_, _, _, _) -> error. @@ -738,72 +732,72 @@ comma(Config) when is_list(Config) -> %% ',' combinations of literal true/false. - ?line check(fun() -> if true, false -> ok; true -> error end end, error), - ?line check(fun() -> if false, true -> ok; true -> error end end, error), - ?line check(fun() -> if true, true -> ok end end, ok), - ?line check(fun() -> if false, false -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = - (catch if true, false -> ok; - false, true -> ok; - false, false -> ok - end), - exit - end, exit), + check(fun() -> if true, false -> ok; true -> error end end, error), + check(fun() -> if false, true -> ok; true -> error end end, error), + check(fun() -> if true, true -> ok end end, ok), + check(fun() -> if false, false -> ok; true -> error end end, error), + check(fun() -> + {'EXIT',{if_clause,_}} = + (catch if true, false -> ok; + false, true -> ok; + false, false -> ok + end), + exit + end, exit), %% ',' combinations of true/false in variables. True = id(true), False = id(false), - ?line check(fun() -> if True, False -> ok; true -> error end end, error), - ?line check(fun() -> if False, True -> ok; true -> error end end, error), - ?line check(fun() -> if True, True -> ok end end, ok), - ?line check(fun() -> if False, False -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = - (catch if True, False -> ok; - False, True -> ok; - False, False -> ok - end), - exit - end, exit), + check(fun() -> if True, False -> ok; true -> error end end, error), + check(fun() -> if False, True -> ok; true -> error end end, error), + check(fun() -> if True, True -> ok end end, ok), + check(fun() -> if False, False -> ok; true -> error end end, error), + check(fun() -> + {'EXIT',{if_clause,_}} = + (catch if True, False -> ok; + False, True -> ok; + False, False -> ok + end), + exit + end, exit), %% ',' combinations of true/false, and non-boolean in variables. Glurf = id(glurf), - ?line check(fun() -> if True, Glurf -> ok; true -> error end end, error), - ?line check(fun() -> if Glurf, True -> ok; true -> error end end, error), - ?line check(fun() -> if True, True -> ok end end, ok), - ?line check(fun() -> if Glurf, Glurf -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = - (catch if True, Glurf -> ok; - Glurf, True -> ok; - Glurf, Glurf -> ok - end), - exit - end, exit), + check(fun() -> if True, Glurf -> ok; true -> error end end, error), + check(fun() -> if Glurf, True -> ok; true -> error end end, error), + check(fun() -> if True, True -> ok end end, ok), + check(fun() -> if Glurf, Glurf -> ok; true -> error end end, error), + check(fun() -> + {'EXIT',{if_clause,_}} = + (catch if True, Glurf -> ok; + Glurf, True -> ok; + Glurf, Glurf -> ok + end), + exit + end, exit), %% ',' combinations of true/false with errors. ATuple = id({a,b,c}), - ?line check(fun() -> if True, element(42, ATuple) -> ok; - true -> error end end, error), - ?line check(fun() -> if element(42, ATuple), True -> ok; - true -> error end end, error), - ?line check(fun() -> if True, True -> ok end end, ok), - ?line check(fun() -> if element(42, ATuple), element(42, ATuple) -> ok; - true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = - (catch if True, element(42, ATuple) -> ok; - element(42, ATuple), True -> ok; - element(42, ATuple), element(42, ATuple) -> ok - end), - exit - end, exit), + check(fun() -> if True, element(42, ATuple) -> ok; + true -> error end end, error), + check(fun() -> if element(42, ATuple), True -> ok; + true -> error end end, error), + check(fun() -> if True, True -> ok end end, ok), + check(fun() -> if element(42, ATuple), element(42, ATuple) -> ok; + true -> error end end, error), + check(fun() -> + {'EXIT',{if_clause,_}} = + (catch if True, element(42, ATuple) -> ok; + element(42, ATuple), True -> ok; + element(42, ATuple), element(42, ATuple) -> ok + end), + exit + end, exit), ok. @@ -813,35 +807,35 @@ or_guard(Config) when is_list(Config) -> Glurf = id(glurf), %% 'or' combinations of literal true/false. - ?line check(fun() -> if true or false -> ok end end, ok), - ?line check(fun() -> if false or true -> ok end end, ok), - ?line check(fun() -> if true or true -> ok end end, ok), - ?line check(fun() -> if false or false -> ok; true -> error end end, error), + check(fun() -> if true or false -> ok end end, ok), + check(fun() -> if false or true -> ok end end, ok), + check(fun() -> if true or true -> ok end end, ok), + check(fun() -> if false or false -> ok; true -> error end end, error), - ?line check(fun() -> if glurf or true -> ok; true -> error end end, error), - ?line check(fun() -> if true or glurf -> ok; true -> error end end, error), - ?line check(fun() -> if glurf or glurf -> ok; true -> error end end, error), + check(fun() -> if glurf or true -> ok; true -> error end end, error), + check(fun() -> if true or glurf -> ok; true -> error end end, error), + check(fun() -> if glurf or glurf -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = (catch if false or false -> ok end), - exit - end, exit), + check(fun() -> + {'EXIT',{if_clause,_}} = (catch if false or false -> ok end), + exit + end, exit), %% 'or' combinations using variables containing true/false. - ?line check(fun() -> if True or False -> ok end end, ok), - ?line check(fun() -> if False or True -> ok end end, ok), - ?line check(fun() -> if True or True -> ok end end, ok), - ?line check(fun() -> if False or False -> ok; true -> error end end, error), + check(fun() -> if True or False -> ok end end, ok), + check(fun() -> if False or True -> ok end end, ok), + check(fun() -> if True or True -> ok end end, ok), + check(fun() -> if False or False -> ok; true -> error end end, error), - ?line check(fun() -> if True or Glurf -> ok; true -> error end end, error), - ?line check(fun() -> if Glurf or True -> ok; true -> error end end, error), - ?line check(fun() -> if Glurf or Glurf -> ok; true -> error end end, error), + check(fun() -> if True or Glurf -> ok; true -> error end end, error), + check(fun() -> if Glurf or True -> ok; true -> error end end, error), + check(fun() -> if Glurf or Glurf -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = (catch if False or False -> ok end), - exit - end, exit), + check(fun() -> + {'EXIT',{if_clause,_}} = (catch if False or False -> ok end), + exit + end, exit), ok. @@ -850,142 +844,142 @@ more_or_guards(Config) when is_list(Config) -> False = id(false), ATuple = id({false,true,gurka}), - ?line check(fun() -> - if element(42, ATuple) or False -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if False or element(42, ATuple) -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if element(18, ATuple) or element(42, ATuple) -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if True or element(42, ATuple) -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if element(42, ATuple) or True -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if element(1, ATuple) or element(42, ATuple) or True -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if element(1, ATuple) or True or element(42, ATuple) -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if - (<<False:8>> == <<0>>) or element(2, ATuple) -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if - element(2, ATuple) or (<<True:8>> == <<1>>) -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if element(2, ATuple) or element(42, ATuple) -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if - element(1, ATuple) or - element(2, ATuple) or - element(19, ATuple) -> ok; - true -> error end - end, error), + check(fun() -> + if element(42, ATuple) or False -> ok; + true -> error end + end, error), + + check(fun() -> + if False or element(42, ATuple) -> ok; + true -> error end + end, error), + + check(fun() -> + if element(18, ATuple) or element(42, ATuple) -> ok; + true -> error end + end, error), + + check(fun() -> + if True or element(42, ATuple) -> ok; + true -> error end + end, error), + + check(fun() -> + if element(42, ATuple) or True -> ok; + true -> error end + end, error), + + check(fun() -> + if element(1, ATuple) or element(42, ATuple) or True -> ok; + true -> error end + end, error), + + check(fun() -> + if element(1, ATuple) or True or element(42, ATuple) -> ok; + true -> error end + end, error), + + check(fun() -> + if + (<<False:8>> == <<0>>) or element(2, ATuple) -> ok; + true -> error end + end, error), + + check(fun() -> + if + element(2, ATuple) or (<<True:8>> == <<1>>) -> ok; + true -> error end + end, error), + + check(fun() -> + if element(2, ATuple) or element(42, ATuple) -> ok; + true -> error end + end, error), + + check(fun() -> + if + element(1, ATuple) or + element(2, ATuple) or + element(19, ATuple) -> ok; + true -> error end + end, error), ok. complex_or_guards(Config) when is_list(Config) -> %% complex_or_1/2 - ?line ok = complex_or_1({a,b,c,d}, {1,2,3}), - ?line ok = complex_or_1({a,b,c,d}, {1}), - ?line ok = complex_or_1({a}, {1,2,3}), - ?line error = complex_or_1({a}, {1}), + ok = complex_or_1({a,b,c,d}, {1,2,3}), + ok = complex_or_1({a,b,c,d}, {1}), + ok = complex_or_1({a}, {1,2,3}), + error = complex_or_1({a}, {1}), - ?line error = complex_or_1(1, 2), - ?line error = complex_or_1([], {a,b,c,d}), - ?line error = complex_or_1({a,b,c,d}, []), + error = complex_or_1(1, 2), + error = complex_or_1([], {a,b,c,d}), + error = complex_or_1({a,b,c,d}, []), %% complex_or_2/1 - ?line ok = complex_or_2({true,{}}), - ?line ok = complex_or_2({false,{a}}), - ?line ok = complex_or_2({false,{a,b,c}}), - ?line ok = complex_or_2({true,{a,b,c,d}}), + ok = complex_or_2({true,{}}), + ok = complex_or_2({false,{a}}), + ok = complex_or_2({false,{a,b,c}}), + ok = complex_or_2({true,{a,b,c,d}}), - ?line error = complex_or_2({blurf,{a,b,c}}), + error = complex_or_2({blurf,{a,b,c}}), - ?line error = complex_or_2({true}), - ?line error = complex_or_2({true,no_tuple}), - ?line error = complex_or_2({true,[]}), + error = complex_or_2({true}), + error = complex_or_2({true,no_tuple}), + error = complex_or_2({true,[]}), %% complex_or_3/2 - ?line ok = complex_or_3({true}, {}), - ?line ok = complex_or_3({false}, {a}), - ?line ok = complex_or_3({false}, {a,b,c}), - ?line ok = complex_or_3({true}, {a,b,c,d}), - ?line ok = complex_or_3({false}, <<1,2,3>>), - ?line ok = complex_or_3({true}, <<1,2,3,4>>), + ok = complex_or_3({true}, {}), + ok = complex_or_3({false}, {a}), + ok = complex_or_3({false}, {a,b,c}), + ok = complex_or_3({true}, {a,b,c,d}), + ok = complex_or_3({false}, <<1,2,3>>), + ok = complex_or_3({true}, <<1,2,3,4>>), - ?line error = complex_or_3(blurf, {a,b,c}), + error = complex_or_3(blurf, {a,b,c}), - ?line error = complex_or_3({false}, <<1,2,3,4>>), - ?line error = complex_or_3([], <<1,2>>), - ?line error = complex_or_3({true}, 45), - ?line error = complex_or_3(<<>>, <<>>), + error = complex_or_3({false}, <<1,2,3,4>>), + error = complex_or_3([], <<1,2>>), + error = complex_or_3({true}, 45), + error = complex_or_3(<<>>, <<>>), %% complex_or_4/2 - ?line ok = complex_or_4(<<1,2,3>>, {true}), - ?line ok = complex_or_4(<<1,2,3>>, {false}), - ?line ok = complex_or_4(<<1,2,3>>, {true}), - ?line ok = complex_or_4({1,2,3}, {true}), - ?line error = complex_or_4({1,2,3,4}, {false}), + ok = complex_or_4(<<1,2,3>>, {true}), + ok = complex_or_4(<<1,2,3>>, {false}), + ok = complex_or_4(<<1,2,3>>, {true}), + ok = complex_or_4({1,2,3}, {true}), + error = complex_or_4({1,2,3,4}, {false}), - ?line error = complex_or_4(<<1,2,3,4>>, []), - ?line error = complex_or_4([], {true}), + error = complex_or_4(<<1,2,3,4>>, []), + error = complex_or_4([], {true}), %% complex_or_5/2 - ?line ok = complex_or_5(<<1>>, {false}), - ?line ok = complex_or_5(<<1,2,3>>, {true}), - ?line ok = complex_or_5(<<1,2,3,4>>, {false}), - ?line ok = complex_or_5({1,2,3}, {false}), - ?line ok = complex_or_5({1,2,3,4}, {false}), + ok = complex_or_5(<<1>>, {false}), + ok = complex_or_5(<<1,2,3>>, {true}), + ok = complex_or_5(<<1,2,3,4>>, {false}), + ok = complex_or_5({1,2,3}, {false}), + ok = complex_or_5({1,2,3,4}, {false}), - ?line error = complex_or_5(blurf, {false}), - ?line error = complex_or_5(<<1>>, klarf), - ?line error = complex_or_5(blurf, klarf), + error = complex_or_5(blurf, {false}), + error = complex_or_5(<<1>>, klarf), + error = complex_or_5(blurf, klarf), %% complex_or_6/2 - ?line ok = complex_or_6({true,true}, {1,2,3,4}), - ?line ok = complex_or_6({true,true}, <<1,2,3,4>>), - ?line ok = complex_or_6({false,false}, <<1,2,3,4>>), - ?line ok = complex_or_6({false,true}, <<1>>), - ?line ok = complex_or_6({true,false}, {1}), - ?line ok = complex_or_6({true,true}, {1}), + ok = complex_or_6({true,true}, {1,2,3,4}), + ok = complex_or_6({true,true}, <<1,2,3,4>>), + ok = complex_or_6({false,false}, <<1,2,3,4>>), + ok = complex_or_6({false,true}, <<1>>), + ok = complex_or_6({true,false}, {1}), + ok = complex_or_6({true,true}, {1}), - ?line error = complex_or_6({false,false}, {1}), + error = complex_or_6({false,false}, {1}), - ?line error = complex_or_6({true}, {1,2,3,4}), - ?line error = complex_or_6({}, {1,2,3,4}), - ?line error = complex_or_6([], {1,2,3,4}), - ?line error = complex_or_6([], {1,2,3,4}), - ?line error = complex_or_6({true,false}, klurf), + error = complex_or_6({true}, {1,2,3,4}), + error = complex_or_6({}, {1,2,3,4}), + error = complex_or_6([], {1,2,3,4}), + error = complex_or_6([], {1,2,3,4}), + error = complex_or_6({true,false}, klurf), ok. @@ -1031,79 +1025,79 @@ and_guard(Config) when is_list(Config) -> %% 'and' combinations of literal true/false. - ?line check(fun() -> if true and false -> ok; true -> error end end, error), - ?line check(fun() -> if false and true -> ok; true -> error end end, error), - ?line check(fun() -> if true and true -> ok end end, ok), - ?line check(fun() -> if false and false -> ok; true -> error end end, error), + check(fun() -> if true and false -> ok; true -> error end end, error), + check(fun() -> if false and true -> ok; true -> error end end, error), + check(fun() -> if true and true -> ok end end, ok), + check(fun() -> if false and false -> ok; true -> error end end, error), - ?line check(fun() -> if glurf and true -> ok; true -> error end end, error), - ?line check(fun() -> if true and glurf -> ok; true -> error end end, error), - ?line check(fun() -> if glurf and glurf -> ok; true -> error end end, error), + check(fun() -> if glurf and true -> ok; true -> error end end, error), + check(fun() -> if true and glurf -> ok; true -> error end end, error), + check(fun() -> if glurf and glurf -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = - (catch if true and false -> ok; - false and true -> ok; - false and false -> ok - end), - exit - end, exit), + check(fun() -> + {'EXIT',{if_clause,_}} = + (catch if true and false -> ok; + false and true -> ok; + false and false -> ok + end), + exit + end, exit), %% 'and' combinations of true/false in variables. True = id(true), False = id(false), - ?line check(fun() -> if True and False -> ok; true -> error end end, error), - ?line check(fun() -> if False and True -> ok; true -> error end end, error), - ?line check(fun() -> if True and True -> ok end end, ok), - ?line check(fun() -> if False and False -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = - (catch if True and False -> ok; - False and True -> ok; - False and False -> ok - end), - exit - end, exit), + check(fun() -> if True and False -> ok; true -> error end end, error), + check(fun() -> if False and True -> ok; true -> error end end, error), + check(fun() -> if True and True -> ok end end, ok), + check(fun() -> if False and False -> ok; true -> error end end, error), + check(fun() -> + {'EXIT',{if_clause,_}} = + (catch if True and False -> ok; + False and True -> ok; + False and False -> ok + end), + exit + end, exit), %% 'and' combinations of true/false and a non-boolean in variables. Glurf = id(glurf), - ?line check(fun() -> if True and Glurf -> ok; true -> error end end, error), - ?line check(fun() -> if Glurf and True -> ok; true -> error end end, error), - ?line check(fun() -> if True and True -> ok end end, ok), - ?line check(fun() -> if Glurf and Glurf -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = - (catch if True and Glurf -> ok; - Glurf and True -> ok; - Glurf and Glurf -> ok - end), - exit - end, exit), + check(fun() -> if True and Glurf -> ok; true -> error end end, error), + check(fun() -> if Glurf and True -> ok; true -> error end end, error), + check(fun() -> if True and True -> ok end end, ok), + check(fun() -> if Glurf and Glurf -> ok; true -> error end end, error), + check(fun() -> + {'EXIT',{if_clause,_}} = + (catch if True and Glurf -> ok; + Glurf and True -> ok; + Glurf and Glurf -> ok + end), + exit + end, exit), %% 'and' combinations of true/false with errors. ATuple = id({a,b,c}), - ?line check(fun() -> if True and element(42, ATuple) -> ok; - true -> error end end, error), - ?line check(fun() -> if element(42, ATuple) and True -> ok; - true -> error end end, error), - ?line check(fun() -> if True and True -> ok end end, ok), - ?line check(fun() -> if element(42, ATuple) and element(42, ATuple) -> ok; - true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = - (catch if True and element(42, ATuple) -> ok; - element(42, ATuple) and True -> ok; - element(42, ATuple) and element(42, ATuple) -> ok - end), - exit - end, exit), - - ?line ok = relprod({'Set',a,b}, {'Set',a,b}), + check(fun() -> if True and element(42, ATuple) -> ok; + true -> error end end, error), + check(fun() -> if element(42, ATuple) and True -> ok; + true -> error end end, error), + check(fun() -> if True and True -> ok end end, ok), + check(fun() -> if element(42, ATuple) and element(42, ATuple) -> ok; + true -> error end end, error), + check(fun() -> + {'EXIT',{if_clause,_}} = + (catch if True and element(42, ATuple) -> ok; + element(42, ATuple) and True -> ok; + element(42, ATuple) and element(42, ATuple) -> ok + end), + exit + end, exit), + + ok = relprod({'Set',a,b}, {'Set',a,b}), ok. @@ -1114,18 +1108,18 @@ relprod(R1, R2) when (erlang:size(R1) =:= 3) and (erlang:element(1,R1) =:= 'Set' xor_guard(Config) when is_list(Config) -> %% 'xor' combinations of literal true/false. - ?line check(fun() -> if true xor false -> ok end end, ok), - ?line check(fun() -> if false xor true -> ok end end, ok), - ?line check(fun() -> if true xor true -> ok; true -> error end end, error), - ?line check(fun() -> if false xor false -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = (catch if false xor false -> ok end), - exit - end, exit), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = (catch if true xor true -> ok end), - exit - end, exit), + check(fun() -> if true xor false -> ok end end, ok), + check(fun() -> if false xor true -> ok end end, ok), + check(fun() -> if true xor true -> ok; true -> error end end, error), + check(fun() -> if false xor false -> ok; true -> error end end, error), + check(fun() -> + {'EXIT',{if_clause,_}} = (catch if false xor false -> ok end), + exit + end, exit), + check(fun() -> + {'EXIT',{if_clause,_}} = (catch if true xor true -> ok end), + exit + end, exit), %% 'xor' combinations using variables containing true/false. @@ -1133,18 +1127,18 @@ xor_guard(Config) when is_list(Config) -> True = id(true), False = id(false), - ?line check(fun() -> if True xor False -> ok end end, ok), - ?line check(fun() -> if False xor True -> ok end end, ok), - ?line check(fun() -> if True xor True -> ok; true -> error end end, error), - ?line check(fun() -> if False xor False -> ok; true -> error end end, error), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = (catch if False xor False -> ok end), - exit - end, exit), - ?line check(fun() -> - {'EXIT',{if_clause,_}} = (catch if True xor True -> ok end), - exit - end, exit), + check(fun() -> if True xor False -> ok end end, ok), + check(fun() -> if False xor True -> ok end end, ok), + check(fun() -> if True xor True -> ok; true -> error end end, error), + check(fun() -> if False xor False -> ok; true -> error end end, error), + check(fun() -> + {'EXIT',{if_clause,_}} = (catch if False xor False -> ok end), + exit + end, exit), + check(fun() -> + {'EXIT',{if_clause,_}} = (catch if True xor True -> ok end), + exit + end, exit), ok. @@ -1153,53 +1147,53 @@ more_xor_guards(Config) when is_list(Config) -> False = id(false), ATuple = id({false,true,gurka}), - ?line check(fun() -> - if element(42, ATuple) xor False -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if False xor element(42, ATuple) xor False -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if element(18, ATuple) xor element(42, ATuple) -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if True xor element(42, ATuple) -> ok; - true -> error end - end, error), - - ?line check(fun() -> - if element(42, ATuple) xor True -> ok; - true -> error end - end, error), + check(fun() -> + if element(42, ATuple) xor False -> ok; + true -> error end + end, error), + + check(fun() -> + if False xor element(42, ATuple) xor False -> ok; + true -> error end + end, error), + + check(fun() -> + if element(18, ATuple) xor element(42, ATuple) -> ok; + true -> error end + end, error), + + check(fun() -> + if True xor element(42, ATuple) -> ok; + true -> error end + end, error), + + check(fun() -> + if element(42, ATuple) xor True -> ok; + true -> error end + end, error), ok. build_in_guard(Config) when is_list(Config) -> SubBin = <<5.0/float>>, - ?line B = <<1,SubBin/binary,3.5/float>>, - ?line if - B =:= <<1,SubBin/binary,3.5/float>> -> ok - end. + B = <<1,SubBin/binary,3.5/float>>, + if + B =:= <<1,SubBin/binary,3.5/float>> -> ok + end. old_guard_tests(Config) when list(Config) -> %% Check that all the old guard tests are still recognized. - ?line list = og(Config), - ?line atom = og(an_atom), - ?line binary = og(<<1,2>>), - ?line float = og(3.14), - ?line integer = og(43), - ?line a_function = og(fun() -> ok end), - ?line pid = og(self()), - ?line reference = og(make_ref()), - ?line tuple = og({}), - - ?line number = on(45.333), - ?line number = on(-19), + list = og(Config), + atom = og(an_atom), + binary = og(<<1,2>>), + float = og(3.14), + integer = og(43), + a_function = og(fun() -> ok end), + pid = og(self()), + reference = og(make_ref()), + tuple = og({}), + + number = on(45.333), + number = on(-19), ok. og(V) when atom(V) -> atom; @@ -1218,8 +1212,8 @@ on(V) when number(V) -> number; on(_) -> not_number. gbif(Config) when is_list(Config) -> - ?line error = gbif_1(1, {false,true}), - ?line ok = gbif_1(2, {false,true}), + error = gbif_1(1, {false,true}), + ok = gbif_1(2, {false,true}), ok. gbif_1(P, T) when element(P, T) -> ok; @@ -1227,49 +1221,49 @@ gbif_1(_, _) -> error. t_is_boolean(Config) when is_list(Config) -> - ?line true = is_boolean(true), - ?line true = is_boolean(false), - ?line true = is_boolean(id(true)), - ?line true = is_boolean(id(false)), - - ?line false = is_boolean(glurf), - ?line false = is_boolean(id(glurf)), - - ?line false = is_boolean([]), - ?line false = is_boolean(id([])), - ?line false = is_boolean(42), - ?line false = is_boolean(id(-42)), - - ?line false = is_boolean(math:pi()), - ?line false = is_boolean(384793478934378924978439789873478934897), - - ?line false = is_boolean(id(self())), - ?line false = is_boolean(id({x,y,z})), - ?line false = is_boolean(id([a,b,c])), - ?line false = is_boolean(id(make_ref())), - ?line false = is_boolean(id(<<1,2,3>>)), - - ?line ok = bool(true), - ?line ok = bool(false), - ?line ok = bool(id(true)), - ?line ok = bool(id(false)), - - ?line error = bool(glurf), - ?line error = bool(id(glurf)), - - ?line error = bool([]), - ?line error = bool(id([])), - ?line error = bool(42), - ?line error = bool(id(-42)), - - ?line error = bool(math:pi()), - ?line error = bool(384793478934378924978439789873478934897), - - ?line error = bool(id(self())), - ?line error = bool(id({x,y,z})), - ?line error = bool(id([a,b,c])), - ?line error = bool(id(make_ref())), - ?line error = bool(id(<<1,2,3>>)), + true = is_boolean(true), + true = is_boolean(false), + true = is_boolean(id(true)), + true = is_boolean(id(false)), + + false = is_boolean(glurf), + false = is_boolean(id(glurf)), + + false = is_boolean([]), + false = is_boolean(id([])), + false = is_boolean(42), + false = is_boolean(id(-42)), + + false = is_boolean(math:pi()), + false = is_boolean(384793478934378924978439789873478934897), + + false = is_boolean(id(self())), + false = is_boolean(id({x,y,z})), + false = is_boolean(id([a,b,c])), + false = is_boolean(id(make_ref())), + false = is_boolean(id(<<1,2,3>>)), + + ok = bool(true), + ok = bool(false), + ok = bool(id(true)), + ok = bool(id(false)), + + error = bool(glurf), + error = bool(id(glurf)), + + error = bool([]), + error = bool(id([])), + error = bool(42), + error = bool(id(-42)), + + error = bool(math:pi()), + error = bool(384793478934378924978439789873478934897), + + error = bool(id(self())), + error = bool(id({x,y,z})), + error = bool(id([a,b,c])), + error = bool(id(make_ref())), + error = bool(id(<<1,2,3>>)), ok. @@ -1289,14 +1283,14 @@ is_function_2(Config) when is_list(Config) -> end. tricky(Config) when is_list(Config) -> - ?line not_ok = tricky_1(1, 2), - ?line not_ok = tricky_1(1, blurf), - ?line not_ok = tricky_1(foo, 2), - ?line not_ok = tricky_1(a, b), - - ?line false = rb(100000, [1], 42), - ?line true = rb(100000, [], 42), - ?line true = rb(555, [a,b,c], 19), + not_ok = tricky_1(1, 2), + not_ok = tricky_1(1, blurf), + not_ok = tricky_1(foo, 2), + not_ok = tricky_1(a, b), + + false = rb(100000, [1], 42), + true = rb(100000, [], 42), + true = rb(555, [a,b,c], 19), ok. tricky_1(X, Y) when abs((X == 1) or (Y == 2)) -> ok; @@ -1331,66 +1325,66 @@ rb(_, _, _) -> false. rel_ops(Config) when is_list(Config) -> - ?line ?T(=/=, 1, 1.0), - ?line ?F(=/=, 2, 2), - ?line ?F(=/=, {a}, {a}), + ?T(=/=, 1, 1.0), + ?F(=/=, 2, 2), + ?F(=/=, {a}, {a}), - ?line ?F(/=, a, a), - ?line ?F(/=, 0, 0.0), - ?line ?T(/=, 0, 1), - ?line ?F(/=, {a}, {a}), + ?F(/=, a, a), + ?F(/=, 0, 0.0), + ?T(/=, 0, 1), + ?F(/=, {a}, {a}), - ?line ?T(==, 1, 1.0), - ?line ?F(==, a, {}), + ?T(==, 1, 1.0), + ?F(==, a, {}), - ?line ?F(=:=, 1, 1.0), - ?line ?T(=:=, 42.0, 42.0), + ?F(=:=, 1, 1.0), + ?T(=:=, 42.0, 42.0), - ?line ?F(>, a, b), - ?line ?T(>, 42, 1.0), - ?line ?F(>, 42, 42.0), + ?F(>, a, b), + ?T(>, 42, 1.0), + ?F(>, 42, 42.0), - ?line ?T(<, a, b), - ?line ?F(<, 42, 1.0), - ?line ?F(<, 42, 42.0), + ?T(<, a, b), + ?F(<, 42, 1.0), + ?F(<, 42, 42.0), - ?line ?T(=<, 1.5, 5), - ?line ?F(=<, -9, -100.344), - ?line ?T(=<, 42, 42.0), + ?T(=<, 1.5, 5), + ?F(=<, -9, -100.344), + ?T(=<, 42, 42.0), - ?line ?T(>=, 42, 42.0), - ?line ?F(>=, a, b), - ?line ?T(>=, 1.0, 0), + ?T(>=, 42, 42.0), + ?F(>=, a, b), + ?T(>=, 1.0, 0), ok. -undef(TestOp). basic_andalso_orelse(Config) when is_list(Config) -> - ?line T = id({type,integers,23,42}), - ?line 65 = if - ((element(1, T) =:= type) andalso (size(T) =:= 4) andalso - element(2, T) == integers) -> - element(3, T) + element(4, T); - true -> error - end, - ?line 65 = case [] of - [] when ((element(1, T) =:= type) andalso (size(T) =:= 4) andalso - element(2, T) == integers) -> - element(3, T) + element(4, T) - end, - - ?line 42 = basic_rt({type,integers,40,2}), - ?line 5.0 = basic_rt({vector,{3.0,4.0}}), - ?line 20 = basic_rt(['+',3,7]), - ?line {'Set',a,b} = basic_rt({{'Set',a,b},{'Set',a,b}}), - ?line 12 = basic_rt({klurf,4}), - - ?line error = basic_rt({type,integers,40,2,3}), - ?line error = basic_rt({kalle,integers,40,2}), - ?line error = basic_rt({kalle,integers,40,2}), - ?line error = basic_rt({1,2}), - ?line error = basic_rt([]), + T = id({type,integers,23,42}), + 65 = if + ((element(1, T) =:= type) andalso (size(T) =:= 4) andalso + element(2, T) == integers) -> + element(3, T) + element(4, T); + true -> error + end, + 65 = case [] of + [] when ((element(1, T) =:= type) andalso (size(T) =:= 4) andalso + element(2, T) == integers) -> + element(3, T) + element(4, T) + end, + + 42 = basic_rt({type,integers,40,2}), + 5.0 = basic_rt({vector,{3.0,4.0}}), + 20 = basic_rt(['+',3,7]), + {'Set',a,b} = basic_rt({{'Set',a,b},{'Set',a,b}}), + 12 = basic_rt({klurf,4}), + + error = basic_rt({type,integers,40,2,3}), + error = basic_rt({kalle,integers,40,2}), + error = basic_rt({kalle,integers,40,2}), + error = basic_rt({1,2}), + error = basic_rt([]), RelProdBody = fun(R1, R2) -> @@ -1401,7 +1395,7 @@ basic_andalso_orelse(Config) when is_list(Config) -> end end, - ?line ok = RelProdBody({'Set',a,b}, {'Set',a,b}), + ok = RelProdBody({'Set',a,b}, {'Set',a,b}), ok. basic_rt(T) when is_tuple(T) andalso size(T) =:= 4 andalso element(1, T) =:= type andalso @@ -1445,9 +1439,9 @@ traverse_dcd(Config) when is_list(Config) -> traverse_dcd({Cont,[LogH|Rest]},Log,Fun) when is_tuple(LogH) andalso size(LogH) =:= 6 andalso element(1, LogH) =:= log_header -andalso erlang:element(2,LogH) == dcd_log, -is_tuple(LogH) andalso size(LogH) =:= 6 andalso element(1, LogH) =:= log_header -andalso erlang:element(3,LogH) >= "1.0" -> + andalso erlang:element(2,LogH) == dcd_log, + is_tuple(LogH) andalso size(LogH) =:= 6 andalso element(1, LogH) =:= log_header + andalso erlang:element(3,LogH) >= "1.0" -> traverse_dcd({Cont,Rest},Log,Fun); traverse_dcd({Cont,Recs},Log,Fun) -> {Cont,Recs,Log,Fun}. @@ -1455,14 +1449,14 @@ traverse_dcd({Cont,Recs},Log,Fun) -> check_qlc_hrl(Config) when is_list(Config) -> St = {r1,false,dum}, - ?line foo = cqlc(qlc, q, [{lc,1,2,3}], St), - ?line foo = cqlc(qlc, q, [{lc,1,2,3},b], St), - ?line St = cqlc(qlc, q, [], St), - ?line St = cqlc(qlc, blurf, [{lc,1,2,3},b], St), - ?line St = cqlc(q, q, [{lc,1,2,3},b], St), - ?line St = cqlc(qlc, q, [{lc,1,2,3},b,c], St), - ?line St = cqlc(qlc, q, [a,b], St), - ?line {r1,true,kalle} = cqlc(qlc, q, [{lc,1,2,3},b], {r1,true,kalle}), + foo = cqlc(qlc, q, [{lc,1,2,3}], St), + foo = cqlc(qlc, q, [{lc,1,2,3},b], St), + St = cqlc(qlc, q, [], St), + St = cqlc(qlc, blurf, [{lc,1,2,3},b], St), + St = cqlc(q, q, [{lc,1,2,3},b], St), + St = cqlc(qlc, q, [{lc,1,2,3},b,c], St), + St = cqlc(qlc, q, [a,b], St), + {r1,true,kalle} = cqlc(qlc, q, [{lc,1,2,3},b], {r1,true,kalle}), ok. %% From erl_lint.erl; original name was check_qlc_hrl/4. @@ -1479,29 +1473,29 @@ cqlc(M, F, As, St) -> %% OTP-7679: Thanks to Hunter Morris. andalso_semi(Config) when is_list(Config) -> - ?line ok = andalso_semi_foo(0), - ?line ok = andalso_semi_foo(1), - ?line fc(catch andalso_semi_foo(2)), + ok = andalso_semi_foo(0), + ok = andalso_semi_foo(1), + fc(catch andalso_semi_foo(2)), - ?line ok = andalso_semi_bar([a,b,c]), - ?line ok = andalso_semi_bar(1), - ?line fc(catch andalso_semi_bar([a,b])), + ok = andalso_semi_bar([a,b,c]), + ok = andalso_semi_bar(1), + fc(catch andalso_semi_bar([a,b])), ok. andalso_semi_foo(Bar) when is_integer(Bar) andalso Bar =:= 0; Bar =:= 1 -> - ok. + ok. andalso_semi_bar(Bar) when is_list(Bar) andalso length(Bar) =:= 3; Bar =:= 1 -> - ok. + ok. t_tuple_size(Config) when is_list(Config) -> - ?line 10 = do_tuple_size({1,2,3,4}), - ?line fc(catch do_tuple_size({1,2,3})), - ?line fc(catch do_tuple_size(42)), + 10 = do_tuple_size({1,2,3,4}), + fc(catch do_tuple_size({1,2,3})), + fc(catch do_tuple_size(42)), - ?line error = ludicrous_tuple_size({a,b,c}), - ?line error = ludicrous_tuple_size([a,b,c]), + error = ludicrous_tuple_size({a,b,c}), + error = ludicrous_tuple_size([a,b,c]), ok. @@ -1528,77 +1522,76 @@ mask_error({'EXIT',{Err,_}}) -> mask_error(Else) -> Else. -binary_part(doc) -> - ["Tests the binary_part/2,3 guard (GC) bif's"]; +%% Tests the binary_part/2,3 guard (GC) bif's. binary_part(Config) when is_list(Config) -> %% This is more or less a copy of what the guard_SUITE in emulator %% does to cover the guard bif's - ?line 1 = bptest(<<1,2,3>>), - ?line 2 = bptest(<<2,1,3>>), - ?line error = bptest(<<1>>), - ?line error = bptest(<<>>), - ?line error = bptest(apa), - ?line 3 = bptest(<<2,3,3>>), - % With one variable (pos) - ?line 1 = bptest(<<1,2,3>>,1), - ?line 2 = bptest(<<2,1,3>>,1), - ?line error = bptest(<<1>>,1), - ?line error = bptest(<<>>,1), - ?line error = bptest(apa,1), - ?line 3 = bptest(<<2,3,3>>,1), - % With one variable (length) - ?line 1 = bptesty(<<1,2,3>>,1), - ?line 2 = bptesty(<<2,1,3>>,1), - ?line error = bptesty(<<1>>,1), - ?line error = bptesty(<<>>,1), - ?line error = bptesty(apa,1), - ?line 3 = bptesty(<<2,3,3>>,2), - % With one variable (whole tuple) - ?line 1 = bptestx(<<1,2,3>>,{1,1}), - ?line 2 = bptestx(<<2,1,3>>,{1,1}), - ?line error = bptestx(<<1>>,{1,1}), - ?line error = bptestx(<<>>,{1,1}), - ?line error = bptestx(apa,{1,1}), - ?line 3 = bptestx(<<2,3,3>>,{1,2}), - % With two variables - ?line 1 = bptest(<<1,2,3>>,1,1), - ?line 2 = bptest(<<2,1,3>>,1,1), - ?line error = bptest(<<1>>,1,1), - ?line error = bptest(<<>>,1,1), - ?line error = bptest(apa,1,1), - ?line 3 = bptest(<<2,3,3>>,1,2), - % Direct (autoimported) call, these will be evaluated by the compiler... - ?line <<2>> = binary_part(<<1,2,3>>,1,1), - ?line <<1>> = binary_part(<<2,1,3>>,1,1), - % Compiler warnings due to constant evaluation expected (3) - ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)), - ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)), - ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)), - ?line <<3,3>> = binary_part(<<2,3,3>>,1,2), - % Direct call through apply - ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]), - ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]), - % Compiler warnings due to constant evaluation expected (3) - ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])), - ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])), - ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])), - ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]), - % Constant propagation - ?line Bin = <<1,2,3>>, - ?line ok = if - binary_part(Bin,1,1) =:= <<2>> -> - ok; - %% Compiler warning, clause cannot match (expected) - true -> - error - end, - ?line ok = if - binary_part(Bin,{1,1}) =:= <<2>> -> - ok; - %% Compiler warning, clause cannot match (expected) - true -> - error - end, + 1 = bptest(<<1,2,3>>), + 2 = bptest(<<2,1,3>>), + error = bptest(<<1>>), + error = bptest(<<>>), + error = bptest(apa), + 3 = bptest(<<2,3,3>>), + %% With one variable (pos) + 1 = bptest(<<1,2,3>>,1), + 2 = bptest(<<2,1,3>>,1), + error = bptest(<<1>>,1), + error = bptest(<<>>,1), + error = bptest(apa,1), + 3 = bptest(<<2,3,3>>,1), + %% With one variable (length) + 1 = bptesty(<<1,2,3>>,1), + 2 = bptesty(<<2,1,3>>,1), + error = bptesty(<<1>>,1), + error = bptesty(<<>>,1), + error = bptesty(apa,1), + 3 = bptesty(<<2,3,3>>,2), + %% With one variable (whole tuple) + 1 = bptestx(<<1,2,3>>,{1,1}), + 2 = bptestx(<<2,1,3>>,{1,1}), + error = bptestx(<<1>>,{1,1}), + error = bptestx(<<>>,{1,1}), + error = bptestx(apa,{1,1}), + 3 = bptestx(<<2,3,3>>,{1,2}), + %% With two variables + 1 = bptest(<<1,2,3>>,1,1), + 2 = bptest(<<2,1,3>>,1,1), + error = bptest(<<1>>,1,1), + error = bptest(<<>>,1,1), + error = bptest(apa,1,1), + 3 = bptest(<<2,3,3>>,1,2), + %% Direct (autoimported) call, these will be evaluated by the compiler... + <<2>> = binary_part(<<1,2,3>>,1,1), + <<1>> = binary_part(<<2,1,3>>,1,1), + %% Compiler warnings due to constant evaluation expected (3) + badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)), + badarg = ?MASK_ERROR(binary_part(<<>>,1,1)), + badarg = ?MASK_ERROR(binary_part(apa,1,1)), + <<3,3>> = binary_part(<<2,3,3>>,1,2), + %% Direct call through apply + <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]), + <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]), + %% Compiler warnings due to constant evaluation expected (3) + badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])), + badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])), + badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])), + <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]), + %% Constant propagation + Bin = <<1,2,3>>, + ok = if + binary_part(Bin,1,1) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, + ok = if + binary_part(Bin,{1,1}) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, ok. @@ -1659,24 +1652,24 @@ bptest(_,_,_) -> -define(FAILING(C), if - C -> ?t:fail(should_fail); + C -> ct:fail(should_fail); true -> ok end, if - true, C -> ?t:fail(should_fail); + true, C -> ct:fail(should_fail); true -> ok end). bad_constants(Config) when is_list(Config) -> - ?line ?FAILING(false), - ?line ?FAILING([]), - ?line ?FAILING([a]), - ?line ?FAILING([Config]), - ?line ?FAILING({a,b}), - ?line ?FAILING({a,Config}), - ?line ?FAILING(<<1>>), - ?line ?FAILING(42), - ?line ?FAILING(3.14), + ?FAILING(false), + ?FAILING([]), + ?FAILING([a]), + ?FAILING([Config]), + ?FAILING({a,b}), + ?FAILING({a,Config}), + ?FAILING(<<1>>), + ?FAILING(42), + ?FAILING(3.14), ok. %% Call this function to turn off constant propagation. @@ -1688,7 +1681,7 @@ check(F, Result) -> Other -> io:format("Expected: ~p\n", [Result]), io:format(" Got: ~p\n", [Other]), - test_server:fail() + ct:fail(failed) end. fc({'EXIT',{function_clause,_}}) -> ok. diff --git a/lib/debugger/test/int_SUITE.erl b/lib/debugger/test/int_SUITE.erl index af8f5256cb..f697ace4e5 100644 --- a/lib/debugger/test/int_SUITE.erl +++ b/lib/debugger/test/int_SUITE.erl @@ -31,37 +31,30 @@ -export([interpret/1, guards/1, interpretable/1]). -export([ append_1/1, append_2/1, member/1, reverse/1]). -%% Default timetrap timeout (set in init_per_testcase) --define(default_timeout, ?t:minutes(1)). - init_per_testcase(interpretable, Config) -> - ?line Dog=test_server:timetrap(?default_timeout), - [{watchdog, Dog}|Config]; + Config; init_per_testcase(_Case, Config) -> %% Interpret some existing and non-existing modules - ?line DataDir = ?config(data_dir, Config), - ?line {module, lists1} = int:i(filename:join([DataDir,lists1])), - ?line {module, guards} = int:i(filename:join([DataDir,guards])), + DataDir = proplists:get_value(data_dir, Config), + {module, lists1} = int:i(filename:join([DataDir,lists1])), + {module, guards} = int:i(filename:join([DataDir,guards])), - ?line Dog=test_server:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. + Config. -end_per_testcase(interpretable, Config) -> - ?line Dog=?config(watchdog, Config), - ?line test_server:timetrap_cancel(Dog), +end_per_testcase(interpretable, _Config) -> ok; end_per_testcase(_Case, Config) -> %% Quit interpreting - ?line ok = int:n(lists1), - ?line ok = int:n(guards), + ok = int:n(lists1), + ok = int:n(guards), - ?line Dog=?config(watchdog, Config), - ?line test_server:timetrap_cancel(Dog), - ?line ok. + ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> [interpret, guards, {group, list_suite}, interpretable]. @@ -71,6 +64,14 @@ groups() -> {append, [], [append_1, append_2]}]. init_per_suite(Config) -> + DataDir = proplists:get_value(data_dir, Config), + {ok,OldCwd} = file:get_cwd(), + try + ok = file:set_cwd(DataDir), + make:all() + after + file:set_cwd(OldCwd) + end, Config. end_per_suite(_Config) -> @@ -83,83 +84,62 @@ end_per_group(_GroupName, Config) -> Config. -interpret(suite) -> - []; -interpret(doc) -> - ["Interpreting modules"]; +%% Interpreting modules. interpret(Config) when is_list(Config) -> - ?line int:n(int:interpreted()), + int:n(int:interpreted()), %% Interpret some existing and non-existing modules - ?line DataDir = ?config(data_dir, Config), - ?line {module, lists1} = int:i(filename:join([DataDir,lists1])), - ?line {module, ordsets1} = int:i(filename:join([DataDir,ordsets1])), - ?line error = int:i(non_existent_module), + DataDir = proplists:get_value(data_dir, Config), + {module, lists1} = int:i(filename:join([DataDir,lists1])), + {module, ordsets1} = int:i(filename:join([DataDir,ordsets1])), + error = int:i(non_existent_module), %% Check that the interpreter has the right view. - ?line ExpectedResult = lists:sort([lists1, ordsets1]), - ?line Result = int:interpreted(), - ?line ExpectedResult = lists:sort(Result), + ExpectedResult = lists:sort([lists1, ordsets1]), + Result = int:interpreted(), + ExpectedResult = lists:sort(Result), %% Uniterpret the modules. - ?line ok = int:n(non_existent_module), - ?line ok = int:n(lists1), - ?line [ordsets1] = int:interpreted(), - ?line ok = int:n("ordsets1"), - ?line [] = int:interpreted(), + ok = int:n(non_existent_module), + ok = int:n(lists1), + [ordsets1] = int:interpreted(), + ok = int:n("ordsets1"), + [] = int:interpreted(), ok. -guards(suite) -> - []; -guards(doc) -> - "Evaluate guards."; +%% Evaluate guards. guards(Config) when is_list(Config) -> ok = guards:guards(). - - - -append_1(suite) -> - []; -append_1(doc) -> - []; append_1(Config) when is_list(Config) -> - ?line test_server:format("In append_1~n"), - ?line test_server:format("code:which(lists1)=~p~n", - [code:which(lists1)]), - ?line test_server:format("lists1:append([a],[b])=~p~n", - [spawn_eval(lists1,append,[[a],[b]])]), - - ?line "abcdef"=spawn_eval(lists1,append,[["abc","def"]]), - ?line [hej, du,[glade, [bagare]]]= + io:format("In append_1~n"), + io:format("code:which(lists1)=~p~n", + [code:which(lists1)]), + io:format("lists1:append([a],[b])=~p~n", + [spawn_eval(lists1,append,[[a],[b]])]), + + "abcdef"=spawn_eval(lists1,append,[["abc","def"]]), + [hej, du,[glade, [bagare]]]= spawn_eval(lists1,append,[[[hej], [du], [[glade, [bagare]]]]]), - ?line [10, [elem]]=spawn_eval(lists1,append,[[[10], [[elem]]]]), + [10, [elem]]=spawn_eval(lists1,append,[[[10], [[elem]]]]), ok. -append_2(suite) -> - []; -append_2(doc) -> - []; append_2(Config) when is_list(Config) -> - ?line test_server:format("In append_2~n"), - ?line test_server:format("code:which(lists1)=~p~n", - [code:which(lists1)]), + io:format("In append_2~n"), + io:format("code:which(lists1)=~p~n", + [code:which(lists1)]), - ?line "abcdef"=spawn_eval(lists1,append,["abc", "def"]), - ?line [hej, du]=spawn_eval(lists1,append,[[hej], [du]]), - ?line [10, [elem]]=spawn_eval(lists1,append,[[10], [[elem]]]), + "abcdef"=spawn_eval(lists1,append,["abc", "def"]), + [hej, du]=spawn_eval(lists1,append,[[hej], [du]]), + [10, [elem]]=spawn_eval(lists1,append,[[10], [[elem]]]), ok. -reverse(suite) -> - []; -reverse(doc) -> - []; reverse(Config) when is_list(Config) -> - ?line ok=reverse_test(0), - ?line ok=reverse_test(1), - ?line ok=reverse_test(2), - ?line ok=reverse_test(537), + ok=reverse_test(0), + ok=reverse_test(1), + ok=reverse_test(2), + ok=reverse_test(537), ok. reverse_test(0) -> @@ -179,19 +159,16 @@ reverse_test(Num) -> error end. -member(suite) -> - []; -member(doc) -> - ["Tests the lists1:member() implementation. The function " - "is `non-blocking', and only processes 2000 elements " - "at a time.", - "This test case depends on lists1:reverse() to work, " - "wich is tested in a separate test case."]; +%% Tests the lists1:member() implementation. The function +%% is `non-blocking', and only processes 2000 elements +%% at a time. +%% This test case depends on lists1:reverse() to work, +%% which is tested in a separate test case. member(Config) when list(Config) -> - ?line ok=member_test(0), - ?line ok=member_test(1), - ?line ok=member_test(100), - ?line ok=member_test(537), + ok=member_test(0), + ok=member_test(1), + ok=member_test(100), + ok=member_test(537), ok. member_test(0) -> @@ -223,48 +200,45 @@ spawn_eval(M,F,A) -> evaluator(Pid, M,F,A) -> Pid ! (catch apply(M,F,A)). -interpretable(suite) -> - []; -interpretable(doc) -> - ["Test int:interpretable/1"]; +%% Test int:interpretable/1. interpretable(Config) when is_list(Config) -> %% First make sure that 'lists1' is not loaded case code:is_loaded(lists1) of {file, _Loaded} -> - ?line code:purge(lists1), - ?line code:delete(lists1), - ?line code:purge(lists1); + code:purge(lists1), + code:delete(lists1), + code:purge(lists1); false -> ignore end, %% true - ?line DataDir = filename:dirname(?config(data_dir, Config)), - ?line true = code:add_patha(DataDir), - ?line true = int:interpretable(lists1), - ?line true = int:interpretable(filename:join([DataDir,lists1])), - ?line true = code:del_path(DataDir), + DataDir = filename:dirname(proplists:get_value(data_dir, Config)), + true = code:add_patha(DataDir), + true = int:interpretable(lists1), + true = int:interpretable(filename:join([DataDir,lists1])), + true = code:del_path(DataDir), %% true (from source) - PrivDir = filename:join(?config(priv_dir, Config), ""), + PrivDir = filename:join(proplists:get_value(priv_dir, Config), ""), {ok, _} = file:copy(filename:join([DataDir,"lists1.beam"]), - filename:join([PrivDir,"lists1.beam"])), + filename:join([PrivDir,"lists1.beam"])), true = code:add_patha(PrivDir), true = int:interpretable(lists1), ok = file:delete(filename:join([PrivDir,"lists1.beam"])), %% {error, no_beam} Src = filename:join([PrivDir,"lists1.erl"]), - ?line {ok, _} = file:copy(filename:join([DataDir,"lists1.erl"]), - Src), - ?line {error, no_beam} = int:interpretable(Src), + {ok, _} = file:copy(filename:join([DataDir,"lists1.erl"]), + Src), + {error, no_beam} = int:interpretable(Src), %% {error, no_debug_info} - ?line {ok, _} = compile:file(Src, [{outdir,PrivDir}]), - ?line {error, no_debug_info} = int:interpretable(Src), - ?line {error, no_debug_info} = int:interpretable(lists1), - ?line ok = file:delete(Src), - ?line true = code:del_path(PrivDir), + {ok, _} = compile:file(Src, [{outdir,PrivDir}]), + {error, no_debug_info} = int:interpretable(Src), + {error, no_debug_info} = int:interpretable(lists1), + ok = file:delete(Src), + true = code:del_path(PrivDir), %% {error, no_src} {ok, lists2, Binary} = compile:forms([{attribute,1,module,lists2}], []), @@ -272,24 +246,33 @@ interpretable(Config) when is_list(Config) -> {error, no_src} = int:interpretable(lists2), %% {error, badarg} - ?line {error, badarg} = int:interpretable(pride), - ?line {error, badarg} = int:interpretable("prejudice.erl"), + {error, badarg} = int:interpretable(pride), + {error, badarg} = int:interpretable("prejudice.erl"), %% {error, {app,App}} - ?line {error, {app,_}} = int:interpretable(file), - ?line {error, {app,_}} = int:interpretable(lists), - ?line case int:interpretable(dbg_ieval) of - {error, {app,_}} -> - ok; - {error, badarg} -> - case code:which(dbg_ieval) of - cover_compiled -> - ok; - Other1 -> - ?line ?t:fail({unexpected_result, Other1}) - end; - Other2 -> - ?line ?t:fail({unexpected_result, Other2}) - end, - + case filename:basename(code:lib_dir(kernel)) of + "kernel" -> + %% Development system (not installed). We are allowed + %% to interpret modules in kernel and stdlib + %% (at our own risk). + ok; + "kernel-" ++ _ -> + %% Installed system. Certain applications (including + %% kernel and stdlib) cannot be interpreted. + {error, {app,_}} = int:interpretable(file), + {error, {app,_}} = int:interpretable(lists), + case int:interpretable(dbg_ieval) of + {error, {app,_}} -> + ok; + {error, badarg} -> + case code:which(dbg_ieval) of + cover_compiled -> + ok; + Other1 -> + ct:fail({unexpected_result, Other1}) + end; + Other2 -> + ct:fail({unexpected_result, Other2}) + end + end, ok. diff --git a/lib/debugger/test/int_SUITE_data/Emakefile b/lib/debugger/test/int_SUITE_data/Emakefile new file mode 100644 index 0000000000..6158d66764 --- /dev/null +++ b/lib/debugger/test/int_SUITE_data/Emakefile @@ -0,0 +1 @@ +{[guards,lists1,my_lists,ordsets1,test,test1],[{outdir,"."},debug_info]}. diff --git a/lib/debugger/test/int_SUITE_data/Makefile.src b/lib/debugger/test/int_SUITE_data/Makefile.src deleted file mode 100644 index d5697623cd..0000000000 --- a/lib/debugger/test/int_SUITE_data/Makefile.src +++ /dev/null @@ -1,40 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2000-2016. All Rights Reserved. -# -# Licensed under the Apache License, Version 2.0 (the "License"); -# you may not use this file except in compliance with the License. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# -EFLAGS=+debug_info -all: guards.@EMULATOR@ lists1.@EMULATOR@ my_lists.@EMULATOR@ \ - ordsets1.@EMULATOR@ test.@EMULATOR@ test1.@EMULATOR@ - -guards.@EMULATOR@: guards.erl - erlc $(EFLAGS) guards.erl - -lists1.@EMULATOR@: lists1.erl - erlc $(EFLAGS) lists1.erl - -my_lists.@EMULATOR@: my_lists.erl - erlc $(EFLAGS) my_lists.erl - -ordsets1.@EMULATOR@: ordsets1.erl - erlc $(EFLAGS) ordsets1.erl - -test.@EMULATOR@: test.erl - erlc $(EFLAGS) test.erl - -test1.@EMULATOR@: test1.erl - erlc $(EFLAGS) test1.erl diff --git a/lib/debugger/test/int_break_SUITE.erl b/lib/debugger/test/int_break_SUITE.erl index 5362479897..9894c27b81 100644 --- a/lib/debugger/test/int_break_SUITE.erl +++ b/lib/debugger/test/int_break_SUITE.erl @@ -31,7 +31,9 @@ -export([auto_attach/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> [basic, cleanup]. @@ -53,38 +55,33 @@ end_per_group(_GroupName, Config) -> init_per_testcase(_Case, Config) -> - ?line DataDir = ?config(data_dir, Config), - ?line Mod = ordsets1, - ?line {module,Mod} = int:i(filename:join(DataDir, Mod)), - ?line ok = io:format("Interpreted modules: ~p", [int:interpreted()]), - ?line Dog = test_server:timetrap(?t:minutes(0.5)), - [{watchdog,Dog}|Config]. - -end_per_testcase(_Case, Config) -> - ?line ok = io:format("Interpreted modules: ~p", [int:interpreted()]), - ?line Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), + DataDir = proplists:get_value(data_dir, Config), + Mod = ordsets1, + {module,Mod} = int:i(filename:join(DataDir, Mod)), + ok = io:format("Interpreted modules: ~p", [int:interpreted()]), + Config. + +end_per_testcase(_Case, _Config) -> + ok = io:format("Interpreted modules: ~p", [int:interpreted()]), ok. -basic(doc) -> "Tests setting a few break points."; -basic(suite) -> []; +%% Tests setting a few break points. basic(Config) when list(Config) -> - ?line int:auto_attach([init], {?MODULE,auto_attach}), - ?line S1 = [] = ordsets1:new_set(), - ?line ok = i:ib(ordsets1, 86), - ?line S2 = [xxx] = ordsets1:add_element(xxx, S1), - ?line S3 = [xxx,y] = ordsets1:add_element(y, S2), - ?line ok = i:ib(ordsets1, union, 2), - ?line [xxx,y,z] = ordsets1:union(S3, [z]), + int:auto_attach([init], {?MODULE,auto_attach}), + S1 = [] = ordsets1:new_set(), + ok = i:ib(ordsets1, 86), + S2 = [xxx] = ordsets1:add_element(xxx, S1), + S3 = [xxx,y] = ordsets1:add_element(y, S2), + ok = i:ib(ordsets1, union, 2), + [xxx,y,z] = ordsets1:union(S3, [z]), All = [{{ordsets1,86}, _}, {{ordsets1,_},_}|_] = lists:sort(int:all_breaks()), [] = lists:sort(int:all_breaks(foobar)), All = lists:sort(int:all_breaks(ordsets1)), ok. -cleanup(doc) -> "Make sure that the auto-attach flag is turned off."; -cleanup(suite) -> []; +%% Make sure that the auto-attach flag is turned off. cleanup(Config) when list(Config) -> - ?line int:auto_attach(false), + int:auto_attach(false), ok. auto_attach(Pid) -> diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl index abb6c7e3ff..27ca4852b5 100644 --- a/lib/debugger/test/int_eval_SUITE.erl +++ b/lib/debugger/test/int_eval_SUITE.erl @@ -64,19 +64,16 @@ end_per_group(_GroupName, Config) -> init_per_testcase(_Case, Config) -> - ?line DataDir = ?config(data_dir, Config), - ?line {module,?IM} = int:i(filename:join(DataDir, ?IM)), - ?line ok = io:format("Interpreted modules: ~p",[int:interpreted()]), + DataDir = proplists:get_value(data_dir, Config), + {module,?IM} = int:i(filename:join(DataDir, ?IM)), + ok = io:format("Interpreted modules: ~p",[int:interpreted()]), Config. end_per_testcase(_Case, _Config) -> ok = io:format("Interpreted modules: ~p", [int:interpreted()]), ok. -bifs_outside_erlang(doc) -> - "Test that BIFs outside the erlang module are correctly evaluated."; -bifs_outside_erlang(suite) -> - []; +%% Test that BIFs outside the erlang module are correctly evaluated. bifs_outside_erlang(Config) when is_list(Config) -> Fun = fun() -> Id = ?IM:ets_new(), @@ -87,164 +84,145 @@ bifs_outside_erlang(Config) when is_list(Config) -> ?IM:ets_delete(Id), ok end, - ?line ok = spawn_eval(Fun), + ok = spawn_eval(Fun), ok. -spawning(doc) -> - "Try evalutate spawn_link/3."; -spawning(suite) -> - []; +%% Try evalutate spawn_link/3. spawning(Config) when is_list(Config) -> - ?line ok = spawn_eval(fun() -> ?IM:spawn_test() end). + ok = spawn_eval(fun() -> ?IM:spawn_test() end). -applying(doc) -> - "Try various sorts of applies."; -applying(suite) -> - []; +%% Try various sorts of applies. applying(Config) when is_list(Config) -> Fun = fun({number,X}, {number,Y}) -> X+Y end, - ?line ok = spawn_eval(fun() -> ?IM:apply_test(Fun) end). + ok = spawn_eval(fun() -> ?IM:apply_test(Fun) end). -catch_and_throw(doc) -> - "Test catch and throw/1."; -catch_and_throw(suite) -> - []; +%% Test catch and throw/1. catch_and_throw(Config) when is_list(Config) -> - {a,ball} = spawn_eval(fun() -> ok = ?IM:catch_a_ball(), - catch ?IM:throw_a_ball() end), - - %% Throw and catch without any extra outer catch. - - ?line process_flag(trap_exit, true), - ?line Pid1 = spawn_link(fun() -> exit(?IM:catch_a_ball()) end), - receive - {'EXIT',Pid1,ok} -> ok; - {'EXIT',Pid1,Bad1} -> ?line ?t:fail({bad_message,Bad1}) - after 5000 -> - ?line ?t:fail(timeout) - end, + {a,ball} = spawn_eval(fun() -> ok = ?IM:catch_a_ball(), + catch ?IM:throw_a_ball() end), + + %% Throw and catch without any extra outer catch. + + process_flag(trap_exit, true), + Pid1 = spawn_link(fun() -> exit(?IM:catch_a_ball()) end), + receive + {'EXIT',Pid1,ok} -> ok; + {'EXIT',Pid1,Bad1} -> ct:fail({bad_message,Bad1}) + after 5000 -> + ct:fail(timeout) + end, - %% Throw without catch. + %% Throw without catch. - ?line Pid2 = spawn_link(fun() -> ?IM:throw_a_ball() end), - receive - {'EXIT',Pid2,{{nocatch,{a,ball}},[_|_]}} -> ok; - {'EXIT',Pid2,Bad2} -> ?line ?t:fail({bad_message,Bad2}) - after 5000 -> - ?line ?t:fail(timeout) - end, + Pid2 = spawn_link(fun() -> ?IM:throw_a_ball() end), + receive + {'EXIT',Pid2,{{nocatch,{a,ball}},[_|_]}} -> ok; + {'EXIT',Pid2,Bad2} -> ct:fail({bad_message,Bad2}) + after 5000 -> + ct:fail(timeout) + end, - ?line ok = ?IM:more_catch(fun(_) -> ?IM:exit_me() end), - ?line ok = ?IM:more_catch(fun(_) -> exit({unint, exit}) end), - ?line {a, ball} = ?IM:more_catch(fun(_) -> ?IM:throw_a_ball() end), - ?line {b, ball} = ?IM:more_catch(fun(_) -> throw({b,ball}) end), + ok = ?IM:more_catch(fun(_) -> ?IM:exit_me() end), + ok = ?IM:more_catch(fun(_) -> exit({unint, exit}) end), + {a, ball} = ?IM:more_catch(fun(_) -> ?IM:throw_a_ball() end), + {b, ball} = ?IM:more_catch(fun(_) -> throw({b,ball}) end), - ExitInt = {'EXIT',{int,exit}}, - ExitU = {'EXIT',{unint,exit}}, + ExitInt = {'EXIT',{int,exit}}, + ExitU = {'EXIT',{unint,exit}}, - ?line ExitInt = (catch ?IM:more_nocatch(fun(_) -> ?IM:exit_me() end)), - ?line ExitU = (catch ?IM:more_nocatch(fun(_) -> exit({unint, exit}) end)), - ?line {a, ball} = (catch {error, ?IM:more_nocatch(fun(_) -> ?IM:throw_a_ball() end)}), - ?line {b, ball} = (catch {error, ?IM:more_nocatch(fun(_) -> throw({b,ball}) end)}), - ok. + ExitInt = (catch ?IM:more_nocatch(fun(_) -> ?IM:exit_me() end)), + ExitU = (catch ?IM:more_nocatch(fun(_) -> exit({unint, exit}) end)), + {a, ball} = (catch {error, ?IM:more_nocatch(fun(_) -> ?IM:throw_a_ball() end)}), + {b, ball} = (catch {error, ?IM:more_nocatch(fun(_) -> throw({b,ball}) end)}), + ok. -external_call(doc) -> - "Test external calls."; -external_call(suite) -> - []; +%% Test external calls. external_call(Config) when is_list(Config) -> - ?line ok = spawn_eval(fun() -> ?IM:external_call_test({some,stupid,data}) end). + ok = spawn_eval(fun() -> ?IM:external_call_test({some,stupid,data}) end). -test_module_info(doc) -> - "Test the module_info/0,1 functions."; -test_module_info(suite) -> - []; +%% Test the module_info/0,1 functions. test_module_info(Config) when is_list(Config) -> - ?line ModInfo = ?IM:module_info(), - ?line {value,{exports,Exp}} = lists:keysearch(exports, 1, ModInfo), - ?line {value,{attributes,Attr}} = lists:keysearch(attributes, 1, ModInfo), - ?line Exp = ?IM:module_info(exports), - ?line Attr = ?IM:module_info(attributes), - ?line {value,{stupid_attribute,[{a,b}]}} = + ModInfo = ?IM:module_info(), + {value,{exports,Exp}} = lists:keysearch(exports, 1, ModInfo), + {value,{attributes,Attr}} = lists:keysearch(attributes, 1, ModInfo), + Exp = ?IM:module_info(exports), + Attr = ?IM:module_info(attributes), + {value,{stupid_attribute,[{a,b}]}} = lists:keysearch(stupid_attribute, 1, Attr), %% Check exports using a list comprehension in the module itself. - ?line ok = ?IM:check_exports(Exp), + ok = ?IM:check_exports(Exp), %% Call module_info/0,1 from the module itself. - ?line ok = ?IM:check_module_info(ModInfo, Exp), + ok = ?IM:check_module_info(ModInfo, Exp), ok. -apply_interpreted_fun(doc) -> - "Apply a fun defined in interpreted code."; -apply_interpreted_fun(suite) -> []; +%% Apply a fun defined in interpreted code. apply_interpreted_fun(Config) when is_list(Config) -> %% Called from uninterpreted code - ?line F1 = spawn_eval(fun() -> ?IM:give_me_a_fun_0() end), - ?line perfectly_alright = spawn_eval(fun() -> F1() end), - ?line ATerm = {a,term}, - ?line F2 = spawn_eval(fun() -> ?IM:give_me_a_fun_0(ATerm) end), - ?line {ok,ATerm} = spawn_eval(fun() -> F2() end), + F1 = spawn_eval(fun() -> ?IM:give_me_a_fun_0() end), + perfectly_alright = spawn_eval(fun() -> F1() end), + ATerm = {a,term}, + F2 = spawn_eval(fun() -> ?IM:give_me_a_fun_0(ATerm) end), + {ok,ATerm} = spawn_eval(fun() -> F2() end), %% Called from uninterpreted code, badarity - ?line {'EXIT',{{badarity,{F1,[snape]}},[{?MODULE,_,_,_}|_]}} = + {'EXIT',{{badarity,{F1,[snape]}},[{?MODULE,_,_,_}|_]}} = spawn_eval(fun() -> F1(snape) end), %% Called from uninterpreted code, error in fun - ?line F3 = spawn_eval(fun() -> ?IM:give_me_a_bad_fun() end), - ?line {'EXIT',{snape,[{?IM,_FunName,_,_}|_]}} = + F3 = spawn_eval(fun() -> ?IM:give_me_a_bad_fun() end), + {'EXIT',{snape,[{?IM,_FunName,_,_}|_]}} = spawn_eval(fun() -> F3(snape) end), %% Called from within interpreted code - ?line perfectly_alright = spawn_eval(fun() -> ?IM:do_apply(F1) end), + perfectly_alright = spawn_eval(fun() -> ?IM:do_apply(F1) end), %% Called from within interpreted code, badarity - ?line {'EXIT',{{badarity,{F1,[snape]}},[{?IM,do_apply,_,_}|_]}} = + {'EXIT',{{badarity,{F1,[snape]}},[{?IM,do_apply,_,_}|_]}} = spawn_eval(fun() -> ?IM:do_apply(F1, snape) end), %% Called from within interpreted code, error in fun - ?line {'EXIT',{snape,[{?IM,_FunName,_,_}|_]}} = + {'EXIT',{snape,[{?IM,_FunName,_,_}|_]}} = spawn_eval(fun() -> ?IM:do_apply(F3, snape) end), %% Try some more complex funs. - ?line F4 = ?IM:give_me_a_fun_1(14, 42), - ?line {false,yes,yeah,false} = + F4 = ?IM:give_me_a_fun_1(14, 42), + {false,yes,yeah,false} = F4({{1,nope},{14,yes},{42,yeah},{100,forget_it}}), - ?line [this_is_ok,me_too] = + [this_is_ok,me_too] = F4([{-24,no_way},{15,this_is_ok},{1333,forget_me},{37,me_too}]), %% OTP-5837 %% Try fun with guard containing variable bound in environment - ?line [yes,no,no,no] = ?IM:otp_5837(1), + [yes,no,no,no] = ?IM:otp_5837(1), ok. -apply_uninterpreted_fun(doc) -> - "Apply a fun defined outside interpreted code."; -apply_uninterpreted_fun(suite) -> []; +%% Apply a fun defined outside interpreted code. apply_uninterpreted_fun(Config) when is_list(Config) -> - ?line F1 = fun(snape) -> - erlang:error(snape); - (_Arg) -> - perfectly_alright - end, + F1 = fun(snape) -> + erlang:error(snape); + (_Arg) -> + perfectly_alright + end, %% Ok - ?line perfectly_alright = + perfectly_alright = spawn_eval(fun() -> ?IM:do_apply(F1, any_arg) end), %% Badarity (evaluated in dbg_debugged, which calls erlang:apply/2) - ?line {'EXIT',{{badarity,{F1,[]}},[{erlang,apply,_,_}|_]}} = + {'EXIT',{{badarity,{F1,[]}},[{erlang,apply,_,_}|_]}} = spawn_eval(fun() -> ?IM:do_apply(F1) end), %% Error in fun - ?line {'EXIT',{snape,[{?MODULE,_FunName,_,_}|_]}} = + {'EXIT',{snape,[{?MODULE,_FunName,_,_}|_]}} = spawn_eval(fun() -> ?IM:do_apply(F1, snape) end), ok. @@ -254,23 +232,22 @@ apply_uninterpreted_fun(Config) when is_list(Config) -> %% interpreted_exit(Config) when is_list(Config) -> - ?line process_flag(trap_exit, true), - ?line Reason = make_ref(), - ?line Pid = spawn_link(fun() -> ?IM:please_call_exit(Reason) end), - ?line receive - {'EXIT',Pid,Reason} -> - ok; - {'EXIT',Pid,BadReason} -> - ?line ?t:fail({bad_message,BadReason}) - after 10000 -> - ?line ?t:fail(timeout) - end, + process_flag(trap_exit, true), + Reason = make_ref(), + Pid = spawn_link(fun() -> ?IM:please_call_exit(Reason) end), + receive + {'EXIT',Pid,Reason} -> + ok; + {'EXIT',Pid,BadReason} -> + ct:fail({bad_message,BadReason}) + after 10000 -> + ct:fail(timeout) + end, ok. -otp_8310(doc) -> - "OTP-8310. Bugfixes lc/bc and andalso/orelse."; +%% OTP-8310. Bugfixes lc/bc and andalso/orelse. otp_8310(Config) when is_list(Config) -> - ?line ok = ?IM:otp_8310(), + ok = ?IM:otp_8310(), ok. applier(M, F, A) -> @@ -279,17 +256,17 @@ applier(M, F, A) -> Res. stacktrace(Config) when is_list(Config) -> - ?line {done,Stk} = do_eval(Config, stacktrace), - ?line 13 = length(Stk), - ?line OldStackTraceFlag = int:stack_trace(), - ?line int:stack_trace(no_tail), + {done,Stk} = do_eval(Config, stacktrace), + 13 = length(Stk), + OldStackTraceFlag = int:stack_trace(), + int:stack_trace(no_tail), try - ?line Res = spawn_eval(fun() -> stacktrace:stacktrace() end), - ?line io:format("\nInterpreted (no_tail):\n~p", [Res]), - ?line {done,Stk} = Res - after - ?line int:stack_trace(OldStackTraceFlag) - end, + Res = spawn_eval(fun() -> stacktrace:stacktrace() end), + io:format("\nInterpreted (no_tail):\n~p", [Res]), + {done,Stk} = Res + after + int:stack_trace(OldStackTraceFlag) + end, ok. maps(Config) when is_list(Config) -> @@ -300,20 +277,20 @@ maps(Config) when is_list(Config) -> do_eval(Config, Mod) -> - ?line DataDir = ?config(data_dir, Config), - ?line ok = file:set_cwd(DataDir), + DataDir = proplists:get_value(data_dir, Config), + ok = file:set_cwd(DataDir), - ?line {ok,Mod} = compile:file(Mod, [report,debug_info]), - ?line {module,Mod} = code:load_file(Mod), - ?line CompiledRes = Mod:Mod(), - ?line ok = io:format("Compiled:\n~p", [CompiledRes]), + {ok,Mod} = compile:file(Mod, [report,debug_info]), + {module,Mod} = code:load_file(Mod), + CompiledRes = Mod:Mod(), + ok = io:format("Compiled:\n~p", [CompiledRes]), io:nl(), - ?line {module,Mod} = int:i(Mod), - ?line IntRes = Mod:Mod(), - ?line ok = io:format("Interpreted:\n~p", [IntRes]), + {module,Mod} = int:i(Mod), + IntRes = Mod:Mod(), + ok = io:format("Interpreted:\n~p", [IntRes]), - ?line CompiledRes = IntRes. + CompiledRes = IntRes. %% %% Evaluate in another process, to prevent the test_case process to become diff --git a/lib/debugger/test/lc_SUITE.erl b/lib/debugger/test/lc_SUITE.erl index c88486c056..28415b412b 100644 --- a/lib/debugger/test/lc_SUITE.erl +++ b/lib/debugger/test/lc_SUITE.erl @@ -30,7 +30,9 @@ -include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> [basic, deeply_nested, no_generator, empty_generator]. @@ -46,53 +48,50 @@ end_per_group(_GroupName, Config) -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(1)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> ok. basic(Config) when is_list(Config) -> - ?line L0 = lists:seq(1, 10), - ?line L1 = my_map(fun(X) -> {x,X} end, L0), - ?line L1 = [{x,X} || X <- L0], - ?line L0 = my_map(fun({x,X}) -> X end, L1), - ?line [1,2,3,4,5] = [X || X <- L0, X < 6], - ?line [4,5,6] = [X || X <- L0, X > 3, X < 7], - ?line [] = [X || X <- L0, X > 32, X < 7], - ?line [1,3,5,7,9] = [X || X <- L0, odd(X)], - ?line [2,4,6,8,10] = [X || X <- L0, not odd(X)], - ?line [1,3,5,9] = [X || X <- L0, odd(X), X =/= 7], - ?line [2,4,8,10] = [X || X <- L0, not odd(X), X =/= 6], + L0 = lists:seq(1, 10), + L1 = my_map(fun(X) -> {x,X} end, L0), + L1 = [{x,X} || X <- L0], + L0 = my_map(fun({x,X}) -> X end, L1), + [1,2,3,4,5] = [X || X <- L0, X < 6], + [4,5,6] = [X || X <- L0, X > 3, X < 7], + [] = [X || X <- L0, X > 32, X < 7], + [1,3,5,7,9] = [X || X <- L0, odd(X)], + [2,4,6,8,10] = [X || X <- L0, not odd(X)], + [1,3,5,9] = [X || X <- L0, odd(X), X =/= 7], + [2,4,8,10] = [X || X <- L0, not odd(X), X =/= 6], %% Append is specially handled. - ?line [1,3,5,9,2,4,8,10] = [X || X <- L0, odd(X), X =/= 7] ++ + [1,3,5,9,2,4,8,10] = [X || X <- L0, odd(X), X =/= 7] ++ [X || X <- L0, not odd(X), X =/= 6], %% Guards BIFs are evaluated in guard context. Weird, but true. - ?line [{a,b,true},{x,y,true,true}] = [X || X <- tuple_list(), element(3, X)], + [{a,b,true},{x,y,true,true}] = [X || X <- tuple_list(), element(3, X)], %% Filter expressions with andalso/orelse. - ?line "abc123" = alphanum("?abc123.;"), + "abc123" = alphanum("?abc123.;"), %% Error cases. - ?line [] = [{xx,X} || X <- L0, element(2, X) == no_no_no], - ?line {'EXIT',_} = (catch [X || X <- L1, list_to_atom(X) == dum]), - ?line [] = [X || X <- L1, X+1 < 2], - ?line {'EXIT',_} = (catch [X || X <- L1, odd(X)]), + [] = [{xx,X} || X <- L0, element(2, X) == no_no_no], + {'EXIT',_} = (catch [X || X <- L1, list_to_atom(X) == dum]), + [] = [X || X <- L1, X+1 < 2], + {'EXIT',_} = (catch [X || X <- L1, odd(X)]), %% A bad generator has a different exception compared to BEAM. - ?line {'EXIT',{{bad_generator,x},_}} = (catch [E || E <- id(x)]), + {'EXIT',{{bad_generator,x},_}} = (catch [E || E <- id(x)]), ok. tuple_list() -> @@ -122,12 +121,12 @@ deeply_nested_1() -> X16 <- [4],X17 <- [3],X18 <- [fun() -> X16+X17 end],X19 <- [2],X20 <- [1]]. no_generator(Config) when is_list(Config) -> - ?line Seq = lists:seq(-10, 17), - ?line [no_gen_verify(no_gen(A, B), A, B) || A <- Seq, B <- Seq], + Seq = lists:seq(-10, 17), + [no_gen_verify(no_gen(A, B), A, B) || A <- Seq, B <- Seq], %% Literal expression, for coverage. - ?line [a] = [a || true], - ?line [a,b,c] = [a || true] ++ [b,c], + [a] = [a || true], + [a,b,c] = [a || true] ++ [b,c], ok. no_gen(A, B) -> @@ -168,7 +167,7 @@ no_gen_verify(Res, A, B) -> ShouldBe -> ok; _ -> io:format("A = ~p; B = ~p; Expected = ~p, actual = ~p", [A,B,ShouldBe,Res]), - ?t:fail() + ct:fail(failed) end. no_gen_eval(Fun, Res) -> @@ -180,7 +179,7 @@ no_gen_eval(Fun, Res) -> no_gen_one_more(A, B) -> A + 1 =:= B. empty_generator(Config) when is_list(Config) -> - ?line [] = [X || {X} <- [], (false or (X/0 > 3))], + [] = [X || {X} <- [], (false or (X/0 > 3))], ok. id(I) -> I. diff --git a/lib/debugger/test/line_number_SUITE.erl b/lib/debugger/test/line_number_SUITE.erl index f1a1988104..276473b95f 100644 --- a/lib/debugger/test/line_number_SUITE.erl +++ b/lib/debugger/test/line_number_SUITE.erl @@ -28,7 +28,9 @@ -include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> cases(). @@ -47,17 +49,14 @@ cases() -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(1)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> @@ -66,6 +65,7 @@ end_per_suite(Config) when is_list(Config) -> + %% %% === Make sure that this is always line 70 === %% diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl index eabcdcbf42..42484ff723 100644 --- a/lib/debugger/test/map_SUITE.erl +++ b/lib/debugger/test/map_SUITE.erl @@ -191,8 +191,8 @@ t_build_and_match_literals(Config) when is_list(Config) -> id(#{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}), %% error case - %V = 32, - %{'EXIT',{{badmatch,_},_}} = (catch (#{<<"hi all">> => 1} = id(#{<<"hi",V,"all">> => 1}))), + %% V = 32, + %%{'EXIT',{{badmatch,_},_}} = (catch (#{<<"hi all">> => 1} = id(#{<<"hi",V,"all">> => 1}))), {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))), {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = id(#{x=>3}))), {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))), @@ -201,7 +201,7 @@ t_build_and_match_literals(Config) when is_list(Config) -> ok. t_build_and_match_literals_large(Config) when is_list(Config) -> - % normal non-repeating + %% normal non-repeating M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", @@ -229,7 +229,7 @@ t_build_and_match_literals_large(Config) when is_list(Config) -> 60 = map_size(M0), 60 = maps:size(M0), - % with repeating + %% with repeating M1 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", @@ -265,7 +265,7 @@ t_build_and_match_literals_large(Config) when is_list(Config) -> 60 = map_size(M1), 60 = maps:size(M1), - % with floats + %% with floats M2 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", @@ -318,7 +318,7 @@ t_build_and_match_literals_large(Config) when is_list(Config) -> 90 = map_size(M2), 90 = maps:size(M2), - % with bignums + %% with bignums M3 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", @@ -501,7 +501,7 @@ t_build_and_match_literals_large(Config) when is_list(Config) -> 95 = map_size(M4), 95 = maps:size(M4), - % call for value + %% call for value M5 = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10", 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11", @@ -681,7 +681,7 @@ t_map_size(Config) when is_list(Config) -> map_is_size(M,N) when map_size(M) =:= N -> true; map_is_size(_,_) -> false. -% test map updates without matching +%% test map updates without matching t_update_literals(Config) when is_list(Config) -> Map = #{x=>1,y=>2,z=>3,q=>4}, #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ @@ -751,7 +751,7 @@ loop_update_literals_x_q(Map, []) -> Map; loop_update_literals_x_q(Map, [{X,Q}|Vs]) -> loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs). -% test map updates with matching +%% test map updates with matching t_match_and_update_literals(Config) when is_list(Config) -> Map = #{ x=>0,y=>"untouched",z=>"also untouched",q=>1, #{ "one" => small, map => key } => "small map key 1" }, @@ -1413,7 +1413,7 @@ t_guard_fun(Config) when is_list(Config) -> t_map_sort_literals(Config) when is_list(Config) -> - % test relation + %% test relation %% size order true = #{ a => 1, b => 2} < id(#{ a => 1, b => 1, c => 1}), @@ -1983,10 +1983,10 @@ t_ets(_Config) -> [] = ets:select(Tid,[{{'$1','_'},[{'==','$1',#{ b => c }}],['$_']}]), %% Test match with map of different size - %[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => c },'_'},[],['$_']}]), + %%[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => c },'_'},[],['$_']}]), %%% Test match with don't care value - %[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => '_' },'_'},[],['$_']}]), + %%[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => '_' },'_'},[],['$_']}]), %% Test is_map bif 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), @@ -2138,13 +2138,13 @@ t_update_exact_variables(Config) when is_list(Config) -> t_nested_pattern_expressions(Config) when is_list(Config) -> K1 = id("hello"), - %K2 = id({ok}), + %% 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}]), + %%[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) -> @@ -2335,7 +2335,7 @@ t_build_and_match_empty_val(Config) when is_list(Config) -> {'EXIT',{function_clause,_}} -> ok; {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; Other -> - test_server:fail({no_match, Other}) + ct:fail({no_match, Other}) end. t_build_and_match_val(Config) when is_list(Config) -> @@ -2353,7 +2353,7 @@ t_build_and_match_val(Config) when is_list(Config) -> {'EXIT',{function_clause,_}} -> ok; {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; Other -> - test_server:fail({no_match, Other}) + ct:fail({no_match, Other}) end. t_build_and_match_nil(Config) when is_list(Config) -> diff --git a/lib/debugger/test/record_SUITE.erl b/lib/debugger/test/record_SUITE.erl index b1d9bece58..0edb3786be 100644 --- a/lib/debugger/test/record_SUITE.erl +++ b/lib/debugger/test/record_SUITE.erl @@ -30,7 +30,9 @@ init_per_suite/1,end_per_suite/1, errors/1,record_test/1,eval_once/1]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> cases(). @@ -50,17 +52,14 @@ cases() -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(1)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> @@ -72,19 +71,19 @@ end_per_suite(Config) when is_list(Config) -> errors(Config) when is_list(Config) -> Foo = #foo{a=1,b=2,c=3,d=4}, - ?line #foo{a=19,b=42,c=3,d=4} = update_foo(Foo, 19, 42), + #foo{a=19,b=42,c=3,d=4} = update_foo(Foo, 19, 42), - ?line {'EXIT',{{badrecord,bar},_}} = (catch update_foo_bar(Foo, 19)), - ?line {'EXIT',{{badrecord,bar},_}} = (catch update_foo_bar(Foo, 19, 35)), - ?line {'EXIT',{{badrecord,bar},_}} = (catch update_foo_bar(Foo, 19, 35, 17)), - ?line {'EXIT',{{badrecord,bar},_}} = (catch update_foo_bar(Foo, 19, 35, 17, 42)), + {'EXIT',{{badrecord,bar},_}} = (catch update_foo_bar(Foo, 19)), + {'EXIT',{{badrecord,bar},_}} = (catch update_foo_bar(Foo, 19, 35)), + {'EXIT',{{badrecord,bar},_}} = (catch update_foo_bar(Foo, 19, 35, 17)), + {'EXIT',{{badrecord,bar},_}} = (catch update_foo_bar(Foo, 19, 35, 17, 42)), - ?line {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19)), - ?line {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19, 35)), - ?line {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19, 35, 17)), - ?line {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19, 35, 17, 42)), - ?line {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19, - 35, 17, 42, -2)), + {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19)), + {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19, 35)), + {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19, 35, 17)), + {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19, 35, 17, 42)), + {'EXIT',{{badrecord,barf},_}} = (catch update_foo_barf(Foo, 19, + 35, 17, 42, -2)), ok. @@ -119,134 +118,134 @@ update_foo_barf(#foo{}=R, A, _B, C, D, E) -> R#barf{a=A,b=A,c=C,d=D,e=E}. --define(TrueGuard(Expr), if Expr -> ok; true -> ?t:fail() end). --define(FalseGuard(Expr), if Expr -> ?t:fail(); true -> ok end). +-define(TrueGuard(Expr), if Expr -> ok; true -> ct:fail(failed) end). +-define(FalseGuard(Expr), if Expr -> ct:fail(failed); true -> ok end). record_test(Config) when is_list(Config) -> - ?line true = is_record(#foo{}, foo), - ?line false = is_record(#foo{}, barf), - ?line false = is_record({foo}, foo), + true = is_record(#foo{}, foo), + false = is_record(#foo{}, barf), + false = is_record({foo}, foo), - ?line true = erlang:is_record(#foo{}, foo), - ?line false = erlang:is_record(#foo{}, barf), - ?line false = erlang:is_record({foo}, foo), + true = erlang:is_record(#foo{}, foo), + false = erlang:is_record(#foo{}, barf), + false = erlang:is_record({foo}, foo), - ?line false = is_record([], foo), - ?line false = is_record(Config, foo), + false = is_record([], foo), + false = is_record(Config, foo), - ?line ?TrueGuard(is_record(#foo{}, foo)), - ?line ?FalseGuard(is_record(#foo{}, barf)), - ?line ?FalseGuard(is_record({foo}, foo)), + ?TrueGuard(is_record(#foo{}, foo)), + ?FalseGuard(is_record(#foo{}, barf)), + ?FalseGuard(is_record({foo}, foo)), - ?line ?TrueGuard(erlang:is_record(#foo{}, foo)), - ?line ?FalseGuard(erlang:is_record(#foo{}, barf)), - ?line ?FalseGuard(erlang:is_record({foo}, foo)), + ?TrueGuard(erlang:is_record(#foo{}, foo)), + ?FalseGuard(erlang:is_record(#foo{}, barf)), + ?FalseGuard(erlang:is_record({foo}, foo)), - ?line ?FalseGuard(is_record([], foo)), - ?line ?FalseGuard(is_record(Config, foo)), + ?FalseGuard(is_record([], foo)), + ?FalseGuard(is_record(Config, foo)), %% 'not is_record/2' to test guard optimization. - ?line ?FalseGuard(not is_record(#foo{}, foo)), - ?line ?TrueGuard(not is_record(#foo{}, barf)), - ?line ?TrueGuard(not is_record({foo}, foo)), + ?FalseGuard(not is_record(#foo{}, foo)), + ?TrueGuard(not is_record(#foo{}, barf)), + ?TrueGuard(not is_record({foo}, foo)), - ?line ?FalseGuard(not erlang:is_record(#foo{}, foo)), - ?line ?TrueGuard(not erlang:is_record(#foo{}, barf)), - ?line ?TrueGuard(not erlang:is_record({foo}, foo)), + ?FalseGuard(not erlang:is_record(#foo{}, foo)), + ?TrueGuard(not erlang:is_record(#foo{}, barf)), + ?TrueGuard(not erlang:is_record({foo}, foo)), Foo = id(#foo{}), - ?line ?FalseGuard(not erlang:is_record(Foo, foo)), - ?line ?TrueGuard(not erlang:is_record(Foo, barf)), + ?FalseGuard(not erlang:is_record(Foo, foo)), + ?TrueGuard(not erlang:is_record(Foo, barf)), - ?line ?TrueGuard(not is_record(Config, foo)), + ?TrueGuard(not is_record(Config, foo)), - ?line ?TrueGuard(not is_record(a, foo)), - ?line ?TrueGuard(not is_record([], foo)), + ?TrueGuard(not is_record(a, foo)), + ?TrueGuard(not is_record([], foo)), %% Pass non-literal first argument. - ?line true = is_record(id(#foo{}), foo), - ?line false = is_record(id(#foo{}), barf), - ?line false = is_record(id({foo}), foo), + true = is_record(id(#foo{}), foo), + false = is_record(id(#foo{}), barf), + false = is_record(id({foo}), foo), - ?line true = erlang:is_record(id(#foo{}), foo), - ?line false = erlang:is_record(id(#foo{}), barf), - ?line false = erlang:is_record(id({foo}), foo), + true = erlang:is_record(id(#foo{}), foo), + false = erlang:is_record(id(#foo{}), barf), + false = erlang:is_record(id({foo}), foo), NoRec1 = id(blurf), NoRec2 = id([]), - ?line ?TrueGuard(not is_record(NoRec1, foo)), - ?line ?TrueGuard(not is_record(NoRec2, foo)), + ?TrueGuard(not is_record(NoRec1, foo)), + ?TrueGuard(not is_record(NoRec2, foo)), %% Force the use of guard bifs by using the 'xor' operation. False = id(false), - ?line ?TrueGuard(is_record(#foo{}, foo) xor False), - ?line ?FalseGuard(is_record(#foo{}, barf) xor False), - ?line ?FalseGuard(is_record({foo}, foo) xor False ), + ?TrueGuard(is_record(#foo{}, foo) xor False), + ?FalseGuard(is_record(#foo{}, barf) xor False), + ?FalseGuard(is_record({foo}, foo) xor False ), - ?line ?TrueGuard(is_record(Foo, foo) xor False), - ?line ?FalseGuard(is_record(Foo, barf) xor False), + ?TrueGuard(is_record(Foo, foo) xor False), + ?FalseGuard(is_record(Foo, barf) xor False), %% Implicit guards by using a list comprehension. List = id([1,#foo{a=2},3,#bar{d=4},5,#foo{a=6},7]), - ?line [#foo{a=2},#foo{a=6}] = [X || X <- List, is_record(X, foo)], - ?line [#bar{d=4}] = [X || X <- List, is_record(X, bar)], - ?line [1,#foo{a=2},3,5,#foo{a=6},7] = + [#foo{a=2},#foo{a=6}] = [X || X <- List, is_record(X, foo)], + [#bar{d=4}] = [X || X <- List, is_record(X, bar)], + [1,#foo{a=2},3,5,#foo{a=6},7] = [X || X <- List, not is_record(X, bar)], - ?line [1,3,5,7] = + [1,3,5,7] = [X || X <- List, ((not is_record(X, bar)) and (not is_record(X, foo)))], - ?line [#foo{a=2},#bar{d=4},#foo{a=6}] = + [#foo{a=2},#bar{d=4},#foo{a=6}] = [X || X <- List, ((is_record(X, bar)) or (is_record(X, foo)))], - ?line [1,3,#bar{d=4}] = + [1,3,#bar{d=4}] = [X || X <- List, ((is_record(X, bar)) or (X < 5))], - ?line MyList = [#foo{a=3},x,[],{a,b}], - ?line [#foo{a=3}] = [X || X <- MyList, is_record(X, foo)], - ?line [x,[],{a,b}] = [X || X <- MyList, not is_record(X, foo)], - ?line [#foo{a=3}] = [X || X <- MyList, begin is_record(X, foo) end], - ?line [x,[],{a,b}] = [X || X <- MyList, begin not is_record(X, foo) end], - ?line [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, is_record(X, foo) or - not is_binary(X)], - ?line [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, not is_record(X, foo) or - not is_binary(X)], - ?line [#foo{a=3}] = [X || X <- MyList, is_record(X, foo) or is_reference(X)], - ?line [x,[],{a,b}] = [X || X <- MyList, not is_record(X, foo) or - is_reference(X)], - ?line [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, - begin is_record(X, foo) or - not is_binary(X) end], - ?line [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, - begin not is_record(X, foo) or - not is_binary(X) end], - ?line [#foo{a=3}] = [X || X <- MyList, - begin is_record(X, foo) or is_reference(X) end], - ?line [x,[],{a,b}] = [X || X <- MyList, - begin not is_record(X, foo) or - is_reference(X) end], + MyList = [#foo{a=3},x,[],{a,b}], + [#foo{a=3}] = [X || X <- MyList, is_record(X, foo)], + [x,[],{a,b}] = [X || X <- MyList, not is_record(X, foo)], + [#foo{a=3}] = [X || X <- MyList, begin is_record(X, foo) end], + [x,[],{a,b}] = [X || X <- MyList, begin not is_record(X, foo) end], + [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, is_record(X, foo) or + not is_binary(X)], + [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, not is_record(X, foo) or + not is_binary(X)], + [#foo{a=3}] = [X || X <- MyList, is_record(X, foo) or is_reference(X)], + [x,[],{a,b}] = [X || X <- MyList, not is_record(X, foo) or + is_reference(X)], + [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, + begin is_record(X, foo) or + not is_binary(X) end], + [#foo{a=3},x,[],{a,b}] = [X || X <- MyList, + begin not is_record(X, foo) or + not is_binary(X) end], + [#foo{a=3}] = [X || X <- MyList, + begin is_record(X, foo) or is_reference(X) end], + [x,[],{a,b}] = [X || X <- MyList, + begin not is_record(X, foo) or + is_reference(X) end], ok. eval_once(Config) when is_list(Config) -> - ?line once(fun(GetRec) -> - true = erlang:is_record(GetRec(), foo) - end, #foo{}), - ?line once(fun(GetRec) -> - (GetRec())#foo{a=1} - end, #foo{}), - ?line once(fun(GetRec) -> - (GetRec())#foo{a=1,b=2} - end, #foo{}), - ?line once(fun(GetRec) -> - (GetRec())#foo{a=1,b=2,c=3} - end, #foo{}), - ?line once(fun(GetRec) -> - (GetRec())#foo{a=1,b=2,c=3,d=4} - end, #foo{}), + once(fun(GetRec) -> + true = erlang:is_record(GetRec(), foo) + end, #foo{}), + once(fun(GetRec) -> + (GetRec())#foo{a=1} + end, #foo{}), + once(fun(GetRec) -> + (GetRec())#foo{a=1,b=2} + end, #foo{}), + once(fun(GetRec) -> + (GetRec())#foo{a=1,b=2,c=3} + end, #foo{}), + once(fun(GetRec) -> + (GetRec())#foo{a=1,b=2,c=3,d=4} + end, #foo{}), ok. once(Test, Record) -> @@ -260,7 +259,7 @@ once(Test, Record) -> 1 -> ok; N -> io:format("Evaluated ~w times\n", [N]), - ?t:fail() + ct:fail(failed) end, Result. diff --git a/lib/debugger/test/trycatch_SUITE.erl b/lib/debugger/test/trycatch_SUITE.erl index f5e0f62cf0..2857cac9a3 100644 --- a/lib/debugger/test/trycatch_SUITE.erl +++ b/lib/debugger/test/trycatch_SUITE.erl @@ -30,7 +30,9 @@ -include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. all() -> cases(). @@ -52,49 +54,46 @@ cases() -> init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), - Dog = test_server:timetrap(?t:minutes(1)), - [{watchdog,Dog}|Config]. + Config. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), Config. end_per_suite(Config) when is_list(Config) -> ok. basic(Conf) when is_list(Conf) -> - ?line 2 = + 2 = try my_div(4, 2) catch Class:Reason -> {Class,Reason} end, - ?line error = + error = try my_div(1, 0) catch error:badarith -> error end, - ?line error = + error = try 1/0 catch error:badarith -> error end, - ?line ok = + ok = try my_add(53, atom) catch error:badarith -> ok end, - ?line exit_nisse = + exit_nisse = try exit(nisse) catch exit:nisse -> exit_nisse end, - ?line ok = + ok = try throw(kalle) catch kalle -> ok @@ -103,26 +102,26 @@ basic(Conf) when is_list(Conf) -> %% Try some stuff where the compiler will optimize away the try. V = id({a,variable}), - ?line V = try V catch nisse -> error end, - ?line 42 = try 42 catch nisse -> error end, - ?line [V] = try [V] catch nisse -> error end, - ?line {ok,V} = try {ok,V} catch nisse -> error end, + V = try V catch nisse -> error end, + 42 = try 42 catch nisse -> error end, + [V] = try [V] catch nisse -> error end, + {ok,V} = try {ok,V} catch nisse -> error end, %% Same idea, but use an after too. - ?line V = try V catch nisse -> error after after_call() end, - ?line after_clean(), - ?line 42 = try 42 after after_call() end, - ?line after_clean(), - ?line [V] = try [V] catch nisse -> error after after_call() end, - ?line after_clean(), - ?line {ok,V} = try {ok,V} after after_call() end, + V = try V catch nisse -> error after after_call() end, + after_clean(), + 42 = try 42 after after_call() end, + after_clean(), + [V] = try [V] catch nisse -> error after after_call() end, + after_clean(), + {ok,V} = try {ok,V} after after_call() end, %% Try/of - ?line ok = try V of - {a,variable} -> ok - catch nisse -> erro - end, + ok = try V of + {a,variable} -> ok + catch nisse -> erro + end, ok. @@ -133,24 +132,24 @@ after_clean() -> after_was_called = erase(basic). lean_throw(Conf) when is_list(Conf) -> - ?line {throw,kalle} = + {throw,kalle} = try throw(kalle) catch Kalle -> {throw,Kalle} end, - ?line {exit,kalle} = + {exit,kalle} = try exit(kalle) catch Throw1 -> {throw,Throw1}; exit:Reason1 -> {exit,Reason1} end, - ?line {exit,kalle} = + {exit,kalle} = try exit(kalle) catch exit:Reason2 -> {exit,Reason2}; Throw2 -> {throw,Throw2} end, - ?line {exit,kalle} = + {exit,kalle} = try try exit(kalle) catch Throw3 -> {throw,Throw3} @@ -161,25 +160,25 @@ lean_throw(Conf) when is_list(Conf) -> ok. try_of(Conf) when is_list(Conf) -> - ?line {ok,{some,content}} = + {ok,{some,content}} = try_of_1({value,{good,{some,content}}}), - ?line {error,[other,content]} = + {error,[other,content]} = try_of_1({value,{bad,[other,content]}}), - ?line {caught,{exit,{ex,it,[reason]}}} = + {caught,{exit,{ex,it,[reason]}}} = try_of_1({exit,{ex,it,[reason]}}), - ?line {caught,{throw,[term,{in,a,{tuple}}]}} = + {caught,{throw,[term,{in,a,{tuple}}]}} = try_of_1({throw,[term,{in,a,{tuple}}]}), - ?line {caught,{error,[bad,arg]}} = + {caught,{error,[bad,arg]}} = try_of_1({error,[bad,arg]}), - ?line {caught,{error,badarith}} = + {caught,{error,badarith}} = try_of_1({'div',{1,0}}), - ?line {caught,{error,badarith}} = + {caught,{error,badarith}} = try_of_1({'add',{a,0}}), - ?line {caught,{error,badarg}} = + {caught,{error,badarg}} = try_of_1({'abs',x}), - ?line {caught,{error,function_clause}} = + {caught,{error,function_clause}} = try_of_1(illegal), - ?line {error,{try_clause,{some,other_garbage}}} = + {error,{try_clause,{some,other_garbage}}} = try try_of_1({value,{some,other_garbage}}) catch error:Reason -> {error,Reason} end, @@ -191,33 +190,33 @@ try_of_1(X) -> {bad,Y} -> {error,Y} catch Class:Reason -> - {caught,{Class,Reason}} + {caught,{Class,Reason}} end. try_after(Conf) when is_list(Conf) -> - ?line {{ok,[some,value],undefined},finalized} = + {{ok,[some,value],undefined},finalized} = try_after_1({value,{ok,[some,value]}},finalized), - ?line {{error,badarith,undefined},finalized} = + {{error,badarith,undefined},finalized} = try_after_1({'div',{1,0}},finalized), - ?line {{error,badarith,undefined},finalized} = + {{error,badarith,undefined},finalized} = try_after_1({'add',{1,a}},finalized), - ?line {{error,badarg,undefined},finalized} = + {{error,badarg,undefined},finalized} = try_after_1({'abs',a},finalized), - ?line {{error,[the,{reason}],undefined},finalized} = + {{error,[the,{reason}],undefined},finalized} = try_after_1({error,[the,{reason}]},finalized), - ?line {{throw,{thrown,[reason]},undefined},finalized} = + {{throw,{thrown,[reason]},undefined},finalized} = try_after_1({throw,{thrown,[reason]}},finalized), - ?line {{exit,{exited,{reason}},undefined},finalized} = + {{exit,{exited,{reason}},undefined},finalized} = try_after_1({exit,{exited,{reason}}},finalized), - ?line {{error,function_clause,undefined},finalized} = + {{error,function_clause,undefined},finalized} = try_after_1(function_clause,finalized), - ?line ok = + ok = try try_after_1({'add',{1,1}}, finalized) catch error:{try_clause,2} -> ok end, - ?line finalized = erase(try_after), - ?line ok = + finalized = erase(try_after), + ok = try try foo({exit,[reaso,{n}]}) after put(try_after, finalized) end @@ -244,7 +243,7 @@ try_after_1(X, Y) -> after_bind(Conf) when is_list(Conf) -> V = [make_ref(),self()|value], - ?line {value,{value,V}} = + {value,{value,V}} = after_bind_1({value,V}, V, {value,V}), ok. @@ -268,35 +267,35 @@ after_bind_1(X, V, Y) -> -endif. catch_oops(Conf) when is_list(Conf) -> - V = {v,[a,l|u],{e},self()}, - ?line {value,V} = catch_oops_1({value,V}), - ?line {value,1} = catch_oops_1({'div',{1,1}}), - ?line {error,badarith} = catch_oops_1({'div',{1,0}}), - ?line {error,function_clause} = catch_oops_1(function_clause), - ?line {throw,V} = catch_oops_1({throw,V}), - ?line {exit,V} = catch_oops_1({exit,V}), - ok. + V = {v,[a,l|u],{e},self()}, + {value,V} = catch_oops_1({value,V}), + {value,1} = catch_oops_1({'div',{1,1}}), + {error,badarith} = catch_oops_1({'div',{1,0}}), + {error,function_clause} = catch_oops_1(function_clause), + {throw,V} = catch_oops_1({throw,V}), + {exit,V} = catch_oops_1({exit,V}), + ok. catch_oops_1(X) -> - Ref = make_ref(), - try try foo({error,Ref}) - catch - error:Ref -> - foo(X) - end of - Value -> {value,Value} - catch - Class:Data -> {Class,Data} - end. + Ref = make_ref(), + try try foo({error,Ref}) + catch + error:Ref -> + foo(X) + end of + Value -> {value,Value} + catch + Class:Data -> {Class,Data} + end. after_oops(Conf) when is_list(Conf) -> V = {self(),make_ref()}, - ?line {{value,V},V} = after_oops_1({value,V}, {value,V}), - ?line {{exit,V},V} = after_oops_1({exit,V}, {value,V}), - ?line {{error,V},undefined} = after_oops_1({value,V}, {error,V}), - ?line {{error,function_clause},undefined} = + {{value,V},V} = after_oops_1({value,V}, {value,V}), + {{exit,V},V} = after_oops_1({exit,V}, {value,V}), + {{error,V},undefined} = after_oops_1({value,V}, {error,V}), + {{error,function_clause},undefined} = after_oops_1({exit,V}, function_clause), ok. @@ -317,37 +316,37 @@ after_oops_1(X, Y) -> eclectic(Conf) when is_list(Conf) -> V = {make_ref(),3.1415926535,[[]|{}]}, - ?line {{value,{value,V},V},V} = + {{value,{value,V},V},V} = eclectic_1({foo,{value,{value,V}}}, undefined, {value,V}), - ?line {{'EXIT',{V,[{?MODULE,foo,_,_}|_]}},V} = + {{'EXIT',{V,[{?MODULE,foo,_,_}|_]}},V} = eclectic_1({catch_foo,{error,V}}, undefined, {value,V}), - ?line {{error,{exit,V},{'EXIT',V}},V} = + {{error,{exit,V},{'EXIT',V}},V} = eclectic_1({foo,{error,{exit,V}}}, error, {value,V}), - ?line {{value,{value,V},V},{'EXIT',{badarith,[{?MODULE,my_add,_,_}|_]}}} = + {{value,{value,V},V},{'EXIT',{badarith,[{?MODULE,my_add,_,_}|_]}}} = eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}), - ?line {{'EXIT',V},V} = + {{'EXIT',V},V} = eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}), - ?line {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,_,_}|_]}}}, - {'EXIT',V}} = + {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,_,_}|_]}}}, + {'EXIT',V}} = eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}), - ?line {{{error,V},{'EXIT',{V,[{?MODULE,foo,_,_}|_]}}},{'EXIT',V}} = + {{{error,V},{'EXIT',{V,[{?MODULE,foo,_,_}|_]}}},{'EXIT',V}} = eclectic_1({catch_foo,{throw,{error,V}}}, undefined, {exit,V}), %% - ?line {{value,{value,{value,V},V}},V} = + {{value,{value,{value,V},V}},V} = eclectic_2({value,{value,V}}, undefined, {value,V}), - ?line {{value,{throw,{value,V},V}},V} = + {{value,{throw,{value,V},V}},V} = eclectic_2({throw,{value,V}}, throw, {value,V}), - ?line {{caught,{'EXIT',V}},undefined} = + {{caught,{'EXIT',V}},undefined} = eclectic_2({value,{value,V}}, undefined, {exit,V}), - ?line {{caught,{'EXIT',{V,[{?MODULE,foo,_,_}|_]}}},undefined} = + {{caught,{'EXIT',{V,[{?MODULE,foo,_,_}|_]}}},undefined} = eclectic_2({error,{value,V}}, throw, {error,V}), - ?line {{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} = + {{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} = eclectic_2({value,{'abs',V}}, undefined, {value,V}), - ?line {{caught,{'EXIT',{badarith,[{?MODULE,my_add,_,_}|_]}}},V} = + {{caught,{'EXIT',{badarith,[{?MODULE,my_add,_,_}|_]}}},V} = eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}), - ?line {{caught,{'EXIT',V}},undefined} = + {{caught,{'EXIT',V}},undefined} = eclectic_2({value,{error,V}}, undefined, {exit,V}), - ?line {{caught,{'EXIT',{V,[{?MODULE,foo,_,_}|_]}}},undefined} = + {{caught,{'EXIT',{V,[{?MODULE,foo,_,_}|_]}}},undefined} = eclectic_2({throw,{'div',{1,0}}}, throw, {error,V}), ok. @@ -375,42 +374,42 @@ eclectic_2(X, C, Y) -> Catch = case catch - {Done, - try foo(X) of - V -> {value,V,foo(V)} - catch - C:D -> {C,D,foo(D)} - after - put(eclectic, foo(Y)) - end} of - {Done,Z} -> {value,Z}; - Z -> {caught,Z} - end, + {Done, + try foo(X) of + V -> {value,V,foo(V)} + catch + C:D -> {C,D,foo(D)} + after + put(eclectic, foo(Y)) + end} of + {Done,Z} -> {value,Z}; + Z -> {caught,Z} + end, {Catch,erase(eclectic)}. rethrow(Conf) when is_list(Conf) -> V = {a,[b,{c,self()},make_ref]}, - ?line {value2,value1} = + {value2,value1} = rethrow_1({value,V}, V), - ?line {caught2,{error,V}} = + {caught2,{error,V}} = rethrow_2({error,V}, undefined), - ?line {caught2,{exit,V}} = + {caught2,{exit,V}} = rethrow_1({exit,V}, error), - ?line {caught2,{throw,V}} = + {caught2,{throw,V}} = rethrow_1({throw,V}, undefined), - ?line {caught2,{throw,V}} = + {caught2,{throw,V}} = rethrow_2({throw,V}, undefined), - ?line {caught2,{error,badarith}} = + {caught2,{error,badarith}} = rethrow_1({'add',{0,a}}, throw), - ?line {caught2,{error,function_clause}} = + {caught2,{error,function_clause}} = rethrow_2(function_clause, undefined), - ?line {caught2,{error,{try_clause,V}}} = + {caught2,{error,{try_clause,V}}} = rethrow_1({value,V}, exit), - ?line {value2,{caught1,V}} = + {value2,{caught1,V}} = rethrow_1({error,V}, error), - ?line {value2,{caught1,V}} = + {value2,{caught1,V}} = rethrow_1({exit,V}, exit), - ?line {value2,caught1} = + {value2,caught1} = rethrow_2({throw,V}, V), ok. @@ -440,91 +439,91 @@ rethrow_2(X, C1) -> nested_of(Conf) when is_list(Conf) -> V = {[self()|make_ref()],1.4142136}, - ?line {{value,{value1,{V,x2}}}, - {V,x3}, - {V,x4}, - finalized} = + {{value,{value1,{V,x2}}}, + {V,x3}, + {V,x4}, + finalized} = nested_of_1({{value,{V,x1}},void,{V,x1}}, {value,{V,x2}}, {value,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{throw,{V,x2}}}, - {V,x3}, - {V,x4}, - finalized} = + {{caught,{throw,{V,x2}}}, + {V,x3}, + {V,x4}, + finalized} = nested_of_1({{value,{V,x1}},void,{V,x1}}, {throw,{V,x2}}, {value,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{error,badarith}}, - undefined, - {V,x4}, - finalized} = + {{caught,{error,badarith}}, + undefined, + {V,x4}, + finalized} = nested_of_1({{value,{V,x1}},void,{V,x1}}, {throw,{V,x2}}, {'div',{1,0}}, {value,{V,x4}}), - ?line {{caught,{error,badarith}}, - undefined, - undefined, - finalized} = + {{caught,{error,badarith}}, + undefined, + undefined, + finalized} = nested_of_1({{value,{V,x1}},void,{V,x1}}, {throw,{V,x2}}, {'div',{1,0}}, {'add',{0,b}}), %% - ?line {{caught,{error,{try_clause,{V,x1}}}}, - {V,x3}, - {V,x4}, - finalized} = + {{caught,{error,{try_clause,{V,x1}}}}, + {V,x3}, + {V,x4}, + finalized} = nested_of_1({{value,{V,x1}},void,try_clause}, void, {value,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{exit,{V,x3}}}, - undefined, - {V,x4}, - finalized} = + {{caught,{exit,{V,x3}}}, + undefined, + {V,x4}, + finalized} = nested_of_1({{value,{V,x1}},void,try_clause}, void, {exit,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{throw,{V,x4}}}, - undefined, - undefined, - finalized} = + {{caught,{throw,{V,x4}}}, + undefined, + undefined, + finalized} = nested_of_1({{value,{V,x1}},void,try_clause}, void, {exit,{V,x3}}, {throw,{V,x4}}), %% - ?line {{value,{caught1,{V,x2}}}, - {V,x3}, - {V,x4}, - finalized} = + {{value,{caught1,{V,x2}}}, + {V,x3}, + {V,x4}, + finalized} = nested_of_1({{error,{V,x1}},error,{V,x1}}, {value,{V,x2}}, {value,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{error,badarith}}, - {V,x3}, - {V,x4}, - finalized} = + {{caught,{error,badarith}}, + {V,x3}, + {V,x4}, + finalized} = nested_of_1({{error,{V,x1}},error,{V,x1}}, {'add',{1,c}}, {value,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{error,badarith}}, - undefined, - {V,x4}, - finalized} = + {{caught,{error,badarith}}, + undefined, + {V,x4}, + finalized} = nested_of_1({{error,{V,x1}},error,{V,x1}}, {'add',{1,c}}, {'div',{17,0}}, {value,{V,x4}}), - ?line {{caught,{error,badarg}}, - undefined, - undefined, - finalized} = + {{caught,{error,badarg}}, + undefined, + undefined, + finalized} = nested_of_1({{error,{V,x1}},error,{V,x1}}, {'add',{1,c}}, {'div',{17,0}}, {'abs',V}), %% - ?line {{caught,{error,badarith}}, - {V,x3}, - {V,x4}, - finalized} = + {{caught,{error,badarith}}, + {V,x3}, + {V,x4}, + finalized} = nested_of_1({{'add',{2,c}},rethrow,void}, void, {value,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{error,badarg}}, - undefined, - {V,x4}, - finalized} = + {{caught,{error,badarg}}, + undefined, + {V,x4}, + finalized} = nested_of_1({{'add',{2,c}},rethrow,void}, void, {'abs',V}, {value,{V,x4}}), - ?line {{caught,{error,function_clause}}, - undefined, - undefined, - finalized} = + {{caught,{error,function_clause}}, + undefined, + undefined, + finalized} = nested_of_1({{'add',{2,c}},rethrow,void}, void, {'abs',V}, function_clause), ok. @@ -565,97 +564,97 @@ nested_of_1({X1,C1,V1}, nested_catch(Conf) when is_list(Conf) -> V = {[make_ref(),1.4142136,self()]}, - ?line {{value,{value1,{V,x2}}}, - {V,x3}, - {V,x4}, - finalized} = + {{value,{value1,{V,x2}}}, + {V,x3}, + {V,x4}, + finalized} = nested_catch_1({{value,{V,x1}},void,{V,x1}}, - {value,{V,x2}}, {value,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{throw,{V,x2}}}, - {V,x3}, - {V,x4}, - finalized} = + {value,{V,x2}}, {value,{V,x3}}, {value,{V,x4}}), + {{caught,{throw,{V,x2}}}, + {V,x3}, + {V,x4}, + finalized} = nested_catch_1({{value,{V,x1}},void,{V,x1}}, - {throw,{V,x2}}, {value,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{error,badarith}}, - undefined, - {V,x4}, - finalized} = + {throw,{V,x2}}, {value,{V,x3}}, {value,{V,x4}}), + {{caught,{error,badarith}}, + undefined, + {V,x4}, + finalized} = nested_catch_1({{value,{V,x1}},void,{V,x1}}, - {throw,{V,x2}}, {'div',{1,0}}, {value,{V,x4}}), - ?line {{caught,{error,badarith}}, - undefined, - undefined, - finalized} = + {throw,{V,x2}}, {'div',{1,0}}, {value,{V,x4}}), + {{caught,{error,badarith}}, + undefined, + undefined, + finalized} = nested_catch_1({{value,{V,x1}},void,{V,x1}}, - {throw,{V,x2}}, {'div',{1,0}}, {'add',{0,b}}), + {throw,{V,x2}}, {'div',{1,0}}, {'add',{0,b}}), %% - ?line {{caught,{error,{try_clause,{V,x1}}}}, - {V,x3}, - {V,x4}, - finalized} = + {{caught,{error,{try_clause,{V,x1}}}}, + {V,x3}, + {V,x4}, + finalized} = nested_catch_1({{value,{V,x1}},void,try_clause}, - void, {value,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{exit,{V,x3}}}, - undefined, - {V,x4}, - finalized} = + void, {value,{V,x3}}, {value,{V,x4}}), + {{caught,{exit,{V,x3}}}, + undefined, + {V,x4}, + finalized} = nested_catch_1({{value,{V,x1}},void,try_clause}, - void, {exit,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{throw,{V,x4}}}, - undefined, - undefined, - finalized} = + void, {exit,{V,x3}}, {value,{V,x4}}), + {{caught,{throw,{V,x4}}}, + undefined, + undefined, + finalized} = nested_catch_1({{value,{V,x1}},void,try_clause}, - void, {exit,{V,x3}}, {throw,{V,x4}}), + void, {exit,{V,x3}}, {throw,{V,x4}}), %% - ?line {{value,{caught1,{V,x2}}}, - {V,x3}, - {V,x4}, - finalized} = + {{value,{caught1,{V,x2}}}, + {V,x3}, + {V,x4}, + finalized} = nested_catch_1({{error,{V,x1}},error,{V,x1}}, - {value,{V,x2}}, {value,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{error,badarith}}, - {V,x3}, - {V,x4}, - finalized} = + {value,{V,x2}}, {value,{V,x3}}, {value,{V,x4}}), + {{caught,{error,badarith}}, + {V,x3}, + {V,x4}, + finalized} = nested_catch_1({{error,{V,x1}},error,{V,x1}}, - {'add',{1,c}}, {value,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{error,badarith}}, - undefined, - {V,x4}, - finalized} = + {'add',{1,c}}, {value,{V,x3}}, {value,{V,x4}}), + {{caught,{error,badarith}}, + undefined, + {V,x4}, + finalized} = nested_catch_1({{error,{V,x1}},error,{V,x1}}, - {'add',{1,c}}, {'div',{17,0}}, {value,{V,x4}}), - ?line {{caught,{error,badarg}}, - undefined, - undefined, - finalized} = + {'add',{1,c}}, {'div',{17,0}}, {value,{V,x4}}), + {{caught,{error,badarg}}, + undefined, + undefined, + finalized} = nested_catch_1({{error,{V,x1}},error,{V,x1}}, - {'add',{1,c}}, {'div',{17,0}}, {'abs',V}), + {'add',{1,c}}, {'div',{17,0}}, {'abs',V}), %% - ?line {{caught,{error,badarith}}, - {V,x3}, - {V,x4}, - finalized} = + {{caught,{error,badarith}}, + {V,x3}, + {V,x4}, + finalized} = nested_catch_1({{'add',{2,c}},rethrow,void}, - void, {value,{V,x3}}, {value,{V,x4}}), - ?line {{caught,{error,badarg}}, - undefined, - {V,x4}, - finalized} = + void, {value,{V,x3}}, {value,{V,x4}}), + {{caught,{error,badarg}}, + undefined, + {V,x4}, + finalized} = nested_catch_1({{'add',{2,c}},rethrow,void}, - void, {'abs',V}, {value,{V,x4}}), - ?line {{caught,{error,function_clause}}, - undefined, - undefined, - finalized} = + void, {'abs',V}, {value,{V,x4}}), + {{caught,{error,function_clause}}, + undefined, + undefined, + finalized} = nested_catch_1({{'add',{2,c}},rethrow,void}, - void, {'abs',V}, function_clause), + void, {'abs',V}, function_clause), ok. nested_catch_1({X1,C1,V1}, - X2, X3, X4) -> + X2, X3, X4) -> erase(nested3), erase(nested4), erase(nested), @@ -688,73 +687,73 @@ nested_catch_1({X1,C1,V1}, nested_after(Conf) when is_list(Conf) -> V = [{make_ref(),1.4142136,self()}], - ?line {value, - {V,x3}, - {value1,{V,x2}}, - finalized} = + {value, + {V,x3}, + {value1,{V,x2}}, + finalized} = nested_after_1({{value,{V,x1}},void,{V,x1}}, {value,{V,x2}}, {value,{V,x3}}), - ?line {{caught,{error,{V,x2}}}, - {V,x3}, - undefined, - finalized} = + {{caught,{error,{V,x2}}}, + {V,x3}, + undefined, + finalized} = nested_after_1({{value,{V,x1}},void,{V,x1}}, {error,{V,x2}}, {value,{V,x3}}), - ?line {{caught,{exit,{V,x3}}}, - undefined, - undefined, - finalized} = + {{caught,{exit,{V,x3}}}, + undefined, + undefined, + finalized} = nested_after_1({{value,{V,x1}},void,{V,x1}}, {error,{V,x2}}, {exit,{V,x3}}), %% - ?line {{caught,{error,{try_clause,{V,x1}}}}, - {V,x3}, - undefined, - finalized} = + {{caught,{error,{try_clause,{V,x1}}}}, + {V,x3}, + undefined, + finalized} = nested_after_1({{value,{V,x1}},void,try_clause}, void, {value,{V,x3}}), - ?line {{caught,{error,badarith}}, - undefined, - undefined, - finalized} = + {{caught,{error,badarith}}, + undefined, + undefined, + finalized} = nested_after_1({{value,{V,x1}},void,try_clause}, void, {'div',{17,0}}), %% - ?line {value, - {V,x3}, - {caught1,{V,x2}}, - finalized} = + {value, + {V,x3}, + {caught1,{V,x2}}, + finalized} = nested_after_1({{throw,{V,x1}},throw,{V,x1}}, {value,{V,x2}}, {value,{V,x3}}), - ?line {{caught,{error,badarith}}, - {V,x3}, - undefined, - finalized} = + {{caught,{error,badarith}}, + {V,x3}, + undefined, + finalized} = nested_after_1({{throw,{V,x1}},throw,{V,x1}}, {'add',{a,b}}, {value,{V,x3}}), - ?line {{caught,{error,badarg}}, - undefined, - undefined, - finalized} = + {{caught,{error,badarg}}, + undefined, + undefined, + finalized} = nested_after_1({{throw,{V,x1}},throw,{V,x1}}, {'add',{a,b}}, {'abs',V}), %% - ?line {{caught,{throw,{V,x1}}}, - {V,x3}, - undefined, - finalized} = + {{caught,{throw,{V,x1}}}, + {V,x3}, + undefined, + finalized} = nested_after_1({{throw,{V,x1}},rethrow,void}, void, {value,{V,x3}}), - ?line {{caught,{error,badarith}}, - undefined, - undefined, - finalized} = + {{caught,{error,badarith}}, + undefined, + undefined, + finalized} = nested_after_1({{throw,{V,x1}},rethrow,void}, void, {'div',{1,0}}), ok. nested_after_1({X1,C1,V1}, - X2, X3) -> + X2, X3) -> erase(nested3), erase(nested4), erase(nested), diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index 9f51dfe356..bcac8afe64 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -336,6 +336,9 @@ message_to_string({guard_fail, []}) -> "Clause guard cannot succeed.\n"; message_to_string({guard_fail, [Arg1, Infix, Arg2]}) -> io_lib:format("Guard test ~s ~s ~s can never succeed\n", [Arg1, Infix, Arg2]); +message_to_string({map_update, [Type, Key]}) -> + io_lib:format("A key of type ~s cannot exist " + "in a map of type ~s\n", [Key, Type]); message_to_string({neg_guard_fail, [Arg1, Infix, Arg2]}) -> io_lib:format("Guard test not(~s ~s ~s) can never succeed\n", [Arg1, Infix, Arg2]); diff --git a/lib/dialyzer/src/dialyzer.hrl b/lib/dialyzer/src/dialyzer.hrl index 601e2e954b..ea6a71217c 100644 --- a/lib/dialyzer/src/dialyzer.hrl +++ b/lib/dialyzer/src/dialyzer.hrl @@ -60,6 +60,7 @@ -define(WARN_BEHAVIOUR, warn_behaviour). -define(WARN_UNDEFINED_CALLBACK, warn_undefined_callbacks). -define(WARN_UNKNOWN, warn_unknown). +-define(WARN_MAP_CONSTRUCTION, warn_map_construction). %% %% The following type has double role: @@ -75,7 +76,8 @@ | ?WARN_CONTRACT_SUPERTYPE | ?WARN_CALLGRAPH | ?WARN_UNMATCHED_RETURN | ?WARN_RACE_CONDITION | ?WARN_BEHAVIOUR | ?WARN_CONTRACT_RANGE - | ?WARN_UNDEFINED_CALLBACK | ?WARN_UNKNOWN. + | ?WARN_UNDEFINED_CALLBACK | ?WARN_UNKNOWN + | ?WARN_MAP_CONSTRUCTION. %% %% This is the representation of each warning as they will be returned diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index e03e4d5bb4..1895a98e96 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -277,28 +277,45 @@ check_extraneous_1(Contract, SuccType) -> case [CR || CR <- CRngs, erl_types:t_is_none(erl_types:t_inf(CR, STRng))] of [] -> - CRngList = list_part(CRng), - STRngList = list_part(STRng), - case is_not_nil_list(CRngList) andalso is_not_nil_list(STRngList) of - false -> ok; - true -> - CRngElements = erl_types:t_list_elements(CRngList), - STRngElements = erl_types:t_list_elements(STRngList), - Inf = erl_types:t_inf(CRngElements, STRngElements), - case erl_types:t_is_none(Inf) of - true -> {error, invalid_contract}; - false -> ok - end + case bad_extraneous_list(CRng, STRng) + orelse bad_extraneous_map(CRng, STRng) + of + true -> {error, invalid_contract}; + false -> ok end; CRs -> {error, {extra_range, erl_types:t_sup(CRs), STRng}} end. +bad_extraneous_list(CRng, STRng) -> + CRngList = list_part(CRng), + STRngList = list_part(STRng), + case is_not_nil_list(CRngList) andalso is_not_nil_list(STRngList) of + false -> false; + true -> + CRngElements = erl_types:t_list_elements(CRngList), + STRngElements = erl_types:t_list_elements(STRngList), + Inf = erl_types:t_inf(CRngElements, STRngElements), + erl_types:t_is_none(Inf) + end. + list_part(Type) -> erl_types:t_inf(erl_types:t_list(), Type). is_not_nil_list(Type) -> erl_types:t_is_list(Type) andalso not erl_types:t_is_nil(Type). +bad_extraneous_map(CRng, STRng) -> + CRngMap = map_part(CRng), + STRngMap = map_part(STRng), + (not is_empty_map(CRngMap)) andalso (not is_empty_map(STRngMap)) + andalso is_empty_map(erl_types:t_inf(CRngMap, STRngMap)). + +map_part(Type) -> + erl_types:t_inf(erl_types:t_map(), Type). + +is_empty_map(Type) -> + erl_types:t_is_equal(Type, erl_types:t_from_term(#{})). + %% This is the heart of the "range function" -spec process_contracts([contract_pair()], [erl_types:erl_type()]) -> erl_types:erl_type(). diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 6e49043551..f0fa9fbb4e 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -72,7 +72,7 @@ t_tuple/0, t_tuple/1, t_tuple_args/1, t_tuple_args/2, t_tuple_subtypes/2, t_unit/0, t_unopaque/2, - t_map/1 + t_map/0, t_map/1, t_is_singleton/2 ]). %%-define(DEBUG, true). @@ -342,8 +342,6 @@ traverse(Tree, Map, State) -> handle_tuple(Tree, Map, State); map -> handle_map(Tree, Map, State); - map_pair -> - handle_map_pair(Tree, Map, State); values -> Elements = cerl:values_es(Tree), {State1, Map1, EsType} = traverse_list(Elements, Map, State), @@ -1102,15 +1100,54 @@ handle_try(Tree, Map, State) -> %%---------------------------------------- handle_map(Tree,Map,State) -> - Pairs = cerl:map_es(Tree), - {State1, Map1, TypePairs} = traverse_list(Pairs,Map,State), - {State1, Map1, t_map(TypePairs)}. + Pairs = cerl:map_es(Tree), + Arg = cerl:map_arg(Tree), + {State1, Map1, ArgType} = traverse(Arg, Map, State), + ArgType1 = t_inf(t_map(), ArgType), + case t_is_none_or_unit(ArgType1) of + true -> + {State1, Map1, ArgType1}; + false -> + {State2, Map2, TypePairs, ExactKeys} = + traverse_map_pairs(Pairs, Map1, State1, t_none(), [], []), + InsertPair = fun({KV,assoc,_},Acc) -> erl_types:t_map_put(KV,Acc); + ({KV,exact,KVTree},Acc) -> + case t_is_none(T=erl_types:t_map_update(KV,Acc)) of + true -> throw({none, Acc, KV, KVTree}); + false -> T + end + end, + try lists:foldl(InsertPair, ArgType1, TypePairs) + of ResT -> + BindT = t_map([{K, t_any()} || K <- ExactKeys]), + case bind_pat_vars_reverse([Arg], [BindT], [], Map2, State2) of + {error, _, _, _, _} -> {State2, Map2, ResT}; + {Map3, _} -> {State2, Map3, ResT} + end + catch {none, MapType, {K,_}, KVTree} -> + Msg2 = {map_update, [format_type(MapType, State2), + format_type(K, State2)]}, + {state__add_warning(State2, ?WARN_MAP_CONSTRUCTION, KVTree, Msg2), + Map2, t_none()} + end + end. -handle_map_pair(Tree,Map,State) -> - Key = cerl:map_pair_key(Tree), - Val = cerl:map_pair_val(Tree), +traverse_map_pairs([], Map, State, _ShadowKeys, PairAcc, KeyAcc) -> + {State, Map, lists:reverse(PairAcc), KeyAcc}; +traverse_map_pairs([Pair|Pairs], Map, State, ShadowKeys, PairAcc, KeyAcc) -> + Key = cerl:map_pair_key(Pair), + Val = cerl:map_pair_val(Pair), + Op = cerl:map_pair_op(Pair), {State1, Map1, [K,V]} = traverse_list([Key,Val],Map,State), - {State1, Map1, {K,V}}. + KeyAcc1 = + case cerl:is_literal(Op) andalso cerl:concrete(Op) =:= exact andalso + t_is_singleton(K, State#state.opaques) andalso + t_is_none(t_inf(ShadowKeys, K)) of + true -> [K|KeyAcc]; + false -> KeyAcc + end, + traverse_map_pairs(Pairs, Map1, State1, t_sup(K, ShadowKeys), + [{{K,V},cerl:concrete(Op),Pair}|PairAcc], KeyAcc1). %%---------------------------------------- @@ -1445,7 +1482,9 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> {NewMap, TypeOut} = case cerl:type(Pat) of alias -> - AliasPat = cerl:alias_pat(Pat), + %% Map patterns are more allowing than the type of their literal. We + %% must unfold AliasPat if it is a literal. + AliasPat = dialyzer_utils:refold_pattern(cerl:alias_pat(Pat)), Var = cerl:alias_var(Pat), Map1 = enter_subst(Var, AliasPat, Map), {Map2, [PatType]} = bind_pat_vars([AliasPat], [Type], [], @@ -1486,14 +1525,59 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> {Map1, t_cons(HdType, TlType)} end; literal -> - Literal = literal_type(Pat), - case t_is_none(t_inf(Literal, Type, Opaques)) of + Pat0 = dialyzer_utils:refold_pattern(Pat), + case cerl:is_literal(Pat0) of true -> - bind_opaque_pats(Literal, Type, Pat, State); - false -> {Map, Literal} + Literal = literal_type(Pat), + case t_is_none(t_inf(Literal, Type, Opaques)) of + true -> + bind_opaque_pats(Literal, Type, Pat, State); + false -> {Map, Literal} + end; + false -> + %% Retry with the unfolded pattern + {Map1, [PatType]} + = bind_pat_vars([Pat0], [Type], [], Map, State, Rev), + {Map1, PatType} end; map -> - {Map, t_map([])}; + MapT = t_inf(Type, t_map(), Opaques), + case t_is_none(MapT) of + true -> + bind_opaque_pats(t_map(), Type, Pat, State); + false -> + case Rev of + %% TODO: Reverse matching (propagating a matched subset back to a value) + true -> {Map, MapT}; + false -> + FoldFun = + fun(Pair, {MapAcc, ListAcc}) -> + %% Only exact (:=) can appear in patterns + exact = cerl:concrete(cerl:map_pair_op(Pair)), + Key = cerl:map_pair_key(Pair), + KeyType = + case cerl:type(Key) of + var -> + case state__lookup_type_for_letrec(Key, State) of + error -> lookup_type(Key, MapAcc); + {ok, RecType} -> RecType + end; + literal -> + literal_type(Key) + end, + Bind = erl_types:t_map_get(KeyType, MapT), + {MapAcc1, [ValType]} = + bind_pat_vars([cerl:map_pair_val(Pair)], + [Bind], [], MapAcc, State, Rev), + case t_is_singleton(KeyType, Opaques) of + true -> {MapAcc1, [{KeyType, ValType}|ListAcc]}; + false -> {MapAcc1, ListAcc} + end + end, + {Map1, Pairs} = lists:foldl(FoldFun, {Map, []}, cerl:map_es(Pat)), + {Map1, t_inf(MapT, t_map(Pairs))} + end + end; tuple -> Es = cerl:tuple_es(Pat), {TypedRecord, Prototype} = @@ -1710,15 +1794,58 @@ bind_guard(Guard, Map, Env, Eval, State) -> 'try' -> Arg = cerl:try_arg(Guard), [Var] = cerl:try_vars(Guard), + EVars = cerl:try_evars(Guard), %%?debug("Storing: ~w\n", [Var]), - NewEnv = dict:store(get_label(Var), Arg, Env), - bind_guard(cerl:try_body(Guard), Map, NewEnv, Eval, State); + Map1 = join_maps_begin(Map), + Map2 = mark_as_fresh(EVars, Map1), + %% Visit handler first so we know if it should be ignored + {{HandlerMap, HandlerType}, HandlerE} = + try {bind_guard(cerl:try_handler(Guard), Map2, Env, Eval, State), none} + catch throw:HE -> + {{Map2, t_none()}, HE} + end, + BodyEnv = dict:store(get_label(Var), Arg, Env), + Wanted = case Eval of pos -> t_atom(true); neg -> t_atom(false); + dont_know -> t_any() end, + case t_is_none(t_inf(HandlerType, Wanted)) of + %% Handler won't save us; pretend it does not exist + true -> bind_guard(cerl:try_body(Guard), Map, BodyEnv, Eval, State); + false -> + {{BodyMap, BodyType}, BodyE} = + try {bind_guard(cerl:try_body(Guard), Map1, BodyEnv, + Eval, State), none} + catch throw:BE -> + {{Map1, t_none()}, BE} + end, + Map3 = join_maps_end([BodyMap, HandlerMap], Map1), + case t_is_none(Sup = t_sup(BodyType, HandlerType)) of + true -> + %% Pick a reason. N.B. We assume that the handler is always + %% compiler-generated if the body is; that way, we won't need to + %% check. + Fatality = case {BodyE, HandlerE} of + {{fatal_fail, _}, _} -> fatal_fail; + {_, {fatal_fail, _}} -> fatal_fail; + _ -> fail + end, + throw({Fatality, + case {BodyE, HandlerE} of + {{_, Rsn}, _} when Rsn =/= none -> Rsn; + {_, {_,Rsn}} -> Rsn; + _ -> none + end}); + false -> {Map3, Sup} + end + end; tuple -> Es0 = cerl:tuple_es(Guard), {Map1, Es} = bind_guard_list(Es0, Map, Env, dont_know, State), {Map1, t_tuple(Es)}; map -> - {Map, t_map([])}; + case Eval of + dont_know -> handle_guard_map(Guard, Map, Env, State); + _PosOrNeg -> {Map, t_none()} %% Map exprs do not produce bools + end; 'let' -> Arg = cerl:let_arg(Guard), [Var] = cerl:let_vars(Guard), @@ -1761,7 +1888,7 @@ handle_guard_call(Guard, Map, Env, Eval, State) -> {erlang, F, 1} when F =:= is_atom; F =:= is_boolean; F =:= is_binary; F =:= is_bitstring; F =:= is_float; F =:= is_function; - F =:= is_integer; F =:= is_list; + F =:= is_integer; F =:= is_list; F =:= is_map; F =:= is_number; F =:= is_pid; F =:= is_port; F =:= is_reference; F =:= is_tuple -> handle_guard_type_test(Guard, F, Map, Env, Eval, State); @@ -1841,6 +1968,7 @@ bind_type_test(Eval, TypeTest, ArgType, State) -> is_function -> t_fun(); is_integer -> t_integer(); is_list -> t_maybe_improper_list(); + is_map -> t_map(); is_number -> t_number(); is_pid -> t_pid(); is_port -> t_port(); @@ -2349,6 +2477,30 @@ bind_guard_list([G|Gs], Map, Env, Eval, State, Acc) -> bind_guard_list([], Map, _Env, _Eval, _State, Acc) -> {Map, lists:reverse(Acc)}. +handle_guard_map(Guard, Map, Env, State) -> + Pairs = cerl:map_es(Guard), + Arg = cerl:map_arg(Guard), + {Map1, ArgType0} = bind_guard(Arg, Map, Env, dont_know, State), + ArgType1 = t_inf(t_map(), ArgType0), + case t_is_none_or_unit(ArgType1) of + true -> {Map1, t_none()}; + false -> + {Map2, TypePairs} = bind_guard_map_pairs(Pairs, Map1, Env, State, []), + {Map2, lists:foldl(fun({KV,assoc},Acc) -> erl_types:t_map_put(KV,Acc); + ({KV,exact},Acc) -> erl_types:t_map_update(KV,Acc) + end, ArgType1, TypePairs)} + end. + +bind_guard_map_pairs([], Map, _Env, _State, PairAcc) -> + {Map, lists:reverse(PairAcc)}; +bind_guard_map_pairs([Pair|Pairs], Map, Env, State, PairAcc) -> + Key = cerl:map_pair_key(Pair), + Val = cerl:map_pair_val(Pair), + Op = cerl:map_pair_op(Pair), + {Map1, [K,V]} = bind_guard_list([Key,Val],Map,Env,dont_know,State), + bind_guard_map_pairs(Pairs, Map1, Env, State, + [{{K,V},cerl:concrete(Op)}|PairAcc]). + -type eval() :: 'pos' | 'neg' | 'dont_know'. -spec signal_guard_fail(eval(), cerl:c_call(), [type()], @@ -2421,7 +2573,9 @@ filter_fail_clauses([Clause|Left]) -> case (cerl:clause_pats(Clause) =:= []) of true -> Body = cerl:clause_body(Clause), - case cerl:is_literal(Body) andalso (cerl:concrete(Body) =:= fail) of + case cerl:is_literal(Body) andalso (cerl:concrete(Body) =:= fail) orelse + cerl:is_c_primop(Body) andalso + (cerl:atom_val(cerl:primop_name(Body)) =:= match_fail) of true -> filter_fail_clauses(Left); false -> [Clause|filter_fail_clauses(Left)] end; @@ -2639,8 +2793,9 @@ store_map(Key, Val, #map{dict = Dict, ref = undefined} = Map) -> store_map(Key, Val, #map{dict = Dict, modified = Mod} = Map) -> Map#map{dict = dict:store(Key, Val, Dict), modified = [Key | Mod]}. -enter_subst(Key, Val, #map{subst = Subst} = MS) -> +enter_subst(Key, Val0, #map{subst = Subst} = MS) -> KeyLabel = get_label(Key), + Val = dialyzer_utils:refold_pattern(Val0), case cerl:is_literal(Val) of true -> store_map(KeyLabel, literal_type(Val), MS); @@ -2703,6 +2858,9 @@ mark_as_fresh([Tree|Left], Map) -> bitstr -> %% The Size field is not fresh. {SubTrees1 -- [cerl:bitstr_size(Tree)], Map}; + map_pair -> + %% The keys are not fresh + {SubTrees1 -- [cerl:map_pair_key(Tree)], Map}; var -> {SubTrees1, enter_type(Tree, t_any(), Map)}; _ -> diff --git a/lib/dialyzer/src/dialyzer_options.erl b/lib/dialyzer/src/dialyzer_options.erl index dd81dd01ed..add660eae9 100644 --- a/lib/dialyzer/src/dialyzer_options.erl +++ b/lib/dialyzer/src/dialyzer_options.erl @@ -47,6 +47,7 @@ build(Opts) -> ?WARN_CALLGRAPH, ?WARN_FAILING_CALL, ?WARN_BIN_CONSTRUCTION, + ?WARN_MAP_CONSTRUCTION, ?WARN_CONTRACT_RANGE, ?WARN_CONTRACT_TYPES, ?WARN_CONTRACT_SYNTAX, diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 5f0881bbcd..50fcbc555b 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -48,6 +48,7 @@ t_is_float/1, t_is_fun/1, t_is_integer/1, t_non_neg_integer/0, t_is_list/1, t_is_nil/1, t_is_none/1, t_is_number/1, + t_is_singleton/1, t_limit/2, t_list/0, t_list/1, t_list_elements/1, t_nonempty_list/1, t_maybe_improper_list/0, @@ -57,7 +58,7 @@ t_timeout/0, t_tuple/0, t_tuple/1, t_var/1, t_var_name/1, t_none/0, t_unit/0, - t_map/1 + t_map/0, t_map/1, t_map_get/2, t_map_put/2 ]). -include("dialyzer.hrl"). @@ -126,6 +127,8 @@ solvers = [] :: [solver()] }). +-type state() :: #state{}. + %%----------------------------------------------------------------------------- -define(TYPE_LIMIT, 4). @@ -311,7 +314,7 @@ traverse(Tree, DefinedVars, State) -> Hd = cerl:cons_hd(Tree), Tl = cerl:cons_tl(Tree), {State1, [HdVar, TlVar]} = traverse_list([Hd, Tl], DefinedVars, State), - case cerl:is_literal(cerl:fold_literal(Tree)) of + case cerl:is_literal(fold_literal_maybe_match(Tree, State)) of true -> %% We do not need to do anything more here. {State, t_cons(HdVar, TlVar)}; @@ -392,8 +395,18 @@ traverse(Tree, DefinedVars, State) -> {State2, _} = traverse_list(Funs, DefinedVars1, State1), traverse(Body, DefinedVars1, State2); literal -> - Type = t_from_term(cerl:concrete(Tree)), - {State, Type}; + %% Maps are special; a literal pattern matches more than just the value + %% constructed by the literal. For example #{} constructs the empty map, + %% but matches every map. + case state__is_in_match(State) of + true -> + Tree1 = dialyzer_utils:refold_pattern(Tree), + case cerl:is_literal(Tree1) of + false -> traverse(Tree1, DefinedVars, State); + true -> {State, t_from_term(cerl:concrete(Tree))} + end; + _ -> {State, t_from_term(cerl:concrete(Tree))} + end; module -> Defs = cerl:module_defs(Tree), Funs = [Fun || {_Var, Fun} <- Defs], @@ -437,7 +450,7 @@ traverse(Tree, DefinedVars, State) -> Elements = cerl:tuple_es(Tree), {State1, EVars} = traverse_list(Elements, DefinedVars, State), {State2, TupleType} = - case cerl:is_literal(cerl:fold_literal(Tree)) of + case cerl:is_literal(fold_literal_maybe_match(Tree, State1)) of true -> %% We do not need to do anything more here. {State, t_tuple(EVars)}; @@ -476,7 +489,111 @@ traverse(Tree, DefinedVars, State) -> [] -> {State2, TupleType} end; map -> - {State, t_map([])}; + Entries = cerl:map_es(Tree), + MapFoldFun = fun(Entry, AccState) -> + AccState1 = state__set_in_match(AccState, false), + {AccState2, KeyVar} = traverse(cerl:map_pair_key(Entry), + DefinedVars, AccState1), + AccState3 = state__set_in_match( + AccState2, state__is_in_match(AccState)), + {AccState4, ValVar} = traverse(cerl:map_pair_val(Entry), + DefinedVars, AccState3), + {{KeyVar, ValVar}, AccState4} + end, + {Pairs, State1} = lists:mapfoldl(MapFoldFun, State, Entries), + %% We mustn't recurse into map arguments to matches. Not only are they + %% syntactically only allowed to be the literal #{}, but that would also + %% cause an infinite recursion, since traverse/3 unfolds literals with + %% maps in them using dialyzer_utils:reflow_pattern/1. + {State2, ArgVar} = + case state__is_in_match(State) of + false -> traverse(cerl:map_arg(Tree), DefinedVars, State1); + true -> {State1, t_map()} + end, + MapVar = mk_var(Tree), + MapType = ?mk_fun_var( + fun(Map) -> + lists:foldl( + fun({K,V}, TypeAcc) -> + t_map_put({lookup_type(K, Map), + lookup_type(V, Map)}, + TypeAcc) + end, t_inf(t_map(), lookup_type(ArgVar, Map)), + Pairs) + end, [ArgVar | lists:append([[K,V] || {K,V} <- Pairs])]), + %% TODO: does the "same element appearing several times" problem apply + %% here too? + Fun = + fun({KeyVar, ValVar}, {AccState, ShadowKeys}) -> + %% If Val is known to be the last association of Key (i.e. Key + %% is not in ShadowKeys), Val must be a subtype of what is + %% associated to Key in Tree + TypeFun = + fun(Map) -> + KeyType = lookup_type(KeyVar, Map), + case t_is_singleton(KeyType) of + false -> t_any(); + true -> + MT = t_inf(lookup_type(MapVar, Map), t_map()), + case t_is_none(MT) of + true -> t_none(); + false -> + DisjointFromKeyType = + fun(ShadowKey) -> + t_is_none(t_inf(lookup_type(ShadowKey, Map), + KeyType)) + end, + case lists:all(DisjointFromKeyType, ShadowKeys) of + true -> t_map_get(KeyType, MT); + %% A later association might shadow this one + false -> t_any() + end + end + end + end, + ValType = ?mk_fun_var(TypeFun, [KeyVar, MapVar | ShadowKeys]), + {state__store_conj(ValVar, sub, ValType, AccState), + [KeyVar | ShadowKeys]} + end, + %% Accumulate shadowing keys right-to-left + {State3, _} = lists:foldr(Fun, {State2, []}, Pairs), + %% In a map expression, Arg must contain all keys that are inserted with + %% the exact (:=) operator, and are known (i.e. are not in ShadowedKeys) + %% to not have been introduced by a previous association + State4 = + case state__is_in_match(State) of + true -> State3; + false -> + ArgFun = + fun(Map) -> + FoldFun = + fun({{KeyVar, _}, Entry}, {AccType, ShadowedKeys}) -> + OpTree = cerl:map_pair_op(Entry), + KeyType = lookup_type(KeyVar, Map), + AccType1 = + case cerl:is_literal(OpTree) andalso + cerl:concrete(OpTree) =:= exact of + true -> + case t_is_none(t_inf(ShadowedKeys, KeyType)) of + true -> + t_map_put({KeyType, t_any()}, AccType); + false -> + AccType + end; + false -> + AccType + end, + {AccType1, t_sup(KeyType, ShadowedKeys)} + end, + %% Accumulate shadowed keys left-to-right + {ResType, _} = lists:foldl(FoldFun, {t_map(), t_none()}, + lists:zip(Pairs, Entries)), + ResType + end, + ArgType = ?mk_fun_var(ArgFun, [KeyVar || {KeyVar, _} <- Pairs]), + state__store_conj(ArgVar, sub, ArgType, State3) + end, + {state__store_conj(MapVar, sub, MapType, State4), MapVar}; values -> %% We can get into trouble when unifying products that have the %% same element appearing several times. Handle these cases by @@ -948,6 +1065,7 @@ get_type_test({erlang, is_float, 1}) -> {ok, t_float()}; get_type_test({erlang, is_function, 1}) -> {ok, t_fun()}; get_type_test({erlang, is_integer, 1}) -> {ok, t_integer()}; get_type_test({erlang, is_list, 1}) -> {ok, t_list()}; +get_type_test({erlang, is_map, 1}) -> {ok, t_map()}; get_type_test({erlang, is_number, 1}) -> {ok, t_number()}; get_type_test({erlang, is_pid, 1}) -> {ok, t_pid()}; get_type_test({erlang, is_port, 1}) -> {ok, t_port()}; @@ -1004,7 +1122,9 @@ bitstr_val_constr(SizeType, UnitVal, Flags) -> end end. -get_safe_underapprox_1([Pat|Left], Acc, Map) -> +get_safe_underapprox_1([Pat0|Left], Acc, Map) -> + %% Maps should be treated as patterns, not as literals + Pat = dialyzer_utils:refold_pattern(Pat0), case cerl:type(Pat) of alias -> APat = cerl:alias_pat(Pat), @@ -1048,8 +1168,35 @@ get_safe_underapprox_1([Pat|Left], Acc, Map) -> Type = t_tuple(Ts), get_safe_underapprox_1(Left, [Type|Acc], Map1); map -> - %% TODO: Can maybe do something here - throw(dont_know); + %% Some assertions in case the syntax gets more premissive in the future + true = #{} =:= cerl:concrete(cerl:map_arg(Pat)), + true = lists:all(fun(P) -> + cerl:is_literal(Op = cerl:map_pair_op(P)) andalso + exact =:= cerl:concrete(Op) + end, cerl:map_es(Pat)), + KeyTrees = lists:map(fun cerl:map_pair_key/1, cerl:map_es(Pat)), + ValTrees = lists:map(fun cerl:map_pair_val/1, cerl:map_es(Pat)), + %% Keys must not be underapproximated. Overapproximations are safe. + Keys = get_safe_overapprox(KeyTrees), + {Vals, Map1} = get_safe_underapprox_1(ValTrees, [], Map), + case lists:all(fun erl_types:t_is_singleton/1, Keys) of + false -> throw(dont_know); + true -> ok + end, + SortedPairs = lists:sort(lists:zip(Keys, Vals)), + %% We need to deal with duplicates ourselves + SquashDuplicates = + fun SquashDuplicates([{K,First},{K,Second}|List]) -> + case t_is_none(Inf = t_inf(First, Second)) of + true -> throw(dont_know); + false -> [{K, Inf}|SquashDuplicates(List)] + end; + SquashDuplicates([Good|Rest]) -> + [Good|SquashDuplicates(Rest)]; + SquashDuplicates([]) -> [] + end, + Type = t_map(SquashDuplicates(SortedPairs)), + get_safe_underapprox_1(Left, [Type|Acc], Map1); values -> Es = cerl:values_es(Pat), {Ts, Map1} = get_safe_underapprox_1(Es, [], Map), @@ -1064,6 +1211,15 @@ get_safe_underapprox_1([Pat|Left], Acc, Map) -> get_safe_underapprox_1([], Acc, Map) -> {lists:reverse(Acc), Map}. +get_safe_overapprox(Pats) -> + lists:map(fun get_safe_overapprox_1/1, Pats). + +get_safe_overapprox_1(Pat) -> + case cerl:is_literal(Lit = cerl:fold_literal(Pat)) of + true -> t_from_term(cerl:concrete(Lit)); + false -> t_any() + end. + %%---------------------------------------- %% Guards %% @@ -1263,6 +1419,8 @@ get_bif_constr({erlang, is_integer, 1}, Dst, [Arg], State) -> get_bif_test_constr(Dst, Arg, t_integer(), State); get_bif_constr({erlang, is_list, 1}, Dst, [Arg], State) -> get_bif_test_constr(Dst, Arg, t_maybe_improper_list(), State); +get_bif_constr({erlang, is_map, 1}, Dst, [Arg], State) -> + get_bif_test_constr(Dst, Arg, t_map(), State); get_bif_constr({erlang, is_number, 1}, Dst, [Arg], State) -> get_bif_test_constr(Dst, Arg, t_number(), State); get_bif_constr({erlang, is_pid, 1}, Dst, [Arg], State) -> @@ -1900,7 +2058,7 @@ sane_maps(Map1, Map2, Keys, _S1, _S2) -> %% Solver v2 -record(v2_state, {constr_data = dict:new() :: dict:dict(), - state :: #state{}}). + state :: state()}). v2_solve_ref(Fun, Map, State) -> V2State = #v2_state{state = State}, @@ -2975,13 +3133,24 @@ mk_constraint_ref(Id, Deps) -> mk_constraint_list(Type, List) -> List1 = ordsets:from_list(lift_lists(Type, List)), - List2 = ordsets:filter(fun(X) -> get_deps(X) =/= [] end, List1), - Deps = calculate_deps(List2), + case Type of + conj -> + List2 = ordsets:filter(fun(X) -> get_deps(X) =/= [] end, List1), + mk_constraint_list_cont(Type, List2); + disj -> + case lists:any(fun(X) -> get_deps(X) =:= [] end, List1) of + true -> mk_constraint_list_cont(Type, [mk_constraint_any(eq)]); + false -> mk_constraint_list_cont(Type, List1) + end + end. + +mk_constraint_list_cont(Type, List) -> + Deps = calculate_deps(List), case Deps =:= [] of true -> #constraint_list{type = conj, list = [mk_constraint_any(eq)], deps = []}; - false -> #constraint_list{type = Type, list = List2, deps = Deps} + false -> #constraint_list{type = Type, list = List, deps = Deps} end. lift_lists(Type, List) -> @@ -3263,6 +3432,15 @@ find_constraint(Tuple, [#constraint_list{list = List}|Cs]) -> find_constraint(Tuple, [_|Cs]) -> find_constraint(Tuple, Cs). +-spec fold_literal_maybe_match(cerl:cerl(), state()) -> cerl:cerl(). + +fold_literal_maybe_match(Tree0, State) -> + Tree1 = cerl:fold_literal(Tree0), + case state__is_in_match(State) of + false -> Tree1; + true -> dialyzer_utils:refold_pattern(Tree1) + end. + lookup_record(Records, Tag, Arity) -> case erl_types:lookup_record(Tag, Arity, Records) of {ok, Fields} -> diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 5fc1c0e691..d37701f03b 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -49,6 +49,7 @@ process_record_remote_types/1, sets_filter/2, src_compiler_opts/0, + refold_pattern/1, parallelism/0, family/1 ]). @@ -752,6 +753,13 @@ pp_hook(Node, Ctxt, Cont) -> pp_binary(Node, Ctxt, Cont); bitstr -> pp_segment(Node, Ctxt, Cont); + map -> + pp_map(Node, Ctxt, Cont); + literal -> + case is_map(cerl:concrete(Node)) of + true -> pp_map(Node, Ctxt, Cont); + false -> Cont(Node, Ctxt) + end; _ -> Cont(Node, Ctxt) end. @@ -832,6 +840,87 @@ pp_atom(Atom) -> String = atom_to_list(cerl:atom_val(Atom)), prettypr:text(String). +pp_map(Node, Ctxt, Cont) -> + Arg = cerl:map_arg(Node), + Before = case cerl:is_c_map_empty(Arg) of + true -> prettypr:floating(prettypr:text("#{")); + false -> + prettypr:beside(Cont(Arg,Ctxt), + prettypr:floating(prettypr:text("#{"))) + end, + prettypr:beside( + Before, prettypr:beside( + prettypr:par(seq(cerl:map_es(Node), + prettypr:floating(prettypr:text(",")), + Ctxt, Cont)), + prettypr:floating(prettypr:text("}")))). + +seq([H | T], Separator, Ctxt, Fun) -> + case T of + [] -> [Fun(H, Ctxt)]; + _ -> [prettypr:beside(Fun(H, Ctxt), Separator) + | seq(T, Separator, Ctxt, Fun)] + end; +seq([], _, _, _) -> + [prettypr:empty()]. + +%%------------------------------------------------------------------------------ + +-spec refold_pattern(cerl:cerl()) -> cerl:cerl(). + +refold_pattern(Pat) -> + %% Avoid the churn of unfolding and refolding + case cerl:is_literal(Pat) andalso find_map(cerl:concrete(Pat)) of + true -> + Tree = refold_concrete_pat(cerl:concrete(Pat)), + PatAnn = cerl:get_ann(Pat), + case proplists:is_defined(label, PatAnn) of + %% Literals are not normally annotated with a label, but can be if, for + %% example, they were created by cerl:fold_literal/1. + true -> cerl:set_ann(Tree, PatAnn); + false -> + [{label, Label}] = cerl:get_ann(Tree), + cerl:set_ann(Tree, [{label, Label}|PatAnn]) + end; + false -> Pat + end. + +find_map(#{}) -> true; +find_map(Tuple) when is_tuple(Tuple) -> find_map(tuple_to_list(Tuple)); +find_map([H|T]) -> find_map(H) orelse find_map(T); +find_map(_) -> false. + +refold_concrete_pat(Val) -> + case Val of + _ when is_tuple(Val) -> + Els = lists:map(fun refold_concrete_pat/1, tuple_to_list(Val)), + case lists:all(fun cerl:is_literal/1, Els) of + true -> cerl:abstract(Val); + false -> label(cerl:c_tuple_skel(Els)) + end; + [H|T] -> + case cerl:is_literal(HP=refold_concrete_pat(H)) + and cerl:is_literal(TP=refold_concrete_pat(T)) + of + true -> cerl:abstract(Val); + false -> label(cerl:c_cons_skel(HP, TP)) + end; + M when is_map(M) -> + %% Map patterns are not generated by the parser(!), but they have a + %% property we want, namely that they are never folded into literals. + %% N.B.: The key in a map pattern is an expression, *not* a pattern. + label(cerl:c_map_pattern([cerl:c_map_pair_exact(cerl:abstract(K), + refold_concrete_pat(V)) + || {K, V} <- maps:to_list(M)])); + _ -> + cerl:abstract(Val) + end. + +label(Tree) -> + %% Sigh + Label = -erlang:unique_integer([positive]), + cerl:set_ann(Tree, [{label, Label}]). + %%------------------------------------------------------------------------------ -spec parallelism() -> integer(). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return index 89eb295604..638d031923 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return +++ b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return @@ -1,2 +1,2 @@ -supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{},[{_,{atom(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom()]} | #{}]}}, which is the expected return type for the callback of supervisor behaviour +supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{'intensity'=>non_neg_integer(), 'period'=>pos_integer(), 'strategy'=>'one_for_all' | 'one_for_one' | 'rest_for_one' | 'simple_one_for_one'},[{_,{atom(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom()]} | #{'id':=_, 'start':={atom(),atom(),'undefined' | [any()]}, 'modules'=>'dynamic' | [atom()], 'restart'=>'permanent' | 'temporary' | 'transient', 'shutdown'=>'brutal_kill' | 'infinity' | non_neg_integer(), 'type'=>'supervisor' | 'worker'}]}}, which is the expected return type for the callback of supervisor behaviour diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/compile_flags.hrl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/compile_flags.hrl new file mode 100644 index 0000000000..e5ee44ace1 --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/compile_flags.hrl @@ -0,0 +1,2 @@ +-define(AT_LEAST_19, 1). +-define(AT_LEAST_17, 1). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_common.hrl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_common.hrl new file mode 100644 index 0000000000..c10626c5cc --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_common.hrl @@ -0,0 +1,55 @@ +%%% Copyright 2010-2013 Manolis Papadakis <[email protected]>, +%%% Eirini Arvaniti <[email protected]> +%%% and Kostis Sagonas <[email protected]> +%%% +%%% This file is part of PropEr. +%%% +%%% PropEr is free software: you can redistribute it and/or modify +%%% it under the terms of the GNU General Public License as published by +%%% the Free Software Foundation, either version 3 of the License, or +%%% (at your option) any later version. +%%% +%%% PropEr is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%%% GNU General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public License +%%% along with PropEr. If not, see <http://www.gnu.org/licenses/>. + +%%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas +%%% @version {@version} +%%% @author Manolis Papadakis +%%% @doc Common parts of user and internal header files + + +%%------------------------------------------------------------------------------ +%% Test generation macros +%%------------------------------------------------------------------------------ + +-define(FORALL(X,RawType,Prop), proper:forall(RawType,fun(X) -> Prop end)). +-define(IMPLIES(Pre,Prop), proper:implies(Pre,?DELAY(Prop))). +-define(WHENFAIL(Action,Prop), proper:whenfail(?DELAY(Action),?DELAY(Prop))). +-define(TRAPEXIT(Prop), proper:trapexit(?DELAY(Prop))). +-define(TIMEOUT(Limit,Prop), proper:timeout(Limit,?DELAY(Prop))). +%% TODO: -define(ALWAYS(Tests,Prop), proper:always(Tests,?DELAY(Prop))). +%% TODO: -define(SOMETIMES(Tests,Prop), proper:sometimes(Tests,?DELAY(Prop))). + + +%%------------------------------------------------------------------------------ +%% Generator macros +%%------------------------------------------------------------------------------ + +-define(FORCE(X), (X)()). +-define(DELAY(X), fun() -> X end). +-define(LAZY(X), proper_types:lazy(?DELAY(X))). +-define(SIZED(SizeArg,Gen), proper_types:sized(fun(SizeArg) -> Gen end)). +-define(LET(X,RawType,Gen), proper_types:bind(RawType,fun(X) -> Gen end,false)). +-define(SHRINK(Gen,AltGens), + proper_types:shrinkwith(?DELAY(Gen),?DELAY(AltGens))). +-define(LETSHRINK(Xs,RawType,Gen), + proper_types:bind(RawType,fun(Xs) -> Gen end,true)). +-define(SUCHTHAT(X,RawType,Condition), + proper_types:add_constraint(RawType,fun(X) -> Condition end,true)). +-define(SUCHTHATMAYBE(X,RawType,Condition), + proper_types:add_constraint(RawType,fun(X) -> Condition end,false)). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_gen.erl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_gen.erl new file mode 100644 index 0000000000..b64a139e4d --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_gen.erl @@ -0,0 +1,611 @@ +%%% Copyright 2010-2015 Manolis Papadakis <[email protected]>, +%%% Eirini Arvaniti <[email protected]> +%%% and Kostis Sagonas <[email protected]> +%%% +%%% This file is part of PropEr. +%%% +%%% PropEr is free software: you can redistribute it and/or modify +%%% it under the terms of the GNU General Public License as published by +%%% the Free Software Foundation, either version 3 of the License, or +%%% (at your option) any later version. +%%% +%%% PropEr is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%%% GNU General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public License +%%% along with PropEr. If not, see <http://www.gnu.org/licenses/>. + +%%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas +%%% @version {@version} +%%% @author Manolis Papadakis + +%%% @doc Generator subsystem and generators for basic types. +%%% +%%% You can use <a href="#index">these</a> functions to try out the random +%%% instance generation and shrinking subsystems. +%%% +%%% CAUTION: These functions should never be used inside properties. They are +%%% meant for demonstration purposes only. + +-module(proper_gen). +-export([pick/1, pick/2, pick/3, + sample/1, sample/3, sampleshrink/1, sampleshrink/2]). + +-export([safe_generate/1]). +-export([generate/1, normal_gen/1, alt_gens/1, clean_instance/1, + get_ret_type/1]). +-export([integer_gen/3, float_gen/3, atom_gen/1, atom_rev/1, binary_gen/1, + binary_rev/1, binary_len_gen/1, bitstring_gen/1, bitstring_rev/1, + bitstring_len_gen/1, list_gen/2, distlist_gen/3, vector_gen/2, + union_gen/1, weighted_union_gen/1, tuple_gen/1, loose_tuple_gen/2, + loose_tuple_rev/2, exactly_gen/1, fixed_list_gen/1, function_gen/2, + any_gen/1, native_type_gen/2, safe_weighted_union_gen/1, + safe_union_gen/1]). + +-export_type([instance/0, imm_instance/0, sized_generator/0, nosize_generator/0, + generator/0, reverse_gen/0, combine_fun/0, alt_gens/0]). + +-include("proper_internal.hrl"). + +%%----------------------------------------------------------------------------- +%% Types +%%----------------------------------------------------------------------------- + +%% TODO: update imm_instance() when adding more types: be careful when reading +%% anything that returns it +%% @private_type +-type imm_instance() :: proper_types:raw_type() + | instance() + | {'$used', imm_instance(), imm_instance()} + | {'$to_part', imm_instance()}. +-type instance() :: term(). +%% A value produced by the random instance generator. +-type error_reason() :: 'arity_limit' | 'cant_generate' | {'typeserver',term()}. + +%% @private_type +-type sized_generator() :: fun((size()) -> imm_instance()). +%% @private_type +-type typed_sized_generator() :: {'typed', + fun((proper_types:type(),size()) -> + imm_instance())}. +%% @private_type +-type nosize_generator() :: fun(() -> imm_instance()). +%% @private_type +-type typed_nosize_generator() :: {'typed', + fun((proper_types:type()) -> + imm_instance())}. +%% @private_type +-type generator() :: sized_generator() + | typed_sized_generator() + | nosize_generator() + | typed_nosize_generator(). +%% @private_type +-type plain_reverse_gen() :: fun((instance()) -> imm_instance()). +%% @private_type +-type typed_reverse_gen() :: {'typed', + fun((proper_types:type(),instance()) -> + imm_instance())}. +%% @private_type +-type reverse_gen() :: plain_reverse_gen() | typed_reverse_gen(). +%% @private_type +-type combine_fun() :: fun((instance()) -> imm_instance()). +%% @private_type +-type alt_gens() :: fun(() -> [imm_instance()]). +%% @private_type +-type fun_seed() :: {non_neg_integer(),non_neg_integer()}. + + +%%----------------------------------------------------------------------------- +%% Instance generation functions +%%----------------------------------------------------------------------------- + +%% @private +-spec safe_generate(proper_types:raw_type()) -> + {'ok',imm_instance()} | {'error',error_reason()}. +safe_generate(RawType) -> + try generate(RawType) of + ImmInstance -> {ok, ImmInstance} + catch + throw:'$arity_limit' -> {error, arity_limit}; + throw:'$cant_generate' -> {error, cant_generate}; + throw:{'$typeserver',SubReason} -> {error, {typeserver,SubReason}} + end. + +%% @private +-spec generate(proper_types:raw_type()) -> imm_instance(). +generate(RawType) -> + Type = proper_types:cook_outer(RawType), + ok = add_parameters(Type), + Instance = generate(Type, get('$constraint_tries'), none), + ok = remove_parameters(Type), + Instance. + +-spec add_parameters(proper_types:type()) -> 'ok'. +add_parameters(Type) -> + case proper_types:find_prop(parameters, Type) of + {ok, Params} -> + OldParams = erlang:get('$parameters'), + case OldParams of + undefined -> + erlang:put('$parameters', Params); + _ -> + erlang:put('$parameters', Params ++ OldParams) + end, + ok; + _ -> + ok + end. + +-spec remove_parameters(proper_types:type()) -> 'ok'. +remove_parameters(Type) -> + case proper_types:find_prop(parameters, Type) of + {ok, Params} -> + AllParams = erlang:get('$parameters'), + case AllParams of + Params-> + erlang:erase('$parameters'); + _ -> + erlang:put('$parameters', AllParams -- Params) + end, + ok; + _ -> + ok + end. + +-spec generate(proper_types:type(), non_neg_integer(), + 'none' | {'ok',imm_instance()}) -> imm_instance(). +generate(_Type, 0, none) -> + throw('$cant_generate'); +generate(_Type, 0, {ok,Fallback}) -> + Fallback; +generate(Type, TriesLeft, Fallback) -> + ImmInstance = + case proper_types:get_prop(kind, Type) of + constructed -> + PartsType = proper_types:get_prop(parts_type, Type), + Combine = proper_types:get_prop(combine, Type), + ImmParts = generate(PartsType), + Parts = clean_instance(ImmParts), + ImmInstance1 = Combine(Parts), + %% TODO: We can just generate the internal type: if it's not + %% a type, it will turn into an exactly. + ImmInstance2 = + case proper_types:is_raw_type(ImmInstance1) of + true -> generate(ImmInstance1); + false -> ImmInstance1 + end, + {'$used',ImmParts,ImmInstance2}; + _ -> + ImmInstance1 = normal_gen(Type), + case proper_types:is_raw_type(ImmInstance1) of + true -> generate(ImmInstance1); + false -> ImmInstance1 + end + end, + case proper_types:satisfies_all(clean_instance(ImmInstance), Type) of + {_,true} -> ImmInstance; + {true,false} -> generate(Type, TriesLeft - 1, {ok,ImmInstance}); + {false,false} -> generate(Type, TriesLeft - 1, Fallback) + end. + +%% @equiv pick(Type, 10) +-spec pick(Type::proper_types:raw_type()) -> {'ok',instance()} | 'error'. +pick(RawType) -> + pick(RawType, 10). + +%% @equiv pick(Type, Size, os:timestamp()) +-spec pick(Type::proper_types:raw_type(), size()) -> {'ok',instance()} | 'error'. +pick(RawType, Size) -> + pick(RawType, Size, os:timestamp()). + +%% @doc Generates a random instance of `Type', of size `Size' with seed `Seed'. +-spec pick(Type::proper_types:raw_type(), size(), seed()) -> + {'ok',instance()} | 'error'. +pick(RawType, Size, Seed) -> + proper:global_state_init_size_seed(Size, Seed), + case clean_instance(safe_generate(RawType)) of + {ok,Instance} = Result -> + Msg = "WARNING: Some garbage has been left in the process registry " + "and the code server~n" + "to allow for the returned function(s) to run normally.~n" + "Please run proper:global_state_erase() when done.~n", + case contains_fun(Instance) of + true -> io:format(Msg, []); + false -> proper:global_state_erase() + end, + Result; + {error,Reason} -> + proper:report_error(Reason, fun io:format/2), + proper:global_state_erase(), + error + end. + +%% @equiv sample(Type, 10, 20) +-spec sample(Type::proper_types:raw_type()) -> 'ok'. +sample(RawType) -> + sample(RawType, 10, 20). + +%% @doc Generates and prints one random instance of `Type' for each size from +%% `StartSize' up to `EndSize'. +-spec sample(Type::proper_types:raw_type(), size(), size()) -> 'ok'. +sample(RawType, StartSize, EndSize) when StartSize =< EndSize -> + Tests = EndSize - StartSize + 1, + Prop = ?FORALL(X, RawType, begin io:format("~p~n",[X]), true end), + Opts = [quiet,{start_size,StartSize},{max_size,EndSize},{numtests,Tests}], + _ = proper:quickcheck(Prop, Opts), + ok. + +%% @equiv sampleshrink(Type, 10) +-spec sampleshrink(Type::proper_types:raw_type()) -> 'ok'. +sampleshrink(RawType) -> + sampleshrink(RawType, 10). + +%% @doc Generates a random instance of `Type', of size `Size', then shrinks it +%% as far as it goes. The value produced on each step of the shrinking process +%% is printed on the screen. +-spec sampleshrink(Type::proper_types:raw_type(), size()) -> 'ok'. +sampleshrink(RawType, Size) -> + proper:global_state_init_size(Size), + Type = proper_types:cook_outer(RawType), + case safe_generate(Type) of + {ok,ImmInstance} -> + Shrunk = keep_shrinking(ImmInstance, [], Type), + PrintInst = fun(I) -> io:format("~p~n",[clean_instance(I)]) end, + lists:foreach(PrintInst, Shrunk); + {error,Reason} -> + proper:report_error(Reason, fun io:format/2) + end, + proper:global_state_erase(), + ok. + +-spec keep_shrinking(imm_instance(), [imm_instance()], proper_types:type()) -> + [imm_instance(),...]. +keep_shrinking(ImmInstance, Acc, Type) -> + keep_shrinking(ImmInstance, Acc, Type, init). + +keep_shrinking(ImmInstance, Acc, Type, State) -> + case proper_shrink:shrink(ImmInstance, Type, State) of + {[], done} -> %% no more shrinkers + lists:reverse([ImmInstance|Acc]); + {[], NewState} -> + %% try next shrinker + keep_shrinking(ImmInstance, Acc, Type, NewState); + {[Shrunk|_Rest], _NewState} -> + Acc2 = [ImmInstance|Acc], + case lists:member(Shrunk, Acc2) of + true -> + %% Avoid infinite loops + lists:reverse(Acc2); + false -> + keep_shrinking(Shrunk, Acc2, Type) + end + end. + +-spec contains_fun(term()) -> boolean(). +contains_fun(List) when is_list(List) -> + proper_arith:safe_any(fun contains_fun/1, List); +contains_fun(Tuple) when is_tuple(Tuple) -> + contains_fun(tuple_to_list(Tuple)); +contains_fun(Fun) when is_function(Fun) -> + true; +contains_fun(_Term) -> + false. + + +%%----------------------------------------------------------------------------- +%% Utility functions +%%----------------------------------------------------------------------------- + +%% @private +-spec normal_gen(proper_types:type()) -> imm_instance(). +normal_gen(Type) -> + case proper_types:get_prop(generator, Type) of + {typed, Gen} -> + if + is_function(Gen, 1) -> Gen(Type); + is_function(Gen, 2) -> Gen(Type, proper:get_size(Type)) + end; + Gen -> + if + is_function(Gen, 0) -> Gen(); + is_function(Gen, 1) -> Gen(proper:get_size(Type)) + end + end. + +%% @private +-spec alt_gens(proper_types:type()) -> [imm_instance()]. +alt_gens(Type) -> + case proper_types:find_prop(alt_gens, Type) of + {ok, AltGens} -> ?FORCE(AltGens); + error -> [] + end. + +%% @private +-spec clean_instance(imm_instance()) -> instance(). +clean_instance({'$used',_ImmParts,ImmInstance}) -> + clean_instance(ImmInstance); +clean_instance({'$to_part',ImmInstance}) -> + clean_instance(ImmInstance); +clean_instance(ImmInstance) -> + if + is_list(ImmInstance) -> + %% CAUTION: this must handle improper lists + proper_arith:safe_map(fun clean_instance/1, ImmInstance); + is_tuple(ImmInstance) -> + proper_arith:tuple_map(fun clean_instance/1, ImmInstance); + true -> + ImmInstance + end. + + +%%----------------------------------------------------------------------------- +%% Basic type generators +%%----------------------------------------------------------------------------- + +%% @private +-spec integer_gen(size(), proper_types:extint(), proper_types:extint()) -> + integer(). +integer_gen(Size, inf, inf) -> + proper_arith:rand_int(Size); +integer_gen(Size, inf, High) -> + High - proper_arith:rand_non_neg_int(Size); +integer_gen(Size, Low, inf) -> + Low + proper_arith:rand_non_neg_int(Size); +integer_gen(Size, Low, High) -> + proper_arith:smart_rand_int(Size, Low, High). + +%% @private +-spec float_gen(size(), proper_types:extnum(), proper_types:extnum()) -> + float(). +float_gen(Size, inf, inf) -> + proper_arith:rand_float(Size); +float_gen(Size, inf, High) -> + High - proper_arith:rand_non_neg_float(Size); +float_gen(Size, Low, inf) -> + Low + proper_arith:rand_non_neg_float(Size); +float_gen(_Size, Low, High) -> + proper_arith:rand_float(Low, High). + +%% @private +-spec atom_gen(size()) -> proper_types:type(). +%% We make sure we never clash with internal atoms by checking that the first +%% character is not '$'. +atom_gen(Size) -> + ?LET(Str, + ?SUCHTHAT(X, + proper_types:resize(Size, + proper_types:list(proper_types:byte())), + X =:= [] orelse hd(X) =/= $$), + list_to_atom(Str)). + +%% @private +-spec atom_rev(atom()) -> imm_instance(). +atom_rev(Atom) -> + {'$used', atom_to_list(Atom), Atom}. + +%% @private +-spec binary_gen(size()) -> proper_types:type(). +binary_gen(Size) -> + ?LET(Bytes, + proper_types:resize(Size, + proper_types:list(proper_types:byte())), + list_to_binary(Bytes)). + +%% @private +-spec binary_rev(binary()) -> imm_instance(). +binary_rev(Binary) -> + {'$used', binary_to_list(Binary), Binary}. + +%% @private +-spec binary_len_gen(length()) -> proper_types:type(). +binary_len_gen(Len) -> + ?LET(Bytes, + proper_types:vector(Len, proper_types:byte()), + list_to_binary(Bytes)). + +%% @private +-spec bitstring_gen(size()) -> proper_types:type(). +bitstring_gen(Size) -> + ?LET({BytesHead, NumBits, TailByte}, + {proper_types:resize(Size,proper_types:binary()), + proper_types:range(0,7), proper_types:range(0,127)}, + <<BytesHead/binary, TailByte:NumBits>>). + +%% @private +-spec bitstring_rev(bitstring()) -> imm_instance(). +bitstring_rev(BitString) -> + List = bitstring_to_list(BitString), + {BytesList, BitsTail} = lists:splitwith(fun erlang:is_integer/1, List), + {NumBits, TailByte} = case BitsTail of + [] -> {0, 0}; + [Bits] -> N = bit_size(Bits), + <<Byte:N>> = Bits, + {N, Byte} + end, + {'$used', + {{'$used',BytesList,list_to_binary(BytesList)}, NumBits, TailByte}, + BitString}. + +%% @private +-spec bitstring_len_gen(length()) -> proper_types:type(). +bitstring_len_gen(Len) -> + BytesLen = Len div 8, + BitsLen = Len rem 8, + ?LET({BytesHead, NumBits, TailByte}, + {proper_types:binary(BytesLen), BitsLen, + proper_types:range(0, 1 bsl BitsLen - 1)}, + <<BytesHead/binary, TailByte:NumBits>>). + +%% @private +-spec list_gen(size(), proper_types:type()) -> [imm_instance()]. +list_gen(Size, ElemType) -> + Len = proper_arith:rand_int(0, Size), + vector_gen(Len, ElemType). + +%% @private +-spec distlist_gen(size(), sized_generator(), boolean()) -> [imm_instance()]. +distlist_gen(RawSize, Gen, NonEmpty) -> + Len = case NonEmpty of + true -> proper_arith:rand_int(1, erlang:max(1,RawSize)); + false -> proper_arith:rand_int(0, RawSize) + end, + Size = case Len of + 1 -> RawSize - 1; + _ -> RawSize + end, + %% TODO: this produces a lot of types: maybe a simple 'div' is sufficient? + Sizes = proper_arith:distribute(Size, Len), + InnerTypes = [Gen(S) || S <- Sizes], + fixed_list_gen(InnerTypes). + +%% @private +-spec vector_gen(length(), proper_types:type()) -> [imm_instance()]. +vector_gen(Len, ElemType) -> + vector_gen_tr(Len, ElemType, []). + +-spec vector_gen_tr(length(), proper_types:type(), [imm_instance()]) -> + [imm_instance()]. +vector_gen_tr(0, _ElemType, AccList) -> + AccList; +vector_gen_tr(Left, ElemType, AccList) -> + vector_gen_tr(Left - 1, ElemType, [generate(ElemType) | AccList]). + +%% @private +-spec union_gen([proper_types:type(),...]) -> imm_instance(). +union_gen(Choices) -> + {_Choice,Type} = proper_arith:rand_choose(Choices), + generate(Type). + +%% @private +-spec weighted_union_gen([{frequency(),proper_types:type()},...]) -> + imm_instance(). +weighted_union_gen(FreqChoices) -> + {_Choice,Type} = proper_arith:freq_choose(FreqChoices), + generate(Type). + +%% @private +-spec safe_union_gen([proper_types:type(),...]) -> imm_instance(). +safe_union_gen(Choices) -> + {Choice,Type} = proper_arith:rand_choose(Choices), + try generate(Type) + catch + error:_ -> + safe_union_gen(proper_arith:list_remove(Choice, Choices)) + end. + +%% @private +-spec safe_weighted_union_gen([{frequency(),proper_types:type()},...]) -> + imm_instance(). +safe_weighted_union_gen(FreqChoices) -> + {Choice,Type} = proper_arith:freq_choose(FreqChoices), + try generate(Type) + catch + error:_ -> + safe_weighted_union_gen(proper_arith:list_remove(Choice, + FreqChoices)) + end. + +%% @private +-spec tuple_gen([proper_types:type()]) -> tuple(). +tuple_gen(Fields) -> + list_to_tuple(fixed_list_gen(Fields)). + +%% @private +-spec loose_tuple_gen(size(), proper_types:type()) -> proper_types:type(). +loose_tuple_gen(Size, ElemType) -> + ?LET(L, + proper_types:resize(Size, proper_types:list(ElemType)), + list_to_tuple(L)). + +%% @private +-spec loose_tuple_rev(tuple(), proper_types:type()) -> imm_instance(). +loose_tuple_rev(Tuple, ElemType) -> + CleanList = tuple_to_list(Tuple), + List = case proper_types:find_prop(reverse_gen, ElemType) of + {ok,{typed, ReverseGen}} -> + [ReverseGen(ElemType,X) || X <- CleanList]; + {ok,ReverseGen} -> [ReverseGen(X) || X <- CleanList]; + error -> CleanList + end, + {'$used', List, Tuple}. + +%% @private +-spec exactly_gen(T) -> T. +exactly_gen(X) -> + X. + +%% @private +-spec fixed_list_gen([proper_types:type()]) -> imm_instance() + ; ({[proper_types:type()],proper_types:type()}) -> + maybe_improper_list(imm_instance(), imm_instance() | []). +fixed_list_gen({ProperHead,ImproperTail}) -> + [generate(F) || F <- ProperHead] ++ generate(ImproperTail); +fixed_list_gen(ProperFields) -> + [generate(F) || F <- ProperFields]. + +%% @private +-spec function_gen(arity(), proper_types:type()) -> function(). +function_gen(Arity, RetType) -> + FunSeed = {proper_arith:rand_int(0, ?SEED_RANGE - 1), + proper_arith:rand_int(0, ?SEED_RANGE - 1)}, + create_fun(Arity, RetType, FunSeed). + +%% @private +-spec any_gen(size()) -> imm_instance(). +any_gen(Size) -> + case get('$any_type') of + undefined -> real_any_gen(Size); + {type,AnyType} -> generate(proper_types:resize(Size, AnyType)) + end. + +-spec real_any_gen(size()) -> imm_instance(). +real_any_gen(0) -> + SimpleTypes = [proper_types:integer(), proper_types:float(), + proper_types:atom()], + union_gen(SimpleTypes); +real_any_gen(Size) -> + FreqChoices = [{?ANY_SIMPLE_PROB,simple}, {?ANY_BINARY_PROB,binary}, + {?ANY_EXPAND_PROB,expand}], + case proper_arith:freq_choose(FreqChoices) of + {_,simple} -> + real_any_gen(0); + {_,binary} -> + generate(proper_types:resize(Size, proper_types:bitstring())); + {_,expand} -> + %% TODO: statistics of produced terms? + NumElems = proper_arith:rand_int(0, Size - 1), + ElemSizes = proper_arith:distribute(Size - 1, NumElems), + ElemTypes = [?LAZY(real_any_gen(S)) || S <- ElemSizes], + case proper_arith:rand_int(1,2) of + 1 -> fixed_list_gen(ElemTypes); + 2 -> tuple_gen(ElemTypes) + end + end. + +%% @private +-spec native_type_gen(mod_name(), string()) -> proper_types:type(). +native_type_gen(Mod, TypeStr) -> + case proper_typeserver:translate_type({Mod,TypeStr}) of + {ok,Type} -> Type; + {error,Reason} -> throw({'$typeserver',Reason}) + end. + + +%%------------------------------------------------------------------------------ +%% Function-generation functions +%%------------------------------------------------------------------------------ + +-spec create_fun(arity(), proper_types:type(), fun_seed()) -> function(). +create_fun(_Arity, _RetType, _FunSeed) -> + fun() -> throw('$arity_limit') end. + +%% @private +-spec get_ret_type(function()) -> proper_types:type(). +get_ret_type(Fun) -> + {arity,Arity} = erlang:fun_info(Fun, arity), + put('$get_ret_type', true), + RetType = apply(Fun, lists:duplicate(Arity,dummy)), + erase('$get_ret_type'), + RetType. diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_internal.hrl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_internal.hrl new file mode 100644 index 0000000000..89e6b34296 --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_internal.hrl @@ -0,0 +1,98 @@ +%%% Copyright 2010-2013 Manolis Papadakis <[email protected]>, +%%% Eirini Arvaniti <[email protected]> +%%% and Kostis Sagonas <[email protected]> +%%% +%%% This file is part of PropEr. +%%% +%%% PropEr is free software: you can redistribute it and/or modify +%%% it under the terms of the GNU General Public License as published by +%%% the Free Software Foundation, either version 3 of the License, or +%%% (at your option) any later version. +%%% +%%% PropEr is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%%% GNU General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public License +%%% along with PropEr. If not, see <http://www.gnu.org/licenses/>. + +%%% @copyright 2010-2016 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas +%%% @version {@version} +%%% @author Manolis Papadakis +%%% @doc Internal header file: This header is included in all PropEr source +%%% files. + +-include("compile_flags.hrl"). +-include("proper_common.hrl"). + + +%%------------------------------------------------------------------------------ +%% Activate strip_types parse transform +%%------------------------------------------------------------------------------ + +-ifdef(NO_TYPES). +-compile({parse_transform, strip_types}). +-endif. + +%%------------------------------------------------------------------------------ +%% Random generator selection +%%------------------------------------------------------------------------------ + +-ifdef(USE_SFMT). +-define(RANDOM_MOD, sfmt). +-define(SEED_NAME, sfmt_seed). +-else. +-define(RANDOM_MOD, random). +-define(SEED_NAME, random_seed). +-endif. + +%%------------------------------------------------------------------------------ +%% Macros +%%------------------------------------------------------------------------------ + +-define(PROPERTY_PREFIX, "prop_"). + + +%%------------------------------------------------------------------------------ +%% Constants +%%------------------------------------------------------------------------------ + +-define(SEED_RANGE, 4294967296). +-define(MAX_ARITY, 20). +-define(MAX_TRIES_FACTOR, 5). +-define(ANY_SIMPLE_PROB, 3). +-define(ANY_BINARY_PROB, 1). +-define(ANY_EXPAND_PROB, 8). +-define(SMALL_RANGE_THRESHOLD, 16#FFFF). + + +%%------------------------------------------------------------------------------ +%% Common type aliases +%%------------------------------------------------------------------------------ + +%% TODO: Perhaps these should be moved inside modules. +-type mod_name() :: atom(). +-type fun_name() :: atom(). +-type size() :: non_neg_integer(). +-type length() :: non_neg_integer(). +-type position() :: pos_integer(). +-type frequency() :: pos_integer(). +-type seed() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}. + +-type abs_form() :: erl_parse:abstract_form(). +-type abs_expr() :: erl_parse:abstract_expr(). +-type abs_clause() :: erl_parse:abstract_clause(). + +%% TODO: Replace these with the appropriate types from stdlib. +-ifdef(AT_LEAST_19). +-type abs_type() :: erl_parse:abstract_type(). +-type abs_rec_field() :: term(). % erl_parse:af_field_decl(). +-else. +-type abs_type() :: term(). +-type abs_rec_field() :: term(). +-endif. + +-type loose_tuple(T) :: {} | {T} | {T,T} | {T,T,T} | {T,T,T,T} | {T,T,T,T,T} + | {T,T,T,T,T,T} | {T,T,T,T,T,T,T} | {T,T,T,T,T,T,T,T} + | {T,T,T,T,T,T,T,T,T} | {T,T,T,T,T,T,T,T,T,T} | tuple(). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_types.erl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_types.erl new file mode 100644 index 0000000000..6b154b813b --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_types.erl @@ -0,0 +1,1353 @@ +%%% Copyright 2010-2013 Manolis Papadakis <[email protected]>, +%%% Eirini Arvaniti <[email protected]> +%%% and Kostis Sagonas <[email protected]> +%%% +%%% This file is part of PropEr. +%%% +%%% PropEr is free software: you can redistribute it and/or modify +%%% it under the terms of the GNU General Public License as published by +%%% the Free Software Foundation, either version 3 of the License, or +%%% (at your option) any later version. +%%% +%%% PropEr is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%%% GNU General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public License +%%% along with PropEr. If not, see <http://www.gnu.org/licenses/>. + +%%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas +%%% @version {@version} +%%% @author Manolis Papadakis + +%%% @doc Type manipulation functions and predefined types. +%%% +%%% == Basic types == +%%% This module defines all the basic types of the PropEr type system as +%%% functions. See the <a href="#index">function index</a> for an overview. +%%% +%%% Types can be combined in tuples or lists to produce other types. Exact +%%% values (such as exact numbers, atoms, binaries and strings) can be combined +%%% with types inside such structures, like in this example of the type of a +%%% tagged tuple: ``{'result', integer()}''. +%%% +%%% When including the PropEr header file, all +%%% <a href="#index">API functions</a> of this module are automatically +%%% imported, unless `PROPER_NO_IMPORTS' is defined. +%%% +%%% == Customized types == +%%% The following operators can be applied to basic types in order to produce +%%% new ones: +%%% +%%% <dl> +%%% <dt>`?LET(<Xs>, <Xs_type>, <In>)'</dt> +%%% <dd>To produce an instance of this type, all appearances of the variables +%%% in `<Xs>' are replaced inside `<In>' by their corresponding values in a +%%% randomly generated instance of `<Xs_type>'. It's OK for the `<In>' part to +%%% evaluate to a type - in that case, an instance of the inner type is +%%% generated recursively.</dd> +%%% <dt>`?SUCHTHAT(<X>, <Type>, <Condition>)'</dt> +%%% <dd>This produces a specialization of `<Type>', which only includes those +%%% members of `<Type>' that satisfy the constraint `<Condition>' - that is, +%%% those members for which the function `fun(<X>) -> <Condition> end' returns +%%% `true'. If the constraint is very strict - that is, only a small +%%% percentage of instances of `<Type>' pass the test - it will take a lot of +%%% tries for the instance generation subsystem to randomly produce a valid +%%% instance. This will result in slower testing, and testing may even be +%%% stopped short, in case the `constraint_tries' limit is reached (see the +%%% "Options" section in the documentation of the {@link proper} module). If +%%% this is the case, it would be more appropriate to generate valid instances +%%% of the specialized type using the `?LET' macro. Also make sure that even +%%% small instances can satisfy the constraint, since PropEr will only try +%%% small instances at the start of testing. If this is not possible, you can +%%% instruct PropEr to start at a larger size, by supplying a suitable value +%%% for the `start_size' option (see the "Options" section in the +%%% documentation of the {@link proper} module).</dd> +%%% <dt>`?SUCHTHATMAYBE(<X>, <Type>, <Condition>)'</dt> +%%% <dd>Equivalent to the `?SUCHTHAT' macro, but the constraint `<Condition>' +%%% is considered non-strict: if the `constraint_tries' limit is reached, the +%%% generator will just return an instance of `<Type>' instead of failing, +%%% even if that instance doesn't satisfy the constraint.</dd> +%%% <dt>`?SHRINK(<Generator>, <List_of_alt_gens>)'</dt> +%%% <dd>This creates a type whose instances are generated by evaluating the +%%% statement block `<Generator>' (this may evaluate to a type, which will +%%% then be generated recursively). If an instance of such a type is to be +%%% shrunk, the generators in `<List_of_alt_gens>' are first run to produce +%%% hopefully simpler instances of the type. Thus, the generators in the +%%% second argument should be simpler than the default. The simplest ones +%%% should be at the front of the list, since those are the generators +%%% preferred by the shrinking subsystem. Like the main `<Generator>', the +%%% alternatives may also evaluate to a type, which is generated recursively. +%%% </dd> +%%% <dt>`?LETSHRINK(<List_of_variables>, <List_of_types>, <Generator>)'</dt> +%%% <dd>This is created by combining a `?LET' and a `?SHRINK' macro. Instances +%%% are generated by applying a randomly generated list of values inside +%%% `<Generator>' (just like a `?LET', with the added constraint that the +%%% variables and types must be provided in a list - alternatively, +%%% `<List_of_types>' may be a list or vector type). When shrinking instances +%%% of such a type, the sub-instances that were combined to produce it are +%%% first tried in place of the failing instance.</dd> +%%% <dt>`?LAZY(<Generator>)'</dt> +%%% <dd>This construct returns a type whose only purpose is to delay the +%%% evaluation of `<Generator>' (`<Generator>' can return a type, which will +%%% be generated recursively). Using this, you can simulate the lazy +%%% generation of instances: +%%% ``` stream() -> ?LAZY(frequency([ {1,[]}, {3,[0|stream()]} ])). ''' +%%% The above type produces lists of zeroes with an average length of 3. Note +%%% that, had we not enclosed the generator with a `?LAZY' macro, the +%%% evaluation would continue indefinitely, due to the eager evaluation of +%%% the Erlang language.</dd> +%%% <dt>`non_empty(<List_or_binary_type>)'</dt> +%%% <dd>See the documentation for {@link non_empty/1}.</dd> +%%% <dt>`noshrink(<Type>)'</dt> +%%% <dd>See the documentation for {@link noshrink/1}.</dd> +%%% <dt>`default(<Default_value>, <Type>)'</dt> +%%% <dd>See the documentation for {@link default/2}.</dd> +%%% <dt>`with_parameter(<Parameter>, <Value>, <Type>)'</dt> +%%% <dd>See the documentation for {@link with_parameter/3}.</dd> +%%% <dt>`with_parameters(<Param_value_pairs>, <Type>)'</dt> +%%% <dd>See the documentation for {@link with_parameters/2}.</dd> +%%% </dl> +%%% +%%% == Size manipulation == +%%% The following operators are related to the `size' parameter, which controls +%%% the maximum size of produced instances. The actual size of a produced +%%% instance is chosen randomly, but can never exceed the value of the `size' +%%% parameter at the moment of generation. A more accurate definition is the +%%% following: the maximum instance of `size S' can never be smaller than the +%%% maximum instance of `size S-1'. The actual size of an instance is measured +%%% differently for each type: the actual size of a list is its length, while +%%% the actual size of a tree may be the number of its internal nodes. Some +%%% types, e.g. unions, have no notion of size, thus their generation is not +%%% influenced by the value of `size'. The `size' parameter starts at 1 and +%%% grows automatically during testing. +%%% +%%% <dl> +%%% <dt>`?SIZED(<S>, <Generator>)'</dt> +%%% <dd>Creates a new type, whose instances are produced by replacing all +%%% appearances of the `<S>' parameter inside the statement block +%%% `<Generator>' with the value of the `size' parameter. It's OK for the +%%% `<Generator>' to return a type - in that case, an instance of the inner +%%% type is generated recursively.</dd> +%%% <dt>`resize(<New_size>, <Type>)'</dt> +%%% <dd>See the documentation for {@link resize/2}.</dd> +%%% </dl> + +-module(proper_types). +-export([is_inst/2, is_inst/3]). + +-export([integer/2, float/2, atom/0, binary/0, binary/1, bitstring/0, + bitstring/1, list/1, vector/2, union/1, weighted_union/1, tuple/1, + loose_tuple/1, exactly/1, fixed_list/1, function/2, any/0, + shrink_list/1, safe_union/1, safe_weighted_union/1]). +-export([integer/0, non_neg_integer/0, pos_integer/0, neg_integer/0, range/2, + float/0, non_neg_float/0, number/0, boolean/0, byte/0, char/0, + list/0, tuple/0, string/0, wunion/1, term/0, timeout/0, arity/0]). +-export([int/0, nat/0, largeint/0, real/0, bool/0, choose/2, elements/1, + oneof/1, frequency/1, return/1, default/2, orderedlist/1, function0/1, + function1/1, function2/1, function3/1, function4/1, + weighted_default/2]). +-export([resize/2, non_empty/1, noshrink/1]). + +-export([cook_outer/1, is_type/1, equal_types/2, is_raw_type/1, to_binary/1, + from_binary/1, get_prop/2, find_prop/2, safe_is_instance/2, + is_instance/2, unwrap/1, weakly/1, strongly/1, satisfies_all/2, + new_type/2, subtype/2]). +-export([lazy/1, sized/1, bind/3, shrinkwith/2, add_constraint/3, + native_type/2, distlist/3, with_parameter/3, with_parameters/2, + parameter/1, parameter/2]). +-export([le/2]). + +-export_type([type/0, raw_type/0, extint/0, extnum/0]). + +-include("proper_internal.hrl"). + + +%%------------------------------------------------------------------------------ +%% Comparison with erl_types +%%------------------------------------------------------------------------------ + +%% Missing types +%% ------------------- +%% will do: +%% records, maybe_improper_list(T,S), nonempty_improper_list(T,S) +%% maybe_improper_list(), maybe_improper_list(T), iolist, iodata +%% don't need: +%% nonempty_{list,string,maybe_improper_list} +%% won't do: +%% pid, port, ref, identifier, none, no_return, module, mfa, node +%% array, dict, digraph, set, gb_tree, gb_set, queue, tid + +%% Missing type information +%% ------------------------ +%% bin types: +%% other unit sizes? what about size info? +%% functions: +%% generally some fun, unspecified number of arguments but specified +%% return type +%% any: +%% doesn't cover functions and improper lists + + +%%------------------------------------------------------------------------------ +%% Type declaration macros +%%------------------------------------------------------------------------------ + +-define(BASIC(PropList), new_type(PropList,basic)). +-define(WRAPPER(PropList), new_type(PropList,wrapper)). +-define(CONSTRUCTED(PropList), new_type(PropList,constructed)). +-define(CONTAINER(PropList), new_type(PropList,container)). +-define(SUBTYPE(Type,PropList), subtype(PropList,Type)). + + +%%------------------------------------------------------------------------------ +%% Types +%%------------------------------------------------------------------------------ + +-type type_kind() :: 'basic' | 'wrapper' | 'constructed' | 'container' | atom(). +-type instance_test() :: fun((proper_gen:imm_instance()) -> boolean()) + | {'typed', + fun((proper_types:type(), + proper_gen:imm_instance()) -> boolean())}. +-type index() :: pos_integer(). +%% @alias +-type value() :: term(). +%% @private_type +%% @alias +-type extint() :: integer() | 'inf'. +%% @private_type +%% @alias +-type extnum() :: number() | 'inf'. +-type constraint_fun() :: fun((proper_gen:instance()) -> boolean()). + +-opaque type() :: {'$type', [type_prop()]}. +%% A type of the PropEr type system +%% @type raw_type(). You can consider this as an equivalent of {@type type()}. +-type raw_type() :: type() | [raw_type()] | loose_tuple(raw_type()) | term(). +-type type_prop_name() :: 'kind' | 'generator' | 'reverse_gen' | 'parts_type' + | 'combine' | 'alt_gens' | 'shrink_to_parts' + | 'size_transform' | 'is_instance' | 'shrinkers' + | 'noshrink' | 'internal_type' | 'internal_types' + | 'get_length' | 'split' | 'join' | 'get_indices' + | 'remove' | 'retrieve' | 'update' | 'constraints' + | 'parameters' | 'env' | 'subenv'. + +-type type_prop_value() :: term(). +-type type_prop() :: + {'kind', type_kind()} + | {'generator', proper_gen:generator()} + | {'reverse_gen', proper_gen:reverse_gen()} + | {'parts_type', type()} + | {'combine', proper_gen:combine_fun()} + | {'alt_gens', proper_gen:alt_gens()} + | {'shrink_to_parts', boolean()} + | {'size_transform', fun((size()) -> size())} + | {'is_instance', instance_test()} + | {'shrinkers', [proper_shrink:shrinker()]} + | {'noshrink', boolean()} + | {'internal_type', raw_type()} + | {'internal_types', tuple() | maybe_improper_list(type(),type() | [])} + %% The items returned by 'remove' must be of this type. + | {'get_length', fun((proper_gen:imm_instance()) -> length())} + %% If this is a container type, this should return the number of elements + %% it contains. + | {'split', fun((proper_gen:imm_instance()) -> [proper_gen:imm_instance()]) + | fun((length(),proper_gen:imm_instance()) -> + {proper_gen:imm_instance(),proper_gen:imm_instance()})} + %% If present, the appropriate form depends on whether get_length is + %% defined: if get_length is undefined, this must be in the one-argument + %% form (e.g. a tree should be split into its subtrees), else it must be + %% in the two-argument form (e.g. a list should be split in two at the + %% index provided). + | {'join', fun((proper_gen:imm_instance(),proper_gen:imm_instance()) -> + proper_gen:imm_instance())} + | {'get_indices', fun((proper_types:type(), + proper_gen:imm_instance()) -> [index()])} + %% If this is a container type, this should return a list of indices we + %% can use to remove or insert elements from the given instance. + | {'remove', fun((index(),proper_gen:imm_instance()) -> + proper_gen:imm_instance())} + | {'retrieve', fun((index(), proper_gen:imm_instance() | tuple() + | maybe_improper_list(type(),type() | [])) -> + value() | type())} + | {'update', fun((index(),value(),proper_gen:imm_instance()) -> + proper_gen:imm_instance())} + | {'constraints', [{constraint_fun(), boolean()}]} + %% A list of constraints on instances of this type: each constraint is a + %% tuple of a fun that must return 'true' for each valid instance and a + %% boolean field that specifies whether the condition is strict. + | {'parameters', [{atom(),value()}]} + | {'env', term()} + | {'subenv', term()}. + + +%%------------------------------------------------------------------------------ +%% Type manipulation functions +%%------------------------------------------------------------------------------ + +%% TODO: We shouldn't need the fully qualified type name in the range of these +%% functions. + +%% @private +%% TODO: just cook/1 ? +-spec cook_outer(raw_type()) -> proper_types:type(). +cook_outer(Type = {'$type',_Props}) -> + Type; +cook_outer(RawType) -> + if + is_tuple(RawType) -> tuple(tuple_to_list(RawType)); + %% CAUTION: this must handle improper lists + is_list(RawType) -> fixed_list(RawType); + %% default case (covers integers, floats, atoms, binaries, ...): + true -> exactly(RawType) + end. + +%% @private +-spec is_type(term()) -> boolean(). +is_type({'$type',_Props}) -> + true; +is_type(_) -> + false. + +%% @private +-spec equal_types(proper_types:type(), proper_types:type()) -> boolean(). +equal_types(SameType, SameType) -> + true; +equal_types(_, _) -> + false. + +%% @private +-spec is_raw_type(term()) -> boolean(). +is_raw_type({'$type',_TypeProps}) -> + true; +is_raw_type(X) -> + if + is_tuple(X) -> is_raw_type_list(tuple_to_list(X)); + is_list(X) -> is_raw_type_list(X); + true -> false + end. + +-spec is_raw_type_list(maybe_improper_list()) -> boolean(). +%% CAUTION: this must handle improper lists +is_raw_type_list(List) -> + proper_arith:safe_any(fun is_raw_type/1, List). + +%% @private +-spec to_binary(proper_types:type()) -> binary(). +to_binary(Type) -> + term_to_binary(Type). + +%% @private +-ifdef(AT_LEAST_17). +-spec from_binary(binary()) -> proper_types:type(). +-endif. +from_binary(Binary) -> + binary_to_term(Binary). + +-spec type_from_list([type_prop()]) -> proper_types:type(). +type_from_list(KeyValueList) -> + {'$type',KeyValueList}. + +-spec add_prop(type_prop_name(), type_prop_value(), proper_types:type()) -> + proper_types:type(). +add_prop(PropName, Value, {'$type',Props}) -> + {'$type',lists:keystore(PropName, 1, Props, {PropName, Value})}. + +-spec add_props([type_prop()], proper_types:type()) -> proper_types:type(). +add_props(PropList, {'$type',OldProps}) -> + {'$type', lists:foldl(fun({N,_}=NV,Acc) -> + lists:keystore(N, 1, Acc, NV) + end, OldProps, PropList)}. + +-spec append_to_prop(type_prop_name(), type_prop_value(), + proper_types:type()) -> proper_types:type(). +append_to_prop(PropName, Value, {'$type',Props}) -> + Val = case lists:keyfind(PropName, 1, Props) of + {PropName, V} -> + V; + _ -> + [] + end, + {'$type', lists:keystore(PropName, 1, Props, + {PropName, lists:reverse([Value|Val])})}. + +-spec append_list_to_prop(type_prop_name(), [type_prop_value()], + proper_types:type()) -> proper_types:type(). +append_list_to_prop(PropName, List, {'$type',Props}) -> + {PropName, Val} = lists:keyfind(PropName, 1, Props), + {'$type', lists:keystore(PropName, 1, Props, {PropName, Val++List})}. + +%% @private +-spec get_prop(type_prop_name(), proper_types:type()) -> type_prop_value(). +get_prop(PropName, {'$type',Props}) -> + {_PropName, Val} = lists:keyfind(PropName, 1, Props), + Val. + +%% @private +-spec find_prop(type_prop_name(), proper_types:type()) -> + {'ok',type_prop_value()} | 'error'. +find_prop(PropName, {'$type',Props}) -> + case lists:keyfind(PropName, 1, Props) of + {PropName, Value} -> + {ok, Value}; + _ -> + error + end. + +%% @private +-spec new_type([type_prop()], type_kind()) -> proper_types:type(). +new_type(PropList, Kind) -> + Type = type_from_list(PropList), + add_prop(kind, Kind, Type). + +%% @private +-spec subtype([type_prop()], proper_types:type()) -> proper_types:type(). +%% TODO: should the 'is_instance' function etc. be reset for subtypes? +subtype(PropList, Type) -> + add_props(PropList, Type). + +%% @private +-spec is_inst(proper_gen:instance(), raw_type()) -> + boolean() | {'error',{'typeserver',term()}}. +is_inst(Instance, RawType) -> + is_inst(Instance, RawType, 10). + +%% @private +-spec is_inst(proper_gen:instance(), raw_type(), size()) -> + boolean() | {'error',{'typeserver',term()}}. +is_inst(Instance, RawType, Size) -> + proper:global_state_init_size(Size), + Result = safe_is_instance(Instance, RawType), + proper:global_state_erase(), + Result. + +%% @private +-spec safe_is_instance(proper_gen:imm_instance(), raw_type()) -> + boolean() | {'error',{'typeserver',term()}}. +safe_is_instance(ImmInstance, RawType) -> + try is_instance(ImmInstance, RawType) catch + throw:{'$typeserver',SubReason} -> {error, {typeserver,SubReason}} + end. + +%% @private +-spec is_instance(proper_gen:imm_instance(), raw_type()) -> boolean(). +%% TODO: If the second argument is not a type, let it pass (don't even check for +%% term equality?) - if it's a raw type, don't cook it, instead recurse +%% into it. +is_instance(ImmInstance, RawType) -> + CleanInstance = proper_gen:clean_instance(ImmInstance), + Type = cook_outer(RawType), + (case get_prop(kind, Type) of + wrapper -> wrapper_test(ImmInstance, Type); + constructed -> constructed_test(ImmInstance, Type); + _ -> false + end + orelse + case find_prop(is_instance, Type) of + {ok,{typed, IsInstance}} -> IsInstance(Type, ImmInstance); + {ok,IsInstance} -> IsInstance(ImmInstance); + error -> false + end) + andalso weakly(satisfies_all(CleanInstance, Type)). + +-spec wrapper_test(proper_gen:imm_instance(), proper_types:type()) -> boolean(). +wrapper_test(ImmInstance, Type) -> + %% TODO: check if it's actually a raw type that's returned? + lists:any(fun(T) -> is_instance(ImmInstance, T) end, unwrap(Type)). + +%% @private +-ifdef(AT_LEAST_17). +-spec unwrap(proper_types:type()) -> [proper_types:type(),...]. +-endif. +%% TODO: check if it's actually a raw type that's returned? +unwrap(Type) -> + RawInnerTypes = proper_gen:alt_gens(Type) ++ [proper_gen:normal_gen(Type)], + [cook_outer(T) || T <- RawInnerTypes]. + +-spec constructed_test(proper_gen:imm_instance(), proper_types:type()) -> + boolean(). +constructed_test({'$used',ImmParts,ImmInstance}, Type) -> + PartsType = get_prop(parts_type, Type), + Combine = get_prop(combine, Type), + is_instance(ImmParts, PartsType) andalso + begin + %% TODO: check if it's actually a raw type that's returned? + %% TODO: move construction code to proper_gen + %% TODO: non-type => should we check for strict term equality? + RawInnerType = Combine(proper_gen:clean_instance(ImmParts)), + is_instance(ImmInstance, RawInnerType) + end; +constructed_test({'$to_part',ImmInstance}, Type) -> + PartsType = get_prop(parts_type, Type), + get_prop(shrink_to_parts, Type) =:= true andalso + %% TODO: we reject non-container types + get_prop(kind, PartsType) =:= container andalso + case {find_prop(internal_type,PartsType), + find_prop(internal_types,PartsType)} of + {{ok,EachPartType},error} -> + %% The parts are in a list or a vector. + is_instance(ImmInstance, EachPartType); + {error,{ok,PartTypesList}} -> + %% The parts are in a fixed list. + %% TODO: It should always be a proper list. + lists:any(fun(T) -> is_instance(ImmInstance,T) end, PartTypesList) + end; +constructed_test(_CleanInstance, _Type) -> + %% TODO: can we do anything better? + false. + +%% @private +-spec weakly({boolean(),boolean()}) -> boolean(). +weakly({B1,_B2}) -> B1. + +%% @private +-spec strongly({boolean(),boolean()}) -> boolean(). +strongly({_B1,B2}) -> B2. + +-spec satisfies(proper_gen:instance(), {constraint_fun(),boolean()}) + -> {boolean(),boolean()}. +satisfies(Instance, {Test,false}) -> + {true,Test(Instance)}; +satisfies(Instance, {Test,true}) -> + Result = Test(Instance), + {Result,Result}. + +%% @private +-spec satisfies_all(proper_gen:instance(), proper_types:type()) -> + {boolean(),boolean()}. +satisfies_all(Instance, Type) -> + case find_prop(constraints, Type) of + {ok, Constraints} -> + L = [satisfies(Instance, C) || C <- Constraints], + {L1,L2} = lists:unzip(L), + {lists:all(fun(B) -> B end, L1), lists:all(fun(B) -> B end, L2)}; + error -> + {true,true} + end. + + +%%------------------------------------------------------------------------------ +%% Type definition functions +%%------------------------------------------------------------------------------ + +%% @private +-spec lazy(proper_gen:nosize_generator()) -> proper_types:type(). +lazy(Gen) -> + ?WRAPPER([ + {generator, Gen} + ]). + +%% @private +-spec sized(proper_gen:sized_generator()) -> proper_types:type(). +sized(Gen) -> + ?WRAPPER([ + {generator, Gen} + ]). + +%% @private +-spec bind(raw_type(), proper_gen:combine_fun(), boolean()) -> + proper_types:type(). +bind(RawPartsType, Combine, ShrinkToParts) -> + PartsType = cook_outer(RawPartsType), + ?CONSTRUCTED([ + {parts_type, PartsType}, + {combine, Combine}, + {shrink_to_parts, ShrinkToParts} + ]). + +%% @private +-spec shrinkwith(proper_gen:nosize_generator(), proper_gen:alt_gens()) -> + proper_types:type(). +shrinkwith(Gen, DelaydAltGens) -> + ?WRAPPER([ + {generator, Gen}, + {alt_gens, DelaydAltGens} + ]). + +%% @private +-spec add_constraint(raw_type(), constraint_fun(), boolean()) -> + proper_types:type(). +add_constraint(RawType, Condition, IsStrict) -> + Type = cook_outer(RawType), + append_to_prop(constraints, {Condition,IsStrict}, Type). + +%% @private +-spec native_type(mod_name(), string()) -> proper_types:type(). +native_type(Mod, TypeStr) -> + ?WRAPPER([ + {generator, fun() -> proper_gen:native_type_gen(Mod,TypeStr) end} + ]). + + +%%------------------------------------------------------------------------------ +%% Basic types +%%------------------------------------------------------------------------------ + +%% @doc All integers between `Low' and `High', bounds included. +%% `Low' and `High' must be Erlang expressions that evaluate to integers, with +%% `Low =< High'. Additionally, `Low' and `High' may have the value `inf', in +%% which case they represent minus infinity and plus infinity respectively. +%% Instances shrink towards 0 if `Low =< 0 =< High', or towards the bound with +%% the smallest absolute value otherwise. +-spec integer(extint(), extint()) -> proper_types:type(). +integer(Low, High) -> + ?BASIC([ + {env, {Low, High}}, + {generator, {typed, fun integer_gen/2}}, + {is_instance, {typed, fun integer_is_instance/2}}, + {shrinkers, [fun number_shrinker/3]} + ]). + +integer_gen(Type, Size) -> + {Low, High} = get_prop(env, Type), + proper_gen:integer_gen(Size, Low, High). + +integer_is_instance(Type, X) -> + {Low, High} = get_prop(env, Type), + is_integer(X) andalso le(Low, X) andalso le(X, High). + +number_shrinker(X, Type, S) -> + {Low, High} = get_prop(env, Type), + proper_shrink:number_shrinker(X, Low, High, S). + +%% @doc All floats between `Low' and `High', bounds included. +%% `Low' and `High' must be Erlang expressions that evaluate to floats, with +%% `Low =< High'. Additionally, `Low' and `High' may have the value `inf', in +%% which case they represent minus infinity and plus infinity respectively. +%% Instances shrink towards 0.0 if `Low =< 0.0 =< High', or towards the bound +%% with the smallest absolute value otherwise. +-spec float(extnum(), extnum()) -> proper_types:type(). +float(Low, High) -> + ?BASIC([ + {env, {Low, High}}, + {generator, {typed, fun float_gen/2}}, + {is_instance, {typed, fun float_is_instance/2}}, + {shrinkers, [fun number_shrinker/3]} + ]). + +float_gen(Type, Size) -> + {Low, High} = get_prop(env, Type), + proper_gen:float_gen(Size, Low, High). + +float_is_instance(Type, X) -> + {Low, High} = get_prop(env, Type), + is_float(X) andalso le(Low, X) andalso le(X, High). + +%% @private +-spec le(extnum(), extnum()) -> boolean(). +le(inf, _B) -> true; +le(_A, inf) -> true; +le(A, B) -> A =< B. + +%% @doc All atoms. All atoms used internally by PropEr start with a '`$'', so +%% such atoms will never be produced as instances of this type. You should also +%% refrain from using such atoms in your code, to avoid a potential clash. +%% Instances shrink towards the empty atom, ''. +-spec atom() -> proper_types:type(). +atom() -> + ?WRAPPER([ + {generator, fun proper_gen:atom_gen/1}, + {reverse_gen, fun proper_gen:atom_rev/1}, + {size_transform, fun(Size) -> erlang:min(Size,255) end}, + {is_instance, fun atom_is_instance/1} + ]). + +atom_is_instance(X) -> + is_atom(X) + %% We return false for atoms starting with '$', since these are + %% atoms used internally and never produced by the atom generator. + andalso (X =:= '' orelse hd(atom_to_list(X)) =/= $$). + +%% @doc All binaries. Instances shrink towards the empty binary, `<<>>'. +-spec binary() -> proper_types:type(). +binary() -> + ?WRAPPER([ + {generator, fun proper_gen:binary_gen/1}, + {reverse_gen, fun proper_gen:binary_rev/1}, + {is_instance, fun erlang:is_binary/1} + ]). + +%% @doc All binaries with a byte size of `Len'. +%% `Len' must be an Erlang expression that evaluates to a non-negative integer. +%% Instances shrink towards binaries of zeroes. +-spec binary(length()) -> proper_types:type(). +binary(Len) -> + ?WRAPPER([ + {env, Len}, + {generator, {typed, fun binary_len_gen/1}}, + {reverse_gen, fun proper_gen:binary_rev/1}, + {is_instance, {typed, fun binary_len_is_instance/2}} + ]). + +binary_len_gen(Type) -> + Len = get_prop(env, Type), + proper_gen:binary_len_gen(Len). + +binary_len_is_instance(Type, X) -> + Len = get_prop(env, Type), + is_binary(X) andalso byte_size(X) =:= Len. + +%% @doc All bitstrings. Instances shrink towards the empty bitstring, `<<>>'. +-spec bitstring() -> proper_types:type(). +bitstring() -> + ?WRAPPER([ + {generator, fun proper_gen:bitstring_gen/1}, + {reverse_gen, fun proper_gen:bitstring_rev/1}, + {is_instance, fun erlang:is_bitstring/1} + ]). + +%% @doc All bitstrings with a bit size of `Len'. +%% `Len' must be an Erlang expression that evaluates to a non-negative integer. +%% Instances shrink towards bitstrings of zeroes +-spec bitstring(length()) -> proper_types:type(). +bitstring(Len) -> + ?WRAPPER([ + {env, Len}, + {generator, {typed, fun bitstring_len_gen/1}}, + {reverse_gen, fun proper_gen:bitstring_rev/1}, + {is_instance, {typed, fun bitstring_len_is_instance/2}} + ]). + +bitstring_len_gen(Type) -> + Len = get_prop(env, Type), + proper_gen:bitstring_len_gen(Len). + +bitstring_len_is_instance(Type, X) -> + Len = get_prop(env, Type), + is_bitstring(X) andalso bit_size(X) =:= Len. + +%% @doc All lists containing elements of type `ElemType'. +%% Instances shrink towards the empty list, `[]'. +-spec list(ElemType::raw_type()) -> proper_types:type(). +% TODO: subtyping would be useful here (list, vector, fixed_list) +list(RawElemType) -> + ElemType = cook_outer(RawElemType), + ?CONTAINER([ + {generator, {typed, fun list_gen/2}}, + {is_instance, {typed, fun list_is_instance/2}}, + {internal_type, ElemType}, + {get_length, fun erlang:length/1}, + {split, fun lists:split/2}, + {join, fun lists:append/2}, + {get_indices, fun list_get_indices/2}, + {remove, fun proper_arith:list_remove/2}, + {retrieve, fun lists:nth/2}, + {update, fun proper_arith:list_update/3} + ]). + +list_gen(Type, Size) -> + ElemType = get_prop(internal_type, Type), + proper_gen:list_gen(Size, ElemType). + +list_is_instance(Type, X) -> + ElemType = get_prop(internal_type, Type), + list_test(X, ElemType). + +%% @doc A type that generates exactly the list `List'. Instances shrink towards +%% shorter sublists of the original list. +-spec shrink_list([term()]) -> proper_types:type(). +shrink_list(List) -> + ?CONTAINER([ + {env, List}, + {generator, {typed, fun shrink_list_gen/1}}, + {is_instance, {typed, fun shrink_list_is_instance/2}}, + {get_length, fun erlang:length/1}, + {split, fun lists:split/2}, + {join, fun lists:append/2}, + {get_indices, fun list_get_indices/2}, + {remove, fun proper_arith:list_remove/2} + ]). + +shrink_list_gen(Type) -> + get_prop(env, Type). + +shrink_list_is_instance(Type, X) -> + List = get_prop(env, Type), + is_sublist(X, List). + +-spec is_sublist([term()], [term()]) -> boolean(). +is_sublist([], _) -> true; +is_sublist(_, []) -> false; +is_sublist([H|T1], [H|T2]) -> is_sublist(T1, T2); +is_sublist(Slice, [_|T2]) -> is_sublist(Slice, T2). + +-spec list_test(proper_gen:imm_instance(), proper_types:type()) -> boolean(). +list_test(X, ElemType) -> + is_list(X) andalso lists:all(fun(E) -> is_instance(E, ElemType) end, X). + +%% @private +-spec list_get_indices(proper_gen:generator(), list()) -> [position()]. +list_get_indices(_, List) -> + lists:seq(1, length(List)). + +%% @private +%% This assumes that: +%% - instances of size S are always valid instances of size >S +%% - any recursive calls inside Gen are lazy +-spec distlist(size(), proper_gen:sized_generator(), boolean()) -> + proper_types:type(). +distlist(Size, Gen, NonEmpty) -> + ParentType = case NonEmpty of + true -> non_empty(list(Gen(Size))); + false -> list(Gen(Size)) + end, + ?SUBTYPE(ParentType, [ + {subenv, {Size, Gen, NonEmpty}}, + {generator, {typed, fun distlist_gen/1}} + ]). + +distlist_gen(Type) -> + {Size, Gen, NonEmpty} = get_prop(subenv, Type), + proper_gen:distlist_gen(Size, Gen, NonEmpty). + +%% @doc All lists of length `Len' containing elements of type `ElemType'. +%% `Len' must be an Erlang expression that evaluates to a non-negative integer. +-spec vector(length(), ElemType::raw_type()) -> proper_types:type(). +vector(Len, RawElemType) -> + ElemType = cook_outer(RawElemType), + ?CONTAINER([ + {env, Len}, + {generator, {typed, fun vector_gen/1}}, + {is_instance, {typed, fun vector_is_instance/2}}, + {internal_type, ElemType}, + {get_indices, fun vector_get_indices/2}, + {retrieve, fun lists:nth/2}, + {update, fun proper_arith:list_update/3} + ]). + +vector_gen(Type) -> + Len = get_prop(env, Type), + ElemType = get_prop(internal_type, Type), + proper_gen:vector_gen(Len, ElemType). + +vector_is_instance(Type, X) -> + Len = get_prop(env, Type), + ElemType = get_prop(internal_type, Type), + is_list(X) + andalso length(X) =:= Len + andalso lists:all(fun(E) -> is_instance(E, ElemType) end, X). + +vector_get_indices(Type, _X) -> + lists:seq(1, get_prop(env, Type)). + +%% @doc The union of all types in `ListOfTypes'. `ListOfTypes' can't be empty. +%% The random instance generator is equally likely to choose any one of the +%% types in `ListOfTypes'. The shrinking subsystem will always try to shrink an +%% instance of a type union to an instance of the first type in `ListOfTypes', +%% thus you should write the simplest case first. +-spec union(ListOfTypes::[raw_type(),...]) -> proper_types:type(). +union(RawChoices) -> + Choices = [cook_outer(C) || C <- RawChoices], + ?BASIC([ + {env, Choices}, + {generator, {typed, fun union_gen/1}}, + {is_instance, {typed, fun union_is_instance/2}}, + {shrinkers, [fun union_shrinker_1/3, fun union_shrinker_2/3]} + ]). + +union_gen(Type) -> + Choices = get_prop(env,Type), + proper_gen:union_gen(Choices). + +union_is_instance(Type, X) -> + Choices = get_prop(env, Type), + lists:any(fun(C) -> is_instance(X, C) end, Choices). + +union_shrinker_1(X, Type, S) -> + Choices = get_prop(env, Type), + proper_shrink:union_first_choice_shrinker(X, Choices, S). + +union_shrinker_2(X, Type, S) -> + Choices = get_prop(env, Type), + proper_shrink:union_recursive_shrinker(X, Choices, S). + +%% @doc A specialization of {@link union/1}, where each type in `ListOfTypes' is +%% assigned a frequency. Frequencies must be Erlang expressions that evaluate to +%% positive integers. Types with larger frequencies are more likely to be chosen +%% by the random instance generator. The shrinking subsystem will ignore the +%% frequencies and try to shrink towards the first type in the list. +-spec weighted_union(ListOfTypes::[{frequency(),raw_type()},...]) -> + proper_types:type(). +weighted_union(RawFreqChoices) -> + CookFreqType = fun({Freq,RawType}) -> {Freq,cook_outer(RawType)} end, + FreqChoices = lists:map(CookFreqType, RawFreqChoices), + Choices = [T || {_F,T} <- FreqChoices], + ?SUBTYPE(union(Choices), [ + {subenv, FreqChoices}, + {generator, {typed, fun weighted_union_gen/1}} + ]). + +weighted_union_gen(Gen) -> + FreqChoices = get_prop(subenv, Gen), + proper_gen:weighted_union_gen(FreqChoices). + +%% @private +-spec safe_union([raw_type(),...]) -> proper_types:type(). +safe_union(RawChoices) -> + Choices = [cook_outer(C) || C <- RawChoices], + subtype( + [{subenv, Choices}, + {generator, {typed, fun safe_union_gen/1}}], + union(Choices)). + +safe_union_gen(Type) -> + Choices = get_prop(subenv, Type), + proper_gen:safe_union_gen(Choices). + +%% @private +-spec safe_weighted_union([{frequency(),raw_type()},...]) -> + proper_types:type(). +safe_weighted_union(RawFreqChoices) -> + CookFreqType = fun({Freq,RawType}) -> + {Freq,cook_outer(RawType)} end, + FreqChoices = lists:map(CookFreqType, RawFreqChoices), + Choices = [T || {_F,T} <- FreqChoices], + subtype([{subenv, FreqChoices}, + {generator, {typed, fun safe_weighted_union_gen/1}}], + union(Choices)). + +safe_weighted_union_gen(Type) -> + FreqChoices = get_prop(subenv, Type), + proper_gen:safe_weighted_union_gen(FreqChoices). + +%% @doc All tuples whose i-th element is an instance of the type at index i of +%% `ListOfTypes'. Also written simply as a tuple of types. +-spec tuple(ListOfTypes::[raw_type()]) -> proper_types:type(). +tuple(RawFields) -> + Fields = [cook_outer(F) || F <- RawFields], + ?CONTAINER([ + {env, Fields}, + {generator, {typed, fun tuple_gen/1}}, + {is_instance, {typed, fun tuple_is_instance/2}}, + {internal_types, list_to_tuple(Fields)}, + {get_indices, fun tuple_get_indices/2}, + {retrieve, fun erlang:element/2}, + {update, fun tuple_update/3} + ]). + +tuple_gen(Type) -> + Fields = get_prop(env, Type), + proper_gen:tuple_gen(Fields). + +tuple_is_instance(Type, X) -> + Fields = get_prop(env, Type), + is_tuple(X) andalso fixed_list_test(tuple_to_list(X), Fields). + +tuple_get_indices(Type, _X) -> + lists:seq(1, length(get_prop(env, Type))). + +-spec tuple_update(index(), value(), tuple()) -> tuple(). +tuple_update(Index, NewElem, Tuple) -> + setelement(Index, Tuple, NewElem). + +%% @doc Tuples whose elements are all of type `ElemType'. +%% Instances shrink towards the 0-size tuple, `{}'. +-spec loose_tuple(ElemType::raw_type()) -> proper_types:type(). +loose_tuple(RawElemType) -> + ElemType = cook_outer(RawElemType), + ?WRAPPER([ + {env, ElemType}, + {generator, {typed, fun loose_tuple_gen/2}}, + {reverse_gen, {typed, fun loose_tuple_rev/2}}, + {is_instance, {typed, fun loose_tuple_is_instance/2}} + ]). + +loose_tuple_gen(Type, Size) -> + ElemType = get_prop(env, Type), + proper_gen:loose_tuple_gen(Size, ElemType). + +loose_tuple_rev(Type, X) -> + ElemType = get_prop(env, Type), + proper_gen:loose_tuple_rev(X, ElemType). + +loose_tuple_is_instance(Type, X) -> + ElemType = get_prop(env, Type), + is_tuple(X) andalso list_test(tuple_to_list(X), ElemType). + +%% @doc Singleton type consisting only of `E'. `E' must be an evaluated term. +%% Also written simply as `E'. +-spec exactly(term()) -> proper_types:type(). +exactly(E) -> + ?BASIC([ + {env, E}, + {generator, {typed, fun exactly_gen/1}}, + {is_instance, {typed, fun exactly_is_instance/2}} + ]). + +exactly_gen(Type) -> + E = get_prop(env, Type), + proper_gen:exactly_gen(E). + +exactly_is_instance(Type, X) -> + E = get_prop(env, Type), + X =:= E. + +%% @doc All lists whose i-th element is an instance of the type at index i of +%% `ListOfTypes'. Also written simply as a list of types. +-spec fixed_list(ListOfTypes::maybe_improper_list(raw_type(),raw_type()|[])) -> + proper_types:type(). +fixed_list(MaybeImproperRawFields) -> + %% CAUTION: must handle improper lists + {Fields, Internal, Len, Retrieve, Update} = + case proper_arith:cut_improper_tail(MaybeImproperRawFields) of + % TODO: have cut_improper_tail return the length and use it in test? + {ProperRawHead, ImproperRawTail} -> + HeadLen = length(ProperRawHead), + CookedHead = [cook_outer(F) || F <- ProperRawHead], + CookedTail = cook_outer(ImproperRawTail), + {{CookedHead,CookedTail}, + CookedHead ++ CookedTail, + HeadLen + 1, + fun(I,L) -> improper_list_retrieve(I, L, HeadLen) end, + fun(I,V,L) -> improper_list_update(I, V, L, HeadLen) end}; + ProperRawFields -> + LocalFields = [cook_outer(F) || F <- ProperRawFields], + {LocalFields, + LocalFields, + length(ProperRawFields), + fun lists:nth/2, + fun proper_arith:list_update/3} + end, + ?CONTAINER([ + {env, {Fields, Len}}, + {generator, {typed, fun fixed_list_gen/1}}, + {is_instance, {typed, fun fixed_list_is_instance/2}}, + {internal_types, Internal}, + {get_indices, fun fixed_list_get_indices/2}, + {retrieve, Retrieve}, + {update, Update} + ]). + +fixed_list_gen(Type) -> + {Fields, _} = get_prop(env, Type), + proper_gen:fixed_list_gen(Fields). + +fixed_list_is_instance(Type, X) -> + {Fields, _} = get_prop(env, Type), + fixed_list_test(X, Fields). + +fixed_list_get_indices(Type, _X) -> + {_, Len} = get_prop(env, Type), + lists:seq(1, Len). + +-spec fixed_list_test(proper_gen:imm_instance(), + [proper_types:type()] | {[proper_types:type()], + proper_types:type()}) -> + boolean(). +fixed_list_test(X, {ProperHead,ImproperTail}) -> + is_list(X) andalso + begin + ProperHeadLen = length(ProperHead), + proper_arith:head_length(X) >= ProperHeadLen andalso + begin + {XHead,XTail} = lists:split(ProperHeadLen, X), + fixed_list_test(XHead, ProperHead) + andalso is_instance(XTail, ImproperTail) + end + end; +fixed_list_test(X, ProperFields) -> + is_list(X) + andalso length(X) =:= length(ProperFields) + andalso lists:all(fun({E,T}) -> is_instance(E, T) end, + lists:zip(X, ProperFields)). + +%% TODO: Move these 2 functions to proper_arith? +-spec improper_list_retrieve(index(), nonempty_improper_list(value(),value()), + pos_integer()) -> value(). +improper_list_retrieve(Index, List, HeadLen) -> + case Index =< HeadLen of + true -> lists:nth(Index, List); + false -> lists:nthtail(HeadLen, List) + end. + +-spec improper_list_update(index(), value(), + nonempty_improper_list(value(),value()), + pos_integer()) -> + nonempty_improper_list(value(),value()). +improper_list_update(Index, Value, List, HeadLen) -> + case Index =< HeadLen of + %% TODO: This happens to work, but is not implied by list_update's spec. + true -> proper_arith:list_update(Index, Value, List); + false -> lists:sublist(List, HeadLen) ++ Value + end. + +%% @doc All pure functions that map instances of `ArgTypes' to instances of +%% `RetType'. The syntax `function(Arity, RetType)' is also acceptable. +-spec function(ArgTypes::[raw_type()] | arity(), RetType::raw_type()) -> + proper_types:type(). +function(Arity, RawRetType) when is_integer(Arity), Arity >= 0, Arity =< 255 -> + RetType = cook_outer(RawRetType), + ?BASIC([ + {env, {Arity, RetType}}, + {generator, {typed, fun function_gen/1}}, + {is_instance, {typed, fun function_is_instance/2}} + ]); +function(RawArgTypes, RawRetType) -> + function(length(RawArgTypes), RawRetType). + +function_gen(Type) -> + {Arity, RetType} = get_prop(env, Type), + proper_gen:function_gen(Arity, RetType). + +function_is_instance(Type, X) -> + {Arity, RetType} = get_prop(env, Type), + is_function(X, Arity) + %% TODO: what if it's not a function we produced? + andalso equal_types(RetType, proper_gen:get_ret_type(X)). + +%% @doc All Erlang terms (that PropEr can produce). For reasons of efficiency, +%% functions are never produced as instances of this type.<br /> +%% CAUTION: Instances of this type are expensive to produce, shrink and instance- +%% check, both in terms of processing time and consumed memory. Only use this +%% type if you are certain that you need it. +-spec any() -> proper_types:type(). +any() -> + AllTypes = [integer(),float(),atom(),bitstring(),?LAZY(loose_tuple(any())), + ?LAZY(list(any()))], + ?SUBTYPE(union(AllTypes), [ + {generator, fun proper_gen:any_gen/1} + ]). + + +%%------------------------------------------------------------------------------ +%% Type aliases +%%------------------------------------------------------------------------------ + +%% @equiv integer(inf, inf) +-spec integer() -> proper_types:type(). +integer() -> integer(inf, inf). + +%% @equiv integer(0, inf) +-spec non_neg_integer() -> proper_types:type(). +non_neg_integer() -> integer(0, inf). + +%% @equiv integer(1, inf) +-spec pos_integer() -> proper_types:type(). +pos_integer() -> integer(1, inf). + +%% @equiv integer(inf, -1) +-spec neg_integer() -> proper_types:type(). +neg_integer() -> integer(inf, -1). + +%% @equiv integer(Low, High) +-spec range(extint(), extint()) -> proper_types:type(). +range(Low, High) -> integer(Low, High). + +%% @equiv float(inf, inf) +-spec float() -> proper_types:type(). +float() -> float(inf, inf). + +%% @equiv float(0.0, inf) +-spec non_neg_float() -> proper_types:type(). +non_neg_float() -> float(0.0, inf). + +%% @equiv union([integer(), float()]) +-spec number() -> proper_types:type(). +number() -> union([integer(), float()]). + +%% @doc The atoms `true' and `false'. Instances shrink towards `false'. +-spec boolean() -> proper_types:type(). +boolean() -> union(['false', 'true']). + +%% @equiv integer(0, 255) +-spec byte() -> proper_types:type(). +byte() -> integer(0, 255). + +%% @equiv integer(0, 16#10ffff) +-spec char() -> proper_types:type(). +char() -> integer(0, 16#10ffff). + +%% @equiv list(any()) +-spec list() -> proper_types:type(). +list() -> list(any()). + +%% @equiv loose_tuple(any()) +-spec tuple() -> proper_types:type(). +tuple() -> loose_tuple(any()). + +%% @equiv list(char()) +-spec string() -> proper_types:type(). +string() -> list(char()). + +%% @equiv weighted_union(FreqChoices) +-spec wunion([{frequency(),raw_type()},...]) -> proper_types:type(). +wunion(FreqChoices) -> weighted_union(FreqChoices). + +%% @equiv any() +-spec term() -> proper_types:type(). +term() -> any(). + +%% @equiv union([non_neg_integer() | infinity]) +-spec timeout() -> proper_types:type(). +timeout() -> union([non_neg_integer(), 'infinity']). + +%% @equiv integer(0, 255) +-spec arity() -> proper_types:type(). +arity() -> integer(0, 255). + + +%%------------------------------------------------------------------------------ +%% QuickCheck compatibility types +%%------------------------------------------------------------------------------ + +%% @doc Small integers (bound by the current value of the `size' parameter). +%% Instances shrink towards `0'. +-spec int() -> proper_types:type(). +int() -> ?SIZED(Size, integer(-Size,Size)). + +%% @doc Small non-negative integers (bound by the current value of the `size' +%% parameter). Instances shrink towards `0'. +-spec nat() -> proper_types:type(). +nat() -> ?SIZED(Size, integer(0,Size)). + +%% @equiv integer() +-spec largeint() -> proper_types:type(). +largeint() -> integer(). + +%% @equiv float() +-spec real() -> proper_types:type(). +real() -> float(). + +%% @equiv boolean() +-spec bool() -> proper_types:type(). +bool() -> boolean(). + +%% @equiv integer(Low, High) +-spec choose(extint(), extint()) -> proper_types:type(). +choose(Low, High) -> integer(Low, High). + +%% @equiv union(Choices) +-spec elements([raw_type(),...]) -> proper_types:type(). +elements(Choices) -> union(Choices). + +%% @equiv union(Choices) +-spec oneof([raw_type(),...]) -> proper_types:type(). +oneof(Choices) -> union(Choices). + +%% @equiv weighted_union(Choices) +-spec frequency([{frequency(),raw_type()},...]) -> proper_types:type(). +frequency(FreqChoices) -> weighted_union(FreqChoices). + +%% @equiv exactly(E) +-spec return(term()) -> proper_types:type(). +return(E) -> exactly(E). + +%% @doc Adds a default value, `Default', to `Type'. +%% The default serves as a primary shrinking target for instances, while it +%% is also chosen by the random instance generation subsystem half the time. +-spec default(raw_type(), raw_type()) -> proper_types:type(). +default(Default, Type) -> + union([Default, Type]). + +%% @doc All sorted lists containing elements of type `ElemType'. +%% Instances shrink towards the empty list, `[]'. +-spec orderedlist(ElemType::raw_type()) -> proper_types:type(). +orderedlist(RawElemType) -> + ?LET(L, list(RawElemType), lists:sort(L)). + +%% @equiv function(0, RetType) +-spec function0(raw_type()) -> proper_types:type(). +function0(RetType) -> + function(0, RetType). + +%% @equiv function(1, RetType) +-spec function1(raw_type()) -> proper_types:type(). +function1(RetType) -> + function(1, RetType). + +%% @equiv function(2, RetType) +-spec function2(raw_type()) -> proper_types:type(). +function2(RetType) -> + function(2, RetType). + +%% @equiv function(3, RetType) +-spec function3(raw_type()) -> proper_types:type(). +function3(RetType) -> + function(3, RetType). + +%% @equiv function(4, RetType) +-spec function4(raw_type()) -> proper_types:type(). +function4(RetType) -> + function(4, RetType). + +%% @doc A specialization of {@link default/2}, where `Default' and `Type' are +%% assigned weights to be considered by the random instance generator. The +%% shrinking subsystem will ignore the weights and try to shrink using the +%% default value. +-spec weighted_default({frequency(),raw_type()}, {frequency(),raw_type()}) -> + proper_types:type(). +weighted_default(Default, Type) -> + weighted_union([Default, Type]). + + +%%------------------------------------------------------------------------------ +%% Additional type specification functions +%%------------------------------------------------------------------------------ + +%% @doc Overrides the `size' parameter used when generating instances of +%% `Type' with `NewSize'. Has no effect on size-less types, such as unions. +%% Also, this will not affect the generation of any internal types contained in +%% `Type', such as the elements of a list - those will still be generated +%% using the test-wide value of `size'. One use of this function is to modify +%% types to produce instances that grow faster or slower, like so: +%% ```?SIZED(Size, resize(Size * 2, list(integer()))''' +%% The above specifies a list type that grows twice as fast as normal lists. +-spec resize(size(), Type::raw_type()) -> proper_types:type(). +resize(NewSize, RawType) -> + Type = cook_outer(RawType), + case find_prop(size_transform, Type) of + {ok,Transform} -> + add_prop(size_transform, fun(_S) -> Transform(NewSize) end, Type); + error -> + add_prop(size_transform, fun(_S) -> NewSize end, Type) + end. + +%% @doc This is a predefined constraint that can be applied to random-length +%% list and binary types to ensure that the produced values are never empty. +%% +%% e.g. {@link list/0}, {@link string/0}, {@link binary/0}) +-spec non_empty(ListType::raw_type()) -> proper_types:type(). +non_empty(RawListType) -> + ?SUCHTHAT(L, RawListType, L =/= [] andalso L =/= <<>>). + +%% @doc Creates a new type which is equivalent to `Type', but whose instances +%% are never shrunk by the shrinking subsystem. +-spec noshrink(Type::raw_type()) -> proper_types:type(). +noshrink(RawType) -> + add_prop(noshrink, true, cook_outer(RawType)). + +%% @doc Associates the atom key `Parameter' with the value `Value' while +%% generating instances of `Type'. +-spec with_parameter(atom(), value(), Type::raw_type()) -> proper_types:type(). +with_parameter(Parameter, Value, RawType) -> + with_parameters([{Parameter,Value}], RawType). + +%% @doc Similar to {@link with_parameter/3}, but accepts a list of +%% `{Parameter, Value}' pairs. +-spec with_parameters([{atom(),value()}], Type::raw_type()) -> + proper_types:type(). +with_parameters(PVlist, RawType) -> + Type = cook_outer(RawType), + case find_prop(parameters, Type) of + {ok,Params} when is_list(Params) -> + append_list_to_prop(parameters, PVlist, Type); + error -> + add_prop(parameters, PVlist, Type) + end. + +%% @doc Returns the value associated with `Parameter', or `Default' in case +%% `Parameter' is not associated with any value. +-spec parameter(atom(), value()) -> value(). +parameter(Parameter, Default) -> + Parameters = + case erlang:get('$parameters') of + undefined -> []; + List -> List + end, + proplists:get_value(Parameter, Parameters, Default). + +%% @equiv parameter(Parameter, undefined) +-spec parameter(atom()) -> value(). +parameter(Parameter) -> + parameter(Parameter, undefined). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl new file mode 100644 index 0000000000..b16075763f --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl @@ -0,0 +1,2411 @@ +%%% Copyright 2010-2016 Manolis Papadakis <[email protected]>, +%%% Eirini Arvaniti <[email protected]> +%%% and Kostis Sagonas <[email protected]> +%%% +%%% This file is part of PropEr. +%%% +%%% PropEr is free software: you can redistribute it and/or modify +%%% it under the terms of the GNU General Public License as published by +%%% the Free Software Foundation, either version 3 of the License, or +%%% (at your option) any later version. +%%% +%%% PropEr is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%%% GNU General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public License +%%% along with PropEr. If not, see <http://www.gnu.org/licenses/>. + +%%% @copyright 2010-2016 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas +%%% @version {@version} +%%% @author Manolis Papadakis + +%%% @doc Erlang type system - PropEr type system integration module. +%%% +%%% PropEr can parse types expressed in Erlang's type language and convert them +%%% to its own type format. Such expressions can be used instead of regular type +%%% constructors in the second argument of `?FORALL's. No extra notation is +%%% required; PropEr will detect which calls correspond to native types by +%%% applying a parse transform during compilation. This parse transform is +%%% automatically applied to any module that includes the `proper.hrl' header +%%% file. You can disable this feature by compiling your modules with +%%% `-DPROPER_NO_TRANS'. Note that this will currently also disable the +%%% automatic exporting of properties. +%%% +%%% The use of native types in properties is subject to the following usage +%%% rules: +%%% <ul> +%%% <li>Native types cannot be used outside of `?FORALL's.</li> +%%% <li>Inside `?FORALL's, native types can be combined with other native +%%% types, and even with PropEr types, inside tuples and lists (the constructs +%%% `[...]', `{...}' and `++' are all allowed).</li> +%%% <li>All other constructs of Erlang's built-in type system (e.g. `|' for +%%% union, `_' as an alias of `any()', `<<_:_>>' binary type syntax and +%%% `fun((...) -> ...)' function type syntax) are not allowed in `?FORALL's, +%%% because they are rejected by the Erlang parser.</li> +%%% <li>Anything other than a tuple constructor, list constructor, `++' +%%% application, local or remote call will automatically be considered a +%%% PropEr type constructor and not be processed further by the parse +%%% transform.</li> +%%% <li>Parametric native types are fully supported; of course, they can only +%%% appear instantiated in a `?FORALL'. The arguments of parametric native +%%% types are always interpreted as native types.</li> +%%% <li>Parametric PropEr types, on the other hand, can take any kind of +%%% argument. You can even mix native and PropEr types in the arguments of a +%%% PropEr type. For example, assuming that the following declarations are +%%% present: +%%% ``` my_proper_type() -> ?LET(...). +%%% -type my_native_type() :: ... .''' +%%% Then the following expressions are all legal: +%%% ``` vector(2, my_native_type()) +%%% function(0, my_native_type()) +%%% union([my_proper_type(), my_native_type()])''' </li> +%%% <li>Some type constructors can take native types as arguments (but only +%%% inside `?FORALL's): +%%% <ul> +%%% <li>`?SUCHTHAT', `?SUCHTHATMAYBE', `non_empty', `noshrink': these work +%%% with native types too</li> +%%% <li>`?LAZY', `?SHRINK', `resize', `?SIZED': these don't work with native +%%% types</li> +%%% <li>`?LET', `?LETSHRINK': only the top-level base type can be a native +%%% type</li> +%%% </ul></li> +%%% <li>Native type declarations in the `?FORALL's of a module can reference any +%%% custom type declared in a `-type' or `-opaque' attribute of the same +%%% module, as long as no module identifier is used.</li> +%%% <li>Typed records cannot be referenced inside `?FORALL's using the +%%% `#rec_name{}' syntax. To use a typed record in a `?FORALL', enclose the +%%% record in a custom type like so: +%%% ``` -type rec_name() :: #rec_name{}. ''' +%%% and use the custom type instead.</li> +%%% <li>`?FORALL's may contain references to self-recursive or mutually +%%% recursive native types, so long as each type in the hierarchy has a clear +%%% base case. +%%% Currently, PropEr requires that the toplevel of any recursive type +%%% declaration is either a (maybe empty) list or a union containing at least +%%% one choice that doesn't reference the type directly (it may, however, +%%% reference any of the types that are mutually recursive with it). This +%%% means, for example, that some valid recursive type declarations, such as +%%% this one: +%%% ``` ?FORALL(..., a(), ...) ''' +%%% where: +%%% ``` -type a() :: {'a','none' | a()}. ''' +%%% are not accepted by PropEr. However, such types can be rewritten in a way +%%% that allows PropEr to parse them: +%%% ``` ?FORALL(..., a(), ...) ''' +%%% where: +%%% ``` -type a() :: {'a','none'} | {'a',a()}. ''' +%%% This also means that recursive record declarations are not allowed: +%%% ``` ?FORALL(..., rec(), ...) ''' +%%% where: +%%% ``` -type rec() :: #rec{}. +%%% -record(rec, {a = 0 :: integer(), b = 'nil' :: 'nil' | #rec{}}). ''' +%%% A little rewritting can usually remedy this problem as well: +%%% ``` ?FORALL(..., rec(), ...) ''' +%%% where: +%%% ``` -type rec() :: #rec{b :: 'nil'} | #rec{b :: rec()}. +%%% -record(rec, {a = 0 :: integer(), b = 'nil' :: 'nil' | #rec{}}). ''' +%%% </li> +%%% <li>Remote types may be referenced in a `?FORALL', so long as they are +%%% exported from the remote module. Currently, PropEr requires that any +%%% remote modules whose types are directly referenced from within properties +%%% are present in the code path at compile time, either compiled with +%%% `debug_info' enabled or in source form. If PropEr cannot find a remote +%%% module at all, finds only a compiled object file with no debug +%%% information or fails to compile the source file, all calls to that module +%%% will automatically be considered calls to PropEr type constructors.</li> +%%% <li>For native types to be translated correctly, both the module that +%%% contains the `?FORALL' declaration as well as any module that contains +%%% the declaration of a type referenced (directly or indirectly) from inside +%%% a `?FORALL' must be present in the code path at runtime, either compiled +%%% with `debug_info' enabled or in source form.</li> +%%% <li>Local types with the same name as an auto-imported BIF are not accepted +%%% by PropEr, unless the BIF in question has been declared in a +%%% `no_auto_import' option.</li> +%%% <li>When an expression can be interpreted both as a PropEr type and as a +%%% native type, the former takes precedence. This means that a function +%%% `foo()' will shadow a type `foo()' if they are both present in the module. +%%% The same rule applies to remote functions and types as well.</li> +%%% <li>The above may cause some confusion when list syntax is used: +%%% <ul> +%%% <li>The expression `[integer()]' can be interpreted both ways, so the +%%% PropEr way applies. Therefore, instances of this type will always be +%%% lists of length 1, not arbitrary integer lists, as would be expected +%%% when interpreting the expression as a native type.</li> +%%% <li>Assuming that a custom type foo/1 has been declared, the expression +%%% `foo([integer()])' can only be interpreted as a native type declaration, +%%% which means that the generic type of integer lists will be passed to +%%% `foo/1'.</li> +%%% </ul></li> +%%% <li>Currently, PropEr does not detect the following mistakes: +%%% <ul> +%%% <li>inline record-field specializations that reference non-existent +%%% fields</li> +%%% <li>type parameters that are not present in the RHS of a `-type' +%%% declaration</li> +%%% <li>using `_' as a type variable in the LHS of a `-type' declaration</li> +%%% <li>using the same variable in more than one position in the LHS of a +%%% `-type' declaration</li> +%%% </ul> +%%% </li> +%%% </ul> +%%% +%%% You can use <a href="#index">these</a> functions to try out the type +%%% translation subsystem. +%%% +%%% CAUTION: These functions should never be used inside properties. They are +%%% meant for demonstration purposes only. + +-module(proper_typeserver). +-behaviour(gen_server). +-export([demo_translate_type/2, demo_is_instance/3]). + +-export([start/0, restart/0, stop/0, create_spec_test/3, get_exp_specced/1, + is_instance/3, translate_type/1]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, + code_change/3]). +-export([get_exp_info/1, match/2]). + +-export_type([imm_type/0, mod_exp_types/0, mod_exp_funs/0]). + +-include("proper_internal.hrl"). + + +%%------------------------------------------------------------------------------ +%% Macros +%%------------------------------------------------------------------------------ + +-define(SRC_FILE_EXT, ".erl"). + +-ifdef(AT_LEAST_19). +-define(anno(L), erl_anno:new(L)). +-else. +-define(anno(L), L). +-endif. + +%% Starting with 18.0 we need to handle both 'type' and 'user_type' tags; +%% prior Erlang/OTP releases had only 'type' as a tag. +-define(IS_TYPE_TAG(T), (T =:= type orelse T =:= user_type)). + +%% CAUTION: all these must be sorted +-define(STD_TYPES_0, + [any,arity,atom,binary,bitstring,bool,boolean,byte,char,float,integer, + list,neg_integer,non_neg_integer,number,pos_integer,string,term, + timeout]). +-define(HARD_ADTS, + %% gb_trees:iterator and gb_sets:iterator are NOT hardcoded + [{{array,0},array}, {{array,1},proper_array}, + {{dict,0},dict}, {{dict,2},proper_dict}, + {{gb_set,0},gb_sets}, {{gb_set,1},proper_gb_sets}, + {{gb_tree,0},gb_trees}, {{gb_tree,2},proper_gb_trees}, + {{orddict,2},proper_orddict}, + {{ordset,1},proper_ordsets}, + {{queue,0},queue}, {{queue,1},proper_queue}, + {{set,0},sets}, {{set,1},proper_sets}]). +-define(HARD_ADT_MODS, + [{array, [{{array,0}, + {{type,0,record,[{atom,0,array}]},[]}}]}, + {dict, [{{dict,0}, + {{type,0,record,[{atom,0,dict}]},[]}}]}, + {gb_sets, [{{gb_set,0}, + {{type,0,tuple,[{type,0,non_neg_integer,[]}, + {type,0,gb_set_node,[]}]},[]}}]}, + {gb_trees, [{{gb_tree,0}, + {{type,0,tuple,[{type,0,non_neg_integer,[]}, + {type,0,gb_tree_node,[]}]},[]}}]}, + %% Our parametric ADTs are already declared as normal types, we just + %% need to change them to opaques. + {proper_array, [{{array,1},already_declared}]}, + {proper_dict, [{{dict,2},already_declared}]}, + {proper_gb_sets, [{{gb_set,1},already_declared}, + {{iterator,1},already_declared}]}, + {proper_gb_trees, [{{gb_tree,2},already_declared}, + {{iterator,2},already_declared}]}, + {proper_orddict, [{{orddict,2},already_declared}]}, + {proper_ordsets, [{{ordset,1},already_declared}]}, + {proper_queue, [{{queue,1},already_declared}]}, + {proper_sets, [{{set,1},already_declared}]}, + {queue, [{{queue,0}, + {{type,0,tuple,[{type,0,list,[]},{type,0,list,[]}]},[]}}]}, + {sets, [{{set,0}, + {{type,0,record,[{atom,0,set}]},[]}}]}]). + + +%%------------------------------------------------------------------------------ +%% Types +%%------------------------------------------------------------------------------ + +-type type_name() :: atom(). +-type var_name() :: atom(). %% TODO: also integers? +-type field_name() :: atom(). + +-type type_kind() :: 'type' | 'record'. +-type type_ref() :: {type_kind(),type_name(),arity()}. +-ifdef(NO_MODULES_IN_OPAQUES). +-type substs_dict() :: dict(). %% dict(field_name(),ret_type()) +-else. +-type substs_dict() :: dict:dict(field_name(),ret_type()). +-endif. +-type full_type_ref() :: {mod_name(),type_kind(),type_name(), + [ret_type()] | substs_dict()}. +-type symb_info() :: 'not_symb' | {'orig_abs',abs_type()}. +-type type_repr() :: {'abs_type',abs_type(),[var_name()],symb_info()} + | {'cached',fin_type(),abs_type(),symb_info()} + | {'abs_record',[{field_name(),abs_type()}]}. +-type gen_fun() :: fun((size()) -> fin_type()). +-type rec_fun() :: fun(([gen_fun()],size()) -> fin_type()). +-type rec_arg() :: {boolean() | {'list',boolean(),rec_fun()},full_type_ref()}. +-type rec_args() :: [rec_arg()]. +-type ret_type() :: {'simple',fin_type()} | {'rec',rec_fun(),rec_args()}. +-type rec_fun_info() :: {pos_integer(),pos_integer(),[arity(),...], + [rec_fun(),...]}. + +-type imm_type_ref() :: {type_name(),arity()}. +-type hard_adt_repr() :: {abs_type(),[var_name()]} | 'already_declared'. +-type fun_ref() :: {fun_name(),arity()}. +-type fun_repr() :: fun_clause_repr(). +-type fun_clause_repr() :: {[abs_type()],abs_type()}. +-type proc_fun_ref() :: {fun_name(),[abs_type()],abs_type()}. +-type full_imm_type_ref() :: {mod_name(),type_name(),arity()}. +-type imm_stack() :: [full_imm_type_ref()]. +-type pat_field() :: 0 | 1 | atom(). +-type pattern() :: loose_tuple(pat_field()). +-type next_step() :: 'none' | 'take_head' | {'match_with',pattern()}. + +-ifdef(NO_MODULES_IN_OPAQUES). +%% @private_type +-type mod_exp_types() :: set(). %% set(imm_type_ref()) +-type mod_types() :: dict(). %% dict(type_ref(),type_repr()) +%% @private_type +-type mod_exp_funs() :: set(). %% set(fun_ref()) +-type mod_specs() :: dict(). %% dict(fun_ref(),fun_repr()) +-else. +%% @private_type +-type mod_exp_types() :: sets:set(imm_type_ref()). +-type mod_types() :: dict:dict(type_ref(),type_repr()). +%% @private_type +-type mod_exp_funs() :: sets:set(fun_ref()). +-type mod_specs() :: dict:dict(fun_ref(),fun_repr()). +-endif. + +-ifdef(NO_MODULES_IN_OPAQUES). +-record(state, + {cached = dict:new() :: dict(), %% dict(imm_type(),fin_type()) + exp_types = dict:new() :: dict(), %% dict(mod_name(),mod_exp_types()) + types = dict:new() :: dict(), %% dict(mod_name(),mod_types()) + exp_specs = dict:new() :: dict()}). %% dict(mod_name(),mod_specs()) +-else. +-record(state, + {cached = dict:new() :: dict:dict(imm_type(),fin_type()), + exp_types = dict:new() :: dict:dict(mod_name(),mod_exp_types()), + types = dict:new() :: dict:dict(mod_name(),mod_types()), + exp_specs = dict:new() :: dict:dict(mod_name(),mod_specs())}). +-endif. +-type state() :: #state{}. + +-record(mod_info, + {mod_exp_types = sets:new() :: mod_exp_types(), + mod_types = dict:new() :: mod_types(), + mod_opaques = sets:new() :: mod_exp_types(), + mod_exp_funs = sets:new() :: mod_exp_funs(), + mod_specs = dict:new() :: mod_specs()}). +-type mod_info() :: #mod_info{}. + +-type stack() :: [full_type_ref() | 'tuple' | 'list' | 'union' | 'fun']. +-ifdef(NO_MODULES_IN_OPAQUES). +-type var_dict() :: dict(). %% dict(var_name(),ret_type()) +-else. +-type var_dict() :: dict:dict(var_name(),ret_type()). +-endif. +%% @private_type +-type imm_type() :: {mod_name(),string()}. +%% @alias +-type fin_type() :: proper_types:type(). +-type tagged_result(T) :: {'ok',T} | 'error'. +-type tagged_result2(T,S) :: {'ok',T,S} | 'error'. +%% @alias +-type rich_result(T) :: {'ok',T} | {'error',term()}. +-type rich_result2(T,S) :: {'ok',T,S} | {'error',term()}. +-type false_positive_mfas() :: proper:false_positive_mfas(). + +-type server_call() :: {'create_spec_test',mfa(),timeout(),false_positive_mfas()} + | {'get_exp_specced',mod_name()} + | {'get_type_repr',mod_name(),type_ref(),boolean()} + | {'translate_type',imm_type()}. +-type server_response() :: rich_result(proper:test()) + | rich_result([mfa()]) + | rich_result(type_repr()) + | rich_result(fin_type()). + + +%%------------------------------------------------------------------------------ +%% Server interface functions +%%------------------------------------------------------------------------------ + +%% @private +-spec start() -> 'ok'. +start() -> + {ok,TypeserverPid} = gen_server:start_link(?MODULE, dummy, []), + put('$typeserver_pid', TypeserverPid), + ok. + +%% @private +-spec restart() -> 'ok'. +restart() -> + TypeserverPid = get('$typeserver_pid'), + case (TypeserverPid =:= undefined orelse not is_process_alive(TypeserverPid)) of + true -> start(); + false -> ok + end. + +%% @private +-spec stop() -> 'ok'. +stop() -> + TypeserverPid = get('$typeserver_pid'), + erase('$typeserver_pid'), + gen_server:cast(TypeserverPid, stop). + +%% @private +-spec create_spec_test(mfa(), timeout(), false_positive_mfas()) -> rich_result(proper:test()). +create_spec_test(MFA, SpecTimeout, FalsePositiveMFAs) -> + TypeserverPid = get('$typeserver_pid'), + gen_server:call(TypeserverPid, {create_spec_test,MFA,SpecTimeout,FalsePositiveMFAs}). + +%% @private +-spec get_exp_specced(mod_name()) -> rich_result([mfa()]). +get_exp_specced(Mod) -> + TypeserverPid = get('$typeserver_pid'), + gen_server:call(TypeserverPid, {get_exp_specced,Mod}). + +-spec get_type_repr(mod_name(), type_ref(), boolean()) -> + rich_result(type_repr()). +get_type_repr(Mod, TypeRef, IsRemote) -> + TypeserverPid = get('$typeserver_pid'), + gen_server:call(TypeserverPid, {get_type_repr,Mod,TypeRef,IsRemote}). + +%% @private +-spec translate_type(imm_type()) -> rich_result(fin_type()). +translate_type(ImmType) -> + TypeserverPid = get('$typeserver_pid'), + gen_server:call(TypeserverPid, {translate_type,ImmType}). + +%% @doc Translates the native type expression `TypeExpr' (which should be +%% provided inside a string) into a PropEr type, which can then be passed to any +%% of the demo functions defined in the {@link proper_gen} module. PropEr acts +%% as if it found this type expression inside the code of module `Mod'. +-spec demo_translate_type(mod_name(), string()) -> rich_result(fin_type()). +demo_translate_type(Mod, TypeExpr) -> + start(), + Result = translate_type({Mod,TypeExpr}), + stop(), + Result. + +%% @doc Checks if `Term' is a valid instance of native type `TypeExpr' (which +%% should be provided inside a string). PropEr acts as if it found this type +%% expression inside the code of module `Mod'. +-spec demo_is_instance(term(), mod_name(), string()) -> + boolean() | {'error',term()}. +demo_is_instance(Term, Mod, TypeExpr) -> + case parse_type(TypeExpr) of + {ok,TypeForm} -> + start(), + Result = + %% Force the typeserver to load the module. + case translate_type({Mod,"integer()"}) of + {ok,_FinType} -> + try is_instance(Term, Mod, TypeForm) + catch + throw:{'$typeserver',Reason} -> {error, Reason} + end; + {error,_Reason} = Error -> + Error + end, + stop(), + Result; + {error,_Reason} = Error -> + Error + end. + + +%%------------------------------------------------------------------------------ +%% Implementation of gen_server interface +%%------------------------------------------------------------------------------ + +%% @private +-spec init(_) -> {'ok',state()}. +init(_) -> + {ok, #state{}}. + +%% @private +-spec handle_call(server_call(), _, state()) -> + {'reply',server_response(),state()}. +handle_call({create_spec_test,MFA,SpecTimeout,FalsePositiveMFAs}, _From, State) -> + case create_spec_test(MFA, SpecTimeout, FalsePositiveMFAs, State) of + {ok,Test,NewState} -> + {reply, {ok,Test}, NewState}; + {error,_Reason} = Error -> + {reply, Error, State} + end; +handle_call({get_exp_specced,Mod}, _From, State) -> + case get_exp_specced(Mod, State) of + {ok,MFAs,NewState} -> + {reply, {ok,MFAs}, NewState}; + {error,_Reason} = Error -> + {reply, Error, State} + end; +handle_call({get_type_repr,Mod,TypeRef,IsRemote}, _From, State) -> + case get_type_repr(Mod, TypeRef, IsRemote, State) of + {ok,TypeRepr,NewState} -> + {reply, {ok,TypeRepr}, NewState}; + {error,_Reason} = Error -> + {reply, Error, State} + end; +handle_call({translate_type,ImmType}, _From, State) -> + case translate_type(ImmType, State) of + {ok,FinType,NewState} -> + {reply, {ok,FinType}, NewState}; + {error,_Reason} = Error -> + {reply, Error, State} + end. + +%% @private +-spec handle_cast('stop', state()) -> {'stop','normal',state()}. +handle_cast(stop, State) -> + {stop, normal, State}. + +%% @private +-spec handle_info(term(), state()) -> {'stop',{'received_info',term()},state()}. +handle_info(Info, State) -> + {stop, {received_info,Info}, State}. + +%% @private +-spec terminate(term(), state()) -> 'ok'. +terminate(_Reason, _State) -> + ok. + +%% @private +-spec code_change(term(), state(), _) -> {'ok',state()}. +code_change(_OldVsn, State, _) -> + {ok, State}. + + +%%------------------------------------------------------------------------------ +%% Top-level interface +%%------------------------------------------------------------------------------ + +-spec create_spec_test(mfa(), timeout(), false_positive_mfas(), state()) -> + rich_result2(proper:test(),state()). +create_spec_test(MFA, SpecTimeout, FalsePositiveMFAs, State) -> + case get_exp_spec(MFA, State) of + {ok,FunRepr,NewState} -> + make_spec_test(MFA, FunRepr, SpecTimeout, FalsePositiveMFAs, NewState); + {error,_Reason} = Error -> + Error + end. + +-spec get_exp_spec(mfa(), state()) -> rich_result2(fun_repr(),state()). +get_exp_spec({Mod,Fun,Arity} = MFA, State) -> + case add_module(Mod, State) of + {ok,#state{exp_specs = ExpSpecs} = NewState} -> + ModExpSpecs = dict:fetch(Mod, ExpSpecs), + case dict:find({Fun,Arity}, ModExpSpecs) of + {ok,FunRepr} -> + {ok, FunRepr, NewState}; + error -> + {error, {function_not_exported_or_specced,MFA}} + end; + {error,_Reason} = Error -> + Error + end. + +-spec make_spec_test(mfa(), fun_repr(), timeout(), false_positive_mfas(), state()) -> + rich_result2(proper:test(),state()). +make_spec_test({Mod,_Fun,_Arity}=MFA, {Domain,_Range}=FunRepr, SpecTimeout, FalsePositiveMFAs, State) -> + case convert(Mod, {type,?anno(0),'$fixed_list',Domain}, State) of + {ok,FinType,NewState} -> + Test = ?FORALL(Args, FinType, apply_spec_test(MFA, FunRepr, SpecTimeout, FalsePositiveMFAs, Args)), + {ok, Test, NewState}; + {error,_Reason} = Error -> + Error + end. + +-spec apply_spec_test(mfa(), fun_repr(), timeout(), false_positive_mfas(), term()) -> proper:test(). +apply_spec_test({Mod,Fun,_Arity}=MFA, {_Domain,Range}, SpecTimeout, FalsePositiveMFAs, Args) -> + ?TIMEOUT(SpecTimeout, + begin + %% NOTE: only call apply/3 inside try/catch (do not trust ?MODULE:is_instance/3) + Result = + try apply(Mod, Fun, Args) of + X -> {ok, X} + catch + X:Y -> {X, Y} + end, + case Result of + {ok, Z} -> + case ?MODULE:is_instance(Z, Mod, Range) of + true -> + true; + false when is_function(FalsePositiveMFAs) -> + FalsePositiveMFAs(MFA, Args, {fail, Z}); + false -> + false + end; + Exception when is_function(FalsePositiveMFAs) -> + case FalsePositiveMFAs(MFA, Args, Exception) of + true -> + true; + false -> + error(Exception, erlang:get_stacktrace()) + end; + Exception -> + error(Exception, erlang:get_stacktrace()) + end + end). + +-spec get_exp_specced(mod_name(), state()) -> rich_result2([mfa()],state()). +get_exp_specced(Mod, State) -> + case add_module(Mod, State) of + {ok,#state{exp_specs = ExpSpecs} = NewState} -> + ModExpSpecs = dict:fetch(Mod, ExpSpecs), + ExpSpecced = [{Mod,F,A} || {F,A} <- dict:fetch_keys(ModExpSpecs)], + {ok, ExpSpecced, NewState}; + {error,_Reason} = Error -> + Error + end. + +-spec get_type_repr(mod_name(), type_ref(), boolean(), state()) -> + rich_result2(type_repr(),state()). +get_type_repr(Mod, {type,Name,Arity} = TypeRef, true, State) -> + case prepare_for_remote(Mod, Name, Arity, State) of + {ok,NewState} -> + get_type_repr(Mod, TypeRef, false, NewState); + {error,_Reason} = Error -> + Error + end; +get_type_repr(Mod, TypeRef, false, #state{types = Types} = State) -> + ModTypes = dict:fetch(Mod, Types), + case dict:find(TypeRef, ModTypes) of + {ok,TypeRepr} -> + {ok, TypeRepr, State}; + error -> + {error, {missing_type,Mod,TypeRef}} + end. + +-spec prepare_for_remote(mod_name(), type_name(), arity(), state()) -> + rich_result(state()). +prepare_for_remote(RemMod, Name, Arity, State) -> + case add_module(RemMod, State) of + {ok,#state{exp_types = ExpTypes} = NewState} -> + RemModExpTypes = dict:fetch(RemMod, ExpTypes), + case sets:is_element({Name,Arity}, RemModExpTypes) of + true -> {ok, NewState}; + false -> {error, {type_not_exported,{RemMod,Name,Arity}}} + end; + {error,_Reason} = Error -> + Error + end. + +-spec translate_type(imm_type(), state()) -> rich_result2(fin_type(),state()). +translate_type({Mod,Str} = ImmType, #state{cached = Cached} = State) -> + case dict:find(ImmType, Cached) of + {ok,Type} -> + {ok, Type, State}; + error -> + case parse_type(Str) of + {ok,TypeForm} -> + case add_module(Mod, State) of + {ok,NewState} -> + case convert(Mod, TypeForm, NewState) of + {ok,FinType, + #state{cached = Cached} = FinalState} -> + NewCached = dict:store(ImmType, FinType, + Cached), + {ok, FinType, + FinalState#state{cached = NewCached}}; + {error,_Reason} = Error -> + Error + end; + {error,_Reason} = Error -> + Error + end; + {error,Reason} -> + {error, {parse_error,Str,Reason}} + end + end. + +-spec parse_type(string()) -> rich_result(abs_type()). +parse_type(Str) -> + TypeStr = "-type mytype() :: " ++ Str ++ ".", + case erl_scan:string(TypeStr) of + {ok,Tokens,_EndLocation} -> + case erl_parse:parse_form(Tokens) of + {ok,{attribute,_Line,type,{mytype,TypeExpr,[]}}} -> + {ok, TypeExpr}; + {error,_ErrorInfo} = Error -> + Error + end; + {error,ErrorInfo,_EndLocation} -> + {error, ErrorInfo} + end. + +-spec add_module(mod_name(), state()) -> rich_result(state()). +add_module(Mod, #state{exp_types = ExpTypes} = State) -> + case dict:is_key(Mod, ExpTypes) of + true -> + {ok, State}; + false -> + case get_code_and_exports(Mod) of + {ok,AbsCode,ModExpFuns} -> + RawModInfo = get_mod_info(Mod, AbsCode, ModExpFuns), + ModInfo = process_adts(Mod, RawModInfo), + {ok, store_mod_info(Mod, ModInfo, State)}; + {error,Reason} -> + {error, {cant_load_code,Mod,Reason}} + end + end. + +%% @private +-spec get_exp_info(mod_name()) -> rich_result2(mod_exp_types(),mod_exp_funs()). +get_exp_info(Mod) -> + case get_code_and_exports(Mod) of + {ok,AbsCode,ModExpFuns} -> + RawModInfo = get_mod_info(Mod, AbsCode, ModExpFuns), + {ok, RawModInfo#mod_info.mod_exp_types, ModExpFuns}; + {error,_Reason} = Error -> + Error + end. + +-spec get_code_and_exports(mod_name()) -> + rich_result2([abs_form()],mod_exp_funs()). +get_code_and_exports(Mod) -> + case code:get_object_code(Mod) of + {Mod, ObjBin, _ObjFileName} -> + case get_chunks(ObjBin) of + {ok,_AbsCode,_ModExpFuns} = Result -> + Result; + {error,Reason} -> + get_code_and_exports_from_source(Mod, Reason) + end; + error -> + get_code_and_exports_from_source(Mod, cant_find_object_file) + end. + +-spec get_code_and_exports_from_source(mod_name(), term()) -> + rich_result2([abs_form()],mod_exp_funs()). +get_code_and_exports_from_source(Mod, ObjError) -> + SrcFileName = atom_to_list(Mod) ++ ?SRC_FILE_EXT, + case code:where_is_file(SrcFileName) of + FullSrcFileName when is_list(FullSrcFileName) -> + Opts = [binary,debug_info,return_errors,{d,'PROPER_REMOVE_PROPS'}], + case compile:file(FullSrcFileName, Opts) of + {ok,Mod,Binary} -> + get_chunks(Binary); + {error,Errors,_Warnings} -> + {error, {ObjError,{cant_compile_source_file,Errors}}} + end; + non_existing -> + {error, {ObjError,cant_find_source_file}} + end. + +-spec get_chunks(string() | binary()) -> + rich_result2([abs_form()],mod_exp_funs()). +get_chunks(ObjFile) -> + case beam_lib:chunks(ObjFile, [abstract_code,exports]) of + {ok,{_Mod,[{abstract_code,AbsCodeChunk},{exports,ExpFunsList}]}} -> + case AbsCodeChunk of + {raw_abstract_v1,AbsCode} -> + %% HACK: Add a declaration for iolist() to every module + {ok, add_iolist(AbsCode), sets:from_list(ExpFunsList)}; + no_abstract_code -> + {error, no_abstract_code}; + _ -> + {error, unsupported_abstract_code_format} + end; + {error,beam_lib,Reason} -> + {error, Reason} + end. + +-spec add_iolist([abs_form()]) -> [abs_form()]. +add_iolist(Forms) -> + IOListDef = + {type,0,maybe_improper_list, + [{type,0,union,[{type,0,byte,[]},{type,0,binary,[]}, + {type,0,iolist,[]}]}, + {type,0,binary,[]}]}, + IOListDecl = {attribute,0,type,{iolist,IOListDef,[]}}, + [IOListDecl | Forms]. + +-spec get_mod_info(mod_name(), [abs_form()], mod_exp_funs()) -> mod_info(). +get_mod_info(Mod, AbsCode, ModExpFuns) -> + StartModInfo = #mod_info{mod_exp_funs = ModExpFuns}, + ImmModInfo = lists:foldl(fun add_mod_info/2, StartModInfo, AbsCode), + #mod_info{mod_specs = AllModSpecs} = ImmModInfo, + IsExported = fun(FunRef,_FunRepr) -> sets:is_element(FunRef,ModExpFuns) end, + ModExpSpecs = dict:filter(IsExported, AllModSpecs), + ModInfo = ImmModInfo#mod_info{mod_specs = ModExpSpecs}, + case orddict:find(Mod, ?HARD_ADT_MODS) of + {ok,ModADTs} -> + #mod_info{mod_exp_types = ModExpTypes, mod_types = ModTypes, + mod_opaques = ModOpaques} = ModInfo, + ModADTsSet = + sets:from_list([ImmTypeRef + || {ImmTypeRef,_HardADTRepr} <- ModADTs]), + NewModExpTypes = sets:union(ModExpTypes, ModADTsSet), + NewModTypes = lists:foldl(fun store_hard_adt/2, ModTypes, ModADTs), + NewModOpaques = sets:union(ModOpaques, ModADTsSet), + ModInfo#mod_info{mod_exp_types = NewModExpTypes, + mod_types = NewModTypes, + mod_opaques = NewModOpaques}; + error -> + ModInfo + end. + +-spec store_hard_adt({imm_type_ref(),hard_adt_repr()}, mod_types()) -> + mod_types(). +store_hard_adt({_ImmTypeRef,already_declared}, ModTypes) -> + ModTypes; +store_hard_adt({{Name,Arity},{TypeForm,VarNames}}, ModTypes) -> + TypeRef = {type,Name,Arity}, + TypeRepr = {abs_type,TypeForm,VarNames,not_symb}, + dict:store(TypeRef, TypeRepr, ModTypes). + +-spec add_mod_info(abs_form(), mod_info()) -> mod_info(). +add_mod_info({attribute,_Line,export_type,TypesList}, + #mod_info{mod_exp_types = ModExpTypes} = ModInfo) -> + NewModExpTypes = sets:union(sets:from_list(TypesList), ModExpTypes), + ModInfo#mod_info{mod_exp_types = NewModExpTypes}; +add_mod_info({attribute,_Line,type,{{record,RecName},Fields,[]}}, + #mod_info{mod_types = ModTypes} = ModInfo) -> + FieldInfo = [process_rec_field(F) || F <- Fields], + NewModTypes = dict:store({record,RecName,0}, {abs_record,FieldInfo}, + ModTypes), + ModInfo#mod_info{mod_types = NewModTypes}; +add_mod_info({attribute,Line,record,{RecName,Fields}}, + #mod_info{mod_types = ModTypes} = ModInfo) -> + case dict:is_key(RecName, ModTypes) of + true -> + ModInfo; + false -> % fake an opaque term by using the same Line as annotation + TypedRecord = {attribute,Line,type,{{record,RecName},Fields,[]}}, + add_mod_info(TypedRecord, ModInfo) + end; +add_mod_info({attribute,_Line,Kind,{Name,TypeForm,VarForms}}, + #mod_info{mod_types = ModTypes, + mod_opaques = ModOpaques} = ModInfo) + when Kind =:= type; Kind =:= opaque -> + Arity = length(VarForms), + VarNames = [V || {var,_,V} <- VarForms], + %% TODO: No check whether variables are different, or non-'_'. + NewModTypes = dict:store({type,Name,Arity}, + {abs_type,TypeForm,VarNames,not_symb}, ModTypes), + NewModOpaques = + case Kind of + type -> ModOpaques; + opaque -> sets:add_element({Name,Arity}, ModOpaques) + end, + ModInfo#mod_info{mod_types = NewModTypes, mod_opaques = NewModOpaques}; +add_mod_info({attribute,_Line,spec,{RawFunRef,[RawFirstClause | _Rest]}}, + #mod_info{mod_specs = ModSpecs} = ModInfo) -> + FunRef = case RawFunRef of + {_Mod,Name,Arity} -> {Name,Arity}; + {_Name,_Arity} = F -> F + end, + %% TODO: We just take the first function clause. + FirstClause = process_fun_clause(RawFirstClause), + NewModSpecs = dict:store(FunRef, FirstClause, ModSpecs), + ModInfo#mod_info{mod_specs = NewModSpecs}; +add_mod_info(_Form, ModInfo) -> + ModInfo. + +-spec process_rec_field(abs_rec_field()) -> {field_name(),abs_type()}. +process_rec_field({record_field,_,{atom,_,FieldName}}) -> + {FieldName, {type,0,any,[]}}; +process_rec_field({record_field,_,{atom,_,FieldName},_Initialization}) -> + {FieldName, {type,0,any,[]}}; +process_rec_field({typed_record_field,RecField,FieldType}) -> + {FieldName,_} = process_rec_field(RecField), + {FieldName, FieldType}. + +-spec process_fun_clause(abs_type()) -> fun_clause_repr(). +process_fun_clause({type,_,'fun',[{type,_,product,Domain},Range]}) -> + {Domain, Range}; +process_fun_clause({type,_,bounded_fun,[MainClause,Constraints]}) -> + {RawDomain,RawRange} = process_fun_clause(MainClause), + VarSubsts = [{V,T} || {type,_,constraint, + [{atom,_,is_subtype},[{var,_,V},T]]} <- Constraints, + V =/= '_'], + VarSubstsDict = dict:from_list(VarSubsts), + Domain = [update_vars(A, VarSubstsDict, false) || A <- RawDomain], + Range = update_vars(RawRange, VarSubstsDict, false), + {Domain, Range}. + +-spec store_mod_info(mod_name(), mod_info(), state()) -> state(). +store_mod_info(Mod, #mod_info{mod_exp_types = ModExpTypes, mod_types = ModTypes, + mod_specs = ImmModExpSpecs}, + #state{exp_types = ExpTypes, types = Types, + exp_specs = ExpSpecs} = State) -> + NewExpTypes = dict:store(Mod, ModExpTypes, ExpTypes), + NewTypes = dict:store(Mod, ModTypes, Types), + ModExpSpecs = dict:map(fun unbound_to_any/2, ImmModExpSpecs), + NewExpSpecs = dict:store(Mod, ModExpSpecs, ExpSpecs), + State#state{exp_types = NewExpTypes, types = NewTypes, + exp_specs = NewExpSpecs}. + +-spec unbound_to_any(fun_ref(), fun_repr()) -> fun_repr(). +unbound_to_any(_FunRef, {Domain,Range}) -> + EmptySubstsDict = dict:new(), + NewDomain = [update_vars(A,EmptySubstsDict,true) || A <- Domain], + NewRange = update_vars(Range, EmptySubstsDict, true), + {NewDomain, NewRange}. + + +%%------------------------------------------------------------------------------ +%% ADT translation functions +%%------------------------------------------------------------------------------ + +-spec process_adts(mod_name(), mod_info()) -> mod_info(). +process_adts(Mod, + #mod_info{mod_exp_types = ModExpTypes, mod_opaques = ModOpaques, + mod_specs = ModExpSpecs} = ModInfo) -> + %% TODO: No warning on unexported opaques. + case sets:to_list(sets:intersection(ModExpTypes,ModOpaques)) of + [] -> + ModInfo; + ModADTs -> + %% TODO: No warning on unexported API functions. + ModExpSpecsList = [{Name,Domain,Range} + || {{Name,_Arity},{Domain,Range}} + <- dict:to_list(ModExpSpecs)], + AddADT = fun(ADT,Acc) -> add_adt(Mod,ADT,Acc,ModExpSpecsList) end, + lists:foldl(AddADT, ModInfo, ModADTs) + end. + +-spec add_adt(mod_name(), imm_type_ref(), mod_info(), [proc_fun_ref()]) -> + mod_info(). +add_adt(Mod, {Name,Arity}, #mod_info{mod_types = ModTypes} = ModInfo, + ModExpFunSpecs) -> + ADTRef = {type,Name,Arity}, + {abs_type,InternalRepr,VarNames,not_symb} = dict:fetch(ADTRef, ModTypes), + FullADTRef = {Mod,Name,Arity}, + %% TODO: No warning on unsuitable range. + SymbCalls1 = [get_symb_call(FullADTRef,Spec) || Spec <- ModExpFunSpecs], + %% TODO: No warning on bad use of variables. + SymbCalls2 = [fix_vars(FullADTRef,Call,RangeVars,VarNames) + || {ok,Call,RangeVars} <- SymbCalls1], + case [Call || {ok,Call} <- SymbCalls2] of + [] -> + %% TODO: No warning on no acceptable spec. + ModInfo; + SymbCalls3 -> + NewADTRepr = {abs_type,{type,0,union,SymbCalls3},VarNames, + {orig_abs,InternalRepr}}, + NewModTypes = dict:store(ADTRef, NewADTRepr, ModTypes), + ModInfo#mod_info{mod_types = NewModTypes} + end. + +-spec get_symb_call(full_imm_type_ref(), proc_fun_ref()) -> + tagged_result2(abs_type(),[var_name()]). +get_symb_call({Mod,_TypeName,_Arity} = FullADTRef, {FunName,Domain,Range}) -> + A = ?anno(0), + BaseCall = {type,A,tuple,[{atom,A,'$call'},{atom,A,Mod},{atom,A,FunName}, + {type,A,'$fixed_list',Domain}]}, + unwrap_range(FullADTRef, BaseCall, Range, false). + +-spec unwrap_range(full_imm_type_ref(), abs_type() | next_step(), abs_type(), + boolean()) -> + tagged_result2(abs_type() | next_step(),[var_name()]). +unwrap_range(FullADTRef, Call, {paren_type,_,[Type]}, TestRun) -> + unwrap_range(FullADTRef, Call, Type, TestRun); +unwrap_range(FullADTRef, Call, {ann_type,_,[_Var,Type]}, TestRun) -> + unwrap_range(FullADTRef, Call, Type, TestRun); +unwrap_range(FullADTRef, Call, {type,_,list,[ElemType]}, TestRun) -> + unwrap_list(FullADTRef, Call, ElemType, TestRun); +unwrap_range(FullADTRef, Call, {type,_,maybe_improper_list,[Cont,_Term]}, + TestRun) -> + unwrap_list(FullADTRef, Call, Cont, TestRun); +unwrap_range(FullADTRef, Call, {type,_,nonempty_list,[ElemType]}, TestRun) -> + unwrap_list(FullADTRef, Call, ElemType, TestRun); +unwrap_range(FullADTRef, Call, {type,_,nonempty_improper_list,[Cont,_Term]}, + TestRun) -> + unwrap_list(FullADTRef, Call, Cont, TestRun); +unwrap_range(FullADTRef, Call, + {type,_,nonempty_maybe_improper_list,[Cont,_Term]}, TestRun) -> + unwrap_list(FullADTRef, Call, Cont, TestRun); +unwrap_range(_FullADTRef, _Call, {type,_,tuple,any}, _TestRun) -> + error; +unwrap_range(FullADTRef, Call, {type,_,tuple,FieldForms}, TestRun) -> + Translates = fun(T) -> unwrap_range(FullADTRef,none,T,true) =/= error end, + case proper_arith:find_first(Translates, FieldForms) of + none -> + error; + {TargetPos,TargetElem} -> + Pattern = get_pattern(TargetPos, FieldForms), + case TestRun of + true -> + NewCall = + case Call of + none -> {match_with,Pattern}; + _ -> Call + end, + {ok, NewCall, []}; + false -> + AbsPattern = term_to_singleton_type(Pattern), + A = ?anno(0), + NewCall = + {type,A,tuple, + [{atom,A,'$call'},{atom,A,?MODULE},{atom,A,match}, + {type,A,'$fixed_list',[AbsPattern,Call]}]}, + unwrap_range(FullADTRef, NewCall, TargetElem, TestRun) + end + end; +unwrap_range(FullADTRef, Call, {type,_,union,Choices}, TestRun) -> + TestedChoices = [unwrap_range(FullADTRef,none,C,true) || C <- Choices], + NotError = fun(error) -> false; (_) -> true end, + case proper_arith:find_first(NotError, TestedChoices) of + none -> + error; + {_ChoicePos,{ok,none,_RangeVars}} -> + error; + {ChoicePos,{ok,NextStep,_RangeVars}} -> + {A, [ChoiceElem|B]} = lists:split(ChoicePos-1, Choices), + OtherChoices = A ++ B, + DistinctChoice = + case NextStep of + take_head -> + fun cant_have_head/1; + {match_with,Pattern} -> + fun(C) -> cant_match(Pattern, C) end + end, + case {lists:all(DistinctChoice,OtherChoices), TestRun} of + {true,true} -> + {ok, NextStep, []}; + {true,false} -> + unwrap_range(FullADTRef, Call, ChoiceElem, TestRun); + {false,_} -> + error + end + end; +unwrap_range({_Mod,SameName,Arity}, Call, {type,_,SameName,ArgForms}, + _TestRun) -> + RangeVars = [V || {var,_,V} <- ArgForms, V =/= '_'], + case length(ArgForms) =:= Arity andalso length(RangeVars) =:= Arity of + true -> {ok, Call, RangeVars}; + false -> error + end; +unwrap_range({SameMod,SameName,_Arity} = FullADTRef, Call, + {remote_type,_,[{atom,_,SameMod},{atom,_,SameName},ArgForms]}, + TestRun) -> + unwrap_range(FullADTRef, Call, {type,?anno(0),SameName,ArgForms}, TestRun); +unwrap_range(_FullADTRef, _Call, _Range, _TestRun) -> + error. + +-spec unwrap_list(full_imm_type_ref(), abs_type() | next_step(), abs_type(), + boolean()) -> + tagged_result2(abs_type() | next_step(),[var_name()]). +unwrap_list(FullADTRef, Call, HeadType, TestRun) -> + NewCall = + case TestRun of + true -> + case Call of + none -> take_head; + _ -> Call + end; + false -> + {type,0,tuple,[{atom,0,'$call'},{atom,0,erlang},{atom,0,hd}, + {type,0,'$fixed_list',[Call]}]} + end, + unwrap_range(FullADTRef, NewCall, HeadType, TestRun). + +-spec fix_vars(full_imm_type_ref(), abs_type(), [var_name()], [var_name()]) -> + tagged_result(abs_type()). +fix_vars(FullADTRef, Call, RangeVars, VarNames) -> + NotAnyVar = fun(V) -> V =/= '_' end, + case no_duplicates(VarNames) andalso lists:all(NotAnyVar,VarNames) of + true -> + RawUsedVars = + collect_vars(FullADTRef, Call, [[V] || V <- RangeVars]), + UsedVars = [lists:usort(L) || L <- RawUsedVars], + case correct_var_use(UsedVars) of + true -> + PairAll = fun(L,Y) -> [{X,{var,0,Y}} || X <- L] end, + VarSubsts = + lists:flatten(lists:zipwith(PairAll,UsedVars,VarNames)), + VarSubstsDict = dict:from_list(VarSubsts), + {ok, update_vars(Call,VarSubstsDict,true)}; + false -> + error + end; + false -> + error + end. + +-spec no_duplicates(list()) -> boolean(). +no_duplicates(L) -> + length(lists:usort(L)) =:= length(L). + +-spec correct_var_use([[var_name() | 0]]) -> boolean(). +correct_var_use(UsedVars) -> + NoNonVarArgs = fun([0|_]) -> false; (_) -> true end, + lists:all(NoNonVarArgs, UsedVars) + andalso no_duplicates(lists:flatten(UsedVars)). + +-spec collect_vars(full_imm_type_ref(), abs_type(), [[var_name() | 0]]) -> + [[var_name() | 0]]. +collect_vars(FullADTRef, {paren_type,_,[Type]}, UsedVars) -> + collect_vars(FullADTRef, Type, UsedVars); +collect_vars(FullADTRef, {ann_type,_,[_Var,Type]}, UsedVars) -> + collect_vars(FullADTRef, Type, UsedVars); +collect_vars(_FullADTRef, {type,_,tuple,any}, UsedVars) -> + UsedVars; +collect_vars({_Mod,SameName,Arity} = FullADTRef, {type,_,SameName,ArgForms}, + UsedVars) -> + case length(ArgForms) =:= Arity of + true -> + VarArgs = [V || {var,_,V} <- ArgForms, V =/= '_'], + case length(VarArgs) =:= Arity of + true -> + AddToList = fun(X,L) -> [X | L] end, + lists:zipwith(AddToList, VarArgs, UsedVars); + false -> + [[0|L] || L <- UsedVars] + end; + false -> + multi_collect_vars(FullADTRef, ArgForms, UsedVars) + end; +collect_vars(FullADTRef, {type,_,_Name,ArgForms}, UsedVars) -> + multi_collect_vars(FullADTRef, ArgForms, UsedVars); +collect_vars({SameMod,SameName,_Arity} = FullADTRef, + {remote_type,_,[{atom,_,SameMod},{atom,_,SameName},ArgForms]}, + UsedVars) -> + collect_vars(FullADTRef, {type,?anno(0),SameName,ArgForms}, UsedVars); +collect_vars(FullADTRef, {remote_type,_,[_RemModForm,_NameForm,ArgForms]}, + UsedVars) -> + multi_collect_vars(FullADTRef, ArgForms, UsedVars); +collect_vars(_FullADTRef, _Call, UsedVars) -> + UsedVars. + +-spec multi_collect_vars(full_imm_type_ref(), [abs_type()], + [[var_name() | 0]]) -> [[var_name() | 0]]. +multi_collect_vars({_Mod,_Name,Arity} = FullADTRef, Forms, UsedVars) -> + NoUsedVars = lists:duplicate(Arity, []), + MoreUsedVars = [collect_vars(FullADTRef,T,NoUsedVars) || T <- Forms], + CombineVars = fun(L1,L2) -> lists:zipwith(fun erlang:'++'/2, L1, L2) end, + lists:foldl(CombineVars, UsedVars, MoreUsedVars). + +-ifdef(NO_MODULES_IN_OPAQUES). +-type var_substs_dict() :: dict(). +-else. +-type var_substs_dict() :: dict:dict(var_name(),abs_type()). +-endif. +-spec update_vars(abs_type(), var_substs_dict(), boolean()) -> abs_type(). +update_vars({paren_type,Line,[Type]}, VarSubstsDict, UnboundToAny) -> + {paren_type, Line, [update_vars(Type,VarSubstsDict,UnboundToAny)]}; +update_vars({ann_type,Line,[Var,Type]}, VarSubstsDict, UnboundToAny) -> + {ann_type, Line, [Var,update_vars(Type,VarSubstsDict,UnboundToAny)]}; +update_vars({var,Line,VarName} = Call, VarSubstsDict, UnboundToAny) -> + case dict:find(VarName, VarSubstsDict) of + {ok,SubstType} -> + SubstType; + error when UnboundToAny =:= false -> + Call; + error when UnboundToAny =:= true -> + {type,Line,any,[]} + end; +update_vars({remote_type,Line,[RemModForm,NameForm,ArgForms]}, VarSubstsDict, + UnboundToAny) -> + NewArgForms = [update_vars(A,VarSubstsDict,UnboundToAny) || A <- ArgForms], + {remote_type, Line, [RemModForm,NameForm,NewArgForms]}; +update_vars({T,_,tuple,any} = Call, _VarSubstsDict, _UnboundToAny) when ?IS_TYPE_TAG(T) -> + Call; +update_vars({T,Line,Name,ArgForms}, VarSubstsDict, UnboundToAny) when ?IS_TYPE_TAG(T) -> + NewArgForms = [update_vars(A,VarSubstsDict,UnboundToAny) || A <- ArgForms], + {T, Line, Name, NewArgForms}; +update_vars(Call, _VarSubstsDict, _UnboundToAny) -> + Call. + + +%%------------------------------------------------------------------------------ +%% Match-related functions +%%------------------------------------------------------------------------------ + +-spec get_pattern(position(), [abs_type()]) -> pattern(). +get_pattern(TargetPos, FieldForms) -> + {0,RevPattern} = lists:foldl(fun add_field/2, {TargetPos,[]}, FieldForms), + list_to_tuple(lists:reverse(RevPattern)). + +-spec add_field(abs_type(), {non_neg_integer(),[pat_field()]}) -> + {non_neg_integer(),[pat_field(),...]}. +add_field(_Type, {1,Acc}) -> + {0, [1|Acc]}; +add_field({atom,_,Tag}, {Left,Acc}) -> + {erlang:max(0,Left-1), [Tag|Acc]}; +add_field(_Type, {Left,Acc}) -> + {erlang:max(0,Left-1), [0|Acc]}. + +%% @private +-spec match(pattern(), tuple()) -> term(). +match(Pattern, Term) when tuple_size(Pattern) =:= tuple_size(Term) -> + match(tuple_to_list(Pattern), tuple_to_list(Term), none, false); +match(_Pattern, _Term) -> + throw(no_match). + +-spec match([pat_field()], [term()], 'none' | {'ok',T}, boolean()) -> T. +match([], [], {ok,Target}, _TypeMode) -> + Target; +match([0|PatRest], [_|ToMatchRest], Acc, TypeMode) -> + match(PatRest, ToMatchRest, Acc, TypeMode); +match([1|PatRest], [Target|ToMatchRest], none, TypeMode) -> + match(PatRest, ToMatchRest, {ok,Target}, TypeMode); +match([Tag|PatRest], [X|ToMatchRest], Acc, TypeMode) when is_atom(Tag) -> + MatchesTag = + case TypeMode of + true -> can_be_tag(Tag, X); + false -> Tag =:= X + end, + case MatchesTag of + true -> match(PatRest, ToMatchRest, Acc, TypeMode); + false -> throw(no_match) + end. + +%% CAUTION: these must be sorted +-define(NON_ATOM_TYPES, + [arity,binary,bitstring,byte,char,float,'fun',function,integer,iodata, + iolist,list,maybe_improper_list,mfa,neg_integer,nil,no_return, + non_neg_integer,none,nonempty_improper_list,nonempty_list, + nonempty_maybe_improper_list,nonempty_string,number,pid,port, + pos_integer,range,record,reference,string,tuple]). +-define(NON_TUPLE_TYPES, + [arity,atom,binary,bitstring,bool,boolean,byte,char,float,'fun', + function,identifier,integer,iodata,iolist,list,maybe_improper_list, + neg_integer,nil,no_return,node,non_neg_integer,none, + nonempty_improper_list,nonempty_list,nonempty_maybe_improper_list, + nonempty_string,number,pid,port,pos_integer,range,reference,string, + timeout]). +-define(NO_HEAD_TYPES, + [arity,atom,binary,bitstring,bool,boolean,byte,char,float,'fun', + function,identifier,integer,mfa,module,neg_integer,nil,no_return,node, + non_neg_integer,none,number,pid,port,pos_integer,range,record, + reference,timeout,tuple]). + +-spec can_be_tag(atom(), abs_type()) -> boolean(). +can_be_tag(Tag, {ann_type,_,[_Var,Type]}) -> + can_be_tag(Tag, Type); +can_be_tag(Tag, {paren_type,_,[Type]}) -> + can_be_tag(Tag, Type); +can_be_tag(Tag, {atom,_,Atom}) -> + Tag =:= Atom; +can_be_tag(_Tag, {integer,_,_Int}) -> + false; +can_be_tag(_Tag, {op,_,_Op,_Arg}) -> + false; +can_be_tag(_Tag, {op,_,_Op,_Arg1,_Arg2}) -> + false; +can_be_tag(Tag, {type,_,BName,[]}) when BName =:= bool; BName =:= boolean -> + is_boolean(Tag); +can_be_tag(Tag, {type,_,timeout,[]}) -> + Tag =:= infinity; +can_be_tag(Tag, {type,_,union,Choices}) -> + lists:any(fun(C) -> can_be_tag(Tag,C) end, Choices); +can_be_tag(_Tag, {type,_,Name,_Args}) -> + not ordsets:is_element(Name, ?NON_ATOM_TYPES); +can_be_tag(_Tag, _Type) -> + true. + +-spec cant_match(pattern(), abs_type()) -> boolean(). +cant_match(Pattern, {ann_type,_,[_Var,Type]}) -> + cant_match(Pattern, Type); +cant_match(Pattern, {paren_type,_,[Type]}) -> + cant_match(Pattern, Type); +cant_match(_Pattern, {atom,_,_Atom}) -> + true; +cant_match(_Pattern, {integer,_,_Int}) -> + true; +cant_match(_Pattern, {op,_,_Op,_Arg}) -> + true; +cant_match(_Pattern, {op,_,_Op,_Arg1,_Arg2}) -> + true; +cant_match(Pattern, {type,Anno,mfa,[]}) -> + MFA_Ts = [{type,Anno,atom,[]}, {type,Anno,atom,[]}, {type,Anno,arity,[]}], + cant_match(Pattern, {type,Anno,tuple,MFA_Ts}); +cant_match(Pattern, {type,_,union,Choices}) -> + lists:all(fun(C) -> cant_match(Pattern,C) end, Choices); +cant_match(_Pattern, {type,_,tuple,any}) -> + false; +cant_match(Pattern, {type,_,tuple,Fields}) -> + tuple_size(Pattern) =/= length(Fields) orelse + try match(tuple_to_list(Pattern), Fields, none, true) of + _ -> false + catch + throw:no_match -> true + end; +cant_match(_Pattern, {type,_,Name,_Args}) -> + ordsets:is_element(Name, ?NON_TUPLE_TYPES); +cant_match(_Pattern, _Type) -> + false. + +-spec cant_have_head(abs_type()) -> boolean(). +cant_have_head({ann_type,_,[_Var,Type]}) -> + cant_have_head(Type); +cant_have_head({paren_type,_,[Type]}) -> + cant_have_head(Type); +cant_have_head({atom,_,_Atom}) -> + true; +cant_have_head({integer,_,_Int}) -> + true; +cant_have_head({op,_,_Op,_Arg}) -> + true; +cant_have_head({op,_,_Op,_Arg1,_Arg2}) -> + true; +cant_have_head({type,_,union,Choices}) -> + lists:all(fun cant_have_head/1, Choices); +cant_have_head({type,_,Name,_Args}) -> + ordsets:is_element(Name, ?NO_HEAD_TYPES); +cant_have_head(_Type) -> + false. + +%% Only covers atoms, integers and tuples, i.e. those that can be specified +%% through singleton types. +-spec term_to_singleton_type(atom() | integer() + | loose_tuple(atom() | integer())) -> abs_type(). +term_to_singleton_type(Atom) when is_atom(Atom) -> + {atom,?anno(0),Atom}; +term_to_singleton_type(Int) when is_integer(Int), Int >= 0 -> + {integer,?anno(0),Int}; +term_to_singleton_type(Int) when is_integer(Int), Int < 0 -> + A = ?anno(0), + {op,A,'-',{integer,A,-Int}}; +term_to_singleton_type(Tuple) when is_tuple(Tuple) -> + Fields = tuple_to_list(Tuple), + {type,?anno(0),tuple,[term_to_singleton_type(F) || F <- Fields]}. + + +%%------------------------------------------------------------------------------ +%% Instance testing functions +%%------------------------------------------------------------------------------ + +%% CAUTION: this must be sorted +-define(EQUIV_TYPES, + [{arity, {type,0,range,[{integer,0,0},{integer,0,255}]}}, + {bool, {type,0,boolean,[]}}, + {byte, {type,0,range,[{integer,0,0},{integer,0,255}]}}, + {char, {type,0,range,[{integer,0,0},{integer,0,16#10ffff}]}}, + {function, {type,0,'fun',[]}}, + {identifier, {type,0,union,[{type,0,pid,[]},{type,0,port,[]}, + {type,0,reference,[]}]}}, + {iodata, {type,0,union,[{type,0,binary,[]},{type,0,iolist,[]}]}}, + {iolist, {type,0,maybe_improper_list, + [{type,0,union,[{type,0,byte,[]},{type,0,binary,[]}, + {type,0,iolist,[]}]}, + {type,0,binary,[]}]}}, + {list, {type,0,list,[{type,0,any,[]}]}}, + {maybe_improper_list, {type,0,maybe_improper_list,[{type,0,any,[]}, + {type,0,any,[]}]}}, + {mfa, {type,0,tuple,[{type,0,atom,[]},{type,0,atom,[]}, + {type,0,arity,[]}]}}, + {node, {type,0,atom,[]}}, + {nonempty_list, {type,0,nonempty_list,[{type,0,any,[]}]}}, + {nonempty_maybe_improper_list, {type,0,nonempty_maybe_improper_list, + [{type,0,any,[]},{type,0,any,[]}]}}, + {nonempty_string, {type,0,nonempty_list,[{type,0,char,[]}]}}, + {string, {type,0,list,[{type,0,char,[]}]}}, + {term, {type,0,any,[]}}, + {timeout, {type,0,union,[{atom,0,infinity}, + {type,0,non_neg_integer,[]}]}}]). + +%% @private +%% TODO: Most of these functions accept an extended form of abs_type(), namely +%% the addition of a custom wrapper: {'from_mod',mod_name(),...} +-spec is_instance(term(), mod_name(), abs_type()) -> boolean(). +is_instance(X, Mod, TypeForm) -> + is_instance(X, Mod, TypeForm, []). + +-spec is_instance(term(), mod_name(), abs_type(), imm_stack()) -> boolean(). +is_instance(X, _Mod, {from_mod,OrigMod,Type}, Stack) -> + is_instance(X, OrigMod, Type, Stack); +is_instance(_X, _Mod, {var,_,'_'}, _Stack) -> + true; +is_instance(_X, _Mod, {var,_,Name}, _Stack) -> + %% All unconstrained spec vars have been replaced by 'any()' and we always + %% replace the variables on the RHS of types before recursing into them. + %% Provided that '-type' declarations contain no unbound variables, we + %% don't expect to find any non-'_' variables while recursing. + throw({'$typeserver',{unbound_var_in_type_declaration,Name}}); +is_instance(X, Mod, {ann_type,_,[_Var,Type]}, Stack) -> + is_instance(X, Mod, Type, Stack); +is_instance(X, Mod, {paren_type,_,[Type]}, Stack) -> + is_instance(X, Mod, Type, Stack); +is_instance(X, Mod, {remote_type,_,[{atom,_,RemMod},{atom,_,Name},ArgForms]}, + Stack) -> + is_custom_instance(X, Mod, RemMod, Name, ArgForms, true, Stack); +is_instance(SameAtom, _Mod, {atom,_,SameAtom}, _Stack) -> + true; +is_instance(SameInt, _Mod, {integer,_,SameInt}, _Stack) -> + true; +is_instance(X, _Mod, {op,_,_Op,_Arg} = Expr, _Stack) -> + is_int_const(X, Expr); +is_instance(X, _Mod, {op,_,_Op,_Arg1,_Arg2} = Expr, _Stack) -> + is_int_const(X, Expr); +is_instance(_X, _Mod, {type,_,any,[]}, _Stack) -> + true; +is_instance(X, _Mod, {type,_,atom,[]}, _Stack) -> + is_atom(X); +is_instance(X, _Mod, {type,_,binary,[]}, _Stack) -> + is_binary(X); +is_instance(X, _Mod, {type,_,binary,[BaseExpr,UnitExpr]}, _Stack) -> + %% <<_:X,_:_*Y>> means "bitstrings of X + k*Y bits, k >= 0" + case eval_int(BaseExpr) of + {ok,Base} when Base >= 0 -> + case eval_int(UnitExpr) of + {ok,Unit} when Unit >= 0 -> + case is_bitstring(X) of + true -> + BitSizeX = bit_size(X), + case Unit =:= 0 of + true -> + BitSizeX =:= Base; + false -> + BitSizeX >= Base + andalso + (BitSizeX - Base) rem Unit =:= 0 + end; + false -> false + end; + _ -> + abs_expr_error(invalid_unit, UnitExpr) + end; + _ -> + abs_expr_error(invalid_base, BaseExpr) + end; +is_instance(X, _Mod, {type,_,bitstring,[]}, _Stack) -> + is_bitstring(X); +is_instance(X, _Mod, {type,_,boolean,[]}, _Stack) -> + is_boolean(X); +is_instance(X, _Mod, {type,_,float,[]}, _Stack) -> + is_float(X); +is_instance(X, _Mod, {type,_,'fun',[]}, _Stack) -> + is_function(X); +%% TODO: how to check range type? random inputs? special case for 0-arity? +is_instance(X, _Mod, {type,_,'fun',[{type,_,any,[]},_Range]}, _Stack) -> + is_function(X); +is_instance(X, _Mod, {type,_,'fun',[{type,_,product,Domain},_Range]}, _Stack) -> + is_function(X, length(Domain)); +is_instance(X, _Mod, {type,_,integer,[]}, _Stack) -> + is_integer(X); +is_instance(X, Mod, {type,_,list,[Type]}, _Stack) -> + list_test(X, Mod, Type, dummy, true, true, false); +is_instance(X, Mod, {type,_,maybe_improper_list,[Cont,Term]}, _Stack) -> + list_test(X, Mod, Cont, Term, true, true, true); +is_instance(X, _Mod, {type,_,module,[]}, _Stack) -> + is_atom(X) orelse + is_tuple(X) andalso X =/= {} andalso is_atom(element(1,X)); +is_instance([], _Mod, {type,_,nil,[]}, _Stack) -> + true; +is_instance(X, _Mod, {type,_,neg_integer,[]}, _Stack) -> + is_integer(X) andalso X < 0; +is_instance(X, _Mod, {type,_,non_neg_integer,[]}, _Stack) -> + is_integer(X) andalso X >= 0; +is_instance(X, Mod, {type,_,nonempty_list,[Type]}, _Stack) -> + list_test(X, Mod, Type, dummy, false, true, false); +is_instance(X, Mod, {type,_,nonempty_improper_list,[Cont,Term]}, _Stack) -> + list_test(X, Mod, Cont, Term, false, false, true); +is_instance(X, Mod, {type,_,nonempty_maybe_improper_list,[Cont,Term]}, + _Stack) -> + list_test(X, Mod, Cont, Term, false, true, true); +is_instance(X, _Mod, {type,_,number,[]}, _Stack) -> + is_number(X); +is_instance(X, _Mod, {type,_,pid,[]}, _Stack) -> + is_pid(X); +is_instance(X, _Mod, {type,_,port,[]}, _Stack) -> + is_port(X); +is_instance(X, _Mod, {type,_,pos_integer,[]}, _Stack) -> + is_integer(X) andalso X > 0; +is_instance(_X, _Mod, {type,_,product,_Elements}, _Stack) -> + throw({'$typeserver',{internal,product_in_is_instance}}); +is_instance(X, _Mod, {type,_,range,[LowExpr,HighExpr]}, _Stack) -> + case {eval_int(LowExpr),eval_int(HighExpr)} of + {{ok,Low},{ok,High}} when Low =< High -> + X >= Low andalso X =< High; + _ -> + abs_expr_error(invalid_range, LowExpr, HighExpr) + end; +is_instance(X, Mod, {type,_,record,[{atom,_,Name} = NameForm | RawSubsts]}, + Stack) -> + Substs = [{N,T} || {type,_,field_type,[{atom,_,N},T]} <- RawSubsts], + SubstsDict = dict:from_list(Substs), + case get_type_repr(Mod, {record,Name,0}, false) of + {ok,{abs_record,OrigFields}} -> + Fields = [case dict:find(FieldName, SubstsDict) of + {ok,NewFieldType} -> NewFieldType; + error -> OrigFieldType + end + || {FieldName,OrigFieldType} <- OrigFields], + is_instance(X, Mod, {type,?anno(0),tuple,[NameForm|Fields]}, Stack); + {error,Reason} -> + throw({'$typeserver',Reason}) + end; +is_instance(X, _Mod, {type,_,reference,[]}, _Stack) -> + is_reference(X); +is_instance(X, _Mod, {type,_,tuple,any}, _Stack) -> + is_tuple(X); +is_instance(X, Mod, {type,_,tuple,Fields}, _Stack) -> + is_tuple(X) andalso tuple_test(tuple_to_list(X), Mod, Fields); +is_instance(X, Mod, {type,_,union,Choices}, Stack) -> + IsInstance = fun(Choice) -> is_instance(X,Mod,Choice,Stack) end, + lists:any(IsInstance, Choices); +is_instance(X, Mod, {T,_,Name,[]}, Stack) when ?IS_TYPE_TAG(T) -> + case orddict:find(Name, ?EQUIV_TYPES) of + {ok,EquivType} -> + is_instance(X, Mod, EquivType, Stack); + error -> + is_maybe_hard_adt(X, Mod, Name, [], Stack) + end; +is_instance(X, Mod, {T,_,Name,ArgForms}, Stack) when ?IS_TYPE_TAG(T) -> + is_maybe_hard_adt(X, Mod, Name, ArgForms, Stack); +is_instance(_X, _Mod, _Type, _Stack) -> + false. + +-spec is_int_const(term(), abs_expr()) -> boolean(). +is_int_const(X, Expr) -> + case eval_int(Expr) of + {ok,Int} -> + X =:= Int; + error -> + abs_expr_error(invalid_int_const, Expr) + end. + +%% TODO: We implicitly add the '| []' at the termination of maybe_improper_list. +%% TODO: We ignore a '[]' termination in improper_list. +-spec list_test(term(), mod_name(), abs_type(), 'dummy' | abs_type(), boolean(), + boolean(), boolean()) -> boolean(). +list_test(X, Mod, Content, Termination, CanEmpty, CanProper, CanImproper) -> + is_list(X) andalso + list_rec(X, Mod, Content, Termination, CanEmpty, CanProper, CanImproper). + +-spec list_rec(term(), mod_name(), abs_type(), 'dummy' | abs_type(), boolean(), + boolean(), boolean()) -> boolean(). +list_rec([], _Mod, _Content, _Termination, CanEmpty, CanProper, _CanImproper) -> + CanEmpty andalso CanProper; +list_rec([X | Rest], Mod, Content, Termination, _CanEmpty, CanProper, + CanImproper) -> + is_instance(X, Mod, Content, []) andalso + list_rec(Rest, Mod, Content, Termination, true, CanProper, CanImproper); +list_rec(X, Mod, _Content, Termination, _CanEmpty, _CanProper, CanImproper) -> + CanImproper andalso is_instance(X, Mod, Termination, []). + +-spec tuple_test([term()], mod_name(), [abs_type()]) -> boolean(). +tuple_test([], _Mod, []) -> + true; +tuple_test([X | XTail], Mod, [T | TTail]) -> + is_instance(X, Mod, T, []) andalso tuple_test(XTail, Mod, TTail); +tuple_test(_, _Mod, _) -> + false. + +-spec is_maybe_hard_adt(term(), mod_name(), type_name(), [abs_type()], + imm_stack()) -> boolean(). +is_maybe_hard_adt(X, Mod, Name, ArgForms, Stack) -> + case orddict:find({Name,length(ArgForms)}, ?HARD_ADTS) of + {ok,ADTMod} -> + is_custom_instance(X, Mod, ADTMod, Name, ArgForms, true, Stack); + error -> + is_custom_instance(X, Mod, Mod, Name, ArgForms, false, Stack) + end. + +-spec is_custom_instance(term(), mod_name(), mod_name(), type_name(), + [abs_type()], boolean(), imm_stack()) -> boolean(). +is_custom_instance(X, Mod, RemMod, Name, RawArgForms, IsRemote, Stack) -> + ArgForms = case Mod =/= RemMod of + true -> [{from_mod,Mod,A} || A <- RawArgForms]; + false -> RawArgForms + end, + Arity = length(ArgForms), + FullTypeRef = {RemMod,Name,Arity}, + case lists:member(FullTypeRef, Stack) of + true -> + throw({'$typeserver',{self_reference,FullTypeRef}}); + false -> + TypeRef = {type,Name,Arity}, + AbsType = get_abs_type(RemMod, TypeRef, ArgForms, IsRemote), + is_instance(X, RemMod, AbsType, [FullTypeRef|Stack]) + end. + +-spec get_abs_type(mod_name(), type_ref(), [abs_type()], boolean()) -> + abs_type(). +get_abs_type(RemMod, TypeRef, ArgForms, IsRemote) -> + case get_type_repr(RemMod, TypeRef, IsRemote) of + {ok,TypeRepr} -> + {FinalAbsType,SymbInfo,VarNames} = + case TypeRepr of + {cached,_FinType,FAT,SI} -> {FAT,SI,[]}; + {abs_type,FAT,VN,SI} -> {FAT,SI,VN} + end, + AbsType = + case SymbInfo of + not_symb -> FinalAbsType; + {orig_abs,OrigAbsType} -> OrigAbsType + end, + VarSubstsDict = dict:from_list(lists:zip(VarNames,ArgForms)), + update_vars(AbsType, VarSubstsDict, false); + {error,Reason} -> + throw({'$typeserver',Reason}) + end. + +-spec abs_expr_error(atom(), abs_expr()) -> no_return(). +abs_expr_error(ImmReason, Expr) -> + {error,Reason} = expr_error(ImmReason, Expr), + throw({'$typeserver',Reason}). + +-spec abs_expr_error(atom(), abs_expr(), abs_expr()) -> no_return(). +abs_expr_error(ImmReason, Expr1, Expr2) -> + {error,Reason} = expr_error(ImmReason, Expr1, Expr2), + throw({'$typeserver',Reason}). + + +%%------------------------------------------------------------------------------ +%% Type translation functions +%%------------------------------------------------------------------------------ + +-spec convert(mod_name(), abs_type(), state()) -> + rich_result2(fin_type(),state()). +convert(Mod, TypeForm, State) -> + case convert(Mod, TypeForm, State, [], dict:new()) of + {ok,{simple,Type},NewState} -> + {ok, Type, NewState}; + {ok,{rec,_RecFun,_RecArgs},_NewState} -> + {error, {internal,rec_returned_to_toplevel}}; + {error,_Reason} = Error -> + Error + end. + +-spec convert(mod_name(), abs_type(), state(), stack(), var_dict()) -> + rich_result2(ret_type(),state()). +convert(Mod, {paren_type,_,[Type]}, State, Stack, VarDict) -> + convert(Mod, Type, State, Stack, VarDict); +convert(Mod, {ann_type,_,[_Var,Type]}, State, Stack, VarDict) -> + convert(Mod, Type, State, Stack, VarDict); +convert(_Mod, {var,_,'_'}, State, _Stack, _VarDict) -> + {ok, {simple,proper_types:any()}, State}; +convert(_Mod, {var,_,VarName}, State, _Stack, VarDict) -> + case dict:find(VarName, VarDict) of + %% TODO: do we need to check if we are at toplevel of a recursive? + {ok,RetType} -> {ok, RetType, State}; + error -> {error, {unbound_var,VarName}} + end; +convert(Mod, {remote_type,_,[{atom,_,RemMod},{atom,_,Name},ArgForms]}, State, + Stack, VarDict) -> + case prepare_for_remote(RemMod, Name, length(ArgForms), State) of + {ok,NewState} -> + convert_custom(Mod,RemMod,Name,ArgForms,NewState,Stack,VarDict); + {error,_Reason} = Error -> + Error + end; +convert(_Mod, {atom,_,Atom}, State, _Stack, _VarDict) -> + {ok, {simple,proper_types:exactly(Atom)}, State}; +convert(_Mod, {integer,_,_Int} = IntExpr, State, _Stack, _VarDict) -> + convert_integer(IntExpr, State); +convert(_Mod, {op,_,_Op,_Arg} = OpExpr, State, _Stack, _VarDict) -> + convert_integer(OpExpr, State); +convert(_Mod, {op,_,_Op,_Arg1,_Arg2} = OpExpr, State, _Stack, _VarDict) -> + convert_integer(OpExpr, State); +convert(_Mod, {type,_,binary,[BaseExpr,UnitExpr]}, State, _Stack, _VarDict) -> + %% <<_:X,_:_*Y>> means "bitstrings of X + k*Y bits, k >= 0" + case eval_int(BaseExpr) of + {ok,0} -> + case eval_int(UnitExpr) of + {ok,0} -> {ok, {simple,proper_types:exactly(<<>>)}, State}; + {ok,1} -> {ok, {simple,proper_types:bitstring()}, State}; + {ok,8} -> {ok, {simple,proper_types:binary()}, State}; + {ok,N} when N > 0 -> + Gen = ?LET(L, proper_types:list(proper_types:bitstring(N)), + concat_bitstrings(L)), + {ok, {simple,Gen}, State}; + _ -> expr_error(invalid_unit, UnitExpr) + end; + {ok,Base} when Base > 0 -> + Head = proper_types:bitstring(Base), + case eval_int(UnitExpr) of + {ok,0} -> {ok, {simple,Head}, State}; + {ok,1} -> + Tail = proper_types:bitstring(), + {ok, {simple,concat_binary_gens(Head, Tail)}, State}; + {ok,8} -> + Tail = proper_types:binary(), + {ok, {simple,concat_binary_gens(Head, Tail)}, State}; + {ok,N} when N > 0 -> + Tail = + ?LET(L, proper_types:list(proper_types:bitstring(N)), + concat_bitstrings(L)), + {ok, {simple,concat_binary_gens(Head, Tail)}, State}; + _ -> expr_error(invalid_unit, UnitExpr) + end; + _ -> + expr_error(invalid_base, BaseExpr) + end; +convert(_Mod, {type,_,range,[LowExpr,HighExpr]}, State, _Stack, _VarDict) -> + case {eval_int(LowExpr),eval_int(HighExpr)} of + {{ok,Low},{ok,High}} when Low =< High -> + {ok, {simple,proper_types:integer(Low,High)}, State}; + _ -> + expr_error(invalid_range, LowExpr, HighExpr) + end; +convert(_Mod, {type,_,nil,[]}, State, _Stack, _VarDict) -> + {ok, {simple,proper_types:exactly([])}, State}; +convert(Mod, {type,_,list,[ElemForm]}, State, Stack, VarDict) -> + convert_list(Mod, false, ElemForm, State, Stack, VarDict); +convert(Mod, {type,_,nonempty_list,[ElemForm]}, State, Stack, VarDict) -> + convert_list(Mod, true, ElemForm, State, Stack, VarDict); +convert(_Mod, {type,_,nonempty_list,[]}, State, _Stack, _VarDict) -> + {ok, {simple,proper_types:non_empty(proper_types:list())}, State}; +convert(_Mod, {type,_,nonempty_string,[]}, State, _Stack, _VarDict) -> + {ok, {simple,proper_types:non_empty(proper_types:string())}, State}; +convert(_Mod, {type,_,tuple,any}, State, _Stack, _VarDict) -> + {ok, {simple,proper_types:tuple()}, State}; +convert(Mod, {type,_,tuple,ElemForms}, State, Stack, VarDict) -> + convert_tuple(Mod, ElemForms, false, State, Stack, VarDict); +convert(Mod, {type,_,'$fixed_list',ElemForms}, State, Stack, VarDict) -> + convert_tuple(Mod, ElemForms, true, State, Stack, VarDict); +convert(Mod, {type,_,record,[{atom,_,Name}|FieldForms]}, State, Stack, + VarDict) -> + convert_record(Mod, Name, FieldForms, State, Stack, VarDict); +convert(Mod, {type,_,union,ChoiceForms}, State, Stack, VarDict) -> + convert_union(Mod, ChoiceForms, State, Stack, VarDict); +convert(Mod, {type,_,'fun',[{type,_,product,Domain},Range]}, State, Stack, + VarDict) -> + convert_fun(Mod, length(Domain), Range, State, Stack, VarDict); +%% TODO: These types should be replaced with accurate types. +%% TODO: Add support for nonempty_improper_list/2. +convert(Mod, {type,Anno,maybe_improper_list,[]}, State, Stack, VarDict) -> + convert(Mod, {type,Anno,list,[]}, State, Stack, VarDict); +convert(Mod, {type,A,maybe_improper_list,[Cont,_Ter]}, State, Stack, VarDict) -> + convert(Mod, {type,A,list,[Cont]}, State, Stack, VarDict); +convert(Mod, {type,A,nonempty_maybe_improper_list,[]}, State, Stack, VarDict) -> + convert(Mod, {type,A,nonempty_list,[]}, State, Stack, VarDict); +convert(Mod, {type,A,nonempty_maybe_improper_list,[Cont,_Term]}, State, Stack, + VarDict) -> + convert(Mod, {type,A,nonempty_list,[Cont]}, State, Stack, VarDict); +convert(Mod, {type,A,iodata,[]}, State, Stack, VarDict) -> + RealType = {type,A,union,[{type,A,binary,[]},{type,A,iolist,[]}]}, + convert(Mod, RealType, State, Stack, VarDict); +convert(Mod, {T,_,Name,[]}, State, Stack, VarDict) when ?IS_TYPE_TAG(T) -> + case ordsets:is_element(Name, ?STD_TYPES_0) of + true -> + {ok, {simple,proper_types:Name()}, State}; + false -> + convert_maybe_hard_adt(Mod, Name, [], State, Stack, VarDict) + end; +convert(Mod, {T,_,Name,ArgForms}, State, Stack, VarDict) when ?IS_TYPE_TAG(T) -> + convert_maybe_hard_adt(Mod, Name, ArgForms, State, Stack, VarDict); +convert(_Mod, TypeForm, _State, _Stack, _VarDict) -> + {error, {unsupported_type,TypeForm}}. + +-spec concat_bitstrings([bitstring()]) -> bitstring(). +concat_bitstrings(BitStrings) -> + concat_bitstrings_tr(BitStrings, <<>>). + +-spec concat_bitstrings_tr([bitstring()], bitstring()) -> bitstring(). +concat_bitstrings_tr([], Acc) -> + Acc; +concat_bitstrings_tr([BitString | Rest], Acc) -> + concat_bitstrings_tr(Rest, <<Acc/bits,BitString/bits>>). + +-spec concat_binary_gens(fin_type(), fin_type()) -> fin_type(). +concat_binary_gens(HeadType, TailType) -> + ?LET({H,T}, {HeadType,TailType}, <<H/bits,T/bits>>). + +-spec convert_fun(mod_name(), arity(), abs_type(), state(), stack(), + var_dict()) -> rich_result2(ret_type(),state()). +convert_fun(Mod, Arity, Range, State, Stack, VarDict) -> + case convert(Mod, Range, State, ['fun' | Stack], VarDict) of + {ok,{simple,RangeType},NewState} -> + {ok, {simple,proper_types:function(Arity,RangeType)}, NewState}; + {ok,{rec,RecFun,RecArgs},NewState} -> + case at_toplevel(RecArgs, Stack) of + true -> base_case_error(Stack); + false -> convert_rec_fun(Arity, RecFun, RecArgs, NewState) + end; + {error,_Reason} = Error -> + Error + end. + +-spec convert_rec_fun(arity(), rec_fun(), rec_args(), state()) -> + {'ok',ret_type(),state()}. +convert_rec_fun(Arity, RecFun, RecArgs, State) -> + %% We bind the generated value by size. + NewRecFun = + fun(GenFuns,Size) -> + proper_types:function(Arity, RecFun(GenFuns,Size)) + end, + NewRecArgs = clean_rec_args(RecArgs), + {ok, {rec,NewRecFun,NewRecArgs}, State}. + +-spec convert_list(mod_name(), boolean(), abs_type(), state(), stack(), + var_dict()) -> rich_result2(ret_type(),state()). +convert_list(Mod, NonEmpty, ElemForm, State, Stack, VarDict) -> + case convert(Mod, ElemForm, State, [list | Stack], VarDict) of + {ok,{simple,ElemType},NewState} -> + InnerType = proper_types:list(ElemType), + FinType = case NonEmpty of + true -> proper_types:non_empty(InnerType); + false -> InnerType + end, + {ok, {simple,FinType}, NewState}; + {ok,{rec,RecFun,RecArgs},NewState} -> + case {at_toplevel(RecArgs,Stack), NonEmpty} of + {true,true} -> + base_case_error(Stack); + {true,false} -> + NewRecFun = + fun(GenFuns,Size) -> + ElemGen = fun(S) -> ?LAZY(RecFun(GenFuns,S)) end, + proper_types:distlist(Size, ElemGen, false) + end, + NewRecArgs = clean_rec_args(RecArgs), + {ok, {rec,NewRecFun,NewRecArgs}, NewState}; + {false,_} -> + {NewRecFun,NewRecArgs} = + convert_rec_list(RecFun, RecArgs, NonEmpty), + {ok, {rec,NewRecFun,NewRecArgs}, NewState} + end; + {error,_Reason} = Error -> + Error + end. + +-spec convert_rec_list(rec_fun(), rec_args(), boolean()) -> + {rec_fun(),rec_args()}. +convert_rec_list(RecFun, [{true,FullTypeRef}] = RecArgs, NonEmpty) -> + {NewRecFun,_NormalRecArgs} = + convert_normal_rec_list(RecFun, RecArgs, NonEmpty), + AltRecFun = + fun([InstListGen],Size) -> + InstTypesList = + proper_types:get_prop(internal_types, InstListGen(Size)), + proper_types:fixed_list([RecFun([fun(_Size) -> I end],0) + || I <- InstTypesList]) + end, + NewRecArgs = [{{list,NonEmpty,AltRecFun},FullTypeRef}], + {NewRecFun, NewRecArgs}; +convert_rec_list(RecFun, RecArgs, NonEmpty) -> + convert_normal_rec_list(RecFun, RecArgs, NonEmpty). + +-spec convert_normal_rec_list(rec_fun(), rec_args(), boolean()) -> + {rec_fun(),rec_args()}. +convert_normal_rec_list(RecFun, RecArgs, NonEmpty) -> + NewRecFun = fun(GenFuns,Size) -> + ElemGen = fun(S) -> RecFun(GenFuns, S) end, + proper_types:distlist(Size, ElemGen, NonEmpty) + end, + NewRecArgs = clean_rec_args(RecArgs), + {NewRecFun, NewRecArgs}. + +-spec convert_tuple(mod_name(), [abs_type()], boolean(), state(), stack(), + var_dict()) -> rich_result2(ret_type(),state()). +convert_tuple(Mod, ElemForms, ToList, State, Stack, VarDict) -> + case process_list(Mod, ElemForms, State, [tuple | Stack], VarDict) of + {ok,RetTypes,NewState} -> + case combine_ret_types(RetTypes, {tuple,ToList}) of + {simple,_FinType} = RetType -> + {ok, RetType, NewState}; + {rec,_RecFun,RecArgs} = RetType -> + case at_toplevel(RecArgs, Stack) of + true -> base_case_error(Stack); + false -> {ok, RetType, NewState} + end + end; + {error,_Reason} = Error -> + Error + end. + +-spec convert_union(mod_name(), [abs_type()], state(), stack(), var_dict()) -> + rich_result2(ret_type(),state()). +convert_union(Mod, ChoiceForms, State, Stack, VarDict) -> + case process_list(Mod, ChoiceForms, State, [union | Stack], VarDict) of + {ok,RawChoices,NewState} -> + ProcessChoice = fun(T,A) -> process_choice(T,A,Stack) end, + {RevSelfRecs,RevNonSelfRecs,RevNonRecs} = + lists:foldl(ProcessChoice, {[],[],[]}, RawChoices), + case {lists:reverse(RevSelfRecs),lists:reverse(RevNonSelfRecs), + lists:reverse(RevNonRecs)} of + {_SelfRecs,[],[]} -> + base_case_error(Stack); + {[],NonSelfRecs,NonRecs} -> + {ok, combine_ret_types(NonRecs ++ NonSelfRecs, union), + NewState}; + {SelfRecs,NonSelfRecs,NonRecs} -> + {BCaseRecFun,BCaseRecArgs} = + case combine_ret_types(NonRecs ++ NonSelfRecs, union) of + {simple,BCaseType} -> + {fun([],_Size) -> BCaseType end,[]}; + {rec,BCRecFun,BCRecArgs} -> + {BCRecFun,BCRecArgs} + end, + NumBCaseGens = length(BCaseRecArgs), + [ParentRef | _Upper] = Stack, + FallbackRecFun = fun([SelfGen],_Size) -> SelfGen(0) end, + FallbackRecArgs = [{false,ParentRef}], + FallbackRetType = {rec,FallbackRecFun,FallbackRecArgs}, + {rec,RCaseRecFun,RCaseRecArgs} = + combine_ret_types([FallbackRetType] ++ SelfRecs + ++ NonSelfRecs, wunion), + NewRecFun = + fun(AllGens,Size) -> + {BCaseGens,RCaseGens} = + lists:split(NumBCaseGens, AllGens), + case Size of + 0 -> BCaseRecFun(BCaseGens,0); + _ -> RCaseRecFun(RCaseGens,Size) + end + end, + NewRecArgs = BCaseRecArgs ++ RCaseRecArgs, + {ok, {rec,NewRecFun,NewRecArgs}, NewState} + end; + {error,_Reason} = Error -> + Error + end. + +-spec process_choice(ret_type(), {[ret_type()],[ret_type()],[ret_type()]}, + stack()) -> {[ret_type()],[ret_type()],[ret_type()]}. +process_choice({simple,_} = RetType, {SelfRecs,NonSelfRecs,NonRecs}, _Stack) -> + {SelfRecs, NonSelfRecs, [RetType | NonRecs]}; +process_choice({rec,RecFun,RecArgs}, {SelfRecs,NonSelfRecs,NonRecs}, Stack) -> + case at_toplevel(RecArgs, Stack) of + true -> + case partition_by_toplevel(RecArgs, Stack, true) of + {[],[],_,_} -> + NewRecArgs = clean_rec_args(RecArgs), + {[{rec,RecFun,NewRecArgs} | SelfRecs], NonSelfRecs, + NonRecs}; + {SelfRecArgs,SelfPos,OtherRecArgs,_OtherPos} -> + NumInstances = length(SelfRecArgs), + IsListInst = fun({true,_FTRef}) -> false + ; ({{list,_NE,_AltRecFun},_FTRef}) -> true + end, + NewRecFun = + case proper_arith:filter(IsListInst,SelfRecArgs) of + {[],[]} -> + no_list_inst_rec_fun(RecFun,NumInstances, + SelfPos); + {[{{list,NonEmpty,AltRecFun},_}],[ListInstPos]} -> + list_inst_rec_fun(AltRecFun,NumInstances, + SelfPos,NonEmpty,ListInstPos) + end, + [{_B,SelfRef} | _] = SelfRecArgs, + NewRecArgs = + [{false,SelfRef} | clean_rec_args(OtherRecArgs)], + {[{rec,NewRecFun,NewRecArgs} | SelfRecs], NonSelfRecs, + NonRecs} + end; + false -> + NewRecArgs = clean_rec_args(RecArgs), + {SelfRecs, [{rec,RecFun,NewRecArgs} | NonSelfRecs], NonRecs} + end. + +-spec no_list_inst_rec_fun(rec_fun(), pos_integer(), [position()]) -> rec_fun(). +no_list_inst_rec_fun(RecFun, NumInstances, SelfPos) -> + fun([SelfGen|OtherGens], Size) -> + ?LETSHRINK( + Instances, + %% Size distribution will be a little off if both normal and + %% instance-accepting generators are present. + lists:duplicate(NumInstances, SelfGen(Size div NumInstances)), + begin + InstGens = [fun(_Size) -> proper_types:exactly(I) end + || I <- Instances], + AllGens = proper_arith:insert(InstGens, SelfPos, OtherGens), + RecFun(AllGens, Size) + end) + end. + +-spec list_inst_rec_fun(rec_fun(), pos_integer(), [position()], boolean(), + position()) -> rec_fun(). +list_inst_rec_fun(AltRecFun, NumInstances, SelfPos, NonEmpty, ListInstPos) -> + fun([SelfGen|OtherGens], Size) -> + ?LETSHRINK( + AllInsts, + lists:duplicate(NumInstances - 1, SelfGen(Size div NumInstances)) + ++ proper_types:distlist(Size div NumInstances, SelfGen, NonEmpty), + begin + {Instances,InstList} = lists:split(NumInstances - 1, AllInsts), + InstGens = [fun(_Size) -> proper_types:exactly(I) end + || I <- Instances], + InstTypesList = [proper_types:exactly(I) || I <- InstList], + InstListGen = + fun(_Size) -> proper_types:fixed_list(InstTypesList) end, + AllInstGens = proper_arith:list_insert(ListInstPos, InstListGen, + InstGens), + AllGens = proper_arith:insert(AllInstGens, SelfPos, OtherGens), + AltRecFun(AllGens, Size) + end) + end. + +-spec convert_maybe_hard_adt(mod_name(), type_name(), [abs_type()], state(), + stack(), var_dict()) -> + rich_result2(ret_type(),state()). +convert_maybe_hard_adt(Mod, Name, ArgForms, State, Stack, VarDict) -> + Arity = length(ArgForms), + case orddict:find({Name,Arity}, ?HARD_ADTS) of + {ok,Mod} -> + convert_custom(Mod, Mod, Name, ArgForms, State, Stack, VarDict); + {ok,ADTMod} -> + A = ?anno(0), + ADT = {remote_type,A,[{atom,A,ADTMod},{atom,A,Name},ArgForms]}, + convert(Mod, ADT, State, Stack, VarDict); + error -> + convert_custom(Mod, Mod, Name, ArgForms, State, Stack, VarDict) + end. + +-spec convert_custom(mod_name(), mod_name(), type_name(), [abs_type()], state(), + stack(), var_dict()) -> rich_result2(ret_type(),state()). +convert_custom(Mod, RemMod, Name, ArgForms, State, Stack, VarDict) -> + case process_list(Mod, ArgForms, State, Stack, VarDict) of + {ok,Args,NewState} -> + Arity = length(Args), + TypeRef = {type,Name,Arity}, + FullTypeRef = {RemMod,type,Name,Args}, + convert_type(TypeRef, FullTypeRef, NewState, Stack); + {error,_Reason} = Error -> + Error + end. + +-spec convert_record(mod_name(), type_name(), [abs_type()], state(), stack(), + var_dict()) -> rich_result2(ret_type(),state()). +convert_record(Mod, Name, RawSubsts, State, Stack, VarDict) -> + Substs = [{N,T} || {type,_,field_type,[{atom,_,N},T]} <- RawSubsts], + {SubstFields,SubstTypeForms} = lists:unzip(Substs), + case process_list(Mod, SubstTypeForms, State, Stack, VarDict) of + {ok,SubstTypes,NewState} -> + SubstsDict = dict:from_list(lists:zip(SubstFields, SubstTypes)), + TypeRef = {record,Name,0}, + FullTypeRef = {Mod,record,Name,SubstsDict}, + convert_type(TypeRef, FullTypeRef, NewState, Stack); + {error,_Reason} = Error -> + Error + end. + +-spec convert_type(type_ref(), full_type_ref(), state(), stack()) -> + rich_result2(ret_type(),state()). +convert_type(TypeRef, {Mod,_Kind,_Name,_Spec} = FullTypeRef, State, Stack) -> + case stack_position(FullTypeRef, Stack) of + none -> + case get_type_repr(Mod, TypeRef, false, State) of + {ok,TypeRepr,NewState} -> + convert_new_type(TypeRef, FullTypeRef, TypeRepr, NewState, + Stack); + {error,_Reason} = Error -> + Error + end; + 1 -> + base_case_error(Stack); + _Pos -> + {ok, {rec,fun([Gen],Size) -> Gen(Size) end,[{true,FullTypeRef}]}, + State} + end. + +-spec convert_new_type(type_ref(), full_type_ref(), type_repr(), state(), + stack()) -> rich_result2(ret_type(),state()). +convert_new_type(_TypeRef, {_Mod,type,_Name,[]}, + {cached,FinType,_TypeForm,_SymbInfo}, State, _Stack) -> + {ok, {simple,FinType}, State}; +convert_new_type(TypeRef, {Mod,type,_Name,Args} = FullTypeRef, + {abs_type,TypeForm,Vars,SymbInfo}, State, Stack) -> + VarDict = dict:from_list(lists:zip(Vars, Args)), + case convert(Mod, TypeForm, State, [FullTypeRef | Stack], VarDict) of + {ok, {simple,ImmFinType}, NewState} -> + FinType = case SymbInfo of + not_symb -> + ImmFinType; + {orig_abs,_OrigAbsType} -> + proper_symb:internal_well_defined(ImmFinType) + end, + FinalState = case Vars of + [] -> cache_type(Mod, TypeRef, FinType, TypeForm, + SymbInfo, NewState); + _ -> NewState + end, + {ok, {simple,FinType}, FinalState}; + {ok, {rec,RecFun,RecArgs}, NewState} -> + convert_maybe_rec(FullTypeRef, SymbInfo, RecFun, RecArgs, NewState, + Stack); + {error,_Reason} = Error -> + Error + end; +convert_new_type(_TypeRef, {Mod,record,Name,SubstsDict} = FullTypeRef, + {abs_record,OrigFields}, State, Stack) -> + Fields = [case dict:find(FieldName, SubstsDict) of + {ok,NewFieldType} -> NewFieldType; + error -> OrigFieldType + end + || {FieldName,OrigFieldType} <- OrigFields], + case convert_tuple(Mod, [{atom,0,Name} | Fields], false, State, + [FullTypeRef | Stack], dict:new()) of + {ok, {simple,_FinType}, _NewState} = Result -> + Result; + {ok, {rec,RecFun,RecArgs}, NewState} -> + convert_maybe_rec(FullTypeRef, not_symb, RecFun, RecArgs, NewState, + Stack); + {error,_Reason} = Error -> + Error + end. + +-spec cache_type(mod_name(), type_ref(), fin_type(), abs_type(), symb_info(), + state()) -> state(). +cache_type(Mod, TypeRef, FinType, TypeForm, SymbInfo, + #state{types = Types} = State) -> + TypeRepr = {cached,FinType,TypeForm,SymbInfo}, + ModTypes = dict:fetch(Mod, Types), + NewModTypes = dict:store(TypeRef, TypeRepr, ModTypes), + NewTypes = dict:store(Mod, NewModTypes, Types), + State#state{types = NewTypes}. + +-spec convert_maybe_rec(full_type_ref(), symb_info(), rec_fun(), rec_args(), + state(), stack()) -> rich_result2(ret_type(),state()). +convert_maybe_rec(FullTypeRef, SymbInfo, RecFun, RecArgs, State, Stack) -> + case at_toplevel(RecArgs, Stack) of + true -> base_case_error(Stack); + false -> safe_convert_maybe_rec(FullTypeRef, SymbInfo, RecFun, RecArgs, + State) + end. + +-spec safe_convert_maybe_rec(full_type_ref(),symb_info(),rec_fun(),rec_args(), + state()) -> rich_result2(ret_type(),state()). +safe_convert_maybe_rec(FullTypeRef, SymbInfo, RecFun, RecArgs, State) -> + case partition_rec_args(FullTypeRef, RecArgs, false) of + {[],[],_,_} -> + {ok, {rec,RecFun,RecArgs}, State}; + {MyRecArgs,MyPos,OtherRecArgs,_OtherPos} -> + case lists:all(fun({B,_T}) -> B =:= false end, MyRecArgs) of + true -> convert_rec_type(SymbInfo, RecFun, MyPos, OtherRecArgs, + State); + false -> {error, {internal,true_rec_arg_reached_type}} + end + end. + +-spec convert_rec_type(symb_info(), rec_fun(), [position()], rec_args(), + state()) -> {ok, ret_type(), state()}. +convert_rec_type(SymbInfo, RecFun, MyPos, [], State) -> + NumRecArgs = length(MyPos), + M = fun(GenFun) -> + fun(Size) -> + GenFuns = lists:duplicate(NumRecArgs, GenFun), + RecFun(GenFuns, erlang:max(0,Size - 1)) + end + end, + SizedGen = y(M), + ImmFinType = ?SIZED(Size,SizedGen(Size + 1)), + FinType = case SymbInfo of + not_symb -> + ImmFinType; + {orig_abs,_OrigAbsType} -> + proper_symb:internal_well_defined(ImmFinType) + end, + {ok, {simple,FinType}, State}; +convert_rec_type(_SymbInfo, RecFun, MyPos, OtherRecArgs, State) -> + NumRecArgs = length(MyPos), + NewRecFun = + fun(OtherGens,TopSize) -> + M = fun(GenFun) -> + fun(Size) -> + GenFuns = lists:duplicate(NumRecArgs, GenFun), + AllGens = + proper_arith:insert(GenFuns, MyPos, OtherGens), + RecFun(AllGens, erlang:max(0,Size - 1)) + end + end, + (y(M))(TopSize) + end, + NewRecArgs = clean_rec_args(OtherRecArgs), + {ok, {rec,NewRecFun,NewRecArgs}, State}. + +%% Y Combinator: Read more at http://bc.tech.coop/blog/070611.html. +-spec y(fun((fun((T) -> S)) -> fun((T) -> S))) -> fun((T) -> S). +y(M) -> + G = fun(F) -> + M(fun(A) -> (F(F))(A) end) + end, + G(G). + +-spec process_list(mod_name(), [abs_type() | ret_type()], state(), stack(), + var_dict()) -> rich_result2([ret_type()],state()). +process_list(Mod, RawTypes, State, Stack, VarDict) -> + Process = fun({simple,_FinType} = Type, {ok,Types,State1}) -> + {ok, [Type|Types], State1}; + ({rec,_RecFun,_RecArgs} = Type, {ok,Types,State1}) -> + {ok, [Type|Types], State1}; + (TypeForm, {ok,Types,State1}) -> + case convert(Mod, TypeForm, State1, Stack, VarDict) of + {ok,Type,State2} -> {ok,[Type|Types],State2}; + {error,_} = Err -> Err + end; + (_RawType, {error,_} = Err) -> + Err + end, + case lists:foldl(Process, {ok,[],State}, RawTypes) of + {ok,RevTypes,NewState} -> + {ok, lists:reverse(RevTypes), NewState}; + {error,_Reason} = Error -> + Error + end. + +-spec convert_integer(abs_expr(), state()) -> rich_result2(ret_type(),state()). +convert_integer(Expr, State) -> + case eval_int(Expr) of + {ok,Int} -> {ok, {simple,proper_types:exactly(Int)}, State}; + error -> expr_error(invalid_int_const, Expr) + end. + +-spec eval_int(abs_expr()) -> tagged_result(integer()). +eval_int(Expr) -> + NoBindings = erl_eval:new_bindings(), + try erl_eval:expr(Expr, NoBindings) of + {value,Value,_NewBindings} when is_integer(Value) -> + {ok, Value}; + _ -> + error + catch + error:_ -> + error + end. + +-spec expr_error(atom(), abs_expr()) -> {'error',term()}. +expr_error(Reason, Expr) -> + {error, {Reason,lists:flatten(erl_pp:expr(Expr))}}. + +-spec expr_error(atom(), abs_expr(), abs_expr()) -> {'error',term()}. +expr_error(Reason, Expr1, Expr2) -> + Str1 = lists:flatten(erl_pp:expr(Expr1)), + Str2 = lists:flatten(erl_pp:expr(Expr2)), + {error, {Reason,Str1,Str2}}. + +-spec base_case_error(stack()) -> {'error',term()}. +%% TODO: This might confuse, since it doesn't record the arguments to parametric +%% types or the type subsitutions of a record. +base_case_error([{Mod,type,Name,Args} | _Upper]) -> + Arity = length(Args), + {error, {no_base_case,{Mod,type,Name,Arity}}}; +base_case_error([{Mod,record,Name,_SubstsDict} | _Upper]) -> + {error, {no_base_case,{Mod,record,Name}}}. + + +%%------------------------------------------------------------------------------ +%% Helper datatypes handling functions +%%------------------------------------------------------------------------------ + +-spec stack_position(full_type_ref(), stack()) -> 'none' | pos_integer(). +stack_position(FullTypeRef, Stack) -> + SameType = fun(A) -> same_full_type_ref(A,FullTypeRef) end, + case proper_arith:find_first(SameType, Stack) of + {Pos,_} -> Pos; + none -> none + end. + +-spec partition_by_toplevel(rec_args(), stack(), boolean()) -> + {rec_args(),[position()],rec_args(),[position()]}. +partition_by_toplevel(RecArgs, [], _OnlyInstanceAccepting) -> + {[],[],RecArgs,lists:seq(1,length(RecArgs))}; +partition_by_toplevel(RecArgs, [_Parent | _Upper], _OnlyInstanceAccepting) + when is_atom(_Parent) -> + {[],[],RecArgs,lists:seq(1,length(RecArgs))}; +partition_by_toplevel(RecArgs, [Parent | _Upper], OnlyInstanceAccepting) -> + partition_rec_args(Parent, RecArgs, OnlyInstanceAccepting). + +-spec at_toplevel(rec_args(), stack()) -> boolean(). +at_toplevel(RecArgs, Stack) -> + case partition_by_toplevel(RecArgs, Stack, false) of + {[],[],_,_} -> false; + _ -> true + end. + +-spec partition_rec_args(full_type_ref(), rec_args(), boolean()) -> + {rec_args(),[position()],rec_args(),[position()]}. +partition_rec_args(FullTypeRef, RecArgs, OnlyInstanceAccepting) -> + SameType = + case OnlyInstanceAccepting of + true -> fun({false,_T}) -> false + ; ({_B,T}) -> same_full_type_ref(T,FullTypeRef) end; + false -> fun({_B,T}) -> same_full_type_ref(T,FullTypeRef) end + end, + proper_arith:partition(SameType, RecArgs). + +%% Tuples can be of 0 arity, unions of 1 and wunions at least of 2. +-spec combine_ret_types([ret_type()], {'tuple',boolean()} | 'union' + | 'wunion') -> ret_type(). +combine_ret_types(RetTypes, EnclosingType) -> + case lists:all(fun is_simple_ret_type/1, RetTypes) of + true -> + %% This should never happen for wunion. + Combine = case EnclosingType of + {tuple,false} -> fun proper_types:tuple/1; + {tuple,true} -> fun proper_types:fixed_list/1; + union -> fun proper_types:union/1 + end, + FinTypes = [T || {simple,T} <- RetTypes], + {simple, Combine(FinTypes)}; + false -> + NumTypes = length(RetTypes), + {RevRecFuns,RevRecArgsList,NumRecs} = + lists:foldl(fun add_ret_type/2, {[],[],0}, RetTypes), + RecFuns = lists:reverse(RevRecFuns), + RecArgsList = lists:reverse(RevRecArgsList), + RecArgLens = [length(RecArgs) || RecArgs <- RecArgsList], + RecFunInfo = {NumTypes,NumRecs,RecArgLens,RecFuns}, + FlatRecArgs = lists:flatten(RecArgsList), + {NewRecFun,NewRecArgs} = + case EnclosingType of + {tuple,ToList} -> + {tuple_rec_fun(RecFunInfo,ToList), + soft_clean_rec_args(FlatRecArgs,RecFunInfo,ToList)}; + union -> + {union_rec_fun(RecFunInfo),clean_rec_args(FlatRecArgs)}; + wunion -> + {wunion_rec_fun(RecFunInfo), + clean_rec_args(FlatRecArgs)} + end, + {rec, NewRecFun, NewRecArgs} + end. + +-spec tuple_rec_fun(rec_fun_info(), boolean()) -> rec_fun(). +tuple_rec_fun({_NumTypes,NumRecs,RecArgLens,RecFuns}, ToList) -> + Combine = case ToList of + true -> fun proper_types:fixed_list/1; + false -> fun proper_types:tuple/1 + end, + fun(AllGFs,TopSize) -> + Size = TopSize div NumRecs, + GFsList = proper_arith:unflatten(AllGFs, RecArgLens), + ArgsList = [[GenFuns,Size] || GenFuns <- GFsList], + ZipFun = fun erlang:apply/2, + Combine(lists:zipwith(ZipFun, RecFuns, ArgsList)) + end. + +-spec union_rec_fun(rec_fun_info()) -> rec_fun(). +union_rec_fun({_NumTypes,_NumRecs,RecArgLens,RecFuns}) -> + fun(AllGFs,Size) -> + GFsList = proper_arith:unflatten(AllGFs, RecArgLens), + ArgsList = [[GenFuns,Size] || GenFuns <- GFsList], + ZipFun = fun(F,A) -> ?LAZY(apply(F,A)) end, + proper_types:union(lists:zipwith(ZipFun, RecFuns, ArgsList)) + end. + +-spec wunion_rec_fun(rec_fun_info()) -> rec_fun(). +wunion_rec_fun({NumTypes,_NumRecs,RecArgLens,RecFuns}) -> + fun(AllGFs,Size) -> + GFsList = proper_arith:unflatten(AllGFs, RecArgLens), + ArgsList = [[GenFuns,Size] || GenFuns <- GFsList], + ZipFun = fun(W,F,A) -> {W,?LAZY(apply(F,A))} end, + RecWeight = erlang:max(1, Size div (NumTypes - 1)), + Weights = [1 | lists:duplicate(NumTypes - 1, RecWeight)], + WeightedChoices = lists:zipwith3(ZipFun, Weights, RecFuns, ArgsList), + proper_types:wunion(WeightedChoices) + end. + +-spec add_ret_type(ret_type(), {[rec_fun()],[rec_args()],non_neg_integer()}) -> + {[rec_fun()],[rec_args()],non_neg_integer()}. +add_ret_type({simple,FinType}, {RecFuns,RecArgsList,NumRecs}) -> + {[fun([],_) -> FinType end | RecFuns], [[] | RecArgsList], NumRecs}; +add_ret_type({rec,RecFun,RecArgs}, {RecFuns,RecArgsList,NumRecs}) -> + {[RecFun | RecFuns], [RecArgs | RecArgsList], NumRecs + 1}. + +-spec is_simple_ret_type(ret_type()) -> boolean(). +is_simple_ret_type({simple,_FinType}) -> + true; +is_simple_ret_type({rec,_RecFun,_RecArgs}) -> + false. + +-spec clean_rec_args(rec_args()) -> rec_args(). +clean_rec_args(RecArgs) -> + [{false,F} || {_B,F} <- RecArgs]. + +-spec soft_clean_rec_args(rec_args(), rec_fun_info(), boolean()) -> rec_args(). +soft_clean_rec_args(RecArgs, RecFunInfo, ToList) -> + soft_clean_rec_args_tr(RecArgs, [], RecFunInfo, ToList, false, 1). + +-spec soft_clean_rec_args_tr(rec_args(), rec_args(), rec_fun_info(), boolean(), + boolean(), position()) -> rec_args(). +soft_clean_rec_args_tr([], Acc, _RecFunInfo, _ToList, _FoundListInst, _Pos) -> + lists:reverse(Acc); +soft_clean_rec_args_tr([{{list,_NonEmpty,_AltRecFun},FTRef} | Rest], Acc, + RecFunInfo, ToList, true, Pos) -> + NewArg = {false,FTRef}, + soft_clean_rec_args_tr(Rest, [NewArg|Acc], RecFunInfo, ToList, true, Pos+1); +soft_clean_rec_args_tr([{{list,NonEmpty,AltRecFun},FTRef} | Rest], Acc, + RecFunInfo, ToList, false, Pos) -> + {NumTypes,NumRecs,RecArgLens,RecFuns} = RecFunInfo, + AltRecFunPos = get_group(Pos, RecArgLens), + AltRecFuns = proper_arith:list_update(AltRecFunPos, AltRecFun, RecFuns), + AltRecFunInfo = {NumTypes,NumRecs,RecArgLens,AltRecFuns}, + NewArg = {{list,NonEmpty,tuple_rec_fun(AltRecFunInfo,ToList)},FTRef}, + soft_clean_rec_args_tr(Rest, [NewArg|Acc], RecFunInfo, ToList, true, Pos+1); +soft_clean_rec_args_tr([Arg | Rest], Acc, RecFunInfo, ToList, FoundListInst, + Pos) -> + soft_clean_rec_args_tr(Rest, [Arg | Acc], RecFunInfo, ToList, FoundListInst, + Pos+1). + +-spec get_group(pos_integer(), [non_neg_integer()]) -> pos_integer(). +get_group(Pos, AllMembers) -> + get_group_tr(Pos, AllMembers, 1). + +-spec get_group_tr(pos_integer(), [non_neg_integer()], pos_integer()) -> + pos_integer(). +get_group_tr(Pos, [Members | Rest], GroupNum) -> + case Pos =< Members of + true -> GroupNum; + false -> get_group_tr(Pos - Members, Rest, GroupNum + 1) + end. + +-spec same_full_type_ref(full_type_ref(), term()) -> boolean(). +same_full_type_ref({SameMod,type,SameName,Args1}, + {SameMod,type,SameName,Args2}) -> + length(Args1) =:= length(Args2) + andalso lists:all(fun({A,B}) -> same_ret_type(A,B) end, + lists:zip(Args1, Args2)); +same_full_type_ref({SameMod,record,SameName,SubstsDict1}, + {SameMod,record,SameName,SubstsDict2}) -> + same_substs_dict(SubstsDict1, SubstsDict2); +same_full_type_ref(_, _) -> + false. + +-spec same_ret_type(ret_type(), ret_type()) -> boolean(). +same_ret_type({simple,FinType1}, {simple,FinType2}) -> + same_fin_type(FinType1, FinType2); +same_ret_type({rec,RecFun1,RecArgs1}, {rec,RecFun2,RecArgs2}) -> + NumRecArgs = length(RecArgs1), + length(RecArgs2) =:= NumRecArgs + andalso lists:all(fun({A1,A2}) -> same_rec_arg(A1,A2,NumRecArgs) end, + lists:zip(RecArgs1,RecArgs2)) + andalso same_rec_fun(RecFun1, RecFun2, NumRecArgs); +same_ret_type(_, _) -> + false. + +%% TODO: Is this too strict? +-spec same_rec_arg(rec_arg(), rec_arg(), arity()) -> boolean(). +same_rec_arg({{list,SameBool,AltRecFun1},FTRef1}, + {{list,SameBool,AltRecFun2},FTRef2}, NumRecArgs) -> + same_rec_fun(AltRecFun1, AltRecFun2, NumRecArgs) + andalso same_full_type_ref(FTRef1, FTRef2); +same_rec_arg({true,FTRef1}, {true,FTRef2}, _NumRecArgs) -> + same_full_type_ref(FTRef1, FTRef2); +same_rec_arg({false,FTRef1}, {false,FTRef2}, _NumRecArgs) -> + same_full_type_ref(FTRef1, FTRef2); +same_rec_arg(_, _, _NumRecArgs) -> + false. + +-spec same_substs_dict(substs_dict(), substs_dict()) -> boolean(). +same_substs_dict(SubstsDict1, SubstsDict2) -> + SameKVPair = fun({{_K,V1},{_K,V2}}) -> same_ret_type(V1,V2); + (_) -> false + end, + SubstsKVList1 = lists:sort(dict:to_list(SubstsDict1)), + SubstsKVList2 = lists:sort(dict:to_list(SubstsDict2)), + length(SubstsKVList1) =:= length(SubstsKVList2) + andalso lists:all(SameKVPair, lists:zip(SubstsKVList1,SubstsKVList2)). + +-spec same_fin_type(fin_type(), fin_type()) -> boolean(). +same_fin_type(Type1, Type2) -> + proper_types:equal_types(Type1, Type2). + +-spec same_rec_fun(rec_fun(), rec_fun(), arity()) -> boolean(). +same_rec_fun(RecFun1, RecFun2, NumRecArgs) -> + %% It's ok that we return a type, even if there's a 'true' for use of + %% an instance. + GenFun = fun(_Size) -> proper_types:exactly('$dummy') end, + GenFuns = lists:duplicate(NumRecArgs,GenFun), + same_fin_type(RecFun1(GenFuns,0), RecFun2(GenFuns,0)). diff --git a/lib/dialyzer/test/map_SUITE_data/dialyzer_options b/lib/dialyzer/test/map_SUITE_data/dialyzer_options new file mode 100644 index 0000000000..50991c9bc5 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/dialyzer_options @@ -0,0 +1 @@ +{dialyzer_options, []}. diff --git a/lib/dialyzer/test/map_SUITE_data/results/bad_argument b/lib/dialyzer/test/map_SUITE_data/results/bad_argument new file mode 100644 index 0000000000..af61a89638 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/bad_argument @@ -0,0 +1,5 @@ + +bad_argument.erl:14: Function t3/0 has no local return +bad_argument.erl:15: Guard test is_map('not_a_map') can never succeed +bad_argument.erl:5: Function t/0 has no local return +bad_argument.erl:6: A key of type 'b' cannot exist in a map of type #{'a':='q'} diff --git a/lib/dialyzer/test/map_SUITE_data/results/contract b/lib/dialyzer/test/map_SUITE_data/results/contract new file mode 100644 index 0000000000..0f6e1d0c65 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/contract @@ -0,0 +1,7 @@ + +contract.erl:10: Function t2/0 has no local return +contract.erl:10: The call missing:f(#{'a':=1, 'c':=4}) breaks the contract (#{'a':=1,'b'=>2,'c'=>3}) -> 'ok' +contract.erl:12: Function t3/0 has no local return +contract.erl:12: The call missing:f(#{'a':=1, 'b':=2, 'e':=3}) breaks the contract (#{'a':=1,'b'=>2,'c'=>3}) -> 'ok' +contract.erl:8: Function t1/0 has no local return +contract.erl:8: The call missing:f(#{'b':=2}) breaks the contract (#{'a':=1,'b'=>2,'c'=>3}) -> 'ok' diff --git a/lib/dialyzer/test/map_SUITE_data/results/contract_violation b/lib/dialyzer/test/map_SUITE_data/results/contract_violation new file mode 100644 index 0000000000..958321618f --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/contract_violation @@ -0,0 +1,3 @@ + +contract_violation.erl:12: The pattern #{I:=Loc} can never match the type #{} +contract_violation.erl:16: Invalid type specification for function contract_violation:beam_disasm_lines/2. The success typing is ('none' | <<_:32,_:_*8>>,_) -> #{pos_integer()=>{'location',_,_}} diff --git a/lib/dialyzer/test/map_SUITE_data/results/exact b/lib/dialyzer/test/map_SUITE_data/results/exact new file mode 100644 index 0000000000..374ada8869 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/exact @@ -0,0 +1,3 @@ + +exact.erl:15: Function t2/1 has no local return +exact.erl:19: The variable _ can never match since previous clauses completely covered the type #{'a':=_, ...} diff --git a/lib/dialyzer/test/map_SUITE_data/results/guard_update b/lib/dialyzer/test/map_SUITE_data/results/guard_update new file mode 100644 index 0000000000..e4bc892195 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/guard_update @@ -0,0 +1,5 @@ + +guard_update.erl:5: Function t/0 has no local return +guard_update.erl:6: The call guard_update:f(#{'a':=2}) will never return since it differs in the 1st argument from the success typing arguments: (#{'b':=_, ...}) +guard_update.erl:8: Clause guard cannot succeed. The variable M was matched against the type #{'a':=2} +guard_update.erl:8: Function f/1 has no local return diff --git a/lib/dialyzer/test/map_SUITE_data/results/initial_dataflow b/lib/dialyzer/test/map_SUITE_data/results/initial_dataflow new file mode 100644 index 0000000000..69144f9208 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/initial_dataflow @@ -0,0 +1,4 @@ + +initial_dataflow.erl:11: The variable Q can never match since previous clauses completely covered the type #{} +initial_dataflow.erl:5: Function test/0 has no local return +initial_dataflow.erl:6: The pattern 'false' can never match the type 'true' diff --git a/lib/dialyzer/test/map_SUITE_data/results/is_map_guard b/lib/dialyzer/test/map_SUITE_data/results/is_map_guard new file mode 100644 index 0000000000..6ab464d865 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/is_map_guard @@ -0,0 +1,5 @@ + +is_map_guard.erl:13: Function t2/0 has no local return +is_map_guard.erl:15: The call is_map_guard:explicit('still_not_map') will never return since it differs in the 1st argument from the success typing arguments: (map()) +is_map_guard.erl:6: Function t1/0 has no local return +is_map_guard.erl:8: The call is_map_guard:implicit('not_a_map') will never return since it differs in the 1st argument from the success typing arguments: (map()) diff --git a/lib/dialyzer/test/map_SUITE_data/results/map_galore b/lib/dialyzer/test/map_SUITE_data/results/map_galore new file mode 100644 index 0000000000..6ea88f01f8 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/map_galore @@ -0,0 +1,28 @@ + +map_galore.erl:1000: A key of type 42 cannot exist in a map of type #{1:='a', 2:='b', 4:='d', 5:='e', float()=>'c' | 'v'} +map_galore.erl:1080: A key of type 'nonexisting' cannot exist in a map of type #{#{'map':='key', 'one':='small'}:=[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}:=[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}:=[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 16:='a6', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 26:='b6', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 36:=[54 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[54 | 99,...], 16=>'a6', 26=>'b6', 36=>[54 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]}=>[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 100 | 101,...]}=>atom() | [1..255,...]} +map_galore.erl:1082: A key of type 42 cannot exist in a map of type #{#{'map':='key', 'one':='small'}:=[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}:=[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}:=[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 16:='a6', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 26:='b6', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 36:=[54 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[54 | 99,...], 16=>'a6', 26=>'b6', 36=>[54 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]}=>[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 100 | 101,...]}=>atom() | [1..255,...]} +map_galore.erl:1140: The call map_galore:map_guard_sequence_1(#{'seq':=6, 'val':=[101,...]}) will never return since it differs in the 1st argument from the success typing arguments: (#{'seq':=1 | 2 | 3 | 4 | 5, 'val':=[97 | 98 | 99 | 100 | 101,...], #{'map':='key', 'one':='small'}=>[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}=>[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}=>[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[any(),...], 31:=[any(),...], 32:=[any(),...], 33:=[any(),...], 34:=[any(),...], 35:=[any(),...], 37:=[any(),...], 38:=[any(),...], 39:=[any(),...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 16=>'a6', 26=>'b6', 36=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) +map_galore.erl:1141: The call map_galore:map_guard_sequence_2(#{'b':=5}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':='gg' | 'kk' | 'sc' | 3 | 4, 'b'=>'other' | 3 | 4 | 5, 'c'=>'sc2', #{'map':='key', 'one':='small'}=>[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}=>[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}=>[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[any(),...], 31:=[any(),...], 32:=[any(),...], 33:=[any(),...], 34:=[any(),...], 35:=[any(),...], 37:=[any(),...], 38:=[any(),...], 39:=[any(),...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 16=>'a6', 26=>'b6', 36=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) +map_galore.erl:1209: The call map_galore:map_guard_sequence_1(#{'seq':=6, 'val':=[101,...], #{'map':='key', 'one':='small'}:=[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}:=[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}:=[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 16:='a6', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 26:='b6', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 36:=[54 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | 3,...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[54 | 99,...], 16=>'a6', 26=>'b6', 36=>[54 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]}=>[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 100 | 101,...]}=>atom() | [1..255,...]}) will never return since it differs in the 1st argument from the success typing arguments: (#{'seq':=1 | 2 | 3 | 4 | 5, 'val':=[97 | 98 | 99 | 100 | 101,...], #{'map':='key', 'one':='small'}=>[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}=>[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}=>[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[any(),...], 31:=[any(),...], 32:=[any(),...], 33:=[any(),...], 34:=[any(),...], 35:=[any(),...], 37:=[any(),...], 38:=[any(),...], 39:=[any(),...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 16=>'a6', 26=>'b6', 36=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) +map_galore.erl:1210: The call map_galore:map_guard_sequence_2(#{'b':=5, #{'map':='key', 'one':='small'}:=[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}:=[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}:=[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 16:='a6', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 26:='b6', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 36:=[54 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | 3,...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[54 | 99,...], 16=>'a6', 26=>'b6', 36=>[54 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]}=>[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 100 | 101,...]}=>atom() | [1..255,...]}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':='gg' | 'kk' | 'sc' | 3 | 4, 'b'=>'other' | 3 | 4 | 5, 'c'=>'sc2', #{'map':='key', 'one':='small'}=>[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}=>[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}=>[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[any(),...], 31:=[any(),...], 32:=[any(),...], 33:=[any(),...], 34:=[any(),...], 35:=[any(),...], 37:=[any(),...], 38:=[any(),...], 39:=[any(),...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 16=>'a6', 26=>'b6', 36=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) +map_galore.erl:1418: Fun application with arguments (#{'s':='none', 'v':='none'}) will never return since it differs in the 1st argument from the success typing arguments: (#{'s':='l' | 't' | 'v', 'v':='none' | <<_:16>> | [<<_:16>>,...] | {<<_:16>>,<<_:16>>}}) +map_galore.erl:1491: The test #{} =:= #{'a':=1} can never evaluate to 'true' +map_galore.erl:1492: The test #{'a':=1} =:= #{} can never evaluate to 'true' +map_galore.erl:1495: The test #{'a':=1} =:= #{'a':=2} can never evaluate to 'true' +map_galore.erl:1496: The test #{'a':=2} =:= #{'a':=1} can never evaluate to 'true' +map_galore.erl:1497: The test #{'a':=2, 'b':=1} =:= #{'a':=1, 'b':=3} can never evaluate to 'true' +map_galore.erl:1498: The test #{'a':=1, 'b':=1} =:= #{'a':=1, 'b':=3} can never evaluate to 'true' +map_galore.erl:1762: The call maps:get({1, 1},#{{1,float()}=>[101 | 108 | 112 | 116 | 117,...]}) will never return since the success typing arguments are (any(),map()) +map_galore.erl:1763: The call maps:get('a',#{}) will never return since the success typing arguments are (any(),map()) +map_galore.erl:1765: The call maps:get('a',#{'b':=1, 'c':=2}) will never return since the success typing arguments are (any(),map()) +map_galore.erl:186: The pattern #{'x':=2} can never match the type #{'x':=3} +map_galore.erl:187: The pattern #{'x':=3} can never match the type {'a','b','c'} +map_galore.erl:188: The pattern #{'x':=3} can never match the type #{'y':=3} +map_galore.erl:189: The pattern #{'x':=3} can never match the type #{'x':=[101 | 104 | 114 | 116,...]} +map_galore.erl:2304: Cons will produce an improper list since its 2nd argument is {'b','a'} +map_galore.erl:2304: The call maps:from_list(nonempty_improper_list({'a','b'},{'b','a'})) will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) +map_galore.erl:2305: The call maps:from_list('a') will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) +map_galore.erl:2306: The call maps:from_list(42) will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) +map_galore.erl:997: A key of type 'nonexisting' cannot exist in a map of type #{} +map_galore.erl:998: A key of type 'nonexisting' cannot exist in a map of type #{1:='a', 2:='b', 4:='d', 5:='e', float()=>'c'} diff --git a/lib/dialyzer/test/map_SUITE_data/results/map_in_guard b/lib/dialyzer/test/map_SUITE_data/results/map_in_guard new file mode 100644 index 0000000000..1015f76128 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/map_in_guard @@ -0,0 +1,4 @@ + +map_in_guard.erl:10: The call map_in_guard:assoc_update('not_a_map') will never return since it differs in the 1st argument from the success typing arguments: (#{}) +map_in_guard.erl:13: The call map_in_guard:assoc_guard_clause('not_a_map') will never return since it differs in the 1st argument from the success typing arguments: (#{}) +map_in_guard.erl:20: The call map_in_guard:exact_guard_clause(#{}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':='q'}) diff --git a/lib/dialyzer/test/map_SUITE_data/results/map_in_guard2 b/lib/dialyzer/test/map_SUITE_data/results/map_in_guard2 new file mode 100644 index 0000000000..6bc0c010d7 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/map_in_guard2 @@ -0,0 +1,13 @@ + +map_in_guard2.erl:10: The call map_in_guard2:assoc_guard_clause('not_a_map') will never return since it differs in the 1st argument from the success typing arguments: (map()) +map_in_guard2.erl:12: The pattern 'true' can never match the type 'false' +map_in_guard2.erl:14: The call map_in_guard2:exact_guard_clause(#{}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':=_, ...}) +map_in_guard2.erl:17: Clause guard cannot succeed. The variable M was matched against the type 'not_a_map' +map_in_guard2.erl:20: Function assoc_update/1 has no local return +map_in_guard2.erl:20: Guard test is_map(M::'not_a_map') can never succeed +map_in_guard2.erl:22: Clause guard cannot succeed. The variable M was matched against the type 'not_a_map' +map_in_guard2.erl:22: Function assoc_guard_clause/1 has no local return +map_in_guard2.erl:24: Clause guard cannot succeed. The variable M was matched against the type #{} +map_in_guard2.erl:27: Clause guard cannot succeed. The variable M was matched against the type #{} +map_in_guard2.erl:27: Function exact_guard_clause/1 has no local return +map_in_guard2.erl:8: The call map_in_guard2:assoc_update('not_a_map') will never return since it differs in the 1st argument from the success typing arguments: (map()) diff --git a/lib/dialyzer/test/map_SUITE_data/results/map_size b/lib/dialyzer/test/map_SUITE_data/results/map_size new file mode 100644 index 0000000000..fc6c1f028c --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/map_size @@ -0,0 +1,13 @@ + +map_size.erl:11: The pattern 1 can never match the type 0 +map_size.erl:13: Function t2/0 has no local return +map_size.erl:15: Function p/1 has no local return +map_size.erl:15: Guard test 1 =:= 0 can never succeed +map_size.erl:17: Function t3/0 has no local return +map_size.erl:21: The pattern 4 can never match the type 1 | 2 | 3 +map_size.erl:23: Function t4/0 has no local return +map_size.erl:24: The pattern 0 can never match the type 1 | 2 | 3 +map_size.erl:26: Function t5/1 has no local return +map_size.erl:5: Function t1/0 has no local return +map_size.erl:7: The pattern 1 can never match the type 0 +map_size.erl:9: Function e1/0 has no local return diff --git a/lib/dialyzer/test/map_SUITE_data/results/maps_merge b/lib/dialyzer/test/map_SUITE_data/results/maps_merge new file mode 100644 index 0000000000..0c347b4cdb --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/maps_merge @@ -0,0 +1,11 @@ + +maps_merge.erl:10: The pattern #{_:=_} can never match the type #{'a':=1, 3:='ok', 'q'=>none(), 7=>none(), atom() | integer()=>_} +maps_merge.erl:12: Function t3/0 has no local return +maps_merge.erl:14: The pattern #{7:='q'} can never match the type #{'a':=1, 3:='ok', 'q'=>none(), 7=>none(), atom() | integer()=>_} +maps_merge.erl:16: Function t4/0 has no local return +maps_merge.erl:18: The pattern #{7:='q'} can never match the type #{'a':=1, 3:='ok', 'q'=>none(), 7=>none(), atom() | integer()=>_} +maps_merge.erl:20: Function t5/0 has no local return +maps_merge.erl:21: The pattern #{'a':=2} can never match the type #{'a':=1, 'q'=>none(), 11=>_, atom()=>_} +maps_merge.erl:5: Function t1/0 has no local return +maps_merge.erl:6: The pattern #{'a':=1} can never match the type #{} +maps_merge.erl:8: Function t2/0 has no local return diff --git a/lib/dialyzer/test/map_SUITE_data/results/opaque_key b/lib/dialyzer/test/map_SUITE_data/results/opaque_key new file mode 100644 index 0000000000..fb7080cdc5 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/opaque_key @@ -0,0 +1,15 @@ + +opaque_key_adt.erl:41: Invalid type specification for function opaque_key_adt:s4/0. The success typing is () -> #{1:='a'} +opaque_key_adt.erl:44: Invalid type specification for function opaque_key_adt:s5/0. The success typing is () -> #{2:=3} +opaque_key_adt.erl:56: Invalid type specification for function opaque_key_adt:smt1/0. The success typing is () -> #{3:='a'} +opaque_key_adt.erl:59: Invalid type specification for function opaque_key_adt:smt2/0. The success typing is () -> #{1:='a'} +opaque_key_use.erl:13: The test opaque_key_use:t() =:= opaque_key_use:t(integer()) can never evaluate to 'true' +opaque_key_use.erl:24: Attempt to test for equality between a term of type opaque_key_adt:t(integer()) and a term of opaque type opaque_key_adt:t() +opaque_key_use.erl:37: Function adt_mm1/0 has no local return +opaque_key_use.erl:40: The attempt to match a term of type opaque_key_adt:m() against the pattern #{A:=R} breaks the opaqueness of the term +opaque_key_use.erl:48: Function adt_mu1/0 has no local return +opaque_key_use.erl:51: Guard test is_map(M::opaque_key_adt:m()) breaks the opaqueness of its argument +opaque_key_use.erl:53: Function adt_mu2/0 has no local return +opaque_key_use.erl:56: Guard test is_map(M::opaque_key_adt:m()) breaks the opaqueness of its argument +opaque_key_use.erl:58: Function adt_mu3/0 has no local return +opaque_key_use.erl:60: Guard test is_map(M::opaque_key_adt:m()) breaks the opaqueness of its argument diff --git a/lib/dialyzer/test/map_SUITE_data/results/order b/lib/dialyzer/test/map_SUITE_data/results/order new file mode 100644 index 0000000000..7be789a11a --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/order @@ -0,0 +1,17 @@ + +order.erl:12: Function t2/0 has no local return +order.erl:14: Guard test is_integer(Int::'b') can never succeed +order.erl:16: The variable _Else can never match since previous clauses completely covered the type 'b' +order.erl:19: Function t3/0 has no local return +order.erl:21: Guard test is_integer(Int::'b') can never succeed +order.erl:23: The variable _Else can never match since previous clauses completely covered the type 'b' +order.erl:30: The variable _Else can never match since previous clauses completely covered the type 'b' | 1 +order.erl:33: Function t5/0 has no local return +order.erl:36: The variable Atom can never match since previous clauses completely covered the type 1 +order.erl:37: The variable _Else can never match since previous clauses completely covered the type 1 +order.erl:40: Function t6/0 has no local return +order.erl:42: Guard test is_integer(Int::'b') can never succeed +order.erl:44: The variable _Else can never match since previous clauses completely covered the type 'b' +order.erl:5: Function t1/0 has no local return +order.erl:7: Guard test is_integer(Int::'b') can never succeed +order.erl:9: The variable _Else can never match since previous clauses completely covered the type 'b' diff --git a/lib/dialyzer/test/map_SUITE_data/results/subtract_value_flip b/lib/dialyzer/test/map_SUITE_data/results/subtract_value_flip new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/subtract_value_flip diff --git a/lib/dialyzer/test/map_SUITE_data/results/typeflow b/lib/dialyzer/test/map_SUITE_data/results/typeflow new file mode 100644 index 0000000000..e3378a24bb --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/typeflow @@ -0,0 +1,4 @@ + +typeflow.erl:14: Function t2/1 has no local return +typeflow.erl:16: The call lists:sort(integer()) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) +typeflow.erl:9: The variable _ can never match since previous clauses completely covered the type #{'a':=integer(), ...} diff --git a/lib/dialyzer/test/map_SUITE_data/results/typeflow2 b/lib/dialyzer/test/map_SUITE_data/results/typeflow2 new file mode 100644 index 0000000000..3adf638978 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/typeflow2 @@ -0,0 +1,13 @@ + +typeflow2.erl:10: The pattern #{'a':=X} can never match the type #{'a'=>none(), _=>maybe_improper_list() | integer()} +typeflow2.erl:11: The pattern #{'a':=X} can never match the type #{'a'=>none(), _=>maybe_improper_list() | integer()} +typeflow2.erl:26: Function t2/1 has no local return +typeflow2.erl:29: The call lists:sort(integer()) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) +typeflow2.erl:42: The pattern #{'a':=X} can never match since previous clauses completely covered the type #{'a':=integer()} +typeflow2.erl:43: The variable _ can never match since previous clauses completely covered the type #{'a':=integer()} +typeflow2.erl:48: The pattern #{} can never match since previous clauses completely covered the type #{'a':=atom() | maybe_improper_list() | integer()} +typeflow2.erl:58: The pattern #{'a':=X} can never match the type #{'a'=>none(), _=>maybe_improper_list() | integer()} +typeflow2.erl:59: The pattern #{'a':=X} can never match the type #{'a'=>none(), _=>maybe_improper_list() | integer()} +typeflow2.erl:60: The pattern #{'a':=X} can never match the type #{'a'=>none(), _=>maybe_improper_list() | integer()} +typeflow2.erl:82: The pattern #{'a':=X} can never match the type #{} +typeflow2.erl:83: The pattern #{'a':=X} can never match the type #{} diff --git a/lib/dialyzer/test/map_SUITE_data/results/typesig b/lib/dialyzer/test/map_SUITE_data/results/typesig new file mode 100644 index 0000000000..3049402860 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/typesig @@ -0,0 +1,5 @@ + +typesig.erl:5: Function t1/0 has no local return +typesig.erl:5: The call typesig:test(#{'a':=1}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':={number()}, ...}) +typesig.erl:6: Function t2/0 has no local return +typesig.erl:6: The call typesig:test(#{'a':={'b'}}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':={number()}, ...}) diff --git a/lib/dialyzer/test/map_SUITE_data/src/bad_argument.erl b/lib/dialyzer/test/map_SUITE_data/src/bad_argument.erl new file mode 100644 index 0000000000..95e2b32ddc --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/bad_argument.erl @@ -0,0 +1,19 @@ +-module(bad_argument). + +-export([t/0, t2/0, t3/0]). + +t() -> + _=(id1(#{a=>q}))#{b:=9}. + +t2() -> + _ = id2(4), + X = id2(3), + _ = (#{ X => q})#{3 := p}, + X. + +t3() -> + (id3(not_a_map))#{a => b}. + +id1(X) -> X. +id2(X) -> X. +id3(X) -> X. diff --git a/lib/dialyzer/test/map_SUITE_data/src/bug.erl b/lib/dialyzer/test/map_SUITE_data/src/bug.erl new file mode 100644 index 0000000000..fc32f5641a --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/bug.erl @@ -0,0 +1,63 @@ +-module(bug). + +-export([t1/0, f1/1 + ,t2/0, f2/1 + ,t3/0, f3/1 + ,t4/0, f4/1 + ,t5/0, f5/1 + ]). + +t1() -> + V = f1(#{a=>b}), + case V of + #{a := Q} -> Q; %% Must not warn here + _ -> ok + end, + ok. + +f1(M) -> %% Should get map() succ typing + #{} = M. + +t2() -> + V = f2([#{a=>b}]), + case V of + [#{a := P}] -> P; %% Must not warn here + _ -> ok + end, + ok. + +f2(M) -> %% Should get [map(),...] succ typing + [#{}] = M. + +t3() -> + V = f3([#{a=>b},a]), + case V of + [#{a := P}, _Q] -> P; %% Must not warn here + _ -> ok + end, + ok. + +f3(M) -> %% Should get [map()|a,...] succ typing + [#{},a] = M. + +t4() -> + V = f4({#{a=>b},{}}), + case V of + {#{a := P},{}} -> P; %% Must not warn here + _ -> ok + end, + ok. + +f4(M) -> %% Should get {map(),{}} succ typing + {#{},{}} = M. + +t5() -> + V = f5(#{k=>q,a=>b}), + case V of + #{k := q, a := P} -> P; %% Must not warn here + _ -> ok + end, + ok. + +f5(M) -> %% Should get #{k:=q, ...} succ typing + #{k:=q} = M. diff --git a/lib/dialyzer/test/map_SUITE_data/src/contract.erl b/lib/dialyzer/test/map_SUITE_data/src/contract.erl new file mode 100644 index 0000000000..2b31be0d58 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/contract.erl @@ -0,0 +1,14 @@ +-module(missing). + +-export([t1/0, t2/0, t3/0, t4/0]). + +-spec f(#{a := 1, b => 2, c => 3}) -> ok. +f(_) -> ok. + +t1() -> f(#{b => 2}). + +t2() -> f(#{a => 1, c => 4}). + +t3() -> f(#{a => 1, b => 2, e => 3}). + +t4() -> f(#{a => 1, b => 2}). diff --git a/lib/dialyzer/test/map_SUITE_data/src/contract_violation.erl b/lib/dialyzer/test/map_SUITE_data/src/contract_violation.erl new file mode 100644 index 0000000000..850f2cad34 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/contract_violation.erl @@ -0,0 +1,29 @@ +-module(contract_violation). + +-export([entry/1, beam_disasm_lines/2]). + +%%----------------------------------------------------------------------- + +-type lines() :: #{non_neg_integer() => {string(), non_neg_integer()}}. + +entry(Bin) -> + I = 42, + case beam_disasm_lines(Bin, ':-)') of + #{I := Loc} -> {good, Loc}; + _ -> bad + end. + +-spec beam_disasm_lines(binary() | none, module()) -> lines(). + +beam_disasm_lines(none, _) -> #{}; +beam_disasm_lines(<<NumLines:32, LineBin:NumLines/binary, FileBin/binary>>, + _Module) -> + Lines = binary_to_term(LineBin), + Files = binary_to_term(FileBin), + lines_collect_items(Lines, Files, #{}). + +lines_collect_items([], _, Acc) -> Acc; +lines_collect_items([{FileNo, LineNo}|Rest], Files, Acc) -> + #{FileNo := File} = Files, + lines_collect_items( + Rest, Files, Acc#{map_size(Acc)+1 => {location, File, LineNo}}). diff --git a/lib/dialyzer/test/map_SUITE_data/src/exact.erl b/lib/dialyzer/test/map_SUITE_data/src/exact.erl new file mode 100644 index 0000000000..e5ad02ec54 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/exact.erl @@ -0,0 +1,23 @@ +-module(exact). + +-export([t1/1, t2/1]). + +t1(M = #{}) -> + any_map(M), + case M of + #{a := _} -> error(fail); + _ -> ok + end. + +any_map(X) -> + X#{a => 1, a := 2}. + +t2(M = #{}) -> + has_a(M), + case M of + #{a := _} -> error(ok); + _ -> unreachable + end. + +has_a(M) -> + M#{a := 1, a => 2}. diff --git a/lib/dialyzer/test/map_SUITE_data/src/guard_update.erl b/lib/dialyzer/test/map_SUITE_data/src/guard_update.erl new file mode 100644 index 0000000000..19d0089401 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/guard_update.erl @@ -0,0 +1,18 @@ +-module(guard_update). + +-export([t/0, t2/0]). + +t() -> + f(#{a=>2}). %% Illegal + +f(M) + when M#{b := 7} =/= q + -> ok. + +t2() -> + f2(#{a=>2}). %% Legal! + +f2(M) + when M#{b := 7} =/= q; + M =/= p + -> ok. diff --git a/lib/dialyzer/test/map_SUITE_data/src/initial_dataflow.erl b/lib/dialyzer/test/map_SUITE_data/src/initial_dataflow.erl new file mode 100644 index 0000000000..bbc0d5682a --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/initial_dataflow.erl @@ -0,0 +1,11 @@ +-module(initial_dataflow). + +-export([test/0]). + +test() -> + false = assoc_guard(#{}), + true = assoc_guard(not_a_map), + ok. + +assoc_guard(#{}) -> true; +assoc_guard(Q) -> false. diff --git a/lib/dialyzer/test/map_SUITE_data/src/is_map_guard.erl b/lib/dialyzer/test/map_SUITE_data/src/is_map_guard.erl new file mode 100644 index 0000000000..ceb4a8763a --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/is_map_guard.erl @@ -0,0 +1,17 @@ +-module(is_map_guard). + +-export([t1/0, t2/0, implicit/1, explicit/1 + ]). + +t1() -> + _ = implicit(#{}), + implicit(not_a_map). + +implicit(M) -> + M#{}. + +t2() -> + explicit(#{q=>d}), + explicit(still_not_map). + +explicit(M) when is_map(M) -> ok. diff --git a/lib/dialyzer/test/map_SUITE_data/src/map_galore.erl b/lib/dialyzer/test/map_SUITE_data/src/map_galore.erl new file mode 100644 index 0000000000..2611241379 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/map_galore.erl @@ -0,0 +1,2824 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(map_galore). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2 + ]). + +-export([ + t_build_and_match_literals/1, t_build_and_match_literals_large/1, + t_update_literals/1, t_update_literals_large/1, + t_match_and_update_literals/1, t_match_and_update_literals_large/1, + t_update_map_expressions/1, + t_update_assoc/1, t_update_assoc_large/1, + t_update_exact/1, t_update_exact_large/1, + t_guard_bifs/1, + t_guard_sequence/1, t_guard_sequence_large/1, + t_guard_update/1, t_guard_update_large/1, + t_guard_receive/1, t_guard_receive_large/1, + t_guard_fun/1, + t_update_deep/1, + t_list_comprehension/1, + t_map_sort_literals/1, + t_map_equal/1, + t_map_compare/1, + t_map_size/1, + t_is_map/1, + + %% Specific Map BIFs + t_bif_map_get/1, + t_bif_map_find/1, + t_bif_map_is_key/1, + t_bif_map_keys/1, + t_bif_map_merge/1, + t_bif_map_new/1, + t_bif_map_put/1, + t_bif_map_remove/1, + t_bif_map_update/1, + t_bif_map_values/1, + t_bif_map_to_list/1, + t_bif_map_from_list/1, + + %% erlang + t_erlang_hash/1, + t_map_encode_decode/1, + + %% non specific BIF related + t_bif_build_and_check/1, + t_bif_merge_and_check/1, + + %% maps module not bifs + t_maps_fold/1, + t_maps_map/1, + t_maps_size/1, + t_maps_without/1, + + %% misc + t_erts_internal_order/1, + t_erts_internal_hash/1, + t_pdict/1, + t_ets/1, + t_dets/1, + t_tracing/1, + + %% instruction-level tests + t_has_map_fields/1, + y_regs/1 + ]). + +-include_lib("stdlib/include/ms_transform.hrl"). + +-define(CHECK(Cond,Term), + case (catch (Cond)) of + true -> true; + _ -> io:format("###### CHECK FAILED ######~nINPUT: ~p~n", [Term]), + exit(Term) + end). + +suite() -> []. + +all() -> [ + t_build_and_match_literals, t_build_and_match_literals_large, + t_update_literals, t_update_literals_large, + t_match_and_update_literals, t_match_and_update_literals_large, + t_update_map_expressions, + t_update_assoc, t_update_assoc_large, + t_update_exact, t_update_exact_large, + t_guard_bifs, + t_guard_sequence, t_guard_sequence_large, + t_guard_update, t_guard_update_large, + t_guard_receive, t_guard_receive_large, + t_guard_fun, t_list_comprehension, + t_update_deep, + t_map_equal, t_map_compare, + t_map_sort_literals, + + %% 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, + t_bif_map_put, + t_bif_map_remove, t_bif_map_update, + t_bif_map_values, + t_bif_map_to_list, t_bif_map_from_list, + + %% erlang + t_erlang_hash, t_map_encode_decode, + t_map_size, t_is_map, + + %% non specific BIF related + t_bif_build_and_check, + t_bif_merge_and_check, + + %% maps module + t_maps_fold, t_maps_map, + t_maps_size, t_maps_without, + + + %% Other functions + t_erts_internal_order, + t_erts_internal_hash, + t_pdict, + t_ets, + t_tracing, + + %% instruction-level tests + t_has_map_fields, + y_regs + ]. + +groups() -> []. + +init_per_suite(Config) -> Config. +end_per_suite(_Config) -> ok. + +init_per_group(_GroupName, Config) -> Config. +end_per_group(_GroupName, Config) -> Config. + +%% tests + +t_build_and_match_literals(Config) when is_list(Config) -> + #{} = #{}, + #{1:=a} = #{1=>a}, + #{1:=a,2:=b} = #{1=>a,2=>b}, + #{1:=a,2:=b,3:="c"} = #{1=>a,2=>b,3=>"c"}, + #{1:=a,2:=b,3:="c","4":="d"} = #{1=>a,2=>b,3=>"c","4"=>"d"}, + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>} = + #{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>}, + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f"} = + #{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f"}, + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} = + #{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}, + + #{[]:=a,42.0:=b,x:={x,y},[a,b]:=list} = + #{[]=>a,42.0=>b,x=>{x,y},[a,b]=>list}, + + #{<<"hi all">> := 1} = #{<<"hi",32,"all">> => 1}, + + #{a:=X,a:=X=3,b:=4} = #{a=>3,b=>4}, % weird but ok =) + + #{ a:=#{ b:=#{c := third, b:=second}}, b:=first} = + #{ b=>first, a=>#{ b=>#{c => third, b=> second}}}, + + M = #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}, + M = #{ map_1:=#{ map_2:=#{value_3 := third}, value_2:= second}, value_1:=first} = + #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}, + + %% error case + %V = 32, + %{'EXIT',{{badmatch,_},_}} = (catch (#{<<"hi all">> => 1} = #{<<"hi",V,"all">> => 1})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = #{x=>3})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = #{x=>3})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = {a,b,c})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = #{y=>3})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = #{x=>"three"})), + ok. + +t_build_and_match_literals_large(Config) when is_list(Config) -> + % normal non-repeating + M0 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" }, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M0, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M0, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M0, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M0, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M0, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M0, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M0, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M0, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M0, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M0, + + 60 = map_size(M0), + 60 = maps:size(M0), + + % with repeating + M1 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 10=>na0,20=>nb0,30=>"nc0","40"=>"nd0",<<"50">>=>"ne0",{["00"]}=>"n10", + 11=>na1,21=>nb1,31=>"nc1","41"=>"nd1",<<"51">>=>"ne1",{["01"]}=>"n11", + 12=>na2,22=>nb2,32=>"nc2","42"=>"nd2",<<"52">>=>"ne2",{["02"]}=>"n12", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + + 13=>na3,23=>nb3,33=>"nc3","43"=>"nd3",<<"53">>=>"ne3",{["03"]}=>"n13", + 14=>na4,24=>nb4,34=>"nc4","44"=>"nd4",<<"54">>=>"ne4",{["04"]}=>"n14", + + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" }, + + #{10:=na0,20:=nb0,30:="nc0","40":="nd0",<<"50">>:="ne0",{["00"]}:="n10"} = M1, + #{11:=na1,21:=nb1,31:="nc1","41":="nd1",<<"51">>:="ne1",{["01"]}:="n11"} = M1, + #{12:=na2,22:=nb2,32:="nc2","42":="nd2",<<"52">>:="ne2",{["02"]}:="n12"} = M1, + #{13:=na3,23:=nb3,33:="nc3","43":="nd3",<<"53">>:="ne3",{["03"]}:="n13"} = M1, + #{14:=na4,24:=nb4,34:="nc4","44":="nd4",<<"54">>:="ne4",{["04"]}:="n14"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M1, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M1, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M1, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M1, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M1, + + 60 = map_size(M1), + 60 = maps:size(M1), + + % with floats + + M2 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9"}, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + 90 = map_size(M2), + 90 = maps:size(M2), + + % with bignums + M3 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + 36893488147419103232=>big1, 73786976294838206464=>big2, + 147573952589676412928=>big3, 18446744073709551616=>big4, + 4294967296=>big5, 8589934592=>big6, + 4294967295=>big7, 67108863=>big8 + }, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{36893488147419103232:=big1,67108863:=big8,"45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{147573952589676412928:=big3,8589934592:=big6,"46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{4294967296:=big5,18446744073709551616:=big4,"47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{4294967295:=big7,73786976294838206464:=big2,"48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + + 98 = map_size(M3), + 98 = maps:size(M3), + + %% with maps + + M4 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M4, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M4, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M4, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M4, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M4, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M4, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M4, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M4, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M4, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M4, + + #{ #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := "small map key 2", + #{ third => small, map => key } := "small map key 3" } = M4, + + #{ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 2" } = M4, + + + #{ 15:=V1,25:=b5,35:=V2,"45":="d5",<<"55">>:=V3,{["05"]}:="15", + #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := V4, + #{ third => small, map => key } := "small map key 3", + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := V5 } = M4, + + a5 = V1, + "c5" = V2, + "e5" = V3, + "small map key 2" = V4, + "large map key 1" = V5, + + 95 = map_size(M4), + 95 = maps:size(M4), + + % call for value + + M5 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M5, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M5, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M5, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M5, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M5, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M5, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M5, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M5, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M5, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M5, + + #{ #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := "small map key 2", + #{ third => small, map => key } := "small map key 3" } = M5, + + #{ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 2" } = M5, + + 95 = map_size(M5), + 95 = maps:size(M5), + + %% remember + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M0, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M0, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M0, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M0, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M0, + + #{10:=na0,20:=nb0,30:="nc0","40":="nd0",<<"50">>:="ne0",{["00"]}:="n10"} = M1, + #{11:=na1,21:=nb1,31:="nc1","41":="nd1",<<"51">>:="ne1",{["01"]}:="n11"} = M1, + #{12:=na2,22:=nb2,32:="nc2","42":="nd2",<<"52">>:="ne2",{["02"]}:="n12"} = M1, + #{13:=na3,23:=nb3,33:="nc3","43":="nd3",<<"53">>:="ne3",{["03"]}:="n13"} = M1, + #{14:=na4,24:=nb4,34:="nc4","44":="nd4",<<"54">>:="ne4",{["04"]}:="n14"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M1, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M1, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M1, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M1, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{36893488147419103232:=big1,67108863:=big8,"45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{147573952589676412928:=big3,8589934592:=big6,"46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{4294967296:=big5,18446744073709551616:=big4,"47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{4294967295:=big7,73786976294838206464:=big2,"48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + + ok. + + +t_map_size(Config) when is_list(Config) -> + 0 = map_size(#{}), + 1 = map_size(#{a=>1}), + 1 = map_size(#{a=>"wat"}), + 2 = map_size(#{a=>1, b=>2}), + 3 = map_size(#{a=>1, b=>2, b=>"3","33"=><<"n">>}), + + true = map_is_size(#{a=>1}, 1), + true = map_is_size(#{a=>1, a=>2}, 1), + M = #{ "a" => 1, "b" => 2}, + true = map_is_size(M, 2), + false = map_is_size(M, 3), + true = map_is_size(M#{ "a" => 2}, 2), + false = map_is_size(M#{ "c" => 2}, 2), + + Ks = [build_key(fun(K) -> <<1,K:32,1>> end,I)||I<-lists:seq(1,100)], + ok = build_and_check_size(Ks,0,#{}), + + %% try deep collisions + %% statistically we get another subtree at 50k -> 100k elements + %% Try to be nice and don't use too much memory in the testcase, + + N = 500000, + Is = lists:seq(1,N), + N = map_size(maps:from_list([{I,I}||I<-Is])), + N = map_size(maps:from_list([{<<I:32>>,I}||I<-Is])), + N = map_size(maps:from_list([{integer_to_list(I),I}||I<-Is])), + N = map_size(maps:from_list([{float(I),I}||I<-Is])), + + %% Error cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch map_size(T)) + end), + ok. + +build_and_check_size([K|Ks],N,M0) -> + N = map_size(M0), + M1 = M0#{ K => K }, + build_and_check_size(Ks,N + 1,M1); +build_and_check_size([],N,M) -> + N = map_size(M), + ok. + +map_is_size(M,N) when map_size(M) =:= N -> true; +map_is_size(_,_) -> false. + +t_is_map(Config) when is_list(Config) -> + true = is_map(#{}), + true = is_map(#{a=>1}), + false = is_map({a,b}), + false = is_map(x), + if is_map(#{}) -> ok end, + if is_map(#{b=>1}) -> ok end, + if not is_map([1,2,3]) -> ok end, + if not is_map(x) -> ok end, + ok. + +% test map updates without matching +t_update_literals_large(Config) when is_list(Config) -> + Map = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + +t_update_literals(Config) when is_list(Config) -> + Map = #{x=>1,y=>2,z=>3,q=>4}, + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + + +loop_update_literals_x_q(Map, []) -> Map; +loop_update_literals_x_q(Map, [{X,Q}|Vs]) -> + loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs). + +% test map updates with matching +t_match_and_update_literals(Config) when is_list(Config) -> + Map = #{ x=>0,y=>"untouched",z=>"also untouched",q=>1, + #{ "one" => small, map => key } => "small map key 1" }, + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M1 = #{}, + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + +t_match_and_update_literals_large(Config) when is_list(Config) -> + Map = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + x=>0,y=>"untouched",z=>"also untouched",q=>1, + + #{ "one" => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = Map#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M1 = Map#{}, + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + + +loop_match_and_update_literals_x_q(Map, []) -> Map; +loop_match_and_update_literals_x_q(#{ q:=Q0, x:=X0, + #{ "one" => small, map => key } := "small map key 1" } = Map, [{X,Q}|Vs]) -> + loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs). + + +t_update_map_expressions(Config) when is_list(Config) -> + M = maps:new(), + #{ a := 1 } = M#{a => 1}, + + #{ b := 2 } = (maps:new())#{ b => 2 }, + + #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 }, + #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 }, + Ks = lists:seq($a,$z), + #{ "aa" := {$a,$a}, "ac":=41, "dc":=42 } = + (maps:from_list([{[K1,K2],{K1,K2}}|| K1 <- Ks, K2 <- Ks]))#{ "ac" := 41, "dc" => 42 }, + + %% Error cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch (T)#{a:=42,b=>2}) + end), + ok. + +t_update_assoc(Config) when is_list(Config) -> + M0 = #{1=>a,2=>b,3.0=>c,4=>d,5=>e}, + + M1 = M0#{1=>42,2=>100,4=>[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,3.0:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{3.0=>new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,3.0=>new}, + + %% Errors cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch T#{nonexisting=>val}) + end), + ok. + + +t_update_assoc_large(Config) when is_list(Config) -> + M0 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + + M1 = M0#{1=>42,2=>100,4=>[a,b,c]}, + #{1:=42,2:=100,10.0:=fa0,4:=[a,b,c],25:=b5} = M1, + #{ 10:=43, 24:=b4, 15:=a5, 35:="c5", 2.0:=100, 13.0:=fa3, 4.0:=[a,b,c]} = + M0#{1.0=>float,10:=43,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{13.0=>new}, + #{10:=a0,20:=b0,13.0:=new,"40":="d0",<<"50">>:="e0"} = M2, + M2 = M0#{13.0:=wrong,13.0=>new}, + + ok. + +t_update_exact(Config) when is_list(Config) -> + M0 = #{1=>a,2=>b,3.0=>c,4=>d,5=>e}, + + M1 = M0#{1:=42,2:=100,4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + M1 = M0#{1:=wrong,1=>42,2=>wrong,2:=100,4:=[a,b,c]}, + + M2 = M0#{3.0:=new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,3.0:=new}, + true = M2 =/= M0#{3=>right,3.0:=new}, + #{ 3 := right, 3.0 := new } = M0#{3=>right,3.0:=new}, + + M3 = #{ 1 => val}, + #{1 := update2,1.0 := new_val4} = M3#{ + 1.0 => new_val1, 1 := update, 1=> update3, + 1 := update2, 1.0 := new_val2, 1.0 => new_val3, + 1.0 => new_val4 }, + + %% Errors cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch T#{nonexisting=>val}) + end), + Empty = #{}, + {'EXIT',{{badkey,nonexisting},_}} = (catch Empty#{nonexisting:=val}), + {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{{badkey,1.0},_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{{badkey,42},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,42.0},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + + ok. + +t_update_exact_large(Config) when is_list(Config) -> + M0 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + + M1 = M0#{10:=42,<<"55">>:=100,10.0:=[a,b,c]}, + #{ 10:=42,<<"55">>:=100,{["05"]}:="15",10.0:=[a,b,c], + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1" } = M1, + + M1 = M0#{10:=wrong,10=>42,<<"55">>=>wrong,<<"55">>:=100,10.0:=[a,b,c]}, + + M2 = M0#{13.0:=new}, + #{10:=a0,20:=b0,13.0:=new} = M2, + M2 = M0#{13.0=>wrong,13.0:=new}, + + %% Errors cases. + {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{{badkey,1.0},_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{{badkey,42},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,42.0},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + + ok. + +t_update_deep(Config) when is_list(Config) -> + N = 250000, + M0 = maps:from_list([{integer_to_list(I),a}||I<-lists:seq(1,N)]), + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + + M1 = M0#{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + + M2 = M0#{ "1" => c, "10" => c, "100" => c, "1000" => c, "10000" => c }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M2, + + M3 = M2#{ "n1" => d, "n10" => d, "n100" => d, "n1000" => d, "n10000" => d }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M2, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M3, + #{ "n1" := d, "n10" := d, "n100" := d, "n1000" := d, "n10000" := d } = M3, + ok. + +t_guard_bifs(Config) when is_list(Config) -> + true = map_guard_head(#{a=>1}), + false = map_guard_head([]), + true = map_guard_body(#{a=>1}), + false = map_guard_body({}), + true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }), + false = map_guard_pattern("list"), + ok. + +map_guard_head(M) when is_map(M) -> true; +map_guard_head(_) -> false. + +map_guard_body(M) -> is_map(M). + +map_guard_pattern(#{}) -> true; +map_guard_pattern(_) -> false. + +t_guard_sequence(Config) when is_list(Config) -> + {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>"a"}), + {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>"b"}), + {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>"c"}), + {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>"d"}), + {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>"e"}), + + {1,M1} = map_guard_sequence_2(M1 = #{a=>3}), + {2,M2} = map_guard_sequence_2(M2 = #{a=>4, b=>4}), + {3,gg,M3} = map_guard_sequence_2(M3 = #{a=>gg, b=>4}), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = #{a=>sc, b=>3, c=>sc2}), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = #{a=>kk, b=>other, c=>sc2}), + + %% error case + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>"e"})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), + ok. + +t_guard_sequence_large(Config) when is_list(Config) -> + M0 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00",03]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01",03]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02",03]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03",03]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04",03]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05",03]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06",03]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07",03]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08",03]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09",03]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + {1, "a"} = map_guard_sequence_1(M0#{seq=>1,val=>"a"}), + {2, "b"} = map_guard_sequence_1(M0#{seq=>2,val=>"b"}), + {3, "c"} = map_guard_sequence_1(M0#{seq=>3,val=>"c"}), + {4, "d"} = map_guard_sequence_1(M0#{seq=>4,val=>"d"}), + {5, "e"} = map_guard_sequence_1(M0#{seq=>5,val=>"e"}), + + {1,M1} = map_guard_sequence_2(M1 = M0#{a=>3}), + {2,M2} = map_guard_sequence_2(M2 = M0#{a=>4, b=>4}), + {3,gg,M3} = map_guard_sequence_2(M3 = M0#{a=>gg, b=>4}), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = M0#{a=>sc, b=>3, c=>sc2}), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = M0#{a=>kk, b=>other, c=>sc2}), + + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(M0#{seq=>6,val=>"e"})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(M0#{b=>5})), + ok. + + +map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=4=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=5=Seq, val:=Val}) -> {Seq,Val}. + +map_guard_sequence_2(#{ a:=3 }=M) -> {1, M}; +map_guard_sequence_2(#{ a:=4 }=M) -> {2, M}; +map_guard_sequence_2(#{ a:=X, a:=X, b:=4 }=M) -> {3,X,M}; +map_guard_sequence_2(#{ a:=X, a:=Y, b:=3 }=M) when X =:= Y -> {4,X,Y,M}; +map_guard_sequence_2(#{ a:=X, a:=Y }=M) when X =:= Y -> {5,X,Y,M}. + + +t_guard_update(Config) when is_list(Config) -> + error = map_guard_update(#{},#{}), + first = map_guard_update(#{}, #{x=>first}), + second = map_guard_update(#{y=>old}, #{x=>second,y=>old}), + ok. + +t_guard_update_large(Config) when is_list(Config) -> + M0 = #{ 70=>a0,80=>b0,90=>"c0","40"=>"d0",<<"50">>=>"e0",{["00",03]}=>"10", + 71=>a1,81=>b1,91=>"c1","41"=>"d1",<<"51">>=>"e1",{["01",03]}=>"11", + 72=>a2,82=>b2,92=>"c2","42"=>"d2",<<"52">>=>"e2",{["02",03]}=>"12", + 73=>a3,83=>b3,93=>"c3","43"=>"d3",<<"53">>=>"e3",{["03",03]}=>"13", + 74=>a4,84=>b4,94=>"c4","44"=>"d4",<<"54">>=>"e4",{["04",03]}=>"14", + + 75=>a5,85=>b5,95=>"c5","45"=>"d5",<<"55">>=>"e5",{["05",03]}=>"15", + 76=>a6,86=>b6,96=>"c6","46"=>"d6",<<"56">>=>"e6",{["06",03]}=>"16", + 77=>a7,87=>b7,97=>"c7","47"=>"d7",<<"57">>=>"e7",{["07",03]}=>"17", + 78=>a8,88=>b8,98=>"c8","48"=>"d8",<<"58">>=>"e8",{["08",03]}=>"18", + 79=>a9,89=>b9,99=>"c9","49"=>"d9",<<"59">>=>"e9",{["09",03]}=>"19", + + 70.0=>fa0,80.0=>fb0,90.0=>"fc0", + 71.0=>fa1,81.0=>fb1,91.0=>"fc1", + 72.0=>fa2,82.0=>fb2,92.0=>"fc2", + 73.0=>fa3,83.0=>fb3,93.0=>"fc3", + 74.0=>fa4,84.0=>fb4,94.0=>"fc4", + + 75.0=>fa5,85.0=>fb5,95.0=>"fc5", + 76.0=>fa6,86.0=>fb6,96.0=>"fc6", + 77.0=>fa7,87.0=>fb7,97.0=>"fc7", + 78.0=>fa8,88.0=>fb8,98.0=>"fc8", + 79.0=>fa9,89.0=>fb9,99.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + + error = map_guard_update(M0#{},M0#{}), + first = map_guard_update(M0#{},M0#{x=>first}), + second = map_guard_update(M0#{y=>old}, M0#{x=>second,y=>old}), + ok. + + +map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first; +map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second; +map_guard_update(_, _) -> error. + +t_guard_receive(Config) when is_list(Config) -> + M0 = #{ id => 0 }, + Pid = spawn_link(fun() -> guard_receive_loop() end), + Big = 36893488147419103229, + B1 = <<"some text">>, + B2 = <<"was appended">>, + B3 = <<B1/binary, B2/binary>>, + + #{id:=1, res:=Big} = M1 = call(Pid, M0#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=2, res:=26} = M2 = call(Pid, M1#{op=>idiv,in=>{53,2}}), + #{id:=3, res:=832} = M3 = call(Pid, M2#{op=>imul,in=>{26,32}}), + #{id:=4, res:=4} = M4 = call(Pid, M3#{op=>add,in=>{1,3}}), + #{id:=5, res:=Big} = M5 = call(Pid, M4#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=6, res:=B3} = M6 = call(Pid, M5#{op=>"append",in=>{B1,B2}}), + #{id:=7, res:=4} = _ = call(Pid, M6#{op=>add,in=>{1,3}}), + + + %% update old maps and check id update + #{id:=2, res:=B3} = call(Pid, M1#{op=>"append",in=>{B1,B2}}), + #{id:=5, res:=99} = call(Pid, M4#{op=>add,in=>{33, 66}}), + + %% cleanup + done = call(Pid, done), + ok. + +-define(t_guard_receive_large_procs, 1500). + +t_guard_receive_large(Config) when is_list(Config) -> + M = lists:foldl(fun(_,#{procs := Ps } = M) -> + M#{ procs := Ps#{ spawn_link(fun() -> grecv_loop() end) => 0 }} + end, #{procs => #{}, done => 0}, lists:seq(1,?t_guard_receive_large_procs)), + lists:foreach(fun(Pid) -> + Pid ! {self(), hello} + end, maps:keys(maps:get(procs,M))), + ok = guard_receive_large_loop(M), + ok. + +guard_receive_large_loop(#{done := ?t_guard_receive_large_procs}) -> + ok; +guard_receive_large_loop(M) -> + receive + #{pid := Pid, msg := hello} -> + case M of + #{done := Count, procs := #{Pid := 150}} -> + Pid ! {self(), done}, + guard_receive_large_loop(M#{done := Count + 1}); + #{procs := #{Pid := Count} = Ps} -> + Pid ! {self(), hello}, + guard_receive_large_loop(M#{procs := Ps#{Pid := Count + 1}}) + end + end. + +grecv_loop() -> + receive + {_, done} -> + ok; + {Pid, hello} -> + Pid ! #{pid=>self(), msg=>hello}, + grecv_loop() + end. + +call(Pid, M) -> + Pid ! {self(), M}, receive {Pid, Res} -> Res end. + +guard_receive_loop() -> + receive + {Pid, #{ id:=Id, op:="append", in:={X,Y}}=M} when is_binary(X), is_binary(Y) -> + Pid ! {self(), M#{ id=>Id+1, res=><<X/binary,Y/binary>>}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=add, in:={X,Y}}} -> + Pid ! {self(), #{ id=>Id+1, res=>X+Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=sub, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X-Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=idiv, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X div Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=imul, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X * Y}}, + guard_receive_loop(); + {Pid, done} -> + Pid ! {self(), done}; + {Pid, Other} -> + Pid ! {error, Other}, + guard_receive_loop() + end. + + +t_list_comprehension(Config) when is_list(Config) -> + [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + + Ks = lists:seq($a,$z), + Ms = [#{[K1,K2]=>{K1,K2}} || K1 <- Ks, K2 <- Ks], + [#{"aa" := {$a,$a}},#{"ab":={$a,$b}}|_] = Ms, + [#{"zz" := {$z,$z}},#{"zy":={$z,$y}}|_] = lists:reverse(Ms), + ok. + +t_guard_fun(Config) when is_list(Config) -> + F1 = fun + (#{s:=v,v:=V}) -> {v,V}; + (#{s:=t,v:={V,V}}) -> {t,V}; + (#{s:=l,v:=[V,V]}) -> {l,V} + end, + + F2 = fun + (#{s:=T,v:={V,V}}) -> {T,V}; + (#{s:=T,v:=[V,V]}) -> {T,V}; + (#{s:=T,v:=V}) -> {T,V} + end, + V = <<"hi">>, + + {v,V} = F1(#{s=>v,v=>V}), + {t,V} = F1(#{s=>t,v=>{V,V}}), + {l,V} = F1(#{s=>l,v=>[V,V]}), + + {v,V} = F2(#{s=>v,v=>V}), + {t,V} = F2(#{s=>t,v=>{V,V}}), + {l,V} = F2(#{s=>l,v=>[V,V]}), + + %% error case + {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} = (catch F1(#{s=>none,v=>none})), + ok. + + +t_map_sort_literals(Config) when is_list(Config) -> + % test relation + + %% size order + true = #{ a => 1, b => 2} < #{ a => 1, b => 1, c => 1}, + true = #{ b => 1, a => 1} < #{ c => 1, a => 1, b => 1}, + false = #{ c => 1, b => 1, a => 1} < #{ c => 1, a => 1}, + + %% key order + true = #{ a => 1 } < #{ b => 1}, + false = #{ b => 1 } < #{ a => 1}, + true = #{ a => 1, b => 1, c => 1 } < #{ b => 1, c => 1, d => 1}, + true = #{ b => 1, c => 1, d => 1 } > #{ a => 1, b => 1, c => 1}, + true = #{ c => 1, b => 1, a => 1 } < #{ b => 1, c => 1, d => 1}, + true = #{ "a" => 1 } < #{ <<"a">> => 1}, + false = #{ <<"a">> => 1 } < #{ "a" => 1}, + true = #{ 1 => 1 } < #{ 1.0 => 1}, + false = #{ 1.0 => 1 } < #{ 1 => 1}, + + %% value order + true = #{ a => 1 } < #{ a => 2}, + false = #{ a => 2 } < #{ a => 1}, + false = #{ a => 2, b => 1 } < #{ a => 1, b => 3}, + true = #{ a => 1, b => 1 } < #{ a => 1, b => 3}, + false = #{ a => 1 } < #{ a => 1.0}, + false = #{ a => 1.0 } < #{ a => 1}, + + true = #{ "a" => "hi", b => 134 } == #{ b => 134,"a" => "hi"}, + + %% large maps + + M = maps:from_list([{I,I}||I <- lists:seq(1,500)]), + + %% size order + true = M#{ a => 1, b => 2} < M#{ a => 1, b => 1, c => 1}, + true = M#{ b => 1, a => 1} < M#{ c => 1, a => 1, b => 1}, + false = M#{ c => 1, b => 1, a => 1} < M#{ c => 1, a => 1}, + + %% key order + true = M#{ a => 1 } < M#{ b => 1}, + false = M#{ b => 1 } < M#{ a => 1}, + true = M#{ a => 1, b => 1, c => 1 } < M#{ b => 1, c => 1, d => 1}, + true = M#{ b => 1, c => 1, d => 1 } > M#{ a => 1, b => 1, c => 1}, + true = M#{ c => 1, b => 1, a => 1 } < M#{ b => 1, c => 1, d => 1}, + true = M#{ "a" => 1 } < M#{ <<"a">> => 1}, + false = M#{ <<"a">> => 1 } < #{ "a" => 1}, + true = M#{ 1 => 1 } < maps:remove(1,M#{ 1.0 => 1}), + false = M#{ 1.0 => 1 } < M#{ 1 => 1}, + + %% value order + true = M#{ a => 1 } < M#{ a => 2}, + false = M#{ a => 2 } < M#{ a => 1}, + false = M#{ a => 2, b => 1 } < M#{ a => 1, b => 3}, + true = M#{ a => 1, b => 1 } < M#{ a => 1, b => 3}, + false = M#{ a => 1 } < M#{ a => 1.0}, + false = M#{ a => 1.0 } < M#{ a => 1}, + + true = M#{ "a" => "hi", b => 134 } == M#{ b => 134,"a" => "hi"}, + + %% lists:sort + + SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}], + [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)), + ok. + +t_map_equal(Config) when is_list(Config) -> + true = #{} =:= #{}, + false = #{} =:= #{a=>1}, + false = #{a=>1} =:= #{}, + true = #{ "a" => "hi", b => 134 } =:= #{ b => 134,"a" => "hi"}, + + false = #{ a => 1 } =:= #{ a => 2}, + false = #{ a => 2 } =:= #{ a => 1}, + false = #{ a => 2, b => 1 } =:= #{ a => 1, b => 3}, + false = #{ a => 1, b => 1 } =:= #{ a => 1, b => 3}, + + true = #{ a => 1 } =:= #{ a => 1}, + true = #{ "a" => 2 } =:= #{ "a" => 2}, + true = #{ "a" => 2, b => 3 } =:= #{ "a" => 2, b => 3}, + true = #{ a => 1, b => 3, c => <<"wat">> } =:= #{ a => 1, b => 3, c=><<"wat">>}, + ok. + + +t_map_compare(Config) when is_list(Config) -> + Seed = {erlang:monotonic_time(), + erlang:time_offset(), + erlang:unique_integer()}, + io:format("seed = ~p\n", [Seed]), + random:seed(Seed), + repeat(100, fun(_) -> float_int_compare() end, []), + repeat(100, fun(_) -> recursive_compare() end, []), + ok. + +float_int_compare() -> + Terms = numeric_keys(3), + %%io:format("Keys to use: ~p\n", [Terms]), + Pairs = lists:map(fun(K) -> list_to_tuple([{K,V} || V <- Terms]) end, Terms), + lists:foreach(fun(Size) -> + MapGen = fun() -> map_gen(list_to_tuple(Pairs), Size) end, + repeat(100, fun do_compare/1, [MapGen, MapGen]) + end, + lists:seq(1,length(Terms))), + ok. + +numeric_keys(N) -> + lists:foldl(fun(_,Acc) -> + Int = random:uniform(N*4) - N*2, + Float = float(Int), + [Int, Float, Float * 0.99, Float * 1.01 | Acc] + end, + [], + lists:seq(1,N)). + + +repeat(0, _, _) -> + ok; +repeat(N, Fun, Arg) -> + Fun(Arg), + repeat(N-1, Fun, Arg). + +copy_term(T) -> + Papa = self(), + P = spawn_link(fun() -> receive Msg -> Papa ! Msg end end), + P ! T, + receive R -> R end. + +do_compare([Gen1, Gen2]) -> + M1 = Gen1(), + M2 = Gen2(), + %%io:format("Maps to compare: ~p AND ~p\n", [M1, M2]), + C = (M1 < M2), + Erlang = maps_lessthan(M1, M2), + C = Erlang, + ?CHECK(M1==M1, M1), + + %% Change one key from int to float (or vice versa) and check compare + ML1 = maps:to_list(M1), + {K1,V1} = lists:nth(random:uniform(length(ML1)), ML1), + case K1 of + I when is_integer(I) -> + case maps:find(float(I),M1) of + error -> + M1f = maps:remove(I, maps:put(float(I), V1, M1)), + ?CHECK(M1f > M1, [M1f, M1]); + _ -> ok + end; + + F when is_float(F), round(F) == F -> + case maps:find(round(F),M1) of + error -> + M1i = maps:remove(F, maps:put(round(F), V1, M1)), + ?CHECK(M1i < M1, [M1i, M1]); + _ -> ok + end; + + _ -> ok % skip floats with decimals + end, + + ?CHECK(M2 == M2, [M2]). + + +maps_lessthan(M1, M2) -> + case {maps:size(M1),maps:size(M2)} of + {_S,_S} -> + {K1,V1} = lists:unzip(term_sort(maps:to_list(M1))), + {K2,V2} = lists:unzip(term_sort(maps:to_list(M2))), + + case erts_internal:cmp_term(K1,K2) of + -1 -> true; + 0 -> (V1 < V2); + 1 -> false + end; + + {S1, S2} -> + S1 < S2 + end. + +term_sort(L) -> + lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) =< 0 end, + L). + + +cmp(T1, T2, Exact) when is_tuple(T1) and is_tuple(T2) -> + case {size(T1),size(T2)} of + {_S,_S} -> cmp(tuple_to_list(T1), tuple_to_list(T2), Exact); + {S1,S2} when S1 < S2 -> -1; + {S1,S2} when S1 > S2 -> 1 + end; + +cmp([H1|T1], [H2|T2], Exact) -> + case cmp(H1,H2, Exact) of + 0 -> cmp(T1,T2, Exact); + C -> C + end; + +cmp(M1, M2, Exact) when is_map(M1) andalso is_map(M2) -> + cmp_maps(M1,M2,Exact); +cmp(M1, M2, Exact) -> + cmp_others(M1, M2, Exact). + +cmp_maps(M1, M2, Exact) -> + case {maps:size(M1),maps:size(M2)} of + {_S,_S} -> + {K1,V1} = lists:unzip(term_sort(maps:to_list(M1))), + {K2,V2} = lists:unzip(term_sort(maps:to_list(M2))), + + case cmp(K1, K2, true) of + 0 -> cmp(V1, V2, Exact); + C -> C + end; + + {S1,S2} when S1 < S2 -> -1; + {S1,S2} when S1 > S2 -> 1 + end. + +cmp_others(I, F, true) when is_integer(I), is_float(F) -> + -1; +cmp_others(F, I, true) when is_float(F), is_integer(I) -> + 1; +cmp_others(T1, T2, _) -> + case {T1<T2, T1==T2} of + {true,false} -> -1; + {false,true} -> 0; + {false,false} -> 1 + end. + +map_gen(Pairs, Size) -> + {_,L} = lists:foldl(fun(_, {Keys, Acc}) -> + KI = random:uniform(size(Keys)), + K = element(KI,Keys), + KV = element(random:uniform(size(K)), K), + {erlang:delete_element(KI,Keys), [KV | Acc]} + end, + {Pairs, []}, + lists:seq(1,Size)), + + maps:from_list(L). + + +recursive_compare() -> + Leafs = {atom, 17, 16.9, 17.1, [], self(), spawn(fun() -> ok end), make_ref(), make_ref()}, + {A, B} = term_gen_recursive(Leafs, 0, 0), + %%io:format("Recursive term A = ~p\n", [A]), + %%io:format("Recursive term B = ~p\n", [B]), + + ?CHECK({true,false} =:= case do_cmp(A, B, false) of + -1 -> {A<B, A>=B}; + 0 -> {A==B, A/=B}; + 1 -> {A>B, A=<B} + end, + {A,B}), + A2 = copy_term(A), + ?CHECK(A == A2, {A,A2}), + ?CHECK(0 =:= cmp(A, A2, false), {A,A2}), + + B2 = copy_term(B), + ?CHECK(B == B2, {B,B2}), + ?CHECK(0 =:= cmp(B, B2, false), {B,B2}), + ok. + +do_cmp(A, B, Exact) -> + C = cmp(A, B, Exact), + C. + +%% Generate two terms {A,B} that may only differ +%% at float vs integer types. +term_gen_recursive(Leafs, Flags, Depth) -> + MaxDepth = 10, + Rnd = case {Flags, Depth} of + {_, MaxDepth} -> % Only leafs + random:uniform(size(Leafs)) + 3; + {0, 0} -> % Only containers + random:uniform(3); + {0,_} -> % Anything + random:uniform(size(Leafs)+3) + end, + case Rnd of + 1 -> % Make map + Size = random:uniform(size(Leafs)), + lists:foldl(fun(_, {Acc1,Acc2}) -> + {K1,K2} = term_gen_recursive(Leafs, Flags, + Depth+1), + {V1,V2} = term_gen_recursive(Leafs, Flags, Depth+1), + {maps:put(K1,V1, Acc1), maps:put(K2,V2, Acc2)} + end, + {maps:new(), maps:new()}, + lists:seq(1,Size)); + 2 -> % Make cons + {Car1,Car2} = term_gen_recursive(Leafs, Flags, Depth+1), + {Cdr1,Cdr2} = term_gen_recursive(Leafs, Flags, Depth+1), + {[Car1 | Cdr1], [Car2 | Cdr2]}; + 3 -> % Make tuple + Size = random:uniform(size(Leafs)), + L = lists:map(fun(_) -> term_gen_recursive(Leafs, Flags, Depth+1) end, + lists:seq(1,Size)), + {L1, L2} = lists:unzip(L), + {list_to_tuple(L1), list_to_tuple(L2)}; + + N -> % Make leaf + case element(N-3, Leafs) of + I when is_integer(I) -> + case random:uniform(4) of + 1 -> {I, float(I)}; + 2 -> {float(I), I}; + _ -> {I,I} + end; + T -> {T,T} + end + end. + +%% BIFs +t_bif_map_get(Config) when is_list(Config) -> + %% small map + 1 = maps:get(a, #{ a=> 1}), + 2 = maps:get(b, #{ a=> 1, b => 2}), + "hi" = maps:get("hello", #{ a=>1, "hello" => "hi"}), + "tuple hi" = maps:get({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), + + M0 = #{ k1=>"v1", <<"k2">> => <<"v3">> }, + "v4" = maps:get(<<"k2">>, M0#{<<"k2">> => "v4"}), + + %% large map + M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++ + [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"}, + {k1,"v1"},{<<"k2">>,"v3"}]), + 1 = maps:get(a, M1), + 2 = maps:get(b, M1), + "hi" = maps:get("hello", M1), + "tuple hi" = maps:get({1,1.0}, M1), + "v3" = maps:get(<<"k2">>, M1), + + %% error cases + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,get,_,_}|_]}} = + (catch maps:get(a, T)) + end), + + {'EXIT',{{badkey,{1,1}},[{maps,get,_,_}|_]}} = + (catch maps:get({1,1}, #{{1,1.0} => "tuple"})), + {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} = (catch maps:get(a, #{})), + {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} = + (catch maps:get(a, #{b=>1, c=>2})), + ok. + +t_bif_map_find(Config) when is_list(Config) -> + %% small map + {ok, 1} = maps:find(a, #{ a=> 1}), + {ok, 2} = maps:find(b, #{ a=> 1, b => 2}), + {ok, "int"} = maps:find(1, #{ 1 => "int"}), + {ok, "float"} = maps:find(1.0, #{ 1.0=> "float"}), + + {ok, "hi"} = maps:find("hello", #{ a=>1, "hello" => "hi"}), + {ok, "tuple hi"} = maps:find({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), + + M0 = #{ k1=>"v1", <<"k2">> => <<"v3">> }, + {ok, "v4"} = maps:find(<<"k2">>, M0#{ <<"k2">> => "v4" }), + + %% large map + M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++ + [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"}, + {k1,"v1"},{<<"k2">>,"v3"}]), + {ok, 1} = maps:find(a, M1), + {ok, 2} = maps:find(b, M1), + {ok, "hi"} = maps:find("hello", M1), + {ok, "tuple hi"} = maps:find({1,1.0}, M1), + {ok, "v3"} = maps:find(<<"k2">>, M1), + + %% error case + error = maps:find(a,#{}), + error = maps:find(a,#{b=>1, c=>2}), + error = maps:find(1.0, #{ 1 => "int"}), + error = maps:find(1, #{ 1.0 => "float"}), + error = maps:find({1.0,1}, #{ a=>a, {1,1.0} => "tuple hi"}), % reverse types in tuple key + + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,find,_,_}|_]}} = + (catch maps:find(a, T)) + end), + ok. + + +t_bif_map_is_key(Config) when is_list(Config) -> + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + + true = maps:is_key("hi", M1), + true = maps:is_key(int, M1), + true = maps:is_key(<<"key">>, M1), + true = maps:is_key(4, M1), + + false = maps:is_key(5, M1), + false = maps:is_key(<<"key2">>, M1), + false = maps:is_key("h", M1), + false = maps:is_key("hello", M1), + false = maps:is_key(atom, M1), + false = maps:is_key(any, #{}), + + false = maps:is_key("hi", maps:remove("hi", M1)), + true = maps:is_key("hi", M1), + true = maps:is_key(1, maps:put(1, "number", M1)), + false = maps:is_key(1.0, maps:put(1, "number", M1)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,is_key,_,_}|_]}} = + (catch maps:is_key(a, T)) + end), + ok. + +t_bif_map_keys(Config) when is_list(Config) -> + [] = maps:keys(#{}), + + [1,2,3,4,5] = lists:sort(maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})), + [1,2,3,4,5] = lists:sort(maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})), + + % values in key order: [4,int,"hi",<<"key">>] + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + [4,int,"hi",<<"key">>] = lists:sort(maps:keys(M1)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,keys,_,_}|_]}} = + (catch maps:keys(T)) + end), + ok. + +t_bif_map_new(Config) when is_list(Config) -> + #{} = maps:new(), + 0 = erlang:map_size(maps:new()), + ok. + +t_bif_map_merge(Config) when is_list(Config) -> + 0 = erlang:map_size(maps:merge(#{},#{})), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:merge(#{}, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:merge(M0, #{}), + + M1 = #{ "hi" => "hello again", float => 3.3, {1,2} => "tuple", 4 => integer }, + + #{4 := number, 18446744073709551629 := wat, float := 3.3, int := 3, + {1,2} := "tuple", "hi" := "hello", <<"key">> := <<"value">>} = maps:merge(M1,M0), + + #{4 := integer, 18446744073709551629 := wat, float := 3.3, int := 3, + {1,2} := "tuple", "hi" := "hello again", <<"key">> := <<"value">>} = maps:merge(M0,M1), + + %% try deep collisions + N = 150000, + Is = lists:seq(1,N), + M2 = maps:from_list([{I,I}||I<-Is]), + 150000 = maps:size(M2), + M3 = maps:from_list([{<<I:32>>,I}||I<-Is]), + 150000 = maps:size(M3), + M4 = maps:merge(M2,M3), + 300000 = maps:size(M4), + M5 = maps:from_list([{integer_to_list(I),I}||I<-Is]), + 150000 = maps:size(M5), + M6 = maps:merge(M4,M5), + 450000 = maps:size(M6), + M7 = maps:from_list([{float(I),I}||I<-Is]), + 150000 = maps:size(M7), + M8 = maps:merge(M7,M6), + 600000 = maps:size(M8), + + #{ 1 := 1, "1" := 1, <<1:32>> := 1 } = M8, + #{ 10 := 10, "10" := 10, <<10:32>> := 10 } = M8, + #{ 100 := 100, "100" := 100, <<100:32>> := 100 } = M8, + #{ 1000 := 1000, "1000" := 1000, <<1000:32>> := 1000 } = M8, + #{ 10000 := 10000, "10000" := 10000, <<10000:32>> := 10000 } = M8, + #{ 100000 := 100000, "100000" := 100000, <<100000:32>> := 100000 } = M8, + + %% overlapping + M8 = maps:merge(M2,M8), + M8 = maps:merge(M3,M8), + M8 = maps:merge(M4,M8), + M8 = maps:merge(M5,M8), + M8 = maps:merge(M6,M8), + M8 = maps:merge(M7,M8), + M8 = maps:merge(M8,M8), + + %% maps:merge/2 and mixed + + Ks1 = [764492191,2361333849], %% deep collision + Ks2 = lists:seq(1,33), + M9 = maps:from_list([{K,K}||K <- Ks1]), + M10 = maps:from_list([{K,K}||K <- Ks2]), + M11 = maps:merge(M9,M10), + ok = check_keys_exist(Ks1 ++ Ks2, M11), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(#{}, T)), + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(T, #{})), + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(T, T)) + end), + ok. + + +t_bif_map_put(Config) when is_list(Config) -> + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + M1 = #{ "hi" := "hello"} = maps:put("hi", "hello", #{}), + + true = is_members(["hi"],maps:keys(M1)), + true = is_members(["hello"],maps:values(M1)), + + M2 = #{ int := 3 } = maps:put(int, 3, M1), + + true = is_members([int,"hi"],maps:keys(M2)), + true = is_members([3,"hello"],maps:values(M2)), + + M3 = #{ <<"key">> := <<"value">> } = maps:put(<<"key">>, <<"value">>, M2), + + true = is_members([int,"hi",<<"key">>],maps:keys(M3)), + true = is_members([3,"hello",<<"value">>],maps:values(M3)), + + M4 = #{ 18446744073709551629 := wat } = maps:put(18446744073709551629, wat, M3), + + true = is_members([18446744073709551629,int,"hi",<<"key">>],maps:keys(M4)), + true = is_members([wat,3,"hello",<<"value">>],maps:values(M4)), + + M0 = #{ 4 := number } = M5 = maps:put(4, number, M4), + + true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M5)), + true = is_members([number,wat,3,"hello",<<"value">>],maps:values(M5)), + + M6 = #{ <<"key">> := <<"other value">> } = maps:put(<<"key">>, <<"other value">>, M5), + + true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M6)), + true = is_members([number,wat,3,"hello",<<"other value">>],maps:values(M6)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,put,_,_}|_]}} = + (catch maps:put(1, a, T)) + end), + ok. + +is_members(Ks,Ls) when length(Ks) =/= length(Ls) -> false; +is_members(Ks,Ls) -> is_members_do(Ks,Ls). + +is_members_do([],[]) -> true; +is_members_do([],_) -> false; +is_members_do([K|Ks],Ls) -> + is_members_do(Ks, lists:delete(K,Ls)). + +t_bif_map_remove(Config) when is_list(Config) -> + 0 = erlang:map_size(maps:remove(some_key, #{})), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + M1 = maps:remove("hi", M0), + true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)), + true = is_members([number,wat,3,<<"value">>],maps:values(M1)), + + M2 = maps:remove(int, M1), + true = is_members([4,18446744073709551629,<<"key">>],maps:keys(M2)), + true = is_members([number,wat,<<"value">>],maps:values(M2)), + + M3 = maps:remove(<<"key">>, M2), + true = is_members([4,18446744073709551629],maps:keys(M3)), + true = is_members([number,wat],maps:values(M3)), + + M4 = maps:remove(18446744073709551629, M3), + true = is_members([4],maps:keys(M4)), + true = is_members([number],maps:values(M4)), + + M5 = maps:remove(4, M4), + [] = maps:keys(M5), + [] = maps:values(M5), + + M0 = maps:remove(5,M0), + M0 = maps:remove("hi there",M0), + + #{ "hi" := "hello", int := 3, 4 := number} = maps:remove(18446744073709551629,maps:remove(<<"key">>,M0)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,remove,_,_}|_]}} = + (catch maps:remove(a, T)) + end), + ok. + +t_bif_map_update(Config) when is_list(Config) -> + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + #{ "hi" := "hello again", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:update("hi", "hello again", M0), + + #{ "hi" := "hello", int := 1337, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:update(int, 1337, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"new value">>, + 4 := number, 18446744073709551629 := wat} = maps:update(<<"key">>, <<"new value">>, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := integer, 18446744073709551629 := wat} = maps:update(4, integer, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wazzup} = maps:update(18446744073709551629, wazzup, M0), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,update,_,_}|_]}} = + (catch maps:update(1, none, T)) + end), + ok. + + + +t_bif_map_values(Config) when is_list(Config) -> + + [] = maps:values(#{}), + [1] = maps:values(#{a=>1}), + + true = is_members([a,b,c,d,e],maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})), + true = is_members([a,b,c,d,e],maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})), + + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + M2 = M1#{ "hi" => "hello2", <<"key">> => <<"value2">> }, + true = is_members([number,3,"hello2",<<"value2">>],maps:values(M2)), + true = is_members([number,3,"hello",<<"value">>],maps:values(M1)), + + Vs = lists:seq(1000,20000), + M3 = maps:from_list([{K,K}||K<-Vs]), + M4 = maps:merge(M1,M3), + M5 = maps:merge(M2,M3), + true = is_members(Vs,maps:values(M3)), + true = is_members([number,3,"hello",<<"value">>]++Vs,maps:values(M4)), + true = is_members([number,3,"hello2",<<"value2">>]++Vs,maps:values(M5)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,values,_,_}|_]}} = + (catch maps:values(T)) + end), + ok. + +t_erlang_hash(Config) when is_list(Config) -> + + ok = t_bif_erlang_phash2(), + ok = t_bif_erlang_phash(), + ok = t_bif_erlang_hash(), + + ok. + +t_bif_erlang_phash2() -> + + 39679005 = erlang:phash2(#{}), + 33667975 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), % 78942764 + 95332690 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), % 37338230 + 108954384 = erlang:phash2(#{ 1 => a }), % 14363616 + 59617982 = erlang:phash2(#{ a => 1 }), % 51612236 + + 42770201 = erlang:phash2(#{{} => <<>>}), % 37468437 + 71687700 = erlang:phash2(#{<<>> => {}}), % 44049159 + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 70249457 = erlang:phash2(M0), % 118679416 + 59617982 = erlang:phash2(M1), % 51612236 + 70249457 = erlang:phash2(M2), % 118679416 + ok. + +t_bif_erlang_phash() -> + Sz = 1 bsl 32, + 1113425985 = erlang:phash(#{},Sz), % 268440612 + 1510068139 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 1196461908 + 3182345590 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 3944426064 + 2927531828 = erlang:phash(#{ 1 => a },Sz), % 1394238263 + 1670235874 = erlang:phash(#{ a => 1 },Sz), % 4066388227 + + 3935089469 = erlang:phash(#{{} => <<>>},Sz), % 1578050717 + 71692856 = erlang:phash(#{<<>> => {}},Sz), % 1578050717 + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 2620391445 = erlang:phash(M0,Sz), % 3590546636 + 1670235874 = erlang:phash(M1,Sz), % 4066388227 + 2620391445 = erlang:phash(M2,Sz), % 3590546636 + ok. + +t_bif_erlang_hash() -> + Sz = 1 bsl 27 - 1, + 39684169 = erlang:hash(#{},Sz), % 5158 + 33673142 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 71555838 + 95337869 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 5497225 + 108959561 = erlang:hash(#{ 1 => a },Sz), % 126071654 + 59623150 = erlang:hash(#{ a => 1 },Sz), % 126426236 + + 42775386 = erlang:hash(#{{} => <<>>},Sz), % 101655720 + 71692856 = erlang:hash(#{<<>> => {}},Sz), % 101655720 + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 70254632 = erlang:hash(M0,Sz), % 38260486 + 59623150 = erlang:hash(M1,Sz), % 126426236 + 70254632 = erlang:hash(M2,Sz), % 38260486 + ok. + + +t_map_encode_decode(Config) when is_list(Config) -> + <<131,116,0,0,0,0>> = erlang:term_to_binary(#{}), + Pairs = [ + {a,b},{"key","values"},{<<"key">>,<<"value">>}, + {1,b},{[atom,1],{<<"wat">>,1,2,3}}, + {aa,"values"}, + {1 bsl 64 + (1 bsl 50 - 1), sc1}, + {99, sc2}, + {1 bsl 65 + (1 bsl 51 - 1), sc3}, + {88, sc4}, + {1 bsl 66 + (1 bsl 52 - 1), sc5}, + {77, sc6}, + {1 bsl 67 + (1 bsl 53 - 1), sc3}, + {75, sc6}, {-10,sc8}, + {<<>>, sc9}, {3.14158, sc10}, + {[3.14158], sc11}, {more_atoms, sc12}, + {{more_tuples}, sc13}, {self(), sc14}, + {{},{}},{[],[]} + ], + ok = map_encode_decode_and_match(Pairs,[],#{}), + + %% check sorting + + %% literally #{ b=>2, a=>1 } in the internal order + #{ a:=1, b:=2 } = + erlang:binary_to_term(<<131,116,0,0,0,2,100,0,1,98,97,2,100,0,1,97,97,1>>), + + + %% literally #{ "hi" => "value", a=>33, b=>55 } in the internal order + #{ a:=33, b:=55, "hi" := "value"} = erlang:binary_to_term(<<131,116,0,0,0,3, + 107,0,2,104,105, % "hi" :: list() + 107,0,5,118,97,108,117,101, % "value" :: list() + 100,0,1,97, % a :: atom() + 97,33, % 33 :: integer() + 100,0,1,98, % b :: atom() + 97,55 % 55 :: integer() + >>), + + %% Maps of different sizes + lists:foldl(fun(Key, M0) -> + M1 = M0#{Key => Key}, + case Key rem 17 of + 0 -> + M1 = binary_to_term(term_to_binary(M1)); + _ -> + ok + end, + M1 + end, + #{}, + lists:seq(1,10000)), + + %% many maps in same binary + MapList = lists:foldl(fun(K, [M|_]=Acc) -> [M#{K => K} | Acc] end, + [#{}], + lists:seq(1,100)), + MapList = binary_to_term(term_to_binary(MapList)), + MapListR = lists:reverse(MapList), + MapListR = binary_to_term(term_to_binary(MapListR)), + + %% error cases + %% template: <<131,116,0,0,0,2,100,0,1,97,100,0,1,98,97,1,97,1>> + %% which is: #{ a=>1, b=>1 } + + %% uniqueness violation + %% literally #{ a=>1, "hi"=>"value", a=>2 } + {'EXIT',{badarg,[{_,_,_,_}|_]}} = (catch + erlang:binary_to_term(<<131,116,0,0,0,3, + 100,0,1,97, + 97,1, + 107,0,2,104,105, + 107,0,5,118,97,108,117,101, + 100,0,1,97, + 97,2>>)), + + %% bad size (too large) + {'EXIT',{badarg,[{_,_,_,_}|_]}} = (catch + erlang:binary_to_term(<<131,116,0,0,0,12,100,0,1,97,97,1,100,0,1,98,97,1>>)), + + %% bad size (too small) .. should fail just truncate it .. weird. + %% possibly change external format so truncated will be #{a:=1} + #{ a:=b } = + erlang:binary_to_term(<<131,116,0,0,0,1,100,0,1,97,100,0,1,98,97,1,97,1>>), + + ok. + +map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) -> + M1 = maps:put(K,V,M0), + B0 = erlang:term_to_binary(M1), + Ls = [{erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs], + ok = match_encoded_map(B0, length(Ls), Ls), + %% decode and match it + M1 = erlang:binary_to_term(B0), + map_encode_decode_and_match(Pairs,Ls,M1); +map_encode_decode_and_match([],_,_) -> ok. + +match_encoded_map(<<131,116,Size:32,Encoded/binary>>,Size,Items) -> + match_encoded_map_stripped_size(Encoded,Items,Items); +match_encoded_map(_,_,_) -> no_match_size. + +match_encoded_map_stripped_size(<<>>,_,_) -> ok; +match_encoded_map_stripped_size(B0,[{<<131,K/binary>>,<<131,V/binary>>}|Items],Ls) -> + Ksz = byte_size(K), + Vsz = byte_size(V), + case B0 of + <<K:Ksz/binary,V:Vsz/binary,B1/binary>> -> + match_encoded_map_stripped_size(B1,Ls,Ls); + _ -> + match_encoded_map_stripped_size(B0,Items,Ls) + end; +match_encoded_map_stripped_size(_,[],_) -> fail. + + +t_bif_map_to_list(Config) when is_list(Config) -> + [] = maps:to_list(#{}), + [{a,1},{b,2}] = lists:sort(maps:to_list(#{a=>1,b=>2})), + [{a,1},{b,2},{c,3}] = lists:sort(maps:to_list(#{c=>3,a=>1,b=>2})), + [{a,1},{b,2},{g,3}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2})), + [{a,1},{b,2},{g,3},{"c",4}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4})), + [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = + lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5})), + + [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] = + lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5, + <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10})), + + %% error cases + do_badmap(fun(T) -> + {'EXIT', {{badmap,T},_}} = + (catch maps:to_list(T)) + end), + ok. + + +t_bif_map_from_list(Config) when is_list(Config) -> + #{} = maps:from_list([]), + A = maps:from_list([]), + 0 = erlang:map_size(A), + + #{a:=1,b:=2} = maps:from_list([{a,1},{b,2}]), + #{c:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{c,3}]), + #{g:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{g,3}]), + + #{a:=2} = maps:from_list([{a,1},{a,3},{a,2}]), + + #{ <<"hi">>:=v1,3:=v3,"hi":=v6,hi:=v4,{hi,3}:=v5} = + maps:from_list([{3,v3},{"hi",v6},{hi,v4},{{hi,3},v5},{<<"hi">>,v1}]), + + #{<<"hi">>:=v6,3:=v8,"hi":=v11,hi:=v9,{hi,3}:=v10} = + maps:from_list([ {{hi,3},v3}, {"hi",v0},{3,v1}, {<<"hi">>,v4}, {hi,v2}, + {<<"hi">>,v6}, {{hi,3},v10},{"hi",v11}, {hi,v9}, {3,v8}]), + + %% repeated keys (large -> small) + Ps1 = [{a,I}|| I <- lists:seq(1,32)], + Ps2 = [{a,I}|| I <- lists:seq(33,64)], + + M = maps:from_list(Ps1 ++ [{b,1},{c,1}] ++ Ps2), + #{ a := 64, b := 1, c := 1 } = M, + + %% error cases + {'EXIT', {badarg,_}} = (catch maps:from_list([{a,b},b])), + {'EXIT', {badarg,_}} = (catch maps:from_list([{a,b},{b,b,3}])), + {'EXIT', {badarg,_}} = (catch maps:from_list([{a,b},<<>>])), + {'EXIT', {badarg,_}} = (catch maps:from_list([{a,b}|{b,a}])), + {'EXIT', {badarg,_}} = (catch maps:from_list(a)), + {'EXIT', {badarg,_}} = (catch maps:from_list(42)), + ok. + +t_bif_build_and_check(Config) when is_list(Config) -> + ok = check_build_and_remove(750,[ + fun(K) -> [K,K] end, + fun(K) -> [float(K),K] end, + fun(K) -> K end, + fun(K) -> {1,K} end, + fun(K) -> {K} end, + fun(K) -> [K|K] end, + fun(K) -> [K,1,2,3,4] end, + fun(K) -> {K,atom} end, + fun(K) -> float(K) end, + fun(K) -> integer_to_list(K) end, + fun(K) -> list_to_atom(integer_to_list(K)) end, + fun(K) -> [K,{K,[K,{K,[K]}]}] end, + fun(K) -> <<K:32>> end + ]), + + ok. + +check_build_and_remove(_,[]) -> ok; +check_build_and_remove(N,[F|Fs]) -> + {M,Ks} = build_and_check(N, maps:new(), F, []), + ok = remove_and_check(Ks,M), + check_build_and_remove(N,Fs). + +build_and_check(0, M0, _, Ks) -> {M0, Ks}; +build_and_check(N, M0, F, Ks) -> + K = build_key(F,N), + M1 = maps:put(K,K,M0), + ok = check_keys_exist([I||{I,_} <- [{K,M1}|Ks]], M1), + M2 = maps:update(K,v,M1), + v = maps:get(K,M2), + build_and_check(N-1,M1,F,[{K,M1}|Ks]). + +remove_and_check([],_) -> ok; +remove_and_check([{K,Mc}|Ks], M0) -> + K = maps:get(K,M0), + true = maps:is_key(K,M0), + true = Mc =:= M0, + true = M0 == Mc, + M1 = maps:remove(K,M0), + false = M1 =:= Mc, + false = Mc == M1, + false = maps:is_key(K,M1), + true = maps:is_key(K,M0), + ok = check_keys_exist([I||{I,_} <- Ks],M1), + error = maps:find(K,M1), + remove_and_check(Ks, M1). + +build_key(F,N) when N rem 3 =:= 0 -> F(N); +build_key(F,N) when N rem 3 =:= 1 -> K = F(N), {K,K}; +build_key(F,N) when N rem 3 =:= 2 -> K = F(N), [K,K]. + +check_keys_exist([], _) -> ok; +check_keys_exist([K|Ks],M) -> + true = maps:is_key(K,M), + check_keys_exist(Ks,M). + +t_bif_merge_and_check(Config) when is_list(Config) -> + + io:format("rand:export_seed() -> ~p\n",[rand:export_seed()]), + + %% simple disjunct ones + %% make sure all keys are unique + Kss = [[a,b,c,d], + [1,2,3,4], + [], + ["hi"], + [e], + [build_key(fun(K) -> {small,K} end, I) || I <- lists:seq(1,32)], + lists:seq(5, 28), + lists:seq(29, 59), + [build_key(fun(K) -> integer_to_list(K) end, I) || I <- lists:seq(2000,10000)], + [build_key(fun(K) -> <<K:32>> end, I) || I <- lists:seq(1,80)], + [build_key(fun(K) -> {<<K:32>>} end, I) || I <- lists:seq(100,1000)]], + + + KsMs = build_keys_map_pairs(Kss), + Cs = [{CKs1,CM1,CKs2,CM2} || {CKs1,CM1} <- KsMs, {CKs2,CM2} <- KsMs], + ok = merge_and_check_combo(Cs), + + %% overlapping ones + + KVs1 = [{a,1},{b,2},{c,3}], + KVs2 = [{b,3},{c,4},{d,5}], + KVs = [{I,I} || I <- lists:seq(1,32)], + KVs3 = KVs1 ++ KVs, + KVs4 = KVs2 ++ KVs, + + M1 = maps:from_list(KVs1), + M2 = maps:from_list(KVs2), + M3 = maps:from_list(KVs3), + M4 = maps:from_list(KVs4), + + M12 = maps:merge(M1,M2), + ok = check_key_values(KVs2 ++ [{a,1}], M12), + M21 = maps:merge(M2,M1), + ok = check_key_values(KVs1 ++ [{d,5}], M21), + + M34 = maps:merge(M3,M4), + ok = check_key_values(KVs4 ++ [{a,1}], M34), + M43 = maps:merge(M4,M3), + ok = check_key_values(KVs3 ++ [{d,5}], M43), + + M14 = maps:merge(M1,M4), + ok = check_key_values(KVs4 ++ [{a,1}], M14), + M41 = maps:merge(M4,M1), + ok = check_key_values(KVs1 ++ [{d,5}] ++ KVs, M41), + + [begin Ma = random_map(SzA, a), + Mb = random_map(SzB, b), + ok = merge_maps(Ma, Mb) + end || SzA <- [3,10,20,100,200,1000], SzB <- [3,10,20,100,200,1000]], + + ok. + +% Generate random map with an average of Sz number of pairs: K -> {V,K} +random_map(Sz, V) -> + random_map_insert(#{}, 0, V, Sz*2). + +random_map_insert(M0, K0, _, Sz) when K0 > Sz -> + M0; +random_map_insert(M0, K0, V, Sz) -> + Key = K0 + rand:uniform(3), + random_map_insert(M0#{Key => {V,Key}}, Key, V, Sz). + + +merge_maps(A, B) -> + AB = maps:merge(A, B), + %%io:format("A=~p\nB=~p\n",[A,B]), + maps_foreach(fun(K,VB) -> VB = maps:get(K, AB) + end, B), + maps_foreach(fun(K,VA) -> + case {maps:get(K, AB),maps:find(K, B)} of + {VA, error} -> ok; + {VB, {ok, VB}} -> ok + end + end, A), + + maps_foreach(fun(K,V) -> + case {maps:find(K, A),maps:find(K, B)} of + {{ok, V}, error} -> ok; + {error, {ok, V}} -> ok; + {{ok,_}, {ok, V}} -> ok + end + end, AB), + ok. + +maps_foreach(Fun, Map) -> + maps:fold(fun(K,V,_) -> Fun(K,V) end, void, Map). + + +check_key_values([],_) -> ok; +check_key_values([{K,V}|KVs],M) -> + V = maps:get(K,M), + check_key_values(KVs,M). + +merge_and_check_combo([]) -> ok; +merge_and_check_combo([{Ks1,M1,Ks2,M2}|Cs]) -> + M12 = maps:merge(M1,M2), + ok = check_keys_exist(Ks1 ++ Ks2, M12), + M21 = maps:merge(M2,M1), + ok = check_keys_exist(Ks1 ++ Ks2, M21), + + true = M12 =:= M21, + M12 = M21, + + merge_and_check_combo(Cs). + +build_keys_map_pairs([]) -> []; +build_keys_map_pairs([Ks|Kss]) -> + M = maps:from_list(keys_to_pairs(Ks)), + ok = check_keys_exist(Ks, M), + [{Ks,M}|build_keys_map_pairs(Kss)]. + +keys_to_pairs(Ks) -> [{K,K} || K <- Ks]. + + +%% Maps module, not BIFs +t_maps_fold(_Config) -> + Vs = lists:seq(1,100), + M = maps:from_list([{{k,I},{v,I}}||I<-Vs]), + + %% fold + 5050 = maps:fold(fun({k,_},{v,V},A) -> V + A end, 0, M), + + ok. + +t_maps_map(_Config) -> + Vs = lists:seq(1,100), + M1 = maps:from_list([{I,I}||I<-Vs]), + M2 = maps:from_list([{I,{token,I}}||I<-Vs]), + + M2 = maps:map(fun(_K,V) -> {token,V} end, M1), + ok. + +t_maps_size(_Config) -> + Vs = lists:seq(1,100), + lists:foldl(fun(I,M) -> + M1 = maps:put(I,I,M), + I = maps:size(M1), + M1 + end, #{}, Vs), + ok. + + +t_maps_without(_Config) -> + Ki = [11,22,33,44,55,66,77,88,99], + M0 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100)]), + M1 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100) -- Ki]), + M1 = maps:without([{k,I}||I <- Ki],M0), + ok. + +t_erts_internal_order(_Config) when is_list(_Config) -> + M = #{0 => 0,2147483648 => 0}, + true = M =:= binary_to_term(term_to_binary(M)), + + F1 = fun(_, _) -> 0 end, + F2 = fun(_, _) -> 1 end, + M0 = maps:from_list( [{-2147483649, 0}, {0,0}, {97, 0}, {false, 0}, {flower, 0}, {F1, 0}, {F2, 0}, {<<>>, 0}]), + M1 = maps:merge(M0, #{0 => 1}), + 8 = maps:size(M1), + 1 = maps:get(0,M1), + ok. + +t_erts_internal_hash(_Config) when is_list(_Config) -> + K1 = 0.0, + K2 = 0.0/-1, + M = maps:from_list([{I,I}||I<-lists:seq(1,32)]), + + M1 = M#{ K1 => a, K2 => b }, + b = maps:get(K2,M1), + + M2 = M#{ K2 => a, K1 => b }, + b = maps:get(K1,M2), + + %% test previously faulty hash list optimization + + M3 = M#{[0] => a, [0,0] => b, [0,0,0] => c, [0,0,0,0] => d}, + a = maps:get([0],M3), + b = maps:get([0,0],M3), + c = maps:get([0,0,0],M3), + d = maps:get([0,0,0,0],M3), + + M4 = M#{{[0]} => a, {[0,0]} => b, {[0,0,0]} => c, {[0,0,0,0]} => d}, + a = maps:get({[0]},M4), + b = maps:get({[0,0]},M4), + c = maps:get({[0,0,0]},M4), + d = maps:get({[0,0,0,0]},M4), + + M5 = M3#{[0,0,0] => e, [0,0,0,0] => f, [0,0,0,0,0] => g, + [0,0,0,0,0,0] => h, [0,0,0,0,0,0,0] => i, + [0,0,0,0,0,0,0,0] => j, [0,0,0,0,0,0,0,0,0] => k}, + + a = maps:get([0],M5), + b = maps:get([0,0],M5), + e = maps:get([0,0,0],M5), + f = maps:get([0,0,0,0],M5), + g = maps:get([0,0,0,0,0],M5), + h = maps:get([0,0,0,0,0,0],M5), + i = maps:get([0,0,0,0,0,0,0],M5), + j = maps:get([0,0,0,0,0,0,0,0],M5), + k = maps:get([0,0,0,0,0,0,0,0,0],M5), + + M6 = M4#{{[0,0,0]} => e, {[0,0,0,0]} => f, {[0,0,0,0,0]} => g, + {[0,0,0,0,0,0]} => h, {[0,0,0,0,0,0,0]} => i, + {[0,0,0,0,0,0,0,0]} => j, {[0,0,0,0,0,0,0,0,0]} => k}, + + a = maps:get({[0]},M6), + b = maps:get({[0,0]},M6), + e = maps:get({[0,0,0]},M6), + f = maps:get({[0,0,0,0]},M6), + g = maps:get({[0,0,0,0,0]},M6), + h = maps:get({[0,0,0,0,0,0]},M6), + i = maps:get({[0,0,0,0,0,0,0]},M6), + j = maps:get({[0,0,0,0,0,0,0,0]},M6), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M6), + + M7 = maps:merge(M5,M6), + + a = maps:get([0],M7), + b = maps:get([0,0],M7), + e = maps:get([0,0,0],M7), + f = maps:get([0,0,0,0],M7), + g = maps:get([0,0,0,0,0],M7), + h = maps:get([0,0,0,0,0,0],M7), + i = maps:get([0,0,0,0,0,0,0],M7), + j = maps:get([0,0,0,0,0,0,0,0],M7), + k = maps:get([0,0,0,0,0,0,0,0,0],M7), + a = maps:get({[0]},M7), + b = maps:get({[0,0]},M7), + e = maps:get({[0,0,0]},M7), + f = maps:get({[0,0,0,0]},M7), + g = maps:get({[0,0,0,0,0]},M7), + h = maps:get({[0,0,0,0,0,0]},M7), + i = maps:get({[0,0,0,0,0,0,0]},M7), + j = maps:get({[0,0,0,0,0,0,0,0]},M7), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M7), + ok. + +t_pdict(_Config) -> + + put(#{ a => b, b => a},#{ c => d}), + put(get(#{ a => b, b => a}),1), + 1 = get(#{ c => d}), + #{ c := d } = get(#{ a => b, b => a}). + +t_ets(_Config) -> + + Tid = ets:new(map_table,[]), + + [ets:insert(Tid,{maps:from_list([{I,-I}]),I}) || I <- lists:seq(1,100)], + + + [{#{ 2 := -2},2}] = ets:lookup(Tid,#{ 2 => -2 }), + + %% Test equal + [3,4] = lists:sort( + ets:select(Tid,[{{'$1','$2'}, + [{'or',{'==','$1',#{ 3 => -3 }}, + {'==','$1',#{ 4 => -4 }}}], + ['$2']}])), + %% Test match + [30,50] = lists:sort( + ets:select(Tid, + [{{#{ 30 => -30}, '$1'},[],['$1']}, + {{#{ 50 => -50}, '$1'},[],['$1']}] + )), + + ets:insert(Tid,{#{ a => b, b => c, c => a},transitivity}), + + %% Test equal with map of different size + [] = ets:select(Tid,[{{'$1','_'},[{'==','$1',#{ b => c }}],['$_']}]), + + %% Test match with map of different size + %[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => c },'_'},[],['$_']}]), + + %%% Test match with don't care value + %[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => '_' },'_'},[],['$_']}]), + + %% Test is_map bif + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + ets:insert(Tid,{not_a_map,2}), + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + ets:insert(Tid,{{nope,a,tuple},2}), + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + + %% Test map_size bif + [3] = ets:select(Tid,[{{'$1','_'},[{'==',{map_size,'$1'},3}], + [{map_size,'$1'}]}]), + + true = ets:delete(Tid,#{50 => -50}), + [] = ets:lookup(Tid,#{50 => -50}), + + ets:delete(Tid), + ok. + +t_dets(_Config) -> + ok. + +t_tracing(_Config) -> + + dbg:stop_clear(), + {ok,Tracer} = dbg:tracer(process,{fun trace_collector/2, self()}), + dbg:p(self(),c), + + %% Test basic map call + {ok,_} = dbg:tpl(?MODULE,id,x), + #{ a => b }, + {trace,_,call,{?MODULE,id,[#{ a := b }]}} = getmsg(Tracer), + {trace,_,return_from,{?MODULE,id,1},#{ a := b }} = getmsg(Tracer), + dbg:ctpl(), + + %% Test equals in argument list + {ok,_} = dbg:tpl(?MODULE,id,[{['$1'],[{'==','$1',#{ b => c}}], + [{return_trace}]}]), + #{ a => b }, + #{ b => c }, + {trace,_,call,{?MODULE,id,[#{ b := c }]}} = getmsg(Tracer), + {trace,_,return_from,{?MODULE,id,1},#{ b := c }} = getmsg(Tracer), + dbg:ctpl(), + + %% Test match in head + {ok,_} = dbg:tpl(?MODULE,id,[{[#{b => c}],[],[]}]), + #{ a => b }, + #{ b => c }, + {trace,_,call,{?MODULE,id,[#{ b := c }]}} = getmsg(Tracer), + dbg:ctpl(), + + % Test map guard bifs + {ok,_} = dbg:tpl(?MODULE,id,[{['$1'],[{is_map,{element,1,'$1'}}],[]}]), + #{ a => b }, + {1,2}, + {#{ a => b},2}, + {trace,_,call,{?MODULE,id,[{#{ a := b },2}]}} = getmsg(Tracer), + dbg:ctpl(), + + {ok,_} = dbg:tpl(?MODULE,id,[{['$1'],[{'==',{map_size,{element,1,'$1'}},2}],[]}]), + #{ a => b }, + {1,2}, + {#{ a => b},2}, + {#{ a => b, b => c},atom}, + {trace,_,call,{?MODULE,id,[{#{ a := b, b := c },atom}]}} = getmsg(Tracer), + dbg:ctpl(), + + %MS = dbg:fun2ms(fun([A]) when A == #{ a => b} -> ok end), + %dbg:tpl(?MODULE,id,MS), + %#{ a => b }, + %#{ b => c }, + %{trace,_,call,{?MODULE,id,[#{ a := b }]}} = getmsg(Tracer), + %dbg:ctpl(), + + %% Check to extra messages + timeout = getmsg(Tracer), + + dbg:stop_clear(), + ok. + +getmsg(_Tracer) -> + receive V -> V after 100 -> timeout end. + +trace_collector(Msg,Parent) -> + io:format("~p~n",[Msg]), + Parent ! Msg, + Parent. + +t_has_map_fields(Config) when is_list(Config) -> + true = has_map_fields_1(#{one=>1}), + true = has_map_fields_1(#{one=>1,two=>2}), + false = has_map_fields_1(#{two=>2}), + false = has_map_fields_1(#{}), + + true = has_map_fields_2(#{c=>1,b=>2,a=>3}), + true = has_map_fields_2(#{c=>1,b=>2,a=>3,x=>42}), + false = has_map_fields_2(#{b=>2,c=>1}), + false = has_map_fields_2(#{x=>y}), + false = has_map_fields_2(#{}), + + true = has_map_fields_3(#{c=>1,b=>2,a=>3}), + true = has_map_fields_3(#{c=>1,b=>2,a=>3,[]=>42}), + true = has_map_fields_3(#{b=>2,a=>3,[]=>42,42.0=>43}), + true = has_map_fields_3(#{a=>3,[]=>42,42.0=>43}), + true = has_map_fields_3(#{[]=>42,42.0=>43}), + false = has_map_fields_3(#{b=>2,c=>1}), + false = has_map_fields_3(#{[]=>y}), + false = has_map_fields_3(#{42.0=>x,a=>99}), + false = has_map_fields_3(#{}), + + ok. + +has_map_fields_1(#{one:=_}) -> true; +has_map_fields_1(#{}) -> false. + +has_map_fields_2(#{a:=_,b:=_,c:=_}) -> true; +has_map_fields_2(#{}) -> false. + +has_map_fields_3(#{a:=_,b:=_}) -> true; +has_map_fields_3(#{[]:=_,42.0:=_}) -> true; +has_map_fields_3(#{}) -> false. + +y_regs(Config) when is_list(Config) -> + Val = [length(Config)], + Map0 = y_regs_update(#{}, Val), + Map2 = y_regs_update(Map0, Val), + + Map3 = maps:from_list([{I,I*I} || I <- lists:seq(1, 100)]), + Map4 = y_regs_update(Map3, Val), + + true = is_map(Map2) andalso is_map(Map4), + + ok. + +y_regs_update(Map0, Val0) -> + Val1 = {t,Val0}, + K1 = {key,1}, + K2 = {key,2}, + Map1 = Map0#{K1=>K1, + a=>Val0,b=>Val0,c=>Val0,d=>Val0,e=>Val0, + f=>Val0,g=>Val0,h=>Val0,i=>Val0,j=>Val0, + k=>Val0,l=>Val0,m=>Val0,n=>Val0,o=>Val0, + p=>Val0,q=>Val0,r=>Val0,s=>Val0,t=>Val0, + u=>Val0,v=>Val0,w=>Val0,x=>Val0,y=>Val0, + z=>Val0, + aa=>Val0,ab=>Val0,ac=>Val0,ad=>Val0,ae=>Val0, + af=>Val0,ag=>Val0,ah=>Val0,ai=>Val0,aj=>Val0, + ak=>Val0,al=>Val0,am=>Val0,an=>Val0,ao=>Val0, + ap=>Val0,aq=>Val0,ar=>Val0,as=>Val0,at=>Val0, + au=>Val0,av=>Val0,aw=>Val0,ax=>Val0,ay=>Val0, + az=>Val0, + K2=>[a,b,c]}, + Map2 = Map1#{K1=>K1, + a:=Val1,b:=Val1,c:=Val1,d:=Val1,e:=Val1, + f:=Val1,g:=Val1,h:=Val1,i:=Val1,j:=Val1, + k:=Val1,l:=Val1,m:=Val1,n:=Val1,o:=Val1, + p:=Val1,q:=Val1,r:=Val1,s:=Val1,t:=Val1, + u:=Val1,v:=Val1,w:=Val1,x:=Val1,y:=Val1, + z:=Val1, + aa:=Val1,ab:=Val1,ac:=Val1,ad:=Val1,ae:=Val1, + af:=Val1,ag:=Val1,ah:=Val1,ai:=Val1,aj:=Val1, + ak:=Val1,al:=Val1,am:=Val1,an:=Val1,ao:=Val1, + ap:=Val1,aq:=Val1,ar:=Val1,as:=Val1,at:=Val1, + au:=Val1,av:=Val1,aw:=Val1,ax:=Val1,ay:=Val1, + az:=Val1, + K2=>[a,b,c]}, + + %% Traverse the maps to validate them. + _ = erlang:phash2({Map1,Map2}, 100000), + + _ = {K1,K2,Val0,Val1}, %Force use of Y registers. + Map2. + +do_badmap(Test) -> + Terms = [Test,fun erlang:abs/1,make_ref(),self(),0.0/-1, + <<0:1024>>,<<1:1>>,<<>>,<<1,2,3>>, + [],{a,b,c},[a,b],atom,10.0,42,(1 bsl 65) + 3], + [Test(T) || T <- Terms]. diff --git a/lib/dialyzer/test/map_SUITE_data/src/map_in_guard.erl b/lib/dialyzer/test/map_SUITE_data/src/map_in_guard.erl new file mode 100644 index 0000000000..6176ef1fdf --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/map_in_guard.erl @@ -0,0 +1,35 @@ +-module(map_in_guard). + +-export([test/0, raw_expr/0]). + +test() -> + false = assoc_guard(#{}), + true = assoc_guard(not_a_map), + #{a := true} = assoc_update(#{}), + {'EXIT', {{badmap, not_a_map}, [{?MODULE, assoc_update, 1, _}|_]}} + = (catch assoc_update(not_a_map)), + ok = assoc_guard_clause(#{}), + {'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}} + = (catch assoc_guard_clause(not_a_map)), + true = exact_guard(#{a=>1}), + {'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}} + %% There's nothing we can do to find the error here, is there? + = (catch (begin true = exact_guard(#{}) end)), + ok = exact_guard_clause(#{a => q}), + {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}} + = (catch exact_guard_clause(#{})), + ok. + +assoc_guard(M) when is_map(M#{a => b}) -> true; +assoc_guard(Q) -> false. + +assoc_update(M) -> M#{a => true}. + +assoc_guard_clause(M) when is_map(M#{a => 3}) -> ok. + +exact_guard(M) when (false =/= M#{a := b}) -> true; +exact_guard(_) -> false. + +exact_guard_clause(M) when (false =/= M#{a := b}) -> ok. + +raw_expr() when #{}; true -> ok. %% Must not warn here! diff --git a/lib/dialyzer/test/map_SUITE_data/src/map_in_guard2.erl b/lib/dialyzer/test/map_SUITE_data/src/map_in_guard2.erl new file mode 100644 index 0000000000..ac2205e8fa --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/map_in_guard2.erl @@ -0,0 +1,27 @@ +-module(map_in_guard2). + +-export([test/0]). + +test() -> + false = assoc_guard(not_a_map), + {'EXIT', {{badmap, not_a_map}, [{?MODULE, assoc_update, 1, _}|_]}} + = (catch assoc_update(not_a_map)), + {'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}} + = (catch assoc_guard_clause(not_a_map)), + {'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}} + = (catch (begin true = exact_guard(#{}) end)), + {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}} + = (catch exact_guard_clause(#{})), + ok. + +assoc_guard(M) when is_map(M#{a => b}) -> true; +assoc_guard(_) -> false. + +assoc_update(M) -> M#{a => true}. + +assoc_guard_clause(M) when is_map(M#{a => 3}) -> ok. + +exact_guard(M) when (false =/= M#{a := b}) -> true; +exact_guard(_) -> false. + +exact_guard_clause(M) when (false =/= M#{a := b}) -> ok. diff --git a/lib/dialyzer/test/map_SUITE_data/src/map_size.erl b/lib/dialyzer/test/map_SUITE_data/src/map_size.erl new file mode 100644 index 0000000000..2da4f6904e --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/map_size.erl @@ -0,0 +1,36 @@ +-module(map_size). + +-export([t1/0, e1/0, t2/0, t3/0, t4/0, t5/1, t6/1, t7/1]). + +t1() -> + 0 = maps:size(#{}), + 1 = maps:size(#{}). + +e1() -> + 0 = map_size(#{}), + 1 = map_size(#{}). + +t2() -> p(#{a=>x}). + +p(M) when map_size(M) =:= 0 -> ok. + +t3() -> + 1 = map_size(cio()), + 2 = map_size(cio()), + 3 = map_size(cio()), + 4 = map_size(cio()). + +t4() -> + 0 = map_size(cio()). + +t5(M) when map_size(M) =:= 0 -> + #{a := _} = M. %% Only t5 has no local return; want better message + +t6(M) when map_size(M) =:= 0 -> + #{} = M. + +t7(M=#{a := _}) when map_size(M) =:= 1 -> + #{b := _} = M. %% We should warn here too + +-spec cio() -> #{3 := ok, 9 => _, 11 => x}. +cio() -> binary_to_term(<<131,116,0,0,0,2,97,3,100,0,2,111,107,97,9,97,6>>). diff --git a/lib/dialyzer/test/map_SUITE_data/src/maps_merge.erl b/lib/dialyzer/test/map_SUITE_data/src/maps_merge.erl new file mode 100644 index 0000000000..d4f3c6887a --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/maps_merge.erl @@ -0,0 +1,29 @@ +-module(maps_merge). + +-export([t1/0, t2/0, t3/0, t4/0, t5/0]). + +t1() -> + #{a:=1} = maps:merge(#{}, #{}). + +t2() -> + #{hej := _} = maps:merge(cao(), cio()), + #{{} := _} = maps:merge(cao(), cio()). + +t3() -> + #{a:=1} = maps:merge(cao(), cio()), + #{7:=q} = maps:merge(cao(), cio()). + +t4() -> + #{a:=1} = maps:merge(cio(), cao()), + #{7:=q} = maps:merge(cio(), cao()). + +t5() -> + #{a:=2} = maps:merge(cao(), #{}). + +-spec cao() -> #{a := 1, q => none(), 11 => _, atom() => _}. +cao() -> + binary_to_term(<<131,116,0,0,0,3,100,0,1,97,97,1,100,0,1,98,97,9,100,0,1, + 102,104,0>>). + +-spec cio() -> #{3 := ok, 7 => none(), z => _, integer() => _}. +cio() -> binary_to_term(<<131,116,0,0,0,2,97,3,100,0,2,111,107,97,9,97,6>>). diff --git a/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_adt.erl b/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_adt.erl new file mode 100644 index 0000000000..b98c713c6b --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_adt.erl @@ -0,0 +1,69 @@ +-module(opaque_key_adt). + +-compile(export_all). + +-export_type([t/0, t/1, m/0, s/1, sm/1]). + +-opaque t() :: #{atom() => integer()}. +-opaque t(A) :: #{A => integer()}. + +-opaque m() :: #{t() => integer()}. +-type mt() :: #{t() => integer()}. + +-opaque s(K) :: #{K => integer(), integer() => atom()}. +-opaque sm(K) :: #{K := integer(), integer() := atom()}. +-type smt(K) :: #{K := integer(), integer() := atom()}. + +-spec t0() -> t(). +t0() -> #{}. + +-spec t1() -> t(integer()). +t1() -> #{3 => 1}. + +-spec m0() -> m(). +m0() -> #{#{} => 3}. + +-spec mt0() -> mt(). +mt0() -> #{#{} => 3}. + +-spec s0() -> s(atom()). +s0() -> #{}. + +-spec s1() -> s(atom()). +s1() -> #{3 => a}. + +-spec s2() -> s(atom() | 3). +s2() -> #{3 => a}. %% Contract breakage (not found) + +-spec s3() -> s(atom() | 3). +s3() -> #{3 => 5, a => 6, 7 => 8}. + +-spec s4() -> s(integer()). +s4() -> #{1 => a}. %% Contract breakage + +-spec s5() -> s(1). +s5() -> #{2 => 3}. %% Contract breakage + +-spec s6() -> s(1). +s6() -> #{1 => 3}. + +-spec s7() -> s(integer()). +s7() -> #{1 => 3}. + +-spec sm1() -> sm(1). +sm1() -> #{1 => 2, 3 => a}. + +-spec smt1() -> smt(1). +smt1() -> #{3 => a}. %% Contract breakage + +-spec smt2() -> smt(1). +smt2() -> #{1 => a}. %% Contract breakage + +-spec smt3() -> smt(q). +smt3() -> #{q => 1}. %% Slight contract breakage (probably requires better map type) + +-spec smt4() -> smt(q). +smt4() -> #{q => 2, 3 => a}. + +-spec smt5() -> smt(1). +smt5() -> #{1 => 2, 3 => a}. diff --git a/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_use.erl b/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_use.erl new file mode 100644 index 0000000000..917413fdd2 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_use.erl @@ -0,0 +1,97 @@ +-module(opaque_key_use). + +-compile(export_all). + +-export_type([t/0, t/1]). + +-opaque t() :: #{atom() => integer()}. +-opaque t(A) :: #{A => integer()}. + +tt1() -> + A = t0(), + B = t1(), + A =:= B. % never 'true' + +-spec t0() -> t(). +t0() -> #{a => 1}. + +-spec t1() -> t(integer()). +t1() -> #{3 => 1}. + +adt_tt1() -> + A = adt_t0(), + B = adt_t1(), + A =:= B. % opaque attempt + +adt_tt2() -> + A = adt_t0(), + B = adt_t1(), + #{A => 1 % opaque key + ,B => 2 % opaque key + }. + +adt_tt3() -> + A = map_adt:t0(), + #{A => 1}. % opaque key + +adt_mm1() -> + A = adt_t0(), + M = adt_m0(), + #{A := R} = M, % opaque attempt + R. + +%% adt_ms1() -> +%% A = adt_t0(), +%% M = adt_m0(), +%% M#{A}. % opaque arg + +adt_mu1() -> + A = adt_t0(), + M = adt_m0(), + M#{A := 4}. % opaque arg + +adt_mu2() -> + A = adt_t0(), + M = adt_m0(), + M#{A => 4}. % opaque arg + +adt_mu3() -> + M = adt_m0(), + M#{}. % opaque arg + +adt_mtm1() -> + A = adt_t0(), + M = adt_mt0(), + #{A := R} = M, % opaque key + R. + +%% adt_mts1() -> +%% A = adt_t0(), +%% M = adt_mt0(), +%% M#{A}. % opaque key + +adt_mtu1() -> + A = adt_t0(), + M = adt_mt0(), + M#{A := 4}. % opaque key + +adt_mtu2() -> + A = adt_t0(), + M = adt_mt0(), + M#{A => 4}. % opaque key + +adt_mtu3() -> + M = adt_mt0(), + M#{}. % Ok to not warn + +adt_t0() -> + opaque_key_adt:t0(). + +adt_t1() -> + opaque_key_adt:t1(). + +adt_m0() -> + opaque_key_adt:m0(). + +adt_mt0() -> + opaque_key_adt:mt0(). diff --git a/lib/dialyzer/test/map_SUITE_data/src/order.erl b/lib/dialyzer/test/map_SUITE_data/src/order.erl new file mode 100644 index 0000000000..51868d7e94 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/order.erl @@ -0,0 +1,56 @@ +-module(order). + +-export([t1/0, t2/0, t3/0, t4/0, t5/0, t6/0]). + +t1() -> + case maps:get(a, #{a=>1, a=>b}) of + Int when is_integer(Int) -> fail; + Atom when is_atom(Atom) -> error(ok); + _Else -> fail + end. + +t2() -> + case maps:get(a, #{a=>id_1(1), a=>id_b(b)}) of + Int when is_integer(Int) -> fail; + Atom when is_atom(Atom) -> error(ok); + _Else -> fail + end. + +t3() -> + case maps:get(a, #{a=>id_1(1), id_a(a)=>id_b(b)}) of + Int when is_integer(Int) -> fail; + Atom when is_atom(Atom) -> error(ok); + _Else -> fail + end. + +t4() -> + case maps:get(a, #{a=>id_1(1), a_or_b()=>id_b(b)}) of + Int when is_integer(Int) -> ok; + Atom when is_atom(Atom) -> ok; + _Else -> fail + end. + +t5() -> + case maps:get(c, #{c=>id_1(1), a_or_b()=>id_b(b)}) of + Int when is_integer(Int) -> error(ok); + Atom when is_atom(Atom) -> fail; + _Else -> fail + end. + +t6() -> + case maps:get(a, #{a_or_b()=>id_1(1), id_a(a)=>id_b(b)}) of + Int when is_integer(Int) -> fail; + Atom when is_atom(Atom) -> error(ok); + _Else -> fail + end. + +id_1(X) -> X. + +id_a(X) -> X. + +id_b(X) -> X. + +any() -> binary_to_term(<<>>). + +-spec a_or_b() -> a | b. +a_or_b() -> any(). diff --git a/lib/dialyzer/test/map_SUITE_data/src/subtract_value_flip.erl b/lib/dialyzer/test/map_SUITE_data/src/subtract_value_flip.erl new file mode 100644 index 0000000000..97e6b54e3c --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/subtract_value_flip.erl @@ -0,0 +1,9 @@ +-module(subtract_value_flip). + +-export([t1/1]). + +t1(#{type := _Smth} = Map) -> + case Map of + #{type := a} -> ok; + #{type := b} -> error + end. diff --git a/lib/dialyzer/test/map_SUITE_data/src/typeflow.erl b/lib/dialyzer/test/map_SUITE_data/src/typeflow.erl new file mode 100644 index 0000000000..b43fd6897b --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/typeflow.erl @@ -0,0 +1,25 @@ +-module(typeflow). + +-export([t1/1, t2/1, t3/1, t4/1]). + +t1(M = #{}) -> + a_is_integer(M), + case M of + #{a := X} when is_integer(X) -> ok; + _ -> fail + end. + +a_is_integer(#{a := X}) when is_integer(X) -> ok. + +t2(M = #{}) -> + a_is_integer(M), + lists:sort(maps:get(a, M)), + ok. + +t3(M = #{}) -> + lists:sort(maps:get(a, M)), + ok. + +t4(M) -> + lists:sort(maps:get(a, M)), + ok. diff --git a/lib/dialyzer/test/map_SUITE_data/src/typeflow2.erl b/lib/dialyzer/test/map_SUITE_data/src/typeflow2.erl new file mode 100644 index 0000000000..71a9657a60 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/typeflow2.erl @@ -0,0 +1,88 @@ +-module(typeflow2). + +-export([t1/1, t2/1, t3/1, t4/1, t5/1, t6/1, t7/1, optional3/1]). + +t1(L) -> + M = only_integers_and_lists(L), + optional(M), + case M of + #{a := X} when is_integer(X) -> ok; + #{a := X} when is_list(X) -> ok; %% Must warn here + #{a := X} when is_pid(X) -> ok; + _ -> fail + end. + +optional(#{a:=X}) -> + true = is_integer(X); +optional(#{}) -> + true. + +only_integers_and_lists(L) -> only_integers_and_lists(L, #{}). + +only_integers_and_lists([], M) -> M; +only_integers_and_lists([{K,V}|T], M) when is_integer(V); is_list(V)-> + only_integers_and_lists(T, M#{K => V}). + +t2(L) -> + M = only_integers_and_lists(L), + optional(M), + lists:sort(maps:get(a, M)), + ok. + +t3(L) -> + M = only_integers_and_lists(L), + lists:sort(maps:get(a, M)), + ok. + +t4(V) -> + M=map_with(a,V), + optional2(M), + case M of + #{a := X} when is_integer(X) -> ok; + #{a := X} when is_list(X) -> ok; %% Must warn here + _ -> fail + end. + +optional2(#{a:=X}) -> + true = is_integer(X); +optional2(#{}) -> + true. + +map_with(K, V) when is_integer(V); is_list(V); is_atom(V) -> #{K => V}. + +t5(L) -> + M = only_integers_and_lists(L), + optional3(M), + case M of + #{a := X} when is_integer(X) -> ok; + #{a := X} when is_list(X) -> ok; %% Must warn here + #{a := X} when is_pid(X) -> ok; %% Must warn here + #{a := X} when is_atom(X) -> ok; + _ -> fail + end. + +t6(L) -> + M = only_integers_and_lists(L), + case M of + #{a := X} when is_integer(X) -> ok; + #{a := X} when is_list(X) -> ok; %% Must not warn here + _ -> fail + end. + +optional3(#{a:=X}) -> + true = is_integer(X); +optional3(#{}) -> + true. + +t7(M) -> + optional4(M), + case M of + #{a := X} when is_integer(X) -> ok; + #{a := X} when is_list(X) -> ok; + #{a := X} when is_pid(X) -> ok; %% Must warn here + #{a := X} when is_atom(X) -> ok; %% Must warn here + _ -> fail %% Must not warn here (requires parsing) + end. + +-spec optional4(#{a=>integer()|list()}) -> true. +optional4(#{}) -> true. diff --git a/lib/dialyzer/test/map_SUITE_data/src/typesig.erl b/lib/dialyzer/test/map_SUITE_data/src/typesig.erl new file mode 100644 index 0000000000..b50511af41 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/typesig.erl @@ -0,0 +1,9 @@ +-module(typesig). + +-export([t1/0, t2/0, t3/0, test/1]). + +t1() -> test(#{a=>1}). +t2() -> test(#{a=>{b}}). +t3() -> test(#{a=>{3}}). + +test(#{a:={X}}) -> X+1. diff --git a/lib/dialyzer/test/small_SUITE_data/results/literals b/lib/dialyzer/test/small_SUITE_data/results/literals index 222d2c0cdb..1ee39453a4 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/literals +++ b/lib/dialyzer/test/small_SUITE_data/results/literals @@ -5,6 +5,7 @@ literals.erl:14: Function t2/0 has no local return literals.erl:15: Record construction #r{id::'a'} violates the declared type of field id::'integer' literals.erl:17: Function t3/0 has no local return literals.erl:18: Record construction #r{id::'a'} violates the declared type of field id::'integer' +literals.erl:20: Function t4/0 has no local return literals.erl:21: Record construction #r{id::'a'} violates the declared type of field id::'integer' literals.erl:23: Function m1/1 has no local return literals.erl:23: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer'} @@ -12,3 +13,5 @@ literals.erl:26: Function m2/1 has no local return literals.erl:26: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer'} literals.erl:29: Function m3/1 has no local return literals.erl:29: The pattern {{'r', 'a'}} can never match the type any() +literals.erl:32: Function m4/1 has no local return +literals.erl:32: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer'} diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps1 b/lib/dialyzer/test/small_SUITE_data/results/maps1 index e88c91f21f..a178e96b20 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/maps1 +++ b/lib/dialyzer/test/small_SUITE_data/results/maps1 @@ -1,4 +1,4 @@ maps1.erl:43: Function t3/0 has no local return -maps1.erl:44: The call maps1:foo(~{'greger'=>3, ~{'arne'=>'anka'}~=>45}~,1) will never return since it differs in the 2nd argument from the success typing arguments: (#{},'b') -maps1.erl:52: The call Mod:'function'(~{'literal'=>'map'}~,'another_arg') requires that Mod is of type atom() not #{} +maps1.erl:44: The call maps1:foo(#{'greger'=>3, #{'arne'=>'anka'}=>45},1) will never return since it differs in the 1st and 2nd argument from the success typing arguments: (#{'beta':=_, ...},'b') +maps1.erl:52: The variable Mod can never match since previous clauses completely covered the type #{} diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps_difftype b/lib/dialyzer/test/small_SUITE_data/results/maps_difftype index 8980321135..3018b888db 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/maps_difftype +++ b/lib/dialyzer/test/small_SUITE_data/results/maps_difftype @@ -1,3 +1,3 @@ maps_difftype.erl:10: Function empty_mismatch/1 has no local return -maps_difftype.erl:11: The pattern ~{}~ can never match the type tuple() +maps_difftype.erl:11: The pattern #{} can never match the type tuple() diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps_sum b/lib/dialyzer/test/small_SUITE_data/results/maps_sum index a19c0bba96..bd192bdb93 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/maps_sum +++ b/lib/dialyzer/test/small_SUITE_data/results/maps_sum @@ -1,4 +1,4 @@ -maps_sum.erl:15: Invalid type specification for function maps_sum:wrong1/1. The success typing is (#{}) -> any() +maps_sum.erl:15: Invalid type specification for function maps_sum:wrong1/1. The success typing is (map()) -> any() maps_sum.erl:26: Function wrong2/1 has no local return maps_sum.erl:27: The call lists:foldl(fun((_,_,_) -> any()),0,Data::any()) will never return since it differs in the 1st argument from the success typing arguments: (fun((_,_) -> any()),any(),[any()]) diff --git a/lib/dialyzer/test/small_SUITE_data/src/literals.erl b/lib/dialyzer/test/small_SUITE_data/src/literals.erl index abd7033712..354a0f4cdc 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/literals.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/literals.erl @@ -2,7 +2,7 @@ %% Bad records inside structures used to be ignored. The reason: %% v3_core:unfold() does not annotate the parts of a literal. -%% This example does not work perfectly yet, in particular Maps. +%% This example does not work perfectly yet. -export([t1/0, t2/0, t3/0, t4/0, m1/1, m2/1, m3/1, m4/1]). @@ -18,7 +18,7 @@ t3() -> {#r{id = a}}. % violation t4() -> - #{a => #r{id = a}}. % violation found, but t4() returns... (bug) + #{a => #r{id = a}}. % violation m1(#r{id = a}) -> % violation ok. @@ -29,5 +29,5 @@ m2([#r{id = a}]) -> % violation m3({#r{id = a}}) -> % can never match; not so good ok. -m4(#{a := #r{id = a}}) -> % violation not found +m4(#{a := #r{id = a}}) -> % violation ok. diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps1.erl b/lib/dialyzer/test/small_SUITE_data/src/maps1.erl index bb2f66a498..597358d16a 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/maps1.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/maps1.erl @@ -21,7 +21,7 @@ recv(Packet, Fun, Chan) -> #{id := Can_id, data := Can_data} = P = decode(Packet), Fun(P). --spec decode(<<_:64,_:_*8>>) -> #{id => <<_:11>>,timestamp => char()}. +-spec decode(<<_:64,_:_*8>>) -> #{id => <<_:11>>,timestamp => char(),_ => _}. decode(<<_:12, Len:4, Timestamp:16, 0:3, Id:11/bitstring, 0:18, Data:Len/binary, _/binary>>) -> #{id => Id, data => Data, timestamp => Timestamp}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps_redef.erl b/lib/dialyzer/test/small_SUITE_data/src/maps_redef.erl deleted file mode 100644 index 70059f73b6..0000000000 --- a/lib/dialyzer/test/small_SUITE_data/src/maps_redef.erl +++ /dev/null @@ -1,12 +0,0 @@ --module(maps_redef). - --export([t/0]). - -%% OK in Erlang/OTP 17, at least. - --type map() :: atom(). % redefine built-in type - --spec t() -> map(). - -t() -> - a. % OK diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk index 44982ab46d..77ea9d0413 100644 --- a/lib/dialyzer/vsn.mk +++ b/lib/dialyzer/vsn.mk @@ -1 +1 @@ -DIALYZER_VSN = 2.9 +DIALYZER_VSN = 2.10 diff --git a/lib/eldap/vsn.mk b/lib/eldap/vsn.mk index 99c474d588..721387d97d 100644 --- a/lib/eldap/vsn.mk +++ b/lib/eldap/vsn.mk @@ -1 +1 @@ -ELDAP_VSN = 1.2.1 +ELDAP_VSN = 1.2.2 diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl index 4dbe023257..9dbb4835f8 100644 --- a/lib/eunit/src/eunit_lib.erl +++ b/lib/eunit/src/eunit_lib.erl @@ -192,7 +192,6 @@ error_msg(Title, Fmt, Args) -> io_lib:fwrite("*** ~ts ***\n~ts\n\n", [Title, Msg]). -ifdef(TEST). --dialyzer({no_match, format_exception_test_/0}). format_exception_test_() -> [?_assertMatch( "\nymmud:rorre"++_, @@ -274,7 +273,6 @@ dlist_next([], Xs) -> -ifdef(TEST). --dialyzer({no_match, dlist_test_/0}). dlist_test_() -> {"deep list traversal", [{"non-list term -> singleton list", @@ -340,7 +338,6 @@ is_nonempty_string([]) -> false; is_nonempty_string(Cs) -> is_string(Cs). -ifdef(TEST). --dialyzer({no_match, is_string_test_/0}). is_string_test_() -> {"is_string", [{"no non-lists", ?_assert(not is_string($A))}, @@ -402,7 +399,7 @@ uniq([X | Xs]) -> [X | uniq(Xs)]; uniq([]) -> []. -ifdef(TEST). --dialyzer({[no_match, no_fail_call, no_improper_lists], uniq_test_/0}). +-dialyzer({[no_fail_call, no_improper_lists], uniq_test_/0}). uniq_test_() -> {"uniq", [?_assertError(function_clause, uniq(ok)), @@ -581,7 +578,6 @@ trie_match([], _T) -> -ifdef(TEST). --dialyzer({no_match, trie_test_/0}). trie_test_() -> [{"basic representation", [?_assert(trie_new() =:= gb_trees:empty()), diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 7684dc4a81..9453ca6c6f 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -115,7 +115,16 @@ t_tuple_size/2, t_tuple_subtypes/2, t_is_map/2, - t_map/0 + t_map/0, + t_map/3, + t_map_def_key/2, + t_map_def_val/2, + t_map_get/3, + t_map_is_key/3, + t_map_entries/2, + t_map_put/3, + t_map_update/3, + map_pairwise_merge/3 ]). -ifdef(DO_ERL_BIF_TYPES_TEST). @@ -755,7 +764,7 @@ type(erlang, length, 1, Xs, Opaques) -> strict(erlang, length, 1, Xs, fun (_) -> t_non_neg_fixnum() end, Opaques); %% Guard bif, needs to be here. type(erlang, map_size, 1, Xs, Opaques) -> - strict(erlang, map_size, 1, Xs, fun (_) -> t_non_neg_integer() end, Opaques); + type(maps, size, 1, Xs, Opaques); type(erlang, make_fun, 3, Xs, Opaques) -> strict(erlang, make_fun, 3, Xs, fun ([_, _, Arity]) -> @@ -1645,6 +1654,89 @@ type(lists, zipwith3, 4, Xs, Opaques) -> fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F, Opaques)), t_nil()) end, Opaques); +%%-- maps --------------------------------------------------------------------- +type(maps, from_list, 1, Xs, Opaques) -> + strict(maps, from_list, 1, Xs, + fun ([List]) -> + case t_is_nil(List, Opaques) of + true -> t_from_term(#{}); + false -> + T = t_list_elements(List, Opaques), + case t_tuple_subtypes(T, Opaques) of + unknown -> t_map(); + Stypes when length(Stypes) >= 1 -> + t_sup([begin + [K, V] = t_tuple_args(Args, Opaques), + t_map([], K, V) + end || Args <- Stypes]) + end + end + end, Opaques); +type(maps, get, 2, Xs, Opaques) -> + strict(maps, get, 2, Xs, + fun ([Key, Map]) -> + t_map_get(Key, Map, Opaques) + end, Opaques); +type(maps, is_key, 2, Xs, Opaques) -> + strict(maps, is_key, 2, Xs, + fun ([Key, Map]) -> + t_map_is_key(Key, Map, Opaques) + end, Opaques); +type(maps, merge, 2, Xs, Opaques) -> + strict(maps, merge, 2, Xs, + fun ([MapA, MapB]) -> + ADefK = t_map_def_key(MapA, Opaques), + BDefK = t_map_def_key(MapB, Opaques), + ADefV = t_map_def_val(MapA, Opaques), + BDefV = t_map_def_val(MapB, Opaques), + t_map(map_pairwise_merge( + fun(K, _, _, mandatory, V) -> {K, mandatory, V}; + (K, MNess, VA, optional, VB) -> {K, MNess, t_sup(VA,VB)} + end, MapA, MapB), + t_sup(ADefK, BDefK), t_sup(ADefV, BDefV)) + end, Opaques); +type(maps, put, 3, Xs, Opaques) -> + strict(maps, put, 3, Xs, + fun ([Key, Value, Map]) -> + t_map_put({Key, Value}, Map, Opaques) + end, Opaques); +type(maps, size, 1, Xs, Opaques) -> + strict(maps, size, 1, Xs, + fun ([Map]) -> + Mand = [E || E={_,mandatory,_} <- t_map_entries(Map, Opaques)], + LowerBound = length(Mand), + case t_is_none(t_map_def_key(Map, Opaques)) of + false -> t_from_range(LowerBound, pos_inf); + true -> + Opt = [E || E={_,optional,_} <- t_map_entries(Map, Opaques)], + UpperBound = LowerBound + length(Opt), + t_from_range(LowerBound, UpperBound) + end + end, Opaques); +type(maps, to_list, 1, Xs, Opaques) -> + strict(maps, to_list, 1, Xs, + fun ([Map]) -> + DefK = t_map_def_key(Map, Opaques), + DefV = t_map_def_val(Map, Opaques), + Pairs = t_map_entries(Map, Opaques), + EType = lists:foldl( + fun({K,_,V},EType0) -> + case t_is_none(V) of + true -> t_subtract(EType0, t_tuple([K,t_any()])); + false -> t_sup(EType0, t_tuple([K,V])) + end + end, t_tuple([DefK, DefV]), Pairs), + case t_is_none(EType) of + true -> t_nil(); + false -> t_list(EType) + end + end, Opaques); +type(maps, update, 3, Xs, Opaques) -> + strict(maps, update, 3, Xs, + fun ([Key, Value, Map]) -> + t_map_update({Key, Value}, Map, Opaques) + end, Opaques); + %%----------------------------------------------------------------------------- type(M, F, A, Xs, _O) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> @@ -2556,6 +2648,23 @@ arg_types(lists, zipwith, 3) -> [t_fun([t_any(), t_any()], t_any()), t_list(), t_list()]; arg_types(lists, zipwith3, 4) -> [t_fun([t_any(), t_any(), t_any()], t_any()), t_list(), t_list(), t_list()]; +%%------- maps ---------------------------------------------------------------- +arg_types(maps, from_list, 1) -> + [t_list(t_tuple(2))]; +arg_types(maps, get, 2) -> + [t_any(), t_map()]; +arg_types(maps, is_key, 2) -> + [t_any(), t_map()]; +arg_types(maps, merge, 2) -> + [t_map(), t_map()]; +arg_types(maps, put, 3) -> + [t_any(), t_any(), t_map()]; +arg_types(maps, size, 1) -> + [t_map()]; +arg_types(maps, to_list, 1) -> + [t_map()]; +arg_types(maps, update, 3) -> + [t_any(), t_any(), t_map()]; arg_types(M, F, A) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> unknown. % safe approximation for all functions. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index fae12d7421..02e1625965 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2015. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -140,6 +140,8 @@ t_is_port/1, t_is_port/2, t_is_maybe_improper_list/1, t_is_maybe_improper_list/2, t_is_reference/1, t_is_reference/2, + t_is_singleton/1, + t_is_singleton/2, t_is_string/1, t_is_subtype/2, t_is_tuple/1, t_is_tuple/2, @@ -152,6 +154,14 @@ t_list_termination/1, t_list_termination/2, t_map/0, t_map/1, + t_map/3, + t_map_entries/2, t_map_entries/1, + t_map_def_key/2, t_map_def_key/1, + t_map_def_val/2, t_map_def_val/1, + t_map_get/2, t_map_get/3, + t_map_is_key/2, t_map_is_key/3, + t_map_update/2, t_map_update/3, + t_map_put/2, t_map_put/3, t_matchstate/0, t_matchstate/2, t_matchstate_present/1, @@ -178,6 +188,7 @@ %% t_maybe_improper_list/2, t_product/1, t_reference/0, + t_singleton_to_term/2, t_string/0, t_struct_from_opaque/2, t_subst/2, @@ -208,7 +219,8 @@ lift_list_to_pos_empty/1, lift_list_to_pos_empty/2, is_opaque_type/2, is_erl_type/1, - atom_to_string/1 + atom_to_string/1, + map_pairwise_merge/3 ]). %%-define(DO_ERL_TYPES_TEST, true). @@ -341,7 +353,8 @@ -define(nonempty_list(Types, Term),?list(Types, Term, ?nonempty_qual)). -define(number(Set, Qualifier), #c{tag=?number_tag, elements=Set, qualifier=Qualifier}). --define(map(Pairs), #c{tag=?map_tag, elements=Pairs}). +-define(map(Pairs,DefKey,DefVal), + #c{tag=?map_tag, elements={Pairs,DefKey,DefVal}}). -define(opaque(Optypes), #c{tag=?opaque_tag, elements=Optypes}). -define(product(Types), #c{tag=?product_tag, elements=Types}). -define(tuple(Types, Arity, Qual), #c{tag=?tuple_tag, elements=Types, @@ -484,9 +497,8 @@ t_contains_opaque(?int_range(_From, _To), _Opaques) -> false; t_contains_opaque(?int_set(_Set), _Opaques) -> false; t_contains_opaque(?list(Type, Tail, _), Opaques) -> t_contains_opaque(Type, Opaques) orelse t_contains_opaque(Tail, Opaques); -t_contains_opaque(?map(_) = Map, Opaques) -> - list_contains_opaque(map_values(Map), Opaques) orelse - list_contains_opaque(map_keys(Map), Opaques); +t_contains_opaque(?map(_, _, _) = Map, Opaques) -> + list_contains_opaque(map_all_types(Map), Opaques); t_contains_opaque(?matchstate(_P, _Slots), _Opaques) -> false; t_contains_opaque(?nil, _Opaques) -> false; t_contains_opaque(?number(_Set, _Tag), _Opaques) -> false; @@ -1581,16 +1593,107 @@ lift_list_to_pos_empty(?list(Content, Termination, _)) -> %%----------------------------------------------------------------------------- %% Maps %% +%% Representation: +%% ?map(Pairs, DefaultKey, DefaultValue) +%% +%% Pairs is a sorted dictionary of types with a mandatoriness tag on each pair +%% (t_map_dict()). DefaultKey and DefaultValue are plain types. +%% +%% A map M belongs to this type iff +%% For each pair {KT, mandatory, VT} in Pairs, there exists a pair {K, V} in M +%% such that K \in KT and V \in VT. +%% For each pair {KT, optional, VT} in Pairs, either there exists no key K in +%% M s.t. K in KT, or there exists a pair {K, V} in M such that K \in KT and +%% V \in VT. +%% For each remaining pair {K, V} in M (where remaining means that there is no +%% key KT in Pairs s.t. K \in KT), K \in DefaultKey and V \in DefaultValue. +%% +%% Invariants: +%% * The keys in Pairs are singleton types. +%% * The values of Pairs must not be unit, and may only be none if the +%% mandatoriness tag is 'optional'. +%% * Optional must contain no pair {K,V} s.t. K is a subtype of DefaultKey and +%% V is equal to DefaultKey. +%% * DefaultKey must be the empty type iff DefaultValue is the empty type. +%% * DefaultKey must not be a singleton type. +%% * For every key K in Pairs, DefaultKey - K must not be representable; i.e. +%% t_subtract(DefaultKey, K) must return DefaultKey. +%% * For every pair {K, 'optional', ?none} in Pairs, K must be a subtype of +%% DefaultKey. +%% * Pairs must be sorted and not contain any duplicate keys. +%% +%% These invariants ensure that equal map types are represented by equal terms. + +-define(mand, mandatory). +-define(opt, optional). + +-type t_map_mandatoriness() :: ?mand | ?opt. +-type t_map_pair() :: {erl_type(), t_map_mandatoriness(), erl_type()}. +-type t_map_dict() :: [t_map_pair()]. -spec t_map() -> erl_type(). t_map() -> - ?map([]). + t_map([], t_any(), t_any()). -spec t_map([{erl_type(), erl_type()}]) -> erl_type(). -t_map(_) -> - ?map([]). +t_map(L) -> + lists:foldl(fun t_map_put/2, t_map(), L). + +-spec t_map(t_map_dict(), erl_type(), erl_type()) -> erl_type(). + +t_map(Pairs0, DefK0, DefV0) -> + DefK1 = lists:foldl(fun({K,_,_},Acc)->t_subtract(Acc,K)end, DefK0, Pairs0), + {DefK2, DefV1} = + case t_is_none_or_unit(DefK1) orelse t_is_none_or_unit(DefV0) of + true -> {?none, ?none}; + false -> {DefK1, DefV0} + end, + {Pairs1, DefK, DefV} + = case is_singleton_type(DefK2) of + true -> {mapdict_insert({DefK2, ?opt, DefV1}, Pairs0), ?none, ?none}; + false -> {Pairs0, DefK2, DefV1} + end, + Pairs = normalise_map_optionals(Pairs1, DefK, DefV), + %% Validate invariants of the map representation. + %% Since we needed to iterate over the arguments in order to normalise anyway, + %% we might as well save us some future pain and do this even without + %% define(DEBUG, true). + try + validate_map_elements(Pairs) + catch error:badarg -> error(badarg, [Pairs0,DefK0,DefV0]); + error:{badarg, E} -> error({badarg, E}, [Pairs0,DefK0,DefV0]) + end, + ?map(Pairs, DefK, DefV). + +normalise_map_optionals([], _, _) -> []; +normalise_map_optionals([E={K,?opt,?none}|T], DefK, DefV) -> + Diff = t_subtract(DefK, K), + case t_is_subtype(K, DefK) andalso DefK =:= Diff of + true -> [E|normalise_map_optionals(T, DefK, DefV)]; + false -> normalise_map_optionals(T, Diff, DefV) + end; +normalise_map_optionals([E={K,?opt,V}|T], DefK, DefV) -> + case t_is_equal(V, DefV) andalso t_is_subtype(K, DefK) of + true -> normalise_map_optionals(T, DefK, DefV); + false -> [E|normalise_map_optionals(T, DefK, DefV)] + end; +normalise_map_optionals([E|T], DefK, DefV) -> + [E|normalise_map_optionals(T, DefK, DefV)]. + +validate_map_elements([{_,?mand,?none}|_]) -> error({badarg, none_in_mand}); +validate_map_elements([{K1,_,_}|Rest=[{K2,_,_}|_]]) -> + case is_singleton_type(K1) andalso K1 < K2 of + false -> error(badarg); + true -> validate_map_elements(Rest) + end; +validate_map_elements([{K,_,_}]) -> + case is_singleton_type(K) of + false -> error(badarg); + true -> true + end; +validate_map_elements([]) -> true. -spec t_is_map(erl_type()) -> boolean(). @@ -1602,9 +1705,242 @@ t_is_map(Type) -> t_is_map(Type, Opaques) -> do_opaque(Type, Opaques, fun is_map1/1). -is_map1(?map(_)) -> true; +is_map1(?map(_, _, _)) -> true; is_map1(_) -> false. +-spec t_map_entries(erl_type()) -> t_map_dict(). + +t_map_entries(M) -> + t_map_entries(M, 'universe'). + +-spec t_map_entries(erl_type(), opaques()) -> t_map_dict(). + +t_map_entries(M, Opaques) -> + do_opaque(M, Opaques, fun map_entries/1). + +map_entries(?map(Pairs,_,_)) -> + Pairs. + +-spec t_map_def_key(erl_type()) -> erl_type(). + +t_map_def_key(M) -> + t_map_def_key(M, 'universe'). + +-spec t_map_def_key(erl_type(), opaques()) -> erl_type(). + +t_map_def_key(M, Opaques) -> + do_opaque(M, Opaques, fun map_def_key/1). + +map_def_key(?map(_,DefK,_)) -> + DefK. + +-spec t_map_def_val(erl_type()) -> erl_type(). + +t_map_def_val(M) -> + t_map_def_val(M, 'universe'). + +-spec t_map_def_val(erl_type(), opaques()) -> erl_type(). + +t_map_def_val(M, Opaques) -> + do_opaque(M, Opaques, fun map_def_val/1). + +map_def_val(?map(_,_,DefV)) -> + DefV. + +-spec mapdict_store(t_map_pair(), t_map_dict()) -> t_map_dict(). + +mapdict_store(E={K,_,_}, [{K,_,_}|T]) -> [E|T]; +mapdict_store(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2-> + [E2|mapdict_store(E1, T)]; +mapdict_store(E={_,_,_}, T) -> [E|T]. + +-spec mapdict_insert(t_map_pair(), t_map_dict()) -> t_map_dict(). + +mapdict_insert(E={K,_,_}, D=[{K,_,_}|_]) -> error(badarg, [E, D]); +mapdict_insert(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2-> + [E2|mapdict_insert(E1, T)]; +mapdict_insert(E={_,_,_}, T) -> [E|T]. + +%% Merges the pairs of two maps together. Missing pairs become (?opt, DefV) or +%% (?opt, ?none), depending on whether K \in DefK. +-spec map_pairwise_merge(fun((erl_type(), + t_map_mandatoriness(), erl_type(), + t_map_mandatoriness(), erl_type()) + -> t_map_pair() | false), + erl_type(), erl_type()) -> t_map_dict(). +map_pairwise_merge(F, ?map(APairs, ADefK, ADefV), + ?map(BPairs, BDefK, BDefV)) -> + map_pairwise_merge(F, APairs, ADefK, ADefV, BPairs, BDefK, BDefV). + +map_pairwise_merge(_, [], _, _, [], _, _) -> []; +map_pairwise_merge(F, As0, ADefK, ADefV, Bs0, BDefK, BDefV) -> + case {As0, Bs0} of + {[{K,AMNess,AV}|As], [{K, BMNess,BV}|Bs]} -> ok; + {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> + {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)}; + {As, [{K, BMNess,BV}|Bs]} -> + {AMNess, AV} = {?opt, mapmerge_otherv(K, ADefK, ADefV)}; + {[{K,AMNess,AV}|As], []=Bs} -> + {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)} + end, + MK = K, %% Rename to make clear that we are matching below + case F(K, AMNess, AV, BMNess, BV) of + false -> map_pairwise_merge(F,As,ADefK,ADefV,Bs,BDefK,BDefV); + M={MK,_,_} -> [M|map_pairwise_merge(F,As,ADefK,ADefV,Bs,BDefK,BDefV)] + end. + +%% Folds over the pairs in two maps simultaneously in reverse key order. Missing +%% pairs become (?opt, DefV) or (?opt, ?none), depending on whether K \in DefK. +-spec map_pairwise_merge_foldr(fun((erl_type(), + t_map_mandatoriness(), erl_type(), + t_map_mandatoriness(), erl_type(), + Acc) -> Acc), + Acc, erl_type(), erl_type()) -> Acc. + +map_pairwise_merge_foldr(F, AccIn, ?map(APairs, ADefK, ADefV), + ?map(BPairs, BDefK, BDefV)) -> + map_pairwise_merge_foldr(F, AccIn, APairs, ADefK, ADefV, BPairs, BDefK, BDefV). + +map_pairwise_merge_foldr(_, Acc, [], _, _, [], _, _) -> Acc; +map_pairwise_merge_foldr(F, AccIn, As0, ADefK, ADefV, Bs0, BDefK, BDefV) -> + case {As0, Bs0} of + {[{K,AMNess,AV}|As], [{K, BMNess,BV}|Bs]} -> ok; + {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> + {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)}; + {As, [{K, BMNess,BV}|Bs]} -> + {AMNess, AV} = {?opt, mapmerge_otherv(K, ADefK, ADefV)}; + {[{K,AMNess,AV}|As], []=Bs} -> + {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)} + end, + F(K, AMNess, AV, BMNess, BV, + map_pairwise_merge_foldr(F,AccIn,As,ADefK,ADefV,Bs,BDefK,BDefV)). + +%% By observing that a missing pair in a map is equivalent to an optional pair, +%% with ?none or DefV value, depending on whether K \in DefK, we can simplify +%% merging by denormalising the map pairs temporarily, removing all 'false' +%% cases, at the cost of the creation of more tuples: +mapmerge_otherv(K, ODefK, ODefV) -> + case t_inf(K, ODefK) of + ?none -> ?none; + _KOrOpaque -> ODefV + end. + +-spec t_map_put({erl_type(), erl_type()}, erl_type()) -> erl_type(). + +t_map_put(KV, Map) -> + t_map_put(KV, Map, 'universe'). + +-spec t_map_put({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type(). + +t_map_put(KV, Map, Opaques) -> + do_opaque(Map, Opaques, fun(UM) -> map_put(KV, UM, Opaques) end). + +%% Key and Value are *not* unopaqued, but the map is +map_put(_, ?none, _) -> ?none; +map_put({Key, Value}, ?map(Pairs,DefK,DefV), Opaques) -> + case t_is_none_or_unit(Key) orelse t_is_none_or_unit(Value) of + true -> ?none; + false -> + case is_singleton_type(Key) of + true -> + t_map(mapdict_store({Key, ?mand, Value}, Pairs), DefK, DefV); + false -> + t_map([{K, MNess, case t_is_none(t_inf(K, Key, Opaques)) of + true -> V; + false -> t_sup(V, Value) + end} || {K, MNess, V} <- Pairs], + t_sup(DefK, Key), + t_sup(DefV, Value)) + end + end. + +-spec t_map_update({erl_type(), erl_type()}, erl_type()) -> erl_type(). + +t_map_update(KV, Map) -> + t_map_update(KV, Map, 'universe'). + +-spec t_map_update({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type(). + +t_map_update(_, ?none, _) -> ?none; +t_map_update(KV={Key, _}, M, Opaques) -> + case t_is_subtype(t_atom('true'), t_map_is_key(Key, M, Opaques)) of + false -> ?none; + true -> t_map_put(KV, M, Opaques) + end. + +-spec t_map_get(erl_type(), erl_type()) -> erl_type(). + +t_map_get(Key, Map) -> + t_map_get(Key, Map, 'universe'). + +-spec t_map_get(erl_type(), erl_type(), opaques()) -> erl_type(). + +t_map_get(Key, Map, Opaques) -> + do_opaque(Map, Opaques, + fun(UM) -> + do_opaque(Key, Opaques, fun(UK) -> map_get(UK, UM) end) + end). + +map_get(_, ?none) -> ?none; +map_get(Key, ?map(Pairs, DefK, DefV)) -> + DefRes = + case t_do_overlap(DefK, Key) of + false -> t_none(); + true -> DefV + end, + case is_singleton_type(Key) of + false -> + lists:foldl(fun({K, _, V}, Res) -> + case t_do_overlap(K, Key) of + false -> Res; + true -> t_sup(Res, V) + end + end, DefRes, Pairs); + true -> + case lists:keyfind(Key, 1, Pairs) of + false -> DefRes; + {_, _, ValType} -> ValType + end + end. + +-spec t_map_is_key(erl_type(), erl_type()) -> erl_type(). + +t_map_is_key(Key, Map) -> + t_map_is_key(Key, Map, 'universe'). + +-spec t_map_is_key(erl_type(), erl_type(), opaques()) -> erl_type(). + +t_map_is_key(Key, Map, Opaques) -> + do_opaque(Map, Opaques, + fun(UM) -> + do_opaque(Key, Opaques, fun(UK) -> map_is_key(UK, UM) end) + end). + +map_is_key(_, ?none) -> ?none; +map_is_key(Key, ?map(Pairs, DefK, _DefV)) -> + case is_singleton_type(Key) of + true -> + case lists:keyfind(Key, 1, Pairs) of + {Key, ?mand, _} -> t_atom(true); + {Key, ?opt, ?none} -> t_atom(false); + {Key, ?opt, _} -> t_boolean(); + false -> + case t_do_overlap(DefK, Key) of + false -> t_atom(false); + true -> t_boolean() + end + end; + false -> + case t_do_overlap(DefK, Key) + orelse lists:any(fun({_,_,?none}) -> false; + ({K,_,_}) -> t_do_overlap(K, Key) + end, Pairs) + of + true -> t_boolean(); + false -> t_atom(false) + end + end. + %%----------------------------------------------------------------------------- %% Tuples %% @@ -1862,8 +2198,9 @@ t_has_var(?tuple(Elements, _, _)) -> t_has_var_list(Elements); t_has_var(?tuple_set(_) = T) -> t_has_var_list(t_tuple_subtypes(T)); -t_has_var(?map(_)= Map) -> - t_has_var_list(map_keys(Map)) orelse t_has_var_list(map_values(Map)); +t_has_var(?map(_, DefK, _)= Map) -> + t_has_var_list(map_all_values(Map)) orelse + t_has_var(DefK); t_has_var(?opaque(Set)) -> %% Assume variables in 'args' are also present i 'struct' t_has_var_list([O#opaque.struct || O <- set_to_list(Set)]); @@ -1898,9 +2235,9 @@ t_collect_vars(?tuple(Types, _, _), Acc) -> t_collect_vars_list(Types, Acc); t_collect_vars(?tuple_set(_) = TS, Acc) -> t_collect_vars_list(t_tuple_subtypes(TS), Acc); -t_collect_vars(?map(_) = Map, Acc0) -> - Acc = t_collect_vars_list(map_keys(Map), Acc0), - t_collect_vars_list(map_values(Map), Acc); +t_collect_vars(?map(_, DefK, _) = Map, Acc0) -> + Acc = t_collect_vars_list(map_all_values(Map), Acc0), + t_collect_vars(DefK, Acc); t_collect_vars(?opaque(Set), Acc) -> %% Assume variables in 'args' are also present i 'struct' t_collect_vars_list([O#opaque.struct || O <- set_to_list(Set)], Acc); @@ -1935,7 +2272,15 @@ t_from_term(T) when is_function(T) -> {arity, Arity} = erlang:fun_info(T, arity), t_fun(Arity, t_any()); t_from_term(T) when is_integer(T) -> t_integer(T); -t_from_term(T) when is_map(T) -> t_map(); +t_from_term(T) when is_map(T) -> + Pairs = [{t_from_term(K), ?mand, t_from_term(V)} + || {K, V} <- maps:to_list(T)], + {Stons, Rest} = lists:partition(fun({K,_,_}) -> is_singleton_type(K) end, + Pairs), + {DefK, DefV} + = lists:foldl(fun({K,_,V},{AK,AV}) -> {t_sup(K,AK), t_sup(V,AV)} end, + {t_none(), t_none()}, Rest), + t_map(lists:keysort(1, Stons), DefK, DefV); t_from_term(T) when is_pid(T) -> t_pid(); t_from_term(T) when is_port(T) -> t_port(); t_from_term(T) when is_reference(T) -> t_reference(); @@ -2225,6 +2570,13 @@ t_sup(?tuple_set(List1), T2 = ?tuple(_, Arity, _)) -> sup_tuple_sets(List1, [{Arity, [T2]}]); t_sup(?tuple(_, Arity, _) = T1, ?tuple_set(List2)) -> sup_tuple_sets([{Arity, [T1]}], List2); +t_sup(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> + Pairs = + map_pairwise_merge( + fun(K, MNess, V1, MNess, V2) -> {K, MNess, t_sup(V1, V2)}; + (K, _, V1, _, V2) -> {K, ?opt, t_sup(V1, V2)} + end, A, B), + t_map(Pairs, t_sup(ADefK, BDefK), t_sup(ADefV, BDefV)); t_sup(T1, T2) -> ?union(U1) = force_union(T1), ?union(U2) = force_union(T2), @@ -2343,7 +2695,7 @@ force_union(T = ?list(_, _, _)) -> ?list_union(T); force_union(T = ?nil) -> ?list_union(T); force_union(T = ?number(_, _)) -> ?number_union(T); force_union(T = ?opaque(_)) -> ?opaque_union(T); -force_union(T = ?map(_)) -> ?map_union(T); +force_union(T = ?map(_,_,_)) -> ?map_union(T); force_union(T = ?tuple(_, _, _)) -> ?tuple_union(T); force_union(T = ?tuple_set(_)) -> ?tuple_union(T); force_union(T = ?matchstate(_, _)) -> ?matchstate_union(T); @@ -2380,7 +2732,7 @@ t_elements(?number(_, _) = T) -> end; t_elements(?opaque(_) = T) -> do_elements(T); -t_elements(?map(_) = T) -> [T]; +t_elements(?map(_,_,_) = T) -> [T]; t_elements(?tuple(_, _, _) = T) -> [T]; t_elements(?tuple_set(_) = TS) -> case t_tuple_subtypes(TS) of @@ -2462,6 +2814,25 @@ t_inf(?identifier(Set1), ?identifier(Set2), _Opaques) -> ?none -> ?none; Set -> ?identifier(Set) end; +t_inf(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B, _Opaques) -> + %% Because it simplifies the anonymous function, we allow Pairs to temporarily + %% contain mandatory pairs with none values, since all such cases should + %% result in a none result. + Pairs = + map_pairwise_merge( + %% For optional keys in both maps, when the infinimum is none, we have + %% essentially concluded that K must not be a key in the map. + fun(K, ?opt, V1, ?opt, V2) -> {K, ?opt, t_inf(V1, V2)}; + %% When a key is optional in one map, but mandatory in another, it + %% becomes mandatory in the infinumum + (K, _, V1, _, V2) -> {K, ?mand, t_inf(V1, V2)} + end, A, B), + %% If the infinimum of any mandatory values is ?none, the entire map infinimum + %% is ?none. + case lists:any(fun({_,?mand,?none})->true; ({_,_,_}) -> false end, Pairs) of + true -> t_none(); + false -> t_map(Pairs, t_inf(ADefK, BDefK), t_inf(ADefV, BDefV)) + end; t_inf(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2), _Opaques) -> ?matchstate(t_inf(Pres1, Pres2), t_inf(Slots1, Slots2)); t_inf(?nil, ?nil, _Opaques) -> ?nil; @@ -2970,9 +3341,9 @@ t_subst_dict(?tuple(Elements, _Arity, _Tag), Dict) -> t_tuple([t_subst_dict(E, Dict) || E <- Elements]); t_subst_dict(?tuple_set(_) = TS, Dict) -> t_sup([t_subst_dict(T, Dict) || T <- t_tuple_subtypes(TS)]); -t_subst_dict(?map(Pairs), Dict) -> - ?map([{t_subst_dict(K, Dict), t_subst_dict(V, Dict)} || - {K, V} <- Pairs]); +t_subst_dict(?map(Pairs, DefK, DefV), Dict) -> + t_map([{K, MNess, t_subst_dict(V, Dict)} || {K, MNess, V} <- Pairs], + t_subst_dict(DefK, Dict), t_subst_dict(DefV, Dict)); t_subst_dict(?opaque(Es), Dict) -> List = [Opaque#opaque{args = [t_subst_dict(Arg, Dict) || Arg <- Args], struct = t_subst_dict(S, Dict)} || @@ -3022,9 +3393,9 @@ t_subst_aux(?tuple(Elements, _Arity, _Tag), VarMap) -> t_tuple([t_subst_aux(E, VarMap) || E <- Elements]); t_subst_aux(?tuple_set(_) = TS, VarMap) -> t_sup([t_subst_aux(T, VarMap) || T <- t_tuple_subtypes(TS)]); -t_subst_aux(?map(Pairs), VarMap) -> - ?map([{t_subst_aux(K, VarMap), t_subst_aux(V, VarMap)} || - {K, V} <- Pairs]); +t_subst_aux(?map(Pairs, DefK, DefV), VarMap) -> + t_map([{K, MNess, t_subst_aux(V, VarMap)} || {K, MNess, V} <- Pairs], + t_subst_aux(DefK, VarMap), t_subst_aux(DefV, VarMap)); t_subst_aux(?opaque(Es), VarMap) -> List = [Opaque#opaque{args = [t_subst_aux(Arg, VarMap) || Arg <- Args], struct = t_subst_aux(S, VarMap)} || @@ -3104,6 +3475,23 @@ t_unify(?tuple_set(List1) = T1, ?tuple_set(List2) = T2, VarMap) -> {Tuples, NewVarMap} -> {t_sup(Tuples), NewVarMap} catch _:_ -> throw({mismatch, T1, T2}) end; +t_unify(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B, VarMap0) -> + {DefK, VarMap1} = t_unify(ADefK, BDefK, VarMap0), + {DefV, VarMap2} = t_unify(ADefV, BDefV, VarMap1), + {Pairs, VarMap} = + map_pairwise_merge_foldr( + fun(K, MNess, V1, MNess, V2, {Pairs0, VarMap3}) -> + %% We know that the keys unify and do not contain variables, or they + %% would not be singletons + %% TODO: Should V=?none (known missing keys) be handled special? + {V, VarMap4} = t_unify(V1, V2, VarMap3), + {[{K,MNess,V}|Pairs0], VarMap4}; + (K, _, V1, _, V2, {Pairs0, VarMap3}) -> + %% One mandatory and one optional; what should be done in this case? + {V, VarMap4} = t_unify(V1, V2, VarMap3), + {[{K,?mand,V}|Pairs0], VarMap4} + end, {[], VarMap2}, A, B), + {t_map(Pairs, DefK, DefV), VarMap}; t_unify(?opaque(_) = T1, ?opaque(_) = T2, VarMap) -> t_unify(t_opaque_structure(T1), t_opaque_structure(T2), VarMap); t_unify(T1, ?opaque(_) = T2, VarMap) -> @@ -3307,7 +3695,7 @@ t_subtract_list(T, []) -> -spec t_subtract(erl_type(), erl_type()) -> erl_type(). t_subtract(_, ?any) -> ?none; -t_subtract(_, ?var(_)) -> ?none; +t_subtract(T, ?var(_)) -> T; t_subtract(?any, _) -> ?any; t_subtract(?var(_) = T, _) -> T; t_subtract(T, ?unit) -> T; @@ -3460,8 +3848,50 @@ t_subtract(?product(Elements1) = T1, ?product(Elements2)) -> _ -> T1 end end; -t_subtract(?map(_) = T, _) -> % XXX: very crude; will probably need refinement - T; +t_subtract(?map(APairs, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> + case t_is_subtype(ADefK, BDefK) andalso t_is_subtype(ADefV, BDefV) of + false -> A; + true -> + %% We fold over the maps to produce a list of constraints, where + %% constraints are additional key-value pairs to put in Pairs. Only one + %% constraint need to be applied to produce a type that excludes the + %% right-hand-side type, so if more than one constraint is produced, we + %% just return the left-hand-side argument. + %% + %% Each case of the fold may either conclude that + %% * The arguments constrain A at least as much as B, i.e. that A so far + %% is a subtype of B. In that case they return false + %% * That for the particular arguments, A being a subtype of B does not + %% hold, but the infinimum of A and B is nonempty, and by narrowing a + %% pair in A, we can create a type that excludes some elements in the + %% infinumum. In that case, they will return that pair. + %% * That for the particular arguments, A being a subtype of B does not + %% hold, and either the infinumum of A and B is empty, or it is not + %% possible with the current representation to create a type that + %% excludes elements from B without also excluding elements that are + %% only in A. In that case, it will return the pair from A unchanged. + case + map_pairwise_merge( + %% If V1 is a subtype of V2, the case that K does not exist in A + %% remain. + fun(K, ?opt, V1, ?mand, V2) -> {K, ?opt, t_subtract(V1, V2)}; + (K, _, V1, _, V2) -> + %% If we subtract an optional key, that leaves a mandatory key + case t_subtract(V1, V2) of + ?none -> false; + Partial -> {K, ?mand, Partial} + end + end, A, B) + of + %% We produce a list of keys that are constrained. As only one of + %% these should apply at a time, we can't represent the difference if + %% more than one constraint is produced. If we applied all of them, + %% that would make an underapproximation, which we must not do. + [] -> ?none; %% A is a subtype of B + [E] -> t_map(mapdict_store(E, APairs), ADefK, ADefV); + _ -> A + end + end; t_subtract(?product(P1), _) -> ?product(P1); t_subtract(T, ?product(_)) -> @@ -3592,6 +4022,11 @@ subtype_is_equal(T1, T2) -> t_is_instance(ConcreteType, Type) -> t_is_subtype(ConcreteType, t_unopaque(Type)). +-spec t_do_overlap(erl_type(), erl_type()) -> boolean(). + +t_do_overlap(TypeA, TypeB) -> + not (t_is_none_or_unit(t_inf(TypeA, TypeB))). + -spec t_unopaque(erl_type()) -> erl_type(). t_unopaque(T) -> @@ -3622,12 +4057,17 @@ t_unopaque(?union([A,B,F,I,L,N,T,M,O,Map]), Opaques) -> UL = t_unopaque(L, Opaques), UT = t_unopaque(T, Opaques), UF = t_unopaque(F, Opaques), + UM = t_unopaque(M, Opaques), UMap = t_unopaque(Map, Opaques), {OF,UO} = case t_unopaque(O, Opaques) of ?opaque(_) = O1 -> {O1, []}; Type -> {?none, [Type]} end, - t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,UMap])|UO]); + t_sup([?union([A,B,UF,I,UL,N,UT,UM,OF,UMap])|UO]); +t_unopaque(?map(Pairs,DefK,DefV), Opaques) -> + t_map([{K, MNess, t_unopaque(V, Opaques)} || {K, MNess, V} <- Pairs], + t_unopaque(DefK, Opaques), + t_unopaque(DefV, Opaques)); t_unopaque(T, _) -> T. @@ -3679,6 +4119,16 @@ t_limit_k(?opaque(Es), K) -> Opaque#opaque{struct = NewS} end || #opaque{struct = S} = Opaque <- set_to_list(Es)], ?opaque(ordsets:from_list(List)); +t_limit_k(?map(Pairs0, DefK0, DefV0), K) -> + Fun = fun({EK, MNess, EV}, {Exact, DefK1, DefV1}) -> + LV = t_limit_k(EV, K - 1), + case t_limit_k(EK, K - 1) of + EK -> {[{EK,MNess,LV}|Exact], DefK1, DefV1}; + LK -> {Exact, t_sup(LK, DefK1), t_sup(LV, DefV1)} + end + end, + {Pairs, DefK2, DefV2} = lists:foldr(Fun, {[], DefK0, DefV0}, Pairs0), + t_map(Pairs, t_limit_k(DefK2, K - 1), t_limit_k(DefV2, K - 1)); t_limit_k(T, _K) -> T. %%============================================================================ @@ -3753,6 +4203,9 @@ t_map(Fun, ?opaque(Set)) -> [] -> ?none; _ -> ?opaque(ordsets:from_list(L)) end); +t_map(Fun, ?map(Pairs,DefK,DefV)) -> + %% TODO: + Fun(t_map(Pairs, Fun(DefK), Fun(DefV))); t_map(Fun, T) -> Fun(T). @@ -3894,8 +4347,23 @@ t_to_string(?float, _RecDict) -> "float()"; t_to_string(?number(?any, ?unknown_qual), _RecDict) -> "number()"; t_to_string(?product(List), RecDict) -> "<" ++ comma_sequence(List, RecDict) ++ ">"; -t_to_string(?map(Pairs), RecDict) -> - "#{" ++ map_pairs_to_string(Pairs,RecDict) ++ "}"; +t_to_string(?map([],?any,?any), _RecDict) -> "map()"; +t_to_string(?map(Pairs0,DefK,DefV), RecDict) -> + {Pairs, ExtraEl} = + case {DefK, DefV} of + {?none, ?none} -> {Pairs0, []}; + {?any, ?any} -> {Pairs0, ["..."]}; + _ -> {Pairs0 ++ [{DefK,?opt,DefV}], []} + end, + Tos = fun(T) -> case T of + ?any -> "_"; + _ -> t_to_string(T, RecDict) + end end, + StrMand = [{Tos(K),Tos(V)}||{K,?mand,V}<-Pairs], + StrOpt = [{Tos(K),Tos(V)}||{K,?opt,V}<-Pairs], + "#{" ++ string:join([K ++ ":=" ++ V||{K,V}<-StrMand] + ++ [K ++ "=>" ++ V||{K,V}<-StrOpt] + ++ ExtraEl, ", ") ++ "}"; t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()"; t_to_string(?tuple(Elements, _Arity, ?any), RecDict) -> "{" ++ comma_sequence(Elements, RecDict) ++ "}"; @@ -3916,12 +4384,6 @@ t_to_string(?var(Id), _RecDict) when is_integer(Id) -> flat_format("var(~w)", [Id]). -map_pairs_to_string([],_) -> []; -map_pairs_to_string(Pairs,RecDict) -> - StrPairs = [{t_to_string(K,RecDict),t_to_string(V,RecDict)}||{K,V}<-Pairs], - string:join([K ++ "=>" ++ V||{K,V}<-StrPairs], ", "). - - record_to_string(Tag, [_|Fields], FieldNames, RecDict) -> FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []), "#" ++ atom_to_string(Tag) ++ "{" ++ string:join(FieldStrings, ",") ++ "}". @@ -4149,7 +4611,7 @@ t_from_form({type, _L, 'fun', [{type, _, any}, Range]}, TypeNames, t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, TypeNames, ET, S, MR, V, D, L) -> {Dom1, L1} = list_from_form(Domain, TypeNames, ET, S, MR, V, D, L), - {Ran1, L2} = t_from_form(Range, TypeNames, ET, S, MR, V, D - 1, L1), + {Ran1, L2} = t_from_form(Range, TypeNames, ET, S, MR, V, D, L1), {t_fun(Dom1, Ran1), L2}; t_from_form({type, _L, identifier, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_identifier(), L}; @@ -4164,8 +4626,26 @@ t_from_form({type, _L, list, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> t_from_form({type, _L, list, [Type]}, TypeNames, ET, S, MR, V, D, L) -> {T, L1} = t_from_form(Type, TypeNames, ET, S, MR, V, D - 1, L - 1), {t_list(T), L1}; -t_from_form({type, _L, map, _}, TypeNames, ET, S, MR, V, D, L) -> - builtin_type(map, t_map([]), TypeNames, ET, S, MR, V, D, L); +t_from_form({type, _L, map, any}, TypeNames, ET, S, MR, V, D, L) -> + builtin_type(map, t_map(), TypeNames, ET, S, MR, V, D, L); +t_from_form({type, _L, map, List}, TypeNames, ET, S, MR, V, D, L) -> + {Pairs1, L5} = + fun PairsFromForm(_, L1) when L1 =< 0 -> {[{?any,?opt,?any}], L1}; + PairsFromForm([], L1) -> {[], L1}; + PairsFromForm([{type, _, Oper, [KF, VF]}|T], L1) -> + {Key, L2} = t_from_form(KF, TypeNames, ET, S, MR, V, D - 1, L1), + {Val, L3} = t_from_form(VF, TypeNames, ET, S, MR, V, D - 1, L2), + {Pairs0, L4} = PairsFromForm(T, L3 - 1), + case Oper of + map_field_assoc -> {[{Key,?opt, Val}|Pairs0], L4}; + map_field_exact -> {[{Key,?mand,Val}|Pairs0], L4} + end + end(List, L), + try + {Pairs, DefK, DefV} = map_from_form(Pairs1, [], [], [], ?none, ?none), + {t_map(Pairs, DefK, DefV), L5} + catch none -> {t_none(), L5} + end; t_from_form({type, _L, mfa, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_mfa(), L}; t_from_form({type, _L, module, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> @@ -4495,6 +4975,50 @@ list_from_form([H|Tail], TypeNames, ET, S, MR, V, D, L) -> {T1, L2} = list_from_form(Tail, TypeNames, ET, S, MR, V, D, L1), {[H1|T1], L2}. +%% Sorts, combines non-singleton pairs, and applies precendence and +%% mandatoriness rules. +map_from_form([], ShdwPs, MKs, Pairs, DefK, DefV) -> + verify_possible(MKs, ShdwPs), + {promote_to_mand(MKs, Pairs), DefK, DefV}; +map_from_form([{SKey,MNess,Val}|SPairs], ShdwPs0, MKs0, Pairs0, DefK0, DefV0) -> + Key = lists:foldl(fun({K,_},S)->t_subtract(S,K)end, SKey, ShdwPs0), + ShdwPs = case Key of ?none -> ShdwPs0; _ -> [{Key,Val}|ShdwPs0] end, + MKs = case MNess of ?mand -> [SKey|MKs0]; ?opt -> MKs0 end, + if MNess =:= ?mand, SKey =:= ?none -> throw(none); + true -> ok + end, + {Pairs, DefK, DefV} = + case is_singleton_type(Key) of + true -> + MNess1 = case Val =:= ?none of true -> ?opt; false -> MNess end, + {mapdict_insert({Key,MNess1,Val}, Pairs0), DefK0, DefV0}; + false -> + case Key =:= ?none orelse Val =:= ?none of + true -> {Pairs0, DefK0, DefV0}; + false -> {Pairs0, t_sup(DefK0, Key), t_sup(DefV0, Val)} + end + end, + map_from_form(SPairs, ShdwPs, MKs, Pairs, DefK, DefV). + +%% Verifies that all mandatory keys are possible, throws 'none' otherwise +verify_possible(MKs, ShdwPs) -> + lists:foreach(fun(M) -> verify_possible_1(M, ShdwPs) end, MKs). + +verify_possible_1(M, ShdwPs) -> + case lists:any(fun({K,_}) -> t_inf(M, K) =/= ?none end, ShdwPs) of + true -> ok; + false -> throw(none) + end. + +-spec promote_to_mand([erl_type()], t_map_dict()) -> t_map_dict(). + +promote_to_mand(_, []) -> []; +promote_to_mand(MKs, [E={K,_,V}|T]) -> + [case lists:any(fun(M) -> t_is_equal(K,M) end, MKs) of + true -> {K, ?mand, V}; + false -> E + end|promote_to_mand(MKs, T)]. + -spec t_check_record_fields(parse_form(), sets:set(mfa()), site(), mod_records()) -> ok. @@ -4627,8 +5151,13 @@ t_form_to_string({type, _L, iodata, []}) -> "iodata()"; t_form_to_string({type, _L, iolist, []}) -> "iolist()"; t_form_to_string({type, _L, list, [Type]}) -> "[" ++ t_form_to_string(Type) ++ "]"; -t_form_to_string({type, _L, map, _}) -> - "#{}"; +t_form_to_string({type, _L, map, any}) -> "map()"; +t_form_to_string({type, _L, map, Args}) -> + "#{" ++ string:join(t_form_to_string_list(Args), ",") ++ "}"; +t_form_to_string({type, _L, map_field_assoc, [Key, Val]}) -> + t_form_to_string(Key) ++ "=>" ++ t_form_to_string(Val); +t_form_to_string({type, _L, map_field_exact, [Key, Val]}) -> + t_form_to_string(Key) ++ ":=" ++ t_form_to_string(Val); t_form_to_string({type, _L, mfa, []}) -> "mfa()"; t_form_to_string({type, _L, module, []}) -> "module()"; t_form_to_string({type, _L, node, []}) -> "node()"; @@ -4789,11 +5318,70 @@ do_opaque(?union(List) = Type, Opaques, Pred) -> do_opaque(Type, _Opaques, Pred) -> Pred(Type). -map_keys(?map(Pairs)) -> - [K || {K, _} <- Pairs]. +map_all_values(?map(Pairs,_,DefV)) -> + [DefV|[V || {V, _, _} <- Pairs]]. + +map_all_keys(?map(Pairs,DefK,_)) -> + [DefK|[K || {_, _, K} <- Pairs]]. + +map_all_types(M) -> + map_all_keys(M) ++ map_all_values(M). + +%% Tests if a type has exactly one possible value. +-spec t_is_singleton(erl_type()) -> boolean(). + +t_is_singleton(Type) -> + t_is_singleton(Type, 'universe'). + +-spec t_is_singleton(erl_type(), opaques()) -> boolean(). + +t_is_singleton(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_singleton_type/1). + +%% Incomplete; not all representable singleton types are included. +is_singleton_type(?nil) -> true; +is_singleton_type(?atom(?any)) -> false; +is_singleton_type(?atom(Set)) -> + ordsets:size(Set) =:= 1; +is_singleton_type(?int_range(V, V)) -> true; +is_singleton_type(?int_set(Set)) -> + ordsets:size(Set) =:= 1; +is_singleton_type(?tuple(Types, Arity, _)) when is_integer(Arity) -> + lists:all(fun is_singleton_type/1, Types); +is_singleton_type(?tuple_set([{Arity, [OnlyTuple]}])) when is_integer(Arity) -> + is_singleton_type(OnlyTuple); +is_singleton_type(?map(Pairs, ?none, ?none)) -> + lists:all(fun({_,MNess,V}) -> MNess =:= ?mand andalso is_singleton_type(V) + end, Pairs); +is_singleton_type(_) -> + false. + +%% Returns the only possible value of a singleton type. +-spec t_singleton_to_term(erl_type(), opaques()) -> term(). -map_values(?map(Pairs)) -> - [V || {_, V} <- Pairs]. +t_singleton_to_term(Type, Opaques) -> + do_opaque(Type, Opaques, fun singleton_type_to_term/1). + +singleton_type_to_term(?nil) -> []; +singleton_type_to_term(?atom(Set)) when Set =/= ?any -> + case ordsets:size(Set) of + 1 -> hd(ordsets:to_list(Set)); + _ -> error(badarg) + end; +singleton_type_to_term(?int_range(V, V)) -> V; +singleton_type_to_term(?int_set(Set)) -> + case ordsets:size(Set) of + 1 -> hd(ordsets:to_list(Set)); + _ -> error(badarg) + end; +singleton_type_to_term(?tuple(Types, Arity, _)) when is_integer(Arity) -> + lists:map(fun singleton_type_to_term/1, Types); +singleton_type_to_term(?tuple_set([{Arity, [OnlyTuple]}])) + when is_integer(Arity) -> + singleton_type_to_term(OnlyTuple); +singleton_type_to_term(?map(Pairs, ?none, ?none)) -> + maps:from_list([{singleton_type_to_term(K), singleton_type_to_term(V)} + || {K,?mand,V} <- Pairs]). %% ----------------------------------- %% Set diff --git a/lib/hipe/test/hipe_SUITE.erl b/lib/hipe/test/hipe_SUITE.erl index 9319b710d9..a5b3924aa8 100644 --- a/lib/hipe/test/hipe_SUITE.erl +++ b/lib/hipe/test/hipe_SUITE.erl @@ -19,9 +19,6 @@ -compile([export_all]). -include_lib("common_test/include/ct.hrl"). -suite() -> - [{ct_hooks, [ts_install_cth]}]. - all() -> [app, appup]. diff --git a/lib/inets/doc/src/mod_esi.xml b/lib/inets/doc/src/mod_esi.xml index ae567ea185..deef010e54 100644 --- a/lib/inets/doc/src/mod_esi.xml +++ b/lib/inets/doc/src/mod_esi.xml @@ -23,10 +23,6 @@ </legalnotice> <title>mod_esi</title> - <prepared>Joakim Grebenö</prepared> - <docno></docno> - <date>1997-10-14</date> - <rev>2.2</rev> <file>mod_esi.sgml</file> </header> <module>mod_esi</module> @@ -39,6 +35,56 @@ <marker id="deliver"></marker> </description> + <section> + <title>DATA TYPES</title> + <p>The following data types are used in the functions for mod_esi:</p> + + <taglist> + <tag><c>env() = </c></tag> + <item> <p><c>{EnvKey()::atom(), Value::term()}</c></p> + </item> + + <p>Currently supported key value pairs</p> + <taglist> + + <tag><c>{server_software, string()}</c></tag> + <item><p>Indicates the inets version.</p></item> + + <tag><c>{server_name, string()}</c></tag> + <item><p>The local hostname. </p></item> + + <tag><c>{gateway_interface, string()}</c></tag> + <item><p>Legacy string used in CGI, just ignore.</p> </item> + + <tag><c>{server_protocol, string()}</c></tag> + <item><p> HTTP version, currently "HTTP/1.1"</p></item> + + <tag>{server_port, integer()}</tag> + <item><p>Servers port number.</p></item> + + <tag><c>{request_method, "GET | "PUT" | "DELETE | "POST" | "PATCH"}</c></tag> + + <tag><c>{remote_adress, inet:ip_address()} </c></tag> + <item><p>The clients ip address.</p></item> + + <tag><c>{peer_cert, undefined | no_peercert | DER:binary()</c></tag> + <item> + <p>For TLS connections where client certificates are used this will + be an ASN.1 DER-encoded X509-certificate as an Erlang binary. + If client certificates are not used the value will be <c>no_peercert</c>, + and if TLS is not used (HTTP or connection is lost due to network failure) + the value will be <c>undefined</c>. + </p></item> + + <tag><c>{script_name, string()}</c></tag> + <item><p>Request URI</p></item> + + <tag><c>{http_LowerCaseHTTPHeaderName, string()}</c></tag> + <item><p>example: {http_content_type, "text/html"}</p></item> + </taglist> + + </taglist> + <funcs> <func> <name>deliver(SessionID, Data) -> ok | {error, Reason}</name> @@ -63,11 +109,11 @@ overhead. Do not assume anything about the data type of <c>SessionID</c>. <c>SessionID</c> must be the value given as input to the ESI callback function that you implemented.</p> - </note> + </note> </desc> </func> </funcs> - + </section> <section> <title>ESI Callback Functions</title> </section> @@ -78,9 +124,7 @@ to the server process by calling <c>mod_esi:deliver/2</c>.</fsummary> <type> <v>SessionID = term()</v> - <v>Env = [EnvironmentDirectives] ++ ParsedHeader</v> - <v>EnvironmentDirectives = {Key,Value}</v> - <v>Key = query_string | content_length | server_software | gateway_interface | server_protocol | server_port | request_method | remote_addr | script_name</v> + <v>Env = env()</v> <v>Input = string()</v> </type> <desc> @@ -111,9 +155,7 @@ <fsummary>Creates a dynamic web page and returns it as a list. This function is deprecated and is only kept for backwards compatibility.</fsummary> <type> - <v>Env = [EnvironmentDirectives] ++ ParsedHeader</v> - <v>EnvironmentDirectives = {Key,Value}</v> - <v>Key = query_string | content_length | server_software | gateway_interface | server_protocol | server_port | request_method | remote_addr | script_name.</v> + <v>Env = env()</v> <v>Input = string()</v> <v>Response = string()</v> </type> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index b3d2221930..bd6b76a73e 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,22 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.2.1</title> + <section><title>Inets 6.2.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add environment information item peer_cert to mod_esi</p> + <p> + Own Id: OTP-13510</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.2.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_server/httpd_example.erl b/lib/inets/src/http_server/httpd_example.erl index 366e37742b..424d269859 100644 --- a/lib/inets/src/http_server/httpd_example.erl +++ b/lib/inets/src/http_server/httpd_example.erl @@ -20,7 +20,7 @@ %% -module(httpd_example). -export([print/1]). --export([get/2, post/2, yahoo/2, test1/2, get_bin/2]). +-export([get/2, post/2, yahoo/2, test1/2, get_bin/2, peer/2]). -export([newformat/3]). %% These are used by the inets test-suite @@ -94,10 +94,26 @@ default(Env,Input) -> io_lib:format("~p",[httpd:parse_query(Input)]),"\n", footer()]. +peer(Env, Input) -> + Header = + case proplists:get_value(peer_cert, Env) of + undefined -> + header("text/html", "Peer-Cert-Exist:false"); + _ -> + header("text/html", "Peer-Cert-Exist:true") + end, + [Header, + top("Test peer_cert environment option"), + "<B>Peer cert:</B> ", + io_lib:format("~p",[proplists:get_value(peer_cert, Env)]),"\n", + footer()]. + header() -> header("text/html"). header(MimeType) -> "Content-type: " ++ MimeType ++ "\r\n\r\n". +header(MimeType, Other) -> + "Content-type: " ++ MimeType ++ "\r\n" ++ Other ++ "\r\n\r\n". top(Title) -> "<HTML> diff --git a/lib/inets/src/http_server/httpd_script_env.erl b/lib/inets/src/http_server/httpd_script_env.erl index 25f9bea7b3..e15613273e 100644 --- a/lib/inets/src/http_server/httpd_script_env.erl +++ b/lib/inets/src/http_server/httpd_script_env.erl @@ -61,6 +61,19 @@ which_port(#mod{config_db = ConfigDb}) -> which_peername(#mod{init_data = #init_data{peername = {_, RemoteAddr}}}) -> RemoteAddr. +which_peercert(#mod{socket_type = {Type, _}, socket = Socket}) when Type == essl; + Type == ssl -> + case ssl:peercert(Socket) of + {ok, Cert} -> + Cert; + {error, no_peercert} -> + no_peercert; + _ -> + undefined + end; +which_peercert(_) -> %% Not an ssl connection + undefined. + which_resolve(#mod{init_data = #init_data{resolve = Resolve}}) -> Resolve. @@ -78,6 +91,7 @@ create_basic_elements(esi, ModData) -> {server_port, which_port(ModData)}, {request_method, which_method(ModData)}, {remote_addr, which_peername(ModData)}, + {peer_cert, which_peercert(ModData)}, {script_name, which_request_uri(ModData)}]; create_basic_elements(cgi, ModData) -> diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index 4d0d656acb..a603357ebd 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,12 +18,16 @@ %% %CopyrightEnd% {"%VSN%", [ - {<<"6.2">>, [{load_module, httpc, soft_purge, soft_purge, []}]}, + {<<"6.2.1">>, [{load_module, httpd_script_env, soft_purge, soft_purge, []}]}, + {<<"6.2">>, [{load_module, httpd_script_env, soft_purge, soft_purge, []}, + {load_module, httpc, soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ], [ - {<<"6.2">>, [{load_module, httpc, soft_purge, soft_purge, []}]}, + {<<"6.2.1">>, [{load_module, httpd_script_env, soft_purge, soft_purge, []}]}, + {<<"6.2">>, [{load_module, httpd_script_env, soft_purge, soft_purge, []}, + {load_module, httpc, soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ] diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 1d8a603981..93520c1cb4 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -755,7 +755,11 @@ esi(Config) when is_list(Config) -> %% Check "ErlScriptNoCache" directive (default: false) ok = http_status("GET /cgi-bin/erl/httpd_example:get ", Config, [{statuscode, 200}, - {no_header, "cache-control"}]). + {no_header, "cache-control"}]), + ok = http_status("GET /cgi-bin/erl/httpd_example:peer ", + Config, [{statuscode, 200}, + {header, "peer-cert-exist", peer(Config)}]). + %%------------------------------------------------------------------------- mod_esi_chunk_timeout(Config) when is_list(Config) -> ok = httpd_1_1:mod_esi_chunk_timeout(?config(type, Config), @@ -2065,3 +2069,11 @@ response_default_headers() -> {"X-Frame-Options", "SAMEORIGIN"}, %% Override built-in default {"Date", "Override-date"}]. + +peer(Config) -> + case proplists:get_value(type, Config) of + ssl -> + "true"; + _ -> + "false" + end.
\ No newline at end of file diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 121f55c389..fc33b546d9 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.2.1 +INETS_VSN = 6.2.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/seq_trace.xml b/lib/kernel/doc/src/seq_trace.xml index 1feb3fcb07..5ac199b6a7 100644 --- a/lib/kernel/doc/src/seq_trace.xml +++ b/lib/kernel/doc/src/seq_trace.xml @@ -213,9 +213,10 @@ seq_trace:set_token(OldToken), % activate the trace token again <type name="tracer"/> <desc> <p>Sets the system tracer. The system tracer can be either a - process or port denoted by <c><anno>Tracer</anno></c>. Returns the previous - value (which can be <c>false</c> if no system tracer is - active).</p> + process, port or <seealso marker="erts:erl_tracer">tracer module</seealso> + denoted by <c><anno>Tracer</anno></c>. + Returns the previous value (which can be <c>false</c> if no system + tracer is active).</p> <p>Failure: <c>{badarg, Info}}</c> if <c><anno>Pid</anno></c> is not an existing local pid.</p> </desc> @@ -225,7 +226,7 @@ seq_trace:set_token(OldToken), % activate the trace token again <fsummary>Return the pid() or port() of the current system tracer.</fsummary> <type name="tracer"/> <desc> - <p>Returns the pid or port identifier of the current system + <p>Returns the pid, port identifier or tracer module of the current system tracer or <c>false</c> if no system tracer is activated.</p> </desc> </func> @@ -298,7 +299,7 @@ TimeStamp = {Seconds, Milliseconds, Microseconds} matches a message in a receive statement, according to the trace token carried by the received message, empty or not.</p> <p>On each Erlang node, a process can be set as the <em>system tracer</em>. - This process receives trace messages each time + This process will receive trace messages each time a message with a trace token is sent or received (if the trace token flag <c>send</c> or <c>'receive'</c> is set). The system tracer can then print each trace event, write it to a file, or diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 25dddb1f6c..90b2a06c46 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -76,7 +76,7 @@ init(Ref, Parent, [Root,Mode]) -> interactive -> LibDir = filename:append(Root, "lib"), {ok,Dirs} = erl_prim_loader:list_dir(LibDir), - {Paths,_Libs} = make_path(LibDir, Dirs), + Paths = make_path(LibDir, Dirs), UserLibPaths = get_user_lib_dirs(), ["."] ++ UserLibPaths ++ Paths; _ -> @@ -111,7 +111,7 @@ get_user_lib_dirs() -> get_user_lib_dirs_1([Dir|DirList]) -> case erl_prim_loader:list_dir(Dir) of {ok, Dirs} -> - {Paths,_Libs} = make_path(Dir, Dirs), + Paths = make_path(Dir, Dirs), %% Only add paths trailing with ./ebin. [P || P <- Paths, filename:basename(P) =:= "ebin"] ++ get_user_lib_dirs_1(DirList); @@ -371,7 +371,7 @@ handle_call(Other,{_From,_Tag}, S) -> %% make_path(BundleDir, Bundles0) -> Bundles = choose_bundles(Bundles0), - make_path(BundleDir, Bundles, [], []). + make_path(BundleDir, Bundles, []). choose_bundles(Bundles) -> ArchiveExt = archive_extension(), @@ -381,12 +381,10 @@ choose_bundles(Bundles) -> create_bundle(FullName, ArchiveExt) -> BaseName = filename:basename(FullName, ArchiveExt), - case split(BaseName, "-") of - [_, _|_] = Toks -> - VsnStr = lists:last(Toks), + case split_base(BaseName) of + {Name, VsnStr} -> case vsn_to_num(VsnStr) of {ok, VsnNum} -> - Name = join(lists:sublist(Toks, length(Toks)-1),"-"), {Name,VsnNum,FullName}; false -> {FullName,[0],FullName} @@ -457,41 +455,44 @@ choose([{Name,NumVsn,NewFullName}=New|Bs], Acc, ArchiveExt) -> choose([],Acc, _ArchiveExt) -> Acc. -make_path(_,[],Res,Bs) -> - {Res,Bs}; -make_path(BundleDir,[Bundle|Tail],Res,Bs) -> - Dir = filename:append(BundleDir,Bundle), - Ebin = filename:append(Dir,"ebin"), +make_path(_, [], Res) -> + Res; +make_path(BundleDir, [Bundle|Tail], Res) -> + Dir = filename:append(BundleDir, Bundle), + Ebin = filename:append(Dir, "ebin"), %% First try with /ebin - case erl_prim_loader:read_file_info(Ebin) of - {ok,#file_info{type=directory}} -> - make_path(BundleDir,Tail,[Ebin|Res],[Bundle|Bs]); - _ -> + case is_dir(Ebin) of + true -> + make_path(BundleDir, Tail, [Ebin|Res]); + false -> %% Second try with archive Ext = archive_extension(), - Base = filename:basename(Dir, Ext), - Ebin2 = filename:join([filename:dirname(Dir), Base ++ Ext, Base, "ebin"]), + Base = filename:basename(Bundle, Ext), + Ebin2 = filename:join([BundleDir, Base ++ Ext, Base, "ebin"]), Ebins = - case split(Base, "-") of - [_, _|_] = Toks -> - AppName = join(lists:sublist(Toks, length(Toks)-1),"-"), - Ebin3 = filename:join([filename:dirname(Dir), Base ++ Ext, AppName, "ebin"]), + case split_base(Base) of + {AppName,_} -> + Ebin3 = filename:join([BundleDir, Base ++ Ext, + AppName, "ebin"]), [Ebin3, Ebin2, Dir]; _ -> [Ebin2, Dir] end, - try_ebin_dirs(Ebins,BundleDir,Tail,Res,Bundle, Bs) + case try_ebin_dirs(Ebins) of + {ok,FoundEbin} -> + make_path(BundleDir, Tail, [FoundEbin|Res]); + error -> + make_path(BundleDir, Tail, Res) + end end. -try_ebin_dirs([Ebin | Ebins],BundleDir,Tail,Res,Bundle,Bs) -> - case erl_prim_loader:read_file_info(Ebin) of - {ok,#file_info{type=directory}} -> - make_path(BundleDir,Tail,[Ebin|Res],[Bundle|Bs]); - _ -> - try_ebin_dirs(Ebins,BundleDir,Tail,Res,Bundle,Bs) +try_ebin_dirs([Ebin|Ebins]) -> + case is_dir(Ebin) of + true -> {ok,Ebin}; + false -> try_ebin_dirs(Ebins) end; -try_ebin_dirs([],BundleDir,Tail,Res,_Bundle,Bs) -> - make_path(BundleDir,Tail,Res,Bs). +try_ebin_dirs([]) -> + error. %% @@ -609,19 +610,34 @@ exclude(Dir,Path) -> %% %% get_name(Dir) -> - get_name2(get_name1(Dir), []). + get_name_from_splitted(filename:split(Dir)). + +get_name_from_splitted([DirName,"ebin"]) -> + discard_after_hyphen(DirName); +get_name_from_splitted([DirName]) -> + discard_after_hyphen(DirName); +get_name_from_splitted([_|T]) -> + get_name_from_splitted(T); +get_name_from_splitted([]) -> + "". %No name. + +discard_after_hyphen("-"++_) -> + []; +discard_after_hyphen([H|T]) -> + [H|discard_after_hyphen(T)]; +discard_after_hyphen([]) -> + []. -get_name1(Dir) -> - case lists:reverse(filename:split(Dir)) of - ["ebin",DirName|_] -> DirName; - [DirName|_] -> DirName; - _ -> "" % No name ! +split_base(BaseName) -> + case split(BaseName, "-") of + [_, _|_] = Toks -> + Vsn = lists:last(Toks), + AllButLast = lists:droplast(Toks), + {join(AllButLast, "-"),Vsn}; + [_|_] -> + BaseName end. -get_name2([$-|_],Acc) -> lists:reverse(Acc); -get_name2([H|T],Acc) -> get_name2(T,[H|Acc]); -get_name2(_,Acc) -> lists:reverse(Acc). - check_path(Path) -> PathChoice = init:code_path_choice(), ArchiveExt = archive_extension(), @@ -630,23 +646,23 @@ check_path(Path) -> do_check_path([], _PathChoice, _ArchiveExt, Acc) -> {ok, lists:reverse(Acc)}; do_check_path([Dir | Tail], PathChoice, ArchiveExt, Acc) -> - case catch erl_prim_loader:read_file_info(Dir) of - {ok, #file_info{type=directory}} -> + case is_dir(Dir) of + true -> do_check_path(Tail, PathChoice, ArchiveExt, [Dir | Acc]); - _ when PathChoice =:= strict -> + false when PathChoice =:= strict -> %% Be strict. Only use dir as explicitly stated {error, bad_directory}; - _ when PathChoice =:= relaxed -> + false when PathChoice =:= relaxed -> %% Be relaxed case catch lists:reverse(filename:split(Dir)) of {'EXIT', _} -> {error, bad_directory}; ["ebin", App] -> Dir2 = filename:join([App ++ ArchiveExt, App, "ebin"]), - case erl_prim_loader:read_file_info(Dir2) of - {ok, #file_info{type = directory}} -> + case is_dir(Dir2) of + true -> do_check_path(Tail, PathChoice, ArchiveExt, [Dir2 | Acc]); - _ -> + false -> {error, bad_directory} end; ["ebin", App, OptArchive | RevTop] -> @@ -666,10 +682,10 @@ do_check_path([Dir | Tail], PathChoice, ArchiveExt, Acc) -> Top = lists:reverse([OptArchive | RevTop]), filename:join(Top ++ [App ++ ArchiveExt, App, "ebin"]) end, - case erl_prim_loader:read_file_info(Dir2) of - {ok, #file_info{type = directory}} -> + case is_dir(Dir2) of + true -> do_check_path(Tail, PathChoice, ArchiveExt, [Dir2 | Acc]); - _ -> + false -> {error, bad_directory} end; _ -> @@ -768,7 +784,7 @@ init_namedb(Path) -> Db. init_namedb([P|Path], Db) -> - insert_name(P, Db), + insert_dir(P, Db), init_namedb(Path, Db); init_namedb([], _) -> ok. @@ -781,59 +797,39 @@ clear_namedb([], _) -> ok. -endif. -insert_name(Dir, Db) -> - case get_name(Dir) of - Dir -> false; - Name -> insert_name(Name, Dir, Db) - end. +%% Dir must be a complete pathname (not only a name). +insert_dir(Dir, Db) -> + Splitted = filename:split(Dir), + Name = get_name_from_splitted(Splitted), + AppDir = filename:join(del_ebin_1(Splitted)), + do_insert_name(Name, AppDir, Db). insert_name(Name, Dir, Db) -> AppDir = del_ebin(Dir), + do_insert_name(Name, AppDir, Db). + +do_insert_name(Name, AppDir, Db) -> {Base, SubDirs} = archive_subdirs(AppDir), ets:insert(Db, {Name, AppDir, Base, SubDirs}), true. archive_subdirs(AppDir) -> - IsDir = - fun(RelFile) -> - File = filename:join([AppDir, RelFile]), - case erl_prim_loader:read_file_info(File) of - {ok, #file_info{type = directory}} -> - false; - _ -> - true - end - end, - {Base, ArchiveDirs} = all_archive_subdirs(AppDir), - {Base, lists:filter(IsDir, ArchiveDirs)}. - -all_archive_subdirs(AppDir) -> - Ext = archive_extension(), Base = filename:basename(AppDir), - Dirs = - case split(Base, "-") of - [_, _|_] = Toks -> - Base2 = join(lists:sublist(Toks, length(Toks)-1), "-"), - [Base2, Base]; - _ -> - [Base] + Dirs = case split_base(Base) of + {Name, _} -> [Name, Base]; + _ -> [Base] end, + Ext = archive_extension(), try_archive_subdirs(AppDir ++ Ext, Base, Dirs). try_archive_subdirs(Archive, Base, [Dir | Dirs]) -> - ArchiveDir = filename:join([Archive, Dir]), + ArchiveDir = filename:append(Archive, Dir), case erl_prim_loader:list_dir(ArchiveDir) of {ok, Files} -> - IsDir = - fun(RelFile) -> - File = filename:join([ArchiveDir, RelFile]), - case erl_prim_loader:read_file_info(File) of - {ok, #file_info{type = directory}} -> - true; - _ -> - false - end - end, + IsDir = fun(RelFile) -> + File = filename:append(ArchiveDir, RelFile), + is_dir(File) + end, {Dir, lists:filter(IsDir, Files)}; _ -> try_archive_subdirs(Archive, Base, Dirs) @@ -927,22 +923,22 @@ check_pars(Name,Dir) -> end. del_ebin(Dir) -> - case filename:basename(Dir) of - "ebin" -> - Dir2 = filename:dirname(Dir), - Dir3 = filename:dirname(Dir2), - Ext = archive_extension(), - case filename:extension(Dir3) of - E when E =:= Ext -> - %% Strip archive extension - filename:join([filename:dirname(Dir3), - filename:basename(Dir3, Ext)]); - _ -> - Dir2 - end; - _ -> - Dir - end. + filename:join(del_ebin_1(filename:split(Dir))). + +del_ebin_1([Parent,App,"ebin"]) -> + Ext = archive_extension(), + case filename:basename(Parent, Ext) of + Parent -> + %% Plain directory. + [Parent,App]; + Archive -> + %% Archive. + [Archive] + end; +del_ebin_1([H|T]) -> + [H|del_ebin_1(T)]; +del_ebin_1([]) -> + []. replace_name(Dir, Db) -> case get_name(Dir) of @@ -1174,8 +1170,13 @@ mod_to_bin([Dir|Tail], Mod) -> case erl_prim_loader:get_file(File) of error -> mod_to_bin(Tail, Mod); - {ok,Bin,FName} -> - {Mod,Bin,absname(FName)} + {ok,Bin,_} -> + case filename:pathtype(File) of + absolute -> + {Mod,Bin,File}; + _ -> + {Mod,Bin,absname(File)} + end end; mod_to_bin([], Mod) -> %% At last, try also erl_prim_loader's own method @@ -1236,6 +1237,11 @@ do_purge(Mod) -> do_soft_purge(Mod) -> erts_code_purger:soft_purge(Mod). +is_dir(Path) -> + case erl_prim_loader:read_file_info(Path) of + {ok,#file_info{type=directory}} -> true; + _ -> false + end. %%% %%% Loading of multiple modules in parallel. diff --git a/lib/kernel/src/global_group.erl b/lib/kernel/src/global_group.erl index e71f83f9d3..8ac0bd9551 100644 --- a/lib/kernel/src/global_group.erl +++ b/lib/kernel/src/global_group.erl @@ -692,7 +692,7 @@ handle_cast({registered_names, User}, S) -> handle_cast({registered_names_res, Result, Pid, From}, S) -> % io:format(">>>>> registered_names_res Result ~p~n",[Result]), unlink(Pid), - exit(Pid, normal), + Pid ! kill, Wait = get(registered_names), NewWait = lists:delete({Pid, From},Wait), put(registered_names, NewWait), @@ -718,7 +718,7 @@ handle_cast({send_res, Result, Name, Msg, Pid, From}, S) -> ToPid ! Msg end, unlink(Pid), - exit(Pid, normal), + Pid ! kill, Wait = get(send), NewWait = lists:delete({Pid, From, Name, Msg},Wait), put(send, NewWait), @@ -748,7 +748,7 @@ handle_cast({find_name_res, Result, Pid, From}, S) -> % io:format(">>>>> find_name_res Result ~p~n",[Result]), % io:format(">>>>> find_name_res get() ~p~n",[get()]), unlink(Pid), - exit(Pid, normal), + Pid ! kill, Wait = get(whereis_name), NewWait = lists:delete({Pid, From},Wait), put(whereis_name, NewWait), diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl index d5c5205dbc..465cec1b45 100644 --- a/lib/kernel/src/inet_db.erl +++ b/lib/kernel/src/inet_db.erl @@ -1206,7 +1206,8 @@ handle_set_file(Option, Fname, TagTm, TagInfo, ParseFun, From, File = filename:flatten(Fname), ets:insert(Db, {res_optname(Option), File}), ets:insert(Db, {TagInfo, undefined}), - ets:insert(Db, {TagTm, 0}), + TimeZero = - (?RES_FILE_UPDATE_TM + 1), % Early enough + ets:insert(Db, {TagTm, TimeZero}), {reply,ok,State}; true -> File = filename:flatten(Fname), diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl index 01ac024c88..cc0c10909b 100644 --- a/lib/kernel/src/seq_trace.erl +++ b/lib/kernel/src/seq_trace.erl @@ -106,14 +106,24 @@ reset_trace() -> %% reset_trace(Pid) -> % this might be a useful function too --type tracer() :: (Pid :: pid()) | port() | 'false'. +-type tracer() :: (Pid :: pid()) | port() | + (TracerModule :: {module(), term()}) | + 'false'. -spec set_system_tracer(Tracer) -> OldTracer when Tracer :: tracer(), OldTracer :: tracer(). -set_system_tracer(Pid) -> - erlang:system_flag(sequential_tracer, Pid). +set_system_tracer({Module, State} = Tracer) -> + case erlang:module_loaded(Module) of + false -> + Module:enabled(trace_status, erlang:self(), State); + true -> + ok + end, + erlang:system_flag(sequential_tracer, Tracer); +set_system_tracer(Tracer) -> + erlang:system_flag(sequential_tracer, Tracer). -spec get_system_tracer() -> Tracer when Tracer :: tracer(). diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 7f9718a354..383eab94fe 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -1023,6 +1023,12 @@ do_code_archive(Config, Root, StripVsn) when is_list(Config) -> {ok, _} = zip:create(Archive, [Base], [{compress, []}, {cwd, PrivDir}]), + %% Create a directory and a file outside of the archive. + OtherFile = filename:join([RootDir,VsnBase,"other","other.txt"]), + OtherContents = ?MODULE:module_info(md5), + filelib:ensure_dir(OtherFile), + ok = file:write_file(OtherFile, OtherContents), + %% Set up ERL_LIBS and start a slave node. {ok, Node} = test_server:start_node(code_archive, slave, @@ -1037,13 +1043,25 @@ do_code_archive(Config, Root, StripVsn) when is_list(Config) -> %% Start the app ok = rpc:call(Node, application, start, [App]), + %% Get the lib dir for the app. + AppLibDir = rpc:call(Node, code, lib_dir, [App]), + io:format("AppLibDir: ~p\n", [AppLibDir]), + AppLibDir = filename:join(RootDir, VsnBase), + %% Access the app priv dir AppPrivDir = rpc:call(Node, code, priv_dir, [App]), AppPrivFile = filename:join([AppPrivDir, "code_archive.txt"]), io:format("AppPrivFile: ~p\n", [AppPrivFile]), - {ok, _Bin, _Path} = + {ok, _Bin, _} = rpc:call(Node, erl_prim_loader, get_file, [AppPrivFile]), + %% Read back the other text file. + OtherDirPath = rpc:call(Node, code, lib_dir, [App,other]), + OtherFilePath = filename:join(OtherDirPath, "other.txt"), + io:format("OtherFilePath: ~p\n", [OtherFilePath]), + {ok, OtherContents, _} = + rpc:call(Node, erl_prim_loader, get_file, [OtherFilePath]), + %% Use the app Tab = code_archive_tab, Key = foo, diff --git a/lib/kernel/test/global_group_SUITE.erl b/lib/kernel/test/global_group_SUITE.erl index 06a5b7fcfe..594ee6b537 100644 --- a/lib/kernel/test/global_group_SUITE.erl +++ b/lib/kernel/test/global_group_SUITE.erl @@ -1153,6 +1153,16 @@ test_exit(Config) when is_list(Config) -> rpc:call(Cp1, global_group, send, [king, "The message"]), undefined = rpc:call(Cp1, global_group, whereis_name, [king]), + % make sure the search process really exits after every global_group operations + ProcessCount0 = rpc:call(Cp1, erlang, system_info, [process_count]), + _ = rpc:call(Cp1, global_group, whereis_name, [{node, Cp1nn}, whatever_pid_name]), + ProcessCount1 = rpc:call(Cp1, erlang, system_info, [process_count]), + _ = rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}]), + ProcessCount2 = rpc:call(Cp1, erlang, system_info, [process_count]), + _ = rpc:call(Cp1, global_group, send, [{node, Cp1nn}, whatever_pid_name, msg]), + ProcessCount3 = rpc:call(Cp1, erlang, system_info, [process_count]), + ProcessCount0 = ProcessCount1 = ProcessCount2 = ProcessCount3, + %% stop the nodes, and make sure names are released. stop_node(Cp1), stop_node(Cp2), diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl index 0a03503163..000994751f 100644 --- a/lib/kernel/test/seq_trace_SUITE.erl +++ b/lib/kernel/test/seq_trace_SUITE.erl @@ -787,7 +787,6 @@ start_tracer() -> seq_trace:set_system_tracer(Pid), Pid. - set_token_flags([]) -> ok; set_token_flags([no_timestamp|Flags]) -> @@ -836,7 +835,7 @@ check_ts(strict_monotonic_timestamp, Ts) -> ct:fail({unexpected_timestamp, Ts}) end, ok. - + start_node(Name, Param) -> test_server:start_node(Name, slave, [{args, Param}]). diff --git a/lib/mnesia/test/mnesia_config_test.erl b/lib/mnesia/test/mnesia_config_test.erl index a31c9b1f4f..204b8fa394 100644 --- a/lib/mnesia/test/mnesia_config_test.erl +++ b/lib/mnesia/test/mnesia_config_test.erl @@ -693,9 +693,9 @@ event_module(Config) when is_list(Config) -> end, ?match({[ok, ok], []}, rpc:multicall(Nodes, mnesia, start, [Def])), - receive after 1000 -> ok end, + receive after 2000 -> ok end, mnesia_event ! {get_log, self()}, - DebugLog1 = receive + DebugLog1 = receive {log, L1} -> L1 after 10000 -> [timeout] end, @@ -706,9 +706,9 @@ event_module(Config) when is_list(Config) -> ?match({[ok], []}, rpc:multicall([N2], mnesia, start, [])), - receive after 1000 -> ok end, + receive after 2000 -> ok end, mnesia_event ! {get_log, self()}, - DebugLog = receive + DebugLog = receive {log, L} -> L after 10000 -> [timeout] end, diff --git a/lib/mnesia/test/mnesia_consistency_test.erl b/lib/mnesia/test/mnesia_consistency_test.erl index 6c3e68ba38..9cc84de87b 100644 --- a/lib/mnesia/test/mnesia_consistency_test.erl +++ b/lib/mnesia/test/mnesia_consistency_test.erl @@ -565,6 +565,7 @@ consistency_after_fallback_3_disc_only(Config) when is_list(Config) -> consistency_after_fallback(disc_only_copies, 3, Config). consistency_after_fallback(ReplicaType, NodeConfig, Config) -> + put(mnesia_test_verbose, true), %%?verbose("Starting consistency_after_fallback2 at ~p~n", [self()]), Delay = 5, Nodes = ?acquire_nodes(NodeConfig, [{tc_timeout, timer:minutes(10)} | Config]), @@ -594,10 +595,11 @@ consistency_after_fallback(ReplicaType, NodeConfig, Config) -> ?match(ok, mnesia_tpcb:verify_tabs()), %% Stop and then start mnesia and check table consistency - %%?verbose("Restarting Mnesia~n", []), + ?verbose("Kill Mnesia~n", []), mnesia_test_lib:kill_mnesia(Nodes), + ?verbose("Start Mnesia~n", []), mnesia_test_lib:start_mnesia(Nodes,[account,branch,teller,history]), - + ?verbose("Verify tabs~n", []), ?match(ok, mnesia_tpcb:verify_tabs()), if ReplicaType == ram_copies -> diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl index d37623d1cc..220276ac0c 100644 --- a/lib/observer/src/observer_alloc_wx.erl +++ b/lib/observer/src/observer_alloc_wx.erl @@ -250,7 +250,6 @@ sum_alloc_one_instance([],BS,CS,TotalBS,TotalCS) -> create_mem_info(Parent) -> Panel = wxPanel:new(Parent), - wxWindow:setBackgroundColour(Panel, {255,255,255}), Style = ?wxLC_REPORT bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES bor ?wxLC_VRULES, Grid = wxListCtrl:new(Panel, [{style, Style}]), Li = wxListItem:new(), diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index f0b8a004ec..5d5ac37ce9 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -122,7 +122,7 @@ display_yes_no_dialog(Str) -> %% display_info(Parent, [{Title, [{Label, Info}]}]) -> {Panel, Sizer, InfoFieldsToUpdate} display_info(Frame, Info) -> Panel = wxPanel:new(Frame), - wxWindow:setBackgroundColour(Panel, {255,255,255}), + wxWindow:setBackgroundStyle(Panel, ?wxBG_STYLE_SYSTEM), Sizer = wxBoxSizer:new(?wxVERTICAL), wxSizer:addSpacer(Sizer, 5), Add = fun(BoxInfo) -> @@ -201,22 +201,21 @@ update_info2([Scroll = {_, _, _}|Fs], [{_, NewInfo}|Rest]) -> update_scroll_boxes(Scroll, NewInfo), update_info2(Fs, Rest); update_info2([Field|Fs], [{_Str, {click, Value}}|Rest]) -> - wxTextCtrl:setValue(Field, to_str(Value)), + wxStaticText:setLabel(Field, to_str(Value)), update_info2(Fs, Rest); update_info2([Field|Fs], [{_Str, Value}|Rest]) -> - wxTextCtrl:setValue(Field, to_str(Value)), + wxStaticText:setLabel(Field, to_str(Value)), update_info2(Fs, Rest); update_info2([Field|Fs], [undefined|Rest]) -> - wxTextCtrl:setValue(Field, ""), + wxStaticText:setLabel(Field, ""), update_info2(Fs, Rest); update_info2([], []) -> ok. update_scroll_boxes({_, _, 0}, {_, []}) -> ok; update_scroll_boxes({Win, Sizer, _}, {Type, List}) -> [wxSizerItem:deleteWindows(Child) || Child <- wxSizer:getChildren(Sizer)], - BC = wxWindow:getBackgroundColour(Win), Cursor = wxCursor:new(?wxCURSOR_HAND), - add_entries(Type, List, Win, Sizer, BC, Cursor), + add_entries(Type, List, Win, Sizer, Cursor), wxCursor:destroy(Cursor), wxSizer:recalcSizes(Sizer), wxWindow:refresh(Win), @@ -379,25 +378,22 @@ add_box(Panel, OuterBox, Cursor, Title, Proportion, {Format, List}) -> wxScrolledWindow:setScrollbars(Scroll,1,1,0,0), ScrollSizer = wxBoxSizer:new(?wxVERTICAL), wxScrolledWindow:setSizer(Scroll, ScrollSizer), - BC = wxWindow:getBackgroundColour(Panel), - wxWindow:setBackgroundColour(Scroll,BC), - add_entries(Format, List, Scroll, ScrollSizer, BC, Cursor), + wxWindow:setBackgroundStyle(Scroll, ?wxBG_STYLE_SYSTEM), + add_entries(Format, List, Scroll, ScrollSizer, Cursor), wxSizer:add(Box,Scroll,[{proportion,1},{flag,?wxEXPAND}]), wxSizer:add(OuterBox,Box,[{proportion,Proportion},{flag,?wxEXPAND}]), {Scroll,ScrollSizer,length(List)}. -add_entries(click, List, Scroll, ScrollSizer, BC, Cursor) -> +add_entries(click, List, Scroll, ScrollSizer, Cursor) -> Add = fun(Link) -> TC = link_entry(Scroll, Link, Cursor), - wxWindow:setBackgroundColour(TC,BC), - wxSizer:add(ScrollSizer,TC,[{flag,?wxEXPAND}]) + wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM), + wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}]) end, [Add(Link) || Link <- List]; -add_entries(plain, List, Scroll, ScrollSizer, _, _) -> +add_entries(plain, List, Scroll, ScrollSizer, _) -> Add = fun(String) -> - TC = wxTextCtrl:new(Scroll, ?wxID_ANY, - [{style,?SINGLE_LINE_STYLE}, - {value,String}]), + TC = wxStaticText:new(Scroll, ?wxID_ANY, String), wxSizer:add(ScrollSizer,TC,[{flag,?wxEXPAND}]) end, [Add(String) || String <- List]. @@ -435,51 +431,44 @@ create_box(Panel, {scroll_boxes,Data}) -> wxSizer:layout(OuterBox), {OuterBox, Boxes}; -create_box(Panel, Data) -> +create_box(Parent, Data) -> {Title, Align, Info} = get_box_info(Data), - Box = wxStaticBoxSizer:new(?wxVERTICAL, Panel, [{label, Title}]), - LeftSize = get_max_size(Panel,Info), - LeftProportion = [{proportion,0}], - RightProportion = [{proportion,1}, {flag, Align bor ?wxEXPAND}], + Top = wxStaticBoxSizer:new(?wxVERTICAL, Parent, [{label, Title}]), + Panel = wxPanel:new(Parent), + Box = wxBoxSizer:new(?wxVERTICAL), + LeftSize = get_max_width(Panel,Info), + RightProportion = [{flag, Align bor ?wxEXPAND}], AddRow = fun({Desc0, Value0}) -> Desc = Desc0++":", Line = wxBoxSizer:new(?wxHORIZONTAL), - wxSizer:add(Line, - wxTextCtrl:new(Panel, ?wxID_ANY, - [{style,?SINGLE_LINE_STYLE}, - {size,LeftSize}, - {value,Desc}]), - LeftProportion), + Label = wxStaticText:new(Panel, ?wxID_ANY, Desc), + wxSizer:add(Line, 5, 0), + wxSizer:add(Line, Label), + wxSizer:setItemMinSize(Line, Label, LeftSize, -1), Field = case Value0 of {click,"unknown"} -> - wxTextCtrl:new(Panel, ?wxID_ANY, - [{style,?SINGLE_LINE_STYLE}, - {value,"unknown"}]); + wxStaticText:new(Panel, ?wxID_ANY,"unknown"); {click,Value} -> link_entry(Panel,Value); _ -> Value = to_str(Value0), - TCtrl = wxTextCtrl:new(Panel, ?wxID_ANY, - [{style,?SINGLE_LINE_STYLE}, - {value,Value}]), + TCtrl = wxStaticText:new(Panel, ?wxID_ANY,Value), length(Value) > 50 andalso wxWindow:setToolTip(TCtrl,wxToolTip:new(Value)), TCtrl end, wxSizer:add(Line, 10, 0), % space of size 10 horisontally wxSizer:add(Line, Field, RightProportion), - - {_,H,_,_} = wxTextCtrl:getTextExtent(Field,"Wj"), - wxTextCtrl:setMinSize(Field,{0,H}), - - wxSizer:add(Box, Line, [{proportion,0},{flag,?wxEXPAND}]), + wxSizer:add(Box, Line, [{proportion,1},{flag,?wxEXPAND}]), Field; (undefined) -> undefined end, InfoFields = [AddRow(Entry) || Entry <- Info], - {Box, InfoFields}. + wxWindow:setSizer(Panel, Box), + wxSizer:add(Top, Panel, [{proportion,1},{flag,?wxEXPAND}]), + {Top, InfoFields}. link_entry(Panel, Link) -> Cursor = wxCursor:new(?wxCURSOR_HAND), @@ -490,13 +479,12 @@ link_entry(Panel, Link, Cursor) -> link_entry2(Panel, to_link(Link), Cursor). link_entry2(Panel,{Target,Str},Cursor) -> - TC = wxTextCtrl:new(Panel, ?wxID_ANY, [{style, ?SINGLE_LINE_STYLE}]), - wxTextCtrl:setForegroundColour(TC,?wxBLUE), - wxTextCtrl:appendText(TC, Str), + TC = wxStaticText:new(Panel, ?wxID_ANY, Str), + wxWindow:setForegroundColour(TC,?wxBLUE), wxWindow:setCursor(TC, Cursor), - wxTextCtrl:connect(TC, left_down, [{userData,Target}]), - wxTextCtrl:connect(TC, enter_window), - wxTextCtrl:connect(TC, leave_window), + wxWindow:connect(TC, left_down, [{userData,Target}]), + wxWindow:connect(TC, enter_window), + wxWindow:connect(TC, leave_window), ToolTip = wxToolTip:new("Click to see properties for " ++ Str), wxWindow:setToolTip(TC, ToolTip), TC. @@ -521,23 +509,12 @@ html_window(Panel, Html) -> wxHtmlWindow:setPage(Win, Html), Win. -get_max_size(Panel,Info) -> - Txt = wxTextCtrl:new(Panel, ?wxID_ANY, []), - Size = get_max_size(Txt,Info,0,0), - wxTextCtrl:destroy(Txt), - Size. - -get_max_size(Txt,[{Desc,_}|Info],MaxX,MaxY) -> - {X,Y,_,_} = wxTextCtrl:getTextExtent(Txt,Desc++":"), - if X>MaxX -> - get_max_size(Txt,Info,X,Y); - true -> - get_max_size(Txt,Info,MaxX,MaxY) - end; -get_max_size(Txt,[undefined|Info],MaxX,MaxY) -> - get_max_size(Txt,Info,MaxX,MaxY); -get_max_size(_,[],X,_Y) -> - {X+2,-1}. +get_max_width(Parent,Info) -> + lists:foldl(fun({Desc,_}, Max) -> + {W, _, _, _} = wxWindow:getTextExtent(Parent, Desc), + max(W,Max); + (_, Max) -> Max + end, 0, Info). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% set_listctrl_col_size(LCtrl, Total) -> diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl index 017f07d2c4..45af08026a 100644 --- a/lib/observer/src/observer_perf_wx.erl +++ b/lib/observer/src/observer_perf_wx.erl @@ -100,7 +100,7 @@ setup_graph_drawing(Panels) -> IsWindows = element(1, os:type()) =:= win32, IgnoreCB = {callback, fun(_,_) -> ok end}, Do = fun(#win{panel=Panel}) -> - wxWindow:setBackgroundColour(Panel, ?wxWHITE), + wxWindow:setBackgroundStyle(Panel, ?wxBG_STYLE_SYSTEM), wxPanel:connect(Panel, paint, [callback]), IsWindows andalso wxPanel:connect(Panel, erase_background, [IgnoreCB]) diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 9d6aa84384..cff5fbb474 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -125,11 +125,11 @@ handle_event(#wx{event=#wxMouse{type=left_down}, userData=TargetPid}, State) -> {noreply, State}; handle_event(#wx{obj=Obj, event=#wxMouse{type=enter_window}}, State) -> - wxTextCtrl:setForegroundColour(Obj,{0,0,100,255}), + wxStaticText:setForegroundColour(Obj,{0,0,100,255}), {noreply, State}; handle_event(#wx{obj=Obj, event=#wxMouse{type=leave_window}}, State) -> - wxTextCtrl:setForegroundColour(Obj,?wxBLUE), + wxStaticText:setForegroundColour(Obj,?wxBLUE), {noreply, State}; handle_event(#wx{event=#wxHtmlLink{linkInfo=#wxHtmlLinkInfo{href=Href}}}, diff --git a/lib/observer/src/ttb.erl b/lib/observer/src/ttb.erl index c60c0385b8..4d6eb3ba8d 100644 --- a/lib/observer/src/ttb.erl +++ b/lib/observer/src/ttb.erl @@ -434,7 +434,9 @@ procs(Procs) when is_list(Procs) -> procs(Proc) -> proc(Proc). -proc(Procs) when Procs=:=all; Procs=:=existing; Procs=:=new -> +proc(Procs) when Procs=:=all; Procs=:=ports; Procs=:=processes; + Procs=:=existing; Procs=:=existing_ports; Procs=:=existing_processes; + Procs=:=new; Procs=:=new_ports; Procs=:=new_processes -> [Procs]; proc(Name) when is_atom(Name) -> [Name]; % can be registered on this node or other node diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl index 499cdb3fc8..c06ec21f36 100644 --- a/lib/observer/test/ttb_SUITE.erl +++ b/lib/observer/test/ttb_SUITE.erl @@ -819,6 +819,7 @@ myhandler(_Fd,Trace,_,Relay) -> simple_call_handler() -> {fun(A, {trace_ts, _, call, _, _} ,_,_) -> io:format(A, "ok.~n", []); + (A, {drop, N}, _, _) -> io:format(A, "{drop, ~p}.", [N]); (_, end_of_trace, _, _) -> ok end, []}. marking_call_handler() -> @@ -954,17 +955,24 @@ begin_trace_local(ServerNode, ClientNode, Dest) -> ?line ttb:tpl(client, get, []). check_size(N, Dest, Output, ServerNode, ClientNode) -> - ?line begin_trace(ServerNode, ClientNode, Dest), - ?line case Dest of + begin_trace(ServerNode, ClientNode, Dest), + case Dest of {local, _} -> - ?line ttb_helper:msgs_ip(N); + ttb_helper:msgs_ip(N); _ -> - ?line ttb_helper:msgs(N) + ttb_helper:msgs(N) end, - ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), - ?line ttb:format(D, [{out, Output}, {handler, simple_call_handler()}]), - ?line {ok, Ret} = file:consult(Output), - ?line true = (N + 1 == length(Ret)). + {_, D} = ttb:stop([fetch, return_fetch_dir]), + ttb:format(D, [{out, Output}, {handler, simple_call_handler()}]), + {ok, Ret} = file:consult(Output), + check_output(N+1, Ret). + +check_output(Expected, Ret) + when length(Ret) =:= Expected -> ok; +check_output(Expected, Ret) -> + io:format("~p~n",[Ret]), + io:format("Expected ~p got ~p ~n",[Expected, length(Ret)]), + Expected = length(Ret). fetch_when_no_option_given(suite) -> []; @@ -1166,8 +1174,8 @@ changing_cwd_on_control_node(Config) when is_list(Config) -> ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), ?line {ok, Ret} = file:consult(?OUTPUT), - ?line true = (2*(NumMsgs + 1) == length(Ret)), - ?line ok = file:set_cwd(OldDir). + check_output(2*(NumMsgs + 1),Ret), + ok = file:set_cwd(OldDir). changing_cwd_on_control_node(cleanup,_Config) -> ?line stop_client_and_server(). @@ -1176,18 +1184,19 @@ changing_cwd_on_control_node_with_local_trace(suite) -> changing_cwd_on_control_node_with_local_trace(doc) -> ["Changing cwd on control node during local tracing is safe"]; changing_cwd_on_control_node_with_local_trace(Config) when is_list(Config) -> - ?line {ok, OldDir} = file:get_cwd(), - ?line {ServerNode, ClientNode} = start_client_and_server(), - ?line begin_trace(ServerNode, ClientNode, {local, ?FNAME}), - ?line NumMsgs = 3, - ?line ttb_helper:msgs_ip(NumMsgs), - ?line ok = file:set_cwd(".."), - ?line ttb_helper:msgs_ip(NumMsgs), - ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), - ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), - ?line {ok, Ret} = file:consult(?OUTPUT), - ?line true = (2*(NumMsgs + 1) == length(Ret)), - ?line ok = file:set_cwd(OldDir). + {ok, OldDir} = file:get_cwd(), + {ServerNode, ClientNode} = start_client_and_server(), + begin_trace(ServerNode, ClientNode, {local, ?FNAME}), + NumMsgs = 3, + ttb_helper:msgs_ip(NumMsgs), + ok = file:set_cwd(".."), + ttb_helper:msgs_ip(NumMsgs), + {_, D} = ttb:stop([fetch, return_fetch_dir]), + ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), + {ok, Ret} = file:consult(?OUTPUT), + Expected = 2*(NumMsgs + 1), + check_output(Expected, Ret), + ok = file:set_cwd(OldDir). changing_cwd_on_control_node_with_local_trace(cleanup,_Config) -> ?line stop_client_and_server(). @@ -1205,7 +1214,7 @@ changing_cwd_on_remote_node(Config) when is_list(Config) -> ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), ?line {ok, Ret} = file:consult(?OUTPUT), - ?line true = (2*(NumMsgs + 1) == length(Ret)). + check_output(2*(NumMsgs + 1),Ret). changing_cwd_on_remote_node(cleanup,_Config) -> ?line stop_client_and_server(). @@ -1497,7 +1506,7 @@ logic(N, M, TracingType) -> ct:log("formatted ~p",[{D,?OUTPUT}]), ?line {ok, Ret} = file:consult(?OUTPUT), ct:log("consulted: ~p",[Ret]), - ?line M = length(Ret). + check_output(M,Ret). begin_trace_with_resume(ServerNode, ClientNode, Dest) -> ?line {ok, _} = ttb:tracer([ServerNode,ClientNode], [{file, Dest}, resume]), diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl index 0045b2c09f..5664615230 100644 --- a/lib/os_mon/src/cpu_sup.erl +++ b/lib/os_mon/src/cpu_sup.erl @@ -68,7 +68,7 @@ -type util_cpus() :: 'all' | integer() | [integer()]. -type util_state() :: 'user' | 'nice_user' | 'kernel' | 'wait' | 'idle'. --type util_value() :: {util_state(), float()} | float(). +-type util_value() :: [{util_state(), float()}] | float(). -type util_desc() :: {util_cpus(), util_value(), util_value(), []}. %%---------------------------------------------------------------------- diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 6923066da7..04daee460f 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -118,7 +118,7 @@ <p><c> not_encrypted | cipher_info()}</c></p></item> <tag><c>cipher_info() = </c></tag> - <item><p><c>{"RC2-CBC" | "DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)</c></p> + <item><p><c>{"RC2-CBC" | "DES-CBC" | "DES-EDE3-CBC", crypto:strong_rand_bytes(8)</c></p> <p><c>| {#'PBEParameter{}, digest_type()} | #'PBES2-params'{}}</c></p> </item> diff --git a/lib/public_key/doc/src/using_public_key.xml b/lib/public_key/doc/src/using_public_key.xml index 86808adbea..e3a1eed4be 100644 --- a/lib/public_key/doc/src/using_public_key.xml +++ b/lib/public_key/doc/src/using_public_key.xml @@ -124,7 +124,7 @@ ...>>, not_encrypted}, {'Certificate',<<48,130,3,200,48,130,3,49,160,3,2,1,2,2,1, - 1,48,13,6,9,42,134,72,134,247,...>>>, + 1,48,13,6,9,42,134,72,134,247,...>>, not_encrypted}]</code> <p>Certificates can be decoded as usual:</p> diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index be1a4472e9..51050c4480 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -199,7 +199,7 @@ encrypted_pem(Config) when is_list(Config) -> RSAKey = public_key:der_decode('RSAPrivateKey', DerRSAKey), - Salt0 = crypto:rand_bytes(8), + Salt0 = crypto:strong_rand_bytes(8), Entry0 = public_key:pem_entry_encode('RSAPrivateKey', RSAKey, {{"DES-EDE3-CBC", Salt0}, "1234abcd"}), RSAKey = public_key:pem_entry_decode(Entry0,"1234abcd"), @@ -208,7 +208,7 @@ encrypted_pem(Config) when is_list(Config) -> [{'RSAPrivateKey', _, {"DES-EDE3-CBC", Salt0}}] = erl_make_certs:pem_to_der(Des3KeyFile), - Salt1 = crypto:rand_bytes(8), + Salt1 = crypto:strong_rand_bytes(8), Entry1 = public_key:pem_entry_encode('RSAPrivateKey', RSAKey, {{"DES-CBC", Salt1}, "4567efgh"}), DesKeyFile = filename:join(Datadir, "des_client_key.pem"), diff --git a/lib/runtime_tools/c_src/Makefile.in b/lib/runtime_tools/c_src/Makefile.in index 58c12e0d88..4530a83aee 100644 --- a/lib/runtime_tools/c_src/Makefile.in +++ b/lib/runtime_tools/c_src/Makefile.in @@ -33,21 +33,18 @@ VSN=$(RUNTIME_TOOLS_VSN) # be set for that system only. # ---------------------------------------------------- CC = $(DED_CC) -CFLAGS = $(DED_CFLAGS) +CFLAGS = $(DED_CFLAGS) -I./ LD = $(DED_LD) SHELL = /bin/sh LIBS = $(DED_LIBS) LDFLAGS += $(DED_LDFLAGS) -DTRACE_LIBNAME = dyntrace +TRACE_LIBNAME = dyntrace trace_file_drv trace_ip_drv SYSINCLUDE = $(DED_SYS_INCLUDE) TRACE_DRV_INCLUDES = $(SYSINCLUDE) -ALL_CFLAGS = $(CFLAGS) @DEFS@ $(TYPE_FLAGS) $(TRACE_DRV_INCLUDES) \ - -I$(OBJDIR) -I$(ERL_TOP)/erts/emulator/$(TARGET) - ifeq ($(TYPE),debug) TYPEMARKER = .debug TYPE_FLAGS = $(subst -O3,,$(subst -O2,,$(CFLAGS))) -DDEBUG @DEBUG_FLAGS@ @@ -61,6 +58,9 @@ TYPE_FLAGS = $(CFLAGS) endif endif +ALL_CFLAGS = @DEFS@ $(TYPE_FLAGS) $(TRACE_DRV_INCLUDES) \ + -I$(OBJDIR) -I$(ERL_TOP)/erts/emulator/$(TARGET) + ROOTDIR = $(ERL_TOP)/lib PRIVDIR = ../priv LIBDIR = $(PRIVDIR)/lib/$(TARGET) @@ -74,37 +74,16 @@ RELSYSDIR = $(RELEASE_PATH)/lib/runtime_tools-$(VSN) # ---------------------------------------------------- # Misc Macros # ---------------------------------------------------- -before_DTrace_OBJS = $(OBJDIR)/dyntrace$(TYPEMARKER).o -## NIF_MAKEFILE = $(PRIVDIR)/Makefile -# Higher-level makefiles says that we can only compile on UNIX flavors -NIF_LIB = $(LIBDIR)/dyntrace$(TYPEMARKER).@DED_EXT@ +TRACE_LIBS = $(foreach LIB, $(TRACE_LIBNAME), $(LIBDIR)/$(LIB)$(TYPEMARKER).@DED_EXT@) -ifeq ($(HOST_OS),) -HOST_OS := $(shell $(ERL_TOP)/erts/autoconf/config.guess) -endif - -TRACE_IP_DRV_OBJS = \ - $(OBJDIR)/trace_ip_drv.o - -TRACE_FILE_DRV_OBJS = \ - $(OBJDIR)/trace_file_drv.o - -ifeq ($(findstring win32,$(TARGET)), win32) -SOLIBS = $(LIBDIR)/trace_ip_drv.dll $(LIBDIR)/trace_file_drv.dll -LN=cp -else -SOLIBS = $(LIBDIR)/trace_ip_drv.so $(LIBDIR)/trace_file_drv.so -endif # ---------------------------------------------------- # Targets # ---------------------------------------------------- _create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) -debug opt valgrind: $(SOLIBS) $(OBJDIR) $(LIBDIR) $(NIF_LIB) - -DYNTRACE_OBJS = $(before_DTrace_OBJS) +debug opt valgrind: $(SOLIBS) $(OBJDIR) $(LIBDIR) $(TRACE_LIBS) $(OBJDIR): -@mkdir -p $(OBJDIR) @@ -112,50 +91,26 @@ $(OBJDIR): $(LIBDIR): -@mkdir -p $(LIBDIR) -$(OBJDIR)/dyntrace$(TYPEMARKER).o: dyntrace.c - $(V_at)$(INSTALL_DIR) $(OBJDIR) - $(V_CC) -c -o $@ $(ALL_CFLAGS) $< - -$(NIF_LIB): $(DYNTRACE_OBJS) - $(V_at)$(INSTALL_DIR) $(LIBDIR) - $(V_LD) $(LDFLAGS) -o $@ $^ $(LDLIBS) - -$(OBJDIR)/%.o: %.c +$(OBJDIR)/%$(TYPEMARKER).o: %.c dyntrace_lttng.h $(V_CC) -c -o $@ $(ALL_CFLAGS) $< -$(LIBDIR)/trace_ip_drv.so: $(TRACE_IP_DRV_OBJS) - $(V_LD) $(LDFLAGS) -o $@ $^ -lc $(LIBS) - -$(LIBDIR)/trace_file_drv.so: $(TRACE_FILE_DRV_OBJS) - $(V_LD) $(LDFLAGS) -o $@ $^ -lc $(LIBS) - -$(LIBDIR)/trace_ip_drv.dll: $(TRACE_IP_DRV_OBJS) - $(V_LD) $(LDFLAGS) -o $@ $^ $(LIBS) -$(LIBDIR)/trace_file_drv.dll: $(TRACE_FILE_DRV_OBJS) +$(LIBDIR)/%$(TYPEMARKER).@DED_EXT@: $(OBJDIR)/%$(TYPEMARKER).o $(V_LD) $(LDFLAGS) -o $@ $^ $(LIBS) clean: - rm -f $(SOLIBS) $(TRACE_IP_DRV_OBJS) $(TRACE_FILE_DRV_OBJS) - rm -f $(LIBDIR)/dyntrace.@DED_EXT@ - rm -f $(LIBDIR)/dyntrace.debug.@DED_EXT@ - rm -f $(LIBDIR)/dyntrace.valgrind.@DED_EXT@ - rm -f $(OBJDIR)/dyntrace.o - rm -f $(OBJDIR)/dyntrace.debug.o - rm -f $(OBJDIR)/dyntrace.valgrind.o + rm -f $(TRACE_LIBS) rm -f core *~ docs: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/priv/obj" $(INSTALL_DIR) "$(RELSYSDIR)/priv/lib" - $(INSTALL_PROGRAM) $(DYNTRACE_OBJS) "$(RELSYSDIR)/priv/obj" - $(INSTALL_PROGRAM) $(NIF_LIB) $(SOLIBS) "$(RELSYSDIR)/priv/lib" + $(INSTALL_PROGRAM) $(TRACE_LIBS) "$(RELSYSDIR)/priv/lib" release_docs_spec: diff --git a/lib/runtime_tools/c_src/dyntrace.c b/lib/runtime_tools/c_src/dyntrace.c index 0ef8eaf4d3..0178d95efb 100644 --- a/lib/runtime_tools/c_src/dyntrace.c +++ b/lib/runtime_tools/c_src/dyntrace.c @@ -29,7 +29,13 @@ #include "sys.h" #include "dtrace-wrapper.h" #if defined(USE_DYNAMIC_TRACE) && (defined(USE_DTRACE) || defined(USE_SYSTEMTAP)) -#define HAVE_USE_DTRACE 1 +# define HAVE_USE_DTRACE 1 +#endif +#if defined(USE_LTTNG) +# define HAVE_USE_LTTNG 1 +# define TRACEPOINT_DEFINE +# define TRACEPOINT_CREATE_PROBES +# include "dyntrace_lttng.h" #endif void dtrace_nifenv_str(ErlNifEnv *env, char *process_buf); @@ -60,11 +66,56 @@ static ERL_NIF_TERM user_trace_s1(ErlNifEnv* env, int argc, const ERL_NIF_TERM a static ERL_NIF_TERM user_trace_i4s4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM user_trace_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +#ifdef HAVE_USE_LTTNG +static ERL_NIF_TERM trace_procs(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_ports(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_running_procs(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_running_ports(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_call(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_send(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_receive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_garbage_collection(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ERL_NIF_TERM enabled_procs(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_ports(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_running_procs(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_running_ports(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_call(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_send(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_receive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_garbage_collection(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +#endif + + static ErlNifFunc nif_funcs[] = { {"available", 0, available}, {"user_trace_s1", 1, user_trace_s1}, {"user_trace_i4s4", 9, user_trace_i4s4}, - {"user_trace_n", 10, user_trace_n} + {"user_trace_n", 10, user_trace_n}, +#ifdef HAVE_USE_LTTNG + {"trace_procs", 6, trace_procs}, + {"trace_ports", 6, trace_ports}, + {"trace_running_procs", 6, trace_running_procs}, + {"trace_running_ports", 6, trace_running_ports}, + {"trace_call", 6, trace_call}, + {"trace_send", 6, trace_send}, + {"trace_receive", 6, trace_receive}, + {"trace_garbage_collection", 6, trace_garbage_collection}, + {"enabled_procs", 3, enabled_procs}, + {"enabled_ports", 3, enabled_ports}, + {"enabled_running_procs", 3, enabled_running_procs}, + {"enabled_running_ports", 3, enabled_running_ports}, + {"enabled_call", 3, enabled_call}, + {"enabled_send", 3, enabled_send}, + {"enabled_receive", 3, enabled_receive}, + {"enabled_garbage_collection", 3, enabled_garbage_collection}, +#endif + {"enabled", 3, enabled}, + {"trace", 5, trace}, + {"trace", 6, trace} }; ERL_NIF_INIT(dyntrace, nif_funcs, load, NULL, NULL, NULL) @@ -76,6 +127,61 @@ static ERL_NIF_TERM atom_not_available; static ERL_NIF_TERM atom_badarg; static ERL_NIF_TERM atom_ok; +static ERL_NIF_TERM atom_trace; +static ERL_NIF_TERM atom_seq_trace; +static ERL_NIF_TERM atom_remove; +static ERL_NIF_TERM atom_discard; + +#ifdef HAVE_USE_LTTNG + +/* gc atoms */ + +static ERL_NIF_TERM atom_gc_minor_start; +static ERL_NIF_TERM atom_gc_minor_end; +static ERL_NIF_TERM atom_gc_major_start; +static ERL_NIF_TERM atom_gc_major_end; + +static ERL_NIF_TERM atom_old_heap_block_size; /* for debug */ +static ERL_NIF_TERM atom_heap_block_size; /* for debug */ + +/* process 'procs' */ + +static ERL_NIF_TERM atom_spawn; +static ERL_NIF_TERM atom_exit; +static ERL_NIF_TERM atom_register; +static ERL_NIF_TERM atom_unregister; +static ERL_NIF_TERM atom_link; +static ERL_NIF_TERM atom_unlink; +static ERL_NIF_TERM atom_getting_linked; +static ERL_NIF_TERM atom_getting_unlinked; + +/* process 'running' and 'exiting' */ + +static ERL_NIF_TERM atom_in; +static ERL_NIF_TERM atom_out; +static ERL_NIF_TERM atom_in_exiting; +static ERL_NIF_TERM atom_out_exiting; +static ERL_NIF_TERM atom_out_exited; + +/* process messages 'send' and 'receive' */ + +static ERL_NIF_TERM atom_send; +static ERL_NIF_TERM atom_receive; +static ERL_NIF_TERM atom_send_to_non_existing_process; + +/* ports 'ports' */ + +static ERL_NIF_TERM atom_open; +static ERL_NIF_TERM atom_closed; + +/* 'call' */ + +static ERL_NIF_TERM atom_call; +static ERL_NIF_TERM atom_return_from; +static ERL_NIF_TERM atom_return_to; +static ERL_NIF_TERM atom_exception_from; +#endif + static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) { atom_true = enif_make_atom(env,"true"); @@ -85,6 +191,61 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) atom_badarg = enif_make_atom(env,"badarg"); atom_ok = enif_make_atom(env,"ok"); + atom_trace = enif_make_atom(env,"trace"); + atom_seq_trace = enif_make_atom(env,"seq_trace"); + atom_remove = enif_make_atom(env,"remove"); + atom_discard = enif_make_atom(env,"discard"); + +#ifdef HAVE_USE_LTTNG + + /* gc */ + + atom_gc_minor_start = enif_make_atom(env,"gc_minor_start"); + atom_gc_minor_end = enif_make_atom(env,"gc_minor_end"); + atom_gc_major_start = enif_make_atom(env,"gc_major_start"); + atom_gc_major_end = enif_make_atom(env,"gc_major_end"); + + atom_old_heap_block_size = enif_make_atom(env,"old_heap_block_size"); + atom_heap_block_size = enif_make_atom(env,"heap_block_size"); + + /* process 'proc' */ + + atom_spawn = enif_make_atom(env,"spawn"); + atom_exit = enif_make_atom(env,"exit"); + atom_register = enif_make_atom(env,"register"); + atom_unregister = enif_make_atom(env,"unregister"); + atom_link = enif_make_atom(env,"link"); + atom_unlink = enif_make_atom(env,"unlink"); + atom_getting_unlinked = enif_make_atom(env,"getting_unlinked"); + atom_getting_linked = enif_make_atom(env,"getting_linked"); + + /* process 'running' and 'exiting' */ + + atom_in = enif_make_atom(env,"in"); + atom_out = enif_make_atom(env,"out"); + atom_in_exiting = enif_make_atom(env,"in_exiting"); + atom_out_exiting = enif_make_atom(env,"out_exiting"); + atom_out_exited = enif_make_atom(env,"out_exited"); + + /* process messages 'send' and 'receive' */ + + atom_send = enif_make_atom(env,"send"); + atom_receive = enif_make_atom(env,"receive"); + atom_send_to_non_existing_process = enif_make_atom(env,"send_to_non_existing_process"); + + /* ports 'ports' */ + + atom_open = enif_make_atom(env,"open"); + atom_closed = enif_make_atom(env,"closed"); + + /* 'call' */ + + atom_call = enif_make_atom(env,"call"); + atom_return_from = enif_make_atom(env,"return_from"); + atom_return_to = enif_make_atom(env,"return_to"); + atom_exception_from = enif_make_atom(env,"exception_from"); +#endif + return 0; } @@ -123,3 +284,442 @@ static ERL_NIF_TERM user_trace_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar return atom_error; #endif } + +static ERL_NIF_TERM enabled(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ +#ifdef HAVE_USE_LTTNG + ASSERT(argc == 3); + return atom_trace; +#endif + return atom_remove; +} + +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return atom_ok; +} + +#ifdef HAVE_USE_LTTNG +static ERL_NIF_TERM enabled_garbage_collection(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + + if (argv[0] == atom_gc_minor_start && LTTNG_ENABLED(gc_minor_start)) { + return atom_trace; + } else if (argv[0] == atom_gc_minor_end && LTTNG_ENABLED(gc_minor_end)) { + return atom_trace; + } else if (argv[0] == atom_gc_major_start && LTTNG_ENABLED(gc_major_start)) { + return atom_trace; + } else if (argv[0] == atom_gc_major_end && LTTNG_ENABLED(gc_major_end)) { + return atom_trace; + } + + return atom_discard; +} + +static ERL_NIF_TERM trace_garbage_collection(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_procbuf(pid); + ERL_NIF_TERM gci, tup; + const ERL_NIF_TERM *vals; + int arity; + unsigned long ohbsz, nhbsz, size; + + ASSERT(argc == 6); + + /* Assume gc info order does not change */ + gci = argv[3]; + + /* get reclaimed or need */ + enif_get_list_cell(env, gci, &tup, &gci); + enif_get_tuple(env, tup, &arity, &vals); + ASSERT(arity == 2); + enif_get_ulong(env, vals[1], &size); + + /* get old heap block size */ + enif_get_list_cell(env, gci, &tup, &gci); + enif_get_tuple(env, tup, &arity, &vals); + ASSERT(arity == 2); + ASSERT(vals[0] == atom_old_heap_block_size); + enif_get_ulong(env, vals[1], &ohbsz); + + /* get new heap block size */ + enif_get_list_cell(env, gci, &tup, &gci); + enif_get_tuple(env, tup, &arity, &vals); + ASSERT(arity == 2); + ASSERT(vals[0] == atom_heap_block_size); + enif_get_ulong(env, vals[1], &nhbsz); + + lttng_pid_to_str(argv[2], pid); + + if (argv[0] == atom_gc_minor_start) { + LTTNG4(gc_minor_start, pid, size, nhbsz, ohbsz); + } else if (argv[0] == atom_gc_minor_end) { + LTTNG4(gc_minor_end, pid, size, nhbsz, ohbsz); + } else if (argv[0] == atom_gc_major_start) { + LTTNG4(gc_major_start, pid, size, nhbsz, ohbsz); + } else if (argv[0] == atom_gc_major_end) { + LTTNG4(gc_major_end, pid, size, nhbsz, ohbsz); + } + return atom_ok; +} + +static ERL_NIF_TERM enabled_call(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + + if (argv[0] == atom_call && LTTNG_ENABLED(function_call)) + return atom_trace; + else if (argv[0] == atom_return_from && LTTNG_ENABLED(function_return)) + return atom_trace; + else if (argv[0] == atom_exception_from && LTTNG_ENABLED(function_exception)) + return atom_trace; + + return atom_discard; +} + +static ERL_NIF_TERM trace_call(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_procbuf(pid); + unsigned int len; + char undef[] = "undefined"; + + lttng_pid_to_str(argv[2], pid); + + if (argv[0] == atom_call) { + const ERL_NIF_TERM* tuple; + int arity; + lttng_decl_mfabuf(mfa); + + if (enif_get_tuple(env, argv[3], &arity, &tuple)) { + if (enif_is_list(env, tuple[2])) { + enif_get_list_length(env, tuple[2], &len); + } else { + enif_get_uint(env, tuple[2], &len); + } + lttng_mfa_to_str(tuple[0], tuple[1], len, mfa); + LTTNG3(function_call, pid, mfa, 0); + } else { + LTTNG3(function_call, pid, undef, 0); + } + } else if (argv[0] == atom_return_from) { + const ERL_NIF_TERM* tuple; + int arity; + lttng_decl_mfabuf(mfa); + + if (enif_get_tuple(env, argv[3], &arity, &tuple)) { + enif_get_uint(env, tuple[2], &len); + lttng_mfa_to_str(tuple[0], tuple[1], len, mfa); + LTTNG3(function_return, pid, mfa, 0); + } else { + LTTNG3(function_return, pid, undef, 0); + } + } else if (argv[0] == atom_return_to) { + const ERL_NIF_TERM* tuple; + int arity; + lttng_decl_mfabuf(mfa); + + if (enif_get_tuple(env, argv[3], &arity, &tuple)) { + enif_get_uint(env, tuple[2], &len); + lttng_mfa_to_str(tuple[0], tuple[1], len, mfa); + LTTNG3(function_return, pid, mfa, 0); + } else { + LTTNG3(function_return, pid, undef, 0); + } + } else if (argv[0] == atom_exception_from) { + const ERL_NIF_TERM* tuple; + int arity; + lttng_decl_mfabuf(mfa); + char class[LTTNG_BUFFER_SZ]; + + enif_get_tuple(env, argv[4], &arity, &tuple); + erts_snprintf(class, LTTNG_BUFFER_SZ, "%T", tuple[0]); + + if (enif_get_tuple(env, argv[3], &arity, &tuple)) { + enif_get_uint(env, tuple[2], &len); + lttng_mfa_to_str(tuple[0], tuple[1], len, mfa); + LTTNG3(function_exception, pid, mfa, class); + } else { + LTTNG3(function_exception, pid, undef, class); + } + } + return atom_ok; +} + +static ERL_NIF_TERM enabled_send(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + if (LTTNG_ENABLED(message_send)) + return atom_trace; + + return atom_discard; +} + +static ERL_NIF_TERM trace_send(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_procbuf(pid); + lttng_pid_to_str(argv[2], pid); + + if (argv[0] == atom_send) { + lttng_decl_procbuf(to); + char msg[LTTNG_BUFFER_SZ]; + + lttng_pid_to_str(argv[4], to); + erts_snprintf(msg, LTTNG_BUFFER_SZ, "%T", argv[3]); + + LTTNG3(message_send, pid, to, msg); + } else if (argv[0] == atom_send_to_non_existing_process) { + lttng_decl_procbuf(to); + char msg[LTTNG_BUFFER_SZ]; + + lttng_pid_to_str(argv[4], to); + erts_snprintf(msg, LTTNG_BUFFER_SZ, "%T", argv[3]); + /* mark it as non existing ? */ + + LTTNG3(message_send, pid, to, msg); + } + return atom_ok; +} + +static ERL_NIF_TERM enabled_receive(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + if (LTTNG_ENABLED(message_receive)) + return atom_trace; + + return atom_discard; +} + +static ERL_NIF_TERM trace_receive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + if (argv[0] == atom_receive) { + lttng_decl_procbuf(pid); + char msg[LTTNG_BUFFER_SZ]; + + lttng_pid_to_str(argv[2], pid); + erts_snprintf(msg, LTTNG_BUFFER_SZ, "%T", argv[3]); + + LTTNG2(message_receive, pid, msg); + } + return atom_ok; +} + +static ERL_NIF_TERM enabled_procs(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + + if (argv[0] == atom_spawn && LTTNG_ENABLED(process_spawn)) { + return atom_trace; + } else if (argv[0] == atom_register && LTTNG_ENABLED(process_register)) { + return atom_trace; + } else if (argv[0] == atom_unregister && LTTNG_ENABLED(process_register)) { + return atom_trace; + } else if (argv[0] == atom_link && LTTNG_ENABLED(process_link)) { + return atom_trace; + } else if (argv[0] == atom_unlink && LTTNG_ENABLED(process_link)) { + return atom_trace; + } else if (argv[0] == atom_getting_linked && LTTNG_ENABLED(process_link)) { + return atom_trace; + } else if (argv[0] == atom_getting_unlinked && LTTNG_ENABLED(process_link)) { + return atom_trace; + } else if (argv[0] == atom_exit && LTTNG_ENABLED(process_exit)) { + return atom_trace; + } + + return atom_discard; +} + +static ERL_NIF_TERM trace_procs(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_procbuf(pid); + lttng_decl_procbuf(to); + + lttng_pid_to_str(argv[2], pid); + + /* spawn */ + if (argv[0] == atom_spawn) { + char undef[] = "undefined"; + const ERL_NIF_TERM* tuple; + int arity; + unsigned int len; + lttng_decl_mfabuf(mfa); + + lttng_pid_to_str(argv[3], to); + + if (enif_get_tuple(env, argv[4], &arity, &tuple)) { + if (enif_is_list(env, tuple[2])) { + enif_get_list_length(env, tuple[2], &len); + } else { + enif_get_uint(env, tuple[2], &len); + } + lttng_mfa_to_str(tuple[0], tuple[1], len, mfa); + LTTNG3(process_spawn, to, pid, mfa); + } else { + LTTNG3(process_spawn, to, pid, undef); + } + + /* register */ + } else if (argv[0] == atom_register) { + char name[LTTNG_BUFFER_SZ]; + erts_snprintf(name, LTTNG_BUFFER_SZ, "%T", argv[3]); + LTTNG3(process_register, pid, name, "register"); + } else if (argv[0] == atom_unregister) { + char name[LTTNG_BUFFER_SZ]; + erts_snprintf(name, LTTNG_BUFFER_SZ, "%T", argv[3]); + LTTNG3(process_register, pid, name, "unregister"); + /* link */ + } else if (argv[0] == atom_link) { + lttng_pid_to_str(argv[3], to); + LTTNG3(process_link, pid, to, "link"); + } else if (argv[0] == atom_unlink) { + lttng_pid_to_str(argv[3], to); + LTTNG3(process_link, pid, to, "unlink"); + } else if (argv[0] == atom_getting_linked) { + lttng_pid_to_str(argv[3], to); + LTTNG3(process_link, to, pid, "link"); + } else if (argv[0] == atom_getting_unlinked) { + lttng_pid_to_str(argv[3], to); + LTTNG3(process_link, to, pid, "unlink"); + /* exit */ + } else if (argv[0] == atom_exit) { + char reason[LTTNG_BUFFER_SZ]; + erts_snprintf(reason, LTTNG_BUFFER_SZ, "%T", argv[3]); + LTTNG2(process_exit, pid, reason); + } + return atom_ok; +} + +static ERL_NIF_TERM enabled_ports(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + + if (argv[0] == atom_open && LTTNG_ENABLED(port_open)) { + return atom_trace; + } else if (argv[0] == atom_link && LTTNG_ENABLED(port_link)) { + return atom_trace; + } else if (argv[0] == atom_unlink && LTTNG_ENABLED(port_link)) { + return atom_trace; + } else if (argv[0] == atom_getting_linked && LTTNG_ENABLED(port_link)) { + return atom_trace; + } else if (argv[0] == atom_getting_unlinked && LTTNG_ENABLED(port_link)) { + return atom_trace; + } else if (argv[0] == atom_closed && LTTNG_ENABLED(port_exit)) { + return atom_trace; + } + + return atom_discard; +} + +static ERL_NIF_TERM trace_ports(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_portbuf(port); + lttng_decl_procbuf(to); + + lttng_portid_to_str(argv[2], port); + + /* open and closed */ + if (argv[0] == atom_open) { + char driver[LTTNG_BUFFER_SZ]; + lttng_decl_procbuf(pid); + lttng_pid_to_str(argv[3], pid); + + erts_snprintf(driver, LTTNG_BUFFER_SZ, "%T", argv[4]); + LTTNG3(port_open, pid, driver, port); + } else if (argv[0] == atom_closed) { + char reason[LTTNG_BUFFER_SZ]; + erts_snprintf(reason, LTTNG_BUFFER_SZ, "%T", argv[3]); + + LTTNG2(port_exit, port, reason); + /* link */ + } else if (argv[0] == atom_link) { + lttng_pid_to_str(argv[3], to); + LTTNG3(port_link, port, to, "link"); + } else if (argv[0] == atom_unlink) { + lttng_pid_to_str(argv[3], to); + LTTNG3(port_link, port, to, "unlink"); + } else if (argv[0] == atom_getting_linked) { + lttng_pid_to_str(argv[3], to); + LTTNG3(port_link, to, port, "link"); + } else if (argv[0] == atom_getting_unlinked) { + lttng_pid_to_str(argv[3], to); + LTTNG3(port_link, to, port, "unlink"); + } + return atom_ok; +} + +static ERL_NIF_TERM enabled_running_procs(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + + if (LTTNG_ENABLED(process_scheduled)) + return atom_trace; + + return atom_discard; +} + +static ERL_NIF_TERM trace_running_procs(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_procbuf(pid); + const ERL_NIF_TERM* tuple; + char *mfastr = "undefined"; + int arity; + lttng_decl_mfabuf(mfa); + + lttng_pid_to_str(argv[2], pid); + + if (enif_get_tuple(env, argv[3], &arity, &tuple)) { + int val; + enif_get_int(env, tuple[2], &val); + lttng_mfa_to_str(tuple[0], tuple[1], val, mfa); + mfastr = mfa; + } + /* running processes */ + if (argv[0] == atom_in) { + LTTNG3(process_scheduled, pid, mfastr, "in"); + } else if (argv[0] == atom_out) { + LTTNG3(process_scheduled, pid, mfastr, "out"); + /* exiting */ + } else if (argv[0] == atom_in_exiting) { + LTTNG3(process_scheduled, pid, mfastr, "in_exiting"); + } else if (argv[0] == atom_out_exiting) { + LTTNG3(process_scheduled, pid, mfastr, "out_exiting"); + } else if (argv[0] == atom_out_exited) { + LTTNG3(process_scheduled, pid, mfastr, "out_exited"); + } + + return atom_ok; +} + +static ERL_NIF_TERM enabled_running_ports(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + + if (LTTNG_ENABLED(port_scheduled)) + return atom_trace; + + return atom_discard; +} + +static ERL_NIF_TERM trace_running_ports(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_procbuf(pid); + lttng_decl_mfabuf(where); + + lttng_portid_to_str(argv[2], pid); + erts_snprintf(where, LTTNG_BUFFER_SZ, "%T", argv[3]); + + /* running ports */ + if (argv[0] == atom_in) { + LTTNG3(port_scheduled, pid, where, "in"); + } else if (argv[0] == atom_out) { + LTTNG3(port_scheduled, pid, where, "out"); + /* exiting */ + } else if (argv[0] == atom_in_exiting) { + LTTNG3(port_scheduled, pid, where, "in_exiting"); + } else if (argv[0] == atom_out_exiting) { + LTTNG3(port_scheduled, pid, where, "out_exiting"); + } else if (argv[0] == atom_out_exited) { + LTTNG3(port_scheduled, pid, where, "out_exited"); + } + return atom_ok; +} +#endif diff --git a/lib/runtime_tools/c_src/dyntrace_lttng.h b/lib/runtime_tools/c_src/dyntrace_lttng.h new file mode 100644 index 0000000000..3550a1cab5 --- /dev/null +++ b/lib/runtime_tools/c_src/dyntrace_lttng.h @@ -0,0 +1,367 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#undef TRACEPOINT_PROVIDER +#define TRACEPOINT_PROVIDER com_ericsson_dyntrace + +#if !defined(DYNTRACE_LTTNG_H) || defined(TRACEPOINT_HEADER_MULTI_READ) +#define DYNTRACE_LTTNG_H + +#include <lttng/tracepoint.h> + +#define LTTNG1(Name, Arg1) \ + tracepoint(com_ericsson_dyntrace, Name, (Arg1)) + +#define LTTNG2(Name, Arg1, Arg2) \ + tracepoint(com_ericsson_dyntrace, Name, (Arg1), (Arg2)) + +#define LTTNG3(Name, Arg1, Arg2, Arg3) \ + tracepoint(com_ericsson_dyntrace, Name, (Arg1), (Arg2), (Arg3)) + +#define LTTNG4(Name, Arg1, Arg2, Arg3, Arg4) \ + tracepoint(com_ericsson_dyntrace, Name, (Arg1), (Arg2), (Arg3), (Arg4)) + +#define LTTNG5(Name, Arg1, Arg2, Arg3, Arg4, Arg5) \ + tracepoint(com_ericsson_dyntrace, Name, (Arg1), (Arg2), (Arg3), (Arg4), (Arg5)) + +#define LTTNG_ENABLED(Name) \ + tracepoint_enabled(com_ericsson_dyntrace, Name) + +#define LTTNG_BUFFER_SZ (256) +#define LTTNG_PROC_BUFFER_SZ (16) +#define LTTNG_PORT_BUFFER_SZ (20) +#define LTTNG_MFA_BUFFER_SZ (256) + +#define lttng_decl_procbuf(Name) \ + char Name[LTTNG_PROC_BUFFER_SZ] + +#define lttng_decl_portbuf(Name) \ + char Name[LTTNG_PORT_BUFFER_SZ] + +#define lttng_decl_mfabuf(Name) \ + char Name[LTTNG_MFA_BUFFER_SZ] + +#define lttng_pid_to_str(pid, name) \ + erts_snprintf(name, LTTNG_PROC_BUFFER_SZ, "%T", (pid)) + +#define lttng_portid_to_str(pid, name) \ + erts_snprintf(name, LTTNG_PORT_BUFFER_SZ, "%T", (pid)) + +#define lttng_proc_to_str(p, name) \ + lttng_pid_to_str(((p) ? (p)->common.id : ERTS_INVALID_PID), name) + +#define lttng_port_to_str(p, name) \ + lttng_portid_to_str(((p) ? (p)->common.id : ERTS_INVALID_PORT), name) + +#define lttng_mfa_to_str(m,f,a, Name) \ + erts_snprintf(Name, LTTNG_MFA_BUFFER_SZ, "%T:%T/%lu", (Eterm)(m), (Eterm)(f), (Uint)(a)) + +/* Process scheduling */ + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + process_spawn, + TP_ARGS( + char*, p, + char*, parent, + char*, mfa + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_string(parent, parent) + ctf_string(entry, mfa) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + process_link, + TP_ARGS( + char*, from, + char*, to, + char*, type + ), + TP_FIELDS( + ctf_string(from, from) + ctf_string(to, to) + ctf_string(type, type) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + process_exit, + TP_ARGS( + char*, p, + char*, reason + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_string(reason, reason) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + process_register, + TP_ARGS( + char*, pid, + char*, name, + char*, type + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(name, name) + ctf_string(type, type) + ) +) + +/* Scheduled */ + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + process_scheduled, + TP_ARGS( + char*, p, + char*, mfa, + char*, type + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_string(entry, mfa) + ctf_string(type, type) + ) +) + +/* Ports */ + + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + port_open, + TP_ARGS( + char*, pid, + char*, driver, + char*, port + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(driver, driver) + ctf_string(port, port) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + port_exit, + TP_ARGS( + char*, port, + char*, reason + ), + TP_FIELDS( + ctf_string(port, port) + ctf_string(reason, reason) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + port_link, + TP_ARGS( + char*, from, + char*, to, + char*, type + ), + TP_FIELDS( + ctf_string(from, from) + ctf_string(to, to) + ctf_string(type, type) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + port_scheduled, + TP_ARGS( + char*, p, + char*, op, + char*, type + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_string(entry, op) + ctf_string(type, type) + ) +) + +/* Call tracing */ + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + function_call, + TP_ARGS( + char*, pid, + char*, mfa, + unsigned int, depth + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(entry, mfa) + ctf_integer(unsigned int, depth, depth) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + function_return, + TP_ARGS( + char*, pid, + char*, mfa, + unsigned int, depth + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(entry, mfa) + ctf_integer(unsigned int, depth, depth) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + function_exception, + TP_ARGS( + char*, pid, + char*, mfa, + char*, type + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(entry, mfa) + ctf_string(class, type) + ) +) + +/* Process messages */ + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + message_send, + TP_ARGS( + char*, sender, + char*, receiver, + char*, msg + ), + TP_FIELDS( + ctf_string(from, sender) + ctf_string(to, receiver) + ctf_string(message, msg) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + message_receive, + TP_ARGS( + char*, receiver, + char*, msg + ), + TP_FIELDS( + ctf_string(to, receiver) + ctf_string(message, msg) + ) +) + +/* Process Memory */ + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + gc_minor_start, + TP_ARGS( + char*, p, + unsigned long, need, + unsigned long, nh, + unsigned long, oh + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_integer(unsigned long, need, need) + ctf_integer(unsigned long, heap, nh) + ctf_integer(unsigned long, old_heap, oh) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + gc_minor_end, + TP_ARGS( + char*, p, + unsigned long, reclaimed, + unsigned long, nh, + unsigned long, oh + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_integer(unsigned long, reclaimed, reclaimed) + ctf_integer(unsigned long, heap, nh) + ctf_integer(unsigned long, old_heap, oh) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + gc_major_start, + TP_ARGS( + char*, p, + unsigned long, need, + unsigned long, nh, + unsigned long, oh + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_integer(unsigned long, need, need) + ctf_integer(unsigned long, heap, nh) + ctf_integer(unsigned long, old_heap, oh) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + gc_major_end, + TP_ARGS( + char*, p, + unsigned long, reclaimed, + unsigned long, nh, + unsigned long, oh + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_integer(unsigned long, reclaimed, reclaimed) + ctf_integer(unsigned long, heap, nh) + ctf_integer(unsigned long, old_heap, oh) + ) +) + +#endif /* DYNTRACE_LTTNG_H */ + +#undef TRACEPOINT_INCLUDE +#define TRACEPOINT_INCLUDE "./dyntrace_lttng.h" + +/* This part must be outside protection */ +#include <lttng/tracepoint-event.h> diff --git a/lib/runtime_tools/c_src/trace_file_drv.c b/lib/runtime_tools/c_src/trace_file_drv.c index 703766c188..e7fd5968c1 100644 --- a/lib/runtime_tools/c_src/trace_file_drv.c +++ b/lib/runtime_tools/c_src/trace_file_drv.c @@ -172,6 +172,7 @@ static ErlDrvData trace_file_start(ErlDrvPort port, char *buff); static void trace_file_stop(ErlDrvData handle); static void trace_file_output(ErlDrvData handle, char *buff, ErlDrvSizeT bufflen); +static void trace_file_outputv(ErlDrvData handle, ErlIOVec *ev); static void trace_file_finish(void); static ErlDrvSSizeT trace_file_control(ErlDrvData handle, unsigned int command, @@ -214,7 +215,7 @@ ErlDrvEntry trace_file_driver_entry = { NULL, /* void * that is not used (BC) */ trace_file_control, /* F_PTR control, port_control callback */ trace_file_timeout, /* F_PTR timeout, driver_set_timer callback */ - NULL, /* F_PTR outputv, reserved */ + trace_file_outputv, /* F_PTR outputv, reserved */ NULL, /* ready_async */ NULL, /* flush */ NULL, /* call */ @@ -363,6 +364,16 @@ static void trace_file_stop(ErlDrvData handle) /* ** Data sent from erlang to port. */ +static void trace_file_outputv(ErlDrvData handle, ErlIOVec *ev) +{ + int i; + for (i = 0; i < ev->vsize; i++) { + if (ev->iov[i].iov_len) + trace_file_output(handle, ev->iov[i].iov_base, + ev->iov[i].iov_len); + } +} + static void trace_file_output(ErlDrvData handle, char *buff, ErlDrvSizeT bufflen) { diff --git a/lib/runtime_tools/doc/src/LTTng.xml b/lib/runtime_tools/doc/src/LTTng.xml new file mode 100644 index 0000000000..eab1848e88 --- /dev/null +++ b/lib/runtime_tools/doc/src/LTTng.xml @@ -0,0 +1,245 @@ +<?xml version="1.0" encoding="utf8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> +<chapter> + <header> + <copyright> + <year>2016</year><year>2016</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + </legalnotice> + + <title>LTTng and Erlang/OTP</title> + <prepared></prepared> + <responsible></responsible> + <docno></docno> + <approved></approved> + <checked></checked> + <date>2016-04-27</date> + <rev></rev> + <file>LTTng.xml</file> + </header> + + <section> + <title>Introduction</title> + <p>The Linux Trace Toolkit: next generation is an open source system software package + for correlated tracing of the Linux kernel, user applications and libraries. </p> + <p>For more information, please visit <url href="http://lttng.org">http://lttng.org</url></p> + </section> + + <section> + <title>Building Erlang/OTP with LTTng support</title> + <p> + Configure and build Erlang with LTTng support: + </p> + <p>For LTTng to work properly with Erlang/OTP you need + the following packages installed:</p> + + <list type="bulleted"> + <item><p>LTTng-tools: a command line interface to control tracing sessions.</p></item> + <item><p>LTTng-UST: user space tracing library.</p></item> + </list> + + <p>On Ubuntu this can be installed via <c>aptitude</c>:</p> + + <code type="none">$ sudo aptitude install lttng-tools liblttng-ust-dev</code> + <p>See <url href="http://lttng.org/docs/#doc-installing-lttng">Installing LTTng</url> + for more information on how to install LTTng on your system.</p> + + <p>After LTTng is properly installed on the system Erlang/OTP can be built with LTTng support.</p> + + +<code type="none">$ ./configure --with-dynamic-trace=lttng +$ make </code> + </section> + + <section> + <title>Dyntrace Tracepoints</title> + <p>All tracepoints are in the domain of <c>com_ericsson_dyntrace</c></p> + <p>All Erlang types are the string equivalent in LTTng.</p> + + <p><em>process_spawn</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>parent : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>entry : string</c> :: Code Location. Ex. <c>"lists:sort/1"</c></item> + </list> + <p>Example:</p> + <p><code type="none">process_spawn: { cpu_id = 3 }, { pid = "<0.131.0>", parent = "<0.130.0>", entry = "erlang:apply/2" }</code></p> + + <p><em>process_link</em></p> + <list type="bulleted"> + <item><c>to : string</c> :: Process ID or Port ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>from : string</c> :: Process ID or Port ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>type : string</c> :: <c>"link" | "unlink"</c></item> + </list> + <p>Example:</p> + <p><code type="none">process_link: { cpu_id = 3 }, { from = "<0.130.0>", to = "<0.131.0>", type = "link" }</code></p> + + + <p><em>process_exit</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>reason : string</c> :: Exit reason. Ex. <c>"normal"</c></item> + </list> + <p>Example:</p> + <p><code type="none">process_exit: { cpu_id = 3 }, { pid = "<0.130.0>", reason = "normal" }</code></p> + + <p><em>process_register</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>name : string</c> :: Registered name. Ex. <c>"error_logger"</c></item> + <item><c>type : string</c> :: <c>"register" | "unregister"</c></item> + </list> + <p>Example:</p> + <p><code type="none">process_register: { cpu_id = 0 }, { pid = "<0.128.0>", name = "dyntrace_lttng_SUITE" type = "register" }</code></p> + + <p><em>process_scheduled</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>entry : string</c> :: Code Location. Ex. <c>"lists:sort/1"</c></item> + <item><c>type : string</c> :: <c>"in" | "out" | "in_exiting" | "out_exiting" | "out_exited"</c></item> + </list> + + <p>Example:</p> + <p><code type="none">process_scheduled: { cpu_id = 0 }, { pid = "<0.136.0>", entry = "erlang:apply/2", type = "in" }</code></p> + + + <p><em>port_open</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + </list> + + <p>Example:</p> + <p><code type="none">port_open: { cpu_id = 5 }, { pid = "<0.131.0>", driver = "'/bin/sh -s unix:cmd'", port = "#Port<0.1887>" }</code></p> + + <p><em>port_exit</em></p> + <list type="bulleted"> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>reason : string</c> :: Exit reason. Ex. <c>"normal"</c></item> + </list> + <p>Example:</p> + <p><code type="none">port_exit: { cpu_id = 5 }, { port = "#Port<0.1887>", reason = "normal" }</code></p> + + <p><em>port_link</em></p> + <list type="bulleted"> + <item><c>to : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>from : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>type : string</c> :: <c>"link" | "unlink"</c></item> + </list> + <p>Example:</p> + <p><code type="none">port_link: { cpu_id = 5 }, { from = "#Port<0.1887>", to = "<0.131.0>", type = "unlink" }</code></p> + + <p><em>port_scheduled</em></p> + <list type="bulleted"> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>entry : string</c> :: Callback. Ex. <c>"open"</c></item> + <item><c>type : string</c> :: <c>"in" | "out" | "in_exiting" | "out_exiting" | "out_exited"</c></item> + </list> + + <p>Example:</p> + <p><code type="none">port_scheduled: { cpu_id = 5 }, { pid = "#Port<0.1905>", entry = "close", type = "out" }</code></p> + + <p><em>function_call</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>entry : string</c> :: Code Location. Ex. <c>"lists:sort/1"</c></item> + <item><c>depth : integer</c> :: Stack depth. Ex. <c>0</c></item> + </list> + <p>Example:</p> + <p><code type="none">function_call: { cpu_id = 5 }, { pid = "<0.145.0>", entry = "dyntrace_lttng_SUITE:'-t_call/1-fun-1-'/0", depth = 0 }</code></p> + + <p><em>function_return</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>entry : string</c> :: Code Location. Ex. <c>"lists:sort/1"</c></item> + <item><c>depth : integer</c> :: Stack depth. Ex. <c>0</c></item> + </list> + <p>Example:</p> + <p><code type="none">function_return: { cpu_id = 5 }, { pid = "<0.145.0>", entry = "dyntrace_lttng_SUITE:waiter/0", depth = 0 }</code></p> + + <p><em>function_exception</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>entry : string</c> :: Code Location. Ex. <c>"lists:sort/1"</c></item> + <item><c>class : string</c> :: Error reason. Ex. <c>"error"</c></item> + </list> + <p>Example:</p> + <p><code type="none">function_exception: { cpu_id = 5 }, { pid = "<0.144.0>", entry = "t:call_exc/1", class = "error" }</code></p> + + <p><em>message_send</em></p> + <list type="bulleted"> + <item><c>from : string</c> :: Process ID or Port ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>to : string</c> :: Process ID or Port ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>message : string</c> :: Message sent. Ex. <c>"{<0.162.0>,ok}"</c></item> + </list> + <p>Example:</p> + <p><code type="none">message_send: { cpu_id = 3 }, { from = "#Port<0.1938>", to = "<0.160.0>", message = "{#Port<0.1938>,eof}" }</code></p> + + <p><em>message_receive</em></p> + <list type="bulleted"> + <item><c>to : string</c> :: Process ID or Port ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>message : string</c> :: Message received. Ex. <c>"{<0.162.0>,ok}"</c></item> + </list> + <p>Example:</p> + <p><code type="none">message_receive: { cpu_id = 7 }, { to = "<0.167.0>", message = "{<0.165.0>,ok}" }</code></p> + + <p><em>gc_minor_start</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>need : integer</c> :: Heap need. Ex. <c>2</c></item> + <item><c>heap : integer</c> :: Young heap word size. Ex. <c>233</c></item> + <item><c>old_heap : integer</c> :: Old heap word size. Ex. <c>233</c></item> + </list> + <p>Example:</p> + <p><code type="none">gc_minor_start: { cpu_id = 0 }, { pid = "<0.172.0>", need = 0, heap = 610, old_heap = 0 }</code></p> + + <p><em>gc_minor_end</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>reclaimed : integer</c> :: Heap reclaimed. Ex. <c>2</c></item> + <item><c>heap : integer</c> :: Young heap word size. Ex. <c>233</c></item> + <item><c>old_heap : integer</c> :: Old heap word size. Ex. <c>233</c></item> + </list> + <p>Example:</p> + <p><code type="none">gc_minor_end: { cpu_id = 0 }, { pid = "<0.172.0>", reclaimed = 120, heap = 1598, old_heap = 1598 }</code></p> + + <p><em>gc_major_start</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>need : integer</c> :: Heap need. Ex. <c>2</c></item> + <item><c>heap : integer</c> :: Young heap word size. Ex. <c>233</c></item> + <item><c>old_heap : integer</c> :: Old heap word size. Ex. <c>233</c></item> + </list> + <p>Example:</p> + <p><code type="none">gc_major_start: { cpu_id = 0 }, { pid = "<0.172.0>", need = 8, heap = 2586, old_heap = 1598 }</code></p> + + <p><em>gc_major_end</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>reclaimed : integer</c> :: Heap reclaimed. Ex. <c>2</c></item> + <item><c>heap : integer</c> :: Young heap word size. Ex. <c>233</c></item> + <item><c>old_heap : integer</c> :: Old heap word size. Ex. <c>233</c></item> + </list> + <p>Example:</p> + <p><code type="none">gc_major_end: { cpu_id = 0 }, { pid = "<0.172.0>", reclaimed = 240, heap = 4185, old_heap = 0 }</code></p> + + </section> + + <section> + <title>Examples</title> + </section> +</chapter> diff --git a/lib/runtime_tools/doc/src/Makefile b/lib/runtime_tools/doc/src/Makefile index 0a590ff9ec..5ce40bb995 100644 --- a/lib/runtime_tools/doc/src/Makefile +++ b/lib/runtime_tools/doc/src/Makefile @@ -45,7 +45,7 @@ XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.x XML_REF6_FILES = runtime_tools_app.xml XML_PART_FILES = part_notes.xml part_notes_history.xml part.xml -XML_CHAPTER_FILES = notes.xml notes_history.xml +XML_CHAPTER_FILES = notes.xml notes_history.xml LTTng.xml GENERATED_XML_FILES = DTRACE.xml SYSTEMTAP.xml diff --git a/lib/runtime_tools/doc/src/dbg.xml b/lib/runtime_tools/doc/src/dbg.xml index 0232cc0453..0128e23a47 100644 --- a/lib/runtime_tools/doc/src/dbg.xml +++ b/lib/runtime_tools/doc/src/dbg.xml @@ -36,14 +36,30 @@ <modulesummary>The Text Based Trace Facility</modulesummary> <description> <p>This module implements a text based interface to the - <c>trace/3</c> and the <c>trace_pattern/2</c> BIFs. It makes it - possible to trace functions, processes and messages on text based - terminals. It can be used instead of, or as complement to, the - <c>pman</c> module. - </p> - <p>For some examples of how to use <c>dbg</c> from the Erlang + <c><seealso marker="erts:erlang#trace-3">trace/3</seealso></c> and the + <c><seealso marker="erts:erlang#trace_pattern-2">trace_pattern/2</seealso></c> BIFs. It makes it + possible to trace functions, processes, ports and messages. + </p> + <p> + To quickly get started on tracing function calls you can use the following + code in the Erlang shell: + </p> + <pre> +1> dbg:tracer(). %% Start the default trace message receiver +{ok,<0.36.0>} +2> dbg:p(all, c). %% Setup call (c) tracing on all processes +{ok,[{matched,nonode@nohost,26}]} +3> dbg:tp(lists, seq, x). %% Setup an exception return trace (x) on lists:seq +{ok,[{matched,nonode@nohost,2},{saved,x}]} +4> lists:seq(1,10). +(<0.34.0>) call lists:seq(1,10) +(<0.34.0>) returned from lists:seq/2 -> [1,2,3,4,5,6,7,8,9,10] +[1,2,3,4,5,6,7,8,9,10] + </pre> + <p> + For more examples of how to use <c>dbg</c> from the Erlang shell, see the <seealso marker="#simple_example">simple example</seealso> section. - </p> + </p> <p>The utilities are also suitable to use in system testing on large systems, where other tools have too much impact on the system performance. Some primitive support for sequential tracing @@ -164,53 +180,66 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <desc> <p>Traces <c>Item</c> in accordance to the value specified by <c>Flags</c>. The variation of <c>Item</c> is listed below:</p> - <list type="bulleted"> - <item>If the <c>Item</c> is a <c>pid()</c>, the corresponding - process is traced. The process may be a remote process - (on another Erlang node). The node must be in the list of - traced nodes (see <seealso marker="#n"><c>n/1</c></seealso> and - <c>tracer/0/2/3</c>).</item> - <item>If the <c>Item</c> is the atom <c>all</c>, all processes in the - system as well as all processes created hereafter are - to be traced. This also affects all nodes added with the - <c>n/1</c> or <c>tracer/0/2/3</c> function.</item> - <item>If the <c>Item</c> is the atom <c>new</c>, no currently existing - processes are affected, but every process created after the - call is.This also affects all nodes added with the - <c>n/1</c> or <c>tracer/0/2/3</c> function.</item> - <item>If the <c>Item</c> is the atom <c>existing</c>, all - existing processes are traced, but new processes will not - be affected.This also affects all nodes added with the - <c>n/1</c> or <c>tracer/0/2/3</c> function.</item> - <item>If the <c>Item</c> is an atom other than <c>all</c>, - <c>new</c> or <c>existing</c>, the process with the - corresponding registered name is traced.The process may be a - remote process (on another Erlang node). The node must be added - with the <c>n/1</c> or <c>tracer/0/2/3</c> function.</item> - <item>If the <c>Item</c> is an integer, the process <c><![CDATA[<0.Item.0>]]></c> is - traced.</item> - <item>If the <c>Item</c> is a tuple <c>{X, Y, Z}</c>, the - process <c><![CDATA[<X.Y.Z>]]></c> is - traced. </item> + <taglist> + <tag><c>pid()</c> or <c>port()</c></tag> + <item>The corresponding process or port is traced. The process or port may + be a remote process or port (on another Erlang node). The node must + be in the list of traced nodes (see <seealso marker="#n-1"><c>n/1</c></seealso> + and <c><seealso marker="#tracer-3">tracer/3</seealso></c>).</item> + <tag><c>all</c></tag> + <item>All processes and ports in the system as well as all processes and ports + created hereafter are to be traced.</item> + <tag><c>all_processes</c></tag> + <item>All processes in the system as well as all processes created hereafter are to be traced.</item> + <tag><c>all_ports</c></tag> + <item>All ports in the system as well as all ports created hereafter are to be traced.</item> + <tag><c>new</c></tag> + <item>All processes and ports created after the call is are to be traced.</item> + <tag><c>new_processes</c></tag> + <item>All processes created after the call is are to be traced.</item> + <tag><c>new_ports</c></tag> + <item>All ports created after the call is are to be traced.</item> + <tag><c>existing</c></tag> + <item>All existing processes and ports are traced.</item> + <tag><c>existing_processes</c></tag> + <item>All existing processes are traced.</item> + <tag><c>existing_ports</c></tag> + <item>All existing ports are traced.</item> + <tag><c>atom()</c></tag> + <item>The process or port with the corresponding registered name is traced. The process or + port may be a remote process (on another Erlang node). The node must be + added with the <c><seealso marker="#n-1">n/1</seealso></c> or + <c><seealso marker="#tracer-3">tracer/3</seealso></c> function.</item> + <tag><c>integer()</c></tag> + <item>The process <c><![CDATA[<0.Item.0>]]></c> is traced.</item> + <tag><c>{X, Y, Z}</c></tag> + <item>The process <c><![CDATA[<X.Y.Z>]]></c> is traced. </item> + <tag><c>string()</c></tag> <item>If the <c>Item</c> is a string <![CDATA["<X.Y.Z>"]]> - as returned from <c>pid_to_list/1</c>, the process + as returned from <c><seealso marker="erts:erlang#pid_to_list-1">pid_to_list/1</seealso></c>, the process <c><![CDATA[<X.Y.Z>]]></c> is traced. </item> - </list> + </taglist> + + <p>When enabling an <c>Item</c> that represents a group of processes, + the <c>Item</c> is enabled on all nodes added with the + <c><seealso marker="#n-1">n/1</seealso></c> or + <c><seealso marker="#tracer-3">tracer/3</seealso></c> function.</p> + <p><c>Flags</c> can be a single atom, or a list of flags. The available flags are: </p> <taglist> <tag><c>s (send)</c></tag> <item> - <p>Traces the messages the process sends.</p> + <p>Traces the messages the process or port sends.</p> </item> <tag><c>r (receive)</c></tag> <item> - <p>Traces the messages the process receives.</p> + <p>Traces the messages the process or port receives.</p> </item> <tag><c>m (messages)</c></tag> <item> - <p>Traces the messages the process receives and sends.</p> + <p>Traces the messages the process or port receives and sends.</p> </item> <tag><c>c (call)</c></tag> <item> @@ -221,6 +250,10 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <item> <p>Traces process related events to the process.</p> </item> + <tag><c>ports</c></tag> + <item> + <p>Traces port related events to the port.</p> + </item> <tag><c>sos (set on spawn)</c></tag> <item> <p>Lets all processes created by the traced @@ -241,8 +274,8 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <tag><c>sofl (set on first link)</c></tag> <item> <p>This is the same as <c>sol</c>, but only for - the first call to - <c>link/1</c> by the traced process.</p> + the first call to + <c><seealso marker="erts:erlang#link-1">link/1</seealso></c> by the traced process.</p> </item> <tag><c>all</c></tag> <item> @@ -255,10 +288,10 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ </item> </taglist> <p>The list can also include any of the flags allowed in - <c>erlang:trace/3</c></p> + <c><seealso marker="erts:erlang#trace-3">erlang:trace/3</seealso></c></p> <p>The function returns either an error tuple or a tuple <c>{ok, List}</c>. The <c>List</c> consists of - specifications of how many processes that matched (in the + specifications of how many processes and ports that matched (in the case of a pure pid() exactly 1). The specification of matched processes is <c>{matched, Node, N}</c>. If the remote processor call,<c>rpc</c>, to a remote node fails, @@ -286,9 +319,9 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ </func> <func> <name>i() -> ok</name> - <fsummary>Display information about all traced processes.</fsummary> + <fsummary>Display information about all traced processes and ports.</fsummary> <desc> - <p>Displays information about all traced processes.</p> + <p>Displays information about all traced processes and ports.</p> </desc> </func> <func> @@ -327,35 +360,41 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ </type> <desc> <p>This function enables call trace for one or more - functions. All exported functions matching the <c>{Module, Function, Arity}</c> argument will be concerned, but the + functions. All exported functions matching the <c>{Module, Function, Arity}</c> + argument will be concerned, but the <c>match_spec()</c> may further narrow down the set of function calls generating trace messages.</p> <p>For a description of the <c>match_spec()</c> syntax, please turn to the <em>User's guide</em> part of the online documentation for the runtime system (<em>erts</em>). The - chapter <em>Match Specification in Erlang</em> explains the - general match specification "language".</p> + chapter <em><seealso marker="erts:match_spec">Match Specifications in Erlang</seealso></em> + explains the general match specification "language". + The most common generic match specifications used can be + found as <c>Built-inAlias</c>', see + <c><seealso marker="#ltp-0">ltp/0</seealso></c> below for details. + </p> <p>The Module, Function and/or Arity parts of the tuple may be specified as the atom <c>'_'</c> which is a "wild-card" matching all modules/functions/arities. Note, if the Module is specified as <c>'_'</c>, the Function and Arity parts have to be specified as '_' too. The same holds for the Functions relation to the Arity.</p> - <p>All nodes added with <c>n/1</c> or <c>tracer/0/2/3</c> will + <p>All nodes added with <c><seealso marker="#n-1">n/1</seealso></c> or + <c><seealso marker="#tracer-3">tracer/3</seealso></c> will be affected by this call, and if Module is not <c>'_'</c> the module will be loaded on all nodes.</p> <p>The function returns either an error tuple or a tuple <c>{ok, List}</c>. The <c>List</c> consists of specifications of how - many functions that matched, in the same way as the processes - are presented in the return value of <c>p/2</c>. </p> + many functions that matched, in the same way as the processes and ports + are presented in the return value of <c><seealso marker="#p-2">p/2</seealso></c>. </p> <p>There may be a tuple <c>{saved, N}</c> in the return value, if the MatchSpec is other than []. The integer <c>N</c> may then be used in subsequent calls to this function and will stand as an "alias" for the given expression. There are also a couple of - built-in aliases for common expressions, see <c>ltp/0</c> below - for details.</p> + built-in aliases for common expressions, see + <c><seealso marker="#ltp-0">ltp/0</seealso></c> below for details.</p> <p>If an error is returned, it can be due to errors in compilation of the match specification. Such errors are presented as a list of tuples <c>{error, string()}</c> where @@ -394,7 +433,7 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <name>tpl({Module, Function, Arity}, MatchSpec) -> {ok, MatchDesc} | {error, term()}</name> <fsummary>Set pattern for traced local (as well as global) function calls</fsummary> <desc> - <p>This function works as <c>tp/2</c>, but enables + <p>This function works as <c><seealso marker="#tp-2">tp/2</seealso></c>, but enables tracing for local calls (and local functions) as well as for global calls (and functions).</p> </desc> @@ -441,10 +480,10 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <p>This function disables call tracing on the specified functions. The semantics of the parameter is the same as for the corresponding function specification in - <c>tp/2</c> or <c>tpl/2</c>. Both local and global call trace + <c><seealso marker="#tp-2">tp/2</seealso></c> or <c><seealso marker="#tpl-2">tpl/2</seealso></c>. Both local and global call trace is disabled. </p> <p>The return value reflects how many functions that matched, - and is constructed as described in <c>tp/2</c>. No tuple + and is constructed as described in <c><seealso marker="#tp-2">tp/2</seealso></c>. No tuple <c>{saved, N}</c> is however ever returned (for obvious reasons).</p> </desc> </func> @@ -480,8 +519,8 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <name>ctpl({Module, Function, Arity}) -> {ok, MatchDesc} | {error, term()}</name> <fsummary>Clear call trace pattern for the specified functions</fsummary> <desc> - <p>This function works as <c>ctp/1</c>, but only disables - tracing set up with <c>tpl/2</c> (not with <c>tp/2</c>).</p> + <p>This function works as <c><seealso marker="#ctp-1">ctp/1</seealso></c>, but only disables + tracing set up with <c><seealso marker="#tpl-2">tpl/2</seealso></c> (not with <c><seealso marker="#tp-2">tp/2</seealso></c>).</p> </desc> </func> <func> @@ -516,8 +555,8 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <name>ctpg({Module, Function, Arity}) -> {ok, MatchDesc} | {error, term()}</name> <fsummary>Clear call trace pattern for the specified functions</fsummary> <desc> - <p>This function works as <c>ctp/1</c>, but only disables - tracing set up with <c>tp/2</c> (not with <c>tpl/2</c>).</p> + <p>This function works as <c><seealso marker="#ctp-1">ctp/1</seealso></c>, but only disables + tracing set up with <c><seealso marker="#tp-2">tp/2</seealso></c> (not with <c><seealso marker="#tpl-2">tpl/2</seealso></c>).</p> </desc> </func> <func> @@ -526,13 +565,13 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <desc> <p>Use this function to recall all match specifications previously used in the session (i. e. previously saved during calls - to <c>tp/2</c>, and built-in match specifications. + to <c><seealso marker="#tp-2">tp/2</seealso></c>, and built-in match specifications. This is very useful, as a complicated match_spec can be quite awkward to write. Note that the - match specifications are lost if <c>stop/0</c> is called.</p> + match specifications are lost if <c><seealso marker="#stop-0">stop/0</seealso></c> is called.</p> <p>Match specifications used can be saved in a file (if a read-write file system is present) for use in later - debugging sessions, see <c>wtp/1</c> and <c>rtp/1</c></p> + debugging sessions, see <c><seealso marker="#wtp-1">wtp/1</seealso></c> and <c><seealso marker="#rtp-1">rtp/1</seealso></c></p> <p>There are three built-in trace patterns: <c>exception_trace</c>, <c>caller_trace</c> and <c>caller_exception_trace</c> (or <c>x</c>, <c>c</c> and @@ -555,10 +594,10 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <fsummary>Delete all saved match specifications.</fsummary> <desc> <p>Use this function to "forget" all match specifications - saved during calls to <c>tp/2</c>. + saved during calls to <c><seealso marker="#tp-2">tp/2</seealso></c>. This is useful when one wants to restore other match - specifications from a file with <c>rtp/1</c>. Use - <c>dtp/1</c> to delete specific saved match specifications. </p> + specifications from a file with <c><seealso marker="#rtp-1">rtp/1</seealso></c>. Use + <c><seealso marker="#dtp-1">dtp/1</seealso></c> to delete specific saved match specifications. </p> </desc> </func> <func> @@ -569,7 +608,7 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ </type> <desc> <p>Use this function to "forget" a specific match specification - saved during calls to <c>tp/2</c>.</p> + saved during calls to <c><seealso marker="#tp-2">tp/2</seealso></c>.</p> </desc> </func> <func> @@ -581,12 +620,12 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ </type> <desc> <p>This function will save all match specifications saved - during the session (during calls to <c>tp/2</c>) + during the session (during calls to <c><seealso marker="#tp-2">tp/2</seealso></c>) and built-in match specifications in a text file with the name designated by <c>Name</c>. The format of the file is textual, why it can be edited with an ordinary text editor, and then restored with - <c>rtp/1</c>. </p> + <c><seealso marker="#rtp-1">rtp/1</seealso></c>. </p> <p>Each match spec in the file ends with a full stop (<c>.</c>) and new (syntactically correct) match specifications can be added to the file manually.</p> @@ -604,7 +643,7 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ </type> <desc> <p>This function reads match specifications from a file - (possibly) generated by the <c>wtp/1</c> function. It checks + (possibly) generated by the <c><seealso marker="#wtp-1">wtp/1</seealso></c> function. It checks the syntax of all match specifications and verifies that they are correct. The error handling principle is "all or nothing", i. e. if some of the match specifications are @@ -612,14 +651,14 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ saved match specifications for the running system. </p> <p>The match specifications in the file are <em>merged</em> with the current match specifications, so that no duplicates - are generated. Use <c>ltp/0</c> to see what numbers were + are generated. Use <c><seealso marker="#ltp-0">ltp/0</seealso></c> to see what numbers were assigned to the specifications from the file.</p> <p>The function will return an error, either due to I/O problems (like a non existing or non readable file) or due to file format problems. The errors from a bad format file are in a more or less textual format, which will give a hint - to what's causing the problem. <marker id="n"></marker> -</p> + to what's causing the problem. + </p> </desc> </func> <func> @@ -631,12 +670,12 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ </type> <desc> <p>The <c>dbg</c> server keeps a list of nodes where tracing - should be performed. Whenever a <c>tp/2</c> call or a - <c>p/2</c> call is made, it is executed for all nodes in this - list including the local node (except for <c>p/2</c> with a - specific <c>pid()</c> as first argument, in which case the + should be performed. Whenever a <c><seealso marker="#tp-2">tp/2</seealso></c> call or a + <c><seealso marker="#p-2">p/2</seealso></c> call is made, it is executed for all nodes in this + list including the local node (except for <c><seealso marker="#p-2">p/2</seealso></c> with a + specific <c>pid()</c> or <c>port()</c> as first argument, in which case the command is executed only on the node where the designated - process resides). + process or port resides). </p> <p>This function adds a remote node (<c>Nodename</c>) to the list of nodes where tracing is performed. It starts a tracer @@ -645,17 +684,17 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ distribution). If no tracer process is running on the local node, the error reason <c>no_local_tracer</c> is returned. The tracer process on the local node must be started with the - <c>tracer/0/2</c> function. + <c><seealso marker="#tracer-2">tracer/0/2</seealso></c> function. </p> <p>If <c>Nodename</c> is the local node, the error reason <c>cant_add_local_node</c> is returned. </p> - <p>If a trace port (see <seealso marker="#trace_port"><c>trace_port/2</c></seealso>) is + <p>If a trace port (see <seealso marker="#trace_port-2"><c>trace_port/2</c></seealso>) is running on the local node, remote nodes can not be traced with a tracer process. The error reason <c>cant_trace_remote_pid_to_local_port</c> is returned. A trace port can however be started on the remote node with the - <c>tracer/3</c> function. + <c><seealso marker="#tracer-3">tracer/3</seealso></c> function. </p> <p>The function will also return an error if the node <c>Nodename</c> is not reachable.</p> @@ -669,7 +708,7 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ </type> <desc> <p>Clears a node from the list of traced nodes. Subsequent - calls to <c>tp/2</c> and <c>p/2</c> will not consider that + calls to <c><seealso marker="#tp-2">tp/2</seealso></c> and <c><seealso marker="#p-2">p/2</seealso></c> will not consider that node, but tracing already activated on the node will continue to be in effect.</p> <p>Returns <c>ok</c>, cannot fail.</p> @@ -688,37 +727,42 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <desc> <p>This function starts a server on the local node that will be the recipient of all trace messages. All subsequent calls - to <c>p/2</c> will result in messages sent to the newly + to <c><seealso marker="#p-2">p/2</seealso></c> will result in messages sent to the newly started trace server.</p> <p>A trace server started in this way will simply display the trace messages in a formatted way in the Erlang shell - (i. e. use io:format). See <c>tracer/2</c> for a description - of how the trace message handler can be customized. <marker id="tracer2"></marker> -</p> - <p>To start a similar tracer on a remote node, use <c>n/1</c>.</p> + (i. e. use io:format). See <c><seealso marker="#tracer-2">tracer/2</seealso></c> for a description + of how the trace message handler can be customized. + </p> + <p>To start a similar tracer on a remote node, use <c><seealso marker="#n-1">n/1</seealso></c>.</p> </desc> </func> <func> <name>tracer(Type, Data) -> {ok, pid()} | {error, Error}</name> <fsummary>Start a tracer server with additional parameters</fsummary> <type> - <v>Type = port | process</v> - <v>Data = PortGenerator | HandlerSpec</v> - <v>HandlerSpec = {HandlerFun, InitialData}</v> - <v>HandlerFun = fun() (two arguments)</v> - <v>InitialData = term()</v> + <v>Type = port | process | module</v> + <v>Data = PortGenerator | HandlerSpec | ModuleSpec</v> <v>PortGenerator = fun() (no arguments)</v> <v>Error = term()</v> + <v>HandlerSpec = {HandlerFun, InitialData}</v> + <v>HandlerFun = fun() (two arguments)</v> + <v>ModuleSpec = fun() (no arguments) | {TracerModule, TracerState}</v> + <v>ModuleModule = atom()</v> + <v>InitialData = TracerState = term()</v> </type> <desc> <p>This function starts a tracer server with additional parameters on the local node. The first parameter, the <c>Type</c>, indicates if trace messages should be handled - by a receiving process (<c>process</c>) or by a tracer port - (<c>port</c>). For a description about tracer ports see - <c>trace_port/2</c>. + by a receiving process (<c>process</c>), by a tracer port + (<c>port</c>) or by a tracer module + (<c>module</c>). For a description about tracer ports see + <c><seealso marker="#trace_port-2">trace_port/2</seealso></c> + and for a tracer modules see + <c><seealso marker="erts:erl_tracer">erl_tracer</seealso>.</c> </p> - <p>If <c>Type</c> is a process, a message handler function can + <p>If <c>Type</c> is <c>process</c>, a message handler function can be specified (<c>HandlerSpec</c>). The handler function, which should be a <c>fun</c> taking two arguments, will be called for each trace message, with the first argument containing the @@ -729,18 +773,22 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ choose any appropriate action to take when invoked, and can save a state for the next invocation by returning it. </p> - <p>If <c>Type</c> is a port, then the second parameter should + <p>If <c>Type</c> is <c>port</c>, then the second parameter should be a <em>fun</em> which takes no arguments and returns a newly opened trace port when called. Such a <em>fun</em> is - preferably generated by calling <c>trace_port/2</c>. + preferably generated by calling <c><seealso marker="#trace_port-2">trace_port/2</seealso></c>. </p> + <p>if <c>Type</c> is <c>module</c>, then the second parameter should + be either a tuple describing the <c><seealso marker="erts:erl_tracer">erl_tracer</seealso></c> + module to be used for tracing and the state to be used for + that tracer module or a fun returning the same tuple.</p> <p>If an error is returned, it can either be due to a tracer server already running (<c>{error,already_started}</c>) or due to the <c>HandlerFun</c> throwing an exception. </p> <p>To start a similar tracer on a remote node, use - <c>tracer/3</c>. <marker id="trace_port"></marker> -</p> + <c><seealso marker="#tracer-3">tracer/3</seealso></c>. + </p> </desc> </func> <func> @@ -750,20 +798,19 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <v>Nodename = atom()</v> </type> <desc> - <p>This function is equivalent to <c>tracer/2</c>, but acts on + <p>This function is equivalent to <c><seealso marker="#tracer-2">tracer/2</seealso></c>, but acts on the given node. A tracer is started on the node - (<c>Nodename</c>) and the node is added to the list of traced - nodes. + (<c>Nodename</c>) and the node is added to the list of traced nodes. </p> <note> - <p>This function is not equivalent to <c>n/1</c>. While - <c>n/1</c> starts a process tracer which redirects all trace + <p>This function is not equivalent to <c><seealso marker="#n-1">n/1</seealso></c>. While + <c><seealso marker="#n-1">n/1</seealso></c> starts a process tracer which redirects all trace information to a process tracer on the local node (i.e. the - trace control node), <c>tracer/3</c> starts a tracer of any + trace control node), <c><seealso marker="#tracer-3">tracer/3</seealso></c> starts a tracer of any type which is independent of the tracer on the trace control node.</p> </note> - <p>For details, see <seealso marker="#tracer2"><c>tracer/2</c></seealso>.</p> + <p>For details, see <c><seealso marker="#tracer-2">tracer/2</seealso></c>.</p> </desc> </func> <func> @@ -795,9 +842,9 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <c>file</c> and the <c>ip</c> trace drivers. The file driver sends all trace messages into one or several binary files, from where they later can be fetched and processed with the - <c>trace_client/2</c> function. The ip driver opens a TCP/IP + <c><seealso marker="#trace_client-2">trace_client/2</seealso></c> function. The ip driver opens a TCP/IP port where it listens for connections. When a client - (preferably started by calling <c>trace_client/2</c> on + (preferably started by calling <c><seealso marker="#trace_client-2">trace_client/2</seealso></c> on another Erlang node) connects, all trace messages are sent over the IP network for further processing by the remote client. </p> @@ -836,7 +883,7 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ as fast as they are produced by the runtime system, a special message is sent, which indicates how many messages that are dropped. That message will arrive at the handler function - specified in <c>trace_client/3</c> as the tuple <c>{drop, N}</c> where <c>N</c> is the number of consecutive messages + specified in <c><seealso marker="#trace_client-3">trace_client/3</seealso></c> as the tuple <c>{drop, N}</c> where <c>N</c> is the number of consecutive messages dropped. In case of heavy tracing, drop's are likely to occur, and they surely occur if no client is reading the trace messages.</p> @@ -890,7 +937,7 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ </item> <tag><c>get_listen_port</c></tag> <item> - <p>Returns <c>{ok, IpPort}</c> where <c>IpPort</c>is + <p>Returns <c>{ok, IpPort}</c> where <c>IpPort</c> is the IP port number used by the driver listen socket. Only the ip trace driver supports this operation.</p> </item> @@ -913,7 +960,7 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <desc> <p>This function starts a trace client that reads the output created by a trace port driver and handles it in mostly the - same way as a tracer process created by the <c>tracer/0</c> + same way as a tracer process created by the <c><seealso marker="#tracer-0">tracer/0</seealso></c> function.</p> <p>If <c>Type</c> is <c>file</c>, the client reads all trace messages stored in the file named <c>Filename</c> or @@ -925,7 +972,7 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard)\ <p>If <c>Type</c> is <c>follow_file</c>, the client behaves as in the <c>file</c> case, but keeps trying to read (and process) more data - from the file until stopped by <c>stop_trace_client/1</c>. + from the file until stopped by <c><seealso marker="#stop_trace_client-1">stop_trace_client/1</seealso></c>. <c>WrapFilesSpec</c> is not allowed as second argument for this <c>Type</c>.</p> <p>If <c>Type</c> is <c>ip</c>, the client connects to the @@ -981,10 +1028,10 @@ hello</pre> <v>InitialData = term()</v> </type> <desc> - <p>This function works exactly as <c>trace_client/2</c>, but + <p>This function works exactly as <c><seealso marker="#trace_client-2">trace_client/2</seealso></c>, but allows you to write your own handler function. The handler function works mostly as the one described in - <c>tracer/2</c>, but will also have to be prepared to handle + <c><seealso marker="#tracer-2">tracer/2</seealso></c>, but will also have to be prepared to handle trace messages of the form <c>{drop, N}</c>, where <c>N</c> is the number of dropped messages. This pseudo trace message will only occur if the ip trace driver is used.</p> @@ -1003,7 +1050,7 @@ hello</pre> <desc> <p>This function shuts down a previously started trace client. The <c>Pid</c> argument is the process id returned - from the <c>trace_client/2</c> or <c>trace_client/3</c> call.</p> + from the <c><seealso marker="#trace_client-2">trace_client/2</seealso></c> or <c><seealso marker="#trace_client-3">trace_client/3</seealso></c> call.</p> </desc> </func> <func> @@ -1018,11 +1065,11 @@ hello</pre> <fsummary>Return the process or port to which all trace messages are sent.</fsummary> <type> <v>Nodename = atom()</v> - <v>Tracer = port() | pid()</v> + <v>Tracer = port() | pid() | {module(), term()}</v> </type> <desc> - <p>Returns the process or port to which all trace - messages are sent. </p> + <p>Returns the process, port or tracer module to which all trace + messages are sent.</p> </desc> </func> <func> @@ -1156,8 +1203,9 @@ SeqTrace [0]: (<0.30.0>) <0.25.0> ! {dbg,{ok,<0.31.0>}} [Serial: {4,5}] of causing a deadlock. This will happen if a group leader process generates a trace message and the tracer process, by calling the trace handler function, sends an IO request to the same group leader. The problem can only occur if the trace handler - prints to tty using an <c>io</c> function such as <c>format/2</c>. Note that when - <c>dbg:p(all,call)</c> is called, IO processes are also traced. + prints to tty using an <c>io</c> function such as <c><seealso marker="stdlib:io#format-2">format/2</seealso></c>. + Note that when + <c>dbg:p(all,call)</c> is called, IO processes are also traced. Here's an example:</p> <pre> %% Using a default line editing shell diff --git a/lib/runtime_tools/doc/src/part.xml b/lib/runtime_tools/doc/src/part.xml index 14e8b71c83..34acf69fc8 100644 --- a/lib/runtime_tools/doc/src/part.xml +++ b/lib/runtime_tools/doc/src/part.xml @@ -34,6 +34,7 @@ <p><em>Runtime Tools</em></p> </description> + <xi:include href="LTTng.xml"/> <xi:include href="DTRACE.xml"/> <xi:include href="SYSTEMTAP.xml"/> </part> diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl index 6eea1a0917..d5ff874206 100644 --- a/lib/runtime_tools/src/dbg.erl +++ b/lib/runtime_tools/src/dbg.erl @@ -298,7 +298,12 @@ tracer(port, Port) when is_port(Port) -> start(fun() -> Port end); tracer(process, {Handler,HandlerData}) -> - start(fun() -> start_tracer_process(Handler, HandlerData) end). + start(fun() -> start_tracer_process(Handler, HandlerData) end); + +tracer(module, Fun) when is_function(Fun) -> + start(Fun); +tracer(module, {Module, State}) -> + start(fun() -> {Module, State} end). remote_tracer(port, Fun) when is_function(Fun) -> @@ -308,7 +313,13 @@ remote_tracer(port, Port) when is_port(Port) -> remote_start(fun() -> Port end); remote_tracer(process, {Handler,HandlerData}) -> - remote_start(fun() -> start_tracer_process(Handler, HandlerData) end). + remote_start(fun() -> start_tracer_process(Handler, HandlerData) end); + +remote_tracer(module, Fun) when is_function(Fun) -> + remote_start(Fun); +remote_tracer(module, {Module, State}) -> + remote_start(fun() -> {Module, State} end). + remote_start(StartTracer) -> case (catch StartTracer()) of @@ -543,9 +554,8 @@ c(M, F, A, Flags) -> {error,Reason} -> {error,Reason}; Flags1 -> tracer(), - {ok, Tracer} = get_tracer(), S = self(), - Pid = spawn(fun() -> c(S, M, F, A, [{tracer, Tracer} | Flags1]) end), + Pid = spawn(fun() -> c(S, M, F, A, [get_tracer_flag() | Flags1]) end), Mref = erlang:monitor(process, Pid), receive {'DOWN', Mref, _, _, Reason} -> @@ -660,6 +670,9 @@ loop({C,T}=SurviveLinks, Table) -> reply(From, {error, Reason}); Tracer when is_pid(Tracer); is_port(Tracer) -> put(node(),{self(),Tracer}), + reply(From, {ok,self()}); + {Module, _State} = Tracer when is_atom(Module) -> + put(node(),{self(),Tracer}), reply(From, {ok,self()}) end; {_Relay,_Tracer} -> @@ -710,6 +723,9 @@ loop({C,T}=SurviveLinks, Table) -> {_LocalRelay,Tracer} when is_port(Tracer) -> reply(From, {error, cant_trace_remote_pid_to_local_port}), loop(SurviveLinks, Table); + {_LocalRelay,Tracer} when is_tuple(Tracer) -> + reply(From, {error, cant_trace_remote_pid_to_local_module}), + loop(SurviveLinks, Table); {_LocalRelay,Tracer} when is_pid(Tracer) -> case (catch relay(Node, Tracer)) of {ok,Relay} -> @@ -879,9 +895,9 @@ trac(Proc, How, Flags) -> end end. -trac(Node, {_Relay, Tracer}, AtomPid, How, Flags) -> +trac(Node, {_Replay, Tracer}, AtomPid, How, Flags) -> case rpc:call(Node, ?MODULE, erlang_trace, - [AtomPid, How, [{tracer, Tracer} | Flags]]) of + [AtomPid, How, [get_tracer_flag(Tracer) | Flags]]) of N when is_integer(N) -> {matched, Node, N}; {badrpc,Reason} -> @@ -1114,7 +1130,7 @@ transform_flags([sos|Tail],Acc) -> transform_flags(Tail,[set_on_spawn|Acc]); transform_flags([sol|Tail],Acc) -> transform_flags(Tail,[set_on_link|Acc]); transform_flags([sofs|Tail],Acc) -> transform_flags(Tail,[set_on_first_spawn|Acc]); transform_flags([sofl|Tail],Acc) -> transform_flags(Tail,[set_on_first_link|Acc]); -transform_flags([all|_],_Acc) -> all()--[silent]; +transform_flags([all|_],_Acc) -> all()--[silent,running]; transform_flags([F|Tail]=List,Acc) when is_atom(F) -> case lists:member(F, all()) of true -> transform_flags(Tail,[F|Acc]); @@ -1123,9 +1139,10 @@ transform_flags([F|Tail]=List,Acc) when is_atom(F) -> transform_flags(Bad,_Acc) -> {error,{bad_flags,Bad}}. all() -> - [send,'receive',call,procs,garbage_collection,running, + [send,'receive',call,procs,ports,garbage_collection,running, set_on_spawn,set_on_first_spawn,set_on_link,set_on_first_link, - timestamp,arity,return_to,silent]. + timestamp,monotonic_timestamp,strict_monotonic_timestamp, + arity,return_to,silent,running_procs,running_ports]. display_info([Node|Nodes]) -> io:format("~nNode ~w:~n",[Node]), @@ -1146,24 +1163,34 @@ display_info1([]) -> ok. get_info() -> - get_info(processes(),[]). + get_info(processes(),get_info(erlang:ports(),[])). +get_info([Port|T], Acc) when is_port(Port) -> + case pinfo(Port, name) of + undefined -> + get_info(T,Acc); + {name, Name} -> + get_info(T,get_tinfo(Port, Name, Acc)) + end; get_info([Pid|T],Acc) -> case pinfo(Pid, initial_call) of undefined -> get_info(T,Acc); {initial_call, Call} -> - case tinfo(Pid, flags) of - undefined -> - get_info(T,Acc); - {flags,[]} -> - get_info(T,Acc); - {flags,Flags} -> - get_info(T,[{Pid,Call,Flags}|Acc]) - end + get_info(T,get_tinfo(Pid, Call, Acc)) end; get_info([],Acc) -> Acc. +get_tinfo(P, Id, Acc) -> + case tinfo(P, flags) of + undefined -> + Acc; + {flags,[]} -> + Acc; + {flags,Flags} -> + [{P,Id,Flags}|Acc] + end. + format_trace([]) -> []; format_trace([Item]) -> [ts(Item)]; format_trace([Item|T]) -> [ts(Item) ," | ", format_trace(T)]. @@ -1188,9 +1215,22 @@ to_pidspec(X) when is_pid(X) -> true -> X; false -> {badpid,X} end; -to_pidspec(new) -> new; -to_pidspec(all) -> all; -to_pidspec(existing) -> existing; +to_pidspec(X) when is_port(X) -> + case erlang:port_info(X) of + undefined -> {badport, X}; + _ -> X + end; +to_pidspec(Tag) + when Tag =:= all; + Tag =:= ports; + Tag =:= processes; + Tag =:= new; + Tag =:= new_ports; + Tag =:= new_processes; + Tag =:= existing; + Tag =:= existing_ports; + Tag =:= existing_processes -> + Tag; to_pidspec(X) when is_atom(X) -> case whereis(X) of undefined -> {badpid,X}; @@ -1203,6 +1243,7 @@ to_pidspec(X) -> {badpid,X}. %% to_pid(X) when is_pid(X) -> X; +to_pid(X) when is_port(X) -> X; to_pid(X) when is_integer(X) -> to_pid({0,X,0}); to_pid({X,Y,Z}) -> to_pid(lists:concat(["<",integer_to_list(X),".", @@ -1217,9 +1258,12 @@ to_pid(X) when is_list(X) -> to_pid(X) -> {badpid,X}. +pinfo(P, X) when node(P) == node(), is_port(P) -> erlang:port_info(P, X); pinfo(P, X) when node(P) == node() -> erlang:process_info(P, X); +pinfo(P, X) when is_port(P) -> check(rpc:call(node(P), erlang, port_info, [P, X])); pinfo(P, X) -> check(rpc:call(node(P), erlang, process_info, [P, X])). + tinfo(P, X) when node(P) == node() -> erlang:trace_info(P, X); tinfo(P, X) -> check(rpc:call(node(P), erlang, trace_info, [P, X])). @@ -1411,6 +1455,13 @@ get_tracer() -> req({get_tracer,node()}). get_tracer(Node) -> req({get_tracer,Node}). +get_tracer_flag() -> + {ok, Tracer} = get_tracer(), + get_tracer_flag(Tracer). +get_tracer_flag({Module,State}) -> + {tracer, Module, State}; +get_tracer_flag(Port = Pid) when is_port(Port); is_pid(Pid)-> + {tracer, Pid = Port}. save_pattern([]) -> 0; diff --git a/lib/runtime_tools/src/dyntrace.erl b/lib/runtime_tools/src/dyntrace.erl index f7dbef6929..28e6d67d96 100644 --- a/lib/runtime_tools/src/dyntrace.erl +++ b/lib/runtime_tools/src/dyntrace.erl @@ -41,6 +41,28 @@ pn/1, pn/2, pn/3, pn/4, pn/5, pn/6, pn/7, pn/8, pn/9]). -export([put_tag/1, get_tag/0, get_tag_data/0, spread_tag/1, restore_tag/1]). +-export([trace/5, + trace/6, + trace_procs/6, + trace_ports/6, + trace_running_procs/6, + trace_running_ports/6, + trace_call/6, + trace_send/6, + trace_receive/6, + trace_garbage_collection/6]). + +-export([enabled_procs/3, + enabled_ports/3, + enabled_running_procs/3, + enabled_running_ports/3, + enabled_call/3, + enabled_send/3, + enabled_receive/3, + enabled_garbage_collection/3, + enabled/3]). + + -export([user_trace_i4s4/9]). % Know what you're doing! -on_load(on_load/0). @@ -125,6 +147,63 @@ user_trace_i4s4(_, _, _, _, _, _, _, _, _) -> user_trace_n(_, _, _, _, _, _, _, _, _, _) -> erlang:nif_error(nif_not_loaded). +trace(_TracerState, _Label, _SeqTraceInfo, _, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_procs(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_ports(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_running_procs(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_running_ports(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_call(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_send(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_receive(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_garbage_collection(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +enabled(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_procs(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_ports(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_running_procs(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_running_ports(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_call(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_send(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_receive(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_garbage_collection(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + %%% %%% Erlang support functions %%% diff --git a/lib/runtime_tools/src/msacc.erl b/lib/runtime_tools/src/msacc.erl index 612effa5aa..4db5dbec91 100644 --- a/lib/runtime_tools/src/msacc.erl +++ b/lib/runtime_tools/src/msacc.erl @@ -32,18 +32,18 @@ -type msacc_data() :: [msacc_data_thread()]. --type msacc_data_thread() :: #{ '$type' => msacc_data, - type => msacc_type(), id => msacc_id(), - counters => msacc_data_counters() }. +-type msacc_data_thread() :: #{ '$type' := msacc_data, + type := msacc_type(), id := msacc_id(), + counters := msacc_data_counters() }. -type msacc_data_counters() :: #{ msacc_state() => non_neg_integer()}. -type msacc_stats() :: [msacc_stats_thread()]. --type msacc_stats_thread() :: #{ '$type' => msacc_stats, - type => msacc_type(), id => msacc_id(), - system => float(), - counters => msacc_stats_counters()}. --type msacc_stats_counters() :: #{ msacc_state() => #{ thread => float(), - system => float()}}. +-type msacc_stats_thread() :: #{ '$type' := msacc_stats, + type := msacc_type(), id := msacc_id(), + system := float(), + counters := msacc_stats_counters()}. +-type msacc_stats_counters() :: #{ msacc_state() => #{ thread := float(), + system := float()}}. -type msacc_type() :: scheduler | aux | async. diff --git a/lib/runtime_tools/test/Makefile b/lib/runtime_tools/test/Makefile index 432a361468..61377ea09e 100644 --- a/lib/runtime_tools/test/Makefile +++ b/lib/runtime_tools/test/Makefile @@ -4,6 +4,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES = \ dyntrace_SUITE \ + dyntrace_lttng_SUITE \ runtime_tools_SUITE \ system_information_SUITE \ dbg_SUITE \ diff --git a/lib/runtime_tools/test/dbg_SUITE.erl b/lib/runtime_tools/test/dbg_SUITE.erl index d40efcafef..9c9d6ca352 100644 --- a/lib/runtime_tools/test/dbg_SUITE.erl +++ b/lib/runtime_tools/test/dbg_SUITE.erl @@ -20,284 +20,272 @@ -module(dbg_SUITE). %% Test functions --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - big/1, tiny/1, simple/1, message/1, distributed/1, - ip_port/1, file_port/1, file_port2/1, file_port_schedfix/1, - ip_port_busy/1, wrap_port/1, wrap_port_time/1, - with_seq_trace/1, dead_suspend/1, local_trace/1, - saved_patterns/1, tracer_exit_on_stop/1]). --export([init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0, + big/1, tiny/1, simple/1, message/1, distributed/1, port/1, + ip_port/1, file_port/1, file_port2/1, file_port_schedfix/1, + ip_port_busy/1, wrap_port/1, wrap_port_time/1, + with_seq_trace/1, dead_suspend/1, local_trace/1, + saved_patterns/1, tracer_exit_on_stop/1, + erl_tracer/1, distributed_erl_tracer/1]). -export([tracee1/1, tracee2/1]). -export([dummy/0, exported/1]). +-export([enabled/3, trace/6, load_nif/1]). -include_lib("common_test/include/ct.hrl"). --define(default_timeout, ?t:minutes(1)). - -init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. -end_per_testcase(_Case, Config) -> - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> - [big, tiny, simple, message, distributed, ip_port, + [big, tiny, simple, message, distributed, port, ip_port, file_port, file_port2, file_port_schedfix, ip_port_busy, wrap_port, wrap_port_time, with_seq_trace, dead_suspend, - local_trace, saved_patterns, tracer_exit_on_stop]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. + local_trace, saved_patterns, tracer_exit_on_stop, + erl_tracer, distributed_erl_tracer]. -end_per_group(_GroupName, Config) -> - Config. - -big(suite) -> []; -big(doc) -> ["Rudimentary interface test"]; +%% Rudimentary interface test big(Config) when is_list(Config) -> - ?line {ok,OldCurDir} = file:get_cwd(), - Datadir=?config(data_dir, Config), - Privdir=?config(priv_dir, Config), - ?line ok=file:set_cwd(Privdir), + {ok,OldCurDir} = file:get_cwd(), + Datadir=proplists:get_value(data_dir, Config), + Privdir=proplists:get_value(priv_dir, Config), + ok=file:set_cwd(Privdir), try - %% make sure dbg is stopped (and returns correctly) - ?line ok = dbg:stop(), - - %% compile test module and make sure it is loaded. - ?line {ok,Mod} = compile:file(Datadir++"/dbg_test",[trace]), - ?line code:purge(dbg_test), - ?line {module, Mod}=code:load_file(dbg_test), - - %% run/debug a named test function. - ?line Pid = spawn_link(dbg_test, loop, [Config]), - ?line true = register(dbg_test_loop, Pid), - ?line {ok,_} = dbg:tracer(), - ?line {ok,[{matched, _node, 1}]} = dbg:p(dbg_test_loop, [m,p,c]), - ?line ok = dbg:c(dbg_test, test, [Config]), - ?line ok = dbg:i(), - ?line dbg_test_loop ! {dbg_test, stop}, - unregister(dbg_test_loop), - ?line ok = dbg:stop(), - - %% run/debug a Pid. - ?line Pid2=spawn_link(dbg_test,loop,[Config]), - ?line {ok,_} = dbg:tracer(), - ?line {ok,[{matched, _node, 1}]} = dbg:p(Pid2,[s,r,p]), - ?line ok = dbg:c(dbg_test, test, [Config]), - ?line ok = dbg:i(), - ?line Pid2 ! {dbg_test, stop}, - - ?line ok=file:set_cwd(OldCurDir) + %% make sure dbg is stopped (and returns correctly) + ok = dbg:stop(), + + %% compile test module and make sure it is loaded. + {ok,Mod} = compile:file(Datadir++"/dbg_test",[trace]), + code:purge(dbg_test), + {module, Mod}=code:load_file(dbg_test), + + %% run/debug a named test function. + Pid = spawn_link(dbg_test, loop, [Config]), + true = register(dbg_test_loop, Pid), + {ok,_} = dbg:tracer(), + {ok,[{matched, _node, 1}]} = dbg:p(dbg_test_loop, [m,p,c]), + ok = dbg:c(dbg_test, test, [Config]), + ok = dbg:i(), + dbg_test_loop ! {dbg_test, stop}, + unregister(dbg_test_loop), + ok = dbg:stop(), + + %% run/debug a Pid. + Pid2=spawn_link(dbg_test,loop,[Config]), + {ok,_} = dbg:tracer(), + {ok,[{matched, _node, 1}]} = dbg:p(Pid2,[s,r,p]), + ok = dbg:c(dbg_test, test, [Config]), + ok = dbg:i(), + Pid2 ! {dbg_test, stop}, + + ok=file:set_cwd(OldCurDir) after - ?line dbg:stop() + dbg:stop() end, ok. -tiny(suite) -> []; -tiny(doc) -> ["Rudimentary interface test"]; +%% Rudimentary interface test tiny(Config) when is_list(Config) -> - ?line {ok,OldCurDir} = file:get_cwd(), - Datadir=?config(data_dir, Config), - Privdir=?config(priv_dir, Config), - ?line ok=file:set_cwd(Privdir), + {ok,OldCurDir} = file:get_cwd(), + Datadir=proplists:get_value(data_dir, Config), + Privdir=proplists:get_value(priv_dir, Config), + ok=file:set_cwd(Privdir), try - %% compile test module and make sure it is loaded. - ?line {ok, Mod} = compile:file(Datadir++"/dbg_test",[trace]), - ?line code:purge(dbg_test), - ?line {module, Mod}=code:load_file(dbg_test), - - ?line Pid=spawn_link(dbg_test,loop,[Config]), - if - is_pid(Pid) -> - ?line dbg:tracer(), - ?line {ok,[{matched, _node, 1}]} = dbg:p(Pid,[s,r,m,p,c]), - ?line ok = dbg:c(dbg_test,test,[Config]), - ?line ok = dbg:i(), - ?line Pid ! {dbg_test, stop}; - true -> - ?line ok=file:set_cwd(OldCurDir), - ?t:fail("Could not spawn external test process.~n"), - failure - end + %% compile test module and make sure it is loaded. + {ok, Mod} = compile:file(Datadir++"/dbg_test",[trace]), + code:purge(dbg_test), + {module, Mod}=code:load_file(dbg_test), + + Pid=spawn_link(dbg_test,loop,[Config]), + if + is_pid(Pid) -> + dbg:tracer(), + {ok,[{matched, _node, 1}]} = dbg:p(Pid,[s,r,m,p,c]), + ok = dbg:c(dbg_test,test,[Config]), + ok = dbg:i(), + Pid ! {dbg_test, stop}; + true -> + ok=file:set_cwd(OldCurDir), + ct:fail("Could not spawn external test process.~n"), + failure + end after - ?line ok = dbg:stop(), - ?line ok = file:set_cwd(OldCurDir) + ok = dbg:stop(), + ok = file:set_cwd(OldCurDir) end, ok. -simple(suite) -> - []; -simple(doc) -> - ["Simple interface test with own handler"]; +%% Simple interface test with own handler simple(Config) when is_list(Config) -> try - ?line start(), - ?line dbg:p(self(),call), - ?line dbg:tp(dbg,ltp,[]), - ?line dbg:ltp(), - ?line stop(), - ?line S = self(), - ?line [{trace,S,call,{dbg,ltp,[]}}] = flush() + start(), + dbg:p(self(),call), + dbg:tp(dbg,ltp,[]), + dbg:ltp(), + stop(), + S = self(), + [{trace,S,call,{dbg,ltp,[]}}] = flush() after - ?line dbg:stop() + dbg:stop() end, ok. -message(suite) -> - []; -message(doc) -> - ["Simple interface test with pam code that appends a message"]; +%% Simple interface test with pam code that appends a message message(Config) when is_list(Config) -> - ?line {ok, _} = start(), + {ok, _} = start(), try - ?line {ok, [{matched, _node, 1}]} = dbg:p(self(),call), - ?line {ok, X} = dbg:tp(dbg,ltp,[{'_',[],[{message, {self}}]}]), - ?line {value, {saved, Saved}} = lists:keysearch(saved, 1, X), - ?line {ok, Y} = dbg:tp(dbg,ln,Saved), - ?line {value, {saved, Saved}} = lists:keysearch(saved, 1, Y), - ?line ok = dbg:ltp(), - ?line ok = dbg:ln() + {ok, [{matched, _node, 1}]} = dbg:p(self(),call), + {ok, X} = dbg:tp(dbg,ltp,[{'_',[],[{message, {self}}]}]), + {value, {saved, Saved}} = lists:keysearch(saved, 1, X), + {ok, Y} = dbg:tp(dbg,ln,Saved), + {value, {saved, Saved}} = lists:keysearch(saved, 1, Y), + ok = dbg:ltp(), + ok = dbg:ln() after - ?line stop() + stop() end, - ?line S = self(), - ?line [{trace,S,call,{dbg,ltp,[]},S}, - {trace,S,call,{dbg,ln,[]},S}] = flush(), + S = self(), + [{trace,S,call,{dbg,ltp,[]},S}, + {trace,S,call,{dbg,ln,[]},S}] = flush(), ok. -distributed(suite) -> - []; -distributed(doc) -> - ["Simple test of distributed tracing"]; +%% Simple test of distributed tracing distributed(Config) when is_list(Config) -> - ?line {ok, _} = start(), - ?line Node = start_slave(), + {ok, _} = start(), + Node = start_slave(), try - ?line RexPid = rpc:call(Node, erlang, whereis, [rex]), - ?line RexPidList = pid_to_list(RexPid), - ?line {ok, Node} = dbg:n(Node), - ?line {ok, X} = dbg:p(all,call), - ?line {value, {matched, Node, _}} = lists:keysearch(Node, 2, X), - ?line {ok, Y} = dbg:p(RexPidList, s), - ?line {value, {matched, Node, 1}} = lists:keysearch(Node, 2, Y), - ?line {ok, Z} = dbg:tp(dbg,ltp,[]), - ?line {value, {matched, Node, 1}} = lists:keysearch(Node, 2, Z), - ?line dbg:cn(Node), - ?line dbg:tp(dbg,ln,[]), - ?line ok = rpc:call(Node, dbg, ltp, []), - ?line ok = rpc:call(Node, dbg, ln, []), - ?line ok = dbg:ln(), - ?line S = self(), - ?line {TraceSend, TraceCall} = - lists:partition(fun ({trace,RP,send,_,_}) when RP =:= RexPid -> true; - (_) -> false end, - flush()), - ?line [_|_] = TraceSend, - ?line [{trace,Pid,call,{dbg,ltp,[]}}, - {trace,S,call,{dbg,ln,[]}}] = TraceCall, - ?line Node = node(Pid), - %% - ?line stop() + RexPid = rpc:call(Node, erlang, whereis, [rex]), + RexPidList = pid_to_list(RexPid), + {ok, Node} = dbg:n(Node), + {ok, X} = dbg:p(all,call), + {value, {matched, Node, _}} = lists:keysearch(Node, 2, X), + {ok, Y} = dbg:p(RexPidList, s), + {value, {matched, Node, 1}} = lists:keysearch(Node, 2, Y), + {ok, Z} = dbg:tp(dbg,ltp,[]), + {value, {matched, Node, 1}} = lists:keysearch(Node, 2, Z), + dbg:cn(Node), + dbg:tp(dbg,ln,[]), + ok = rpc:call(Node, dbg, ltp, []), + ok = rpc:call(Node, dbg, ln, []), + ok = dbg:ln(), + S = self(), + {TraceSend, TraceCall} = + lists:partition(fun ({trace,RP,send,_,_}) when RP =:= RexPid -> true; + (_) -> false end, + flush()), + [_|_] = TraceSend, + [{trace,Pid,call,{dbg,ltp,[]}}, + {trace,S,call,{dbg,ln,[]}}] = TraceCall, + Node = node(Pid), + %% + stop() after - ?line stop_slave(Node), - ?line stop() + stop_slave(Node), + stop() end, ok. -local_trace(suite) -> - []; -local_trace(doc) -> - ["Tests tracing of local function calls."]; +%% Tests tracing of local function calls. local_trace(Config) when is_list(Config) -> - ?line {ok, _} = start(), + {ok, _} = start(), try - ?line S = self(), - ?line %% Split "<X.Y.Z>" into {X, Y, Z} - ?line "<"++L1 = L = pid_to_list(S), - ?line NoDot = fun ($.) -> false; (_) -> true end, - ?line {LX,"."++L2} = lists:splitwith(NoDot, L1), - ?line {LY,"."++L3} = lists:splitwith(NoDot, L2), - ?line ">"++L4 = lists:reverse(L3), - ?line LZ = lists:reverse(L4), - ?line X = 0 = list_to_integer(LX), - ?line Y = list_to_integer(LY), - ?line Z = list_to_integer(LZ), - ?line XYZ = {X, Y, Z}, - ?line io:format("Self = ~w = ~w~n", [S,XYZ]), - ?line {ok, [{matched, _node, 1}]} = dbg:p(S,call), - ?line {ok, [{matched, _node, 1}]} = dbg:p(XYZ,call), - if Z =:= 0 -> - ?line {ok, [{matched, _node, 1}]} = dbg:p(Y,call); - true -> ok - end, - ?line {ok, [{matched, _node, 1}]} = dbg:p(L,call), - ?line {ok, _} = dbg:tpl(?MODULE,not_exported,[]), - ?line 4 = not_exported(2), - ?line [{trace,S,call,{?MODULE,not_exported,[2]}}] = flush(), - ?line {ok, _} = dbg:tp(?MODULE,exported,[]), - ?line 4 = ?MODULE:exported(2), - ?line [{trace,S,call,{?MODULE,exported,[2]}}, - {trace,S,call,{?MODULE,not_exported,[2]}}] = flush(), - ?line {ok, _} = dbg:ctpl(?MODULE), - ?line 4 = ?MODULE:exported(2), - ?line [{trace,S,call,{?MODULE,exported,[2]}}] = flush(), - ?line {ok, _} = dbg:tpl(?MODULE,not_exported,[]), - ?line {ok, _} = dbg:ctp(?MODULE), - ?line 4 = ?MODULE:exported(2), - ?line [] = flush(), - ?line {ok, _} = dbg:tpl(?MODULE,not_exported,x), - ?line catch ?MODULE:exported(x), - ?line [{trace,S,call,{dbg_SUITE,not_exported,[x]}}, - {trace,S,exception_from, - {dbg_SUITE,not_exported,1}, - {error,badarith}}] = flush() + S = self(), + %% Split "<X.Y.Z>" into {X, Y, Z} + "<"++L1 = L = pid_to_list(S), + NoDot = fun ($.) -> false; (_) -> true end, + {LX,"."++L2} = lists:splitwith(NoDot, L1), + {LY,"."++L3} = lists:splitwith(NoDot, L2), + ">"++L4 = lists:reverse(L3), + LZ = lists:reverse(L4), + X = 0 = list_to_integer(LX), + Y = list_to_integer(LY), + Z = list_to_integer(LZ), + XYZ = {X, Y, Z}, + io:format("Self = ~w = ~w~n", [S,XYZ]), + {ok, [{matched, _node, 1}]} = dbg:p(S,call), + {ok, [{matched, _node, 1}]} = dbg:p(XYZ,call), + if Z =:= 0 -> + {ok, [{matched, _node, 1}]} = dbg:p(Y,call); + true -> ok + end, + {ok, [{matched, _node, 1}]} = dbg:p(L,call), + {ok, _} = dbg:tpl(?MODULE,not_exported,[]), + 4 = not_exported(2), + [{trace,S,call,{?MODULE,not_exported,[2]}}] = flush(), + {ok, _} = dbg:tp(?MODULE,exported,[]), + 4 = ?MODULE:exported(2), + [{trace,S,call,{?MODULE,exported,[2]}}, + {trace,S,call,{?MODULE,not_exported,[2]}}] = flush(), + {ok, _} = dbg:ctpl(?MODULE), + 4 = ?MODULE:exported(2), + [{trace,S,call,{?MODULE,exported,[2]}}] = flush(), + {ok, _} = dbg:tpl(?MODULE,not_exported,[]), + {ok, _} = dbg:ctp(?MODULE), + 4 = ?MODULE:exported(2), + [] = flush(), + {ok, _} = dbg:tpl(?MODULE,not_exported,x), + catch ?MODULE:exported(x), + [{trace,S,call,{dbg_SUITE,not_exported,[x]}}, + {trace,S,exception_from, + {dbg_SUITE,not_exported,1}, + {error,badarith}}] = flush() after - ?line stop() + stop() end, ok. -saved_patterns(suite) -> - []; -saved_patterns(doc) -> - ["Tests saving of match_spec's."]; +%% Test that tracing on port works +port(Config) when is_list(Config) -> + try + S = self(), + start(), + TestFile = filename:join(proplists:get_value(priv_dir, Config),"port_test"), + Fun = dbg:trace_port(file, TestFile), + + %% Do a run to get rid of all extra port operations + port_close(Fun()), + + dbg:p(new,ports), + Port = Fun(), + port_close(Port), + stop(), + + TraceFileDrv = list_to_atom(lists:flatten(["trace_file_drv n ",TestFile])), + [{trace,Port,open,S,TraceFileDrv}, + {trace,Port,getting_linked,S}, + {trace,Port,closed,normal}, + {trace,Port,unlink,S}] = flush() + after + dbg:stop() + end, + ok. + +%% Tests saving of match_spec's. saved_patterns(Config) when is_list(Config) -> - ?line dbg:stop(), - ?line {ok,[{saved,1}]} = - dbg:tp(dbg,ctp,1,[{'_',[],[{message, blahonga}]}]), - ?line {ok,[{saved,2}]} = - dbg:tp(dbg,ctp,1,[{['_'],[],[{message, blahonga}]}]), - ?line Privdir=?config(priv_dir, Config), - ?line file:make_dir(Privdir), - ?line File = filename:join([Privdir, "blahonga.ms"]), - ?line dbg:wtp(File), - ?line dbg:stop(), - ?line dbg:ctp('_','_','_'), - ?line {ok, _} = start(), + dbg:stop(), + {ok,[{saved,1}]} = + dbg:tp(dbg,ctp,1,[{'_',[],[{message, blahonga}]}]), + {ok,[{saved,2}]} = + dbg:tp(dbg,ctp,1,[{['_'],[],[{message, blahonga}]}]), + Privdir=proplists:get_value(priv_dir, Config), + file:make_dir(Privdir), + File = filename:join([Privdir, "blahonga.ms"]), + dbg:wtp(File), + dbg:stop(), + dbg:ctp('_','_','_'), + {ok, _} = start(), try - ?line dbg:rtp(File), - ?line {ok,[{matched,_node,1},{saved,1}]} = dbg:tp(dbg,ltp,0,1), - ?line {ok, [{matched, _node, 1}]} = dbg:p(self(),call), - ?line dbg:ltp(), - ?line S = self(), - ?line [{trace,S,call,{dbg,ltp,[]},blahonga}] = flush() + dbg:rtp(File), + {ok,[{matched,_node,1},{saved,1}]} = dbg:tp(dbg,ltp,0,1), + {ok, [{matched, _node, 1}]} = dbg:p(self(),call), + dbg:ltp(), + S = self(), + [{trace,S,call,{dbg,ltp,[]},blahonga}] = flush() after - ?line stop() + stop() end, ok. @@ -309,148 +297,132 @@ not_exported(N) -> exported(N) -> not_exported(N). -ip_port(suite) -> - []; -ip_port(doc) -> - ["Test tracing to IP port"]; +%% Test tracing to IP port ip_port(Config) when is_list(Config) -> - ?line stop(), - ?line Port = dbg:trace_port(ip, 0), - ?line {ok, _} = dbg:tracer(port, Port), + stop(), + Port = dbg:trace_port(ip, 0), + {ok, _} = dbg:tracer(port, Port), try - ?line {ok, [{matched, _node, 1}]} = dbg:p(self(),call), - ?line {ok, X} = dbg:tp(dbg, ltp,[{'_',[],[{message, {self}}]}]), - ?line {value, {saved, _Saved}} = lists:keysearch(saved, 1, X), - ?line {ok, Y} = dbg:tp(dbg, ln, [{'_',[],[{message, hej}]}]), - ?line {value, {saved, _}} = lists:keysearch(saved, 1, Y), - ?line ok = dbg:ltp(), - ?line ok = dbg:ln(), - ?line {ok, IpPort} = dbg:trace_port_control(get_listen_port), - ?line io:format("IpPort = ~p~n", [IpPort]), - ?line dbg:trace_client(ip, IpPort, {fun myhandler/2, self()}), - ?line S = self(), - ?line [{trace,S,call,{dbg,ltp,[]},S}, - {trace,S,call,{dbg,ln,[]},hej}] = flush() + {ok, [{matched, _node, 1}]} = dbg:p(self(),call), + {ok, X} = dbg:tp(dbg, ltp,[{'_',[],[{message, {self}}]}]), + {value, {saved, _Saved}} = lists:keysearch(saved, 1, X), + {ok, Y} = dbg:tp(dbg, ln, [{'_',[],[{message, hej}]}]), + {value, {saved, _}} = lists:keysearch(saved, 1, Y), + ok = dbg:ltp(), + ok = dbg:ln(), + {ok, IpPort} = dbg:trace_port_control(get_listen_port), + io:format("IpPort = ~p~n", [IpPort]), + dbg:trace_client(ip, IpPort, {fun myhandler/2, self()}), + S = self(), + [{trace,S,call,{dbg,ltp,[]},S}, + {trace,S,call,{dbg,ln,[]},hej}] = flush() after - ?line stop() + stop() end, ok. -ip_port_busy(suite) -> - []; -ip_port_busy(doc) -> - ["Test that the dbg server does not hang if the tracer don't start ", - "(OTP-3592)"]; +%% Test that the dbg server does not hang if the tracer don't start (OTP-3592) ip_port_busy(Config) when is_list(Config) -> - ?line stop(), - ?line Tracer = dbg:trace_port(ip, 4745), - ?line Port = Tracer(), - ?line {error, Reason} = dbg:tracer(port, Tracer), + stop(), + Tracer = dbg:trace_port(ip, 4745), + Port = Tracer(), + {error, Reason} = dbg:tracer(port, Tracer), try - ?line io:format("Error reason = ~p~n", [Reason]), - ?line true = port_close(Port) + io:format("Error reason = ~p~n", [Reason]), + true = port_close(Port) after - ?line dbg:stop() + dbg:stop() end, - ?line ok. + ok. -file_port(suite) -> - []; -file_port(doc) -> - ["Test tracing to file port (simple)"]; +%% Test tracing to file port (simple) file_port(Config) when is_list(Config) -> - ?line stop(), - ?line {A,B,C} = erlang:now(), - ?line FTMP = atom_to_list(?MODULE) ++ integer_to_list(A) ++ "-" ++ - integer_to_list(B) ++ "-" ++ integer_to_list(C), - ?line FName = filename:join([?config(data_dir, Config), FTMP]), - ?line Port = dbg:trace_port(file, FName), - ?line {ok, _} = dbg:tracer(port, Port), + stop(), + {A,B,C} = erlang:now(), + FTMP = atom_to_list(?MODULE) ++ integer_to_list(A) ++ "-" ++ + integer_to_list(B) ++ "-" ++ integer_to_list(C), + FName = filename:join([proplists:get_value(data_dir, Config), FTMP]), + Port = dbg:trace_port(file, FName), + {ok, _} = dbg:tracer(port, Port), try - ?line {ok, [{matched, _node, 1}]} = dbg:p(self(),call), - ?line {ok, X} = dbg:tp(dbg, ltp,[{'_',[],[{message, {self}}]}]), - ?line {value, {saved, _Saved}} = lists:keysearch(saved, 1, X), - ?line {ok, Y} = dbg:tp(dbg, ln, [{'_',[],[{message, hej}]}]), - ?line {value, {saved, _}} = lists:keysearch(saved, 1, Y), - ?line ok = dbg:ltp(), - ?line ok = dbg:ln(), - ?line stop(), - ?line dbg:trace_client(file, FName, {fun myhandler/2, self()}), - ?line S = self(), - ?line [{trace,S,call,{dbg,ltp,[]},S}, - {trace,S,call,{dbg,ln,[]},hej}, - end_of_trace] = flush() + {ok, [{matched, _node, 1}]} = dbg:p(self(),call), + {ok, X} = dbg:tp(dbg, ltp,[{'_',[],[{message, {self}}]}]), + {value, {saved, _Saved}} = lists:keysearch(saved, 1, X), + {ok, Y} = dbg:tp(dbg, ln, [{'_',[],[{message, hej}]}]), + {value, {saved, _}} = lists:keysearch(saved, 1, Y), + ok = dbg:ltp(), + ok = dbg:ln(), + stop(), + dbg:trace_client(file, FName, {fun myhandler/2, self()}), + S = self(), + [{trace,S,call,{dbg,ltp,[]},S}, + {trace,S,call,{dbg,ln,[]},hej}, + end_of_trace] = flush() after - ?line stop(), - ?line file:delete(FName) + stop(), + file:delete(FName) end, ok. -file_port2(suite) -> - []; -file_port2(doc) -> - ["Test tracing to file port with 'follow_file'"]; +%% Test tracing to file port with 'follow_file' file_port2(Config) when is_list(Config) -> stop(), {A,B,C} = erlang:now(), FTMP = atom_to_list(?MODULE) ++ integer_to_list(A) ++ - "-" ++ integer_to_list(B) ++ "-" ++ integer_to_list(C), - FName = filename:join([?config(data_dir, Config), FTMP]), + "-" ++ integer_to_list(B) ++ "-" ++ integer_to_list(C), + FName = filename:join([proplists:get_value(data_dir, Config), FTMP]), %% Ok, lets try with flush and follow_file, not a chance on VxWorks %% with NFS caching... Port2 = dbg:trace_port(file, FName), {ok, _} = dbg:tracer(port, Port2), try - {ok, [{matched, _node, 1}]} = dbg:p(self(),call), - {ok, _} = dbg:tp(dbg, ltp,[{'_',[],[{message, {self}}]}]), - {ok, _} = dbg:tp(dbg, ln, [{'_',[],[{message, hej}]}]), - ok = dbg:ltp(), - ok = dbg:flush_trace_port(), - dbg:trace_client(follow_file, FName, - {fun myhandler/2, self()}), - S = self(), - [{trace,S,call,{dbg,ltp,[]},S}] = flush(), - ok = dbg:ln(), - ok = dbg:flush_trace_port(), - receive after 1000 -> ok end, %% Polls every second... - [{trace,S,call,{dbg,ln,[]},hej}] = flush(), - stop(), - [] = flush() + {ok, [{matched, _node, 1}]} = dbg:p(self(),call), + {ok, _} = dbg:tp(dbg, ltp,[{'_',[],[{message, {self}}]}]), + {ok, _} = dbg:tp(dbg, ln, [{'_',[],[{message, hej}]}]), + ok = dbg:ltp(), + ok = dbg:flush_trace_port(), + dbg:trace_client(follow_file, FName, + {fun myhandler/2, self()}), + S = self(), + [{trace,S,call,{dbg,ltp,[]},S}] = flush(), + ok = dbg:ln(), + ok = dbg:flush_trace_port(), + receive after 1000 -> ok end, %% Polls every second... + [{trace,S,call,{dbg,ln,[]},hej}] = flush(), + stop(), + [] = flush() after - stop(), - file:delete(FName) + stop(), + file:delete(FName) end, ok. -file_port_schedfix(suite) -> - []; -file_port_schedfix(doc) -> - ["Test that the scheduling timestamp fix for trace flag 'running' works."]; +%% Test that the scheduling timestamp fix for trace flag 'running' works. file_port_schedfix(Config) when is_list(Config) -> - ?line case (catch erlang:system_info(smp_support)) of - true -> - {skip, "No schedule fix on SMP"}; - _ -> - try - file_port_schedfix1(Config) - after - dbg:stop() - end - end. + case (catch erlang:system_info(smp_support)) of + true -> + {skip, "No schedule fix on SMP"}; + _ -> + try + file_port_schedfix1(Config) + after + dbg:stop() + end + end. file_port_schedfix1(Config) when is_list(Config) -> - ?line stop(), - ?line {A,B,C} = erlang:now(), - ?line FTMP = atom_to_list(?MODULE) ++ integer_to_list(A) ++ - "-" ++ integer_to_list(B) ++ "-" ++ integer_to_list(C), - ?line FName = filename:join([?config(data_dir, Config), FTMP]), + stop(), + {A,B,C} = erlang:now(), + FTMP = atom_to_list(?MODULE) ++ integer_to_list(A) ++ + "-" ++ integer_to_list(B) ++ "-" ++ integer_to_list(C), + FName = filename:join([proplists:get_value(data_dir, Config), FTMP]), %% - ?line Port = dbg:trace_port(file, {FName, wrap, ".wraplog", 8*1024, 4}), - ?line {ok, _} = dbg:tracer(port, Port), - ?line {ok,[{matched,_node,0}]} = dbg:p(new,[running,procs,send,timestamp]), + Port = dbg:trace_port(file, {FName, wrap, ".wraplog", 8*1024, 4}), + {ok, _} = dbg:tracer(port, Port), + {ok,[{matched,_node,0}]} = dbg:p(new,[running,procs,send,timestamp]), %% %% Generate the trace data %% @@ -471,146 +443,143 @@ file_port_schedfix1(Config) when is_list(Config) -> %% execution time. Wallclock. A normal result is about 10 times more %% without schedule in - schedule out compensation (OTP-3938). %% - ?line ok = token_volleyball(3, 4, 8), + ok = token_volleyball(3, 4, 8), %% - ?line {ok,[{matched,_,_}]} = dbg:p(all, [clear]), - ?line stop(), + {ok,[{matched,_,_}]} = dbg:p(all, [clear]), + stop(), % Some debug code to run on all platforms, for finding the fault on genny % Dont touch please /PaN - ?line io:format("Trace dump by PaN BEGIN~n"), - ?line dbg:trace_client(file,{FName, wrap, ".wraplog"},{fun(end_of_trace,Pid)-> Pid ! done; (Mesg,Pid) -> io:format("~w~n",[Mesg]),Pid end,self()}), + io:format("Trace dump by PaN BEGIN~n"), + dbg:trace_client(file,{FName, wrap, ".wraplog"},{fun(end_of_trace,Pid)-> Pid ! done; (Mesg,Pid) -> io:format("~w~n",[Mesg]),Pid end,self()}), receive done -> ok end, - ?line io:format("Trace dump by PaN END~n"), - %% + io:format("Trace dump by PaN END~n"), + %% %% Get the trace result %% - ?line Tag = make_ref(), - ?line dbg:trace_client(file, {FName, wrap, ".wraplog"}, - {fun schedstat_handler/2, {self(), Tag, []}}), - ?line Result = - receive - {Tag, D} -> - lists:map( - fun({Pid, {A1, B1, C1}}) -> - {Pid, C1/1000000 + B1 + A1*1000000} - end, - D) - end, - ?line ok = io:format("Result=~p", [Result]), -% erlang:display({?MODULE, ?LINE, Result}), + Tag = make_ref(), + dbg:trace_client(file, {FName, wrap, ".wraplog"}, + {fun schedstat_handler/2, {self(), Tag, []}}), + Result = + receive + {Tag, D} -> + lists:map( + fun({Pid, {A1, B1, C1}}) -> + {Pid, C1/1000000 + B1 + A1*1000000} + end, + D) + end, + ok = io:format("Result=~p", [Result]), + % erlang:display({?MODULE, ?LINE, Result}), %% %% Analyze the result %% - ?line {Min, Max} = - lists:foldl( - fun({_Pid, M}, {Mi, Ma}) -> - {if M < Mi -> M; true -> Mi end, - if M > Ma -> M; true -> Ma end} - end, - {void, 0}, - Result), + {Min, Max} = + lists:foldl( + fun({_Pid, M}, {Mi, Ma}) -> + {if M < Mi -> M; true -> Mi end, + if M > Ma -> M; true -> Ma end} + end, + {void, 0}, + Result), % More PaN debug - ?line io:format("Min = ~f, Max = ~f~n",[Min,Max]), + io:format("Min = ~f, Max = ~f~n",[Min,Max]), %% %% Cleanup %% - ?line ToBeDeleted = filelib:wildcard(FName++"*"++".wraplog"), - ?line lists:map(fun file:delete/1, ToBeDeleted), -% io:format("ToBeDeleted=~p", [ToBeDeleted]), + ToBeDeleted = filelib:wildcard(FName++"*"++".wraplog"), + lists:map(fun file:delete/1, ToBeDeleted), + % io:format("ToBeDeleted=~p", [ToBeDeleted]), %% %% Present the result %% P = (Max / Min - 1) * 100, BottomLine = lists:flatten(io_lib:format("~.2f %", [P])), if P > 100 -> - Reason = {BottomLine, '>', "100%"}, - erlang:display({file_port_schedfix, fail, Reason}), - test_server:fail(Reason); + Reason = {BottomLine, '>', "100%"}, + erlang:display({file_port_schedfix, fail, Reason}), + ct:fail(Reason); true -> - {comment, BottomLine} + {comment, BottomLine} end. -wrap_port(suite) -> - []; -wrap_port(doc) -> - ["Test tracing to wrapping file port"]; +%% Test tracing to wrapping file port wrap_port(Config) when is_list(Config) -> - ?line Self = self(), - ?line stop(), - ?line {A,B,C} = erlang:now(), - ?line FTMP = atom_to_list(?MODULE) ++ integer_to_list(A) ++ "-" ++ - integer_to_list(B) ++ "-" ++ integer_to_list(C) ++ "-", - ?line FName = filename:join([?config(data_dir, Config), FTMP]), - ?line FNameWildcard = FName++"*"++".trace", + Self = self(), + stop(), + {A,B,C} = erlang:now(), + FTMP = atom_to_list(?MODULE) ++ integer_to_list(A) ++ "-" ++ + integer_to_list(B) ++ "-" ++ integer_to_list(C) ++ "-", + FName = filename:join([proplists:get_value(data_dir, Config), FTMP]), + FNameWildcard = FName++"*"++".trace", %% WrapSize=0 and WrapCnt=11 will force the trace to wrap after %% every trace message, and to contain only the last 10 entries %% after trace stop since the last file will be empty waiting %% for its first trace message. - ?line WrapSize = 0, - ?line WrapCnt = 11, - ?line WrapFilesSpec = {FName, wrap, ".trace", WrapSize, WrapCnt}, - ?line wrap_port_init(WrapFilesSpec), + WrapSize = 0, + WrapCnt = 11, + WrapFilesSpec = {FName, wrap, ".trace", WrapSize, WrapCnt}, + wrap_port_init(WrapFilesSpec), %% The number of iterations, N, is tested to place wrap the log, %% giving a gap in the filename sequence at index 3. %% This should be a difficult case for %% the trace_client file sorting functionality. N = 7, - ?line lists:foreach( - fun(Cnt) -> - ?MODULE:tracee1(Cnt), - ?MODULE:tracee2(Cnt) - end, - lists:seq(1, N)), - ?line stop(), + lists:foreach( + fun(Cnt) -> + ?MODULE:tracee1(Cnt), + ?MODULE:tracee2(Cnt) + end, + lists:seq(1, N)), + stop(), try - ?line Files1 = filelib:wildcard(FNameWildcard), - ?line io:format("~p~n", [Files1]), - ?line Tc1 = dbg:trace_client(file, WrapFilesSpec, - {fun myhandler/2, {wait_for_go,Self}}), - ?line Tref1 = erlang:monitor(process, Tc1), - Tc1 ! {go,Self}, - ?line [{'DOWN',Tref1,_,_,normal}, - end_of_trace - |Result] = lists:reverse(flush()), - ?line M = N - (WrapCnt-1) div 2, - ?line M = wrap_port_result(Result, Self, N), - %% - %% Start a new wrap log with the same name to verify that - %% all files are cleared at wrap log start. Only produce - %% two trace messages to also place the gap at index 3, - %% so the trace log will be misinterpreted. - %% - ?line wrap_port_init(WrapFilesSpec), - ?line Files2 = filelib:wildcard(FNameWildcard), - ?line io:format("~p~n", [Files2]), - ?line -1 = ?MODULE:tracee1(-1), - ?line -1 = ?MODULE:tracee2(-1), - ?line stop(), - ?line Files = filelib:wildcard(FNameWildcard), - ?line io:format("~p~n", [Files]), - ?line Tc2 = dbg:trace_client(file, WrapFilesSpec, - {fun myhandler/2, {wait_for_go,Self}}), - ?line Tref2 = erlang:monitor(process, Tc2), - Tc2 ! {go,Self}, - ?line [{trace,Self,call,{?MODULE,tracee1,[-1]},Self}, - {trace,Self,call,{?MODULE,tracee2,[-1]},hej}, - end_of_trace, - {'DOWN',Tref2,_,_,normal}] = flush(), - %% - ?line lists:map(fun(F) -> file:delete(F) end, Files) + Files1 = filelib:wildcard(FNameWildcard), + io:format("~p~n", [Files1]), + Tc1 = dbg:trace_client(file, WrapFilesSpec, + {fun myhandler/2, {wait_for_go,Self}}), + Tref1 = erlang:monitor(process, Tc1), + Tc1 ! {go,Self}, + [{'DOWN',Tref1,_,_,normal}, + end_of_trace + |Result] = lists:reverse(flush()), + M = N - (WrapCnt-1) div 2, + M = wrap_port_result(Result, Self, N), + %% + %% Start a new wrap log with the same name to verify that + %% all files are cleared at wrap log start. Only produce + %% two trace messages to also place the gap at index 3, + %% so the trace log will be misinterpreted. + %% + wrap_port_init(WrapFilesSpec), + Files2 = filelib:wildcard(FNameWildcard), + io:format("~p~n", [Files2]), + -1 = ?MODULE:tracee1(-1), + -1 = ?MODULE:tracee2(-1), + stop(), + Files = filelib:wildcard(FNameWildcard), + io:format("~p~n", [Files]), + Tc2 = dbg:trace_client(file, WrapFilesSpec, + {fun myhandler/2, {wait_for_go,Self}}), + Tref2 = erlang:monitor(process, Tc2), + Tc2 ! {go,Self}, + [{trace,Self,call,{?MODULE,tracee1,[-1]},Self}, + {trace,Self,call,{?MODULE,tracee2,[-1]},hej}, + end_of_trace, + {'DOWN',Tref2,_,_,normal}] = flush(), + %% + lists:map(fun(F) -> file:delete(F) end, Files) after - ?line stop() + stop() end, ok. wrap_port_init(WrapFilesSpec) -> - ?line Port = dbg:trace_port(file, WrapFilesSpec), - ?line {ok, _} = dbg:tracer(port, Port), - ?line {ok, [{matched, _node, 1}]} = dbg:p(self(),call), - ?line {ok, X} = dbg:tp(?MODULE, tracee1,[{'_',[],[{message, {self}}]}]), - ?line {value, {saved, _Saved}} = lists:keysearch(saved, 1, X), - ?line {ok, Y} = dbg:tp(?MODULE, tracee2, [{'_',[],[{message, hej}]}]), - ?line {value, {saved, _}} = lists:keysearch(saved, 1, Y), + Port = dbg:trace_port(file, WrapFilesSpec), + {ok, _} = dbg:tracer(port, Port), + {ok, [{matched, _node, 1}]} = dbg:p(self(),call), + {ok, X} = dbg:tp(?MODULE, tracee1,[{'_',[],[{message, {self}}]}]), + {value, {saved, _Saved}} = lists:keysearch(saved, 1, X), + {ok, Y} = dbg:tp(?MODULE, tracee2, [{'_',[],[{message, hej}]}]), + {value, {saved, _}} = lists:keysearch(saved, 1, Y), ok. tracee1(X) -> @@ -622,106 +591,96 @@ tracee2(X) -> wrap_port_result([], _S, M) -> M; wrap_port_result([{trace, S, call, {?MODULE, tracee2, [M]}, hej}, - {trace, S, call, {?MODULE, tracee1, [M]}, S} | Tail], - S, - M) -> + {trace, S, call, {?MODULE, tracee1, [M]}, S} | Tail], + S, + M) -> wrap_port_result(Tail, S, M-1). -wrap_port_time(suite) -> - []; -wrap_port_time(doc) -> - ["Test tracing to time limited wrapping file port"]; +%% Test tracing to time limited wrapping file port wrap_port_time(Config) when is_list(Config) -> - ?line stop(), - ?line {A,B,C} = erlang:now(), - ?line FTMP = atom_to_list(?MODULE) ++ integer_to_list(A) ++ "-" ++ - integer_to_list(B) ++ "-" ++ integer_to_list(C) ++ "-", - ?line FName = filename:join([?config(data_dir, Config), FTMP]), + stop(), + {A,B,C} = erlang:now(), + FTMP = atom_to_list(?MODULE) ++ integer_to_list(A) ++ "-" ++ + integer_to_list(B) ++ "-" ++ integer_to_list(C) ++ "-", + FName = filename:join([proplists:get_value(data_dir, Config), FTMP]), %% WrapTime=2 and WrapCnt=4 will force the trace to wrap after %% every 2 seconds, and to contain between 3*2 and 4*2 seconds %% of trace entries. - ?line WrapFilesSpec = {FName, wrap, ".trace", {time, 2000}, 4}, - ?line Port = dbg:trace_port(file, WrapFilesSpec), - ?line {ok, _} = dbg:tracer(port, Port), + WrapFilesSpec = {FName, wrap, ".trace", {time, 2000}, 4}, + Port = dbg:trace_port(file, WrapFilesSpec), + {ok, _} = dbg:tracer(port, Port), try - ?line {ok, [{matched, _node, 1}]} = dbg:p(self(),call), - ?line {ok, X} = dbg:tp(?MODULE, tracee1,[{'_',[],[{message, {self}}]}]), - ?line {value, {saved, _Saved1}} = lists:keysearch(saved, 1, X), - ?line {ok, Y} = dbg:tp(?MODULE, tracee2, [{'_',[],[{message, hej}]}]), - ?line {value, {saved, _Saved2}} = lists:keysearch(saved, 1, Y), - %% The delays in the iterations places two trace messages in each - %% trace file, but the last which is empty waiting for its first - %% trace message. The number of iterations is chosen so that - %% one trace file has been wasted, and therefore the first pair - %% of trace messages. - ?line lists:foreach( - fun(Cnt) -> - receive after 1000 -> ok end, - ?MODULE:tracee1(Cnt), - ?MODULE:tracee2(Cnt), - receive after 1100 -> ok end - end, - lists:seq(1, 4)), - ?line stop(), - ?line Files = filelib:wildcard(FName ++ "*" ++ ".trace"), - ?line io:format("~p~n", [Files]), - ?line dbg:trace_client(file, WrapFilesSpec, {fun myhandler/2, self()}), - ?line S = self(), - ?line [{trace, S, call, {?MODULE, tracee1, [2]}, S}, - {trace, S, call, {?MODULE, tracee2, [2]}, hej}, - {trace, S, call, {?MODULE, tracee1, [3]}, S}, - {trace, S, call, {?MODULE, tracee2, [3]}, hej}, - {trace, S, call, {?MODULE, tracee1, [4]}, S}, - {trace, S, call, {?MODULE, tracee2, [4]}, hej}, - end_of_trace] = flush(), - ?line lists:map(fun(F) -> file:delete(F) end, Files) + {ok, [{matched, _node, 1}]} = dbg:p(self(),call), + {ok, X} = dbg:tp(?MODULE, tracee1,[{'_',[],[{message, {self}}]}]), + {value, {saved, _Saved1}} = lists:keysearch(saved, 1, X), + {ok, Y} = dbg:tp(?MODULE, tracee2, [{'_',[],[{message, hej}]}]), + {value, {saved, _Saved2}} = lists:keysearch(saved, 1, Y), + %% The delays in the iterations places two trace messages in each + %% trace file, but the last which is empty waiting for its first + %% trace message. The number of iterations is chosen so that + %% one trace file has been wasted, and therefore the first pair + %% of trace messages. + lists:foreach( + fun(Cnt) -> + receive after 1000 -> ok end, + ?MODULE:tracee1(Cnt), + ?MODULE:tracee2(Cnt), + receive after 1100 -> ok end + end, + lists:seq(1, 4)), + stop(), + Files = filelib:wildcard(FName ++ "*" ++ ".trace"), + io:format("~p~n", [Files]), + dbg:trace_client(file, WrapFilesSpec, {fun myhandler/2, self()}), + S = self(), + [{trace, S, call, {?MODULE, tracee1, [2]}, S}, + {trace, S, call, {?MODULE, tracee2, [2]}, hej}, + {trace, S, call, {?MODULE, tracee1, [3]}, S}, + {trace, S, call, {?MODULE, tracee2, [3]}, hej}, + {trace, S, call, {?MODULE, tracee1, [4]}, S}, + {trace, S, call, {?MODULE, tracee2, [4]}, hej}, + end_of_trace] = flush(), + lists:map(fun(F) -> file:delete(F) end, Files) after - ?line stop() + stop() end, ok. -with_seq_trace(suite) -> - []; -with_seq_trace(doc) -> - ["Test ordinary tracing combined with seq_trace"]; +%% Test ordinary tracing combined with seq_trace with_seq_trace(Config) when is_list(Config) -> try - ?line {ok, Server} = start(), - ?line {ok, Tracer} = dbg:get_tracer(), - ?line {ok, X} = dbg:tp(dbg, get_tracer, [{[],[], - [{set_seq_token, send, true}]}]), - ?line {value, {saved, _}} = lists:keysearch(saved, 1, X), - ?line {ok, [{matched, _node, 1}]} = dbg:p(self(),call), - ?line seq_trace:set_system_tracer(Tracer), - ?line dbg:get_tracer(), - receive - after 1 -> - ok - end, - ?line S = self(), - ?line ThisNode = node(), - ?line [{trace,S,call,{dbg,get_tracer,[]}}, - {seq_trace,0,{send,_,S,Server,{S,{get_tracer,ThisNode}}}}, - {seq_trace,0,{send,_,Server,S,{dbg,{ok,Tracer}}}}] = - flush() + {ok, Server} = start(), + {ok, Tracer} = dbg:get_tracer(), + {ok, X} = dbg:tp(dbg, get_tracer, [{[],[], + [{set_seq_token, send, true}]}]), + {value, {saved, _}} = lists:keysearch(saved, 1, X), + {ok, [{matched, _node, 1}]} = dbg:p(self(),call), + seq_trace:set_system_tracer(Tracer), + dbg:get_tracer(), + receive + after 1 -> + ok + end, + S = self(), + ThisNode = node(), + [{trace,S,call,{dbg,get_tracer,[]}}, + {seq_trace,0,{send,_,S,Server,{S,{get_tracer,ThisNode}}}}, + {seq_trace,0,{send,_,Server,S,{dbg,{ok,Tracer}}}}] = + flush() after - ?line stop() + stop() end, ok. -dead_suspend(suite) -> - []; -dead_suspend(doc) -> - ["Test that trace messages concerning a now dead process does " - "not crash dbg."]; +%% Test that trace messages concerning a now dead process does not crash dbg. dead_suspend(Config) when is_list(Config) -> - ?line start(), + start(), try - survived = run_dead_suspend() + survived = run_dead_suspend() after - ?line stop() + stop() end. run_dead_suspend() -> @@ -734,10 +693,10 @@ run_dead_suspend() -> spawn(?MODULE, dummy, []), receive after 1000 -> ok end, case whereis(dbg) of - undefined -> - died; - _ -> - survived + undefined -> + died; + _ -> + survived end. dummy() -> @@ -749,10 +708,10 @@ tracer_exit_on_stop(_) -> %% Tracer blocks waiting for fun to complete so that the trace message and %% the exit signal message from the dbg process are in its message queue. Fun = fun() -> - ?MODULE:dummy(), - Ref = erlang:trace_delivered(self()), - receive {trace_delivered, _, Ref} -> stop() end - end, + ?MODULE:dummy(), + Ref = erlang:trace_delivered(self()), + receive {trace_delivered, _, Ref} -> stop() end + end, {ok, _} = dbg:tracer(process, {fun spawn_once_handler/2, {self(), Fun}}), {ok, Tracer} = dbg:get_tracer(), MRef = monitor(process, Tracer), @@ -771,11 +730,83 @@ spawn_once_handler(Event, {Pid, done} = State) -> spawn_once_handler(Event, {Pid, Fun}) -> {_, Ref} = spawn_monitor(Fun), receive - {'DOWN', Ref, _, _, _} -> - Pid ! Event, - {Pid, done} + {'DOWN', Ref, _, _, _} -> + Pid ! Event, + {Pid, done} end. +%% Test that erl_tracer modules work correctly +erl_tracer(Config) -> + stop(), + + ok = load_nif(Config), + + Self = self(), + {ok, _} = dbg:tracer(module, {?MODULE, Self}), + {ok, {?MODULE, Self}} = dbg:get_tracer(), + {ok, _} = dbg:p(self(), [c, timestamp]), + {ok, _} = dbg:tp(?MODULE, dummy, []), + ok = ?MODULE:dummy(), + [{Self, call, Self, Self, {?MODULE, dummy, []}, undefined, #{}}] = flush(), + ok. + +%% Test that distributed erl_tracer modules work +distributed_erl_tracer(Config) -> + stop(), + + S = self(), + + ok = load_nif(Config), + + LNode = node(), + RNode = start_slave(), + true = rpc:call(RNode, code, add_patha, [filename:join(proplists:get_value(data_dir, Config), "..")]), + ok = rpc:call(RNode, ?MODULE, load_nif, [Config]), + + NifProxy = fun() -> + register(nif_proxy, self()), + receive M -> S ! M end + end, + + LNifProxy = spawn_link(LNode, NifProxy), + RNifProxy = spawn_link(RNode, NifProxy), + + TracerFun = fun() -> {?MODULE, whereis(nif_proxy)} end, + + {ok, _} = dbg:tracer(LNode, module, TracerFun), + {ok, _} = dbg:tracer(RNode, module, TracerFun), + + {ok, [{matched, _, _}, {matched, _, _}]} = dbg:p(all,c), + {ok, [_, _]} = dbg:tp(?MODULE, dummy, []), + + {ok, {?MODULE, LNifProxy}} = dbg:get_tracer(LNode), + {ok, {?MODULE, RNifProxy}} = dbg:get_tracer(RNode), + + LCall = spawn_link(LNode, fun() -> ?MODULE:dummy() end), + [{LCall, call, LNifProxy, LCall, {?MODULE, dummy, []}, undefined, #{}}] = flush(), + + RCall = spawn_link(RNode, fun() -> ?MODULE:dummy() end), + [{RCall, call, RNifProxy, RCall, {?MODULE, dummy, []}, undefined, #{}}] = flush(), + + + ok. + +load_nif(Config) -> + SoFile = atom_to_list(?MODULE), + DataDir = proplists:get_value(data_dir, Config), + case erlang:load_nif(filename:join(DataDir, SoFile) , 0) of + {error, {reload, _}} -> + ok; + ok -> + ok + end. + +enabled(_, _, _) -> + erlang:nif_error(nif_not_loaded). + +trace(_, _, _, _, _, _) -> + erlang:nif_error(nif_not_loaded). + %% %% Support functions %% @@ -794,38 +825,38 @@ wait_node(_,0) -> no; wait_node(Node, N) -> case net_adm:ping(Node) of - pong -> - ok; - pang -> - receive - after 1000 -> - ok - end, - wait_node(Node, N - 1) + pong -> + ok; + pang -> + receive + after 1000 -> + ok + end, + wait_node(Node, N - 1) end. myhandler(Message, {wait_for_go,Pid}) -> receive - {go,Pid} -> - myhandler(Message, Pid) + {go,Pid} -> + myhandler(Message, Pid) end; myhandler(Message, Relay) -> Relay ! Message, case Message of - end_of_trace -> - ok; - _ -> - Relay + end_of_trace -> + ok; + _ -> + Relay end. flush() -> flush([]). flush(Acc) -> receive - X -> - flush(Acc ++ [X]) + X -> + flush(Acc ++ [X]) after 1000 -> - Acc + Acc end. start() -> @@ -839,88 +870,88 @@ stop() -> schedstat_handler(TraceMsg, {Parent, Tag, Data} = State) -> case TraceMsg of - {trace_ts, Pid, in, _, Ts} -> - NewData = - case lists:keysearch(Pid, 1, Data) of - {value, {Pid, Acc}} -> - [{Pid, Acc, Ts} | lists:keydelete(Pid, 1, Data)]; - false -> - [{Pid, {0, 0, 0}, Ts} | Data]; - Other -> - exit(Parent, {?MODULE, ?LINE, Other}), - erlang:display({?MODULE, ?LINE, Other}), - Data - end, - {Parent, Tag, NewData}; - {trace_ts, Pid, out, _, {A3, B3, C3}} -> - NewData = - case lists:keysearch(Pid, 1, Data) of - {value, {Pid, {A1, B1, C1}, {A2, B2, C2}}} -> - [{Pid, {A3-A2+A1, B3-B2+B1, C3-C2+C1}} | - lists:keydelete(Pid, 1, Data)]; - Other -> - exit(Parent, {?MODULE, ?LINE, Other}), - erlang:display({?MODULE, ?LINE, Other}), - Data - end, - {Parent, Tag, NewData}; - {trace_ts, Pid, exit, normal, {A3, B3, C3}} -> - NewData = - case lists:keysearch(Pid, 1, Data) of - {value, {Pid, {A1, B1, C1}, {A2, B2, C2}}} -> - [{Pid, {A3-A2+A1, B3-B2+B1, C3-C2+C1}} | - lists:keydelete(Pid, 1, Data)]; - {value, {Pid, _Acc}} -> - Data; - false -> - [{Pid, {0, 0, 0}} | Data]; - Other -> - exit(Parent, {?MODULE, ?LINE, Other}), - erlang:display({?MODULE, ?LINE, Other}), - Data - end, - {Parent, Tag, NewData}; - {trace_ts, _Pid, send, _Msg, _OtherPid, _Ts} -> - State; - end_of_trace -> - Parent ! {Tag, Data}, - State + {trace_ts, Pid, in, _, Ts} -> + NewData = + case lists:keysearch(Pid, 1, Data) of + {value, {Pid, Acc}} -> + [{Pid, Acc, Ts} | lists:keydelete(Pid, 1, Data)]; + false -> + [{Pid, {0, 0, 0}, Ts} | Data]; + Other -> + exit(Parent, {?MODULE, ?LINE, Other}), + erlang:display({?MODULE, ?LINE, Other}), + Data + end, + {Parent, Tag, NewData}; + {trace_ts, Pid, out, _, {A3, B3, C3}} -> + NewData = + case lists:keysearch(Pid, 1, Data) of + {value, {Pid, {A1, B1, C1}, {A2, B2, C2}}} -> + [{Pid, {A3-A2+A1, B3-B2+B1, C3-C2+C1}} | + lists:keydelete(Pid, 1, Data)]; + Other -> + exit(Parent, {?MODULE, ?LINE, Other}), + erlang:display({?MODULE, ?LINE, Other}), + Data + end, + {Parent, Tag, NewData}; + {trace_ts, Pid, exit, normal, {A3, B3, C3}} -> + NewData = + case lists:keysearch(Pid, 1, Data) of + {value, {Pid, {A1, B1, C1}, {A2, B2, C2}}} -> + [{Pid, {A3-A2+A1, B3-B2+B1, C3-C2+C1}} | + lists:keydelete(Pid, 1, Data)]; + {value, {Pid, _Acc}} -> + Data; + false -> + [{Pid, {0, 0, 0}} | Data]; + Other -> + exit(Parent, {?MODULE, ?LINE, Other}), + erlang:display({?MODULE, ?LINE, Other}), + Data + end, + {Parent, Tag, NewData}; + {trace_ts, _Pid, send, _Msg, _OtherPid, _Ts} -> + State; + end_of_trace -> + Parent ! {Tag, Data}, + State end. pass_token(Token, Next, Loops) -> receive - {Token, 1} = Msg -> - sendloop(Loops), - Next ! Msg; - {Token, _Cnt} = Msg-> - sendloop(Loops), - Next ! Msg, - pass_token(Token, Next, Loops) + {Token, 1} = Msg -> + sendloop(Loops), + Next ! Msg; + {Token, _Cnt} = Msg-> + sendloop(Loops), + Next ! Msg, + pass_token(Token, Next, Loops) end. pass_token(Token, Final, Cnt, Loops) -> receive - {Token, start, Next} -> - sendloop(Loops), - Msg = {Token, Cnt}, - Next ! Msg, - pass_token(Token, Final, Next, Cnt, Loops) + {Token, start, Next} -> + sendloop(Loops), + Msg = {Token, Cnt}, + Next ! Msg, + pass_token(Token, Final, Next, Cnt, Loops) end. pass_token(Token, Final, Next, Cnt, Loops) -> receive - {Token, 1} -> - sendloop(Loops), - Msg = {Token, done}, - Final ! Msg; - {Token, Cnt} -> - sendloop(Loops), - NextCnt = Cnt-1, - Msg = {Token, NextCnt}, - Next ! Msg, - pass_token(Token, Final, Next, NextCnt, Loops) + {Token, 1} -> + sendloop(Loops), + Msg = {Token, done}, + Final ! Msg; + {Token, Cnt} -> + sendloop(Loops), + NextCnt = Cnt-1, + Msg = {Token, NextCnt}, + Next ! Msg, + pass_token(Token, Final, Next, NextCnt, Loops) end. sendloop(Loops) -> diff --git a/lib/runtime_tools/test/dbg_SUITE_data/Makefile.src b/lib/runtime_tools/test/dbg_SUITE_data/Makefile.src new file mode 100644 index 0000000000..f3d63bd4d1 --- /dev/null +++ b/lib/runtime_tools/test/dbg_SUITE_data/Makefile.src @@ -0,0 +1,8 @@ + +NIF_LIBS = dbg_SUITE@dll@ + +all: $(NIF_LIBS) + +@SHLIB_RULES@ + +$(NIF_LIBS): dbg_SUITE.c diff --git a/lib/runtime_tools/test/dbg_SUITE_data/dbg_SUITE.c b/lib/runtime_tools/test/dbg_SUITE_data/dbg_SUITE.c new file mode 100644 index 0000000000..45f14938c6 --- /dev/null +++ b/lib/runtime_tools/test/dbg_SUITE_data/dbg_SUITE.c @@ -0,0 +1,113 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-2014. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#include "erl_nif.h" + +#include <stdio.h> +#include <string.h> +#include <assert.h> +#include <limits.h> + +/* NIF interface declarations */ +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); +static void unload(ErlNifEnv* env, void* priv_data); + +/* The NIFs: */ +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ErlNifFunc nif_funcs[] = { + {"enabled", 3, enabled}, + {"trace", 6, trace} +}; + +ERL_NIF_INIT(dbg_SUITE, nif_funcs, load, NULL, upgrade, unload) + +static ERL_NIF_TERM atom_trace; +static ERL_NIF_TERM atom_ok; + +#define ASSERT(expr) assert(expr) + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + + atom_trace = enif_make_atom(env, "trace"); + atom_ok = enif_make_atom(env, "ok"); + + *priv_data = NULL; + + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ + +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, + ERL_NIF_TERM load_info) +{ + if (*old_priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (*priv_data != NULL) { + return -1; /* Don't know how to do that */ + } + if (load(env, priv_data, load_info)) { + return -1; + } + return 0; +} + +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int state_arity; + const ERL_NIF_TERM *state_tuple; + ERL_NIF_TERM value; + ASSERT(argc == 3); + + + return atom_trace; +} + +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int state_arity; + ErlNifPid self, to; + ERL_NIF_TERM *tuple, msg; + ASSERT(argc == 6); + + tuple = enif_alloc(sizeof(ERL_NIF_TERM)*(argc+1)); + memcpy(tuple+1,argv,sizeof(ERL_NIF_TERM)*argc); + + if (enif_self(env, &self)) { + tuple[0] = enif_make_pid(env, &self); + } else { + tuple[0] = enif_make_atom(env, "undefined"); + } + + msg = enif_make_tuple_from_array(env, tuple, argc + 1); + enif_get_local_pid(env, argv[1], &to); + enif_send(env, &to, NULL, msg); + enif_free(tuple); + + return atom_ok; +} diff --git a/lib/runtime_tools/test/dyntrace_SUITE.erl b/lib/runtime_tools/test/dyntrace_SUITE.erl index f3c1cce8f8..7be2f49a8b 100644 --- a/lib/runtime_tools/test/dyntrace_SUITE.erl +++ b/lib/runtime_tools/test/dyntrace_SUITE.erl @@ -20,26 +20,14 @@ -module(dyntrace_SUITE). -include_lib("common_test/include/ct.hrl"). --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]). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1]). %% Test cases -export([smoke/1,process/1]). -%% Default timetrap timeout (set in init_per_testcase) --define(default_timeout, ?t:minutes(1)). - -init_per_testcase(_Case, Config) -> - Dog = test_server:timetrap(?default_timeout), - [{watchdog,Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> case erlang:system_info(dynamic_trace) of @@ -73,14 +61,8 @@ init_per_suite(Config) -> end_per_suite(_Config) -> ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - smoke(Config) -> - Emu = ?t:lookup_config(emu_name, Config), + Emu = test_server:lookup_config(emu_name, Config), BinEmu = list_to_binary(Emu), case erlang:system_info(dynamic_trace) of dtrace -> @@ -107,8 +89,7 @@ process(_Config) -> {probe,"process-hibernate"}, {action,[{printf,["hibernate %s %s\n",{arg,0},{arg,1}]}]}, {probe,"process-exit"}, - {action,[{printf,["exit %s %s\n",{arg,0},{arg,1}]}]} - ], + {action,[{printf,["exit %s %s\n",{arg,0},{arg,1}]}]}], F = fun() -> {Pid,Ref} = spawn_monitor(fun my_process/0), Pid ! hibernate, diff --git a/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl b/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl new file mode 100644 index 0000000000..e6c147b003 --- /dev/null +++ b/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl @@ -0,0 +1,377 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(dyntrace_lttng_SUITE). +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, suite/0]). +-export([init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). + +%% Test cases +-export([t_lttng_list/1, + t_procs/1, + t_ports/1, + t_running_process/1, + t_running_port/1, + t_call/1, + t_call_return_to/1, + t_call_silent/1, + t_send/1, + t_receive/1, + t_garbage_collection/1, + t_all/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. + +all() -> + [t_lttng_list, + t_procs, + t_ports, + t_running_process, + t_running_port, + t_call, + t_call_return_to, + t_call_silent, + t_send, + t_receive, + t_garbage_collection, + t_all]. + + +init_per_suite(Config) -> + case erlang:system_info(dynamic_trace) of + lttng -> + ensure_lttng_stopped("--all"), + Config; + _ -> + {skip, "No LTTng configured on system."} + end. + +end_per_suite(_Config) -> + ensure_lttng_stopped("--all"), + ok. + +init_per_testcase(Case, Config) -> + %% ensure loaded + _ = dyntrace:module_info(), + Name = atom_to_list(Case), + ok = ensure_lttng_started(Name, Config), + [{session, Name}|Config]. + +end_per_testcase(Case, _Config) -> + Name = atom_to_list(Case), + ok = ensure_lttng_stopped(Name), + ok. + +%% tracepoints +%% +%% com_ericsson_dyntrace:gc_major_end +%% com_ericsson_dyntrace:gc_major_start +%% com_ericsson_dyntrace:gc_minor_end +%% com_ericsson_dyntrace:gc_minor_start +%% com_ericsson_dyntrace:message_receive +%% com_ericsson_dyntrace:message_send +%% -com_ericsson_dyntrace:message_queued +%% com_ericsson_dyntrace:function_exception +%% com_ericsson_dyntrace:function_return +%% com_ericsson_dyntrace:function_call +%% com_ericsson_dyntrace:port_link +%% com_ericsson_dyntrace:port_exit +%% com_ericsson_dyntrace:port_open +%% com_ericsson_dyntrace:port_scheduled +%% com_ericsson_dyntrace:process_scheduled +%% com_ericsson_dyntrace:process_register +%% com_ericsson_dyntrace:process_exit +%% com_ericsson_dyntrace:process_link +%% com_ericsson_dyntrace:process_spawn +%% +%% Testcases +%% + +t_lttng_list(_Config) -> + {ok, _} = cmd("lttng list -u"), + ok. + +t_procs(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:process_*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},procs]), + + Pid = spawn_link(fun() -> waiter() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + timer:sleep(1000), + + _ = erlang:trace(all, false, [procs]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:process_spawn", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_link", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_exit", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_register", Res), + ok. + +t_ports(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:port_*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},ports]), + + _ = os:cmd("ls"), + + _ = erlang:trace(all, false, [{tracer, dyntrace, []},ports]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:port_open", Res), + ok = check_tracepoint("com_ericsson_dyntrace:port_link", Res), + ok = check_tracepoint("com_ericsson_dyntrace:port_exit", Res), + ok. + +t_running_process(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:process_scheduled", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},running]), + + Pid = spawn_link(fun() -> waiter() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + timer:sleep(1000), + + _ = erlang:trace(all, false, [running]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:process_scheduled", Res), + ok. + +t_running_port(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:port_scheduled", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},running_ports]), + + _ = os:cmd("ls"), + _ = os:cmd("ls"), + + _ = erlang:trace(all, false, [running_ports]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:port_scheduled", Res), + ok. + + +t_call(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:function_*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []}, call]), + _ = erlang:trace_pattern({?MODULE, '_', '_'}, [{'_',[],[{exception_trace}]}], [local]), + + DontLink = spawn(fun() -> foo_clause_exception(nope) end), + Pid = spawn_link(fun() -> waiter() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + + timer:sleep(10), + undefined = erlang:process_info(DontLink), + + _ = erlang:trace_pattern({?MODULE, '_', '_'}, false, [local]), + _ = erlang:trace(all, false, [call]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:function_call", Res), + ok = check_tracepoint("com_ericsson_dyntrace:function_return", Res), + ok = check_tracepoint("com_ericsson_dyntrace:function_exception", Res), + ok. + +t_send(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:message_send", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},send]), + + Pid = spawn_link(fun() -> waiter() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + _ = os:cmd("ls"), + timer:sleep(10), + + _ = erlang:trace(all, false, [send]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:message_send", Res), + ok. + +t_call_return_to(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:function_*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []}, call, return_to]), + _ = erlang:trace_pattern({lists, '_', '_'}, true, [local]), + _ = erlang:trace_pattern({?MODULE, '_', '_'}, true, [local]), + + Pid = spawn_link(fun() -> gcfier(10) end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + timer:sleep(10), + + _ = erlang:trace_pattern({?MODULE, '_', '_'}, false, [local]), + _ = erlang:trace_pattern({lists, '_', '_'}, false, [local]), + _ = erlang:trace(all, false, [call,return_to]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:function_call", Res), + ok. + +t_call_silent(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:function_*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []}, call, silent]), + _ = erlang:trace_pattern({?MODULE, '_', '_'}, [{'_',[],[{exception_trace}]}], [local]), + + DontLink = spawn(fun() -> foo_clause_exception(nope) end), + Pid = spawn_link(fun() -> waiter() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + + timer:sleep(10), + undefined = erlang:process_info(DontLink), + + _ = erlang:trace_pattern({?MODULE, '_', '_'}, false, [local]), + _ = erlang:trace(all, false, [call]), + Res = lttng_stop_and_view(Config), + notfound = check_tracepoint("com_ericsson_dyntrace:function_call", Res), + notfound = check_tracepoint("com_ericsson_dyntrace:function_return", Res), + notfound = check_tracepoint("com_ericsson_dyntrace:function_exception", Res), + ok. + + +t_receive(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:message_receive", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},'receive']), + + Pid = spawn_link(fun() -> waiter() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + timer:sleep(10), + _ = erlang:trace(all, false, ['receive']), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:message_receive", Res), + ok. + +t_garbage_collection(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:gc_*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},garbage_collection]), + + Pid = spawn_link(fun() -> gcfier() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + timer:sleep(10), + _ = erlang:trace(all, false, [garbage_collection]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:gc_major_start", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_major_end", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_minor_start", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_minor_end", Res), + ok. + +t_all(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},all]), + + Pid1 = spawn_link(fun() -> waiter() end), + Pid1 ! {self(), ok}, + ok = receive {Pid1,ok} -> ok end, + + Pid2 = spawn_link(fun() -> gcfier() end), + Pid2 ! {self(), ok}, + ok = receive {Pid2,ok} -> ok end, + _ = os:cmd("ls"), + _ = os:cmd("ls"), + timer:sleep(10), + + _ = erlang:trace(all, false, [all]), + Res = lttng_stop_and_view(Config), + + ok = check_tracepoint("com_ericsson_dyntrace:process_spawn", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_link", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_exit", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_register", Res), + ok = check_tracepoint("com_ericsson_dyntrace:port_open", Res), + ok = check_tracepoint("com_ericsson_dyntrace:port_link", Res), + ok = check_tracepoint("com_ericsson_dyntrace:port_exit", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_scheduled", Res), + ok = check_tracepoint("com_ericsson_dyntrace:port_scheduled", Res), + ok = check_tracepoint("com_ericsson_dyntrace:message_send", Res), + ok = check_tracepoint("com_ericsson_dyntrace:message_receive", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_major_start", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_major_end", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_minor_start", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_minor_end", Res), + ok. + + +%% aux + +gcfier() -> + gcfier(10000). +gcfier(N) -> + receive + {Pid, ok} -> + _ = lists:reverse(lists:seq(1,N)), + true = erlang:garbage_collect(), + Pid ! {self(), ok} + end. + + +waiter() -> + true = register(?MODULE, self()), + receive + {Pid, ok} -> + Child = spawn(fun() -> receive ok -> ok end end), + link(Child), + unlink(Child), + _ = lists:seq(1,1000), + Child ! ok, + true = unregister(?MODULE), + Pid ! {self(),ok} + end. + +foo_clause_exception({1,2}) -> badness. + +%% lttng +lttng_stop_and_view(Config) -> + Path = proplists:get_value(priv_dir, Config), + Name = proplists:get_value(session, Config), + {ok,_} = cmd("lttng stop " ++ Name), + {ok,Res} = cmd("lttng view " ++ Name ++ " --trace-path=" ++ Path), + Res. + +check_tracepoint(TP, Data) -> + case re:run(Data, TP, [global]) of + {match, _} -> ok; + _ -> notfound + end. + +lttng_start_event(Event, Config) -> + Name = proplists:get_value(session, Config), + {ok, _} = cmd("lttng enable-event -u " ++ Event ++ " --session=" ++ Name), + {ok, _} = cmd("lttng start " ++ Name), + ok. + +ensure_lttng_started(Name, Config) -> + Out = case proplists:get_value(priv_dir, Config) of + undefined -> []; + Path -> "--output="++Path++" " + end, + {ok,_} = cmd("lttng create " ++ Out ++ Name), + ok. + +ensure_lttng_stopped(Name) -> + {ok,_} = cmd("lttng stop"), + {ok,_} = cmd("lttng destroy " ++ Name), + ok. + +cmd(Cmd) -> + io:format("<< ~ts~n", [Cmd]), + Res = os:cmd(Cmd), + io:format(">> ~ts~n", [Res]), + {ok,Res}. diff --git a/lib/runtime_tools/test/erts_alloc_config_SUITE.erl b/lib/runtime_tools/test/erts_alloc_config_SUITE.erl index 4fb96a0c1b..6ae51d9a26 100644 --- a/lib/runtime_tools/test/erts_alloc_config_SUITE.erl +++ b/lib/runtime_tools/test/erts_alloc_config_SUITE.erl @@ -25,9 +25,7 @@ -include_lib("common_test/include/ct.hrl"). %-compile(export_all). --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]). +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). %% Testcases -export([basic/1]). @@ -35,83 +33,63 @@ %% internal export -export([make_basic_config/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(2)). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> [basic]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - init_per_testcase(Case, Config) when is_list(Config) -> [{testcase, Case}, - {watchdog, ?t:timetrap(?DEFAULT_TIMEOUT)}, {erl_flags_env, save_env()} | Config]. end_per_testcase(_Case, Config) when is_list(Config) -> - ?t:timetrap_cancel(?config(watchdog, Config)), - restore_env(?config(erl_flags_env, Config)), + restore_env(proplists:get_value(erl_flags_env, Config)), ok. %%% %%% The test cases ------------------------------------------------------------ %%% -basic(doc) -> []; -basic(suite) -> []; basic(Config) when is_list(Config) -> - ?line ErtsAllocConfig = privfile("generated", Config), + ErtsAllocConfig = privfile("generated", Config), SbctMod = " +MBsbct 1024 +MHsbct 4096", %% Make sure we have enabled allocators ZFlgs = os:getenv("ERL_ZFLAGS", "") ++ " +Mea max +Mea config", - ?line os:putenv("ERL_ZFLAGS", ZFlgs ++ SbctMod), + os:putenv("ERL_ZFLAGS", ZFlgs ++ SbctMod), - ?line {ok, Node1} = start_node(Config), - ?line ok = rpc:call(Node1, ?MODULE, make_basic_config, [ErtsAllocConfig]), - ?line stop_node(Node1), + {ok, Node1} = start_node(Config), + ok = rpc:call(Node1, ?MODULE, make_basic_config, [ErtsAllocConfig]), + stop_node(Node1), - ?line display_file(ErtsAllocConfig), + display_file(ErtsAllocConfig), - ?line ManualConfig = privfile("manual", Config), - ?line {ok, IOD} = file:open(ManualConfig, [write]), - ?line io:format(IOD, "~s", ["+MBsbct 2048"]), - ?line file:close(IOD), - ?line display_file(ManualConfig), + ManualConfig = privfile("manual", Config), + {ok, IOD} = file:open(ManualConfig, [write]), + io:format(IOD, "~s", ["+MBsbct 2048"]), + file:close(IOD), + display_file(ManualConfig), - ?line os:putenv("ERL_ZFLAGS", ZFlgs), + os:putenv("ERL_ZFLAGS", ZFlgs), - ?line {ok, Node2} = start_node(Config, - "-args_file " ++ ErtsAllocConfig - ++ " -args_file " ++ ManualConfig), + {ok, Node2} = start_node(Config, + "-args_file " ++ ErtsAllocConfig + ++ " -args_file " ++ ManualConfig), - ?line {_, _, _, Cfg} = rpc:call(Node2, erlang, system_info, [allocator]), + {_, _, _, Cfg} = rpc:call(Node2, erlang, system_info, [allocator]), - ?line stop_node(Node2), + stop_node(Node2), - ?line {value,{binary_alloc, BCfg}} = lists:keysearch(binary_alloc, 1, Cfg), - ?line {value,{sbct, 2097152}} = lists:keysearch(sbct, 1, BCfg), - ?line {value,{eheap_alloc, HCfg}} = lists:keysearch(eheap_alloc, 1, Cfg), - ?line {value,{sbct, 4194304}} = lists:keysearch(sbct, 1, HCfg), + {value,{binary_alloc, BCfg}} = lists:keysearch(binary_alloc, 1, Cfg), + {value,{sbct, 2097152}} = lists:keysearch(sbct, 1, BCfg), + {value,{eheap_alloc, HCfg}} = lists:keysearch(eheap_alloc, 1, Cfg), + {value,{sbct, 4194304}} = lists:keysearch(sbct, 1, HCfg), - ?line ok. + ok. make_basic_config(ErtsAllocConfig) -> %% Save some different scenarios @@ -119,35 +97,35 @@ make_basic_config(ErtsAllocConfig) -> SSBegun = make_ref(), SSDone = make_ref(), SSFun = fun (F) -> - receive - SSDone -> - ok = erts_alloc_config:save_scenario(), - Tester ! SSDone - after 500 -> - ok = erts_alloc_config:save_scenario(), - F(F) - end - end, + receive + SSDone -> + ok = erts_alloc_config:save_scenario(), + Tester ! SSDone + after 500 -> + ok = erts_alloc_config:save_scenario(), + F(F) + end + end, SS = spawn_link(fun () -> - ok = erts_alloc_config:save_scenario(), - Tester ! SSBegun, - SSFun(SSFun) - end), + ok = erts_alloc_config:save_scenario(), + Tester ! SSBegun, + SSFun(SSFun) + end), receive SSBegun -> ok end, Ref = make_ref(), Tab = ets:new(?MODULE, [bag, public]), Ps = lists:map( - fun (_) -> - spawn_link( - fun () -> - ets:insert(Tab, - {self(), - lists:seq(1, 1000)}), - receive after 1000 -> ok end, - Tester ! {Ref, self()} - end) - end, - lists:seq(1, 10000)), + fun (_) -> + spawn_link( + fun () -> + ets:insert(Tab, + {self(), + lists:seq(1, 1000)}), + receive after 1000 -> ok end, + Tester ! {Ref, self()} + end) + end, + lists:seq(1, 10000)), lists:foreach(fun (P) -> receive {Ref, P} -> ok end end, Ps), ets:delete(Tab), SS ! SSDone, @@ -162,35 +140,35 @@ make_basic_config(ErtsAllocConfig) -> %% display_file(FileName) -> - ?t:format("filename: ~s~n", [FileName]), + io:format("filename: ~s~n", [FileName]), {ok, Bin} = file:read_file(FileName), io:format("~s", [binary_to_list(Bin)]), - ?t:format("eof: ~s~n", [FileName]), + io:format("eof: ~s~n", [FileName]), ok. mk_name(Config) when is_list(Config) -> {A, B, C} = now(), list_to_atom(atom_to_list(?MODULE) - ++ "-" ++ atom_to_list(?config(testcase, Config)) - ++ "-" ++ integer_to_list(A) - ++ "-" ++ integer_to_list(B) - ++ "-" ++ integer_to_list(C)). + ++ "-" ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" ++ integer_to_list(A) + ++ "-" ++ integer_to_list(B) + ++ "-" ++ integer_to_list(C)). start_node(Config) -> start_node(Config, ""). start_node(Config, Args) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line ?t:start_node(mk_name(Config), - slave, - [{args, "-pa " ++ Pa ++ " " ++ Args}]). + Pa = filename:dirname(code:which(?MODULE)), + test_server:start_node(mk_name(Config), + slave, + [{args, "-pa " ++ Pa ++ " " ++ Args}]). stop_node(Node) -> - ?line true = ?t:stop_node(Node). + true = test_server:stop_node(Node). privfile(Name, Config) -> - filename:join([?config(priv_dir, Config), - atom_to_list(?config(testcase, Config)) ++ "." ++ Name]). + filename:join([proplists:get_value(priv_dir, Config), + atom_to_list(proplists:get_value(testcase, Config)) ++ "." ++ Name]). save_env() -> {erl_flags, @@ -203,15 +181,15 @@ restore_env(EVar, false) when is_list(EVar) -> restore_env(EVar, ""); restore_env(EVar, "") when is_list(EVar) -> case os:getenv(EVar) of - false -> ok; - "" -> ok; - " " -> ok; - _ -> os:putenv(EVar, " ") + false -> ok; + "" -> ok; + " " -> ok; + _ -> os:putenv(EVar, " ") end; restore_env(EVar, Value) when is_list(EVar), is_list(Value) -> case os:getenv(EVar) of - Value -> ok; - _ -> os:putenv(EVar, Value) + Value -> ok; + _ -> os:putenv(EVar, Value) end. restore_env({erl_flags, AFlgs, Flgs, RFlgs, ZFlgs}) -> diff --git a/lib/runtime_tools/test/runtime_tools_SUITE.erl b/lib/runtime_tools/test/runtime_tools_SUITE.erl index 374d7f6694..6877e1a379 100644 --- a/lib/runtime_tools/test/runtime_tools_SUITE.erl +++ b/lib/runtime_tools/test/runtime_tools_SUITE.erl @@ -21,54 +21,27 @@ -include_lib("common_test/include/ct.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]). +-export([all/0, suite/0]). %% Test cases -export([app_file/1, appup_file/1, start_stop_app/1]). -%% Default timetrap timeout (set in init_per_testcase) --define(default_timeout, ?t:minutes(1)). - -init_per_testcase(_Case, Config) -> - Dog = test_server:timetrap(?default_timeout), - [{watchdog, Dog} | Config]. - -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [app_file, appup_file, start_stop_app]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - app_file(_Config) -> - ?line ok = ?t:app_test(runtime_tools), + ok = test_server:app_test(runtime_tools), ok. appup_file(_Config) -> - ok = ?t:appup_test(runtime_tools). + ok = test_server:appup_test(runtime_tools). start_stop_app(_Config) -> ok = application:start(runtime_tools), diff --git a/lib/runtime_tools/test/system_information_SUITE.erl b/lib/runtime_tools/test/system_information_SUITE.erl index 5e2e0d17ac..a5a025a1cf 100644 --- a/lib/runtime_tools/test/system_information_SUITE.erl +++ b/lib/runtime_tools/test/system_information_SUITE.erl @@ -230,19 +230,19 @@ api_report(_Config) -> ok. api_to_file(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), Filename = filename:join([DataDir, "system_information_report_1.dat"]), ok = system_information:to_file(Filename), {ok, _} = file:consult(Filename), {save_config, [{report_name, Filename}]}. api_from_file(Config) -> - {api_to_file, Saved} = ?config(saved_config, Config), - DataDir = ?config(data_dir, Config), + {api_to_file, Saved} = proplists:get_value(saved_config, Config), + DataDir = proplists:get_value(data_dir, Config), Fname1 = filename:join([DataDir, "information_test_report.dat"]), Report1 = system_information:from_file(Fname1), ok = validate_report(Report1), - Fname2 = ?config(report_name, Saved), + Fname2 = proplists:get_value(report_name, Saved), Report2 = system_information:from_file(Fname2), ok = validate_report(Report2), ok. @@ -253,7 +253,7 @@ api_start_stop(_Config) -> ok. validate_server_interface(Config) -> - DataDir = ?config(data_dir, Config), + DataDir = proplists:get_value(data_dir, Config), Fname1 = filename:join([DataDir, "information_test_report.dat"]), %% load old report ok = system_information:load_report(file, Fname1), diff --git a/lib/sasl/doc/src/appup.xml b/lib/sasl/doc/src/appup.xml index a57068492c..6fbdcb9f5b 100644 --- a/lib/sasl/doc/src/appup.xml +++ b/lib/sasl/doc/src/appup.xml @@ -137,7 +137,8 @@ code change. If it is set to <c>{advanced,Extra}</c>, implemented processes using <seealso marker="stdlib:gen_server"><c>gen_server</c></seealso>, - <seealso marker="stdlib:gen_fsm"><c>gen_fsm</c></seealso>, or + <seealso marker="stdlib:gen_fsm"><c>gen_fsm</c></seealso>, + <seealso marker="stdlib:gen_statem"><c>gen_statem</c></seealso>, or <seealso marker="stdlib:gen_event"><c>gen_event</c></seealso> transform their internal state by calling the callback function <c>code_change</c>. Special processes call the callback diff --git a/lib/sasl/doc/src/error_logging.xml b/lib/sasl/doc/src/error_logging.xml index 86d0c811e9..8464a41ff9 100644 --- a/lib/sasl/doc/src/error_logging.xml +++ b/lib/sasl/doc/src/error_logging.xml @@ -90,8 +90,9 @@ a process terminates with an unexpected reason, which is any reason other than <c>normal</c>, <c>shutdown</c>, or <c>{shutdown,Term}</c>. Processes using behaviors - <seealso marker="stdlib:gen_server"><c>gen_server</c></seealso> or - <seealso marker="stdlib:gen_fsm"><c>gen_fsm</c></seealso> + <seealso marker="stdlib:gen_server"><c>gen_server</c></seealso>, + <seealso marker="stdlib:gen_fsm"><c>gen_fsm</c></seealso> or + <seealso marker="stdlib:gen_statem"><c>gen_statem</c></seealso> are examples of such processes. A crash report contains the following items:</p> <taglist> <tag><c>Crasher</c></tag> diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index c23607f8a1..352e4984df 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -1490,7 +1490,7 @@ mandatory_modules() -> preloaded() -> %% Sorted - [erl_prim_loader,erlang, + [erl_prim_loader,erl_tracer,erlang, erts_code_purger, erts_internal,init,otp_ring0,prim_eval,prim_file, prim_inet,prim_zip,zlib]. diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index ee620dcdb4..4dcaec03a7 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -54,7 +54,7 @@ unix_cases() -> end, [target_system, target_system_unicode] ++ RunErlCases ++ cases(). -win32_cases() -> +win32_cases() -> [{group,release} | cases()]. %% Cases that can be run on all platforms @@ -89,11 +89,16 @@ groups() -> %% {group,release} %% Top group for all cases using run_erl init_per_group(release, Config) -> - Dog = ?t:timetrap(?default_timeout), - P1gInstall = filename:join(priv_dir(Config),p1g_install), - ok = create_p1g(Config,P1gInstall), - ok = create_p1h(Config), - ?t:timetrap_cancel(Dog); + case {os:type(), os:version()} of + {{win32, nt}, Vsn} when Vsn > {6,1,999999} -> + {skip, "Requires admin privileges on Win 8 and later"}; + _ -> + Dog = ?t:timetrap(?default_timeout), + P1gInstall = filename:join(priv_dir(Config),p1g_install), + ok = create_p1g(Config,P1gInstall), + ok = create_p1h(Config), + ?t:timetrap_cancel(Dog) + end; %% {group,release_single} %% Subgroup of {group,release}, contains all cases that are not diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 850557444d..ff2d6e082a 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -241,6 +241,7 @@ {server2client,['aes128-cbc','3des-cbc']}]}, {mac,['hmac-sha2-256','hmac-sha1']}, {compression,[none,zlib]} + ] } </code> <p>The example specifies different algorithms in the two directions (client2server and server2client), @@ -359,7 +360,8 @@ </type> <desc> <p>Starts a server listening for SSH connections on the given - port.</p> + port. If the <c>Port</c> is 0, a random free port is selected. See + <seealso marker="#daemon_info/1">daemon_info/1</seealso> about how to find the selected port number.</p> <p>Options:</p> <taglist> <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag> @@ -460,6 +462,7 @@ {server2client,['aes128-cbc','3des-cbc']}]}, {mac,['hmac-sha2-256','hmac-sha1']}, {compression,[none,zlib]} + ] } </code> <p>The example specifies different algorithms in the two directions (client2server and server2client), @@ -680,6 +683,18 @@ </func> <func> + <name>daemon_info(Daemon) -> {ok, [{port,Port}]} | {error,Error}</name> + <fsummary>Get info about a daemon</fsummary> + <type> + <v>Port = integer()</v> + <v>Error = bad_daemon_ref</v> + </type> + <desc> + <p>Returns a key-value list with information about the daemon. For now, only the listening port is returned. This is intended for the case the daemon is started with the port set to 0.</p> + </desc> + </func> + + <func> <name>default_algorithms() -> algs_list()</name> <fsummary>Get a list declaring the supported algorithms</fsummary> <desc> diff --git a/lib/ssh/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml index 1d37933369..071d46ec57 100644 --- a/lib/ssh/doc/src/ssh_sftp.xml +++ b/lib/ssh/doc/src/ssh_sftp.xml @@ -44,24 +44,41 @@ </p> <taglist> + <tag><c>reason()</c></tag> + <item> + <p>= <c>atom()</c> A description of the reason why an operation failed.</p> + <p> + The value is formed from the sftp error codes in the protocol-level responses as defined in + <url href="https://tools.ietf.org/id/draft-ietf-secsh-filexfer-13.txt">draft-ietf-secsh-filexfer-13.txt</url> + section 9.1. + </p> + <p> + The codes are named as <c>SSH_FX_*</c> which are transformed into lowercase of the star-part. + E.g. the error code <c>SSH_FX_NO_SUCH_FILE</c> + will cause the <c>reason()</c> to be <c>no_such_file</c>. + </p> + </item> + <tag><c>ssh_connection_ref() =</c></tag> - <item><p>opaque() - as returned by <c>ssh:connect/3</c></p></item> + <item><p><c>opaque()</c> - as returned by + <seealso marker="ssh#connect-3"><c>ssh:connect/3</c></seealso></p></item> + <tag><c>timeout()</c></tag> - <item><p>= <c>infinity | integer() in milliseconds. Default infinity.</c></p></item> + <item><p>= <c>infinity | integer()</c> in milliseconds. Default infinity.</p></item> </taglist> </section> <section> <title>Time-outs</title> <p>If the request functions for the SFTP channel return <c>{error, timeout}</c>, - it does not guarantee that the request never reached the server and was - not performed. It only means that no answer was received from the - server within the expected time.</p> + no answer was received from the server within the expected time.</p> + <p>The request may have reached the server and may have been performed. + However, no answer was received from the server within the expected time.</p> </section> <funcs> <func> - <name>apread(ChannelPid, Handle, Position, Len) -> {async, N} | {error, Reason}</name> + <name>apread(ChannelPid, Handle, Position, Len) -> {async, N} | {error, reason()}</name> <fsummary>Reads asynchronously from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -69,16 +86,15 @@ <v>Position = integer()</v> <v>Len = integer()</v> <v>N = term()</v> - <v>Reason = term()</v> </type> - - <desc><p>The <c><![CDATA[apread]]></c> function reads from a specified position, - combining the <c><![CDATA[position]]></c> and <c><![CDATA[aread]]></c> functions.</p> - <p><seealso marker="#apread-4">ssh_sftp:apread/4</seealso></p> </desc> + <desc><p>The <c><![CDATA[apread/4]]></c> function reads from a specified position, + combining the <seealso marker="#position-3"><c>position/3</c></seealso> and + <seealso marker="#aread-3"><c>aread/3</c></seealso> functions.</p> + </desc> </func> <func> - <name>apwrite(ChannelPid, Handle, Position, Data) -> ok | {error, Reason}</name> + <name>apwrite(ChannelPid, Handle, Position, Data) -> {async, N} | {error, reason()}</name> <fsummary>Writes asynchronously to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -87,16 +103,16 @@ <v>Len = integer()</v> <v>Data = binary()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> + <v>N = term()</v> </type> - <desc> - <p><c><![CDATA[apwrite]]></c> writes on a specified position, combining - the <c><![CDATA[position]]></c> and <c><![CDATA[awrite]]></c> operations.</p> - <p><seealso marker="#awrite-3">ssh_sftp:awrite/3</seealso> </p></desc> + <desc><p>The <c><![CDATA[apwrite/4]]></c> function writes to a specified position, + combining the <seealso marker="#position-3"><c>position/3</c></seealso> and + <seealso marker="#awrite-3"><c>awrite/3</c></seealso> functions.</p> + </desc> </func> <func> - <name>aread(ChannelPid, Handle, Len) -> {async, N} | {error, Error}</name> + <name>aread(ChannelPid, Handle, Len) -> {async, N} | {error, reason()}</name> <fsummary>Reads asynchronously from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -104,7 +120,6 @@ <v>Position = integer()</v> <v>Len = integer()</v> <v>N = term()</v> - <v>Reason = term()</v> </type> <desc> <p>Reads from an open file, without waiting for the result. If the @@ -113,14 +128,12 @@ The actual data is sent as a message to the calling process. This message has the form <c><![CDATA[{async_reply, N, Result}]]></c>, where <c><![CDATA[Result]]></c> is the result from the read, either <c><![CDATA[{ok, Data}]]></c>, - <c><![CDATA[eof]]></c>, or <c><![CDATA[{error, Error}]]></c>.</p> + <c><![CDATA[eof]]></c>, or <c><![CDATA[{error, reason()}]]></c>.</p> </desc> </func> - - <func> - <name>awrite(ChannelPid, Handle, Data) -> ok | {error, Reason}</name> + <name>awrite(ChannelPid, Handle, Data) -> {async, N} | {error, reason()}</name> <fsummary>Writes asynchronously to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -129,7 +142,6 @@ <v>Len = integer()</v> <v>Data = binary()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Writes to an open file, without waiting for the result. If the @@ -138,19 +150,18 @@ <c><![CDATA[awrite]]></c>. The result of the <c><![CDATA[write]]></c> operation is sent as a message to the calling process. This message has the form <c><![CDATA[{async_reply, N, Result}]]></c>, where <c><![CDATA[Result]]></c> is the result - from the write, either <c><![CDATA[ok]]></c>, or <c><![CDATA[{error, Error}]]></c>.</p> + from the write, either <c><![CDATA[ok]]></c>, or <c><![CDATA[{error, reason()}]]></c>.</p> </desc> </func> <func> <name>close(ChannelPid, Handle) -></name> - <name>close(ChannelPid, Handle, Timeout) -> ok | {error, Reason}</name> + <name>close(ChannelPid, Handle, Timeout) -> ok | {error, reason()}</name> <fsummary>Closes an open handle.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Handle = term()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Closes a handle to an open file or directory on the server.</p> @@ -159,29 +170,27 @@ <func> <name>delete(ChannelPid, Name) -></name> - <name>delete(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> + <name>delete(ChannelPid, Name, Timeout) -> ok | {error, reason()}</name> <fsummary>Deletes a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> - <p>Deletes the file specified by <c><![CDATA[Name]]></c>, like - <seealso marker="kernel:file#delete-1">file:delete/1</seealso></p> + <p>Deletes the file specified by <c><![CDATA[Name]]></c>. + </p> </desc> </func> <func> <name>del_dir(ChannelPid, Name) -></name> - <name>del_dir(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> + <name>del_dir(ChannelPid, Name, Timeout) -> ok | {error, reason()}</name> <fsummary>Deletes an empty directory.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Deletes a directory specified by <c><![CDATA[Name]]></c>. @@ -192,7 +201,7 @@ <func> <name>list_dir(ChannelPid, Path) -></name> - <name>list_dir(ChannelPid, Path, Timeout) -> {ok, Filenames} | {error, Reason}</name> + <name>list_dir(ChannelPid, Path, Timeout) -> {ok, Filenames} | {error, reason()}</name> <fsummary>Lists the directory.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -200,7 +209,6 @@ <v>Filenames = [Filename]</v> <v>Filename = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Lists the given directory on the server, returning the @@ -210,13 +218,12 @@ <func> <name>make_dir(ChannelPid, Name) -></name> - <name>make_dir(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> + <name>make_dir(ChannelPid, Name, Timeout) -> ok | {error, reason()}</name> <fsummary>Creates a directory.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Creates a directory specified by <c><![CDATA[Name]]></c>. <c><![CDATA[Name]]></c> @@ -227,24 +234,23 @@ <func> <name>make_symlink(ChannelPid, Name, Target) -></name> - <name>make_symlink(ChannelPid, Name, Target, Timeout) -> ok | {error, Reason}</name> + <name>make_symlink(ChannelPid, Name, Target, Timeout) -> ok | {error, reason()}</name> <fsummary>Creates a symbolic link.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Target = string()</v> - <v>Reason = term()</v> </type> <desc> <p>Creates a symbolic link pointing to <c><![CDATA[Target]]></c> with the - name <c><![CDATA[Name]]></c>, like - <seealso marker="kernel:file#make_symlink-2">file:make_symlink/2</seealso></p> + name <c><![CDATA[Name]]></c>. + </p> </desc> </func> <func> <name>open(ChannelPid, File, Mode) -></name> - <name>open(ChannelPid, File, Mode, Timeout) -> {ok, Handle} | {error, Reason}</name> + <name>open(ChannelPid, File, Mode, Timeout) -> {ok, Handle} | {error, reason()}</name> <fsummary>Opens a file and returns a handle.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -253,7 +259,6 @@ <v>Modeflag = read | write | creat | trunc | append | binary</v> <v>Timeout = timeout()</v> <v>Handle = term()</v> - <v>Reason = term()</v> </type> <desc> <p>Opens a file on the server and returns a handle, which @@ -262,13 +267,12 @@ </func> <func> <name>opendir(ChannelPid, Path) -></name> - <name>opendir(ChannelPid, Path, Timeout) -> {ok, Handle} | {error, Reason}</name> + <name>opendir(ChannelPid, Path, Timeout) -> {ok, Handle} | {error, reason()}</name> <fsummary>Opens a directory and returns a handle.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Path = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Opens a handle to a directory on the server. The handle @@ -278,7 +282,7 @@ <func> <name>open_tar(ChannelPid, Path, Mode) -></name> - <name>open_tar(ChannelPid, Path, Mode, Timeout) -> {ok, Handle} | {error, Reason}</name> + <name>open_tar(ChannelPid, Path, Mode, Timeout) -> {ok, Handle} | {error, reason()}</name> <fsummary>Opens a tar file on the server to which <c>ChannelPid</c> is connected and returns a handle.</fsummary> <type> @@ -298,7 +302,6 @@ <v>DecryptResult = {ok,PlainBin,CryptoState} | {ok,PlainBin,CryptoState,ChunkSize}</v> <v>CloseFun = (fun(PlainBin,CryptoState) -> {ok,EncryptedBin})</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Opens a handle to a tar file on the server, associated with <c>ChannelPid</c>. @@ -333,7 +336,7 @@ <func> <name>position(ChannelPid, Handle, Location) -></name> - <name>position(ChannelPid, Handle, Location, Timeout) -> {ok, NewPosition} | {error, Reason}</name> + <name>position(ChannelPid, Handle, Location, Timeout) -> {ok, NewPosition | {error, reason()}</name> <fsummary>Sets the file position of a file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -343,12 +346,11 @@ <v>Offset = integer()</v> <v>Timeout = timeout()</v> <v>NewPosition = integer()</v> - <v>Reason = term()</v> </type> <desc> <p>Sets the file position of the file referenced by <c><![CDATA[Handle]]></c>. Returns <c><![CDATA[{ok, NewPosition}]]></c> (as an absolute offset) if - successful, otherwise <c><![CDATA[{error, Reason}]]></c>. <c><![CDATA[Location]]></c> is + successful, otherwise <c><![CDATA[{error, reason()}]]></c>. <c><![CDATA[Location]]></c> is one of the following:</p> <taglist> <tag><c><![CDATA[Offset]]></c></tag> @@ -379,7 +381,7 @@ <func> <name>pread(ChannelPid, Handle, Position, Len) -></name> - <name>pread(ChannelPid, Handle, Position, Len, Timeout) -> {ok, Data} | eof | {error, Error}</name> + <name>pread(ChannelPid, Handle, Position, Len, Timeout) -> {ok, Data} | eof | {error, reason()}</name> <fsummary>Reads from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -388,18 +390,16 @@ <v>Len = integer()</v> <v>Timeout = timeout()</v> <v>Data = string() | binary()</v> - <v>Reason = term()</v> </type> - <desc> - <p>The <c><![CDATA[pread]]></c> function reads from a specified position, - combining the <c><![CDATA[position]]></c> and <c><![CDATA[read]]></c> functions.</p> - <p><seealso marker="#read-4">ssh_sftp:read/4</seealso></p> - </desc> - </func> + <desc><p>The <c><![CDATA[pread/3,4]]></c> function reads from a specified position, + combining the <seealso marker="#position-3"><c>position/3</c></seealso> and + <seealso marker="#read-3"><c>read/3,4</c></seealso> functions.</p> + </desc> + </func> <func> <name>pwrite(ChannelPid, Handle, Position, Data) -> ok</name> - <name>pwrite(ChannelPid, Handle, Position, Data, Timeout) -> ok | {error, Reason}</name> + <name>pwrite(ChannelPid, Handle, Position, Data, Timeout) -> ok | {error, reason()}</name> <fsummary>Writes to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -407,19 +407,16 @@ <v>Position = integer()</v> <v>Data = iolist()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> - <desc> - <p>The <c><![CDATA[pread]]></c> function writes to a specified position, - combining the <c><![CDATA[position]]></c> and <c><![CDATA[write]]></c> functions.</p> - <p><seealso marker="#write-3">ssh_sftp:write/3</seealso></p> - </desc> + <desc><p>The <c><![CDATA[pwrite/3,4]]></c> function writes to a specified position, + combining the <seealso marker="#position-3"><c>position/3</c></seealso> and + <seealso marker="#write-3"><c>write/3,4</c></seealso> functions.</p> + </desc> </func> - - <func> + <func> <name>read(ChannelPid, Handle, Len) -></name> - <name>read(ChannelPid, Handle, Len, Timeout) -> {ok, Data} | eof | {error, Error}</name> + <name>read(ChannelPid, Handle, Len, Timeout) -> {ok, Data} | eof | {error, reason()}</name> <fsummary>Reads from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -428,12 +425,11 @@ <v>Len = integer()</v> <v>Timeout = timeout()</v> <v>Data = string() | binary()</v> - <v>Reason = term()</v> </type> <desc> <p>Reads <c><![CDATA[Len]]></c> bytes from the file referenced by <c><![CDATA[Handle]]></c>. Returns <c><![CDATA[{ok, Data}]]></c>, <c><![CDATA[eof]]></c>, or - <c><![CDATA[{error, Reason}]]></c>. If the file is opened with <c><![CDATA[binary]]></c>, + <c><![CDATA[{error, reason()}]]></c>. If the file is opened with <c><![CDATA[binary]]></c>, <c><![CDATA[Data]]></c> is a binary, otherwise it is a string.</p> <p>If the file is read past <c>eof</c>, only the remaining bytes are read and returned. If no bytes are read, <c><![CDATA[eof]]></c> @@ -443,25 +439,22 @@ <func> <name>read_file(ChannelPid, File) -></name> - <name>read_file(ChannelPid, File, Timeout) -> {ok, Data} | {error, Reason}</name> + <name>read_file(ChannelPid, File, Timeout) -> {ok, Data} | {error, reason()}</name> <fsummary>Reads a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>File = string()</v> <v>Data = binary()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> - <p>Reads a file from the server, and returns the data in a binary, - like - <seealso marker="kernel:file#read_file-1">file:read_file/1</seealso></p> + <p>Reads a file from the server, and returns the data in a binary.</p> </desc> </func> <func> <name>read_file_info(ChannelPid, Name) -></name> - <name>read_file_info(ChannelPid, Name, Timeout) -> {ok, FileInfo} | {error, Reason}</name> + <name>read_file_info(ChannelPid, Name, Timeout) -> {ok, FileInfo} | {error, reason()}</name> <fsummary>Gets information about a file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -469,35 +462,34 @@ <v>Handle = term()</v> <v>Timeout = timeout()</v> <v>FileInfo = record()</v> - <v>Reason = term()</v> </type> <desc> <p>Returns a <c><![CDATA[file_info]]></c> record from the file specified by - <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>, - like <seealso marker="kernel:file#read_file_info-2">file:read_file_info/2</seealso></p> + <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>. See + <seealso marker="kernel:file#read_file_info-2">file:read_file_info/2</seealso> + for information about the record. + </p> </desc> </func> <func> <name>read_link(ChannelPid, Name) -></name> - <name>read_link(ChannelPid, Name, Timeout) -> {ok, Target} | {error, Reason}</name> + <name>read_link(ChannelPid, Name, Timeout) -> {ok, Target} | {error, reason()}</name> <fsummary>Reads symbolic link.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Target = string()</v> - <v>Reason = term()</v> </type> <desc> - <p>Reads the link target from the symbolic link specified - by <c><![CDATA[name]]></c>, like - <seealso marker="kernel:file#read_link-1">file:read_link/1</seealso></p> + <p>Reads the link target from the symbolic link specified by <c><![CDATA[name]]></c>. + </p> </desc> </func> <func> - <name>read_link_info(ChannelPid, Name) -> {ok, FileInfo} | {error, Reason}</name> - <name>read_link_info(ChannelPid, Name, Timeout) -> {ok, FileInfo} | {error, Reason}</name> + <name>read_link_info(ChannelPid, Name) -> {ok, FileInfo} | {error, reason()}</name> + <name>read_link_info(ChannelPid, Name, Timeout) -> {ok, FileInfo} | {error, reason()}</name> <fsummary>Gets information about a symbolic link.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -505,30 +497,31 @@ <v>Handle = term()</v> <v>Timeout = timeout()</v> <v>FileInfo = record()</v> - <v>Reason = term()</v> </type> <desc> <p>Returns a <c><![CDATA[file_info]]></c> record from the symbolic - link specified by <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>, like - <seealso marker="kernel:file#read_link_info-2">file:read_link_info/2</seealso></p> + link specified by <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>. + See + <seealso marker="kernel:file#read_link_info-2">file:read_link_info/2</seealso> + for information about the record. + </p> </desc> </func> <func> <name>rename(ChannelPid, OldName, NewName) -> </name> - <name>rename(ChannelPid, OldName, NewName, Timeout) -> ok | {error, Reason}</name> + <name>rename(ChannelPid, OldName, NewName, Timeout) -> ok | {error, reason()}</name> <fsummary>Renames a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>OldName = string()</v> <v>NewName = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Renames a file named <c><![CDATA[OldName]]></c> and gives it the name - <c><![CDATA[NewName]]></c>, like - <seealso marker="kernel:file#rename-2">file:rename/2</seealso></p> + <c><![CDATA[NewName]]></c>. + </p> </desc> </func> @@ -537,14 +530,13 @@ <name>start_channel(ConnectionRef, Options) -></name> <name>start_channel(Host, Options) -></name> <name>start_channel(Host, Port, Options) -> {ok, Pid} | {ok, Pid, ConnectionRef} | - {error, Reason}</name> + {error, reason()|term()}</name> <fsummary>Starts an SFTP client.</fsummary> <type> <v>Host = string()</v> <v>ConnectionRef = ssh_connection_ref()</v> <v>Port = integer()</v> <v>Options = [{Option, Value}]</v> - <v>Reason = term()</v> </type> <desc> <p>If no connection reference is provided, a connection is set @@ -592,7 +584,7 @@ <func> <name>write(ChannelPid, Handle, Data) -></name> - <name>write(ChannelPid, Handle, Data, Timeout) -> ok | {error, Reason}</name> + <name>write(ChannelPid, Handle, Data, Timeout) -> ok | {error, reason()}</name> <fsummary>Writes to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -600,61 +592,47 @@ <v>Position = integer()</v> <v>Data = iolist()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Writes <c><![CDATA[data]]></c> to the file referenced by <c><![CDATA[Handle]]></c>. The file is to be opened with <c><![CDATA[write]]></c> or <c><![CDATA[append]]></c> - flag. Returns <c><![CDATA[ok]]></c> if successful or <c><![CDATA[{error, Reason}]]></c> + flag. Returns <c><![CDATA[ok]]></c> if successful or <c><![CDATA[{error, reason()}]]></c> otherwise.</p> - <p>Typical error reasons:</p> - <taglist> - <tag><c><![CDATA[ebadf]]></c></tag> - <item> - <p>File is not opened for writing.</p> - </item> - <tag><c><![CDATA[enospc]]></c></tag> - <item> - <p>No space is left on the device.</p> - </item> - </taglist> </desc> </func> <func> <name>write_file(ChannelPid, File, Iolist) -></name> - <name>write_file(ChannelPid, File, Iolist, Timeout) -> ok | {error, Reason}</name> + <name>write_file(ChannelPid, File, Iolist, Timeout) -> ok | {error, reason()}</name> <fsummary>Writes a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>File = string()</v> <v>Iolist = iolist()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> - <p>Writes a file to the server, like <seealso - marker="kernel:file#write_file-2">file:write_file/2</seealso> The - file is created if it does not exist. The file is overwritten - if it exists.</p> + <p>Writes a file to the server. The file is created if it does not exist + but overwritten if it exists.</p> </desc> </func> <func> <name>write_file_info(ChannelPid, Name, Info) -></name> - <name>write_file_info(ChannelPid, Name, Info, Timeout) -> ok | {error, Reason}</name> + <name>write_file_info(ChannelPid, Name, Info, Timeout) -> ok | {error, reason()}</name> <fsummary>Writes information for a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Info = record()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Writes file information from a <c><![CDATA[file_info]]></c> record to the - file specified by <c><![CDATA[Name]]></c>, like - <seealso marker="kernel:file#write_file_info-2">file:write_file_info/[2,3]</seealso></p> + file specified by <c><![CDATA[Name]]></c>. See + <seealso marker="kernel:file#write_file_info-2">file:write_file_info/[2,3]</seealso> + for information about the record. + </p> </desc> </func> </funcs> diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index c67350bf72..3245ba5197 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -40,7 +40,12 @@ {applications, [kernel, stdlib, crypto, public_key]}, {env, []}, {mod, {ssh_app, []}}, - {runtime_dependencies, ["stdlib-2.3","public_key-0.22","kernel-3.0", - "erts-6.0","crypto-3.3"]}]}. + {runtime_dependencies, [ + "crypto-3.3", + "erts-6.0", + "kernel-3.0", + "public_key-1.1", + "stdlib-3.0" + ]}]}. diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index d0121e73ba..09b07b7a2a 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -30,12 +30,18 @@ -export([start/0, start/1, stop/0, connect/3, connect/4, close/1, connection_info/2, channel_info/3, daemon/1, daemon/2, daemon/3, + daemon_info/1, default_algorithms/0, stop_listener/1, stop_listener/2, stop_listener/3, stop_daemon/1, stop_daemon/2, stop_daemon/3, shell/1, shell/2, shell/3 ]). +%%% Type exports +-export_type([connection_ref/0, + channel_id/0 + ]). + %%-------------------------------------------------------------------- -spec start() -> ok | {error, term()}. -spec start(permanent | transient | temporary) -> ok | {error, term()}. @@ -81,7 +87,7 @@ connect(Host, Port, Options, Timeout) -> ConnectionTimeout = proplists:get_value(connect_timeout, Options, infinity), try Transport:connect(Host, Port, [ {active, false} | SocketOptions], ConnectionTimeout) of {ok, Socket} -> - Opts = [{user_pid, self()}, {host, Host} | fix_idle_time(SshOptions)], + Opts = [{user_pid,self()}, {host,Host} | SshOptions], ssh_connection_handler:start_connection(client, Socket, Opts, Timeout); {error, Reason} -> {error, Reason} @@ -153,6 +159,19 @@ daemon(HostAddr, Port, Options0) -> start_daemon(Host, Port, Options, Inet). %%-------------------------------------------------------------------- +daemon_info(Pid) -> + case catch ssh_system_sup:acceptor_supervisor(Pid) of + AsupPid when is_pid(AsupPid) -> + [Port] = + [Prt || {{ssh_acceptor_sup,any,Prt,default}, + _WorkerPid,worker,[ssh_acceptor]} <- supervisor:which_children(AsupPid)], + {ok, [{port,Port}]}; + + _ -> + {error,bad_daemon_ref} + end. + +%%-------------------------------------------------------------------- -spec stop_listener(pid()) -> ok. -spec stop_listener(inet:ip_address(), integer()) -> ok. %% @@ -223,13 +242,6 @@ default_algorithms() -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -fix_idle_time(SshOptions) -> - case proplists:get_value(idle_time, SshOptions) of - undefined -> - [{idle_time, infinity}|SshOptions]; - _ -> - SshOptions - end. start_daemon(Host, Port, Options, Inet) -> case handle_options(Options) of {error, _Reason} = Error -> @@ -243,32 +255,52 @@ start_daemon(Host, Port, Options, Inet) -> end end. -do_start_daemon(Host0, Port0, Options, SocketOptions) -> - {Host,Port} = try - case proplists:get_value(fd, SocketOptions) of - undefined -> - {Host0,Port0}; - Fd when Port0==0 -> - find_hostport(Fd); - _ -> - {Host0,Port0} - end - catch - _:_ -> throw(bad_fd) - end, - Profile = proplists:get_value(profile, Options, ?DEFAULT_PROFILE), +do_start_daemon(Host0, Port0, SshOptions, SocketOptions) -> + {Host,Port1} = + try + case proplists:get_value(fd, SocketOptions) of + undefined -> + {Host0,Port0}; + Fd when Port0==0 -> + find_hostport(Fd); + _ -> + {Host0,Port0} + end + catch + _:_ -> throw(bad_fd) + end, + Profile = proplists:get_value(profile, SshOptions, ?DEFAULT_PROFILE), + {Port, WaitRequestControl, Opts} = + case Port1 of + 0 -> %% Allocate the socket here to get the port number... + {_, Callback, _} = + proplists:get_value(transport, SshOptions, {tcp, gen_tcp, tcp_closed}), + {ok,LSock} = ssh_acceptor:callback_listen(Callback, 0, SocketOptions), + {ok,{_,LPort}} = inet:sockname(LSock), + {LPort, + {LSock,Callback}, + [{lsocket,LSock},{lsock_owner,self()}] + }; + _ -> + {Port1, false, []} + end, case ssh_system_sup:system_supervisor(Host, Port, Profile) of undefined -> %% It would proably make more sense to call the %% address option host but that is a too big change at the %% monent. The name is a legacy name! try sshd_sup:start_child([{address, Host}, - {port, Port}, {role, server}, + {port, Port}, + {role, server}, {socket_opts, SocketOptions}, - {ssh_opts, Options}]) of + {ssh_opts, SshOptions} + | Opts]) of {error, {already_started, _}} -> {error, eaddrinuse}; - Result = {Code, _} when (Code == ok) or (Code == error) -> + Result = {ok,_} -> + sync_request_control(WaitRequestControl), + Result; + Result = {error, _} -> Result catch exit:{noproc, _} -> @@ -277,18 +309,31 @@ do_start_daemon(Host0, Port0, Options, SocketOptions) -> Sup -> AccPid = ssh_system_sup:acceptor_supervisor(Sup), case ssh_acceptor_sup:start_child(AccPid, [{address, Host}, - {port, Port}, {role, server}, + {port, Port}, + {role, server}, {socket_opts, SocketOptions}, - {ssh_opts, Options}]) of + {ssh_opts, SshOptions} + | Opts]) of {error, {already_started, _}} -> {error, eaddrinuse}; {ok, _} -> + sync_request_control(WaitRequestControl), {ok, Sup}; Other -> Other end end. +sync_request_control(false) -> + ok; +sync_request_control({LSock,Callback}) -> + receive + {request_control,LSock,ReqPid} -> + ok = Callback:controlling_process(LSock, ReqPid), + ReqPid ! {its_yours,LSock}, + ok + end. + find_hostport(Fd) -> %% Using internal functions inet:open/8 and inet:close/0. %% Don't try this at home unless you know what you are doing! diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 73d6e4d2bc..868f3a9181 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -70,8 +70,6 @@ -record(ssh, { - %%state, %% what it's waiting for - role, %% client | server peer, %% string version of peer address @@ -135,8 +133,8 @@ user, service, userauth_quiet_mode, % boolean() - userauth_supported_methods, % string() eg "keyboard-interactive,password" userauth_methods, % list( string() ) eg ["keyboard-interactive", "password"] + userauth_supported_methods, % string() eg "keyboard-interactive,password" kb_tries_left = 0, % integer(), num tries left for "keyboard-interactive" userauth_preference, available_host_keys, diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index d94dedf1bf..90fd951dcd 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -26,7 +26,8 @@ %% Internal application API -export([start_link/5, - number_of_connections/1]). + number_of_connections/1, + callback_listen/3]). %% spawn export -export([acceptor_init/6, acceptor_loop/6]). @@ -46,15 +47,39 @@ start_link(Port, Address, SockOpts, Opts, AcceptTimeout) -> acceptor_init(Parent, Port, Address, SockOpts, Opts, AcceptTimeout) -> {_, Callback, _} = proplists:get_value(transport, Opts, {tcp, gen_tcp, tcp_closed}), - case (catch do_socket_listen(Callback, Port, [{active, false} | SockOpts])) of - {ok, ListenSocket} -> + + SockOwner = proplists:get_value(lsock_owner, Opts), + LSock = proplists:get_value(lsocket, Opts), + UseExistingSocket = + case catch inet:sockname(LSock) of + {ok,{_,Port}} -> is_pid(SockOwner); + _ -> false + end, + + case UseExistingSocket of + true -> proc_lib:init_ack(Parent, {ok, self()}), - acceptor_loop(Callback, - Port, Address, Opts, ListenSocket, AcceptTimeout); - Error -> - proc_lib:init_ack(Parent, Error), - error + request_ownership(LSock, SockOwner), + acceptor_loop(Callback, Port, Address, Opts, LSock, AcceptTimeout); + + false -> + case (catch do_socket_listen(Callback, Port, SockOpts)) of + {ok, ListenSocket} -> + proc_lib:init_ack(Parent, {ok, self()}), + acceptor_loop(Callback, + Port, Address, Opts, ListenSocket, AcceptTimeout); + Error -> + proc_lib:init_ack(Parent, Error), + error + end end. + +request_ownership(LSock, SockOwner) -> + SockOwner ! {request_control,LSock,self()}, + receive + {its_yours,LSock} -> ok + end. + do_socket_listen(Callback, Port0, Opts) -> Port = @@ -62,6 +87,10 @@ do_socket_listen(Callback, Port0, Opts) -> undefined -> Port0; _ -> 0 end, + callback_listen(Callback, Port, Opts). + +callback_listen(Callback, Port, Opts0) -> + Opts = [{active, false}, {reuseaddr,true} | Opts0], case Callback:listen(Port, Opts) of {error, nxdomain} -> Callback:listen(Port, lists:delete(inet6, Opts)); diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl index b2f489a971..4f76dbe6f0 100644 --- a/lib/ssh/src/ssh_acceptor_sup.erl +++ b/lib/ssh/src/ssh_acceptor_sup.erl @@ -85,10 +85,7 @@ child_spec(ServerOpts) -> Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), Name = id(Address, Port, Profile), SocketOpts = proplists:get_value(socket_opts, ServerOpts), - StartFunc = {ssh_acceptor, start_link, [Port, Address, - [{active, false}, - {reuseaddr, true}] ++ SocketOpts, - ServerOpts, Timeout]}, + StartFunc = {ssh_acceptor, start_link, [Port, Address, SocketOpts, ServerOpts, Timeout]}, Restart = transient, Shutdown = brutal_kill, Modules = [ssh_acceptor], diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index 4b3c21ce3f..49eec8072f 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -135,9 +135,9 @@ init_userauth_request_msg(#ssh{opts = Opts} = Ssh) -> service = "ssh-connection"}); {error, no_user} -> ErrStr = "Could not determine the users name", - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_ILLEGAL_USER_NAME, - description = ErrStr, - language = "en"}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_ILLEGAL_USER_NAME, + description = ErrStr}) end. userauth_request_msg(#ssh{userauth_preference = []} = Ssh) -> @@ -355,10 +355,10 @@ handle_userauth_info_response(#ssh_msg_userauth_info_response{num_responses = 1, handle_userauth_info_response(#ssh_msg_userauth_info_response{}, _Auth) -> - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "Server does not support" - "keyboard-interactive", - language = "en"}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "Server does not support keyboard-interactive" + }). %%-------------------------------------------------------------------- @@ -420,10 +420,10 @@ check_password(User, Password, Opts, Ssh) -> {false,NewState} -> {false, Ssh#ssh{pwdfun_user_state=NewState}}; disconnect -> - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = - "Unable to connect using the available authentication methods", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "Unable to connect using the available authentication methods" + }) end end. diff --git a/lib/ssh/src/ssh_channel.erl b/lib/ssh/src/ssh_channel.erl index de6908bb38..a8e6ebde16 100644 --- a/lib/ssh/src/ssh_channel.erl +++ b/lib/ssh/src/ssh_channel.erl @@ -68,7 +68,7 @@ %% Internal application API -export([cache_create/0, cache_lookup/2, cache_update/2, cache_delete/1, cache_delete/2, cache_foldl/3, - cache_find/2, + cache_info/2, cache_find/2, get_print_info/1]). -record(state, { @@ -335,6 +335,9 @@ cache_delete(Cache) -> cache_foldl(Fun, Acc, Cache) -> ets:foldl(Fun, Acc, Cache). +cache_info(num_entries, Cache) -> + proplists:get_value(size, ets:info(Cache)). + cache_find(ChannelPid, Cache) -> case ets:match_object(Cache, #channel{user = ChannelPid}) of [] -> diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl index 397d51de9d..4fb6bc39f3 100644 --- a/lib/ssh/src/ssh_connect.hrl +++ b/lib/ssh/src/ssh_connect.hrl @@ -22,13 +22,15 @@ %%% Description : SSH connection protocol --type channel_id() :: integer(). +-type role() :: client | server . +-type connection_ref() :: pid(). +-type channel_id() :: pos_integer(). -define(DEFAULT_PACKET_SIZE, 65536). -define(DEFAULT_WINDOW_SIZE, 10*?DEFAULT_PACKET_SIZE). -define(DEFAULT_TIMEOUT, 5000). --define(MAX_PROTO_VERSION, 255). +-define(MAX_PROTO_VERSION, 255). % Max length of the hello string %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @@ -241,7 +243,7 @@ -record(channel, { - type, %% "session", "x11", "forwarded-tcpip", "direct-tcpip" + type, %% "session" sys, %% "none", "shell", "exec" "subsystem" user, %% "user" process id (default to cm user) flow_control, diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index a34478732c..d0f2d54c06 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -38,8 +38,7 @@ %% Potential API currently unsupported and not tested -export([window_change/4, window_change/6, - direct_tcpip/6, direct_tcpip/8, tcpip_forward/3, - cancel_tcpip_forward/3, signal/3, exit_status/3]). + signal/3, exit_status/3]). %% Internal application API -export([channel_data/5, handle_msg/3, channel_eof_msg/1, @@ -48,7 +47,7 @@ channel_adjust_window_msg/2, channel_data_msg/3, channel_open_msg/5, channel_open_confirmation_msg/4, channel_open_failure_msg/4, channel_request_msg/4, - global_request_msg/3, request_failure_msg/0, + request_failure_msg/0, request_success_msg/1, bind/4, unbind/3, unbind_channel/2, bound_channel/3, encode_ip/1]). @@ -232,52 +231,6 @@ exit_status(ConnectionHandler, Channel, Status) -> ssh_connection_handler:request(ConnectionHandler, Channel, "exit-status", false, [?uint32(Status)], 0). -direct_tcpip(ConnectionHandler, RemoteHost, - RemotePort, OrigIP, OrigPort, Timeout) -> - direct_tcpip(ConnectionHandler, RemoteHost, RemotePort, OrigIP, OrigPort, - ?DEFAULT_WINDOW_SIZE, ?DEFAULT_PACKET_SIZE, Timeout). - -direct_tcpip(ConnectionHandler, RemoteIP, RemotePort, OrigIP, OrigPort, - InitialWindowSize, MaxPacketSize, Timeout) -> - case {encode_ip(RemoteIP), encode_ip(OrigIP)} of - {false, _} -> - {error, einval}; - {_, false} -> - {error, einval}; - {RIP, OIP} -> - ssh_connection_handler:open_channel(ConnectionHandler, - "direct-tcpip", - [?string(RIP), - ?uint32(RemotePort), - ?string(OIP), - ?uint32(OrigPort)], - InitialWindowSize, - MaxPacketSize, - Timeout) - end. - -tcpip_forward(ConnectionHandler, BindIP, BindPort) -> - case encode_ip(BindIP) of - false -> - {error, einval}; - IPStr -> - ssh_connection_handler:global_request(ConnectionHandler, - "tcpip-forward", true, - [?string(IPStr), - ?uint32(BindPort)]) - end. - -cancel_tcpip_forward(ConnectionHandler, BindIP, Port) -> - case encode_ip(BindIP) of - false -> - {error, einval}; - IPStr -> - ssh_connection_handler:global_request(ConnectionHandler, - "cancel-tcpip-forward", true, - [?string(IPStr), - ?uint32(Port)]) - end. - %%-------------------------------------------------------------------- %%% Internal API %%-------------------------------------------------------------------- @@ -300,22 +253,11 @@ l2b([]) -> channel_data(ChannelId, DataType, Data, Connection, From) when is_list(Data)-> - channel_data(ChannelId, DataType, -%% list_to_binary(Data), Connection, From); - l2b(Data), Connection, From); - %% try list_to_binary(Data) - %% of - %% B -> B - %% catch - %% _:_ -> io:format('BAD BINARY: ~p~n',[Data]), - %% unicode:characters_to_binary(Data) - %% end, - %% Connection, From); + channel_data(ChannelId, DataType, l2b(Data), Connection, From); channel_data(ChannelId, DataType, Data, #connection{channel_cache = Cache} = Connection, From) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of #channel{remote_id = Id, sent_close = false} = Channel0 -> {SendList, Channel} = @@ -331,8 +273,7 @@ channel_data(ChannelId, DataType, Data, FlowCtrlMsgs = flow_control(Replies, Channel, Cache), {{replies, Replies ++ FlowCtrlMsgs}, Connection}; _ -> - gen_fsm:reply(From, {error, closed}), - {noreply, Connection} + {{replies,[{channel_request_reply,From,{error,closed}}]}, Connection} end. handle_msg(#ssh_msg_channel_open_confirmation{recipient_channel = ChannelId, @@ -499,7 +440,8 @@ handle_msg(#ssh_msg_channel_open{channel_type = "session" = Type, handle_msg(#ssh_msg_channel_open{channel_type = "session", sender_channel = RemoteId}, - Connection, client) -> + Connection, + client) -> %% Client implementations SHOULD reject any session channel open %% requests to make it more difficult for a corrupt server to attack the %% client. See See RFC 4254 6.1. @@ -509,73 +451,6 @@ handle_msg(#ssh_msg_channel_open{channel_type = "session", {{replies, [{connection_reply, FailMsg}]}, Connection}; -handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip" = Type, - sender_channel = RemoteId, - initial_window_size = RWindowSz, - maximum_packet_size = RPacketSz, - data = Data}, - #connection{channel_cache = Cache, - options = SSHopts} = Connection0, server) -> - <<?UINT32(ALen), Address:ALen/binary, ?UINT32(Port), - ?UINT32(OLen), Orig:OLen/binary, ?UINT32(OrigPort)>> = Data, - - MinAcceptedPackSz = proplists:get_value(minimal_remote_max_packet_size, SSHopts, 0), - - if - MinAcceptedPackSz =< RPacketSz -> - case bound_channel(Address, Port, Connection0) of - undefined -> - FailMsg = channel_open_failure_msg(RemoteId, - ?SSH_OPEN_CONNECT_FAILED, - "Connection refused", "en"), - {{replies, - [{connection_reply, FailMsg}]}, Connection0}; - ChannelPid -> - {ChannelId, Connection1} = new_channel_id(Connection0), - LWindowSz = ?DEFAULT_WINDOW_SIZE, - LPacketSz = ?DEFAULT_PACKET_SIZE, - Channel = #channel{type = Type, - sys = "none", - user = ChannelPid, - local_id = ChannelId, - recv_window_size = LWindowSz, - recv_packet_size = LPacketSz, - send_window_size = RWindowSz, - send_packet_size = RPacketSz, - send_buf = queue:new() - }, - ssh_channel:cache_update(Cache, Channel), - OpenConfMsg = channel_open_confirmation_msg(RemoteId, ChannelId, - LWindowSz, LPacketSz), - {OpenMsg, Connection} = - reply_msg(Channel, Connection1, - {open, Channel, {forwarded_tcpip, - decode_ip(Address), Port, - decode_ip(Orig), OrigPort}}), - {{replies, [{connection_reply, OpenConfMsg}, - OpenMsg]}, Connection} - end; - - MinAcceptedPackSz > RPacketSz -> - FailMsg = channel_open_failure_msg(RemoteId, - ?SSH_OPEN_ADMINISTRATIVELY_PROHIBITED, - lists:concat(["Maximum packet size below ",MinAcceptedPackSz, - " not supported"]), "en"), - {{replies, [{connection_reply, FailMsg}]}, Connection0} - end; - - -handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip", - sender_channel = RemoteId}, - Connection, client) -> - %% Client implementations SHOULD reject direct TCP/IP open requests for - %% security reasons. See RFC 4254 7.2. - FailMsg = channel_open_failure_msg(RemoteId, - ?SSH_OPEN_CONNECT_FAILED, - "Connection refused", "en"), - {{replies, [{connection_reply, FailMsg}]}, Connection}; - - handle_msg(#ssh_msg_channel_open{sender_channel = RemoteId}, Connection, _) -> FailMsg = channel_open_failure_msg(RemoteId, ?SSH_OPEN_ADMINISTRATIVELY_PROHIBITED, @@ -786,11 +661,11 @@ handle_msg(#ssh_msg_global_request{name = _Type, handle_msg(#ssh_msg_request_failure{}, #connection{requests = [{_, From} | Rest]} = Connection, _) -> - {{replies, [{channel_requst_reply, From, {failure, <<>>}}]}, + {{replies, [{channel_request_reply, From, {failure, <<>>}}]}, Connection#connection{requests = Rest}}; handle_msg(#ssh_msg_request_success{data = Data}, #connection{requests = [{_, From} | Rest]} = Connection, _) -> - {{replies, [{channel_requst_reply, From, {success, Data}}]}, + {{replies, [{channel_request_reply, From, {success, Data}}]}, Connection#connection{requests = Rest}}; handle_msg(#ssh_msg_disconnect{code = Code, @@ -886,10 +761,6 @@ channel_request_msg(ChannelId, Type, WantReply, Data) -> want_reply = WantReply, data = Data}. -global_request_msg(Type, WantReply, Data) -> - #ssh_msg_global_request{name = Type, - want_reply = WantReply, - data = Data}. request_failure_msg() -> #ssh_msg_request_failure{}. @@ -1059,7 +930,7 @@ request_reply_or_data(#channel{local_id = ChannelId, user = ChannelPid}, Connection, Reply) -> case lists:keysearch(ChannelId, 1, Requests) of {value, {ChannelId, From}} -> - {{channel_requst_reply, From, Reply}, + {{channel_request_reply, From, Reply}, Connection#connection{requests = lists:keydelete(ChannelId, 1, Requests)}}; false when (Reply == success) or (Reply == failure) -> @@ -1351,11 +1222,6 @@ decode_pty_opts2(<<Code, ?UINT32(Value), Tail/binary>>) -> end, [{Op, Value} | decode_pty_opts2(Tail)]. -decode_ip(Addr) when is_binary(Addr) -> - case inet_parse:address(binary_to_list(Addr)) of - {error,_} -> Addr; - {ok,A} -> A - end. backwards_compatible([], Acc) -> Acc; diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 2bef6a41cd..0327a72c12 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -28,94 +28,90 @@ -module(ssh_connection_handler). --behaviour(gen_fsm). +-behaviour(gen_statem). -include("ssh.hrl"). -include("ssh_transport.hrl"). -include("ssh_auth.hrl"). -include("ssh_connect.hrl"). --compile(export_all). --export([start_link/3]). -%% Internal application API --export([open_channel/6, reply_request/3, request/6, request/7, - global_request/4, send/5, send_eof/2, info/1, info/2, - connection_info/2, channel_info/3, - adjust_window/3, close/2, stop/1, renegotiate/1, renegotiate_data/1, - start_connection/4, - get_print_info/1]). - -%% gen_fsm callbacks --export([hello/2, kexinit/2, key_exchange/2, - key_exchange_dh_gex_init/2, key_exchange_dh_gex_reply/2, - new_keys/2, - service_request/2, connected/2, - userauth/2, - userauth_keyboard_interactive/2, - userauth_keyboard_interactive_info_response/2, - error/2]). - --export([init/1, handle_event/3, - handle_sync_event/4, handle_info/3, terminate/3, format_status/2, code_change/4]). - --record(state, { - role, - client, - starter, - auth_user, - connection_state, - latest_channel_id = 0, - idle_timer_ref, - transport_protocol, % ex: tcp - transport_cb, - transport_close_tag, - ssh_params, % #ssh{} - from ssh.hrl - socket, % socket() - decoded_data_buffer, % binary() - encoded_data_buffer, % binary() - undecoded_packet_length, % integer() - key_exchange_init_msg, % #ssh_msg_kexinit{} - renegotiate = false, % boolean() - last_size_rekey = 0, - event_queue = [], - connection_queue, - address, - port, - opts, - recbuf - }). - --type state_name() :: hello | kexinit | key_exchange | key_exchange_dh_gex_init | - key_exchange_dh_gex_reply | new_keys | service_request | - userauth | userauth_keyboard_interactive | - userauth_keyboard_interactive_info_response | - connection. - --type gen_fsm_state_return() :: {next_state, state_name(), term()} | - {next_state, state_name(), term(), timeout()} | - {stop, term(), term()}. - --type gen_fsm_sync_return() :: {next_state, state_name(), term()} | - {next_state, state_name(), term(), timeout()} | - {reply, term(), state_name(), term()} | - {stop, term(), term(), term()}. +%%==================================================================== +%%% Exports +%%==================================================================== + +%%% Start and stop +-export([start_link/3, + stop/1 + ]). + +%%% Internal application API +-export([start_connection/4, + open_channel/6, + request/6, request/7, + reply_request/3, + send/5, + send_eof/2, + info/1, info/2, + connection_info/2, + channel_info/3, + adjust_window/3, close/2, + disconnect/1, disconnect/2, + get_print_info/1 + ]). + +%%% Behaviour callbacks +-export([handle_event/4, terminate/3, format_status/2, code_change/4]). + +%%% Exports not intended to be used :). They are used for spawning and tests +-export([init_connection_handler/3, % proc_lib:spawn needs this + init_ssh_record/3, % Export of this internal function + % intended for low-level protocol test suites + renegotiate/1, renegotiate_data/1 % Export intended for test cases + ]). %%==================================================================== -%% Internal application API +%% Start / stop %%==================================================================== +%%-------------------------------------------------------------------- +-spec start_link(role(), + inet:socket(), + proplists:proplist() + ) -> {ok, pid()}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +start_link(Role, Socket, Options) -> + {ok, proc_lib:spawn_link(?MODULE, init_connection_handler, [Role, Socket, Options])}. + %%-------------------------------------------------------------------- --spec start_connection(client| server, port(), proplists:proplist(), - timeout()) -> {ok, pid()} | {error, term()}. +-spec stop(connection_ref() + ) -> ok | {error, term()}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +stop(ConnectionHandler)-> + case call(ConnectionHandler, stop) of + {error, closed} -> + ok; + Other -> + Other + end. + +%%==================================================================== +%% Internal application API +%%==================================================================== + +-define(DefaultTransport, {tcp, gen_tcp, tcp_closed} ). + %%-------------------------------------------------------------------- +-spec start_connection(role(), + inet:socket(), + proplists:proplist(), + timeout() + ) -> {ok, connection_ref()} | {error, term()}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . start_connection(client = Role, Socket, Options, Timeout) -> try {ok, Pid} = sshc_sup:start_child([Role, Socket, Options]), - {_, Callback, _} = - proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}), - ok = socket_control(Socket, Pid, Callback), - Ref = erlang:monitor(process, Pid), - handshake(Pid, Ref, Timeout) + ok = socket_control(Socket, Pid, Options), + handshake(Pid, erlang:monitor(process,Pid), Timeout) catch exit:{noproc, _} -> {error, ssh_not_started}; @@ -128,8 +124,8 @@ start_connection(server = Role, Socket, Options, Timeout) -> try case proplists:get_value(parallel_login, SSH_Opts, false) of true -> - HandshakerPid = - spawn_link(fun() -> + HandshakerPid = + spawn_link(fun() -> receive {do_handshake, Pid} -> handshake(Pid, erlang:monitor(process,Pid), Timeout) @@ -148,953 +144,1123 @@ start_connection(server = Role, Socket, Options, Timeout) -> {error, Error} end. -start_the_connection_child(UserPid, Role, Socket, Options) -> - Sups = proplists:get_value(supervisors, Options), - ConnectionSup = proplists:get_value(connection_sup, Sups), - Opts = [{supervisors, Sups}, {user_pid, UserPid} | proplists:get_value(ssh_opts, Options, [])], - {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Opts]), - {_, Callback, _} = proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}), - socket_control(Socket, Pid, Callback), - Pid. - +%%-------------------------------------------------------------------- +%%% Some other module has decided to disconnect. +-spec disconnect(#ssh_msg_disconnect{}) -> no_return(). +-spec disconnect(#ssh_msg_disconnect{}, iodata()) -> no_return(). +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +disconnect(Msg = #ssh_msg_disconnect{}) -> + throw({keep_state_and_data, + [{next_event, internal, {disconnect, Msg, Msg#ssh_msg_disconnect.description}}]}). -start_link(Role, Socket, Options) -> - {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Socket, Options]])}. +disconnect(Msg = #ssh_msg_disconnect{}, ExtraInfo) -> + throw({keep_state_and_data, + [{next_event, internal, {disconnect, Msg, {Msg#ssh_msg_disconnect.description,ExtraInfo}}}]}). -init([Role, Socket, SshOpts]) -> - process_flag(trap_exit, true), - {NumVsn, StrVsn} = ssh_transport:versions(Role, SshOpts), - {Protocol, Callback, CloseTag} = - proplists:get_value(transport, SshOpts, {tcp, gen_tcp, tcp_closed}), - Cache = ssh_channel:cache_create(), - State0 = #state{ - role = Role, - connection_state = #connection{channel_cache = Cache, - channel_id_seed = 0, - port_bindings = [], - requests = [], - options = SshOpts}, - socket = Socket, - decoded_data_buffer = <<>>, - encoded_data_buffer = <<>>, - transport_protocol = Protocol, - transport_cb = Callback, - transport_close_tag = CloseTag, - opts = SshOpts - }, - - State = init_role(State0), - - try init_ssh(Role, NumVsn, StrVsn, SshOpts, Socket) of - Ssh -> - gen_fsm:enter_loop(?MODULE, [], hello, - State#state{ssh_params = Ssh}) - catch - _:Error -> - gen_fsm:enter_loop(?MODULE, [], error, {Error, State}) - end. -%% Temporary fix for the Nessus error. SYN-> <-SYNACK ACK-> RST-> ? -error(_Event, {Error,State=#state{}}) -> - case Error of - {badmatch,{error,enotconn}} -> - %% {error,enotconn} probably from inet:peername in - %% init_ssh(server,..)/5 called from init/1 - {stop, {shutdown,"TCP connenction to server was prematurely closed by the client"}, State}; - _ -> - {stop, {shutdown,{init,Error}}, State} - end; -error(Event, State) -> - %% State deliberately not checked beeing #state. This is a panic-clause... - {stop, {shutdown,{init,{spurious_error,Event}}}, State}. - -%%-------------------------------------------------------------------- --spec open_channel(pid(), string(), iodata(), integer(), integer(), - timeout()) -> {open, channel_id()} | {error, term()}. %%-------------------------------------------------------------------- -open_channel(ConnectionHandler, ChannelType, ChannelSpecificData, - InitialWindowSize, - MaxPacketSize, Timeout) -> - sync_send_all_state_event(ConnectionHandler, {open, self(), ChannelType, - InitialWindowSize, MaxPacketSize, - ChannelSpecificData, - Timeout}). -%%-------------------------------------------------------------------- --spec request(pid(), pid(), channel_id(), string(), boolean(), iodata(), - timeout()) -> success | failure | ok | {error, term()}. +-spec open_channel(connection_ref(), + string(), + iodata(), + pos_integer(), + pos_integer(), + timeout() + ) -> {open, channel_id()} | {error, term()}. + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +open_channel(ConnectionHandler, + ChannelType, ChannelSpecificData, InitialWindowSize, MaxPacketSize, + Timeout) -> + call(ConnectionHandler, + {open, + self(), + ChannelType, InitialWindowSize, MaxPacketSize, ChannelSpecificData, + Timeout}). + %%-------------------------------------------------------------------- +-spec request(connection_ref(), + pid(), + channel_id(), + string(), + boolean(), + iodata(), + timeout() + ) -> success | failure | ok | {error,timeout}. + +-spec request(connection_ref(), + channel_id(), + string(), + boolean(), + iodata(), + timeout() + ) -> success | failure | ok | {error,timeout}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . request(ConnectionHandler, ChannelPid, ChannelId, Type, true, Data, Timeout) -> - sync_send_all_state_event(ConnectionHandler, {request, ChannelPid, ChannelId, Type, Data, - Timeout}); + call(ConnectionHandler, {request, ChannelPid, ChannelId, Type, Data, Timeout}); request(ConnectionHandler, ChannelPid, ChannelId, Type, false, Data, _) -> - send_all_state_event(ConnectionHandler, {request, ChannelPid, ChannelId, Type, Data}). + cast(ConnectionHandler, {request, ChannelPid, ChannelId, Type, Data}). -%%-------------------------------------------------------------------- --spec request(pid(), channel_id(), string(), boolean(), iodata(), - timeout()) -> success | failure | {error, timeout}. -%%-------------------------------------------------------------------- request(ConnectionHandler, ChannelId, Type, true, Data, Timeout) -> - sync_send_all_state_event(ConnectionHandler, {request, ChannelId, Type, Data, Timeout}); + call(ConnectionHandler, {request, ChannelId, Type, Data, Timeout}); request(ConnectionHandler, ChannelId, Type, false, Data, _) -> - send_all_state_event(ConnectionHandler, {request, ChannelId, Type, Data}). + cast(ConnectionHandler, {request, ChannelId, Type, Data}). %%-------------------------------------------------------------------- --spec reply_request(pid(), success | failure, channel_id()) -> ok. -%%-------------------------------------------------------------------- +-spec reply_request(connection_ref(), + success | failure, + channel_id() + ) -> ok. + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . reply_request(ConnectionHandler, Status, ChannelId) -> - send_all_state_event(ConnectionHandler, {reply_request, Status, ChannelId}). - -%%-------------------------------------------------------------------- --spec global_request(pid(), string(), boolean(), iolist()) -> ok | error. -%%-------------------------------------------------------------------- -global_request(ConnectionHandler, Type, true = Reply, Data) -> - case sync_send_all_state_event(ConnectionHandler, - {global_request, self(), Type, Reply, Data}) of - {ssh_cm, ConnectionHandler, {success, _}} -> - ok; - {ssh_cm, ConnectionHandler, {failure, _}} -> - error - end; -global_request(ConnectionHandler, Type, false = Reply, Data) -> - send_all_state_event(ConnectionHandler, {global_request, self(), Type, Reply, Data}). + cast(ConnectionHandler, {reply_request, Status, ChannelId}). %%-------------------------------------------------------------------- --spec send(pid(), channel_id(), integer(), iodata(), timeout()) -> - ok | {error, timeout} | {error, closed}. -%%-------------------------------------------------------------------- +-spec send(connection_ref(), + channel_id(), + non_neg_integer(), + iodata(), + timeout() + ) -> ok | {error, timeout|closed}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . send(ConnectionHandler, ChannelId, Type, Data, Timeout) -> - sync_send_all_state_event(ConnectionHandler, {data, ChannelId, Type, Data, Timeout}). + call(ConnectionHandler, {data, ChannelId, Type, Data, Timeout}). %%-------------------------------------------------------------------- --spec send_eof(pid(), channel_id()) -> ok | {error, closed}. -%%-------------------------------------------------------------------- +-spec send_eof(connection_ref(), + channel_id() + ) -> ok | {error,closed}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . send_eof(ConnectionHandler, ChannelId) -> - sync_send_all_state_event(ConnectionHandler, {eof, ChannelId}). + call(ConnectionHandler, {eof, ChannelId}). %%-------------------------------------------------------------------- --spec connection_info(pid(), [atom()]) -> proplists:proplist(). +-spec info(connection_ref() + ) -> {ok, [#channel{}]} . + +-spec info(connection_ref(), + pid() | all + ) -> {ok, [#channel{}]} . +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +info(ConnectionHandler) -> + info(ConnectionHandler, all). + +info(ConnectionHandler, ChannelProcess) -> + call(ConnectionHandler, {info, ChannelProcess}). + %%-------------------------------------------------------------------- +-type local_sock_info() :: {inet:ip_address(), non_neg_integer()} | string(). +-type peer_sock_info() :: {inet:ip_address(), non_neg_integer()} | string(). +-type state_info() :: iolist(). + +-spec get_print_info(connection_ref() + ) -> {{local_sock_info(), peer_sock_info()}, + state_info() + }. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . get_print_info(ConnectionHandler) -> - sync_send_all_state_event(ConnectionHandler, get_print_info, 1000). + call(ConnectionHandler, get_print_info, 1000). +%%-------------------------------------------------------------------- +-spec connection_info(connection_ref(), + [atom()] + ) -> proplists:proplist(). +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . connection_info(ConnectionHandler, Options) -> - sync_send_all_state_event(ConnectionHandler, {connection_info, Options}). + call(ConnectionHandler, {connection_info, Options}). %%-------------------------------------------------------------------- --spec channel_info(pid(), channel_id(), [atom()]) -> proplists:proplist(). -%%-------------------------------------------------------------------- +-spec channel_info(connection_ref(), + channel_id(), + [atom()] + ) -> proplists:proplist(). +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . channel_info(ConnectionHandler, ChannelId, Options) -> - sync_send_all_state_event(ConnectionHandler, {channel_info, ChannelId, Options}). + call(ConnectionHandler, {channel_info, ChannelId, Options}). %%-------------------------------------------------------------------- --spec adjust_window(pid(), channel_id(), integer()) -> ok. -%%-------------------------------------------------------------------- +-spec adjust_window(connection_ref(), + channel_id(), + integer() + ) -> ok. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . adjust_window(ConnectionHandler, Channel, Bytes) -> - send_all_state_event(ConnectionHandler, {adjust_window, Channel, Bytes}). -%%-------------------------------------------------------------------- --spec renegotiate(pid()) -> ok. -%%-------------------------------------------------------------------- -renegotiate(ConnectionHandler) -> - send_all_state_event(ConnectionHandler, renegotiate). - -%%-------------------------------------------------------------------- --spec renegotiate_data(pid()) -> ok. -%%-------------------------------------------------------------------- -renegotiate_data(ConnectionHandler) -> - send_all_state_event(ConnectionHandler, data_size). + cast(ConnectionHandler, {adjust_window, Channel, Bytes}). %%-------------------------------------------------------------------- --spec close(pid(), channel_id()) -> ok. -%%-------------------------------------------------------------------- +-spec close(connection_ref(), + channel_id() + ) -> ok. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . close(ConnectionHandler, ChannelId) -> - case sync_send_all_state_event(ConnectionHandler, {close, ChannelId}) of + case call(ConnectionHandler, {close, ChannelId}) of ok -> ok; - {error, closed} -> + {error, closed} -> ok - end. - -%%-------------------------------------------------------------------- --spec stop(pid()) -> ok | {error, term()}. -%%-------------------------------------------------------------------- -stop(ConnectionHandler)-> - case sync_send_all_state_event(ConnectionHandler, stop) of - {error, closed} -> - ok; - Other -> - Other end. -info(ConnectionHandler) -> - info(ConnectionHandler, {info, all}). +%%==================================================================== +%% Test support +%%==================================================================== +%%-------------------------------------------------------------------- +-spec renegotiate(connection_ref() + ) -> ok. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +renegotiate(ConnectionHandler) -> + cast(ConnectionHandler, renegotiate). -info(ConnectionHandler, ChannelProcess) -> - sync_send_all_state_event(ConnectionHandler, {info, ChannelProcess}). +%%-------------------------------------------------------------------- +-spec renegotiate_data(connection_ref() + ) -> ok. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +renegotiate_data(ConnectionHandler) -> + cast(ConnectionHandler, data_size). %%==================================================================== -%% gen_fsm callbacks +%% Internal process state %%==================================================================== +-record(data, { + starter :: pid(), + auth_user :: string() + | undefined, + connection_state :: #connection{}, + latest_channel_id = 0 :: non_neg_integer(), + idle_timer_ref :: undefined + | infinity + | reference(), + idle_timer_value = infinity :: infinity + | pos_integer(), + transport_protocol :: atom(), % ex: tcp + transport_cb :: atom(), % ex: gen_tcp + transport_close_tag :: atom(), % ex: tcp_closed + ssh_params :: #ssh{} + | undefined, + socket :: inet:socket(), + decrypted_data_buffer = <<>> :: binary(), + encrypted_data_buffer = <<>> :: binary(), + undecrypted_packet_length :: undefined | non_neg_integer(), + key_exchange_init_msg :: #ssh_msg_kexinit{} + | undefined, + last_size_rekey = 0 :: non_neg_integer(), + event_queue = [] :: list(), + opts :: proplists:proplist(), + inet_initial_recbuf_size :: pos_integer() + | undefined + }). +%%==================================================================== +%% Intitialisation +%%==================================================================== %%-------------------------------------------------------------------- --spec hello(socket_control | {info_line, list()} | {version_exchange, list()}, - #state{}) -> gen_fsm_state_return(). +-spec init_connection_handler(role(), + inet:socket(), + proplists:proplist() + ) -> no_return(). +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +init_connection_handler(Role, Socket, Opts) -> + process_flag(trap_exit, true), + S0 = init_process_state(Role, Socket, Opts), + try + {Protocol, Callback, CloseTag} = + proplists:get_value(transport, Opts, ?DefaultTransport), + S0#data{ssh_params = init_ssh_record(Role, Socket, Opts), + transport_protocol = Protocol, + transport_cb = Callback, + transport_close_tag = CloseTag + } + of + S -> + gen_statem:enter_loop(?MODULE, + [], %%[{debug,[trace,log,statistics,debug]} || Role==server], + handle_event_function, + {hello,Role}, + S) + catch + _:Error -> + gen_statem:enter_loop(?MODULE, + [], + handle_event_function, + {init_error,Error}, + S0) + end. + + +init_process_state(Role, Socket, Opts) -> + D = #data{connection_state = + C = #connection{channel_cache = ssh_channel:cache_create(), + channel_id_seed = 0, + port_bindings = [], + requests = [], + options = Opts}, + starter = proplists:get_value(user_pid, Opts), + socket = Socket, + opts = Opts + }, + case Role of + client -> + %% Start the renegotiation timers + timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), + timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), + cache_init_idle_timer(D); + server -> + D#data{connection_state = init_connection(Role, C, Opts)} + end. + + +init_connection(server, C = #connection{}, Opts) -> + Sups = proplists:get_value(supervisors, Opts), + SystemSup = proplists:get_value(system_sup, Sups), + SubSystemSup = proplists:get_value(subsystem_sup, Sups), + ConnectionSup = proplists:get_value(connection_sup, Sups), + Shell = proplists:get_value(shell, Opts), + Exec = proplists:get_value(exec, Opts), + CliSpec = proplists:get_value(ssh_cli, Opts, {ssh_cli, [Shell]}), + C#connection{cli_spec = CliSpec, + exec = Exec, + system_supervisor = SystemSup, + sub_system_supervisor = SubSystemSup, + connection_supervisor = ConnectionSup + }. + + +init_ssh_record(Role, Socket, Opts) -> + {ok, PeerAddr} = inet:peername(Socket), + KeyCb = proplists:get_value(key_cb, Opts, ssh_file), + AuthMethods = proplists:get_value(auth_methods, Opts, ?SUPPORTED_AUTH_METHODS), + S0 = #ssh{role = Role, + key_cb = KeyCb, + opts = Opts, + userauth_supported_methods = AuthMethods, + available_host_keys = supported_host_keys(Role, KeyCb, Opts), + random_length_padding = proplists:get_value(max_random_length_padding, + Opts, + (#ssh{})#ssh.random_length_padding) + }, + + {Vsn, Version} = ssh_transport:versions(Role, Opts), + case Role of + client -> + PeerName = proplists:get_value(host, Opts), + S0#ssh{c_vsn = Vsn, + c_version = Version, + io_cb = case proplists:get_value(user_interaction, Opts, true) of + true -> ssh_io; + false -> ssh_no_io + end, + userauth_quiet_mode = proplists:get_value(quiet_mode, Opts, false), + peer = {PeerName, PeerAddr} + }; + + server -> + S0#ssh{s_vsn = Vsn, + s_version = Version, + io_cb = proplists:get_value(io_cb, Opts, ssh_io), + userauth_methods = string:tokens(AuthMethods, ","), + kb_tries_left = 3, + peer = {undefined, PeerAddr} + } + end. + + + +%%==================================================================== +%% gen_statem callbacks +%%==================================================================== %%-------------------------------------------------------------------- +-type event_content() :: any(). + +-type renegotiate_flag() :: init | renegotiate. + +-type state_name() :: + {init_error,any()} + | {hello, role()} + | {kexinit, role(), renegotiate_flag()} + | {key_exchange, role(), renegotiate_flag()} + | {key_exchange_dh_gex_init, server, renegotiate_flag()} + | {key_exchange_dh_gex_reply, client, renegotiate_flag()} + | {new_keys, role()} + | {service_request, role()} + | {userauth, role()} + | {userauth_keyboard_interactive, role()} + | {connected, role()} + . + +-type handle_event_result() :: gen_statem:handle_event_result(). + +-spec handle_event(gen_statem:event_type(), + event_content(), + state_name(), + #data{} + ) -> handle_event_result(). + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +%%% ######## Error in the initialisation #### + +handle_event(_, _Event, {init_error,Error}, _) -> + case Error of + {badmatch,{error,enotconn}} -> + %% Handles the abnormal sequence: + %% SYN-> + %% <-SYNACK + %% ACK-> + %% RST-> + {stop, {shutdown,"TCP connenction to server was prematurely closed by the client"}}; + + OtherError -> + {stop, {shutdown,{init,OtherError}}} + end; -hello(socket_control, #state{socket = Socket, ssh_params = Ssh} = State) -> - VsnMsg = ssh_transport:hello_version_msg(string_version(Ssh)), - send_msg(VsnMsg, State), - case getopt(recbuf, Socket) of - {ok, Size} -> - inet:setopts(Socket, [{packet, line}, {active, once}, {recbuf, ?MAX_PROTO_VERSION}]), - {next_state, hello, State#state{recbuf = Size}}; - {error, Reason} -> - {stop, {shutdown, Reason}, State} + +%%% ######## {hello, client|server} #### +%% The very first event that is sent when the we are set as controlling process of Socket +handle_event(_, socket_control, {hello,_}, D) -> + VsnMsg = ssh_transport:hello_version_msg(string_version(D#data.ssh_params)), + ok = send_bytes(VsnMsg, D), + case inet:getopts(Socket=D#data.socket, [recbuf]) of + {ok, [{recbuf,Size}]} -> + %% Set the socket to the hello text line handling mode: + inet:setopts(Socket, [{packet, line}, + {active, once}, + % Expecting the version string which might + % be max ?MAX_PROTO_VERSION bytes: + {recbuf, ?MAX_PROTO_VERSION}, + {nodelay,true}]), + {keep_state, D#data{inet_initial_recbuf_size=Size}}; + + Other -> + {stop, {shutdown,{unexpected_getopts_return, Other}}} end; -hello({info_line, _Line},#state{role = client, socket = Socket} = State) -> - %% The server may send info lines before the version_exchange - inet:setopts(Socket, [{active, once}]), - {next_state, hello, State}; - -hello({info_line, _Line},#state{role = server, - socket = Socket, - transport_cb = Transport } = State) -> - %% as openssh - Transport:send(Socket, "Protocol mismatch."), - {stop, {shutdown,"Protocol mismatch in version exchange."}, State}; - -hello({version_exchange, Version}, #state{ssh_params = Ssh0, - socket = Socket, - recbuf = Size} = State) -> +handle_event(_, {info_line,_Line}, {hello,Role}, D) -> + case Role of + client -> + %% The server may send info lines to the client before the version_exchange + inet:setopts(D#data.socket, [{active, once}]), + keep_state_and_data; + server -> + %% But the client may NOT send them to the server. Openssh answers with cleartext, + %% and so do we + ok = send_bytes("Protocol mismatch.", D), + {stop, {shutdown,"Protocol mismatch in version exchange. Client sent info lines."}} + end; + +handle_event(_, {version_exchange,Version}, {hello,Role}, D) -> {NumVsn, StrVsn} = ssh_transport:handle_hello_version(Version), - case handle_version(NumVsn, StrVsn, Ssh0) of + case handle_version(NumVsn, StrVsn, D#data.ssh_params) of {ok, Ssh1} -> - inet:setopts(Socket, [{packet,0}, {mode,binary}, {active, once}, {recbuf, Size}]), + %% Since the hello part is finnished correctly, we set the + %% socket to the packet handling mode (including recbuf size): + inet:setopts(D#data.socket, [{packet,0}, + {mode,binary}, + {active, once}, + {recbuf, D#data.inet_initial_recbuf_size}]), {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh1), - send_msg(SshPacket, State), - {next_state, kexinit, next_packet(State#state{ssh_params = Ssh, - key_exchange_init_msg = - KeyInitMsg})}; + ok = send_bytes(SshPacket, D), + {next_state, {kexinit,Role,init}, D#data{ssh_params = Ssh, + key_exchange_init_msg = KeyInitMsg}}; not_supported -> - DisconnectMsg = - #ssh_msg_disconnect{code = - ?SSH_DISCONNECT_PROTOCOL_VERSION_NOT_SUPPORTED, - description = "Protocol version " ++ StrVsn - ++ " not supported", - language = "en"}, - handle_disconnect(DisconnectMsg, State) - end. + disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_VERSION_NOT_SUPPORTED, + description = ["Protocol version ",StrVsn," not supported"]}, + {next_state, {hello,Role}, D}) + end; -%%-------------------------------------------------------------------- --spec kexinit({#ssh_msg_kexinit{}, binary()}, #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -kexinit({#ssh_msg_kexinit{} = Kex, Payload}, - #state{ssh_params = #ssh{role = Role} = Ssh0, - key_exchange_init_msg = OwnKex} = - State) -> - Ssh1 = ssh_transport:key_init(opposite_role(Role), Ssh0, Payload), - case ssh_transport:handle_kexinit_msg(Kex, OwnKex, Ssh1) of - {ok, NextKexMsg, Ssh} when Role == client -> - send_msg(NextKexMsg, State), - {next_state, key_exchange, - next_packet(State#state{ssh_params = Ssh})}; - {ok, Ssh} when Role == server -> - {next_state, key_exchange, - next_packet(State#state{ssh_params = Ssh})} - end. + +%%% ######## {kexinit, client|server, init|renegotiate} #### -%%-------------------------------------------------------------------- --spec key_exchange(#ssh_msg_kexdh_init{} | #ssh_msg_kexdh_reply{} | - #ssh_msg_kex_dh_gex_group{} | #ssh_msg_kex_dh_gex_request{} | - #ssh_msg_kex_dh_gex_request{} | #ssh_msg_kex_dh_gex_reply{}, #state{}) - -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- +handle_event(_, {#ssh_msg_kexinit{}=Kex, Payload}, {kexinit,Role,ReNeg}, + D = #data{key_exchange_init_msg = OwnKex}) -> + Ssh1 = ssh_transport:key_init(peer_role(Role), D#data.ssh_params, Payload), + Ssh = case ssh_transport:handle_kexinit_msg(Kex, OwnKex, Ssh1) of + {ok, NextKexMsg, Ssh2} when Role==client -> + ok = send_bytes(NextKexMsg, D), + Ssh2; + {ok, Ssh2} when Role==server -> + Ssh2 + end, + {next_state, {key_exchange,Role,ReNeg}, D#data{ssh_params=Ssh}}; -key_exchange(#ssh_msg_kexdh_init{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - case ssh_transport:handle_kexdh_init(Msg, Ssh0) of - {ok, KexdhReply, Ssh1} -> - send_msg(KexdhReply, State), - {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})} - end; -key_exchange(#ssh_msg_kexdh_reply{} = Msg, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - {ok, NewKeys, Ssh} = ssh_transport:handle_kexdh_reply(Msg, Ssh0), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}; - -key_exchange(#ssh_msg_kex_dh_gex_request{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, Ssh0), - send_msg(GexGroup, State), - {next_state, key_exchange_dh_gex_init, next_packet(State#state{ssh_params = Ssh})}; - -key_exchange(#ssh_msg_kex_dh_gex_request_old{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, Ssh0), - send_msg(GexGroup, State), - {next_state, key_exchange_dh_gex_init, next_packet(State#state{ssh_params = Ssh})}; - -key_exchange(#ssh_msg_kex_dh_gex_group{} = Msg, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - {ok, KexGexInit, Ssh} = ssh_transport:handle_kex_dh_gex_group(Msg, Ssh0), - send_msg(KexGexInit, State), - {next_state, key_exchange_dh_gex_reply, next_packet(State#state{ssh_params = Ssh})}; - -key_exchange(#ssh_msg_kex_ecdh_init{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - {ok, KexEcdhReply, Ssh1} = ssh_transport:handle_kex_ecdh_init(Msg, Ssh0), - send_msg(KexEcdhReply, State), +%%% ######## {key_exchange, client|server, init|renegotiate} #### + +%%%---- diffie-hellman +handle_event(_, #ssh_msg_kexdh_init{} = Msg, {key_exchange,server,ReNeg}, D) -> + {ok, KexdhReply, Ssh1} = ssh_transport:handle_kexdh_init(Msg, D#data.ssh_params), + ok = send_bytes(KexdhReply, D), + {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1), + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}}; + +handle_event(_, #ssh_msg_kexdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) -> + {ok, NewKeys, Ssh} = ssh_transport:handle_kexdh_reply(Msg, D#data.ssh_params), + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh}}; + +%%%---- diffie-hellman group exchange +handle_event(_, #ssh_msg_kex_dh_gex_request{} = Msg, {key_exchange,server,ReNeg}, D) -> + {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + ok = send_bytes(GexGroup, D), + {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; + +handle_event(_, #ssh_msg_kex_dh_gex_request_old{} = Msg, {key_exchange,server,ReNeg}, D) -> + {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + ok = send_bytes(GexGroup, D), + {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; + +handle_event(_, #ssh_msg_kex_dh_gex_group{} = Msg, {key_exchange,client,ReNeg}, D) -> + {ok, KexGexInit, Ssh} = ssh_transport:handle_kex_dh_gex_group(Msg, D#data.ssh_params), + ok = send_bytes(KexGexInit, D), + {next_state, {key_exchange_dh_gex_reply,client,ReNeg}, D#data{ssh_params=Ssh}}; + +%%%---- elliptic curve diffie-hellman +handle_event(_, #ssh_msg_kex_ecdh_init{} = Msg, {key_exchange,server,ReNeg}, D) -> + {ok, KexEcdhReply, Ssh1} = ssh_transport:handle_kex_ecdh_init(Msg, D#data.ssh_params), + ok = send_bytes(KexEcdhReply, D), {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}; + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}}; -key_exchange(#ssh_msg_kex_ecdh_reply{} = Msg, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - {ok, NewKeys, Ssh} = ssh_transport:handle_kex_ecdh_reply(Msg, Ssh0), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}. +handle_event(_, #ssh_msg_kex_ecdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) -> + {ok, NewKeys, Ssh} = ssh_transport:handle_kex_ecdh_reply(Msg, D#data.ssh_params), + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh}}; -%%-------------------------------------------------------------------- --spec key_exchange_dh_gex_init(#ssh_msg_kex_dh_gex_init{}, #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -key_exchange_dh_gex_init(#ssh_msg_kex_dh_gex_init{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - {ok, KexGexReply, Ssh1} = ssh_transport:handle_kex_dh_gex_init(Msg, Ssh0), - send_msg(KexGexReply, State), + +%%% ######## {key_exchange_dh_gex_init, server, init|renegotiate} #### + +handle_event(_, #ssh_msg_kex_dh_gex_init{} = Msg, {key_exchange_dh_gex_init,server,ReNeg}, D) -> + {ok, KexGexReply, Ssh1} = ssh_transport:handle_kex_dh_gex_init(Msg, D#data.ssh_params), + ok = send_bytes(KexGexReply, D), {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}. + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}}; -%%-------------------------------------------------------------------- --spec key_exchange_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{}, #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -key_exchange_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{} = Msg, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - {ok, NewKeys, Ssh1} = ssh_transport:handle_kex_dh_gex_reply(Msg, Ssh0), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh1})}. -%%-------------------------------------------------------------------- --spec new_keys(#ssh_msg_newkeys{}, #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- +%%% ######## {key_exchange_dh_gex_reply, client, init|renegotiate} #### -new_keys(#ssh_msg_newkeys{} = Msg, #state{ssh_params = Ssh0} = State0) -> - {ok, Ssh} = ssh_transport:handle_new_keys(Msg, Ssh0), - after_new_keys(next_packet(State0#state{ssh_params = Ssh})). +handle_event(_, #ssh_msg_kex_dh_gex_reply{} = Msg, {key_exchange_dh_gex_reply,client,ReNeg}, D) -> + {ok, NewKeys, Ssh1} = ssh_transport:handle_kex_dh_gex_reply(Msg, D#data.ssh_params), + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh1}}; -%%-------------------------------------------------------------------- --spec service_request(#ssh_msg_service_request{} | #ssh_msg_service_accept{}, - #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -service_request(#ssh_msg_service_request{name = "ssh-userauth"} = Msg, - #state{ssh_params = #ssh{role = server, - session_id = SessionId} = Ssh0} = State) -> - {ok, {Reply, Ssh}} = ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})}; - -service_request(#ssh_msg_service_accept{name = "ssh-userauth"}, - #state{ssh_params = #ssh{role = client, - service = "ssh-userauth"} = Ssh0} = - State) -> + +%%% ######## {new_keys, client|server} #### + +%% First key exchange round: +handle_event(_, #ssh_msg_newkeys{} = Msg, {new_keys,Role,init}, D) -> + {ok, Ssh1} = ssh_transport:handle_new_keys(Msg, D#data.ssh_params), + Ssh = case Role of + client -> + {MsgReq, Ssh2} = ssh_auth:service_request_msg(Ssh1), + ok = send_bytes(MsgReq, D), + Ssh2; + server -> + Ssh1 + end, + {next_state, {service_request,Role}, D#data{ssh_params=Ssh}}; + +%% Subsequent key exchange rounds (renegotiation): +handle_event(_, #ssh_msg_newkeys{}, {new_keys,Role,renegotiate}, D) -> + {next_state, {connected,Role}, D}; + +%%% ######## {service_request, client|server} + +handle_event(_, Msg = #ssh_msg_service_request{name=ServiceName}, StateName = {service_request,server}, D) -> + case ServiceName of + "ssh-userauth" -> + Ssh0 = #ssh{session_id=SessionId} = D#data.ssh_params, + {ok, {Reply, Ssh}} = ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0), + ok = send_bytes(Reply, D), + {next_state, {userauth,server}, D#data{ssh_params = Ssh}}; + + _ -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "Unknown service"}, + StateName, D) + end; + +handle_event(_, #ssh_msg_service_accept{name = "ssh-userauth"}, {service_request,client}, + #data{ssh_params = #ssh{service="ssh-userauth"} = Ssh0} = State) -> {Msg, Ssh} = ssh_auth:init_userauth_request_msg(Ssh0), - send_msg(Msg, State), - {next_state, userauth, next_packet(State#state{auth_user = Ssh#ssh.user, ssh_params = Ssh})}. + ok = send_bytes(Msg, State), + {next_state, {userauth,client}, State#data{auth_user = Ssh#ssh.user, ssh_params = Ssh}}; -%%-------------------------------------------------------------------- --spec userauth(#ssh_msg_userauth_request{} | #ssh_msg_userauth_info_request{} | - #ssh_msg_userauth_info_response{} | #ssh_msg_userauth_success{} | - #ssh_msg_userauth_failure{} | #ssh_msg_userauth_banner{}, - #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -userauth(#ssh_msg_userauth_request{service = "ssh-connection", - method = "none"} = Msg, - #state{ssh_params = #ssh{session_id = SessionId, role = server, - service = "ssh-connection"} = Ssh0 - } = State) -> - {not_authorized, {_User, _Reason}, {Reply, Ssh}} = - ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})}; - -userauth(#ssh_msg_userauth_request{service = "ssh-connection", - method = Method} = Msg, - #state{ssh_params = #ssh{session_id = SessionId, role = server, - service = "ssh-connection", - peer = {_, Address}} = Ssh0, - opts = Opts, starter = Pid} = State) -> - case lists:member(Method, Ssh0#ssh.userauth_methods) of - true -> - case ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0) of - {authorized, User, {Reply, Ssh}} -> - send_msg(Reply, State), - Pid ! ssh_connected, - connected_fun(User, Address, Method, Opts), - {next_state, connected, - next_packet(State#state{auth_user = User, ssh_params = Ssh#ssh{authenticated = true}})}; - {not_authorized, {User, Reason}, {Reply, Ssh}} when Method == "keyboard-interactive" -> - retry_fun(User, Address, Reason, Opts), - send_msg(Reply, State), - {next_state, userauth_keyboard_interactive, next_packet(State#state{ssh_params = Ssh})}; - {not_authorized, {User, Reason}, {Reply, Ssh}} -> - retry_fun(User, Address, Reason, Opts), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + +%%% ######## {userauth, client|server} #### + +%%---- userauth request to server +handle_event(_, + Msg = #ssh_msg_userauth_request{service = ServiceName, method = Method}, + StateName = {userauth,server}, + D = #data{ssh_params=Ssh0}) -> + + case {ServiceName, Ssh0#ssh.service, Method} of + {"ssh-connection", "ssh-connection", "none"} -> + %% Probably the very first userauth_request but we deny unauthorized login + {not_authorized, _, {Reply,Ssh}} = + ssh_auth:handle_userauth_request(Msg, Ssh0#ssh.session_id, Ssh0), + ok = send_bytes(Reply, D), + {keep_state, D#data{ssh_params = Ssh}}; + + {"ssh-connection", "ssh-connection", Method} -> + %% Userauth request with a method like "password" or so + case lists:member(Method, Ssh0#ssh.userauth_methods) of + true -> + %% Yepp! we support this method + case ssh_auth:handle_userauth_request(Msg, Ssh0#ssh.session_id, Ssh0) of + {authorized, User, {Reply, Ssh}} -> + ok = send_bytes(Reply, D), + D#data.starter ! ssh_connected, + connected_fun(User, Method, D), + {next_state, {connected,server}, + D#data{auth_user = User, + ssh_params = Ssh#ssh{authenticated = true}}}; + {not_authorized, {User, Reason}, {Reply, Ssh}} when Method == "keyboard-interactive" -> + retry_fun(User, Reason, D), + ok = send_bytes(Reply, D), + {next_state, {userauth_keyboard_interactive,server}, D#data{ssh_params = Ssh}}; + {not_authorized, {User, Reason}, {Reply, Ssh}} -> + retry_fun(User, Reason, D), + ok = send_bytes(Reply, D), + {keep_state, D#data{ssh_params = Ssh}} + end; + false -> + %% No we do not support this method (=/= none) + %% At least one non-erlang client does like this. Retry as the next event + {keep_state_and_data, + [{next_event, internal, Msg#ssh_msg_userauth_request{method="none"}}] + } end; - false -> - userauth(Msg#ssh_msg_userauth_request{method="none"}, State) + + %% {"ssh-connection", Expected, Method} when Expected =/= ServiceName -> Do what? + %% {ServiceName, Expected, Method} when Expected =/= ServiceName -> Do what? + + {ServiceName, _, _} when ServiceName =/= "ssh-connection" -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "Unknown service"}, + StateName, D) end; -userauth(#ssh_msg_userauth_success{}, #state{ssh_params = #ssh{role = client} = Ssh, - starter = Pid} = State) -> - Pid ! ssh_connected, - {next_state, connected, next_packet(State#state{ssh_params = - Ssh#ssh{authenticated = true}})}; -userauth(#ssh_msg_userauth_failure{}, - #state{ssh_params = #ssh{role = client, - userauth_methods = []}} - = State) -> - Msg = #ssh_msg_disconnect{code = - ?SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE, +%%---- userauth success to client +handle_event(_, #ssh_msg_userauth_success{}, {userauth,client}, D=#data{ssh_params = Ssh}) -> + D#data.starter ! ssh_connected, + {next_state, {connected,client}, D#data{ssh_params=Ssh#ssh{authenticated = true}}}; + + +%%---- userauth failure response to client +handle_event(_, #ssh_msg_userauth_failure{}, {userauth,client}=StateName, + D = #data{ssh_params = #ssh{userauth_methods = []}}) -> + Msg = #ssh_msg_disconnect{code = ?SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE, description = "Unable to connect using the available" - " authentication methods", - language = "en"}, - handle_disconnect(Msg, State); - -%% Server tells us which authentication methods that are allowed -userauth(#ssh_msg_userauth_failure{authentications = Methodes}, - #state{ssh_params = #ssh{role = client, - userauth_methods = none} = Ssh0} = State) -> - AuthMethods = string:tokens(Methodes, ","), - Ssh1 = Ssh0#ssh{userauth_methods = AuthMethods}, + " authentication methods"}, + disconnect(Msg, StateName, D); + +handle_event(_, #ssh_msg_userauth_failure{authentications = Methods}, StateName={userauth,client}, + D = #data{ssh_params = Ssh0}) -> + %% The prefered authentication method failed try next method + Ssh1 = case Ssh0#ssh.userauth_methods of + none -> + %% Server tells us which authentication methods that are allowed + Ssh0#ssh{userauth_methods = string:tokens(Methods, ",")}; + _ -> + %% We already know... + Ssh0 + end, case ssh_auth:userauth_request_msg(Ssh1) of {disconnect, DisconnectMsg, {Msg, Ssh}} -> - send_msg(Msg, State), - handle_disconnect(DisconnectMsg, State#state{ssh_params = Ssh}); + send_bytes(Msg, D), + disconnect(DisconnectMsg, StateName, D#data{ssh_params = Ssh}); {"keyboard-interactive", {Msg, Ssh}} -> - send_msg(Msg, State), - {next_state, userauth_keyboard_interactive, next_packet(State#state{ssh_params = Ssh})}; + send_bytes(Msg, D), + {next_state, {userauth_keyboard_interactive,client}, D#data{ssh_params = Ssh}}; {_Method, {Msg, Ssh}} -> - send_msg(Msg, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + send_bytes(Msg, D), + {keep_state, D#data{ssh_params = Ssh}} end; -%% The prefered authentication method failed try next method -userauth(#ssh_msg_userauth_failure{}, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - case ssh_auth:userauth_request_msg(Ssh0) of - {disconnect, DisconnectMsg,{Msg, Ssh}} -> - send_msg(Msg, State), - handle_disconnect(DisconnectMsg, State#state{ssh_params = Ssh}); - {"keyboard-interactive", {Msg, Ssh}} -> - send_msg(Msg, State), - {next_state, userauth_keyboard_interactive, next_packet(State#state{ssh_params = Ssh})}; - {_Method, {Msg, Ssh}} -> - send_msg(Msg, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} - end; +%%---- banner to client +handle_event(_, #ssh_msg_userauth_banner{message = Msg}, {userauth,client}, D) -> + case D#data.ssh_params#ssh.userauth_quiet_mode of + false -> io:format("~s", [Msg]); + true -> ok + end, + keep_state_and_data; -userauth(#ssh_msg_userauth_banner{}, - #state{ssh_params = #ssh{userauth_quiet_mode = true, - role = client}} = State) -> - {next_state, userauth, next_packet(State)}; -userauth(#ssh_msg_userauth_banner{message = Msg}, - #state{ssh_params = - #ssh{userauth_quiet_mode = false, role = client}} = State) -> - io:format("~s", [Msg]), - {next_state, userauth, next_packet(State)}. - - - -userauth_keyboard_interactive(#ssh_msg_userauth_info_request{} = Msg, - #state{ssh_params = #ssh{role = client, - io_cb = IoCb} = Ssh0} = State) -> - {ok, {Reply, Ssh}} = ssh_auth:handle_userauth_info_request(Msg, IoCb, Ssh0), - send_msg(Reply, State), - {next_state, userauth_keyboard_interactive_info_response, next_packet(State#state{ssh_params = Ssh})}; - -userauth_keyboard_interactive(#ssh_msg_userauth_info_response{} = Msg, - #state{ssh_params = #ssh{role = server, - peer = {_, Address}} = Ssh0, - opts = Opts, starter = Pid} = State) -> - case ssh_auth:handle_userauth_info_response(Msg, Ssh0) of + +%%% ######## {userauth_keyboard_interactive, client|server} + +handle_event(_, #ssh_msg_userauth_info_request{} = Msg, {userauth_keyboard_interactive, client}, + #data{ssh_params = Ssh0} = D) -> + {ok, {Reply, Ssh}} = ssh_auth:handle_userauth_info_request(Msg, Ssh0#ssh.io_cb, Ssh0), + send_bytes(Reply, D), + {next_state, {userauth_keyboard_interactive_info_response,client}, D#data{ssh_params = Ssh}}; + +handle_event(_, #ssh_msg_userauth_info_response{} = Msg, {userauth_keyboard_interactive, server}, D) -> + case ssh_auth:handle_userauth_info_response(Msg, D#data.ssh_params) of {authorized, User, {Reply, Ssh}} -> - send_msg(Reply, State), - Pid ! ssh_connected, - connected_fun(User, Address, "keyboard-interactive", Opts), - {next_state, connected, - next_packet(State#state{auth_user = User, ssh_params = Ssh#ssh{authenticated = true}})}; + send_bytes(Reply, D), + D#data.starter ! ssh_connected, + connected_fun(User, "keyboard-interactive", D), + {next_state, {connected,server}, D#data{auth_user = User, + ssh_params = Ssh#ssh{authenticated = true}}}; {not_authorized, {User, Reason}, {Reply, Ssh}} -> - retry_fun(User, Address, Reason, Opts), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + retry_fun(User, Reason, D), + send_bytes(Reply, D), + {next_state, {userauth,server}, D#data{ssh_params = Ssh}} end; -userauth_keyboard_interactive(Msg = #ssh_msg_userauth_failure{}, - #state{ssh_params = Ssh0 = - #ssh{role = client, - userauth_preference = Prefs0}} - = State) -> - Prefs = [{Method,M,F,A} || {Method,M,F,A} <- Prefs0, + +handle_event(_, Msg = #ssh_msg_userauth_failure{}, {userauth_keyboard_interactive, client}, + #data{ssh_params = Ssh0} = D0) -> + Prefs = [{Method,M,F,A} || {Method,M,F,A} <- Ssh0#ssh.userauth_preference, Method =/= "keyboard-interactive"], - userauth(Msg, State#state{ssh_params = Ssh0#ssh{userauth_preference=Prefs}}). + D = D0#data{ssh_params = Ssh0#ssh{userauth_preference=Prefs}}, + {next_state, {userauth,client}, D, [{next_event, internal, Msg}]}; +handle_event(_, Msg=#ssh_msg_userauth_failure{}, {userauth_keyboard_interactive_info_response, client}, D) -> + {next_state, {userauth,client}, D, [{next_event, internal, Msg}]}; +handle_event(_, Msg=#ssh_msg_userauth_success{}, {userauth_keyboard_interactive_info_response, client}, D) -> + {next_state, {userauth,client}, D, [{next_event, internal, Msg}]}; -userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_failure{}, - #state{ssh_params = #ssh{role = client}} = State) -> - userauth(Msg, State); -userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_success{}, - #state{ssh_params = #ssh{role = client}} = State) -> - userauth(Msg, State); -userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_info_request{}, - #state{ssh_params = #ssh{role = client}} = State) -> - userauth_keyboard_interactive(Msg, State). +handle_event(_, Msg=#ssh_msg_userauth_info_request{}, {userauth_keyboard_interactive_info_response, client}, D) -> + {next_state, {userauth_keyboard_interactive,client}, D, [{next_event, internal, Msg}]}; -%%-------------------------------------------------------------------- --spec connected({#ssh_msg_kexinit{}, binary()}, %%| %% #ssh_msg_kexdh_init{}, - #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -connected({#ssh_msg_kexinit{}, _Payload} = Event, #state{ssh_params = Ssh0} = State0) -> - {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh0), - State = State0#state{ssh_params = Ssh, - key_exchange_init_msg = KeyInitMsg, - renegotiate = true}, - send_msg(SshPacket, State), - kexinit(Event, State). -%%-------------------------------------------------------------------- --spec handle_event(#ssh_msg_disconnect{} | #ssh_msg_ignore{} | #ssh_msg_debug{} | - #ssh_msg_unimplemented{} | {adjust_window, integer(), integer()} | - {reply_request, success | failure, integer()} | renegotiate | - data_size | {request, pid(), integer(), integer(), iolist()} | - {request, integer(), integer(), iolist()}, state_name(), - #state{}) -> gen_fsm_state_return(). +%%% ######## {connected, client|server} #### -%%-------------------------------------------------------------------- -handle_event(#ssh_msg_disconnect{description = Desc} = DisconnectMsg, _StateName, #state{} = State) -> - handle_disconnect(peer, DisconnectMsg, State), - {stop, {shutdown, Desc}, State}; - -handle_event(#ssh_msg_ignore{}, StateName, State) -> - {next_state, StateName, next_packet(State)}; - -handle_event(#ssh_msg_debug{always_display = Display, message = DbgMsg, language=Lang}, - StateName, #state{opts = Opts} = State) -> - F = proplists:get_value(ssh_msg_debug_fun, Opts, - fun(_ConnRef, _AlwaysDisplay, _Msg, _Language) -> ok end - ), - catch F(self(), Display, DbgMsg, Lang), - {next_state, StateName, next_packet(State)}; - -handle_event(#ssh_msg_unimplemented{}, StateName, State) -> - {next_state, StateName, next_packet(State)}; - -handle_event(renegotiate, connected, #state{ssh_params = Ssh0} - = State) -> - {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh0), - send_msg(SshPacket, State), - timer:apply_after(?REKEY_TIMOUT, gen_fsm, send_all_state_event, [self(), renegotiate]), - {next_state, kexinit, - next_packet(State#state{ssh_params = Ssh, - key_exchange_init_msg = KeyInitMsg, - renegotiate = true})}; - -handle_event(renegotiate, StateName, State) -> +handle_event(_, {#ssh_msg_kexinit{},_} = Event, {connected,Role}, D0) -> + {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(D0#data.ssh_params), + D = D0#data{ssh_params = Ssh, + key_exchange_init_msg = KeyInitMsg}, + send_bytes(SshPacket, D), + {next_state, {kexinit,Role,renegotiate}, D, [{next_event, internal, Event}]}; + +handle_event(_, #ssh_msg_disconnect{description=Desc} = Msg, StateName, D0) -> + {disconnect, _, {{replies,Replies}, _}} = + ssh_connection:handle_msg(Msg, D0#data.connection_state, role(StateName)), + {Actions,D} = send_replies(Replies, D0), + disconnect_fun(Desc, D), + {stop_and_reply, {shutdown,Desc}, Actions, D}; + +handle_event(_, #ssh_msg_ignore{}, _, _) -> + keep_state_and_data; + +handle_event(_, #ssh_msg_unimplemented{}, _, _) -> + keep_state_and_data; + +handle_event(_, #ssh_msg_debug{} = Msg, _, D) -> + debug_fun(Msg, D), + keep_state_and_data; + +handle_event(internal, Msg=#ssh_msg_global_request{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_request_success{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_request_failure{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_open{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_open_confirmation{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_open_failure{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_window_adjust{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_data{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_extended_data{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_eof{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_close{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_request{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_success{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_failure{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + + +handle_event(cast, renegotiate, {connected,Role}, D) -> + {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(D#data.ssh_params), + send_bytes(SshPacket, D), + timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), + {next_state, {kexinit,Role,renegotiate}, D#data{ssh_params = Ssh, + key_exchange_init_msg = KeyInitMsg}}; + +handle_event(cast, renegotiate, _, _) -> %% Already in key-exchange so safe to ignore - {next_state, StateName, State}; + timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), % FIXME: not here in original + keep_state_and_data; + %% Rekey due to sent data limit reached? -handle_event(data_size, connected, #state{ssh_params = Ssh0} = State) -> - {ok, [{send_oct,Sent0}]} = inet:getstat(State#state.socket, [send_oct]), - Sent = Sent0 - State#state.last_size_rekey, - MaxSent = proplists:get_value(rekey_limit, State#state.opts, 1024000000), - timer:apply_after(?REKEY_DATA_TIMOUT, gen_fsm, send_all_state_event, [self(), data_size]), +handle_event(cast, data_size, {connected,Role}, D) -> + {ok, [{send_oct,Sent0}]} = inet:getstat(D#data.socket, [send_oct]), + Sent = Sent0 - D#data.last_size_rekey, + MaxSent = proplists:get_value(rekey_limit, D#data.opts, 1024000000), + timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), case Sent >= MaxSent of true -> - {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh0), - send_msg(SshPacket, State), - {next_state, kexinit, - next_packet(State#state{ssh_params = Ssh, - key_exchange_init_msg = KeyInitMsg, - renegotiate = true, - last_size_rekey = Sent0})}; + {KeyInitMsg, SshPacket, Ssh} = + ssh_transport:key_exchange_init_msg(D#data.ssh_params), + send_bytes(SshPacket, D), + {next_state, {kexinit,Role,renegotiate}, D#data{ssh_params = Ssh, + key_exchange_init_msg = KeyInitMsg, + last_size_rekey = Sent0}}; _ -> - {next_state, connected, next_packet(State)} + keep_state_and_data end; -handle_event(data_size, StateName, State) -> + +handle_event(cast, data_size, _, _) -> %% Already in key-exchange so safe to ignore - {next_state, StateName, State}; - -handle_event(Event, StateName, State) when StateName /= connected -> - Events = [{event, Event} | State#state.event_queue], - {next_state, StateName, State#state{event_queue = Events}}; - -handle_event({adjust_window, ChannelId, Bytes}, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - State = - case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{recv_window_size = WinSize, - recv_window_pending = Pending, - recv_packet_size = PktSize} = Channel - when (WinSize-Bytes) >= 2*PktSize -> - %% The peer can send at least two more *full* packet, no hurry. - ssh_channel:cache_update(Cache, - Channel#channel{recv_window_pending = Pending + Bytes}), - State0; - - #channel{recv_window_size = WinSize, - recv_window_pending = Pending, - remote_id = Id} = Channel -> - %% Now we have to update the window - we can't receive so many more pkts - ssh_channel:cache_update(Cache, - Channel#channel{recv_window_size = - WinSize + Bytes + Pending, - recv_window_pending = 0}), - Msg = ssh_connection:channel_adjust_window_msg(Id, Bytes + Pending), - send_replies([{connection_reply, Msg}], State0); + timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), % FIXME: not here in original + keep_state_and_data; + + + +handle_event(cast, _, StateName, _) when StateName /= {connected,server}, + StateName /= {connected,client} -> + {keep_state_and_data, [postpone]}; + + +handle_event(cast, {adjust_window,ChannelId,Bytes}, {connected,_}, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of + #channel{recv_window_size = WinSize, + recv_window_pending = Pending, + recv_packet_size = PktSize} = Channel + when (WinSize-Bytes) >= 2*PktSize -> + %% The peer can send at least two more *full* packet, no hurry. + ssh_channel:cache_update(cache(D), + Channel#channel{recv_window_pending = Pending + Bytes}), + keep_state_and_data; + + #channel{recv_window_size = WinSize, + recv_window_pending = Pending, + remote_id = Id} = Channel -> + %% Now we have to update the window - we can't receive so many more pkts + ssh_channel:cache_update(cache(D), + Channel#channel{recv_window_size = + WinSize + Bytes + Pending, + recv_window_pending = 0}), + Msg = ssh_connection:channel_adjust_window_msg(Id, Bytes + Pending), + {keep_state, send_msg(Msg,D)}; - undefined -> - State0 - end, - {next_state, StateName, next_packet(State)}; - -handle_event({reply_request, success, ChannelId}, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - State = case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{remote_id = RemoteId} -> - Msg = ssh_connection:channel_success_msg(RemoteId), - send_replies([{connection_reply, Msg}], State0); - undefined -> - State0 - end, - {next_state, StateName, State}; - -handle_event({request, ChannelPid, ChannelId, Type, Data}, StateName, State0) -> - {{replies, Replies}, State1} = handle_request(ChannelPid, ChannelId, - Type, Data, - false, none, State0), - State = send_replies(Replies, State1), - {next_state, StateName, next_packet(State)}; - -handle_event({request, ChannelId, Type, Data}, StateName, State0) -> - {{replies, Replies}, State1} = handle_request(ChannelId, Type, Data, - false, none, State0), - State = send_replies(Replies, State1), - {next_state, StateName, next_packet(State)}; - -handle_event({unknown, Data}, StateName, State) -> + undefined -> + keep_state_and_data + end; + +handle_event(cast, {reply_request,success,ChannelId}, {connected,_}, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of + #channel{remote_id = RemoteId} -> + Msg = ssh_connection:channel_success_msg(RemoteId), + {keep_state, send_msg(Msg,D)}; + + undefined -> + keep_state_and_data + end; + +handle_event(cast, {request,ChannelPid, ChannelId, Type, Data}, {connected,_}, D) -> + {keep_state, handle_request(ChannelPid, ChannelId, Type, Data, false, none, D)}; + +handle_event(cast, {request,ChannelId,Type,Data}, {connected,_}, D) -> + {keep_state, handle_request(ChannelId, Type, Data, false, none, D)}; + +handle_event(cast, {unknown,Data}, {connected,_}, D) -> Msg = #ssh_msg_unimplemented{sequence = Data}, - send_msg(Msg, State), - {next_state, StateName, next_packet(State)}. + {keep_state, send_msg(Msg,D)}; -%%-------------------------------------------------------------------- --spec handle_sync_event({request, pid(), channel_id(), integer(), binary(), timeout()} | - {request, channel_id(), integer(), binary(), timeout()} | - {global_request, pid(), integer(), boolean(), binary()} | {eof, integer()} | - {open, pid(), integer(), channel_id(), integer(), binary(), _} | - {send_window, channel_id()} | {recv_window, channel_id()} | - {connection_info, [client_version | server_version | peer | - sockname]} | {channel_info, channel_id(), [recv_window | - send_window]} | - {close, channel_id()} | stop, term(), state_name(), #state{}) - -> gen_fsm_sync_return(). -%%-------------------------------------------------------------------- -handle_sync_event(get_print_info, _From, StateName, State) -> +%%% Previously handle_sync_event began here +handle_event({call,From}, get_print_info, StateName, D) -> Reply = try - {inet:sockname(State#state.socket), - inet:peername(State#state.socket) + {inet:sockname(D#data.socket), + inet:peername(D#data.socket) } of - {{ok,Local}, {ok,Remote}} -> {{Local,Remote},io_lib:format("statename=~p",[StateName])}; - _ -> {{"-",0},"-"} + {{ok,Local}, {ok,Remote}} -> + {{Local,Remote},io_lib:format("statename=~p",[StateName])}; + _ -> + {{"-",0},"-"} catch - _:_ -> {{"?",0},"?"} + _:_ -> + {{"?",0},"?"} end, - {reply, Reply, StateName, State}; + {keep_state_and_data, [{reply,From,Reply}]}; -handle_sync_event({connection_info, Options}, _From, StateName, State) -> - Info = ssh_info(Options, State, []), - {reply, Info, StateName, State}; +handle_event({call,From}, {connection_info, Options}, _, D) -> + Info = ssh_info(Options, D, []), + {keep_state_and_data, [{reply,From,Info}]}; -handle_sync_event({channel_info, ChannelId, Options}, _From, StateName, - #state{connection_state = #connection{channel_cache = Cache}} = State) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{} = Channel -> +handle_event({call,From}, {channel_info,ChannelId,Options}, _, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of + #channel{} = Channel -> Info = ssh_channel_info(Options, Channel, []), - {reply, Info, StateName, State}; + {keep_state_and_data, [{reply,From,Info}]}; undefined -> - {reply, [], StateName, State} + {keep_state_and_data, [{reply,From,[]}]} end; -handle_sync_event({info, ChannelPid}, _From, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State) -> + +handle_event({call,From}, {info, all}, _, D) -> + Result = ssh_channel:cache_foldl(fun(Channel, Acc) -> + [Channel | Acc] + end, + [], cache(D)), + {keep_state_and_data, [{reply, From, {ok,Result}}]}; + +handle_event({call,From}, {info, ChannelPid}, _, D) -> Result = ssh_channel:cache_foldl( - fun(Channel, Acc) when ChannelPid == all; - Channel#channel.user == ChannelPid -> + fun(Channel, Acc) when Channel#channel.user == ChannelPid -> [Channel | Acc]; (_, Acc) -> Acc - end, [], Cache), - {reply, {ok, Result}, StateName, State}; + end, [], cache(D)), + {keep_state_and_data, [{reply, From, {ok,Result}}]}; -handle_sync_event(stop, _, _StateName, #state{connection_state = Connection0, - role = Role} = State0) -> +handle_event({call,From}, stop, StateName, D0) -> {disconnect, _Reason, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "User closed down connection", - language = "en"}, Connection0, Role), - State = send_replies(Replies, State0), - {stop, normal, ok, State#state{connection_state = Connection}}; - - -handle_sync_event(Event, From, StateName, State) when StateName /= connected -> - Events = [{sync, Event, From} | State#state.event_queue], - {next_state, StateName, State#state{event_queue = Events}}; - -handle_sync_event({request, ChannelPid, ChannelId, Type, Data, Timeout}, From, StateName, State0) -> - {{replies, Replies}, State1} = handle_request(ChannelPid, - ChannelId, Type, Data, - true, From, State0), - %% Note reply to channel will happen later when - %% reply is recived from peer on the socket - State = send_replies(Replies, State1), - start_timeout(ChannelId, From, Timeout), - handle_idle_timeout(State), - {next_state, StateName, next_packet(State)}; - -handle_sync_event({request, ChannelId, Type, Data, Timeout}, From, StateName, State0) -> - {{replies, Replies}, State1} = handle_request(ChannelId, Type, Data, - true, From, State0), - %% Note reply to channel will happen later when - %% reply is recived from peer on the socket - State = send_replies(Replies, State1), - start_timeout(ChannelId, From, Timeout), - handle_idle_timeout(State), - {next_state, StateName, next_packet(State)}; - -handle_sync_event({global_request, Pid, _, _, _} = Request, From, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - State1 = handle_global_request(Request, State0), - Channel = ssh_channel:cache_find(Pid, Cache), - State = add_request(true, Channel#channel.local_id, From, State1), - {next_state, StateName, next_packet(State)}; - -handle_sync_event({data, ChannelId, Type, Data, Timeout}, From, StateName, - #state{connection_state = #connection{channel_cache = _Cache} - = Connection0} = State0) -> - - case ssh_connection:channel_data(ChannelId, Type, Data, Connection0, From) of - {{replies, Replies}, Connection} -> - State = send_replies(Replies, State0#state{connection_state = Connection}), - start_timeout(ChannelId, From, Timeout), - {next_state, StateName, next_packet(State)}; - {noreply, Connection} -> - start_timeout(ChannelId, From, Timeout), - {next_state, StateName, next_packet(State0#state{connection_state = Connection})} - end; - -handle_sync_event({eof, ChannelId}, _From, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of + description = "User closed down connection"}, + D0#data.connection_state, + role(StateName)), + {Repls,D} = send_replies(Replies, D0), + {stop_and_reply, normal, [{reply,From,ok}|Repls], D#data{connection_state=Connection}}; + +handle_event({call,_}, _, StateName, _) when StateName /= {connected,server}, + StateName /= {connected,client} -> + {keep_state_and_data, [postpone]}; + +handle_event({call,From}, {request, ChannelPid, ChannelId, Type, Data, Timeout}, {connected,_}, D0) -> + D = handle_request(ChannelPid, ChannelId, Type, Data, true, From, D0), + %% Note reply to channel will happen later when reply is recived from peer on the socket + start_channel_request_timer(ChannelId, From, Timeout), + {keep_state, cache_request_idle_timer_check(D)}; + +handle_event({call,From}, {request, ChannelId, Type, Data, Timeout}, {connected,_}, D0) -> + D = handle_request(ChannelId, Type, Data, true, From, D0), + %% Note reply to channel will happen later when reply is recived from peer on the socket + start_channel_request_timer(ChannelId, From, Timeout), + {keep_state, cache_request_idle_timer_check(D)}; + +handle_event({call,From}, {data, ChannelId, Type, Data, Timeout}, {connected,_}, D0) -> + {{replies, Replies}, Connection} = + ssh_connection:channel_data(ChannelId, Type, Data, D0#data.connection_state, From), + {Repls,D} = send_replies(Replies, D0#data{connection_state = Connection}), + start_channel_request_timer(ChannelId, From, Timeout), % FIXME: No message exchange so why? + {keep_state, D, Repls}; + +handle_event({call,From}, {eof, ChannelId}, {connected,_}, D0) -> + case ssh_channel:cache_lookup(cache(D0), ChannelId) of #channel{remote_id = Id, sent_close = false} -> - State = send_replies([{connection_reply, - ssh_connection:channel_eof_msg(Id)}], State0), - {reply, ok, StateName, next_packet(State)}; + D = send_msg(ssh_connection:channel_eof_msg(Id), D0), + {keep_state, D, [{reply,From,ok}]}; _ -> - {reply, {error,closed}, StateName, State0} + {keep_state, D0, [{reply,From,{error,closed}}]} end; -handle_sync_event({open, ChannelPid, Type, InitialWindowSize, MaxPacketSize, Data, Timeout}, - From, StateName, #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> +handle_event({call,From}, + {open, ChannelPid, Type, InitialWindowSize, MaxPacketSize, Data, Timeout}, + {connected,_}, + D0) -> erlang:monitor(process, ChannelPid), - {ChannelId, State1} = new_channel_id(State0), - Msg = ssh_connection:channel_open_msg(Type, ChannelId, - InitialWindowSize, - MaxPacketSize, Data), - State2 = send_replies([{connection_reply, Msg}], State1), - Channel = #channel{type = Type, - sys = "none", - user = ChannelPid, - local_id = ChannelId, - recv_window_size = InitialWindowSize, - recv_packet_size = MaxPacketSize, - send_buf = queue:new() - }, - ssh_channel:cache_update(Cache, Channel), - State = add_request(true, ChannelId, From, State2), - start_timeout(ChannelId, From, Timeout), - {next_state, StateName, next_packet(remove_timer_ref(State))}; - -handle_sync_event({send_window, ChannelId}, _From, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State) -> - Reply = case ssh_channel:cache_lookup(Cache, ChannelId) of + {ChannelId, D1} = new_channel_id(D0), + D2 = send_msg(ssh_connection:channel_open_msg(Type, ChannelId, + InitialWindowSize, + MaxPacketSize, Data), + D1), + ssh_channel:cache_update(cache(D2), + #channel{type = Type, + sys = "none", + user = ChannelPid, + local_id = ChannelId, + recv_window_size = InitialWindowSize, + recv_packet_size = MaxPacketSize, + send_buf = queue:new() + }), + D = add_request(true, ChannelId, From, D2), + start_channel_request_timer(ChannelId, From, Timeout), + {keep_state, cache_cancel_idle_timer(D)}; + +handle_event({call,From}, {send_window, ChannelId}, {connected,_}, D) -> + Reply = case ssh_channel:cache_lookup(cache(D), ChannelId) of #channel{send_window_size = WinSize, send_packet_size = Packsize} -> {ok, {WinSize, Packsize}}; undefined -> {error, einval} end, - {reply, Reply, StateName, next_packet(State)}; - -handle_sync_event({recv_window, ChannelId}, _From, StateName, - #state{connection_state = #connection{channel_cache = Cache}} - = State) -> + {keep_state_and_data, [{reply,From,Reply}]}; - Reply = case ssh_channel:cache_lookup(Cache, ChannelId) of +handle_event({call,From}, {recv_window, ChannelId}, {connected,_}, D) -> + Reply = case ssh_channel:cache_lookup(cache(D), ChannelId) of #channel{recv_window_size = WinSize, recv_packet_size = Packsize} -> {ok, {WinSize, Packsize}}; undefined -> {error, einval} end, - {reply, Reply, StateName, next_packet(State)}; - -handle_sync_event({close, ChannelId}, _, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - State = - case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{remote_id = Id} = Channel -> - State1 = send_replies([{connection_reply, - ssh_connection:channel_close_msg(Id)}], State0), - ssh_channel:cache_update(Cache, Channel#channel{sent_close = true}), - handle_idle_timeout(State1), - State1; - undefined -> - State0 - end, - {reply, ok, StateName, next_packet(State)}. + {keep_state_and_data, [{reply,From,Reply}]}; + +handle_event({call,From}, {close, ChannelId}, {connected,_}, D0) -> + case ssh_channel:cache_lookup(cache(D0), ChannelId) of + #channel{remote_id = Id} = Channel -> + D1 = send_msg(ssh_connection:channel_close_msg(Id), D0), + ssh_channel:cache_update(cache(D1), Channel#channel{sent_close = true}), + {keep_state, cache_request_idle_timer_check(D1), [{reply,From,ok}]}; + undefined -> + {keep_state_and_data, [{reply,From,ok}]} + end; -%%-------------------------------------------------------------------- --spec handle_info({atom(), port(), binary()} | {atom(), port()} | - term (), state_name(), #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -handle_info({Protocol, Socket, "SSH-" ++ _ = Version}, hello, - #state{socket = Socket, - transport_protocol = Protocol} = State ) -> - event({version_exchange, Version}, hello, State); - -handle_info({Protocol, Socket, Info}, hello, - #state{socket = Socket, - transport_protocol = Protocol} = State) -> - event({info_line, Info}, hello, State); - -handle_info({Protocol, Socket, Data}, StateName, - #state{socket = Socket, - transport_protocol = Protocol, - ssh_params = Ssh0, - decoded_data_buffer = DecData0, - encoded_data_buffer = EncData0, - undecoded_packet_length = RemainingSshPacketLen0} = State0) -> - Encoded = <<EncData0/binary, Data/binary>>, - try ssh_transport:handle_packet_part(DecData0, Encoded, RemainingSshPacketLen0, Ssh0) +%%===== Reception of encrypted bytes, decryption and framing +handle_event(info, {Proto, Sock, Info}, {hello,_}, #data{socket = Sock, + transport_protocol = Proto}) -> + case Info of + "SSH-" ++ _ -> + {keep_state_and_data, [{next_event, internal, {version_exchange,Info}}]}; + _ -> + {keep_state_and_data, [{next_event, internal, {info_line,Info}}]} + end; + +handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, + transport_protocol = Proto}) -> + try ssh_transport:handle_packet_part( + D0#data.decrypted_data_buffer, + <<(D0#data.encrypted_data_buffer)/binary, NewData/binary>>, + D0#data.undecrypted_packet_length, + D0#data.ssh_params) of - {get_more, DecBytes, EncDataRest, RemainingSshPacketLen, Ssh1} -> - {next_state, StateName, - next_packet(State0#state{encoded_data_buffer = EncDataRest, - decoded_data_buffer = DecBytes, - undecoded_packet_length = RemainingSshPacketLen, - ssh_params = Ssh1})}; - {decoded, MsgBytes, EncDataRest, Ssh1} -> - generate_event(MsgBytes, StateName, - State0#state{ssh_params = Ssh1, - %% Important to be set for - %% next_packet -%%% FIXME: the following three seem to always be set in generate_event! - decoded_data_buffer = <<>>, - undecoded_packet_length = undefined, - encoded_data_buffer = EncDataRest}, - EncDataRest); + {packet_decrypted, DecryptedBytes, EncryptedDataRest, Ssh1} -> + D = D0#data{ssh_params = + Ssh1#ssh{recv_sequence = ssh_transport:next_seqnum(Ssh1#ssh.recv_sequence)}, + decrypted_data_buffer = <<>>, + undecrypted_packet_length = undefined, + encrypted_data_buffer = EncryptedDataRest}, + try + ssh_message:decode(set_kex_overload_prefix(DecryptedBytes,D)) + of + Msg = #ssh_msg_kexinit{} -> + {keep_state, D, [{next_event, internal, {Msg,DecryptedBytes}}, + {next_event, internal, prepare_next_packet} + ]}; + Msg -> + {keep_state, D, [{next_event, internal, Msg}, + {next_event, internal, prepare_next_packet} + ]} + catch + _C:_E -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Encountered unexpected input"}, + StateName, D) + end; + + {get_more, DecryptedBytes, EncryptedDataRest, RemainingSshPacketLen, Ssh1} -> + %% Here we know that there are not enough bytes in + %% EncryptedDataRest to use. We must wait for more. + inet:setopts(Sock, [{active, once}]), + {keep_state, D0#data{encrypted_data_buffer = EncryptedDataRest, + decrypted_data_buffer = DecryptedBytes, + undecrypted_packet_length = RemainingSshPacketLen, + ssh_params = Ssh1}}; + {bad_mac, Ssh1} -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad mac", - language = ""}, - handle_disconnect(DisconnectMsg, State0#state{ssh_params=Ssh1}); + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Bad mac"}, + StateName, D0#data{ssh_params=Ssh1}); {error, {exceeds_max_size,PacketLen}} -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad packet length " - ++ integer_to_list(PacketLen), - language = ""}, - handle_disconnect(DisconnectMsg, State0) + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Bad packet length " + ++ integer_to_list(PacketLen)}, + StateName, D0) catch - _:_ -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad packet", - language = ""}, - handle_disconnect(DisconnectMsg, State0) + _C:_E -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Bad packet"}, + StateName, D0) end; - -handle_info({CloseTag, _Socket}, _StateName, - #state{transport_close_tag = CloseTag, - ssh_params = #ssh{role = _Role, opts = _Opts}} = State) -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "Connection closed", - language = "en"}, - handle_disconnect(DisconnectMsg, State); - -handle_info({timeout, {_, From} = Request}, Statename, - #state{connection_state = #connection{requests = Requests} = Connection} = State) -> + + +%%%==== +handle_event(internal, prepare_next_packet, _, D) -> + Enough = erlang:max(8, D#data.ssh_params#ssh.decrypt_block_size), + case size(D#data.encrypted_data_buffer) of + Sz when Sz >= Enough -> + self() ! {D#data.transport_protocol, D#data.socket, <<>>}; + _ -> + inet:setopts(D#data.socket, [{active, once}]) + end, + keep_state_and_data; + +handle_event(info, {CloseTag,Socket}, StateName, + D = #data{socket = Socket, + transport_close_tag = CloseTag}) -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Connection closed"}, + StateName, D); + +handle_event(info, {timeout, {_, From} = Request}, _, + #data{connection_state = #connection{requests = Requests} = C0} = D) -> case lists:member(Request, Requests) of true -> - gen_fsm:reply(From, {error, timeout}), - {next_state, Statename, - State#state{connection_state = - Connection#connection{requests = - lists:delete(Request, Requests)}}}; + %% A channel request is not answered in time. Answer {error,timeout} + %% to the caller + C = C0#connection{requests = lists:delete(Request, Requests)}, + {keep_state, D#data{connection_state=C}, [{reply,From,{error,timeout}}]}; false -> - {next_state, Statename, State} + %% The request is answered - just ignore the timeout + keep_state_and_data end; %%% Handle that ssh channels user process goes down -handle_info({'DOWN', _Ref, process, ChannelPid, _Reason}, Statename, State0) -> - {{replies, Replies}, State1} = handle_channel_down(ChannelPid, State0), - State = send_replies(Replies, State1), - {next_state, Statename, next_packet(State)}; +handle_event(info, {'DOWN', _Ref, process, ChannelPid, _Reason}, _, D0) -> + {{replies, Replies}, D1} = handle_channel_down(ChannelPid, D0), + {Repls, D} = send_replies(Replies, D1), + {keep_state, D, Repls}; %%% So that terminate will be run when supervisor is shutdown -handle_info({'EXIT', _Sup, Reason}, _StateName, State) -> - {stop, {shutdown, Reason}, State}; +handle_event(info, {'EXIT', _Sup, Reason}, _, _) -> + {stop, {shutdown, Reason}}; -handle_info({check_cache, _ , _}, - StateName, #state{connection_state = - #connection{channel_cache = Cache}} = State) -> - {next_state, StateName, check_cache(State, Cache)}; +handle_event(info, check_cache, _, D) -> + {keep_state, cache_check_set_idle_timer(D)}; -handle_info(UnexpectedMessage, StateName, #state{opts = Opts, - ssh_params = SshParams} = State) -> - case unexpected_fun(UnexpectedMessage, Opts, SshParams) of +handle_event(info, UnexpectedMessage, StateName, D = #data{ssh_params = Ssh}) -> + case unexpected_fun(UnexpectedMessage, D) of report -> Msg = lists:flatten( io_lib:format( "Unexpected message '~p' received in state '~p'\n" "Role: ~p\n" "Peer: ~p\n" - "Local Address: ~p\n", [UnexpectedMessage, StateName, - SshParams#ssh.role, SshParams#ssh.peer, - proplists:get_value(address, SshParams#ssh.opts)])), - error_logger:info_report(Msg); + "Local Address: ~p\n", [UnexpectedMessage, + StateName, + Ssh#ssh.role, + Ssh#ssh.peer, + proplists:get_value(address, Ssh#ssh.opts)])), + error_logger:info_report(Msg), + keep_state_and_data; skip -> - ok; + keep_state_and_data; Other -> Msg = lists:flatten( @@ -1103,200 +1269,181 @@ handle_info(UnexpectedMessage, StateName, #state{opts = Opts, "Message: ~p\n" "Role: ~p\n" "Peer: ~p\n" - "Local Address: ~p\n", [Other, UnexpectedMessage, - SshParams#ssh.role, - element(2,SshParams#ssh.peer), - proplists:get_value(address, SshParams#ssh.opts)] + "Local Address: ~p\n", [Other, + UnexpectedMessage, + Ssh#ssh.role, + element(2,Ssh#ssh.peer), + proplists:get_value(address, Ssh#ssh.opts)] )), + error_logger:error_report(Msg), + keep_state_and_data + end; + +handle_event(internal, {disconnect,Msg,_Reason}, StateName, D) -> + disconnect(Msg, StateName, D); + +handle_event(Type, Ev, StateName, D) -> + Descr = + case catch atom_to_list(element(1,Ev)) of + "ssh_msg_" ++_ when Type==internal -> + "Message in wrong state"; + _ -> + "Internal error" + end, + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = Descr}, + StateName, D). - error_logger:error_report(Msg) - end, - {next_state, StateName, State}. %%-------------------------------------------------------------------- --spec terminate(Reason::term(), state_name(), #state{}) -> _. -%%-------------------------------------------------------------------- -terminate(normal, _, #state{transport_cb = Transport, - connection_state = Connection, - socket = Socket}) -> - terminate_subsystem(Connection), - (catch Transport:close(Socket)), - ok; +-spec terminate(any(), + state_name(), + #data{} + ) -> finalize_termination_result() . + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +terminate(normal, StateName, State) -> + finalize_termination(StateName, State); terminate({shutdown,{init,Reason}}, StateName, State) -> error_logger:info_report(io_lib:format("Erlang ssh in connection handler init: ~p~n",[Reason])), - terminate(normal, StateName, State); - -%% Terminated by supervisor -terminate(shutdown, StateName, #state{ssh_params = Ssh0} = State) -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "Application shutdown", - language = "en"}, - {SshPacket, Ssh} = ssh_transport:ssh_packet(DisconnectMsg, Ssh0), - send_msg(SshPacket, State), - terminate(normal, StateName, State#state{ssh_params = Ssh}); - -terminate({shutdown, #ssh_msg_disconnect{} = Msg}, StateName, - #state{ssh_params = Ssh0} = State) -> - {SshPacket, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), - send_msg(SshPacket, State), - terminate(normal, StateName, State#state{ssh_params = Ssh}); - -terminate({shutdown, _}, StateName, State) -> - terminate(normal, StateName, State); - -terminate(Reason, StateName, #state{ssh_params = Ssh0, starter = _Pid, - connection_state = Connection} = State) -> - terminate_subsystem(Connection), + finalize_termination(StateName, State); + +terminate(shutdown, StateName, State0) -> + %% Terminated by supervisor + State = send_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Application shutdown"}, + State0), +timer:sleep(400), %% FIXME!!! gen_tcp:shutdown instead + finalize_termination(StateName, State); + +%% terminate({shutdown,Msg}, StateName, State0) when is_record(Msg,ssh_msg_disconnect)-> +%% State = send_msg(Msg, State0), +%% timer:sleep(400), %% FIXME!!! gen_tcp:shutdown instead +%% finalize_termination(StateName, Msg, State); + +terminate({shutdown,_R}, StateName, State) -> + finalize_termination(StateName, State); + +terminate(Reason, StateName, State0) -> + %% Others, e.g undef, {badmatch,_} log_error(Reason), - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "Internal error", - language = "en"}, - {SshPacket, Ssh} = ssh_transport:ssh_packet(DisconnectMsg, Ssh0), - send_msg(SshPacket, State), - terminate(normal, StateName, State#state{ssh_params = Ssh}). - - -terminate_subsystem(#connection{system_supervisor = SysSup, - sub_system_supervisor = SubSysSup}) when is_pid(SubSysSup) -> - ssh_system_sup:stop_subsystem(SysSup, SubSysSup); -terminate_subsystem(_) -> - ok. - -format_status(normal, [_, State]) -> - [{data, [{"StateData", State}]}]; -format_status(terminate, [_, State]) -> - SshParams0 = (State#state.ssh_params), - SshParams = SshParams0#ssh{c_keyinit = "***", - s_keyinit = "***", - send_mac_key = "***", - send_mac_size = "***", - recv_mac_key = "***", - recv_mac_size = "***", - encrypt_keys = "***", - encrypt_ctx = "***", - decrypt_keys = "***", - decrypt_ctx = "***", - compress_ctx = "***", - decompress_ctx = "***", - shared_secret = "***", - exchanged_hash = "***", - session_id = "***", - keyex_key = "***", - keyex_info = "***", - available_host_keys = "***"}, - [{data, [{"StateData", State#state{decoded_data_buffer = "***", - encoded_data_buffer = "***", - key_exchange_init_msg = "***", - opts = "***", - recbuf = "***", - ssh_params = SshParams - }}]}]. + State = send_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Internal error"}, + State0), + finalize_termination(StateName, State). %%-------------------------------------------------------------------- --spec code_change(OldVsn::term(), state_name(), Oldstate::term(), Extra::term()) -> - {ok, state_name(), #state{}}. + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +format_status(normal, [_, _StateName, D]) -> + [{data, [{"State", D}]}]; +format_status(terminate, [_, _StateName, D]) -> + DataPropList0 = fmt_stat_rec(record_info(fields, data), D, + [decrypted_data_buffer, + encrypted_data_buffer, + key_exchange_init_msg, + user_passwords, + opts, + inet_initial_recbuf_size]), + SshPropList = fmt_stat_rec(record_info(fields, ssh), D#data.ssh_params, + [c_keyinit, + s_keyinit, + send_mac_key, + send_mac_size, + recv_mac_key, + recv_mac_size, + encrypt_keys, + encrypt_ctx, + decrypt_keys, + decrypt_ctx, + compress_ctx, + decompress_ctx, + shared_secret, + exchanged_hash, + session_id, + keyex_key, + keyex_info, + available_host_keys]), + DataPropList = lists:keyreplace(ssh_params, 1, DataPropList0, + {ssh_params,SshPropList}), + [{data, [{"State", DataPropList}]}]. + + +fmt_stat_rec(FieldNames, Rec, Exclude) -> + Values = tl(tuple_to_list(Rec)), + [P || {K,_} = P <- lists:zip(FieldNames, Values), + not lists:member(K, Exclude)]. + %%-------------------------------------------------------------------- +-spec code_change(term() | {down,term()}, + state_name(), + #data{}, + term() + ) -> {gen_statem:callback_mode(), state_name(), #data{}}. + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + code_change(_OldVsn, StateName, State, _Extra) -> - {ok, StateName, State}. + {handle_event_function, StateName, State}. + + +%%==================================================================== +%% Internal functions +%%==================================================================== %%-------------------------------------------------------------------- -%%% Internal functions -%%-------------------------------------------------------------------- -init_role(#state{role = client, opts = Opts} = State0) -> - Pid = proplists:get_value(user_pid, Opts), - TimerRef = get_idle_time(Opts), - timer:apply_after(?REKEY_TIMOUT, gen_fsm, send_all_state_event, [self(), renegotiate]), - timer:apply_after(?REKEY_DATA_TIMOUT, gen_fsm, send_all_state_event, - [self(), data_size]), - State0#state{starter = Pid, - idle_timer_ref = TimerRef}; -init_role(#state{role = server, opts = Opts, connection_state = Connection} = State) -> - Sups = proplists:get_value(supervisors, Opts), - Pid = proplists:get_value(user_pid, Opts), - SystemSup = proplists:get_value(system_sup, Sups), - SubSystemSup = proplists:get_value(subsystem_sup, Sups), +%% Starting + +start_the_connection_child(UserPid, Role, Socket, Options) -> + Sups = proplists:get_value(supervisors, Options), ConnectionSup = proplists:get_value(connection_sup, Sups), - Shell = proplists:get_value(shell, Opts), - Exec = proplists:get_value(exec, Opts), - CliSpec = proplists:get_value(ssh_cli, Opts, {ssh_cli, [Shell]}), - State#state{starter = Pid, connection_state = Connection#connection{ - cli_spec = CliSpec, - exec = Exec, - system_supervisor = SystemSup, - sub_system_supervisor = SubSystemSup, - connection_supervisor = ConnectionSup - }}. - -get_idle_time(SshOptions) -> - case proplists:get_value(idle_time, SshOptions) of - infinity -> - infinity; - _IdleTime -> %% We dont want to set the timeout on first connect - undefined - end. + Opts = [{supervisors, Sups}, {user_pid, UserPid} | proplists:get_value(ssh_opts, Options, [])], + {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Opts]), + ok = socket_control(Socket, Pid, Options), + Pid. -init_ssh(client = Role, Vsn, Version, Options, Socket) -> - IOCb = case proplists:get_value(user_interaction, Options, true) of - true -> - ssh_io; - false -> - ssh_no_io - end, +%%-------------------------------------------------------------------- +%% Stopping +-type finalize_termination_result() :: ok . + +finalize_termination(_StateName, #data{transport_cb = Transport, + connection_state = Connection, + socket = Socket}) -> + case Connection of + #connection{system_supervisor = SysSup, + sub_system_supervisor = SubSysSup} when is_pid(SubSysSup) -> + ssh_system_sup:stop_subsystem(SysSup, SubSysSup); + _ -> + do_nothing + end, + (catch Transport:close(Socket)), + ok. - AuthMethods = proplists:get_value(auth_methods, Options, - ?SUPPORTED_AUTH_METHODS), - {ok, PeerAddr} = inet:peername(Socket), - - PeerName = proplists:get_value(host, Options), - KeyCb = proplists:get_value(key_cb, Options, ssh_file), - - #ssh{role = Role, - c_vsn = Vsn, - c_version = Version, - key_cb = KeyCb, - io_cb = IOCb, - userauth_quiet_mode = proplists:get_value(quiet_mode, Options, false), - opts = Options, - userauth_supported_methods = AuthMethods, - peer = {PeerName, PeerAddr}, - available_host_keys = supported_host_keys(Role, KeyCb, Options), - random_length_padding = proplists:get_value(max_random_length_padding, - Options, - (#ssh{})#ssh.random_length_padding) - }; - -init_ssh(server = Role, Vsn, Version, Options, Socket) -> - AuthMethods = proplists:get_value(auth_methods, Options, - ?SUPPORTED_AUTH_METHODS), - AuthMethodsAsList = string:tokens(AuthMethods, ","), - {ok, PeerAddr} = inet:peername(Socket), - KeyCb = proplists:get_value(key_cb, Options, ssh_file), - - #ssh{role = Role, - s_vsn = Vsn, - s_version = Version, - key_cb = KeyCb, - io_cb = proplists:get_value(io_cb, Options, ssh_io), - opts = Options, - userauth_supported_methods = AuthMethods, - userauth_methods = AuthMethodsAsList, - kb_tries_left = 3, - peer = {undefined, PeerAddr}, - available_host_keys = supported_host_keys(Role, KeyCb, Options), - random_length_padding = proplists:get_value(max_random_length_padding, - Options, - (#ssh{})#ssh.random_length_padding) - }. +%%-------------------------------------------------------------------- +%% "Invert" the Role +peer_role(client) -> server; +peer_role(server) -> client. + +%%-------------------------------------------------------------------- +%% StateName to Role +role({_,Role}) -> Role; +role({_,Role,_}) -> Role. +%%-------------------------------------------------------------------- +%% Check the StateName to see if we are in the renegotiation phase +renegotiation({_,_,ReNeg}) -> ReNeg == renegotiation; +renegotiation(_) -> false. + +%%-------------------------------------------------------------------- supported_host_keys(client, _, Options) -> try - case proplists:get_value(public_key, + case proplists:get_value(public_key, proplists:get_value(preferred_algorithms,Options,[]) ) of - undefined -> + undefined -> ssh_transport:default_algorithms(public_key); L -> L -- (L--ssh_transport:default_algorithms(public_key)) @@ -1311,7 +1458,7 @@ supported_host_keys(client, _, Options) -> {stop, {shutdown, Reason}} end; supported_host_keys(server, KeyCb, Options) -> - [atom_to_list(A) || A <- proplists:get_value(public_key, + [atom_to_list(A) || A <- proplists:get_value(public_key, proplists:get_value(preferred_algorithms,Options,[]), ssh_transport:default_algorithms(public_key) ), @@ -1322,10 +1469,16 @@ supported_host_keys(server, KeyCb, Options) -> available_host_key(KeyCb, Alg, Opts) -> element(1, catch KeyCb:host_key(Alg, Opts)) == ok. -send_msg(Msg, #state{socket = Socket, transport_cb = Transport}) -> - Transport:send(Socket, Msg). -handle_version({2, 0} = NumVsn, StrVsn, Ssh0) -> +send_msg(Msg, State=#data{ssh_params=Ssh0}) when is_tuple(Msg) -> + {Bytes, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), + send_bytes(Bytes, State), + State#data{ssh_params=Ssh}. + +send_bytes(Bytes, #data{socket = Socket, transport_cb = Transport}) -> + Transport:send(Socket, Bytes). + +handle_version({2, 0} = NumVsn, StrVsn, Ssh0) -> Ssh = counterpart_versions(NumVsn, StrVsn, Ssh0), {ok, Ssh}; handle_version(_,_,_) -> @@ -1336,419 +1489,185 @@ string_version(#ssh{role = client, c_version = Vsn}) -> string_version(#ssh{role = server, s_version = Vsn}) -> Vsn. -send_event(FsmPid, Event) -> - gen_fsm:send_event(FsmPid, Event). -send_all_state_event(FsmPid, Event) -> - gen_fsm:send_all_state_event(FsmPid, Event). +cast(FsmPid, Event) -> + gen_statem:cast(FsmPid, Event). -sync_send_all_state_event(FsmPid, Event) -> - sync_send_all_state_event(FsmPid, Event, infinity). +call(FsmPid, Event) -> + call(FsmPid, Event, infinity). -sync_send_all_state_event(FsmPid, Event, Timeout) -> - try gen_fsm:sync_send_all_state_event(FsmPid, Event, Timeout) of - {closed, _Channel} -> +call(FsmPid, Event, Timeout) -> + try gen_statem:call(FsmPid, Event, Timeout) of + {closed, _R} -> + {error, closed}; + {killed, _R} -> {error, closed}; Result -> Result catch - exit:{noproc, _} -> + exit:{noproc, _R} -> {error, closed}; - exit:{normal, _} -> + exit:{normal, _R} -> {error, closed}; - exit:{{shutdown, _},_} -> + exit:{{shutdown, _R},_} -> {error, closed} end. -%% simulate send_all_state_event(self(), Event) -event(#ssh_msg_disconnect{} = Event, StateName, State) -> - handle_event(Event, StateName, State); -event(#ssh_msg_ignore{} = Event, StateName, State) -> - handle_event(Event, StateName, State); -event(#ssh_msg_debug{} = Event, StateName, State) -> - handle_event(Event, StateName, State); -event(#ssh_msg_unimplemented{} = Event, StateName, State) -> - handle_event(Event, StateName, State); -%% simulate send_event(self(), Event) -event(Event, StateName, State) -> - try - ?MODULE:StateName(Event, State) + +handle_connection_msg(Msg, StateName, State0 = + #data{starter = User, + connection_state = Connection0, + event_queue = Qev0}) -> + Renegotiation = renegotiation(StateName), + Role = role(StateName), + try ssh_connection:handle_msg(Msg, Connection0, Role) of + {{replies, Replies}, Connection} -> + case StateName of + {connected,_} -> + {Repls, State} = send_replies(Replies, + State0#data{connection_state=Connection}), + {keep_state, State, Repls}; + _ -> + {ConnReplies, Replies} = + lists:splitwith(fun not_connected_filter/1, Replies), + {Repls, State} = send_replies(Replies, + State0#data{event_queue = Qev0 ++ ConnReplies}), + {keep_state, State, Repls} + end; + + {noreply, Connection} -> + {keep_state, State0#data{connection_state = Connection}}; + + {disconnect, Reason0, {{replies, Replies}, Connection}} -> + {Repls,State} = send_replies(Replies, State0#data{connection_state = Connection}), + case {Reason0,Role} of + {{_, Reason}, client} when ((StateName =/= {connected,client}) and (not Renegotiation)) -> + User ! {self(), not_connected, Reason}; + _ -> + ok + end, + {stop, {shutdown,normal}, Repls, State#data{connection_state = Connection}} + catch - throw:#ssh_msg_disconnect{} = DisconnectMsg -> - handle_disconnect(DisconnectMsg, State); - throw:{ErrorToDisplay, #ssh_msg_disconnect{} = DisconnectMsg} -> - handle_disconnect(DisconnectMsg, State, ErrorToDisplay); - _C:_Error -> - handle_disconnect(#ssh_msg_disconnect{code = error_code(StateName), - description = "Invalid state", - language = "en"}, State) + _:Error -> + {disconnect, _Reason, {{replies, Replies}, Connection}} = + ssh_connection:handle_msg( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Internal error"}, + Connection0, Role), + {Repls,State} = send_replies(Replies, State0#data{connection_state = Connection}), + {stop, {shutdown,Error}, Repls, State#data{connection_state = Connection}} end. -error_code(key_exchange) -> - ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED; -error_code(new_keys) -> - ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED; -error_code(_) -> - ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE. - -generate_event(<<?BYTE(Byte), _/binary>> = Msg, StateName, - #state{ - role = Role, - starter = User, - renegotiate = Renegotiation, - connection_state = Connection0} = State0, EncData) - when Byte == ?SSH_MSG_GLOBAL_REQUEST; - Byte == ?SSH_MSG_REQUEST_SUCCESS; - Byte == ?SSH_MSG_REQUEST_FAILURE; - Byte == ?SSH_MSG_CHANNEL_OPEN; - Byte == ?SSH_MSG_CHANNEL_OPEN_CONFIRMATION; - Byte == ?SSH_MSG_CHANNEL_OPEN_FAILURE; - Byte == ?SSH_MSG_CHANNEL_WINDOW_ADJUST; - Byte == ?SSH_MSG_CHANNEL_DATA; - Byte == ?SSH_MSG_CHANNEL_EXTENDED_DATA; - Byte == ?SSH_MSG_CHANNEL_EOF; - Byte == ?SSH_MSG_CHANNEL_CLOSE; - Byte == ?SSH_MSG_CHANNEL_REQUEST; - Byte == ?SSH_MSG_CHANNEL_SUCCESS; - Byte == ?SSH_MSG_CHANNEL_FAILURE -> - try - ssh_message:decode(Msg) - of - ConnectionMsg -> - State1 = generate_event_new_state(State0, EncData), - try ssh_connection:handle_msg(ConnectionMsg, Connection0, Role) of - {{replies, Replies0}, Connection} -> - if StateName == connected -> - Replies = Replies0, - State2 = State1; - true -> - {ConnReplies, Replies} = - lists:splitwith(fun not_connected_filter/1, Replies0), - Q = State1#state.event_queue ++ ConnReplies, - State2 = State1#state{ event_queue = Q } - end, - State = send_replies(Replies, State2#state{connection_state = Connection}), - {next_state, StateName, next_packet(State)}; - {noreply, Connection} -> - {next_state, StateName, next_packet(State1#state{connection_state = Connection})}; - {disconnect, {_, Reason}, {{replies, Replies}, Connection}} when - Role == client andalso ((StateName =/= connected) and (not Renegotiation)) -> - State = send_replies(Replies, State1#state{connection_state = Connection}), - User ! {self(), not_connected, Reason}, - {stop, {shutdown, normal}, - next_packet(State#state{connection_state = Connection})}; - {disconnect, _Reason, {{replies, Replies}, Connection}} -> - State = send_replies(Replies, State1#state{connection_state = Connection}), - {stop, {shutdown, normal}, State#state{connection_state = Connection}} - catch - _:Error -> - {disconnect, _Reason, {{replies, Replies}, Connection}} = - ssh_connection:handle_msg( - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "Internal error", - language = "en"}, Connection0, Role), - State = send_replies(Replies, State1#state{connection_state = Connection}), - {stop, {shutdown, Error}, State#state{connection_state = Connection}} - end - catch - _:_ -> - handle_disconnect( - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad packet received", - language = ""}, State0) - end; -generate_event(Msg, StateName, State0, EncData) -> - try - Event = ssh_message:decode(set_prefix_if_trouble(Msg,State0)), - State = generate_event_new_state(State0, EncData), - case Event of - #ssh_msg_kexinit{} -> - %% We need payload for verification later. - event({Event, Msg}, StateName, State); - _ -> - event(Event, StateName, State) - end - catch - _C:_E -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Encountered unexpected input", - language = "en"}, - handle_disconnect(DisconnectMsg, State0) - end. - - -set_prefix_if_trouble(Msg = <<?BYTE(Op),_/binary>>, #state{ssh_params=SshParams}) +set_kex_overload_prefix(Msg = <<?BYTE(Op),_/binary>>, #data{ssh_params=SshParams}) when Op == 30; Op == 31 -> case catch atom_to_list(kex(SshParams)) of - "ecdh-sha2-" ++ _ -> + "ecdh-sha2-" ++ _ -> <<"ecdh",Msg/binary>>; "diffie-hellman-group-exchange-" ++ _ -> <<"dh_gex",Msg/binary>>; "diffie-hellman-group" ++ _ -> <<"dh",Msg/binary>>; - _ -> + _ -> Msg end; -set_prefix_if_trouble(Msg, _) -> +set_kex_overload_prefix(Msg, _) -> Msg. kex(#ssh{algorithms=#alg{kex=Kex}}) -> Kex; kex(_) -> undefined. +cache(#data{connection_state=C}) -> C#connection.channel_cache. + -handle_request(ChannelPid, ChannelId, Type, Data, WantReply, From, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of +%%%---------------------------------------------------------------- +handle_request(ChannelPid, ChannelId, Type, Data, WantReply, From, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of #channel{remote_id = Id} = Channel -> - update_sys(Cache, Channel, Type, ChannelPid), - Msg = ssh_connection:channel_request_msg(Id, Type, - WantReply, Data), - Replies = [{connection_reply, Msg}], - State = add_request(WantReply, ChannelId, From, State0), - {{replies, Replies}, State}; + update_sys(cache(D), Channel, Type, ChannelPid), + send_msg(ssh_connection:channel_request_msg(Id, Type, WantReply, Data), + add_request(WantReply, ChannelId, From, D)); undefined -> - {{replies, []}, State0} + D end. -handle_request(ChannelId, Type, Data, WantReply, From, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{remote_id = Id} -> - Msg = ssh_connection:channel_request_msg(Id, Type, - WantReply, Data), - Replies = [{connection_reply, Msg}], - State = add_request(WantReply, ChannelId, From, State0), - {{replies, Replies}, State}; +handle_request(ChannelId, Type, Data, WantReply, From, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of + #channel{remote_id = Id} -> + send_msg(ssh_connection:channel_request_msg(Id, Type, WantReply, Data), + add_request(WantReply, ChannelId, From, D)); undefined -> - {{replies, []}, State0} - end. - -handle_global_request({global_request, ChannelPid, - "tcpip-forward" = Type, WantReply, - <<?UINT32(IPLen), - IP:IPLen/binary, ?UINT32(Port)>> = Data}, - #state{connection_state = - #connection{channel_cache = Cache} - = Connection0} = State) -> - ssh_channel:cache_update(Cache, #channel{user = ChannelPid, - type = "forwarded-tcpip", - sys = none}), - Connection = ssh_connection:bind(IP, Port, ChannelPid, Connection0), - Msg = ssh_connection:global_request_msg(Type, WantReply, Data), - send_replies([{connection_reply, Msg}], State#state{connection_state = Connection}); - -handle_global_request({global_request, _Pid, "cancel-tcpip-forward" = Type, - WantReply, <<?UINT32(IPLen), - IP:IPLen/binary, ?UINT32(Port)>> = Data}, - #state{connection_state = Connection0} = State) -> - Connection = ssh_connection:unbind(IP, Port, Connection0), - Msg = ssh_connection:global_request_msg(Type, WantReply, Data), - send_replies([{connection_reply, Msg}], State#state{connection_state = Connection}); - -handle_global_request({global_request, _, "cancel-tcpip-forward" = Type, - WantReply, Data}, State) -> - Msg = ssh_connection:global_request_msg(Type, WantReply, Data), - send_replies([{connection_reply, Msg}], State). - -handle_idle_timeout(#state{opts = Opts}) -> - case proplists:get_value(idle_time, Opts, infinity) of - infinity -> - ok; - IdleTime -> - erlang:send_after(IdleTime, self(), {check_cache, [], []}) + D end. -handle_channel_down(ChannelPid, #state{connection_state = - #connection{channel_cache = Cache}} = - State) -> +%%%---------------------------------------------------------------- +handle_channel_down(ChannelPid, D) -> ssh_channel:cache_foldl( fun(Channel, Acc) when Channel#channel.user == ChannelPid -> - ssh_channel:cache_delete(Cache, + ssh_channel:cache_delete(cache(D), Channel#channel.local_id), Acc; (_,Acc) -> Acc - end, [], Cache), - {{replies, []}, check_cache(State, Cache)}. + end, [], cache(D)), + {{replies, []}, cache_check_set_idle_timer(D)}. + update_sys(Cache, Channel, Type, ChannelPid) -> ssh_channel:cache_update(Cache, Channel#channel{sys = Type, user = ChannelPid}). + add_request(false, _ChannelId, _From, State) -> State; -add_request(true, ChannelId, From, #state{connection_state = - #connection{requests = Requests0} = - Connection} = State) -> +add_request(true, ChannelId, From, #data{connection_state = + #connection{requests = Requests0} = + Connection} = State) -> Requests = [{ChannelId, From} | Requests0], - State#state{connection_state = Connection#connection{requests = Requests}}. + State#data{connection_state = Connection#connection{requests = Requests}}. -new_channel_id(#state{connection_state = #connection{channel_id_seed = Id} = - Connection} +new_channel_id(#data{connection_state = #connection{channel_id_seed = Id} = + Connection} = State) -> - {Id, State#state{connection_state = - Connection#connection{channel_id_seed = Id + 1}}}. - -generate_event_new_state(#state{ssh_params = - #ssh{recv_sequence = SeqNum0} - = Ssh} = State, EncData) -> - SeqNum = ssh_transport:next_seqnum(SeqNum0), - State#state{ssh_params = Ssh#ssh{recv_sequence = SeqNum}, - decoded_data_buffer = <<>>, - encoded_data_buffer = EncData, - undecoded_packet_length = undefined}. - -next_packet(#state{decoded_data_buffer = <<>>, - encoded_data_buffer = Buff, - ssh_params = #ssh{decrypt_block_size = BlockSize}, - socket = Socket, - transport_protocol = Protocol} = State) when Buff =/= <<>> -> - case size(Buff) >= erlang:max(8, BlockSize) of - true -> - %% Enough data from the next packet has been received to - %% decode the length indicator, fake a socket-recive - %% message so that the data will be processed - self() ! {Protocol, Socket, <<>>}; - false -> - inet:setopts(Socket, [{active, once}]) - end, - State; - -next_packet(#state{socket = Socket} = State) -> - inet:setopts(Socket, [{active, once}]), - State. - -after_new_keys(#state{renegotiate = true} = State) -> - State1 = State#state{renegotiate = false, event_queue = []}, - lists:foldr(fun after_new_keys_events/2, {next_state, connected, State1}, State#state.event_queue); -after_new_keys(#state{renegotiate = false, - ssh_params = #ssh{role = client} = Ssh0} = State) -> - {Msg, Ssh} = ssh_auth:service_request_msg(Ssh0), - send_msg(Msg, State), - {next_state, service_request, State#state{ssh_params = Ssh}}; -after_new_keys(#state{renegotiate = false, - ssh_params = #ssh{role = server}} = State) -> - {next_state, service_request, State}. - -after_new_keys_events({sync, _Event, From}, {stop, _Reason, _StateData}=Terminator) -> - gen_fsm:reply(From, {error, closed}), - Terminator; -after_new_keys_events(_, {stop, _Reason, _StateData}=Terminator) -> - Terminator; -after_new_keys_events({sync, Event, From}, {next_state, StateName, StateData}) -> - case handle_sync_event(Event, From, StateName, StateData) of - {reply, Reply, NextStateName, NewStateData} -> - gen_fsm:reply(From, Reply), - {next_state, NextStateName, NewStateData}; - {next_state, NextStateName, NewStateData}-> - {next_state, NextStateName, NewStateData}; - {stop, Reason, Reply, NewStateData} -> - gen_fsm:reply(From, Reply), - {stop, Reason, NewStateData} - end; -after_new_keys_events({event, Event}, {next_state, StateName, StateData}) -> - case handle_event(Event, StateName, StateData) of - {next_state, NextStateName, NewStateData}-> - {next_state, NextStateName, NewStateData}; - {stop, Reason, NewStateData} -> - {stop, Reason, NewStateData} - end; -after_new_keys_events({connection_reply, _Data} = Reply, {StateName, State}) -> - NewState = send_replies([Reply], State), - {next_state, StateName, NewState}. - - -handle_disconnect(DisconnectMsg, State) -> - handle_disconnect(own, DisconnectMsg, State). - -handle_disconnect(#ssh_msg_disconnect{} = DisconnectMsg, State, Error) -> - handle_disconnect(own, DisconnectMsg, State, Error); -handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, role = Role} = State0) -> - {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), - State = send_replies(disconnect_replies(Type, Msg, Replies), State0), - disconnect_fun(Desc, State#state.opts), - {stop, {shutdown, Desc}, State#state{connection_state = Connection}}. - -handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, - role = Role} = State0, ErrorMsg) -> - {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), - State = send_replies(disconnect_replies(Type, Msg, Replies), State0), - disconnect_fun(Desc, State#state.opts), - {stop, {shutdown, {Desc, ErrorMsg}}, State#state{connection_state = Connection}}. - -disconnect_replies(own, Msg, Replies) -> - [{connection_reply, Msg} | Replies]; -disconnect_replies(peer, _, Replies) -> - Replies. - + {Id, State#data{connection_state = + Connection#connection{channel_id_seed = Id + 1}}}. + +%%%---------------------------------------------------------------- +%% %%% This server/client has decided to disconnect via the state machine: +disconnect(Msg=#ssh_msg_disconnect{description=Description}, _StateName, State0) -> + State = send_msg(Msg, State0), + disconnect_fun(Description, State), +timer:sleep(400), + {stop, {shutdown,Description}, State}. + +%%%---------------------------------------------------------------- counterpart_versions(NumVsn, StrVsn, #ssh{role = server} = Ssh) -> Ssh#ssh{c_vsn = NumVsn , c_version = StrVsn}; counterpart_versions(NumVsn, StrVsn, #ssh{role = client} = Ssh) -> Ssh#ssh{s_vsn = NumVsn , s_version = StrVsn}. -opposite_role(client) -> - server; -opposite_role(server) -> - client. -connected_fun(User, PeerAddr, Method, Opts) -> - case proplists:get_value(connectfun, Opts) of - undefined -> - ok; - Fun -> - catch Fun(User, PeerAddr, Method) - end. - -retry_fun(_, _, undefined, _) -> - ok; - -retry_fun(User, PeerAddr, {error, Reason}, Opts) -> - case proplists:get_value(failfun, Opts) of - undefined -> - ok; - Fun -> - do_retry_fun(Fun, User, PeerAddr, Reason) - end; - -retry_fun(User, PeerAddr, Reason, Opts) -> - case proplists:get_value(infofun, Opts) of - undefined -> - ok; - Fun -> - do_retry_fun(Fun, User, PeerAddr, Reason) - end. - -do_retry_fun(Fun, User, PeerAddr, Reason) -> - case erlang:fun_info(Fun, arity) of - {arity, 2} -> %% Backwards compatible - catch Fun(User, Reason); - {arity, 3} -> - catch Fun(User, PeerAddr, Reason) - end. - ssh_info([], _State, Acc) -> Acc; -ssh_info([client_version | Rest], #state{ssh_params = #ssh{c_vsn = IntVsn, +ssh_info([client_version | Rest], #data{ssh_params = #ssh{c_vsn = IntVsn, c_version = StringVsn}} = State, Acc) -> ssh_info(Rest, State, [{client_version, {IntVsn, StringVsn}} | Acc]); -ssh_info([server_version | Rest], #state{ssh_params =#ssh{s_vsn = IntVsn, +ssh_info([server_version | Rest], #data{ssh_params =#ssh{s_vsn = IntVsn, s_version = StringVsn}} = State, Acc) -> ssh_info(Rest, State, [{server_version, {IntVsn, StringVsn}} | Acc]); -ssh_info([peer | Rest], #state{ssh_params = #ssh{peer = Peer}} = State, Acc) -> +ssh_info([peer | Rest], #data{ssh_params = #ssh{peer = Peer}} = State, Acc) -> ssh_info(Rest, State, [{peer, Peer} | Acc]); -ssh_info([sockname | Rest], #state{socket = Socket} = State, Acc) -> +ssh_info([sockname | Rest], #data{socket = Socket} = State, Acc) -> {ok, SockName} = inet:sockname(Socket), ssh_info(Rest, State, [{sockname, SockName}|Acc]); -ssh_info([user | Rest], #state{auth_user = User} = State, Acc) -> +ssh_info([user | Rest], #data{auth_user = User} = State, Acc) -> ssh_info(Rest, State, [{user, User}|Acc]); ssh_info([ _ | Rest], State, Acc) -> ssh_info(Rest, State, Acc). + ssh_channel_info([], _, Acc) -> Acc; @@ -1765,43 +1684,49 @@ ssh_channel_info([send_window | Rest], #channel{send_window_size = WinSize, ssh_channel_info([ _ | Rest], Channel, Acc) -> ssh_channel_info(Rest, Channel, Acc). + log_error(Reason) -> - Report = io_lib:format("Erlang ssh connection handler failed with reason: " - "~p ~n, Stacktrace: ~p ~n", - [Reason, erlang:get_stacktrace()]), - error_logger:error_report(Report), - "Internal error". - -not_connected_filter({connection_reply, _Data}) -> - true; -not_connected_filter(_) -> - false. - -send_replies([], State) -> - State; -send_replies([{connection_reply, Data} | Rest], #state{ssh_params = Ssh0} = State) -> - {Packet, Ssh} = ssh_transport:ssh_packet(Data, Ssh0), - send_msg(Packet, State), - send_replies(Rest, State#state{ssh_params = Ssh}); -send_replies([Msg | Rest], State) -> - catch send_reply(Msg), - send_replies(Rest, State). - -send_reply({channel_data, Pid, Data}) -> - Pid ! {ssh_cm, self(), Data}; -send_reply({channel_requst_reply, From, Data}) -> - gen_fsm:reply(From, Data); -send_reply({flow_control, Cache, Channel, From, Msg}) -> + Report = io_lib:format("Erlang ssh connection handler failed with reason:~n" + " ~p~n" + "Stacktrace:~n" + " ~p~n", + [Reason, erlang:get_stacktrace()]), + error_logger:error_report(Report). + + +%%%---------------------------------------------------------------- +not_connected_filter({connection_reply, _Data}) -> true; +not_connected_filter(_) -> false. + +%%%---------------------------------------------------------------- +send_replies(Repls, State) -> + lists:foldl(fun get_repl/2, + {[],State}, + Repls). + +get_repl({connection_reply,Msg}, {CallRepls,S}) -> + {CallRepls, send_msg(Msg,S)}; +get_repl({channel_data,undefined,_Data}, Acc) -> + Acc; +get_repl({channel_data,Pid,Data}, Acc) -> + Pid ! {ssh_cm, self(), Data}, + Acc; +get_repl({channel_request_reply,From,Data}, {CallRepls,S}) -> + {[{reply,From,Data}|CallRepls], S}; +get_repl({flow_control,Cache,Channel,From,Msg}, {CallRepls,S}) -> ssh_channel:cache_update(Cache, Channel#channel{flow_control = undefined}), - gen_fsm:reply(From, Msg); -send_reply({flow_control, From, Msg}) -> - gen_fsm:reply(From, Msg). + {[{reply,From,Msg}|CallRepls], S}; +get_repl({flow_control,From,Msg}, {CallRepls,S}) -> + {[{reply,From,Msg}|CallRepls], S}; +get_repl(noreply, Acc) -> + Acc; +get_repl(X, Acc) -> + exit({get_repl,X,Acc}). -disconnect_fun({disconnect,Msg}, Opts) -> - disconnect_fun(Msg, Opts); -disconnect_fun(_, undefined) -> - ok; -disconnect_fun(Reason, Opts) -> +%%%---------------------------------------------------------------- +disconnect_fun({disconnect,Msg}, D) -> + disconnect_fun(Msg, D); +disconnect_fun(Reason, #data{opts=Opts}) -> case proplists:get_value(disconnectfun, Opts) of undefined -> ok; @@ -1809,50 +1734,137 @@ disconnect_fun(Reason, Opts) -> catch Fun(Reason) end. -unexpected_fun(UnexpectedMessage, Opts, #ssh{peer={_,Peer}}) -> +unexpected_fun(UnexpectedMessage, #data{opts = Opts, + ssh_params = #ssh{peer = {_,Peer} } + } ) -> case proplists:get_value(unexpectedfun, Opts) of undefined -> report; Fun -> - catch Fun(UnexpectedMessage, Peer) + catch Fun(UnexpectedMessage, Peer) end. -check_cache(#state{opts = Opts} = State, Cache) -> - %% Check the number of entries in Cache - case proplists:get_value(size, ets:info(Cache)) of - 0 -> - case proplists:get_value(idle_time, Opts, infinity) of - infinity -> - State; - Time -> - handle_idle_timer(Time, State) - end; +debug_fun(#ssh_msg_debug{always_display = Display, + message = DbgMsg, + language = Lang}, + #data{opts = Opts}) -> + case proplists:get_value(ssh_msg_debug_fun, Opts) of + undefined -> + ok; + Fun -> + catch Fun(self(), Display, DbgMsg, Lang) + end. + + +connected_fun(User, Method, #data{ssh_params = #ssh{peer = {_,Peer}}, + opts = Opts}) -> + case proplists:get_value(connectfun, Opts) of + undefined -> + ok; + Fun -> + catch Fun(User, Peer, Method) + end. + +retry_fun(_, undefined, _) -> + ok; +retry_fun(User, Reason, #data{ssh_params = #ssh{opts = Opts, + peer = {_,Peer} + }}) -> + {Tag,Info} = + case Reason of + {error, Error} -> + {failfun, Error}; + _ -> + {infofun, Reason} + end, + Fun = proplists:get_value(Tag, Opts, fun(_,_)-> ok end), + try erlang:fun_info(Fun, arity) + of + {arity, 2} -> %% Backwards compatible + catch Fun(User, Info); + {arity, 3} -> + catch Fun(User, Peer, Info); _ -> - State + ok + catch + _:_ -> + ok + end. + +%%%---------------------------------------------------------------- +%%% Cache idle timer that closes the connection if there are no +%%% channels open for a while. + +cache_init_idle_timer(D) -> + case proplists:get_value(idle_time, D#data.opts, infinity) of + infinity -> + D#data{idle_timer_value = infinity, + idle_timer_ref = infinity % A flag used later... + }; + IdleTime -> + %% We dont want to set the timeout on first connect + D#data{idle_timer_value = IdleTime} end. -handle_idle_timer(Time, #state{idle_timer_ref = undefined} = State) -> - TimerRef = erlang:send_after(Time, self(), {'EXIT', [], "Timeout"}), - State#state{idle_timer_ref=TimerRef}; -handle_idle_timer(_, State) -> - State. - -remove_timer_ref(State) -> - case State#state.idle_timer_ref of - infinity -> %% If the timer is not activated - State; - undefined -> %% If we already has cancelled the timer - State; - TimerRef -> %% Timer is active + +cache_check_set_idle_timer(D = #data{idle_timer_ref = undefined, + idle_timer_value = IdleTime}) -> + %% No timer set - shall we set one? + case ssh_channel:cache_info(num_entries, cache(D)) of + 0 when IdleTime == infinity -> + %% No. Meaningless to set a timer that fires in an infinite time... + D; + 0 -> + %% Yes, we'll set one since the cache is empty and it should not + %% be that for a specified time + D#data{idle_timer_ref = + erlang:send_after(IdleTime, self(), {'EXIT',[],"Timeout"})}; + _ -> + %% No - there are entries in the cache + D + end; +cache_check_set_idle_timer(D) -> + %% There is already a timer set or the timeout time is infinite + D. + + +cache_cancel_idle_timer(D) -> + case D#data.idle_timer_ref of + infinity -> + %% The timer is not activated + D; + undefined -> + %% The timer is already cancelled + D; + TimerRef -> + %% The timer is active erlang:cancel_timer(TimerRef), - State#state{idle_timer_ref = undefined} + D#data{idle_timer_ref = undefined} end. -socket_control(Socket, Pid, Transport) -> - case Transport:controlling_process(Socket, Pid) of + +cache_request_idle_timer_check(D = #data{idle_timer_value = infinity}) -> + D; +cache_request_idle_timer_check(D = #data{idle_timer_value = IdleTime}) -> + erlang:send_after(IdleTime, self(), check_cache), + D. + +%%%---------------------------------------------------------------- +start_channel_request_timer(_,_, infinity) -> + ok; +start_channel_request_timer(Channel, From, Time) -> + erlang:send_after(Time, self(), {timeout, {Channel, From}}). + +%%%---------------------------------------------------------------- +%%% Connection start and initalization helpers + +socket_control(Socket, Pid, Options) -> + {_, TransportCallback, _} = % For example {_,gen_tcp,_} + proplists:get_value(transport, Options, ?DefaultTransport), + case TransportCallback:controlling_process(Socket, Pid) of ok -> - send_event(Pid, socket_control); + gen_statem:cast(Pid, socket_control); {error, Reason} -> {error, Reason} end. @@ -1881,16 +1893,3 @@ handshake(Pid, Ref, Timeout) -> {error, timeout} end. -start_timeout(_,_, infinity) -> - ok; -start_timeout(Channel, From, Time) -> - erlang:send_after(Time, self(), {timeout, {Channel, From}}). - -getopt(Opt, Socket) -> - case inet:getopts(Socket, [Opt]) of - {ok, [{Opt, Value}]} -> - {ok, Value}; - Other -> - {error, {unexpected_getopts_return, Other}} - end. - diff --git a/lib/ssh/src/ssh_info.erl b/lib/ssh/src/ssh_info.erl index 67130d5eac..0c24c09887 100644 --- a/lib/ssh/src/ssh_info.erl +++ b/lib/ssh/src/ssh_info.erl @@ -37,7 +37,7 @@ print() -> io:format("~s", [string()]). print(File) when is_list(File) -> - {ok,D} = file:open(File, write), + {ok,D} = file:open(File, [write]), print(D), file:close(D); print(D) -> diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index 65754956aa..db80d4c9e3 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -50,13 +50,7 @@ -define(Empint(X), (ssh_bits:mpint(X))/binary ). -define(Ebinary(X), ?STRING(X) ). -%% encode(Msg) -> -%% try encode1(Msg) -%% catch -%% C:E -> -%% io:format('***********************~n~p:~p ~p~n',[C,E,Msg]), -%% error(E) -%% end. +-define(unicode_list(B), unicode:characters_to_list(B)). encode(#ssh_msg_global_request{ name = Name, @@ -176,7 +170,7 @@ encode(#ssh_msg_userauth_pk_ok{ encode(#ssh_msg_userauth_passwd_changereq{prompt = Prompt, languge = Lang })-> - <<?Ebyte(?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ), ?Estring(Prompt), ?Estring(Lang)>>; + <<?Ebyte(?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ), ?Estring_utf8(Prompt), ?Estring(Lang)>>; encode(#ssh_msg_userauth_info_request{ name = Name, @@ -184,14 +178,14 @@ encode(#ssh_msg_userauth_info_request{ language_tag = Lang, num_prompts = NumPromtps, data = Data}) -> - <<?Ebyte(?SSH_MSG_USERAUTH_INFO_REQUEST), ?Estring(Name), ?Estring(Inst), ?Estring(Lang), + <<?Ebyte(?SSH_MSG_USERAUTH_INFO_REQUEST), ?Estring_utf8(Name), ?Estring_utf8(Inst), ?Estring(Lang), ?Euint32(NumPromtps), ?'E...'(Data)>>; encode(#ssh_msg_userauth_info_response{ num_responses = Num, data = Data}) -> lists:foldl(fun %%("", Acc) -> Acc; % commented out since it seem wrong - (Response, Acc) -> <<Acc/binary, ?Estring(Response)>> + (Response, Acc) -> <<Acc/binary, ?Estring_utf8(Response)>> end, <<?Ebyte(?SSH_MSG_USERAUTH_INFO_RESPONSE), ?Euint32(Num)>>, Data); @@ -201,17 +195,17 @@ encode(#ssh_msg_disconnect{ description = Desc, language = Lang }) -> - <<?Ebyte(?SSH_MSG_DISCONNECT), ?Euint32(Code), ?Estring(Desc), ?Estring(Lang)>>; + <<?Ebyte(?SSH_MSG_DISCONNECT), ?Euint32(Code), ?Estring_utf8(Desc), ?Estring(Lang)>>; encode(#ssh_msg_service_request{ name = Service }) -> - <<?Ebyte(?SSH_MSG_SERVICE_REQUEST), ?Estring(Service)>>; + <<?Ebyte(?SSH_MSG_SERVICE_REQUEST), ?Estring_utf8(Service)>>; encode(#ssh_msg_service_accept{ name = Service }) -> - <<?Ebyte(?SSH_MSG_SERVICE_ACCEPT), ?Estring(Service)>>; + <<?Ebyte(?SSH_MSG_SERVICE_ACCEPT), ?Estring_utf8(Service)>>; encode(#ssh_msg_newkeys{}) -> <<?Ebyte(?SSH_MSG_NEWKEYS)>>; @@ -283,7 +277,7 @@ encode(#ssh_msg_kex_ecdh_reply{public_host_key = Key, q_s = Q_s, h_sig = Sign}) <<?Ebyte(?SSH_MSG_KEX_ECDH_REPLY), ?Ebinary(EncKey), ?Empint(Q_s), ?Ebinary(EncSign)>>; encode(#ssh_msg_ignore{data = Data}) -> - <<?Ebyte(?SSH_MSG_IGNORE), ?Estring(Data)>>; + <<?Ebyte(?SSH_MSG_IGNORE), ?Estring_utf8(Data)>>; encode(#ssh_msg_unimplemented{sequence = Seq}) -> <<?Ebyte(?SSH_MSG_UNIMPLEMENTED), ?Euint32(Seq)>>; @@ -291,7 +285,7 @@ encode(#ssh_msg_unimplemented{sequence = Seq}) -> encode(#ssh_msg_debug{always_display = Bool, message = Msg, language = Lang}) -> - <<?Ebyte(?SSH_MSG_DEBUG), ?Eboolean(Bool), ?Estring(Msg), ?Estring(Lang)>>. + <<?Ebyte(?SSH_MSG_DEBUG), ?Eboolean(Bool), ?Estring_utf8(Msg), ?Estring(Lang)>>. %% Connection Messages @@ -330,7 +324,7 @@ decode(<<?BYTE(?SSH_MSG_CHANNEL_OPEN_FAILURE), ?UINT32(Recipient), ?UINT32(Reas #ssh_msg_channel_open_failure{ recipient_channel = Recipient, reason = Reason, - description = unicode:characters_to_list(Desc), + description = ?unicode_list(Desc), lang = Lang }; decode(<<?BYTE(?SSH_MSG_CHANNEL_WINDOW_ADJUST), ?UINT32(Recipient), ?UINT32(Bytes)>>) -> @@ -363,7 +357,7 @@ decode(<<?BYTE(?SSH_MSG_CHANNEL_REQUEST), ?UINT32(Recipient), ?DEC_BIN(RequestType,__0), ?BYTE(Bool), Data/binary>>) -> #ssh_msg_channel_request{ recipient_channel = Recipient, - request_type = unicode:characters_to_list(RequestType), + request_type = ?unicode_list(RequestType), want_reply = erl_boolean(Bool), data = Data }; @@ -381,9 +375,9 @@ decode(<<?BYTE(?SSH_MSG_USERAUTH_REQUEST), ?DEC_BIN(User,__0), ?DEC_BIN(Service,__1), ?DEC_BIN(Method,__2), Data/binary>>) -> #ssh_msg_userauth_request{ - user = unicode:characters_to_list(User), - service = unicode:characters_to_list(Service), - method = unicode:characters_to_list(Method), + user = ?unicode_list(User), + service = ?unicode_list(Service), + method = ?unicode_list(Method), data = Data }; @@ -391,7 +385,7 @@ decode(<<?BYTE(?SSH_MSG_USERAUTH_FAILURE), ?DEC_BIN(Auths,__0), ?BYTE(Bool)>>) -> #ssh_msg_userauth_failure { - authentications = unicode:characters_to_list(Auths), + authentications = ?unicode_list(Auths), partial_success = erl_boolean(Bool) }; @@ -493,18 +487,18 @@ decode(<<"ecdh",?BYTE(?SSH_MSG_KEX_ECDH_REPLY), decode(<<?SSH_MSG_SERVICE_REQUEST, ?DEC_BIN(Service,__0)>>) -> #ssh_msg_service_request{ - name = unicode:characters_to_list(Service) + name = ?unicode_list(Service) }; decode(<<?SSH_MSG_SERVICE_ACCEPT, ?DEC_BIN(Service,__0)>>) -> #ssh_msg_service_accept{ - name = unicode:characters_to_list(Service) + name = ?unicode_list(Service) }; decode(<<?BYTE(?SSH_MSG_DISCONNECT), ?UINT32(Code), ?DEC_BIN(Desc,__0), ?DEC_BIN(Lang,__1)>>) -> #ssh_msg_disconnect{ code = Code, - description = unicode:characters_to_list(Desc), + description = ?unicode_list(Desc), language = Lang }; @@ -512,7 +506,7 @@ decode(<<?BYTE(?SSH_MSG_DISCONNECT), ?UINT32(Code), ?DEC_BIN(Desc,__0), ?DEC_BIN decode(<<?BYTE(?SSH_MSG_DISCONNECT), ?UINT32(Code), ?DEC_BIN(Desc,__0)>>) -> #ssh_msg_disconnect{ code = Code, - description = unicode:characters_to_list(Desc), + description = ?unicode_list(Desc), language = <<"en">> }; @@ -554,7 +548,7 @@ decode_kex_init(<<?BYTE(Bool)>>, Acc, 0) -> X = 0, list_to_tuple(lists:reverse([X, erl_boolean(Bool) | Acc])); decode_kex_init(<<?DEC_BIN(Data,__0), Rest/binary>>, Acc, N) -> - Names = string:tokens(unicode:characters_to_list(Data), ","), + Names = string:tokens(?unicode_list(Data), ","), decode_kex_init(Rest, [Names | Acc], N -1). diff --git a/lib/ssh/src/ssh_no_io.erl b/lib/ssh/src/ssh_no_io.erl index 8144aac66e..1da257ed99 100644 --- a/lib/ssh/src/ssh_no_io.erl +++ b/lib/ssh/src/ssh_no_io.erl @@ -27,27 +27,39 @@ -export([yes_no/2, read_password/2, read_line/2, format/2]). + +-spec yes_no(any(), any()) -> no_return(). + yes_no(_, _) -> - throw({{no_io_allowed, yes_no}, - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "User interaction is not allowed", - language = "en"}}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "User interaction is not allowed"}, + {no_io_allowed, yes_no}). + + +-spec read_password(any(), any()) -> no_return(). read_password(_, _) -> - throw({{no_io_allowed, read_password}, - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "User interaction is not allowed", - language = "en"}}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "User interaction is not allowed"}, + {no_io_allowed, read_password}). + + +-spec read_line(any(), any()) -> no_return(). read_line(_, _) -> - throw({{no_io_allowed, read_line}, - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "User interaction is not allowed", - language = "en"}} ). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "User interaction is not allowed"}, + {no_io_allowed, read_line}). + + +-spec format(any(), any()) -> no_return(). format(_, _) -> - throw({{no_io_allowed, format}, - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "User interaction is not allowed", - language = "en"}}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "User interaction is not allowed"}, + {no_io_allowed, format}). diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index 6314671f0d..9a9786a914 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -192,6 +192,9 @@ stop_acceptor(Sup) -> [{Name, AcceptorSup}] = [{SupName, ASup} || {SupName, ASup, _, [ssh_acceptor_sup]} <- supervisor:which_children(Sup)], - supervisor:terminate_child(AcceptorSup, Name). - - + case supervisor:terminate_child(AcceptorSup, Name) of + ok -> + supervisor:delete_child(AcceptorSup, Name); + Error -> + Error + end. diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index c04bd350c7..7cb3b75ac0 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -265,7 +265,8 @@ new_keys_message(Ssh0) -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), {ok, SshPacket, Ssh}. - + + handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, #ssh{role = client} = Ssh0) -> {ok, Algoritms} = select_algorithm(client, Own, CounterPart), @@ -275,10 +276,10 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, Ssh0#ssh{algorithms = Algoritms}); _ -> %% TODO: Correct code? - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Selection of key exchange" - " algorithm failed", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Selection of key exchange algorithm failed" + }) end; handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, @@ -288,10 +289,10 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, true -> {ok, Ssh#ssh{algorithms = Algoritms}}; _ -> - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Selection of key exchange" - " algorithm failed", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Selection of key exchange algorithm failed" + }) end. @@ -371,12 +372,12 @@ handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, session_id = sid(Ssh1, H)}}; true -> - throw({{error,bad_e_from_peer}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'e' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'e' out of bounds"}, + {error,bad_e_from_peer} + ) end. handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = PeerPubHostKey, @@ -396,21 +397,20 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = PeerPubHostKey, exchanged_hash = H, session_id = sid(Ssh, H)}}; Error -> - throw({Error, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed", - language = "en"} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed"}, + Error) end; true -> - throw({{error,bad_f_from_peer}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'f' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'f' out of bounds"}, + bad_f_from_peer + ) end. @@ -435,10 +435,11 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = Min0, keyex_info = {Min, Max, NBits} }}; {error,_} -> - throw(#ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "No possible diffie-hellman-group-exchange group found", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "No possible diffie-hellman-group-exchange group found" + }) end; handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits}, @@ -469,19 +470,19 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits}, keyex_info = {-1, -1, NBits} % flag for kex_h hash calc }}; {error,_} -> - throw(#ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "No possible diffie-hellman-group-exchange group found", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "No possible diffie-hellman-group-exchange group found" + }) end; handle_kex_dh_gex_request(_, _) -> - throw({{error,bad_ssh_msg_kex_dh_gex_request}, + ssh_connection_handler:disconnect( #ssh_msg_disconnect{ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, bad values in ssh_msg_kex_dh_gex_request", - language = ""} - }). + description = "Key exchange failed, bad values in ssh_msg_kex_dh_gex_request"}, + bad_ssh_msg_kex_dh_gex_request). adjust_gex_min_max(Min0, Max0, Opts) -> @@ -495,10 +496,11 @@ adjust_gex_min_max(Min0, Max0, Opts) -> Min2 =< Max2 -> {Min2, Max2}; Max2 < Min2 -> - throw(#ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "No possible diffie-hellman-group-exchange group possible", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "No possible diffie-hellman-group-exchange group possible" + }) end end. @@ -535,20 +537,18 @@ handle_kex_dh_gex_init(#ssh_msg_kex_dh_gex_init{e = E}, session_id = sid(Ssh, H) }}; true -> - throw({{error,bad_K}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'K' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'K' out of bounds"}, + bad_K) end; true -> - throw({{error,bad_e_from_peer}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'e' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'e' out of bounds"}, + bad_e_from_peer) end. handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = PeerPubHostKey, @@ -572,29 +572,28 @@ handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = PeerPubHostK exchanged_hash = H, session_id = sid(Ssh, H)}}; _Error -> - throw(#ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed", - language = ""} - ) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed" + }) end; true -> - throw({{error,bad_K}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'K' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'K' out of bounds"}, + bad_K) end; true -> - throw({{error,bad_f_from_peer}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'f' out of bounds", - language = ""} - }) - end. + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'f' out of bounds"}, + bad_f_from_peer + ) + end. %%%---------------------------------------------------------------- %%% @@ -624,12 +623,11 @@ handle_kex_ecdh_init(#ssh_msg_kex_ecdh_init{q_c = PeerPublic}, session_id = sid(Ssh1, H)}} catch _:_ -> - throw({{error,invalid_peer_public_key}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Peer ECDH public key is invalid", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Peer ECDH public key is invalid"}, + invalid_peer_public_key) end. handle_kex_ecdh_reply(#ssh_msg_kex_ecdh_reply{public_host_key = PeerPubHostKey, @@ -650,21 +648,19 @@ handle_kex_ecdh_reply(#ssh_msg_kex_ecdh_reply{public_host_key = PeerPubHostKey, exchanged_hash = H, session_id = sid(Ssh, H)}}; Error -> - throw({Error, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed"}, + Error) end catch _:_ -> - throw({{error,invalid_peer_public_key}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Peer ECDH public key is invalid", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Peer ECDH public key is invalid"}, + invalid_peer_public_key) end. @@ -675,9 +671,10 @@ handle_new_keys(#ssh_msg_newkeys{}, Ssh0) -> {ok, Ssh} catch _C:_Error -> %% TODO: Throw earlier .... - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Install alg failed", - language = "en"}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Install alg failed" + }) end. %% select session id @@ -929,9 +926,9 @@ select_all(CL, SL) when length(CL) + length(SL) < ?MAX_NUM_ALGORITHMS -> lists:map(fun(ALG) -> list_to_atom(ALG) end, (CL -- A)); select_all(CL, SL) -> Err = lists:concat(["Received too many algorithms (",length(CL),"+",length(SL)," >= ",?MAX_NUM_ALGORITHMS,")."]), - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = Err, - language = ""}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = Err}). select([], []) -> @@ -1042,7 +1039,7 @@ handle_packet_part(DecryptedPfx, EncryptedBuffer, TotalNeeded, {bad_mac, Ssh1}; true -> {Ssh, DecompressedPayload} = decompress(Ssh1, payload(DecryptedPacket)), - {decoded, DecompressedPayload, NextPacketBytes, Ssh} + {packet_decrypted, DecompressedPayload, NextPacketBytes, Ssh} end; aead -> PacketLenBin = DecryptedPfx, @@ -1052,7 +1049,7 @@ handle_packet_part(DecryptedPfx, EncryptedBuffer, TotalNeeded, {Ssh1, DecryptedSfx} -> DecryptedPacket = <<DecryptedPfx/binary, DecryptedSfx/binary>>, {Ssh, DecompressedPayload} = decompress(Ssh1, payload(DecryptedPacket)), - {decoded, DecompressedPayload, NextPacketBytes, Ssh} + {packet_decrypted, DecompressedPayload, NextPacketBytes, Ssh} end end. diff --git a/lib/ssh/src/sshc_sup.erl b/lib/ssh/src/sshc_sup.erl index 5667fd2aec..71b5c2c46a 100644 --- a/lib/ssh/src/sshc_sup.erl +++ b/lib/ssh/src/sshc_sup.erl @@ -64,7 +64,7 @@ child_spec(_) -> Name = undefined, % As simple_one_for_one is used. StartFunc = {ssh_connection_handler, start_link, []}, Restart = temporary, - Shutdown = infinity, + Shutdown = 4000, Modules = [ssh_connection_handler], - Type = supervisor, + Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 4ecc662c13..6ce6d6f537 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -55,6 +55,7 @@ MODULES= \ ssh_relay HRL_FILES_NEEDED_IN_TEST= \ + $(ERL_TOP)/lib/ssh/test/ssh_test_lib.hrl \ $(ERL_TOP)/lib/ssh/src/ssh.hrl \ $(ERL_TOP)/lib/ssh/src/ssh_xfer.hrl diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index bdc980e65c..9910b8f1d7 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -192,7 +192,7 @@ simple_exec_groups_no_match_too_large(Config) -> %%-------------------------------------------------------------------- %% Testing all default groups -simple_exec_groups() -> [{timetrap,{seconds,180}}]. +simple_exec_groups() -> [{timetrap,{minutes,5}}]. simple_exec_groups(Config) -> Sizes = interpolate( public_key:dh_gex_group_sizes() ), @@ -226,28 +226,13 @@ sshc_simple_exec(Config) -> KnownHosts = filename:join(PrivDir, "known_hosts"), {Host,Port} = ?config(srvr_addr, Config), Cmd = lists:concat(["ssh -p ",Port, - " -C -o UserKnownHostsFile=",KnownHosts, + " -C", + " -o UserKnownHostsFile=",KnownHosts, + " -o StrictHostKeyChecking=no", " ",Host," 1+1."]), ct:log("~p",[Cmd]), - SshPort = open_port({spawn, Cmd}, [binary]), - Expect = <<"2\n">>, - rcv_expected(SshPort, Expect). - - -rcv_expected(SshPort, Expect) -> - receive - {SshPort, {data,Expect}} -> - ct:log("Got expected ~p from ~p",[Expect,SshPort]), - catch port_close(SshPort), - ok; - Other -> - ct:log("Got UNEXPECTED ~p",[Other]), - rcv_expected(SshPort, Expect) - - after ?TIMEOUT -> - catch port_close(SshPort), - ct:fail("Did not receive answer") - end. + OpenSsh = ssh_test_lib:open_port({spawn, Cmd}, [eof,exit_status]), + ssh_test_lib:rcv_expected({data,<<"2\n">>}, OpenSsh, ?TIMEOUT). %%-------------------------------------------------------------------- %% Connect to the ssh server of the OS @@ -361,13 +346,15 @@ get_atoms(L) -> %%% Test case related %%% start_std_daemon(Opts, Config) -> + ct:log("starting std_daemon",[]), {Pid, Host, Port} = ssh_test_lib:std_daemon(Config, Opts), ct:log("started ~p:~p ~p",[Host,Port,Opts]), [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config]. -start_pubkey_daemon(Opts, Config) -> +start_pubkey_daemon(Opts0, Config) -> + Opts = [{auth_methods,"publickey"}|Opts0], {Pid, Host, Port} = ssh_test_lib:std_daemon1(Config, Opts), - ct:log("started1 ~p:~p ~p",[Host,Port,Opts]), + ct:log("started pubkey_daemon ~p:~p ~p",[Host,Port,Opts]), [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config]. diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index 8ec1017642..1f11fee350 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -104,7 +104,7 @@ init_sftp_dirs(Config) -> DstDir = filename:join(UserDir, "sftp_dst"), ok = file:make_dir(DstDir), N = 100 * 1024*1024, - ok = file:write_file(filename:join(SrcDir,SrcFile), crypto:rand_bytes(N)), + ok = file:write_file(filename:join(SrcDir,SrcFile), crypto:strong_rand_bytes(N)), [{sftp_src_dir,SrcDir}, {sftp_dst_dir,DstDir}, {src_file,SrcFile}, {sftp_size,N} | Config]. @@ -333,52 +333,64 @@ find_time(accept_to_hello, L) -> [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) -> C#call.t_call end, - fun(C=#call{mfa = {ssh_connection_handler,hello,_}, - args = [socket_control|_]}) -> - C#call.t_return - end + ?LINE, + fun(C=#call{mfa = {ssh_connection_handler,handle_event,5}, + args = [_, {version_exchange,_}, _, {hello,_}, _]}) -> + C#call.t_call + end, + ?LINE ], L, []), {accept_to_hello, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(kex, L) -> - [T0,T1] = find([fun(C=#call{mfa = {ssh_connection_handler,hello,_}, - args = [socket_control|_]}) -> + [T0,T1] = find([fun(C=#call{mfa = {ssh_connection_handler,handle_event,5}, + args = [_, {version_exchange,_}, _, {hello,_}, _]}) -> C#call.t_call end, - ?send(#ssh_msg_newkeys{}) + ?LINE, + ?send(#ssh_msg_newkeys{}), + ?LINE ], L, []), {kex, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(kex_to_auth, L) -> [T0,T1] = find([?send(#ssh_msg_newkeys{}), - ?recv(#ssh_msg_userauth_request{}) + ?LINE, + ?recv(#ssh_msg_userauth_request{}), + ?LINE ], L, []), {kex_to_auth, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(auth, L) -> [T0,T1] = find([?recv(#ssh_msg_userauth_request{}), - ?send(#ssh_msg_userauth_success{}) + ?LINE, + ?send(#ssh_msg_userauth_success{}), + ?LINE ], L, []), {auth, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(to_prompt, L) -> [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) -> C#call.t_call end, - ?recv(#ssh_msg_channel_request{request_type="env"}) + ?LINE, + ?recv(#ssh_msg_channel_request{request_type="env"}), + ?LINE ], L, []), {to_prompt, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(channel_open_close, L) -> [T0,T1] = find([?recv(#ssh_msg_channel_request{request_type="subsystem"}), - ?send(#ssh_msg_channel_close{}) + ?LINE, + ?send(#ssh_msg_channel_close{}), + ?LINE ], L, []), {channel_open_close, now2micro_sec(now_diff(T1,T0)), microsec}. -find([F|Fs], [C|Cs], Acc) when is_function(F,1) -> +find([F,Id|Fs], [C|Cs], Acc) when is_function(F,1) -> try F(C) of T -> find(Fs, Cs, [T|Acc]) catch - _:_ -> find([F|Fs], Cs, Acc) + _:_ -> find([F,Id|Fs], Cs, Acc) end; find([], _, Acc) -> lists:reverse(Acc). @@ -444,7 +456,7 @@ erlang_trace() -> 0 = erlang:trace(new, true, [call,timestamp,{tracer,TracerPid}]), [init_trace(MFA, tp(MFA)) || MFA <- [{ssh_acceptor,handle_connection,5}, - {ssh_connection_handler,hello,2}, +%% {ssh_connection_handler,hello,2}, {ssh_message,encode,1}, {ssh_message,decode,1}, {ssh_transport,select_algorithm,3}, @@ -454,6 +466,10 @@ erlang_trace() -> {ssh_message,decode,1}, {public_key,dh_gex_group,4} % To find dh_gex group size ]], + init_trace({ssh_connection_handler,handle_event,5}, + [{['_', {version_exchange,'_'}, '_', {hello,'_'}, '_'], + [], + [return_trace]}]), {ok, TracerPid}. tp({_M,_F,Arity}) -> diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index a5f424f863..0f757a0322 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -23,6 +23,7 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("ssh/src/ssh_connect.hrl"). +-include("ssh_test_lib.hrl"). -compile(export_all). @@ -655,15 +656,21 @@ max_channels_option(Config) when is_list(Config) -> {user_interaction, true}, {user_dir, UserDir}]), + %% Allocate a number of ChannelId:s to play with. (This operation is not + %% counted by the max_channel option). {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId1} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId2} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId3} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId4} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId5} = ssh_connection:session_channel(ConnectionRef, infinity), - {ok, _ChannelId6} = ssh_connection:session_channel(ConnectionRef, infinity), + {ok, ChannelId6} = ssh_connection:session_channel(ConnectionRef, infinity), + {ok, _ChannelId7} = ssh_connection:session_channel(ConnectionRef, infinity), - %%%---- shell + %% Now start to open the channels (this is counted my max_channels) to check that + %% it gives a failure at right place + + %%%---- Channel 1(3): shell ok = ssh_connection:shell(ConnectionRef,ChannelId0), receive {ssh_cm,ConnectionRef, {data, ChannelId0, 0, <<"Eshell",_/binary>>}} -> @@ -672,10 +679,10 @@ max_channels_option(Config) when is_list(Config) -> ct:fail("CLI Timeout") end, - %%%---- subsystem "echo_n" + %%%---- Channel 2(3): subsystem "echo_n" success = ssh_connection:subsystem(ConnectionRef, ChannelId1, "echo_n", infinity), - %%%---- exec #1 + %%%---- Channel 3(3): exec. This closes itself. success = ssh_connection:exec(ConnectionRef, ChannelId2, "testing1.\n", infinity), receive {ssh_cm, ConnectionRef, {data, ChannelId2, 0, <<"testing1",_/binary>>}} -> @@ -684,13 +691,13 @@ max_channels_option(Config) when is_list(Config) -> ct:fail("Exec #1 Timeout") end, - %%%---- ptty - success = ssh_connection:ptty_alloc(ConnectionRef, ChannelId3, []), + %%%---- Channel 3(3): subsystem "echo_n" (Note that ChannelId2 should be closed now) + ?wait_match(success, ssh_connection:subsystem(ConnectionRef, ChannelId3, "echo_n", infinity)), - %%%---- exec #2 + %%%---- Channel 4(3) !: exec This should fail failure = ssh_connection:exec(ConnectionRef, ChannelId4, "testing2.\n", infinity), - %%%---- close the shell + %%%---- close the shell (Frees one channel) ok = ssh_connection:send(ConnectionRef, ChannelId0, "exit().\n", 5000), %%%---- wait for the subsystem to terminate @@ -703,14 +710,11 @@ max_channels_option(Config) when is_list(Config) -> ct:fail("exit Timeout",[]) end, - %%%---- exec #3 - success = ssh_connection:exec(ConnectionRef, ChannelId5, "testing3.\n", infinity), - receive - {ssh_cm, ConnectionRef, {data, ChannelId5, 0, <<"testing3",_/binary>>}} -> - ok - after 5000 -> - ct:fail("Exec #3 Timeout") - end, + %%---- Try that we can open one channel instead of the closed one + ?wait_match(success, ssh_connection:subsystem(ConnectionRef, ChannelId5, "echo_n", infinity)), + + %%---- But not a fourth one... + failure = ssh_connection:subsystem(ConnectionRef, ChannelId6, "echo_n", infinity), ssh:close(ConnectionRef), ssh:stop_daemon(Pid). diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 1d14a16065..4ca6a473fa 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -51,9 +51,7 @@ ssh_connect_arg4_timeout/1, ssh_connect_negtimeout_parallel/1, ssh_connect_negtimeout_sequential/1, - ssh_connect_nonegtimeout_connected_parallel/0, ssh_connect_nonegtimeout_connected_parallel/1, - ssh_connect_nonegtimeout_connected_sequential/0, ssh_connect_nonegtimeout_connected_sequential/1, ssh_connect_timeout/1, connect/4, ssh_daemon_minimal_remote_max_packet_size_option/1, @@ -82,7 +80,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{seconds,40}}]. + {timetrap,{seconds,30}}]. all() -> [connectfun_disconnectfun_server, @@ -493,7 +491,7 @@ ssh_msg_debug_fun_option_client(Config) -> {user_interaction, false}, {ssh_msg_debug_fun,DbgFun}]), %% Beware, implementation knowledge: - gen_fsm:send_all_state_event(ConnectionRef,{ssh_msg_debug,false,<<"Hello">>,<<>>}), + gen_statem:cast(ConnectionRef,{ssh_msg_debug,false,<<"Hello">>,<<>>}), receive {msg_dbg,X={ConnectionRef,false,<<"Hello">>,<<>>}} -> ct:log("Got expected dbg msg ~p",[X]), @@ -606,7 +604,7 @@ ssh_msg_debug_fun_option_server(Config) -> receive {connection_pid,Server} -> %% Beware, implementation knowledge: - gen_fsm:send_all_state_event(Server,{ssh_msg_debug,false,<<"Hello">>,<<>>}), + gen_statem:cast(Server,{ssh_msg_debug,false,<<"Hello">>,<<>>}), receive {msg_dbg,X={_,false,<<"Hello">>,<<>>}} -> ct:log("Got expected dbg msg ~p",[X]), @@ -982,16 +980,10 @@ ssh_connect_negtimeout(Config, Parallel) -> %%-------------------------------------------------------------------- %%% Test that ssh connection does not timeout if the connection is established (parallel) - -ssh_connect_nonegtimeout_connected_parallel() -> [{timetrap,{seconds,90}}]. - ssh_connect_nonegtimeout_connected_parallel(Config) -> ssh_connect_nonegtimeout_connected(Config, true). %%% Test that ssh connection does not timeout if the connection is established (non-parallel) - -ssh_connect_nonegtimeout_connected_sequential() -> [{timetrap,{seconds,90}}]. - ssh_connect_nonegtimeout_connected_sequential(Config) -> ssh_connect_nonegtimeout_connected(Config, false). @@ -1000,7 +992,7 @@ ssh_connect_nonegtimeout_connected(Config, Parallel) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), - NegTimeOut = 20000, % ms + NegTimeOut = 2000, % ms ct:log("Parallel: ~p",[Parallel]), {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, @@ -1131,21 +1123,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> %% This is expected %% Now stop one connection and try to open one more ok = ssh:close(hd(Connections)), - receive after 250 -> ok end, % sleep so the supervisor has time to count down. Not nice... - try Connect(Host,Port) - of - _ConnectionRef1 -> - %% Step 3 ok: could set up one more connection after killing one - %% Thats good. - ssh:stop_daemon(Pid), - ok - catch - error:{badmatch,{error,"Connection closed"}} -> - %% Bad indeed. Could not set up one more connection even after killing - %% one existing. Very bad. - ssh:stop_daemon(Pid), - {fail,"Does not decrease # active sessions"} - end + try_to_connect(Connect, Host, Port, Pid) end catch error:{badmatch,{error,"Connection closed"}} -> @@ -1153,6 +1131,35 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> {fail,"Too few connections accepted"} end. + +try_to_connect(Connect, Host, Port, Pid) -> + {ok,Tref} = timer:send_after(3000, timeout_no_connection), % give the supervisors some time... + try_to_connect(Connect, Host, Port, Pid, Tref, 1). % will take max 3300 ms after 11 tries + +try_to_connect(Connect, Host, Port, Pid, Tref, N) -> + try Connect(Host,Port) + of + _ConnectionRef1 -> + %% Step 3 ok: could set up one more connection after killing one + %% Thats good. + timer:cancel(Tref), + ssh:stop_daemon(Pid), + receive % flush. + timeout_no_connection -> ok + after 0 -> ok + end + catch + error:{badmatch,{error,"Connection closed"}} -> + %% Could not set up one more connection. Try again until timeout. + receive + timeout_no_connection -> + ssh:stop_daemon(Pid), + {fail,"Does not decrease # active sessions"} + after N*50 -> % retry after this time + try_to_connect(Connect, Host, Port, Pid, Tref, N+1) + end + end. + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_renegotiate_SUITE.erl b/lib/ssh/test/ssh_renegotiate_SUITE.erl index 90132becbd..f1a909cbd0 100644 --- a/lib/ssh/test/ssh_renegotiate_SUITE.erl +++ b/lib/ssh/test/ssh_renegotiate_SUITE.erl @@ -33,7 +33,6 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{seconds,40}}]. - all() -> [{group,default_algs}, {group,aes_gcm} ]. @@ -238,7 +237,7 @@ renegotiate2(Config) -> %% get_kex_init - helper function to get key_exchange_init_msg get_kex_init(Conn) -> %% First, validate the key exchange is complete (StateName == connected) - {connected,S} = sys:get_state(Conn), + {{connected,_},S} = sys:get_state(Conn), %% Next, walk through the elements of the #state record looking %% for the #ssh_msg_kexinit record. This method is robust against %% changes to either record. The KEXINIT message contains a cookie diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index c4bb02841b..f6d7be41d6 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -38,7 +38,6 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{seconds,40}}]. - all() -> [{group, not_unicode}, {group, unicode} @@ -301,9 +300,9 @@ end_per_testcase(_, Config) -> end_per_testcase(Config) -> {Sftp, Connection} = ?config(sftp, Config), - ssh_sftp:stop_channel(Sftp), + ok = ssh_sftp:stop_channel(Sftp), catch ssh_sftp:stop_channel(?config(channel_pid2, Config)), - ssh:close(Connection). + ok = ssh:close(Connection). %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- @@ -365,7 +364,7 @@ write_file(Config) when is_list(Config) -> {Sftp, _} = ?config(sftp, Config), Data = list_to_binary("Hej hopp!"), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Data} = file:read_file(FileName). %%-------------------------------------------------------------------- @@ -378,7 +377,7 @@ write_file_iolist(Config) when is_list(Config) -> Data = list_to_binary("Hej hopp!"), lists:foreach( fun(D) -> - ssh_sftp:write_file(Sftp, FileName, [D]), + ok = ssh_sftp:write_file(Sftp, FileName, [D]), Expected = if is_binary(D) -> D; is_list(D) -> list_to_binary(D) end, @@ -397,7 +396,7 @@ write_big_file(Config) when is_list(Config) -> {Sftp, _} = ?config(sftp, Config), Data = list_to_binary(lists:duplicate(750000,"a")), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Data} = file:read_file(FileName). %%-------------------------------------------------------------------- @@ -409,7 +408,7 @@ sftp_read_big_file(Config) when is_list(Config) -> Data = list_to_binary(lists:duplicate(750000,"a")), ct:log("Data size to write is ~p bytes",[size(Data)]), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Data} = ssh_sftp:read_file(Sftp, FileName). %%-------------------------------------------------------------------- @@ -425,7 +424,7 @@ remove_file(Config) when is_list(Config) -> ok = ssh_sftp:delete(Sftp, FileName), {ok, NewFiles} = ssh_sftp:list_dir(Sftp, PrivDir), false = lists:member(filename:basename(FileName), NewFiles), - {error, _} = ssh_sftp:delete(Sftp, FileName). + {error, no_such_file} = ssh_sftp:delete(Sftp, FileName). %%-------------------------------------------------------------------- rename_file() -> [{doc, "Test API function rename_file/2"}]. @@ -500,7 +499,7 @@ set_attributes(Config) when is_list(Config) -> io:put_chars(Fd,"foo"), ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#400}), {error, eacces} = file:write_file(FileName, "hello again"), - ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#600}), + ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#600}), ok = file:write_file(FileName, "hello again"). %%-------------------------------------------------------------------- @@ -549,7 +548,7 @@ position(Config) when is_list(Config) -> {Sftp, _} = ?config(sftp, Config), Data = list_to_binary("1234567890"), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Handle} = ssh_sftp:open(Sftp, FileName, [read]), {ok, 3} = ssh_sftp:position(Sftp, Handle, {bof, 3}), @@ -577,7 +576,7 @@ pos_read(Config) when is_list(Config) -> FileName = ?config(testfile, Config), {Sftp, _} = ?config(sftp, Config), Data = list_to_binary("Hej hopp!"), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Handle} = ssh_sftp:open(Sftp, FileName, [read]), {async, Ref} = ssh_sftp:apread(Sftp, Handle, {bof, 5}, 4), @@ -607,7 +606,7 @@ pos_write(Config) when is_list(Config) -> {ok, Handle} = ssh_sftp:open(Sftp, FileName, [write]), Data = list_to_binary("Bye,"), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), NewData = list_to_binary(" see you tomorrow"), {async, Ref} = ssh_sftp:apwrite(Sftp, Handle, {bof, 4}, NewData), @@ -869,7 +868,7 @@ aes_cbc256_crypto_tar(Config) -> {"d1",fn("d1",Config)} % Dir ]), Key = <<"This is a 256 bit key. Boring...">>, - Ivec0 = crypto:rand_bytes(16), + Ivec0 = crypto:strong_rand_bytes(16), DataSize = 1024, % data_size rem 16 = 0 for aes_cbc Cinitw = fun() -> {ok, Ivec0, DataSize} end, @@ -914,7 +913,7 @@ aes_ctr_stream_crypto_tar(Config) -> {"d1",fn("d1",Config)} % Dir ]), Key = <<"This is a 256 bit key. Boring...">>, - Ivec0 = crypto:rand_bytes(16), + Ivec0 = crypto:strong_rand_bytes(16), Cinitw = Cinitr = fun() -> {ok, crypto:stream_init(aes_ctr,Key,Ivec0)} end, diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index fb1a9687af..9385bd127d 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -105,7 +105,6 @@ init_per_testcase(TestCase, Config) -> ClientUserDir = filename:join(PrivDir, nopubkey), SystemDir = filename:join(?config(priv_dir, Config), system), - Port = ssh_test_lib:inet_port(node()), Options = [{system_dir, SystemDir}, {user_dir, PrivDir}, {user_passwords,[{?USER, ?PASSWD}]}, @@ -113,11 +112,13 @@ init_per_testcase(TestCase, Config) -> {ok, Sftpd} = case TestCase of ver6_basic -> SubSystems = [ssh_sftpd:subsystem_spec([{sftpd_vsn, 6}])], - ssh:daemon(Port, [{subsystems, SubSystems}|Options]); + ssh:daemon(0, [{subsystems, SubSystems}|Options]); _ -> SubSystems = [ssh_sftpd:subsystem_spec([])], - ssh:daemon(Port, [{subsystems, SubSystems}|Options]) + ssh:daemon(0, [{subsystems, SubSystems}|Options]) end, + {ok,Dinf} = ssh:daemon_info(Sftpd), + Port = proplists:get_value(port, Dinf), Cm = ssh_test_lib:connect(Port, [{user_dir, ClientUserDir}, diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl index 09bef87148..355ce6a8f5 100644 --- a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl @@ -39,7 +39,6 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{seconds,40}}]. - all() -> [close_file, quit, diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl index f800ea806d..2dc4263603 100644 --- a/lib/ssh/test/ssh_sup_SUITE.erl +++ b/lib/ssh/test/ssh_sup_SUITE.erl @@ -22,21 +22,23 @@ -module(ssh_sup_SUITE). -include_lib("common_test/include/ct.hrl"). -include_lib("ssh/src/ssh.hrl"). +-include("ssh_test_lib.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). --define(WAIT_FOR_SHUTDOWN, 500). -define(USER, "Alladin"). -define(PASSWD, "Sesame"). +-define(WAIT_FOR_SHUTDOWN, 500). + %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{seconds,40}}]. + {timetrap,{seconds,100}}]. all() -> [default_tree, sshc_subtree, sshd_subtree, sshd_subtree_profile]. @@ -92,8 +94,8 @@ default_tree(Config) when is_list(Config) -> lists:keysearch(sshc_sup, 1, TopSupChildren), {value, {sshd_sup, _,supervisor,[sshd_sup]}} = lists:keysearch(sshd_sup, 1, TopSupChildren), - [] = supervisor:which_children(sshc_sup), - [] = supervisor:which_children(sshd_sup). + ?wait_match([], supervisor:which_children(sshc_sup)), + ?wait_match([], supervisor:which_children(sshd_sup)). sshc_subtree() -> [{doc, "Make sure the sshc subtree is correct"}]. @@ -101,24 +103,26 @@ sshc_subtree(Config) when is_list(Config) -> {_Pid, Host, Port} = ?config(server, Config), UserDir = ?config(userdir, Config), - [] = supervisor:which_children(sshc_sup), + ?wait_match([], supervisor:which_children(sshc_sup)), + {ok, Pid1} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, {user_interaction, false}, {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), - [{_, _,supervisor,[ssh_connection_handler]}] = - supervisor:which_children(sshc_sup), + ?wait_match([{_, _,supervisor,[ssh_connection_handler]}], + supervisor:which_children(sshc_sup)), + {ok, Pid2} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, {user_interaction, false}, {user, ?USER}, {password, ?PASSWD}, {user_dir, UserDir}]), - [{_,_,supervisor,[ssh_connection_handler]}, - {_,_,supervisor,[ssh_connection_handler]}] = - supervisor:which_children(sshc_sup), + ?wait_match([{_,_,supervisor,[ssh_connection_handler]}, + {_,_,supervisor,[ssh_connection_handler]}], + supervisor:which_children(sshc_sup)), + ssh:close(Pid1), - [{_,_,supervisor,[ssh_connection_handler]}] = - supervisor:which_children(sshc_sup), + ?wait_match([{_,_,supervisor,[ssh_connection_handler]}], + supervisor:which_children(sshc_sup)), ssh:close(Pid2), - ct:sleep(?WAIT_FOR_SHUTDOWN), - [] = supervisor:which_children(sshc_sup). + ?wait_match([], supervisor:which_children(sshc_sup)). sshd_subtree() -> [{doc, "Make sure the sshd subtree is correct"}]. @@ -130,14 +134,16 @@ sshd_subtree(Config) when is_list(Config) -> {failfun, fun ssh_test_lib:failfun/2}, {user_passwords, [{?USER, ?PASSWD}]}]), - [{{server,ssh_system_sup, HostIP, Port, ?DEFAULT_PROFILE}, - Daemon, supervisor, - [ssh_system_sup]}] = - supervisor:which_children(sshd_sup), + + ?wait_match([{{server,ssh_system_sup, HostIP, Port, ?DEFAULT_PROFILE}, + Daemon, supervisor, + [ssh_system_sup]}], + supervisor:which_children(sshd_sup), + Daemon), check_sshd_system_tree(Daemon, Config), ssh:stop_daemon(HostIP, Port), ct:sleep(?WAIT_FOR_SHUTDOWN), - [] = supervisor:which_children(sshd_sup). + ?wait_match([], supervisor:which_children(sshd_sup)). sshd_subtree_profile() -> [{doc, "Make sure the sshd subtree using profile option is correct"}]. @@ -152,14 +158,15 @@ sshd_subtree_profile(Config) when is_list(Config) -> {user_passwords, [{?USER, ?PASSWD}]}, {profile, Profile}]), - [{{server,ssh_system_sup, HostIP,Port,Profile}, - Daemon, supervisor, - [ssh_system_sup]}] = - supervisor:which_children(sshd_sup), + ?wait_match([{{server,ssh_system_sup, HostIP,Port,Profile}, + Daemon, supervisor, + [ssh_system_sup]}], + supervisor:which_children(sshd_sup), + Daemon), check_sshd_system_tree(Daemon, Config), ssh:stop_daemon(HostIP, Port, Profile), ct:sleep(?WAIT_FOR_SHUTDOWN), - [] = supervisor:which_children(sshd_sup). + ?wait_match([], supervisor:which_children(sshd_sup)). check_sshd_system_tree(Daemon, Config) -> @@ -170,28 +177,31 @@ check_sshd_system_tree(Daemon, Config) -> {user_interaction, false}, {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), - [{_,SubSysSup, supervisor,[ssh_subsystem_sup]}, - {{ssh_acceptor_sup,_,_,_}, AccSup, supervisor,[ssh_acceptor_sup]}] - = supervisor:which_children(Daemon), + ?wait_match([{_,SubSysSup, supervisor,[ssh_subsystem_sup]}, + {{ssh_acceptor_sup,_,_,_}, AccSup, supervisor,[ssh_acceptor_sup]}], + supervisor:which_children(Daemon), + [SubSysSup,AccSup]), - [{{server,ssh_connection_sup, _,_}, - ConnectionSup, supervisor, - [ssh_connection_sup]}, - {{server,ssh_channel_sup,_ ,_}, - ChannelSup,supervisor, - [ssh_channel_sup]}] = supervisor:which_children(SubSysSup), + ?wait_match([{{server,ssh_connection_sup, _,_}, + ConnectionSup, supervisor, + [ssh_connection_sup]}, + {{server,ssh_channel_sup,_ ,_}, + ChannelSup,supervisor, + [ssh_channel_sup]}], + supervisor:which_children(SubSysSup), + [ConnectionSup,ChannelSup]), - [{{ssh_acceptor_sup,_,_,_},_,worker,[ssh_acceptor]}] = - supervisor:which_children(AccSup), + ?wait_match([{{ssh_acceptor_sup,_,_,_},_,worker,[ssh_acceptor]}], + supervisor:which_children(AccSup)), - [{_, _, worker,[ssh_connection_handler]}] = - supervisor:which_children(ConnectionSup), + ?wait_match([{_, _, worker,[ssh_connection_handler]}], + supervisor:which_children(ConnectionSup)), - [] = supervisor:which_children(ChannelSup), + ?wait_match([], supervisor:which_children(ChannelSup)), ssh_sftp:start_channel(Client), - [{_, _,worker,[ssh_channel]}] = - supervisor:which_children(ChannelSup), + ?wait_match([{_, _,worker,[ssh_channel]}], + supervisor:which_children(ChannelSup)), ssh:close(Client). diff --git a/lib/ssh/test/ssh_test_cli.erl b/lib/ssh/test/ssh_test_cli.erl index 697ddb730d..f96b9967d2 100644 --- a/lib/ssh/test/ssh_test_cli.erl +++ b/lib/ssh/test/ssh_test_cli.erl @@ -75,10 +75,11 @@ terminate(_Why, _S) -> run_portprog(User, cli, TmpDir) -> Pty_bin = os:find_executable("cat"), - open_port({spawn_executable, Pty_bin}, - [stream, {cd, TmpDir}, {env, [{"USER", User}]}, - {args, []}, binary, - exit_status, use_stdio, stderr_to_stdout]). + ssh_test_lib:open_port({spawn_executable, Pty_bin}, + [stream, + {cd, TmpDir}, + {env, [{"USER", User}]}, + {args, []}]). get_ssh_user(Ref) -> [{user, User}] = ssh:connection_info(Ref, [user]), diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index abbd4857c9..c6541461a1 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -32,15 +32,8 @@ -define(TIMEOUT, 50000). -connect(Options) -> - connect(hostname(), inet_port(), Options). - connect(Port, Options) when is_integer(Port) -> - connect(hostname(), Port, Options); -connect(any, Options) -> - connect(hostname(), inet_port(), Options); -connect(Host, Options) -> - connect(Host, inet_port(), Options). + connect(hostname(), Port, Options). connect(any, Port, Options) -> connect(hostname(), Port, Options); @@ -49,23 +42,33 @@ connect(Host, Port, Options) -> ConnectionRef. daemon(Options) -> - daemon(any, inet_port(), Options). + daemon(any, 0, Options). daemon(Port, Options) when is_integer(Port) -> daemon(any, Port, Options); daemon(Host, Options) -> - daemon(Host, inet_port(), Options). + daemon(Host, 0, Options). + daemon(Host, Port, Options) -> + ct:log("~p:~p Calling ssh:daemon(~p, ~p, ~p)",[?MODULE,?LINE,Host,Port,Options]), case ssh:daemon(Host, Port, Options) of {ok, Pid} when Host == any -> - {Pid, hostname(), Port}; + ct:log("ssh:daemon ok (1)",[]), + {Pid, hostname(), daemon_port(Port,Pid)}; {ok, Pid} -> - {Pid, Host, Port}; + ct:log("ssh:daemon ok (2)",[]), + {Pid, Host, daemon_port(Port,Pid)}; Error -> + ct:log("ssh:daemon error ~p",[Error]), Error end. +daemon_port(0, Pid) -> {ok,Dinf} = ssh:daemon_info(Pid), + proplists:get_value(port, Dinf); +daemon_port(Port, _) -> Port. + + std_daemon(Config, ExtraOpts) -> PrivDir = ?config(priv_dir, Config), @@ -100,7 +103,7 @@ std_simple_sftp(Host, Port, Config, Opts) -> DataFile = filename:join(UserDir, "test.data"), ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, Opts), {ok, ChannelRef} = ssh_sftp:start_channel(ConnectionRef), - Data = crypto:rand_bytes(proplists:get_value(std_simple_sftp_size,Config,10)), + Data = crypto:strong_rand_bytes(proplists:get_value(std_simple_sftp_size,Config,10)), ok = ssh_sftp:write_file(ChannelRef, DataFile, Data), {ok,ReadData} = file:read_file(DataFile), ok = ssh:close(ConnectionRef), @@ -201,6 +204,35 @@ reply(TestCase, Result) -> %%ct:log("reply ~p sending ~p ! ~p",[self(), TestCase, Result]), TestCase ! Result. + + +rcv_expected(Expect, SshPort, Timeout) -> + receive + {SshPort, Expect} -> + ct:log("Got expected ~p from ~p",[Expect,SshPort]), + catch port_close(SshPort), + rcv_lingering(50); + Other -> + ct:log("Got UNEXPECTED ~p~nExpect ~p",[Other, {SshPort,Expect}]), + rcv_expected(Expect, SshPort, Timeout) + + after Timeout -> + catch port_close(SshPort), + ct:fail("Did not receive answer") + end. + +rcv_lingering(Timeout) -> + receive + Msg -> + ct:log("Got LINGERING ~p",[Msg]), + rcv_lingering(Timeout) + + after Timeout -> + ct:log("No more lingering messages",[]), + ok + end. + + receive_exec_result(Msg) -> ct:log("Expect data! ~p", [Msg]), receive @@ -354,7 +386,7 @@ setup_rsa_pass_pharse(DataDir, UserDir, Phrase) -> setup_pass_pharse(KeyBin, OutFile, Phrase) -> [{KeyType, _,_} = Entry0] = public_key:pem_decode(KeyBin), Key = public_key:pem_entry_decode(Entry0), - Salt = crypto:rand_bytes(8), + Salt = crypto:strong_rand_bytes(8), Entry = public_key:pem_entry_encode(KeyType, Key, {{"DES-CBC", Salt}, Phrase}), Pem = public_key:pem_encode([Entry]), @@ -470,8 +502,9 @@ openssh_supports(ClientOrServer, Tag, Alg) when ClientOrServer == sshc ; %% Check if we have a "newer" ssh client that supports these test cases ssh_client_supports_Q() -> - ErlPort = open_port({spawn, "ssh -Q cipher"}, [exit_status, stderr_to_stdout]), - 0 == check_ssh_client_support2(ErlPort). + 0 == check_ssh_client_support2( + ?MODULE:open_port({spawn, "ssh -Q cipher"}) + ). check_ssh_client_support2(P) -> receive @@ -690,3 +723,16 @@ has_inet6_address() -> catch throw:6 -> true end. + +%%%---------------------------------------------------------------- +open_port(Arg1) -> + ?MODULE:open_port(Arg1, []). + +open_port(Arg1, ExtraOpts) -> + erlang:open_port(Arg1, + [binary, + stderr_to_stdout, + exit_status, + use_stdio, + overlapped_io, hide %only affects windows + | ExtraOpts]). diff --git a/lib/ssh/test/ssh_test_lib.hrl b/lib/ssh/test/ssh_test_lib.hrl new file mode 100644 index 0000000000..7cb7edeaa8 --- /dev/null +++ b/lib/ssh/test/ssh_test_lib.hrl @@ -0,0 +1,27 @@ +%%------------------------------------------------------------------------- +%% Help macro +%%------------------------------------------------------------------------- +-define(wait_match(Pattern, FunctionCall, Bind, Timeout, Ntries), + Bind = + (fun() -> + F = fun(N, F1) -> + case FunctionCall of + Pattern -> Bind; + _ when N>0 -> + ct:pal("Must sleep ~p ms at ~p:~p",[Timeout,?MODULE,?LINE]), + timer:sleep(Timeout), + F1(N-1, F1); + Other -> + ct:fail("Unexpected ~p:~p ~p",[?MODULE,?LINE,Other]) + end + end, + F(Ntries, F) + end)() + ). + +-define(wait_match(Pattern, FunctionCall, Timeout, Ntries), ?wait_match(Pattern, FunctionCall, ok, Timeout, Ntries)). + +-define(wait_match(Pattern, FunctionCall, Bind), ?wait_match(Pattern, FunctionCall, Bind, 500, 10) ). + +-define(wait_match(Pattern, FunctionCall), ?wait_match(Pattern, FunctionCall, ok) ). + diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 5b65edc32f..2be75fd7f3 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -34,7 +34,7 @@ %%-------------------------------------------------------------------- suite() -> - [{timetrap,{seconds,40}}]. + [{timetrap,{seconds,20}}]. all() -> case os:find_executable("ssh") of @@ -50,13 +50,15 @@ groups() -> [{erlang_client, [], [erlang_shell_client_openssh_server, erlang_client_openssh_server_exec_compressed, erlang_client_openssh_server_setenv, - erlang_client_openssh_server_publickey_rsa, erlang_client_openssh_server_publickey_dsa, + erlang_client_openssh_server_publickey_rsa, erlang_client_openssh_server_password, erlang_client_openssh_server_kexs, erlang_client_openssh_server_nonexistent_subsystem ]}, - {erlang_server, [], [erlang_server_openssh_client_public_key_dsa]} + {erlang_server, [], [erlang_server_openssh_client_public_key_dsa, + erlang_server_openssh_client_public_key_rsa + ]} ]. init_per_suite(Config) -> @@ -74,6 +76,7 @@ init_per_group(erlang_server, Config) -> DataDir = ?config(data_dir, Config), UserDir = ?config(priv_dir, Config), ssh_test_lib:setup_dsa_known_host(DataDir, UserDir), + ssh_test_lib:setup_rsa_known_host(DataDir, UserDir), Config; init_per_group(erlang_client, Config) -> CommonAlgs = ssh_test_lib:algo_intersection( @@ -86,6 +89,7 @@ init_per_group(_, Config) -> end_per_group(erlang_server, Config) -> UserDir = ?config(priv_dir, Config), ssh_test_lib:clean_dsa(UserDir), + ssh_test_lib:clean_rsa(UserDir), Config; end_per_group(_, Config) -> Config. @@ -93,6 +97,8 @@ end_per_group(_, Config) -> init_per_testcase(erlang_server_openssh_client_public_key_dsa, Config) -> chk_key(sshc, 'ssh-dss', ".ssh/id_dsa", Config); +init_per_testcase(erlang_server_openssh_client_public_key_rsa, Config) -> + chk_key(sshc, 'ssh-rsa', ".ssh/id_rsa", Config); init_per_testcase(erlang_client_openssh_server_publickey_dsa, Config) -> chk_key(sshd, 'ssh-dss', ".ssh/id_dsa", Config); init_per_testcase(_TestCase, Config) -> @@ -347,14 +353,24 @@ erlang_client_openssh_server_publickey_dsa(Config) when is_list(Config) -> %%-------------------------------------------------------------------- erlang_server_openssh_client_public_key_dsa() -> - [{doc, "Validate using dsa publickey."}]. + [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}, + {doc, "Validate using dsa publickey."}]. erlang_server_openssh_client_public_key_dsa(Config) when is_list(Config) -> + erlang_server_openssh_client_public_key_X(Config, ssh_dsa). + +erlang_server_openssh_client_public_key_rsa() -> + [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}, + {doc, "Validate using rsa publickey."}]. +erlang_server_openssh_client_public_key_rsa(Config) when is_list(Config) -> + erlang_server_openssh_client_public_key_X(Config, ssh_rsa). + + +erlang_server_openssh_client_public_key_X(Config, PubKeyAlg) -> SystemDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), KnownHosts = filename:join(PrivDir, "known_hosts"), - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {public_key_alg, ssh_dsa}, + {public_key_alg, PubKeyAlg}, {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), @@ -362,18 +378,8 @@ erlang_server_openssh_client_public_key_dsa(Config) when is_list(Config) -> Cmd = "ssh -p " ++ integer_to_list(Port) ++ " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " 1+1.", - SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), - - receive - {SshPort,{data, <<"2\n">>}} -> - ok - after ?TIMEOUT -> - receive - X -> ct:fail("Received: ~p",[X]) - after 0 -> - ct:fail("Did not receive answer") - end - end, + OpenSsh = ssh_test_lib:open_port({spawn, Cmd}), + ssh_test_lib:rcv_expected({data,<<"2\n">>}, OpenSsh, ?TIMEOUT), ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl index 4269529ae8..e34071af99 100644 --- a/lib/ssh/test/ssh_trpt_test_lib.erl +++ b/lib/ssh/test/ssh_trpt_test_lib.erl @@ -294,12 +294,11 @@ instantiate(X, _S) -> %%%================================================================ %%% init_ssh(Role, Socket, Options0) -> - Options = [{user_interaction,false} + Options = [{user_interaction, false}, + {vsn, {2,0}}, + {id_string, "ErlangTestLib"} | Options0], - ssh_connection_handler:init_ssh(Role, - {2,0}, - lists:concat(["SSH-2.0-ErlangTestLib ",Role]), - Options, Socket). + ssh_connection_handler:init_ssh_record(Role, Socket, Options). mangle_opts(Options) -> SysOpts = [{reuseaddr, true}, diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 41b42d454b..b165928877 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.2.2 +SSH_VSN = 4.3 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 7c55dd4c96..00419b63db 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -28,6 +28,36 @@ <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 7.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Corrections to cipher suite handling using the 3 and 4 + tuple format in addition to commit + 89d7e21cf4ae988c57c8ef047bfe85127875c70c</p> + <p> + Own Id: OTP-13511</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Make values for the TLS-1.2 signature_algorithms + extension configurable</p> + <p> + Own Id: OTP-13261</p> + </item> + </list> + </section> + +</section> + <section><title>SSL 7.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 057906bcb3..11728128c4 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,9 +1,6 @@ %% -*- erlang -*- {"%VSN%", [ - {<<"7\\.2">>, [{load_module, tls_connection, soft_purge, soft_purge, []}, - {load_module, ssl_tls_dist_proxy, soft_purge, soft_purge, []} - ]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, {<<"5\\..*">>, [{restart_application, ssl}]}, @@ -11,9 +8,6 @@ {<<"3\\..*">>, [{restart_application, ssl}]} ], [ - {<<"7\\.2">>, [{load_module, tls_connection, soft_purge, soft_purge, []}, - {load_module, ssl_tls_dist_proxy, soft_purge, soft_purge, []} - ]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, {<<"5\\..*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 4bcd6ddb0e..025e8cea61 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -42,7 +42,7 @@ renegotiate/1, prf/5, negotiated_protocol/1, negotiated_next_protocol/1, connection_information/1, connection_information/2]). %% Misc --export([random_bytes/1, handle_options/2]). +-export([handle_options/2]). -deprecated({negotiated_next_protocol, 1, next_major_release}). -deprecated({connection_info, 1, next_major_release}). @@ -581,22 +581,6 @@ format_error(Error) -> Other end. -%%-------------------------------------------------------------------- --spec random_bytes(integer()) -> binary(). - -%% -%% Description: Generates cryptographically secure random sequence if possible -%% fallbacks on pseudo random function -%%-------------------------------------------------------------------- -random_bytes(N) -> - try crypto:strong_rand_bytes(N) of - RandBytes -> - RandBytes - catch - error:low_entropy -> - crypto:rand_bytes(N) - end. - %%%-------------------------------------------------------------- %%% Internal functions %%%-------------------------------------------------------------------- @@ -1105,10 +1089,7 @@ binary_cipher_suites(Version, []) -> %% Defaults to all supported suites that does %% not require explicit configuration ssl_cipher:filter_suites(ssl_cipher:suites(Version)); -binary_cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility - Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0], - binary_cipher_suites(Version, Ciphers); -binary_cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> +binary_cipher_suites(Version, [Tuple|_] = Ciphers0) when is_tuple(Tuple) -> Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index e66f253a70..dc0a0c2cc4 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -1,4 +1,4 @@ -%% +% %% %CopyrightBegin% %% %% Copyright Ericsson AB 2007-2016. All Rights Reserved. @@ -39,7 +39,8 @@ suite/1, suites/1, all_suites/1, ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0, rc4_suites/1, des_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, - hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1]). + hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, + random_bytes/1]). -export_type([cipher_suite/0, erl_cipher_suite/0, openssl_cipher_suite/0, @@ -49,7 +50,8 @@ | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305. -type hash() :: null | sha | md5 | sha224 | sha256 | sha384 | sha512. -type sign_algo() :: rsa | dsa | ecdsa. --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 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()} % Pre TLS 1.2 %% TLS 1.2, internally PRE TLS 1.2 will use default_prf | {key_algo(), cipher(), hash(), hash() | default_prf}. @@ -102,7 +104,7 @@ 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), + <<Nonce:64>> = random_bytes(8), #cipher_state{iv = IV, key = Key, nonce = Nonce}; cipher_init(_BCA, IV, Key) -> #cipher_state{iv = IV, key = Key}. @@ -853,17 +855,17 @@ suite({rsa_psk, aes_256_cbc,sha}) -> %%% TLS 1.2 PSK Cipher Suites RFC 5487 -suite({psk, aes_128_gcm, null}) -> +suite({psk, aes_128_gcm, null, sha256}) -> ?TLS_PSK_WITH_AES_128_GCM_SHA256; -suite({psk, aes_256_gcm, null}) -> +suite({psk, aes_256_gcm, null, sha384}) -> ?TLS_PSK_WITH_AES_256_GCM_SHA384; -suite({dhe_psk, aes_128_gcm, null}) -> +suite({dhe_psk, aes_128_gcm, null, sha256}) -> ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256; -suite({dhe_psk, aes_256_gcm, null}) -> +suite({dhe_psk, aes_256_gcm, null, sha384}) -> ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384; -suite({rsa_psk, aes_128_gcm, null}) -> +suite({rsa_psk, aes_128_gcm, null, sha256}) -> ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256; -suite({rsa_psk, aes_256_gcm, null}) -> +suite({rsa_psk, aes_256_gcm, null, sha384}) -> ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384; suite({psk, aes_128_cbc, sha256}) -> @@ -970,74 +972,74 @@ suite({ecdh_anon, aes_256_cbc, sha}) -> ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA; %%% RFC 5289 EC TLS suites -suite({ecdhe_ecdsa, aes_128_cbc, sha256}) -> +suite({ecdhe_ecdsa, aes_128_cbc, sha256, sha256}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256; -suite({ecdhe_ecdsa, aes_256_cbc, sha384}) -> +suite({ecdhe_ecdsa, aes_256_cbc, sha384, sha384}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384; -suite({ecdh_ecdsa, aes_128_cbc, sha256}) -> +suite({ecdh_ecdsa, aes_128_cbc, sha256, sha256}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256; -suite({ecdh_ecdsa, aes_256_cbc, sha384}) -> +suite({ecdh_ecdsa, aes_256_cbc, sha384, sha384}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384; -suite({ecdhe_rsa, aes_128_cbc, sha256}) -> +suite({ecdhe_rsa, aes_128_cbc, sha256, sha256}) -> ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256; -suite({ecdhe_rsa, aes_256_cbc, sha384}) -> +suite({ecdhe_rsa, aes_256_cbc, sha384, sha384}) -> ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384; -suite({ecdh_rsa, aes_128_cbc, sha256}) -> +suite({ecdh_rsa, aes_128_cbc, sha256, sha256}) -> ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; -suite({ecdh_rsa, aes_256_cbc, sha384}) -> +suite({ecdh_rsa, aes_256_cbc, sha384, sha384}) -> ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; %% RFC 5288 AES-GCM Cipher Suites -suite({rsa, aes_128_gcm, null}) -> +suite({rsa, aes_128_gcm, null, sha256}) -> ?TLS_RSA_WITH_AES_128_GCM_SHA256; -suite({rsa, aes_256_gcm, null}) -> +suite({rsa, aes_256_gcm, null, sha384}) -> ?TLS_RSA_WITH_AES_256_GCM_SHA384; -suite({dhe_rsa, aes_128_gcm, null}) -> +suite({dhe_rsa, aes_128_gcm, null, sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; -suite({dhe_rsa, aes_256_gcm, null}) -> +suite({dhe_rsa, aes_256_gcm, null, sha384}) -> ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; -suite({dh_rsa, aes_128_gcm, null}) -> +suite({dh_rsa, aes_128_gcm, null, sha256}) -> ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; -suite({dh_rsa, aes_256_gcm, null}) -> +suite({dh_rsa, aes_256_gcm, null, sha384}) -> ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; -suite({dhe_dss, aes_128_gcm, null}) -> +suite({dhe_dss, aes_128_gcm, null, sha256}) -> ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; -suite({dhe_dss, aes_256_gcm, null}) -> +suite({dhe_dss, aes_256_gcm, null, sha384}) -> ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; -suite({dh_dss, aes_128_gcm, null}) -> +suite({dh_dss, aes_128_gcm, null, sha256}) -> ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; -suite({dh_dss, aes_256_gcm, null}) -> +suite({dh_dss, aes_256_gcm, null, sha384}) -> ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; -suite({dh_anon, aes_128_gcm, null}) -> +suite({dh_anon, aes_128_gcm, null, sha256}) -> ?TLS_DH_anon_WITH_AES_128_GCM_SHA256; -suite({dh_anon, aes_256_gcm, null}) -> +suite({dh_anon, aes_256_gcm, null, sha384}) -> ?TLS_DH_anon_WITH_AES_256_GCM_SHA384; %% RFC 5289 ECC AES-GCM Cipher Suites -suite({ecdhe_ecdsa, aes_128_gcm, null}) -> +suite({ecdhe_ecdsa, aes_128_gcm, null, sha256}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; -suite({ecdhe_ecdsa, aes_256_gcm, null}) -> +suite({ecdhe_ecdsa, aes_256_gcm, null, sha384}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; -suite({ecdh_ecdsa, aes_128_gcm, null}) -> +suite({ecdh_ecdsa, aes_128_gcm, null, sha256}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; -suite({ecdh_ecdsa, aes_256_gcm, null}) -> +suite({ecdh_ecdsa, aes_256_gcm, null, sha384}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; -suite({ecdhe_rsa, aes_128_gcm, null}) -> +suite({ecdhe_rsa, aes_128_gcm, null, sha256}) -> ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; -suite({ecdhe_rsa, aes_256_gcm, null}) -> +suite({ecdhe_rsa, aes_256_gcm, null, sha384}) -> ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; -suite({ecdh_rsa, aes_128_gcm, null}) -> +suite({ecdh_rsa, aes_128_gcm, null, sha256}) -> ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; -suite({ecdh_rsa, aes_256_gcm, null}) -> +suite({ecdh_rsa, aes_256_gcm, null, sha384}) -> ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384; %% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites -suite({ecdhe_rsa, chacha20_poly1305, null}) -> +suite({ecdhe_rsa, chacha20_poly1305, null, sha256}) -> ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256; -suite({ecdhe_ecdsa, chacha20_poly1305, null}) -> +suite({ecdhe_ecdsa, chacha20_poly1305, null, sha256}) -> ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256; -suite({dhe_rsa, chacha20_poly1305, null}) -> +suite({dhe_rsa, chacha20_poly1305, null, sha256}) -> ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256. %%-------------------------------------------------------------------- @@ -1472,6 +1474,16 @@ is_acceptable_prf(Prf, Algos) -> is_fallback(CipherSuites)-> lists:member(?TLS_FALLBACK_SCSV, CipherSuites). + +%%-------------------------------------------------------------------- +-spec random_bytes(integer()) -> binary(). + +%% +%% Description: Generates cryptographically secure random sequence +%%-------------------------------------------------------------------- +random_bytes(N) -> + crypto:strong_rand_bytes(N). + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -1712,7 +1724,7 @@ get_padding_aux(BlockSize, PadLength) -> random_iv(IV) -> IVSz = byte_size(IV), - ssl:random_bytes(IVSz). + random_bytes(IVSz). next_iv(Bin, IV) -> BinSz = byte_size(Bin), diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 1568e8559f..0073e86e26 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -502,7 +502,7 @@ certify(#server_hello_done{}, role = client, key_algorithm = Alg} = State0, Connection) when Alg == rsa_psk -> - Rand = ssl:random_bytes(?NUM_OF_PREMASTERSECRET_BYTES-2), + Rand = ssl_cipher:random_bytes(?NUM_OF_PREMASTERSECRET_BYTES-2), RSAPremasterSecret = <<?BYTE(Major), ?BYTE(Minor), Rand/binary>>, case ssl_handshake:premaster_secret({Alg, PSKIdentity}, PSKLookup, RSAPremasterSecret) of #alert{} = Alert -> @@ -1885,7 +1885,7 @@ handle_resumed_session(SessId, #state{connection_states = ConnectionStates0, end. make_premaster_secret({MajVer, MinVer}, rsa) -> - Rand = ssl:random_bytes(?NUM_OF_PREMASTERSECRET_BYTES-2), + Rand = ssl_cipher:random_bytes(?NUM_OF_PREMASTERSECRET_BYTES-2), <<?BYTE(MajVer), ?BYTE(MinVer), Rand/binary>>; make_premaster_secret(_, _) -> undefined. diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 8d2dad91d9..60b4fbe995 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -551,7 +551,7 @@ last_delay_timer({_,_}, TRef, {_, LastClient}) -> new_id(_, 0, _, _) -> <<>>; new_id(Port, Tries, Cache, CacheCb) -> - Id = crypto:rand_bytes(?NUM_OF_SESSION_ID_BYTES), + Id = ssl_cipher:random_bytes(?NUM_OF_SESSION_ID_BYTES), case CacheCb:lookup(Cache, {Port, Id}) of undefined -> Now = erlang:monotonic_time(), diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index ecff950668..866bfcef7e 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -460,7 +460,7 @@ empty_security_params(ConnectionEnd = ?SERVER) -> random() -> Secs_since_1970 = calendar:datetime_to_gregorian_seconds( calendar:universal_time()) - 62167219200, - Random_28_bytes = crypto:rand_bytes(28), + Random_28_bytes = ssl_cipher:random_bytes(28), <<?UINT32(Secs_since_1970), Random_28_bytes/binary>>. dtls_next_epoch(#connection_state{epoch = undefined}) -> %% SSL/TLS diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index ef718c13df..102dbba198 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -278,10 +278,11 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, {Version, SessionId, ConnectionStates, ProtoExt, Protocol} end. -available_signature_algs(undefined, SupportedHashSigns, _, {Major, Minor}) when (Major < 3) andalso (Minor < 3) -> +available_signature_algs(undefined, SupportedHashSigns, _, {Major, Minor}) when + (Major >= 3) andalso (Minor >= 3) -> SupportedHashSigns; available_signature_algs(#hash_sign_algos{hash_sign_algos = ClientHashSigns}, SupportedHashSigns, - _, {Major, Minor}) when (Major < 3) andalso (Minor < 3) -> + _, {Major, Minor}) when (Major >= 3) andalso (Minor >= 3) -> ordsets:intersection(ClientHashSigns, SupportedHashSigns); available_signature_algs(_, _, _, _) -> undefined. diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 50313e6a22..3fea38078f 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -88,7 +88,8 @@ basic_tests() -> connect_dist, clear_pem_cache, defaults, - fallback + fallback, + cipher_format ]. options_tests() -> @@ -168,6 +169,7 @@ renegotiate_tests() -> cipher_tests() -> [cipher_suites, + cipher_suites_mix, ciphers_rsa_signed_certs, ciphers_rsa_signed_certs_openssl_names, ciphers_dsa_signed_certs, @@ -763,6 +765,14 @@ fallback(Config) when is_list(Config) -> Client, {error,{tls_alert,"inappropriate fallback"}}). %%-------------------------------------------------------------------- +cipher_format() -> + [{doc, "Test that cipher conversion from tuples to binarys works"}]. +cipher_format(Config) when is_list(Config) -> + {ok, Socket} = ssl:listen(0, [{ciphers, ssl:cipher_suites()}]), + ssl:close(Socket). + +%%-------------------------------------------------------------------- + peername() -> [{doc,"Test API function peername/1"}]. @@ -913,6 +923,31 @@ cipher_suites(Config) when is_list(Config) -> [_|_] =ssl:cipher_suites(openssl). %%-------------------------------------------------------------------- +cipher_suites_mix() -> + [{doc,"Test to have old and new cipher suites at the same time"}]. + +cipher_suites_mix(Config) when is_list(Config) -> + CipherSuites = [{ecdh_rsa,aes_128_cbc,sha256,sha256}, {rsa,aes_128_cbc,sha}], + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, [{ciphers, CipherSuites} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). +%%-------------------------------------------------------------------- socket_options() -> [{doc,"Test API function getopts/2 and setopts/2"}]. @@ -1555,7 +1590,7 @@ tcp_connect_big(Config) when is_list(Config) -> {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), TcpOpts = [binary, {reuseaddr, true}], - Rand = crypto:rand_bytes(?MAX_CIPHER_TEXT_LENGTH+1), + Rand = crypto:strong_rand_bytes(?MAX_CIPHER_TEXT_LENGTH+1), Server = ssl_test_lib:start_upgrade_server_error([{node, ServerNode}, {port, 0}, {from, self()}, {timeout, 5000}, diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl index bd0ddde090..e7cbfa63f4 100644 --- a/lib/ssl/test/ssl_dist_SUITE.erl +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -194,7 +194,7 @@ payload(Config) when is_list(Config) -> ok = apply_on_ssl_node( NH2, fun () -> - Msg = crypto:rand_bytes(100000), + Msg = crypto:strong_rand_bytes(100000), SslPid ! {self(), Msg}, receive {SslPid, Msg} -> diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 2cd23eb3b8..db9e1c3d38 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -349,7 +349,7 @@ wait_for_result(Pid, Msg) -> user_lookup(psk, _Identity, UserState) -> {ok, UserState}; user_lookup(srp, Username, _UserState) -> - Salt = ssl:random_bytes(16), + Salt = ssl_cipher:random_bytes(16), UserPassHash = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, <<"secret">>])]), {ok, {srp_1024, Salt, UserPassHash}}. @@ -905,8 +905,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}, + {dh_anon, aes_128_gcm, null, sha256}, + {dh_anon, aes_256_gcm, null, sha384}, {ecdh_anon,rc4_128,sha}, {ecdh_anon,'3des_ede_cbc',sha}, {ecdh_anon,aes_128_cbc,sha}, @@ -933,12 +933,12 @@ psk_suites() -> {rsa_psk, aes_256_cbc, sha}, {rsa_psk, aes_128_cbc, sha256}, {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}], + {psk, aes_128_gcm, null, sha256}, + {psk, aes_256_gcm, null, sha384}, + {dhe_psk, aes_128_gcm, null, sha256}, + {dhe_psk, aes_256_gcm, null, sha384}, + {rsa_psk, aes_128_gcm, null, sha256}, + {rsa_psk, aes_256_gcm, null, sha384}], ssl_cipher:filter_suites(Suites). psk_anon_suites() -> diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 47cb2909fb..8c732002de 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 7.3 +SSL_VSN = 7.3.1 diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index 196c86748f..26602764a6 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2015. All Rights Reserved. +# Copyright Ericsson AB 1997-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -68,6 +68,7 @@ XML_REF3_FILES = \ gen_event.xml \ gen_fsm.xml \ gen_server.xml \ + gen_statem.xml \ io.xml \ io_lib.xml \ lib.xml \ diff --git a/lib/stdlib/doc/src/binary.xml b/lib/stdlib/doc/src/binary.xml index 5402fd0163..933157fc34 100644 --- a/lib/stdlib/doc/src/binary.xml +++ b/lib/stdlib/doc/src/binary.xml @@ -366,7 +366,7 @@ <code> 1> binary:matches(<<"abcde">>, - [<<"bcde">>,<<"bc">>>,<<"de">>],[]). + [<<"bcde">>,<<"bc">>,<<"de">>],[]). [{1,4}] </code> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 4e430d101e..2d69c201bc 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -1621,6 +1621,8 @@ true</pre> if the match_spec does not match the object <c><anno>Tuple</anno></c>.</p> <p>This is a useful debugging and test tool, especially when writing complicated <c>ets:select/2</c> calls.</p> + <p>See also: <seealso marker="erts:erlang#match_spec_test/3"> + erlang:match_spec_test/3</seealso>.</p> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/gen_fsm.xml b/lib/stdlib/doc/src/gen_fsm.xml index 37e7c6ed17..835e252704 100644 --- a/lib/stdlib/doc/src/gen_fsm.xml +++ b/lib/stdlib/doc/src/gen_fsm.xml @@ -31,12 +31,23 @@ <module>gen_fsm</module> <modulesummary>Generic Finite State Machine Behaviour</modulesummary> <description> + <note> + <p> + There is a new behaviour + <seealso marker="gen_statem"><c>gen_statem</c></seealso> + that is intended to replace <c>gen_fsm</c> for new code. + It has the same features and add some really useful. + This module will not be removed for the foreseeable future + to keep old state machine implementations running. + </p> + </note> <p>A behaviour module for implementing a finite state machine. A generic finite state machine process (gen_fsm) implemented using this module will have a standard set of interface functions and include functionality for tracing and error reporting. It will also fit into an OTP supervision tree. Refer to - <seealso marker="doc/design_principles:fsm">OTP Design Principles</seealso> for more information.</p> + <seealso marker="doc/design_principles:fsm">OTP Design Principles</seealso> for more information. + </p> <p>A gen_fsm assumes all specific parts to be located in a callback module exporting a pre-defined set of functions. The relationship between the behaviour functions and the callback functions can be @@ -848,6 +859,7 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 <title>SEE ALSO</title> <p><seealso marker="gen_event">gen_event(3)</seealso>, <seealso marker="gen_server">gen_server(3)</seealso>, + <seealso marker="gen_statem">gen_statem(3)</seealso>, <seealso marker="supervisor">supervisor(3)</seealso>, <seealso marker="proc_lib">proc_lib(3)</seealso>, <seealso marker="sys">sys(3)</seealso></p> diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml index 02da11250a..10dc978afc 100644 --- a/lib/stdlib/doc/src/gen_server.xml +++ b/lib/stdlib/doc/src/gen_server.xml @@ -715,6 +715,7 @@ gen_server:abcast -----> Module:handle_cast/2 <title>SEE ALSO</title> <p><seealso marker="gen_event">gen_event(3)</seealso>, <seealso marker="gen_fsm">gen_fsm(3)</seealso>, + <seealso marker="gen_statem">gen_statem(3)</seealso>, <seealso marker="supervisor">supervisor(3)</seealso>, <seealso marker="proc_lib">proc_lib(3)</seealso>, <seealso marker="sys">sys(3)</seealso></p> diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml new file mode 100644 index 0000000000..ec7f267c64 --- /dev/null +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -0,0 +1,1724 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2016</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>gen_statem</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + </header> + <module>gen_statem</module> + <modulesummary>Generic State Machine Behaviour</modulesummary> + <description> + <p> + A behaviour module for implementing a state machine. Two + <seealso marker="#type-callback_mode"><em>callback modes</em></seealso> + are supported. One for finite state machines + (<seealso marker="gen_fsm"><c>gen_fsm</c></seealso> like) + that requires the state to be an atom and uses that state as + the name of the current callback function, + and one without restriction on the state data type + that uses one callback function for all states. + </p> + <p> + This is a new behaviour in OTP-19.0. + It has been thoroughly reviewed, is stable enough + to be used by at least two heavy OTP applications, and is here to stay. + But depending on user feedback, we do not expect + but might find it necessary to make minor + not backwards compatible changes into OTP-20.0, + so its state can be designated as "not quite experimental"... + </p> + <p> + The <c>gen_statem</c> behaviour is intended to replace + <seealso marker="gen_fsm"><c>gen_fsm</c></seealso> for new code. + It has the same features and add some really useful: + </p> + <list type="bulleted"> + <item>State code is gathered</item> + <item>The state can be any term</item> + <item>Events can be postponed</item> + <item>Events can be self generated</item> + <item>A reply can be sent from a later state</item> + <item>There can be multiple sys traceable replies</item> + </list> + <p> + The callback model(s) for <c>gen_statem</c> differs from + the one for <seealso marker="gen_fsm"><c>gen_fsm</c></seealso>, + but it is still fairly easy to rewrite + from <c>gen_fsm</c> to <c>gen_statem</c>. + </p> + <p> + A generic state machine process (<c>gen_statem</c>) implemented + using this module will have a standard set of interface functions + and include functionality for tracing and error reporting. + It will also fit into an OTP supervision tree. Refer to + <seealso marker="doc/design_principles:statem"> + OTP Design Principles + </seealso> + for more information. + </p> + <p> + A <c>gen_statem</c> assumes all specific parts to be located in a + callback module exporting a pre-defined set of functions. + The relationship between the behaviour functions and the callback + functions can be illustrated as follows:</p> + <pre> +gen_statem module Callback module +----------------- --------------- +gen_statem:start +gen_statem:start_link -----> Module:init/1 + +gen_statem:stop -----> Module:terminate/3 + +gen_statem:call +gen_statem:cast +erlang:send +erlang:'!' -----> Module:StateName/3 + Module:handle_event/4 + +- -----> Module:terminate/3 + +- -----> Module:code_change/4</pre> + <p> + Events are of different + <seealso marker="#type-event_type">types</seealso> + so the callback functions can know the origin of an event + and how to respond. + </p> + <p> + If a callback function fails or returns a bad value, + the <c>gen_statem</c> will terminate. An exception of class + <seealso marker="erts:erlang#throw/1"><c>throw</c></seealso>, + however, is not regarded as an error but as a valid return. + </p> + <marker id="state_function" /> + <p> + The "<em>state function</em>" for a specific + <seealso marker="#type-state">state</seealso> + in a <c>gen_statem</c> is the callback function that is called + for all events in this state, and is selected depending on which + <seealso marker="#type-callback_mode"><em>callback mode</em></seealso> + that the implementation specifies when the the server starts. + </p> + <p> + When the + <seealso marker="#type-callback_mode"><em>callback mode</em></seealso> + is <c>state_functions</c>, the state has to be an atom and + is used as the state function name. See + <seealso marker="#Module:StateName/3"> + <c>Module:StateName/3</c> + </seealso>. + This gathers all code for a specific state + in one function and hence dispatches on state first. + Note that in this mode the fact that there is + a mandatory callback function + <seealso marker="#Module:terminate/3"> + <c>Module:terminate/3</c> + </seealso> makes the state name <c>terminate</c> unusable. + </p> + <p> + When the + <seealso marker="#type-callback_mode"><em>callback mode</em></seealso> + is <c>handle_event_function</c> the state can be any term + and the state function name is + <seealso marker="#Module:handle_event/4"> + <c>Module:handle_event/4</c> + </seealso>. + This makes it easy to dispatch on state or on event as you desire. + Be careful about which events you handle in which + states so you do not accidentally postpone one event + forever creating an infinite busy loop. + </p> + <p> + The <c>gen_statem</c> enqueues incoming events in order of arrival + and presents these to the + <seealso marker="#state_function">state function</seealso> + in that order. The state function can postpone an event + so it is not retried in the current state. + After a state change the queue restarts with the postponed events. + </p> + <p> + The <c>gen_statem</c> event queue model is sufficient + to emulate the normal process message queue with selective receive. + Postponing an event corresponds to not matching it + in a receive statement and changing states corresponds + to entering a new receive statement. + </p> + <p> + The <seealso marker="#state_function">state function</seealso> + can insert events using the + <seealso marker="#type-action"> + <c>action()</c> <c>next_event</c> + </seealso> + and such an event is inserted as the next to present + to the state function. That is: as if it is + the oldest incoming event. There is a dedicated + <seealso marker="#type-event_type"> + <c>event_type()</c> + </seealso> + <c>internal</c> that can be used for such events making them impossible + to mistake for external events. + </p> + <p> + Inserting an event replaces the trick of calling your own + state handling functions that you often would have to + resort to in for example <seealso marker="gen_fsm"><c>gen_fsm</c></seealso> + to force processing an inserted event before others. + A warning, though: if you in <c>gen_statem</c> for example + postpone an event in one state and then call some other state function of yours, + you have not changed states and hence the postponed event will not be retried, + which is logical but might be confusing. + </p> + <p> + See the type + <seealso marker="#type-transition_option"> + <c>transition_option()</c> + </seealso> + for the details of a state transition. + </p> + <p> + A <c>gen_statem</c> handles system messages as documented in + <seealso marker="sys"><c>sys</c></seealso>. + The <c>sys</c>module can be used for debugging a <c>gen_statem</c>. + </p> + <p> + Note that a <c>gen_statem</c> does not trap exit signals + automatically, this must be explicitly initiated in + the callback module (by calling + <seealso marker="erts:erlang#process_flag/2"> + <c>process_flag(trap_exit, true)</c></seealso>. + </p> + <p> + Unless otherwise stated, all functions in this module fail if + the specified <c>gen_statem</c> does not exist or + if bad arguments are given. + </p> + <p> + The <c>gen_statem</c> process can go into hibernation; see + <seealso marker="proc_lib#hibernate/3"> + <c>proc_lib:hibernate/3</c>. + </seealso> + It is done when a + <seealso marker="#state_function">state function</seealso> or + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + specifies <c>hibernate</c> in the returned + <seealso marker="#type-action"><c>Actions</c></seealso> + list. This feature might be useful to reclaim process heap memory + while the server is expected to be idle for a long time. + However, use this feature with care + since hibernation can be too costly + to use after every event; see + <seealso marker="erts:erlang#hibernate/3"> + <c>erlang:hibernate/3</c>. + </seealso> + </p> + </description> + + <section> + <title>EXAMPLE</title> + <p> + This example shows a simple pushbutton model + for a toggling pushbutton implemented with + <seealso marker="#type-callback_mode"><em>callback mode</em></seealso> + <c>state_functions</c>. + You can push the button and it replies if it went on or off, + and you can ask for a count of how many times it has been + pushed to on. + </p> + <p>This is the complete callback module file <c>pushbutton.erl</c>:</p> + <code type="erl"> +-module(pushbutton). +-behaviour(gen_statem). + +-export([start/0,push/0,get_count/0,stop/0]). +-export([terminate/3,code_change/4,init/1]). +-export([on/3,off/3]). + +name() -> pushbutton_statem. % The registered server name +callback_mode() -> state_functions. + +%% API. This example uses a registered name name() +%% and does not link to the caller. +start() -> + gen_statem:start({local,name()}, ?MODULE, [], []). +push() -> + gen_statem:call(name(), push). +get_count() -> + gen_statem:call(name(), get_count). +stop() -> + gen_statem:stop(name()). + +%% Mandatory callback functions +terminate(_Reason, _State, _Data) -> + void. +code_change(_Vsn, State, Data, _Extra) -> + {callback_mode(),State,Data}. +init([]) -> + %% Set the callback mode and initial state + data. + %% Data is used only as a counter. + State = off, Data = 0, + {callback_mode(),State,Data}. + + +%%% State functions + +off({call,From}, push, Data) -> + %% Go to 'on', increment count and reply + %% that the resulting status is 'on' + {next_state,on,Data+1,[{reply,From,on}]}; +off(EventType, EventContent, Data) -> + handle_event(EventType, EventContent, Data). + +on({call,From}, push, Data) -> + %% Go to 'off' and reply that the resulting status is 'off' + {next_state,off,Data,[{reply,From,off}]}; +on(EventType, EventContent, Data) -> + handle_event(EventType, EventContent, Data). + +%% Handle events common to all states +handle_event({call,From}, get_count, Data) -> + %% Reply with the current count + {keep_state,Data,[{reply,From,Data}]}; +handle_event(_, _, Data) -> + %% Ignore all other events + {keep_state,Data}. + </code> + <p>And this is a shell session when running it:</p> + <pre> +1> pushbutton:start(). +{ok,<0.36.0>} +2> pushbutton:get_count(). +0 +3> pushbutton:push(). +on +4> pushbutton:get_count(). +1 +5> pushbutton:push(). +off +6> pushbutton:get_count(). +1 +7> pushbutton:stop(). +ok +8> pushbutton:push(). +** exception exit: {noproc,{gen_statem,call,[pushbutton_statem,push,infinity]}} + in function gen:do_for_proc/2 (gen.erl, line 261) + in call from gen_statem:call/3 (gen_statem.erl, line 386) + </pre> + + <p> + And just to compare styles here is the same example using + <seealso marker="#type-callback_mode"><em>callback mode</em></seealso> + <c>state_functions</c>, or rather here is code to replace + from the <c>init/1</c> function of the <c>pushbutton.erl</c> + example file above: + </p> + <code type="erl"> +init([]) -> + %% Set the callback mode and initial state + data. + %% Data is used only as a counter. + State = off, Data = 0, + {handle_event_function,State,Data}. + + +%%% Event handling + +handle_event({call,From}, push, off, Data) -> + %% Go to 'on', increment count and reply + %% that the resulting status is 'on' + {next_state,on,Data+1,[{reply,From,on}]}; +handle_event({call,From}, push, on, Data) -> + %% Go to 'off' and reply that the resulting status is 'off' + {next_state,off,Data,[{reply,From,off}]}; +%% +%% Event handling common to all states +handle_event({call,From}, get_count, State, Data) -> + %% Reply with the current count + {next_state,State,Data,[{reply,From,Data}]}; +handle_event(_, _, State, Data) -> + %% Ignore all other events + {next_state,State,Data}. + </code> + </section> + + <datatypes> + <datatype> + <name name="server_name" /> + <desc> + <p> + Name specification to use when starting + a <c>gen_statem</c> server. See + <seealso marker="#start_link/3"> + <c>start_link/3</c> + </seealso> + and + <seealso marker="#type-server_ref"> + <c>server_ref()</c> + </seealso> below. + </p> + </desc> + </datatype> + <datatype> + <name name="server_ref" /> + <desc> + <p> + Server specification to use when addressing + a <c>gen_statem</c> server. + See <seealso marker="#call/2"><c>call/2</c></seealso> and + <seealso marker="#type-server_name"> + <c>server_name()</c> + </seealso> + above. + </p> + <p>It can be:</p> + <taglist> + <tag><c>pid()</c><br /> + <c>LocalName</c></tag> + <item>The <c>gen_statem</c> is locally registered.</item> + <tag><c>Name, Node</c></tag> + <item> + The <c>gen_statem</c> is locally registered + on another node. + </item> + <tag><c>GlobalName</c></tag> + <item> + The <c>gen_statem</c> is globally registered + in <seealso marker="kernel:global"><c>global</c></seealso>. + </item> + <tag><c>RegMod, ViaName</c></tag> + <item> + The <c>gen_statem</c> is registered through + an alternative process registry. + The registry callback module <c>RegMod</c> + should export the functions + <c>register_name/2</c>, <c>unregister_name/1</c>, + <c>whereis_name/1</c> and <c>send/2</c>, + which should behave like the corresponding functions + in <seealso marker="kernel:global"><c>global</c></seealso>. + Thus, <c>{via,global,GlobalName}</c> is the same as + <c>{global,GlobalName}</c>. + </item> + </taglist> + </desc> + </datatype> + <datatype> + <name name="debug_opt" /> + <desc> + <p> + Debug option that can be used when starting + a <c>gen_statem</c> server through for example + <seealso marker="#enter_loop/5"><c>enter_loop/5</c></seealso>. + </p> + <p> + For every entry in <c><anno>Dbgs</anno></c> + the corresponding function in + <seealso marker="sys"><c>sys</c></seealso> will be called. + </p> + </desc> + </datatype> + <datatype> + <name name="start_opt" /> + <desc> + <p> + Options that can be used when starting + a <c>gen_statem</c> server through for example + <seealso marker="#start_link/3"><c>start_link/3</c></seealso>. + </p> + </desc> + </datatype> + <datatype> + <name name="start_ret" /> + <desc> + <p> + Return value from the start functions for_example + <seealso marker="#start_link/3"><c>start_link/3</c></seealso>. + </p> + </desc> + </datatype> + + <datatype> + <name name="from" /> + <desc> + <p> + Destination to use when replying through for example the + <seealso marker="#type-action"> + <c>action()</c> + </seealso> + <c>{reply,From,Reply}</c> + to a process that has called the <c>gen_statem</c> server using + <seealso marker="#call/2"><c>call/2</c></seealso>. + </p> + </desc> + </datatype> + <datatype> + <name name="state" /> + <desc> + <p> + After a state change (<c>NextState =/= State</c>) + all postponed events are retried. + </p> + </desc> + </datatype> + <datatype> + <name name="state_name" /> + <desc> + <p> + If the + <seealso marker="#type-callback_mode"><em>callback mode</em></seealso> + is <c>state_functions</c>, + the state has to be of this type. + </p> + </desc> + </datatype> + <datatype> + <name name="data" /> + <desc> + <p> + A term in which the state machine implementation + should store any server data it needs. The difference between + this and the <seealso marker="#type-state"><c>state()</c></seealso> + itself is that a change in this data does not cause + postponed events to be retried. Hence if a change + in this data would change the set of events that + are handled than that data item should be made + a part of the state. + </p> + </desc> + </datatype> + <datatype> + <name name="event_type" /> + <desc> + <p> + External events are of 3 different type: + <c>{call,<anno>From</anno>}</c>, <c>cast</c> or <c>info</c>. + <seealso marker="#call/2">Calls</seealso> + (synchronous) and + <seealso marker="#cast/2">casts</seealso> + originate from the corresponding API functions. + For calls the event contain whom to reply to. + Type <c>info</c> originates from regular process messages sent + to the <c>gen_statem</c>. It is also possible for the state machine + implementation to generate events of types + <c>timeout</c> and <c>internal</c> to itself. + </p> + </desc> + </datatype> + <datatype> + <name name="callback_mode" /> + <desc> + <p> + The <em>callback mode</em> is selected when starting the + <c>gen_statem</c> using the return value from + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + or when calling + <seealso marker="#enter_loop/5"><c>enter_loop/5-7</c></seealso>, + and with the return value from + <seealso marker="#Module:code_change/4"> + <c>Module:code_change/4</c>. + </seealso> + </p> + <taglist> + <tag><c>state_functions</c></tag> + <item> + The state has to be of type + <seealso marker="#type-state_name"><c>state_name()</c></seealso> + and one callback function per state that is + <seealso marker="#Module:StateName/3"> + <c>Module:StateName/3</c> + </seealso> + is used. + </item> + <tag><c>handle_event_function</c></tag> + <item> + The state can be any term and the callback function + <seealso marker="#Module:handle_event/4"> + <c>Module:handle_event/4</c> + </seealso> + is used for all states. + </item> + </taglist> + </desc> + </datatype> + <datatype> + <name name="transition_option" /> + <desc> + <p> + Transition options may be set by + <seealso marker="#type-action">actions</seealso> + and they modify some details below in how + the state transition is done: + </p> + <list type="ordered"> + <item> + All + <seealso marker="#type-action">actions</seealso> + are processed in order of appearance. + </item> + <item> + If + <seealso marker="#type-postpone"> + <c>postpone()</c> + </seealso> + is <c>true</c> + the current event is postponed. + </item> + <item> + If the state changes the queue of incoming events + is reset to start with the oldest postponed. + </item> + <item> + All events stored with + <seealso marker="#type-action"> + <c>action()</c> + </seealso> + <c>next_event</c> + are inserted in the queue to be processed before + all other events. + </item> + <item> + If an + <seealso marker="#type-event_timeout"> + <c>event_timeout()</c> + </seealso> + is set through + <seealso marker="#type-action"> + <c>action()</c> + </seealso> + <c>timeout</c> + an event timer may be started or a timeout zero event + may be enqueued. + </item> + <item> + The (possibly new) + <seealso marker="#state_function">state function</seealso> + is called with the oldest enqueued event if there is any, + otherwise the <c>gen_statem</c> goes into <c>receive</c> + or hibernation + (if + <seealso marker="#type-hibernate"> + <c>hibernate()</c> + </seealso> + is <c>true</c>) + to wait for the next message. In hibernation the next + non-system event awakens the <c>gen_statem</c>, or rather + the next incoming message awakens the <c>gen_statem</c> + but if it is a system event + it goes right back into hibernation. + </item> + </list> + </desc> + </datatype> + <datatype> + <name name="postpone" /> + <desc> + <p> + If <c>true</c> postpone the current event and retry + it when the state changes + (<c>NextState =/= State</c>). + </p> + </desc> + </datatype> + <datatype> + <name name="hibernate" /> + <desc> + <p> + If <c>true</c> hibernate the <c>gen_statem</c> + by calling + <seealso marker="proc_lib#hibernate/3"> + <c>proc_lib:hibernate/3</c> + </seealso> + before going into <c>receive</c> + to wait for a new external event. + If there are enqueued events, + to prevent receiving any new event; a + <seealso marker="erts:erlang#garbage_collect/0"> + <c>garbage_collect/0</c> + </seealso> is done instead to simulate + that the <c>gen_statem</c> entered hibernation + and immediately got awakened by the oldest enqueued event. + </p> + </desc> + </datatype> + <datatype> + <name name="event_timeout" /> + <desc> + <p> + Generate an event of + <seealso marker="#type-event_type"><c>event_type()</c></seealso> + <c>timeout</c> + after this time (in milliseconds) unless some other + event arrives in which case this timeout is cancelled. + Note that a retried or inserted event + counts just like a new in this respect. + </p> + <p> + If the value is <c>infinity</c> no timer is started since + it will never trigger anyway. + </p> + <p> + If the value is <c>0</c> the timeout event is immediately enqueued + unless there already are enqueued events since then the + timeout is immediately cancelled. + This is a feature ensuring that a timeout <c>0</c> event + will be processed before any not yet received external event. + </p> + <p> + Note that it is not possible nor needed to cancel this timeout + since it is cancelled automatically by any other event. + </p> + </desc> + </datatype> + <datatype> + <name name="action" /> + <desc> + <p> + These state transition actions may be invoked by + returning them from the + <seealso marker="#state_function">state function</seealso>, + from <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + or by giving them to + <seealso marker="#enter_loop/6"><c>enter_loop/6,7</c></seealso>. + </p> + <p> + Actions are executed in the containing list order. + </p> + <p> + Actions that set + <seealso marker="#type-transition_option"> + transition options + </seealso> + overrides any previous of the same type, + so the last in the containing list wins. + For example the last + <seealso marker="#type-event_timeout"> + <c>event_timeout()</c> + </seealso> + overrides any other <c>event_timeout()</c> in the list. + </p> + <taglist> + <tag><c>postpone</c></tag> + <item> + Set the + <seealso marker="#type-transition_option"> + <c>transition_option()</c> + </seealso> + <seealso marker="#type-postpone"> + <c>postpone()</c> + </seealso> + for this state transition. + This action is ignored when returned from + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + or given to + <seealso marker="#enter_loop/5"><c>enter_loop/5,6</c></seealso> + since there is no event to postpone in those cases. + </item> + <tag><c>hibernate</c></tag> + <item> + Set the + <seealso marker="#type-transition_option"> + <c>transition_option()</c> + </seealso> + <seealso marker="#type-hibernate"> + <c>hibernate()</c> + </seealso> + for this state transition. + </item> + <tag><c>Timeout</c></tag> + <item> + Short for <c>{timeout,Timeout,Timeout}</c> that is + the timeout message is the timeout time. + This form exists to make the + <seealso marker="#state_function">state function</seealso> + return value <c>{next_state,NextState,NewData,Timeout}</c> + allowed like for + <seealso marker="gen_fsm#Module:StateName/2"> + <c>gen_fsm Module:StateName/2</c>. + </seealso> + </item> + <tag><c>timeout</c></tag> + <item> + Set the + <seealso marker="#type-transition_option"> + <c>transition_option()</c> + </seealso> + <seealso marker="#type-event_timeout"> + <c>event_timeout()</c> + </seealso> + to <c><anno>Time</anno></c> with <c><anno>EventContent</anno></c>. + </item> + <tag><c>reply_action()</c></tag> + <item>Reply to a caller.</item> + <tag><c>next_event</c></tag> + <item> + Store the given <c><anno>EventType</anno></c> + and <c><anno>EventContent</anno></c> for insertion after all + actions have been executed. + </item> + <item> + <p> + The stored events are inserted in the queue as the next to process + before any already queued events. The order of these stored events + is preserved so the first <c>next_event</c> in the containing list + will become the first to process. + </p> + </item> + <item> + <p> + An event of type + <seealso marker="#type-event_type"> + <c>internal</c> + </seealso> + should be used when you want to reliably distinguish + an event inserted this way from any external event. + </p> + </item> + </taglist> + </desc> + </datatype> + <datatype> + <name name="reply_action" /> + <desc> + <p> + Reply to a caller waiting for a reply in + <seealso marker="#call/2"><c>call/2</c></seealso>. + <c><anno>From</anno></c> must be the term from the + <seealso marker="#type-event_type"> + <c>{call,<anno>From</anno>}</c> + </seealso> + argument to the + <seealso marker="#state_function">state function</seealso>. + </p> + </desc> + </datatype> + <datatype> + <name name="state_function_result" /> + <desc> + <taglist> + <tag><c>next_state</c></tag> + <item> + The <c>gen_statem</c> will do a state transition to + <c><anno>NextStateName</anno></c> + (which may be the same as the current state), + set <c><anno>NewData</anno></c> + and execute all <c><anno>Actions</anno></c> + </item> + </taglist> + <p> + All these terms are tuples or atoms and this property + will hold in any future version of <c>gen_statem</c>, + just in case you need such a promise. + </p> + </desc> + </datatype> + <datatype> + <name name="handle_event_result" /> + <desc> + <taglist> + <tag><c>next_state</c></tag> + <item> + The <c>gen_statem</c> will do a state transition to + <c><anno>NextState</anno></c> + (which may be the same as the current state), + set <c><anno>NewData</anno></c> + and execute all <c><anno>Actions</anno></c> + </item> + </taglist> + <p> + All these terms are tuples or atoms and this property + will hold in any future version of <c>gen_statem</c>, + just in case you need such a promise. + </p> + </desc> + </datatype> + <datatype> + <name name="common_state_callback_result" /> + <desc> + <taglist> + <tag><c>stop</c></tag> + <item> + Terminate the <c>gen_statem</c> by calling + <seealso marker="#Module:terminate/3"> + <c>Module:terminate/3</c> + </seealso> + with <c>Reason</c> and + <c><anno>NewData</anno></c>, if given. + </item> + <tag><c>stop_and_reply</c></tag> + <item> + Send all <c><anno>Replies</anno></c> + then terminate the <c>gen_statem</c> by calling + <seealso marker="#Module:terminate/3"> + <c>Module:terminate/3</c> + </seealso> + with <c>Reason</c> and + <c><anno>NewData</anno></c>, if given. + </item> + <tag><c>keep_state</c></tag> + <item> + The <c>gen_statem</c> will keep the current state, or + do a state transition to the current state if you like, + set <c><anno>NewData</anno></c> + and execute all <c><anno>Actions</anno></c>. + This is the same as + <c>{next_state,CurrentState,<anno>NewData</anno>,<anno>Actions</anno>}</c>. + </item> + <tag><c>keep_state_and_data</c></tag> + <item> + The <c>gen_statem</c> will keep the current state or + do a state transition to the current state if you like, + keep the current server data, + and execute all <c><anno>Actions</anno></c>. + This is the same as + <c>{next_state,CurrentState,CurrentData,<anno>Actions</anno>}</c>. + </item> + </taglist> + <p> + All these terms are tuples or atoms and this property + will hold in any future version of <c>gen_statem</c>, + just in case you need such a promise. + </p> + </desc> + </datatype> + </datatypes> + + <funcs> + + <func> + <name name="start_link" arity="3" /> + <name name="start_link" arity="4" /> + <fsummary>Create a linked <c>gen_statem</c> process</fsummary> + <desc> + <p> + Creates a <c>gen_statem</c> process according + to OTP design principles + (using + <seealso marker="proc_lib"><c>proc_lib</c></seealso> + primitives) + that is linked to the calling process. + This is essential when the <c>gen_statem</c> shall be part of + a supervision tree so it gets linked to its supervisor. + </p> + <p> + The <c>gen_statem</c> process calls + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + to initialize the server. To ensure a synchronized start-up + procedure, <c>start_link/3,4</c> does not return until + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + has returned. + </p> + <p> + <c><anno>ServerName</anno></c> specifies the + <seealso marker="#type-server_name"> + <c>server_name()</c> + </seealso> + to register for the <c>gen_statem</c>. + If the <c>gen_statem</c> is started with <c>start_link/3</c> + no <c><anno>ServerName</anno></c> is provided and + the <c>gen_statem</c> is not registered. + </p> + <p><c><anno>Module</anno></c> is the name of the callback module.</p> + <p> + <c><anno>Args</anno></c> is an arbitrary term which is passed as + the argument to + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso>. + </p> + <p> + If the option <c>{timeout,Time}</c> is present in + <c><anno>Opts</anno></c>, the <c>gen_statem</c> + is allowed to spend <c>Time</c> milliseconds initializing + or it will be terminated and the start function will return + <seealso marker="#type-start_ret"><c>{error,timeout}</c></seealso>. + </p> + <p> + If the option + <seealso marker="#type-debug_opt"><c>{debug,Dbgs}</c></seealso> + is present in <c><anno>Opts</anno></c>, debugging through + <seealso marker="sys"><c>sys</c></seealso> is activated. + </p> + <p> + If the option <c>{spawn_opt,SpawnOpts}</c> is present in + <c><anno>Opts</anno></c>, <c>SpawnOpts</c> will be passed + as option list to + <seealso marker="erts:erlang#spawn_opt/2"><c>spawn_opt/2</c></seealso> + which is used to spawn the <c>gen_statem</c> process. + </p> + <note> + <p> + Using the spawn option <c>monitor</c> is currently not + allowed, but will cause this function to fail with reason + <c>badarg</c>. + </p> + </note> + <p> + If the <c>gen_statem</c> is successfully created + and initialized this function returns + <seealso marker="#type-start_ret"> + <c>{ok,Pid}</c>, + </seealso> + where <c>Pid</c> is the <c>pid()</c> + of the <c>gen_statem</c>. + If there already exists a process with the specified + <c><anno>ServerName</anno></c> this function returns + <seealso marker="#type-start_ret"><c>{error,{already_started,Pid}}</c></seealso>, + where <c>Pid</c> is the <c>pid()</c> of that process. + </p> + <p> + If <c>Module:init/1</c> fails with <c>Reason</c>, + this function returns + <seealso marker="#type-start_ret"><c>{error,Reason}</c></seealso>. + If <c>Module:init/1</c> returns + <seealso marker="#type-start_ret"> + <c>{stop,Reason}</c> + </seealso> + or + <seealso marker="#type-start_ret"><c>ignore</c></seealso>, + the process is terminated and this function + returns + <seealso marker="#type-start_ret"> + <c>{error,Reason}</c> + </seealso> + or + <seealso marker="#type-start_ret"><c>ignore</c></seealso>, + respectively. + </p> + </desc> + </func> + + + <func> + <name name="start" arity="3" /> + <name name="start" arity="4" /> + <fsummary>Create a stand-alone <c>gen_statem</c> process</fsummary> + <desc> + <p> + Creates a stand-alone <c>gen_statem</c> process according to + OTP design principles (using + <seealso marker="proc_lib"><c>proc_lib</c></seealso> + primitives). + Since it does not get linked to the calling process + this start function can not be used by a supervisor + to start a child. + </p> + <p> + See <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso> + for a description of arguments and return values. + </p> + </desc> + </func> + + <func> + <name name="stop" arity="1" /> + <fsummary>Synchronously stop a generic server</fsummary> + <desc> + <p> + The same as + <seealso marker="#stop/3"> + <c>stop(<anno>ServerRef</anno>, normal, infinity)</c>. + </seealso> + </p> + </desc> + </func> + <func> + <name name="stop" arity="3" /> + <fsummary>Synchronously stop a generic server</fsummary> + <desc> + <p> + Orders the <c>gen_statem</c> + <seealso marker="#type-server_ref"> + <c><anno>ServerRef</anno></c> + </seealso> + to exit with the given <c><anno>Reason</anno></c> + and waits for it to terminate. + The <c>gen_statem</c> will call + <seealso marker="#Module:terminate/3"> + <c>Module:terminate/3</c> + </seealso> + before exiting. + </p> + <p> + This 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 through + <seealso marker="kernel:error_logger#format/2"> + <c>error_logger:format/2</c>. + </seealso> + The default <c><anno>Reason</anno></c> is <c>normal</c>. + </p> + <p> + <c><anno>Timeout</anno></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 name="call" arity="2" /> + <name name="call" arity="3" /> + <fsummary>Make a synchronous call to a <c>gen_statem</c></fsummary> + <desc> + <p> + Makes a synchronous call to the <c>gen_statem</c> + <seealso marker="#type-server_ref"> + <c><anno>ServerRef</anno></c> + </seealso> + by sending a request + and waiting until its reply arrives. + The <c>gen_statem</c> will call the + <seealso marker="#state_function">state function</seealso> with + <seealso marker="#type-event_type"><c>event_type()</c></seealso> + <c>{call,From}</c> and event content + <c><anno>Request</anno></c>. + </p> + <p> + A <c><anno>Reply</anno></c> is generated when a + <seealso marker="#state_function">state function</seealso> + returns with + <c>{reply,From,<anno>Reply</anno>}</c> as one + <seealso marker="#type-action"><c>action()</c></seealso>, + and that <c><anno>Reply</anno></c> becomes the return value + of this function. + </p> + <p> + <c><anno>Timeout</anno></c> is an integer greater than zero + which specifies how many milliseconds to wait for a reply, + or the atom <c>infinity</c> to wait indefinitely, + which is the default. If no reply is received within + the specified time, the function call fails. + </p> + <note> + <p> + To avoid getting a late reply in the caller's + inbox this function spawns a proxy process that + does the call. A late reply gets delivered to the + dead proxy process hence gets discarded. This is + less efficient than using + <c><anno>Timeout</anno> =:= infinity</c>. + </p> + </note> + <p> + The call may fail for example if the <c>gen_statem</c> dies + before or during this function call. + </p> + </desc> + </func> + + <func> + <name name="cast" arity="2" /> + <fsummary>Send an asynchronous event to a <c>gen_statem</c></fsummary> + <desc> + <p> + Sends an asynchronous event to the <c>gen_statem</c> + <seealso marker="#type-server_ref"> + <c><anno>ServerRef</anno></c> + </seealso> + and returns <c>ok</c> immediately, + ignoring if the destination node or <c>gen_statem</c> + does not exist. + The <c>gen_statem</c> will call the + <seealso marker="#state_function">state function</seealso> with + <seealso marker="#type-event_type"><c>event_type()</c></seealso> + <c>cast</c> and event content + <c><anno>Msg</anno></c>. + </p> + </desc> + </func> + + <func> + <name name="reply" arity="1" /> + <name name="reply" arity="2" /> + <fsummary>Reply to a caller</fsummary> + <desc> + <p> + This function can be used by a <c>gen_statem</c> + to explicitly send a reply to a process that waits in + <seealso marker="#call/2"><c>call/2</c></seealso> + when the reply cannot be defined in + the return value of a + <seealso marker="#state_function">state function</seealso>. + </p> + <p> + <c><anno>From</anno></c> must be the term from the + <seealso marker="#type-event_type"> + <c>{call,<anno>From</anno>}</c> + </seealso> + argument to the + <seealso marker="#state_function">state function</seealso>. + <c><anno>From</anno></c> and <c><anno>Reply</anno></c> + can also be specified using a + <seealso marker="#type-reply_action"> + <c>reply_action()</c> + </seealso> + and multiple replies with a list of them. + </p> + <note> + <p> + A reply sent with this function will not be visible + in <seealso marker="sys"><c>sys</c></seealso> debug output. + </p> + </note> + </desc> + </func> + + <func> + <name name="enter_loop" arity="5" /> + <fsummary>Enter the <c>gen_statem</c> receive loop</fsummary> + <desc> + <p> + The same as + <seealso marker="#enter_loop/7"><c>enter_loop/7</c></seealso> + except that no + <seealso marker="#type-server_name"> + <c>server_name()</c> + </seealso> + must have been registered. + </p> + </desc> + </func> + <func> + <name name="enter_loop" arity="6" /> + <fsummary>Enter the <c>gen_statem</c> receive loop</fsummary> + <desc> + <p> + If <c><anno>Server_or_Actions</anno></c> is a <c>list()</c> + the same as + <seealso marker="#enter_loop/7"><c>enter_loop/7</c></seealso> + except that no + <seealso marker="#type-server_name"> + <c>server_name()</c> + </seealso> + must have been registered and + <c>Actions = <anno>Server_or_Actions</anno></c>. + </p> + <p> + Otherwise the same as + <seealso marker="#enter_loop/7"><c>enter_loop/7</c></seealso> + with + <c>Server = <anno>Server_or_Actions</anno></c> and + <c>Actions = []</c>. + </p> + </desc> + </func> + <func> + <name name="enter_loop" arity="7" /> + <fsummary>Enter the <c>gen_statem</c> receive loop</fsummary> + <desc> + <p> + Makes an the calling process become a <c>gen_statem</c>. + Does not return, instead the calling process will enter + the <c>gen_statem</c> receive loop and become + a <c>gen_statem</c> server. + The process <em>must</em> have been started + using one of the start functions in + <seealso marker="proc_lib"><c>proc_lib</c></seealso>. + The user is responsible for any initialization of the process, + including registering a name for it. + </p> + <p> + This function is useful when a more complex initialization + procedure is needed than + the <c>gen_statem</c> behaviour provides. + </p> + <p> + <c><anno>Module</anno></c>, <c><anno>Opts</anno></c> and + <c><anno>Server</anno></c> have the same meanings + as when calling + <seealso marker="#start_link/3"> + <c>gen_statem:start[_link]/3,4</c>. + </seealso> + However, the + <seealso marker="#type-server_name"> + <c>server_name()</c> + </seealso> + name must have been registered accordingly + <em>before</em> this function is called.</p> + <p> + <c><anno>CallbackMode</anno></c>, <c><anno>State</anno></c>, + <c><anno>Data</anno></c> and <c><anno>Actions</anno></c> + have the same meanings as in the return value of + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso>. + Also, the callback module <c><anno>Module</anno></c> + does not need to export an <c>init/1</c> function. + </p> + <p> + Failure: If the calling process was not started by a + <seealso marker="proc_lib"><c>proc_lib</c></seealso> + start function, or if it is not registered + according to + <seealso marker="#type-server_name"><c>server_name()</c></seealso>. + </p> + </desc> + </func> + + </funcs> + + + + <section> + <title>CALLBACK FUNCTIONS</title> + <p> + The following functions should be exported from a + <c>gen_statem</c> callback module. + </p> + </section> + <funcs> + + <func> + <name>Module:init(Args) -> Result</name> + <fsummary>Initialize process and internal state</fsummary> + <type> + <v>Args = term()</v> + <v>Result = {CallbackMode,State,Data}</v> + <v> | {CallbackMode,State,Data,Actions}</v> + <v> | {stop,Reason} | ignore</v> + <v> + CallbackMode = + <seealso marker="#type-callback_mode">callback_mode()</seealso> + </v> + <v>State = <seealso marker="#type-state">state()</seealso></v> + <v> + Data = <seealso marker="#type-data">data()</seealso> + </v> + <v> + Actions = + [<seealso marker="#type-action">action()</seealso>] | + <seealso marker="#type-action">action()</seealso> + </v> + <v>Reason = term()</v> + </type> + <desc> + <marker id="Module:init-1" /> + <p> + Whenever a <c>gen_statem</c> is started using + <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso> + or + <seealso marker="#start/3"><c>start/3,4</c></seealso>, + this function is called by the new process to initialize + the implementation state and server data. + </p> + <p> + <c>Args</c> is the <c>Args</c> argument provided to the start + function. + </p> + <p> + If the initialization is successful, the function should + return <c>{CallbackMode,State,Data}</c> or + <c>{CallbackMode,State,Data,Actions}</c>. + <c>CallbackMode</c> selects the + <seealso marker="#type-callback_mode"><em>callback mode</em></seealso>. + of the <c>gen_statem</c>. + <c>State</c> is the initial + <seealso marker="#type-state"><c>state()</c></seealso> + and <c>Data</c> the initial server + <seealso marker="#type-data"><c>data()</c></seealso>. + </p> + <p> + The <seealso marker="#type-action"><c>Actions</c></seealso> + are executed when entering the first + <seealso marker="#type-state">state</seealso> just as for a + <seealso marker="#state_function">state function</seealso>. + </p> + <p> + If something goes wrong during the initialization + the function should return <c>{stop,Reason}</c> + or <c>ignore</c>. See + <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>. + </p> + <p> + This function may use + <seealso marker="erts:erlang#throw/1"><c>throw/1</c></seealso> + to return <c>Result</c>. + </p> + </desc> + </func> + + <func> + <name>Module:StateName(EventType, EventContent, Data) -> + StateFunctionResult + </name> + <name>Module:handle_event(EventType, EventContent, + State, Data) -> HandleEventResult + </name> + <fsummary>Handle an event</fsummary> + <type> + <v> + EventType = + <seealso marker="#type-event_type">event_type()</seealso> + </v> + <v>EventContent = term()</v> + <v> + State = + <seealso marker="#type-state">state()</seealso> + </v> + <v> + Data = NewData = + <seealso marker="#type-data">data()</seealso> + </v> + <v> + StateFunctionResult = + <seealso marker="#type-state_function_result"> + state_function_result() + </seealso> + </v> + <v> + HandleEventResult = + <seealso marker="#type-handle_event_result"> + handle_event_result() + </seealso> + </v> + </type> + <desc> + <p> + Whenever a <c>gen_statem</c> receives an event from + <seealso marker="#call/2"><c>call/2</c></seealso>, + <seealso marker="#cast/2"><c>cast/2</c></seealso> or + as a normal process message one of these functions is called. If + <seealso marker="#type-callback_mode"><em>callback mode</em></seealso> + is <c>state_functions</c> then <c>Module:StateName/3</c> is called, + and if it is <c>handle_event_function</c> + then <c>Module:handle_event/4</c> is called. + </p> + <p> + If <c>EventType</c> is + <seealso marker="#type-event_type"><c>{call,From}</c></seealso> + the caller is waiting for a reply. The reply can be sent + from this or from any other + <seealso marker="#state_function">state function</seealso> + by returning with <c>{reply,From,Reply}</c> in + <seealso marker="#type-action"><c>Actions</c></seealso>, in + <seealso marker="#type-reply_action"><c>Replies</c></seealso> + or by calling + <seealso marker="#reply/2"><c>reply(From, Reply)</c></seealso>. + </p> + <p> + If this function returns with a next state that + does not match equal (<c>=/=</c>) to the current state + all postponed events will be retried in the next state. + </p> + <p> + The only difference between <c>StateFunctionResult</c> and + <c>HandleEventResult</c> is that for <c>StateFunctionResult</c> + the next state has to be an atom but for <c>HandleEventResult</c> + there is no restriction on the next state. + </p> + <p> + See <seealso marker="#type-action"><c>action()</c></seealso> + for options that can be set and actions that can be done + by <c>gen_statem</c> after returning from this function. + </p> + <p> + These functions may use + <seealso marker="erts:erlang#throw/1"><c>throw/1</c></seealso>, + to return the result. + </p> + </desc> + </func> + + <func> + <name>Module:terminate(Reason, State, Data) -> Ignored</name> + <fsummary>Clean up before termination</fsummary> + <type> + <v>Reason = normal | shutdown | {shutdown,term()} | term()</v> + <v>State = <seealso marker="#type-state">state()</seealso></v> + <v>Data = <seealso marker="#type-data">data()</seealso></v> + <v>Ignored = term()</v> + </type> + <desc> + <p> + This function is called by a <c>gen_statem</c> + when it is about to terminate. It should be the opposite of + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + and do any necessary cleaning up. When it returns, + the <c>gen_statem</c> terminates with <c>Reason</c>. The return + value is ignored.</p> + <p> + <c>Reason</c> is a term denoting the stop reason and + <seealso marker="#type-state"><c>State</c></seealso> + is the internal state of the <c>gen_statem</c>. + </p> + <p> + <c>Reason</c> depends on why the <c>gen_statem</c> + is terminating. + If it is because another callback function has returned a + stop tuple <c>{stop,Reason}</c> in + <seealso marker="#type-action"><c>Actions</c></seealso>, + <c>Reason</c> will have the value specified in that tuple. + If it is due to a failure, <c>Reason</c> is the error reason. + </p> + <p> + If the <c>gen_statem</c> is part of a supervision tree and is + ordered by its supervisor to terminate, this function will be + called with <c>Reason = shutdown</c> if the following + conditions apply:</p> + <list type="bulleted"> + <item> + the <c>gen_statem</c> has been set + to trap exit signals, and + </item> + <item> + the shutdown strategy as defined in the supervisor's + child specification is an integer timeout value, not + <c>brutal_kill</c>. + </item> + </list> + <p> + Even if the <c>gen_statem</c> is <em>not</em> + part of a supervision tree, this function will be called + if it receives an <c>'EXIT'</c> message from its parent. + <c>Reason</c> will be the same as + in the <c>'EXIT'</c> message. + </p> + <p> + Otherwise, the <c>gen_statem</c> will be immediately terminated. + </p> + <p> + Note that for any other reason than <c>normal</c>, + <c>shutdown</c>, or <c>{shutdown,Term}</c> + the <c>gen_statem</c> is assumed to terminate due to an error + and an error report is issued using + <seealso marker="kernel:error_logger#format/2"> + <c>error_logger:format/2</c>. + </seealso> + </p> + <p> + This function may use + <seealso marker="erts:erlang#throw/1"><c>throw/1</c></seealso> + to return <c>Ignored</c>, which is ignored anyway. + </p> + </desc> + </func> + + <func> + <name>Module:code_change(OldVsn, OldState, OldData, Extra) -> + Result + </name> + <fsummary>Update the internal state during upgrade/downgrade</fsummary> + <type> + <v>OldVsn = Vsn | {down,Vsn}</v> + <v> Vsn = term()</v> + <v>OldState = NewState = term()</v> + <v>Extra = term()</v> + <v>Result = {NewCallbackMode,NewState,NewData} | Reason</v> + <v> + NewCallbackMode = + <seealso marker="#type-callback_mode">callback_mode()</seealso> + </v> + <v> + OldState = NewState = + <seealso marker="#type-state">state()</seealso> + </v> + <v> + OldData = NewData = + <seealso marker="#type-data">data()</seealso> + </v> + <v>Reason = term()</v> + </type> + <desc> + <p> + This function is called by a <c>gen_statem</c> when it should + update its internal state during a release upgrade/downgrade, + that is when the instruction <c>{update,Module,Change,...}</c> + where <c>Change={advanced,Extra}</c> is given in the + <seealso marker="sasl:appup"><c>appup</c></seealso> + file. See + <seealso marker="doc/design_principles:release_handling#instr"> + OTP Design Principles + </seealso> + for more information. + </p> + <p> + In the case of an upgrade, <c>OldVsn</c> is <c>Vsn</c>, and + in the case of a downgrade, <c>OldVsn</c> is + <c>{down,Vsn}</c>. <c>Vsn</c> is defined by the <c>vsn</c> + attribute(s) of the old version of the callback module + <c>Module</c>. If no such attribute is defined, the version + is the checksum of the BEAM file. + </p> + <note> + <p> + If you would dare to change + <seealso marker="#type-callback_mode"> + <em>callback mode</em> + </seealso> + during release upgrade/downgrade, the upgrade is no problem + since the new code surely knows what <em>callback mode</em> + it needs, but for a downgrade this function will have to + know from the <c>Extra</c> argument that comes from the + <seealso marker="sasl:appup"><c>appup</c></seealso> + file what <em>callback mode</em> the old code did use. + It may also be possible to figure this out + from the <c>{down,Vsn}</c> argument since <c>Vsn</c> + in effect defines the old callback module version. + </p> + </note> + <p> + <c>OldState</c> and <c>OldData</c> is the internal state + of the <c>gen_statem</c>. + </p> + <p> + <c>Extra</c> is passed as-is from the <c>{advanced,Extra}</c> + part of the update instruction. + </p> + <p> + If successful, the function shall return the updated + internal state in an + <c>{NewCallbackMode,NewState,NewData}</c> tuple. + </p> + <p> + If the function returns <c>Reason</c>, the ongoing + upgrade will fail and roll back to the old release.</p> + <p> + This function may use + <seealso marker="erts:erlang#throw/1"><c>throw/1</c></seealso> + to return <c>Result</c> or <c>Reason</c>. + </p> + </desc> + </func> + + <func> + <name>Module:format_status(Opt, [PDict,State,Data]) -> + Status + </name> + <fsummary>Optional function for providing a term describing the + current <c>gen_statem</c> status</fsummary> + <type> + <v>Opt = normal | terminate</v> + <v>PDict = [{Key, Value}]</v> + <v> + State = + <seealso marker="#type-state">state()</seealso> + </v> + <v> + Data = + <seealso marker="#type-data">data()</seealso> + </v> + <v>Key = term()</v> + <v>Value = term()</v> + <v>Status = term()</v> + </type> + <desc> + <note> + <p> + This callback is optional, so a callback module need not + export it. The <c>gen_statem</c> module provides a default + implementation of this function that returns + <c>{State,Data}</c>. If this callback fails the default + function will return <c>{State,Info}</c> + where <c>Info</c> informs of the crash but no details, + to hide possibly sensitive data. + </p> + </note> + <p>This function is called by a <c>gen_statem</c> process when:</p> + <list type="bulleted"> + <item> + One of + <seealso marker="sys#get_status/1"> + <c>sys:get_status/1,2</c> + </seealso> + is invoked to get the <c>gen_statem</c> status. <c>Opt</c> is set + to the atom <c>normal</c> for this case. + </item> + <item> + The <c>gen_statem</c> terminates abnormally and logs an error. + <c>Opt</c> is set to the atom <c>terminate</c> for this case. + </item> + </list> + <p> + This function is useful for customising the form and + appearance of the <c>gen_statem</c> status for these cases. A + callback module wishing to customise the + <seealso marker="sys#get_status/1"> + <c>sys:get_status/1,2</c> + </seealso> + return value as well as how + its status appears in termination error logs exports an + instance of <c>format_status/2</c> that returns a term + describing the current status of the <c>gen_statem</c>. + </p> + <p> + <c>PDict</c> is the current value of the <c>gen_statem</c>'s + process dictionary. + </p> + <p> + <seealso marker="#type-state"><c>State</c></seealso> + is the internal state of the <c>gen_statem</c>. + </p> + <p> + <seealso marker="#type-data"><c>Data</c></seealso> + is the internal server data of the <c>gen_statem</c>. + </p> + <p> + The function should return <c>Status</c>, a term that + customises the details of the current state and status of + the <c>gen_statem</c>. There are no restrictions on the + form <c>Status</c> can take, but for the + <seealso marker="sys#get_status/1"> + <c>sys:get_status/1,2</c> + </seealso> + case (when <c>Opt</c> + is <c>normal</c>), the recommended form for + the <c>Status</c> value is <c>[{data, [{"State", + Term}]}]</c> where <c>Term</c> provides relevant details of + the <c>gen_statem</c> state. Following this recommendation isn't + required, but doing so will make the callback module status + consistent with the rest of the + <seealso marker="sys#get_status/1"> + <c>sys:get_status/1,2</c> + </seealso> + return value. + </p> + <p> + One use for this function is to return compact alternative + state representations to avoid having large state terms + printed in logfiles. Another is to hide sensitive data from + being written to the error log. + </p> + <p> + This function may use + <seealso marker="erts:erlang#throw/1"><c>throw/1</c></seealso> + to return <c>Status</c>. + </p> + </desc> + </func> + + </funcs> + + <section> + <title>SEE ALSO</title> + <p><seealso marker="gen_event"><c>gen_event(3)</c></seealso>, + <seealso marker="gen_fsm"><c>gen_fsm(3)</c></seealso>, + <seealso marker="gen_server"><c>gen_server(3)</c></seealso>, + <seealso marker="supervisor"><c>supervisor(3)</c></seealso>, + <seealso marker="proc_lib"><c>proc_lib(3)</c></seealso>, + <seealso marker="sys"><c>sys(3)</c></seealso></p> + </section> +</erlref> diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index a8435efc6f..03d0063599 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -262,6 +262,21 @@ flatmap(Fun, List1) -> </desc> </func> <func> + <name name="join" arity="2"/> + <fsummary>Insert an element between elements in a list</fsummary> + <desc> + <p>Inserts <c><anno>Sep</anno></c> between each element in <c><anno>List1</anno></c>. Has no + effect on the empty list and on a singleton list. For example:</p> + <pre> +> <input>lists:join(x, [a,b,c]).</input> +[a,x,b,x,c] +> <input>lists:join(x, [a]).</input> +[a] +> <input>lists:join(x, []).</input> +[]</pre> + </desc> + </func> + <func> <name name="foreach" arity="2"/> <fsummary>Apply a function to each element of a list</fsummary> <desc> diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml index 0f58f19421..bf45461e2b 100644 --- a/lib/stdlib/doc/src/maps.xml +++ b/lib/stdlib/doc/src/maps.xml @@ -301,6 +301,30 @@ false</code> </func> <func> + <name name="take" arity="2"/> + <fsummary></fsummary> + <desc> + <p> + The function removes the <c><anno>Key</anno></c>, if it exists, and its associated value from + <c><anno>Map1</anno></c> and returns a tuple with the removed <c><anno>Value</anno></c> and + the new map <c><anno>Map2</anno></c> without key <c><anno>Key</anno></c>. + If the key does not exist <c>error</c> is returned. + </p> + <p> + The call will fail with a <c>{badmap,Map}</c> exception if <c><anno>Map1</anno></c> is not a map. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{"a" => "hello", "b" => "world"}. +#{"a" => "hello", "b" => "world"} +> maps:take("a",Map). +{"hello",#{"b" => "world"}} +> maps:take("does not exist",Map). +error</code> + </desc> + </func> + + <func> <name name="size" arity="1"/> <fsummary></fsummary> <desc> @@ -357,6 +381,42 @@ false</code> </desc> </func> + <func> + <name name="update_with" arity="3"/> + <fsummary></fsummary> + <desc> + <p>Update a value in a <c><anno>Map1</anno></c> associated with <c><anno>Key</anno></c> by + calling <c><anno>Fun</anno></c> on the old value to get a new value. An exception + <c>{badkey,<anno>Key</anno>}</c> is generated if + <c><anno>Key</anno></c> is not present in the map.</p> + <p>Example:</p> + <code type="none"> +> Map = #{"counter" => 1}, + Fun = fun(V) -> V + 1 end, + maps:update_with("counter",Fun,Map). +#{"counter" => 2}</code> + </desc> + </func> + + <func> + <name name="update_with" arity="4"/> + <fsummary></fsummary> + <desc> + <p>Update a value in a <c><anno>Map1</anno></c> associated with <c><anno>Key</anno></c> by + calling <c><anno>Fun</anno></c> on the old value to get a new value. + If <c><anno>Key</anno></c> is not present + in <c><anno>Map1</anno></c> then <c><anno>Init</anno></c> will be associated with + <c><anno>Key</anno></c>. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{"counter" => 1}, + Fun = fun(V) -> V + 1 end, + maps:update_with("new counter",Fun,42,Map). +#{"counter" => 1,"new counter" => 42}</code> + </desc> + </func> + <func> <name name="values" arity="1"/> <fsummary></fsummary> diff --git a/lib/stdlib/doc/src/proc_lib.xml b/lib/stdlib/doc/src/proc_lib.xml index bef037076b..245580b1ba 100644 --- a/lib/stdlib/doc/src/proc_lib.xml +++ b/lib/stdlib/doc/src/proc_lib.xml @@ -34,9 +34,9 @@ <p>This module is used to start processes adhering to the <seealso marker="doc/design_principles:des_princ">OTP Design Principles</seealso>. Specifically, the functions in this module are used by the OTP standard behaviors (<c>gen_server</c>, - <c>gen_fsm</c>, ...) when starting new processes. The functions - can also be used to start <em>special processes</em>, user - defined processes which comply to the OTP design principles. See + <c>gen_fsm</c>, <c>gen_statem</c>, ...) when starting new processes. + The functions can also be used to start <em>special processes</em>, + user defined processes which comply to the OTP design principles. See <seealso marker="doc/design_principles:spec_proc">Sys and Proc_Lib</seealso> in OTP Design Principles for an example.</p> <p>Some useful information is initialized when a process starts. The registered names, or the process identifiers, of the parent diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index 82ad78e675..404873ea32 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -4,7 +4,7 @@ <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1996</year><year>2015</year> + <year>1996</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -66,6 +66,7 @@ <xi:include href="gen_event.xml"/> <xi:include href="gen_fsm.xml"/> <xi:include href="gen_server.xml"/> + <xi:include href="gen_statem.xml"/> <xi:include href="io.xml"/> <xi:include href="io_lib.xml"/> <xi:include href="lib.xml"/> diff --git a/lib/stdlib/doc/src/specs.xml b/lib/stdlib/doc/src/specs.xml index 0418bf7b22..45b207b13d 100644 --- a/lib/stdlib/doc/src/specs.xml +++ b/lib/stdlib/doc/src/specs.xml @@ -30,6 +30,7 @@ <xi:include href="../specs/specs_gen_event.xml"/> <xi:include href="../specs/specs_gen_fsm.xml"/> <xi:include href="../specs/specs_gen_server.xml"/> + <xi:include href="../specs/specs_gen_statem.xml"/> <xi:include href="../specs/specs_io.xml"/> <xi:include href="../specs/specs_io_lib.xml"/> <xi:include href="../specs/specs_lib.xml"/> diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 421306283c..29e5a732d5 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -34,8 +34,8 @@ <p>A behaviour module for implementing a supervisor, a process which supervises other processes called child processes. A child process can either be another supervisor or a worker process. - Worker processes are normally implemented using one of - the <c>gen_event</c>, <c>gen_fsm</c>, or <c>gen_server</c> + Worker processes are normally implemented using one of the + <c>gen_event</c>, <c>gen_fsm</c>, <c>gen_statem</c> or <c>gen_server</c> behaviours. A supervisor implemented using this module will have a standard set of interface functions and include functionality for tracing and error reporting. Supervisors are used to build a @@ -221,7 +221,8 @@ <p><c>modules</c> is used by the release handler during code replacement to determine which processes are using a certain module. As a rule of thumb, if the child process is a - <c>supervisor</c>, <c>gen_server</c>, or <c>gen_fsm</c>, + <c>supervisor</c>, <c>gen_server</c>, + <c>gen_fsm</c> or <c>gen_statem</c> this should be a list with one element <c>[Module]</c>, where <c>Module</c> is the callback module. If the child process is an event manager (<c>gen_event</c>) with a @@ -636,6 +637,7 @@ <title>SEE ALSO</title> <p><seealso marker="gen_event">gen_event(3)</seealso>, <seealso marker="gen_fsm">gen_fsm(3)</seealso>, + <seealso marker="gen_statem">gen_statem(3)</seealso>, <seealso marker="gen_server">gen_server(3)</seealso>, <seealso marker="sys">sys(3)</seealso></p> </section> diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml index d80ec4dfa6..2255395f46 100644 --- a/lib/stdlib/doc/src/sys.xml +++ b/lib/stdlib/doc/src/sys.xml @@ -217,14 +217,18 @@ processes. For example, a <c>gen_server</c> process returns the callback module's state, a <c>gen_fsm</c> process returns information such as its current state name and state data, - and a <c>gen_event</c> process returns information about each of its + a <c>gen_statem</c> process returns information about + its current state and data, and a <c>gen_event</c> process + returns information about each of its registered handlers. Callback modules for <c>gen_server</c>, - <c>gen_fsm</c>, and <c>gen_event</c> can also customise the value + <c>gen_fsm</c>, <c>gen_statem</c> and <c>gen_event</c> + can also customise the value of <c><anno>Misc</anno></c> by exporting a <c>format_status/2</c> function that contributes module-specific information; - see <seealso marker="gen_server#Module:format_status/2">gen_server:format_status/2</seealso>, - <seealso marker="gen_fsm#Module:format_status/2">gen_fsm:format_status/2</seealso>, and - <seealso marker="gen_event#Module:format_status/2">gen_event:format_status/2</seealso> + see <seealso marker="gen_server#Module:format_status/2">gen_server format_status/2</seealso>, + <seealso marker="gen_fsm#Module:format_status/2">gen_fsm format_status/2</seealso>, + <seealso marker="gen_statem#Module:format_status/2">gen_statem format_status/2</seealso>, and + <seealso marker="gen_event#Module:format_status/2">gen_event format_status/2</seealso> for more details.</p> </desc> </func> @@ -245,6 +249,8 @@ processes. For a <c>gen_server</c> process, the returned <c><anno>State</anno></c> is simply the callback module's state. For a <c>gen_fsm</c> process, <c><anno>State</anno></c> is the tuple <c>{CurrentStateName, CurrentStateData}</c>. + For a <c>gen_statem</c> process <c><anno>State</anno></c> is + the tuple <c>{CurrentState,CurrentData}.</c> For a <c>gen_event</c> process, <c><anno>State</anno></c> a list of tuples, where each tuple corresponds to an event handler registered in the process and contains <c>{Module, Id, HandlerState}</c>, where <c>Module</c> is the event handler's module name, @@ -263,8 +269,9 @@ details of the exception.</p> <p>The <c>system_get_state/1</c> function is primarily useful for user-defined behaviours and modules that implement OTP <seealso marker="#special_process">special - processes</seealso>. The <c>gen_server</c>, <c>gen_fsm</c>, and <c>gen_event</c> OTP - behaviour modules export this function, and so callback modules for those behaviours + processes</seealso>. The <c>gen_server</c>, <c>gen_fsm</c>, + <c>gen_statem</c> and <c>gen_event</c> OTP + behaviour modules export this function, so callback modules for those behaviours need not supply their own.</p> <p>To obtain more information about a process, including its state, see <seealso marker="#get_status-1">get_status/1</seealso> and @@ -290,6 +297,8 @@ <c>gen_fsm</c> process, <c><anno>State</anno></c> is the tuple <c>{CurrentStateName, CurrentStateData}</c>, and <c><anno>NewState</anno></c> is a similar tuple that may contain a new state name, new state data, or both. + The same applies for a <c>gen_statem</c> process but + it names the tuple fields <c>{CurrentState,CurrentData}</c>. For a <c>gen_event</c> process, <c><anno>State</anno></c> is the tuple <c>{Module, Id, HandlerState}</c> where <c>Module</c> is the event handler's module name, <c>Id</c> is the handler's ID (which is the value <c>false</c> if it was registered without @@ -304,7 +313,8 @@ state, then regardless of process type, it may simply return its <c><anno>State</anno></c> argument.</p> <p>If a <c><anno>StateFun</anno></c> function crashes or throws an exception, then - for <c>gen_server</c> and <c>gen_fsm</c> processes, the original state of the process is + for <c>gen_server</c>, <c>gen_fsm</c> or <c>gen_statem</c> processes, + the original state of the process is unchanged. For <c>gen_event</c> processes, a crashing or failing <c><anno>StateFun</anno></c> function means that only the state of the particular event handler it was working on when it failed or crashed is unchanged; it can still succeed in changing the states of other event @@ -329,7 +339,8 @@ <c>{callback_failed, StateFun, {Class, Reason}}</c>.</p> <p>The <c>system_replace_state/2</c> function is primarily useful for user-defined behaviours and modules that implement OTP <seealso marker="#special_process">special processes</seealso>. The - <c>gen_server</c>, <c>gen_fsm</c>, and <c>gen_event</c> OTP behaviour modules export this function, + <c>gen_server</c>, <c>gen_fsm</c>, <c>gen_statem</c> and + <c>gen_event</c> OTP behaviour modules export this function, and so callback modules for those behaviours need not supply their own.</p> </desc> </func> diff --git a/lib/stdlib/examples/erl_id_trans.erl b/lib/stdlib/examples/erl_id_trans.erl index c2e345763a..eab2ec4164 100644 --- a/lib/stdlib/examples/erl_id_trans.erl +++ b/lib/stdlib/examples/erl_id_trans.erl @@ -671,6 +671,10 @@ map_pair_types([{type,Line,map_field_assoc,[K,V]}|Ps]) -> K1 = type(K), V1 = type(V), [{type,Line,map_field_assoc,[K1,V1]}|map_pair_types(Ps)]; +map_pair_types([{type,Line,map_field_exact,[K,V]}|Ps]) -> + K1 = type(K), + V1 = type(V), + [{type,Line,map_field_exact,[K1,V1]}|map_pair_types(Ps)]; map_pair_types([]) -> []. field_types([{type,Line,field_type,[{atom,La,A},T]}|Fs]) -> diff --git a/lib/stdlib/include/assert.hrl b/lib/stdlib/include/assert.hrl index 151794d114..9e5d4eb598 100644 --- a/lib/stdlib/include/assert.hrl +++ b/lib/stdlib/include/assert.hrl @@ -59,19 +59,22 @@ -define(assert(BoolExpr),ok). -else. %% The assert macro is written the way it is so as not to cause warnings -%% for clauses that cannot match, even if the expression is a constant. +%% for clauses that cannot match, even if the expression is a constant or +%% is known to be boolean-only. -define(assert(BoolExpr), begin ((fun () -> + __T = is_process_alive(self()), % cheap source of truth case (BoolExpr) of - true -> ok; + __T -> ok; __V -> erlang:error({assert, [{module, ?MODULE}, {line, ?LINE}, {expression, (??BoolExpr)}, {expected, true}, - case __V of false -> {value, __V}; - _ -> {not_boolean,__V} + case not __T of + __V -> {value, false}; + _ -> {not_boolean, __V} end]}) end end)()) @@ -85,15 +88,17 @@ -define(assertNot(BoolExpr), begin ((fun () -> + __F = not is_process_alive(self()), case (BoolExpr) of - false -> ok; + __F -> ok; __V -> erlang:error({assert, [{module, ?MODULE}, {line, ?LINE}, {expression, (??BoolExpr)}, {expected, false}, - case __V of true -> {value, __V}; - _ -> {not_boolean,__V} + case not __F of + __V -> {value, true}; + _ -> {not_boolean, __V} end]}) end end)()) @@ -149,7 +154,8 @@ -else. -define(assertEqual(Expect, Expr), begin - ((fun (__X) -> + ((fun () -> + __X = (Expect), case (Expr) of __X -> ok; __V -> erlang:error({assertEqual, @@ -159,7 +165,7 @@ {expected, __X}, {value, __V}]}) end - end)(Expect)) + end)()) end). -endif. @@ -169,7 +175,8 @@ -else. -define(assertNotEqual(Unexpected, Expr), begin - ((fun (__X) -> + ((fun () -> + __X = (Unexpected), case (Expr) of __X -> erlang:error({assertNotEqual, [{module, ?MODULE}, @@ -178,7 +185,7 @@ {value, __X}]}); _ -> ok end - end)(Unexpected)) + end)()) end). -endif. diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 9f4a446ea0..302834f9d0 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2015. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -85,6 +85,7 @@ MODULES= \ gen_event \ gen_fsm \ gen_server \ + gen_statem \ io \ io_lib \ io_lib_format \ diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 936c095aef..55a818e87c 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -43,7 +43,10 @@ -type name() :: atom(). -type argspec() :: 'none' %No arguments | non_neg_integer(). %Number of arguments +-type argnames() :: [atom()]. -type tokens() :: [erl_scan:token()]. +-type predef() :: 'undefined' | {'none', tokens()}. +-type userdef() :: {argspec(), {argnames(), tokens()}}. -type used() :: {name(), argspec()}. -type function_name_type() :: 'undefined' @@ -63,7 +66,7 @@ sstk=[] :: [#epp{}], %State stack path=[] :: [file:name()], %Include-path macs = #{} %Macros (don't care locations) - :: #{name() => {argspec(), tokens()}}, + :: #{name() => predef() | [userdef()]}, uses = #{} %Macro use structure :: #{name() => [{argspec(), [used()]}]}, default_encoding = ?DEFAULT_ENCODING :: source_encoding(), diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 4ca9a609a8..b14102ac38 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2653,6 +2653,8 @@ find_field(_F, []) -> error. %% Attr :: 'type' | 'opaque' %% Checks that a type definition is valid. +-dialyzer({no_match, type_def/6}). + type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> TypeDefs = St0#lint.types, Arity = length(Args), @@ -2714,8 +2716,6 @@ check_type(Types, St) -> check_type({ann_type, _L, [_Var, Type]}, SeenVars, St) -> check_type(Type, SeenVars, St); -check_type({paren_type, _L, [Type]}, SeenVars, St) -> - check_type(Type, SeenVars, St); check_type({remote_type, L, [{atom, _, Mod}, {atom, _, Name}, Args]}, SeenVars, St0) -> St = deprecated_type(L, Mod, Name, Args, St0), @@ -2755,10 +2755,8 @@ 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) -> - %% 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, any}, SeenVars, St) -> + {SeenVars, St}; check_type({type, _L, map, Pairs}, SeenVars, St) -> lists:foldl(fun(Pair, {AccSeenVars, AccSt}) -> check_type(Pair, AccSeenVars, AccSt) @@ -2866,7 +2864,6 @@ used_type(TypePair, L, #lint{usage = Usage, file = File} = St) -> 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) -> diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 6f8e5e8449..a896de4f1c 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -170,9 +170,16 @@ fun_type -> '(' top_types ')' '->' top_type : {type, ?anno('$1'), 'fun', [{type, ?anno('$1'), product, '$2'},'$5']}. +map_pair_types -> '...' : [{type, ?anno('$1'), map_field_assoc, + [{type, ?anno('$1'), any, []}, + {type, ?anno('$1'), any, []}]}]. 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, ?anno('$2'), map_field_assoc,['$1','$3']}. + +map_pair_type -> top_type '=>' top_type : {type, ?anno('$2'), + map_field_assoc,['$1','$3']}. +map_pair_type -> top_type ':=' top_type : {type, ?anno('$2'), + map_field_exact,['$1','$3']}. field_types -> field_type : ['$1']. field_types -> field_type ',' field_types : ['$1'|'$3']. @@ -810,7 +817,8 @@ Erlang code. | {'type', anno(), 'map', [af_map_pair_type()]}. -type af_map_pair_type() :: - {'type', anno(), 'map_field_assoc', [abstract_type()]}. + {'type', anno(), 'map_field_assoc', [abstract_type()]} + | {'type', anno(), 'map_field_exact', [abstract_type()]}. -type af_predefined_type() :: {'type', anno(), type_name(), [abstract_type()]}. diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index c5177aca90..ca764675fc 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -344,11 +344,31 @@ binary_type(I1, I2) -> map_type(Fs) -> {first,[$#],map_pair_types(Fs)}. -map_pair_types(Fs) -> +map_pair_types(Fs0) -> + Fs = replace_any_map(Fs0), tuple_type(Fs, fun map_pair_type/2). +replace_any_map([{type,Line,map_field_assoc,[KType,VType]}]=Fs) -> + IsAny = fun({type,_,any,[]}) -> true; + %% ({var,_,'_'}) -> true; + (_) -> false + end, + case IsAny(KType) andalso IsAny(VType) of + true -> + [{type,Line,map_field_assoc,any}]; + false -> + Fs + end; +replace_any_map([F|Fs]) -> + [F|replace_any_map(Fs)]; +replace_any_map([]) -> []. + +map_pair_type({type,_Line,map_field_assoc,any}, _Prec) -> + leaf("..."); map_pair_type({type,_Line,map_field_assoc,[KType,VType]}, Prec) -> - {list,[{cstep,[ltype(KType, Prec),leaf(" =>")],ltype(VType, Prec)}]}. + {list,[{cstep,[ltype(KType, Prec),leaf(" =>")],ltype(VType, Prec)}]}; +map_pair_type({type,_Line,map_field_exact,[KType,VType]}, Prec) -> + {list,[{cstep,[ltype(KType, Prec),leaf(" :=")],ltype(VType, Prec)}]}. record_type(Name, Fields) -> {first,[record_name(Name)],field_types(Fields)}. diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 9811a211ae..597830cf9a 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -26,7 +26,8 @@ %%% %%% The standard behaviour should export init_it/6. %%%----------------------------------------------------------------- --export([start/5, start/6, debug_options/1, +-export([start/5, start/6, debug_options/2, + name/1, unregister_name/1, get_proc_name/1, get_parent/0, call/3, call/4, reply/2, stop/1, stop/3]). -export([init_it/6, init_it/7]). @@ -124,7 +125,7 @@ init_it(GenMod, Starter, Parent, Mod, Args, Options) -> init_it2(GenMod, Starter, Parent, self(), Mod, Args, Options). init_it(GenMod, Starter, Parent, Name, Mod, Args, Options) -> - case name_register(Name) of + case register_name(Name) of true -> init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options); {false, Pid} -> @@ -297,19 +298,19 @@ where({global, Name}) -> global:whereis_name(Name); where({via, Module, Name}) -> Module:whereis_name(Name); where({local, Name}) -> whereis(Name). -name_register({local, Name} = LN) -> +register_name({local, Name} = LN) -> try register(Name, self()) of true -> true catch error:_ -> {false, where(LN)} end; -name_register({global, Name} = GN) -> +register_name({global, Name} = GN) -> case global:register_name(Name, self()) of yes -> true; no -> {false, where(GN)} end; -name_register({via, Module, Name} = GN) -> +register_name({via, Module, Name} = GN) -> case Module:register_name(Name, self()) of yes -> true; @@ -317,34 +318,108 @@ name_register({via, Module, Name} = GN) -> {false, where(GN)} end. +name({local,Name}) -> Name; +name({global,Name}) -> Name; +name({via,_, Name}) -> Name; +name(Pid) when is_pid(Pid) -> Pid. + +unregister_name({local,Name}) -> + try unregister(Name) of + _ -> ok + catch + _:_ -> ok + end; +unregister_name({global,Name}) -> + _ = global:unregister_name(Name), + ok; +unregister_name({via, Mod, Name}) -> + _ = Mod:unregister_name(Name), + ok; +unregister_name(Pid) when is_pid(Pid) -> + ok. + +get_proc_name(Pid) when is_pid(Pid) -> + Pid; +get_proc_name({local, Name}) -> + case process_info(self(), registered_name) of + {registered_name, Name} -> + Name; + {registered_name, _Name} -> + exit(process_not_registered); + [] -> + exit(process_not_registered) + end; +get_proc_name({global, Name}) -> + case global:whereis_name(Name) of + undefined -> + exit(process_not_registered_globally); + Pid when Pid =:= self() -> + Name; + _Pid -> + exit(process_not_registered_globally) + end; +get_proc_name({via, Mod, Name}) -> + case Mod:whereis_name(Name) of + undefined -> + exit({process_not_registered_via, Mod}); + Pid when Pid =:= self() -> + Name; + _Pid -> + exit({process_not_registered_via, Mod}) + end. + +get_parent() -> + case get('$ancestors') of + [Parent | _] when is_pid(Parent) -> + Parent; + [Parent | _] when is_atom(Parent) -> + name_to_pid(Parent); + _ -> + exit(process_was_not_started_by_proc_lib) + end. + +name_to_pid(Name) -> + case whereis(Name) of + undefined -> + case global:whereis_name(Name) of + undefined -> + exit(could_not_find_registered_name); + Pid -> + Pid + end; + Pid -> + Pid + end. + timeout(Options) -> - case opt(timeout, Options) of - {ok, Time} -> + case lists:keyfind(timeout, 1, Options) of + {_,Time} -> Time; - _ -> + false -> infinity end. spawn_opts(Options) -> - case opt(spawn_opt, Options) of - {ok, Opts} -> + case lists:keyfind(spawn_opt, 1, Options) of + {_,Opts} -> Opts; - _ -> + false -> [] end. -opt(Op, [{Op, Value}|_]) -> - {ok, Value}; -opt(Op, [_|Options]) -> - opt(Op, Options); -opt(_, []) -> - false. - -debug_options(Opts) -> - case opt(debug, Opts) of - {ok, Options} -> sys:debug_options(Options); - _ -> [] +debug_options(Name, Opts) -> + case lists:keyfind(debug, 1, Opts) of + {_,Options} -> + try sys:debug_options(Options) + catch _:_ -> + error_logger:format( + "~p: ignoring erroneous debug options - ~p~n", + [Name,Options]), + [] + end; + false -> + [] end. format_status_header(TagLine, Pid) when is_pid(Pid) -> diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 1303036168..ccacf658e9 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -147,16 +147,11 @@ init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, _, _, Options) -> process_flag(trap_exit, true), - Debug = gen:debug_options(Options), + Name = gen:name(Name0), + Debug = gen:debug_options(Name, Options), proc_lib:init_ack(Starter, {ok, self()}), - Name = name(Name0), loop(Parent, Name, [], Debug, false). -name({local,Name}) -> Name; -name({global,Name}) -> Name; -name({via,_, Name}) -> Name; -name(Pid) when is_pid(Pid) -> Pid. - -spec add_handler(emgr_ref(), handler(), term()) -> term(). add_handler(M, Handler, Args) -> rpc(M, {add_handler, Handler, Args}). diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 2b4b76105e..6e7528fd98 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -305,64 +305,11 @@ enter_loop(Mod, Options, StateName, StateData, Timeout) -> enter_loop(Mod, Options, StateName, StateData, self(), Timeout). enter_loop(Mod, Options, StateName, StateData, ServerName, Timeout) -> - Name = get_proc_name(ServerName), - Parent = get_parent(), - Debug = gen:debug_options(Options), + Name = gen:get_proc_name(ServerName), + Parent = gen:get_parent(), + Debug = gen:debug_options(Name, Options), loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug). -get_proc_name(Pid) when is_pid(Pid) -> - Pid; -get_proc_name({local, Name}) -> - case process_info(self(), registered_name) of - {registered_name, Name} -> - Name; - {registered_name, _Name} -> - exit(process_not_registered); - [] -> - exit(process_not_registered) - end; -get_proc_name({global, Name}) -> - case global:whereis_name(Name) of - undefined -> - exit(process_not_registered_globally); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit(process_not_registered_globally) - end; -get_proc_name({via, Mod, Name}) -> - case Mod:whereis_name(Name) of - undefined -> - exit({process_not_registered_via, Mod}); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit({process_not_registered_via, Mod}) - end. - -get_parent() -> - case get('$ancestors') of - [Parent | _] when is_pid(Parent) -> - Parent; - [Parent | _] when is_atom(Parent) -> - name_to_pid(Parent); - _ -> - exit(process_was_not_started_by_proc_lib) - end. - -name_to_pid(Name) -> - case whereis(Name) of - undefined -> - case global:whereis_name(Name) of - undefined -> - exit(could_not_find_registered_name); - Pid -> - Pid - end; - Pid -> - Pid - end. - %%% --------------------------------------------------- %%% Initiate the new process. %%% Register the name using the Rfunc function @@ -373,8 +320,8 @@ name_to_pid(Name) -> init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, Mod, Args, Options) -> - Name = name(Name0), - Debug = gen:debug_options(Options), + Name = gen:name(Name0), + Debug = gen:debug_options(Name, Options), case catch Mod:init(Args) of {ok, StateName, StateData} -> proc_lib:init_ack(Starter, {ok, self()}), @@ -383,15 +330,15 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> proc_lib:init_ack(Starter, {ok, self()}), loop(Parent, Name, StateName, StateData, Mod, Timeout, Debug); {stop, Reason} -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); ignore -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, ignore), exit(normal); {'EXIT', Reason} -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); Else -> @@ -400,20 +347,6 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> exit(Error) end. -name({local,Name}) -> Name; -name({global,Name}) -> Name; -name({via,_, Name}) -> Name; -name(Pid) when is_pid(Pid) -> Pid. - -unregister_name({local,Name}) -> - _ = (catch unregister(Name)); -unregister_name({global,Name}) -> - _ = global:unregister_name(Name); -unregister_name({via, Mod, Name}) -> - _ = Mod:unregister_name(Name); -unregister_name(Pid) when is_pid(Pid) -> - Pid. - %%----------------------------------------------------------------- %% The MAIN loop %%----------------------------------------------------------------- diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index fa6fff6dca..5800aca66f 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -304,9 +304,9 @@ enter_loop(Mod, Options, State, Timeout) -> enter_loop(Mod, Options, State, self(), Timeout). enter_loop(Mod, Options, State, ServerName, Timeout) -> - Name = get_proc_name(ServerName), - Parent = get_parent(), - Debug = debug_options(Name, Options), + Name = gen:get_proc_name(ServerName), + Parent = gen:get_parent(), + Debug = gen:debug_options(Name, Options), loop(Parent, Name, State, Mod, Timeout, Debug). %%%======================================================================== @@ -323,8 +323,8 @@ enter_loop(Mod, Options, State, ServerName, Timeout) -> init_it(Starter, self, Name, Mod, Args, Options) -> init_it(Starter, self(), Name, Mod, Args, Options); init_it(Starter, Parent, Name0, Mod, Args, Options) -> - Name = name(Name0), - Debug = debug_options(Name, Options), + Name = gen:name(Name0), + Debug = gen:debug_options(Name, Options), case catch Mod:init(Args) of {ok, State} -> proc_lib:init_ack(Starter, {ok, self()}), @@ -339,15 +339,15 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> %% (Otherwise, the parent process could get %% an 'already_started' error if it immediately %% tried starting the process again.) - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); ignore -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, ignore), exit(normal); {'EXIT', Reason} -> - unregister_name(Name0), + gen:unregister_name(Name0), proc_lib:init_ack(Starter, {error, Reason}), exit(Reason); Else -> @@ -356,20 +356,6 @@ init_it(Starter, Parent, Name0, Mod, Args, Options) -> exit(Error) end. -name({local,Name}) -> Name; -name({global,Name}) -> Name; -name({via,_, Name}) -> Name; -name(Pid) when is_pid(Pid) -> Pid. - -unregister_name({local,Name}) -> - _ = (catch unregister(Name)); -unregister_name({global,Name}) -> - _ = global:unregister_name(Name); -unregister_name({via, Mod, Name}) -> - _ = Mod:unregister_name(Name); -unregister_name(Pid) when is_pid(Pid) -> - Pid. - %%%======================================================================== %%% Internal functions %%%======================================================================== @@ -858,86 +844,6 @@ error_info(Reason, Name, Msg, State, Debug) -> sys:print_log(Debug), ok. -%%% --------------------------------------------------- -%%% Misc. functions. -%%% --------------------------------------------------- - -opt(Op, [{Op, Value}|_]) -> - {ok, Value}; -opt(Op, [_|Options]) -> - opt(Op, Options); -opt(_, []) -> - false. - -debug_options(Name, Opts) -> - case opt(debug, Opts) of - {ok, Options} -> dbg_opts(Name, Options); - _ -> [] - end. - -dbg_opts(Name, Opts) -> - case catch sys:debug_options(Opts) of - {'EXIT',_} -> - format("~p: ignoring erroneous debug options - ~p~n", - [Name, Opts]), - []; - Dbg -> - Dbg - end. - -get_proc_name(Pid) when is_pid(Pid) -> - Pid; -get_proc_name({local, Name}) -> - case process_info(self(), registered_name) of - {registered_name, Name} -> - Name; - {registered_name, _Name} -> - exit(process_not_registered); - [] -> - exit(process_not_registered) - end; -get_proc_name({global, Name}) -> - case global:whereis_name(Name) of - undefined -> - exit(process_not_registered_globally); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit(process_not_registered_globally) - end; -get_proc_name({via, Mod, Name}) -> - case Mod:whereis_name(Name) of - undefined -> - exit({process_not_registered_via, Mod}); - Pid when Pid =:= self() -> - Name; - _Pid -> - exit({process_not_registered_via, Mod}) - end. - -get_parent() -> - case get('$ancestors') of - [Parent | _] when is_pid(Parent)-> - Parent; - [Parent | _] when is_atom(Parent)-> - name_to_pid(Parent); - _ -> - exit(process_was_not_started_by_proc_lib) - end. - -name_to_pid(Name) -> - case whereis(Name) of - undefined -> - case global:whereis_name(Name) of - undefined -> - exit(could_not_find_registered_name); - Pid -> - Pid - end; - Pid -> - Pid - end. - %%----------------------------------------------------------------- %% Status information %%----------------------------------------------------------------- diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl new file mode 100644 index 0000000000..f9e2e5f7d2 --- /dev/null +++ b/lib/stdlib/src/gen_statem.erl @@ -0,0 +1,1267 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(gen_statem). + +%% API +-export( + [start/3,start/4,start_link/3,start_link/4, + stop/1,stop/3, + cast/2,call/2,call/3, + enter_loop/5,enter_loop/6,enter_loop/7, + reply/1,reply/2]). + +%% gen callbacks +-export( + [init_it/6]). + +%% sys callbacks +-export( + [system_continue/3, + system_terminate/4, + system_code_change/4, + system_get_state/1, + system_replace_state/2, + format_status/2]). + +%% Internal callbacks +-export( + [wakeup_from_hibernate/3]). + +%% Type exports for templates +-export_type( + [event_type/0, + callback_mode/0, + state_function_result/0, + handle_event_result/0, + action/0]). + +%% Fix problem for doc build +-export_type([transition_option/0]). + +%%%========================================================================== +%%% Interface functions. +%%%========================================================================== + +-type from() :: + {To :: pid(), Tag :: term()}. % Reply-to specifier for call + +-type state() :: + state_name() | % For state callback function StateName/5 + term(). % For state callback function handle_event/5 + +-type state_name() :: atom(). + +-type data() :: term(). + +-type event_type() :: + {'call',From :: from()} | 'cast' | + 'info' | 'timeout' | 'internal'. + +-type callback_mode() :: 'state_functions' | 'handle_event_function'. + +-type transition_option() :: + postpone() | hibernate() | event_timeout(). +-type postpone() :: + %% If 'true' postpone the current event + %% and retry it when the state changes (=/=) + boolean(). +-type hibernate() :: + %% If 'true' hibernate the server instead of going into receive + boolean(). +-type event_timeout() :: + %% Generate a ('timeout', EventContent, ...) event after Time + %% unless some other event is delivered + Time :: timeout(). + +-type action() :: + %% During a state change: + %% * NextState and NewData are set. + %% * All action()s are executed in order of apperance. + %% * Postponing the current event is performed + %% iff 'postpone' is 'true'. + %% * A state timer is started iff 'timeout' is set. + %% * Pending events are processed or if there are + %% no pending events the server goes into receive + %% or hibernate (iff 'hibernate' is 'true') + %% + %% These action()s are executed in order of appearence + %% in the containing list. The ones that set options + %% will override any previous so the last of each kind wins. + %% + 'postpone' | % Set the postpone option + {'postpone', Postpone :: postpone()} | + %% + 'hibernate' | % Set the hibernate option + {'hibernate', Hibernate :: hibernate()} | + %% + (Timeout :: event_timeout()) | % {timeout,Timeout} + {'timeout', % Set the event timeout option + Time :: event_timeout(), EventContent :: term()} | + %% + reply_action() | + %% + %% All 'next_event' events are kept in a list and then + %% inserted at state changes so the first in the + %% action() list is the first to be delivered. + {'next_event', % Insert event as the next to handle + EventType :: event_type(), + EventContent :: term()}. +-type reply_action() :: + {'reply', % Reply to a caller + From :: from(), Reply :: term()}. + +-type state_function_result() :: + {'next_state', % {next_state,NextStateName,NewData,[]} + NextStateName :: state_name(), + NewData :: data()} | + {'next_state', % State transition, maybe to the same state + NextStateName :: state_name(), + NewData :: data(), + Actions :: [action()] | action()} | + common_state_callback_result(). +-type handle_event_result() :: + {'next_state', % {next_state,NextState,NewData,[]} + NextState :: state(), + NewData :: data()} | + {'next_state', % State transition, maybe to the same state + NextState :: state(), + NewData :: data(), + Actions :: [action()] | action()} | + common_state_callback_result(). +-type common_state_callback_result() :: + 'stop' | % {stop,normal} + {'stop', % Stop the server + Reason :: term()} | + {'stop', % Stop the server + Reason :: term(), + NewData :: data()} | + {'stop_and_reply', % Reply then stop the server + Reason :: term(), + Replies :: [reply_action()] | reply_action()} | + {'stop_and_reply', % Reply then stop the server + Reason :: term(), + Replies :: [reply_action()] | reply_action(), + NewData :: data()} | + {'keep_state', % {keep_state,NewData,[]} + NewData :: data()} | + {'keep_state', % Keep state, change data + NewData :: data(), + Actions :: [action()] | action()} | + 'keep_state_and_data' | % {keep_state_and_data,[]} + {'keep_state_and_data', % Keep state and data -> only actions + Actions :: [action()] | action()}. + + +%% The state machine init function. It is called only once and +%% the server is not running until this function has returned +%% an {ok, ...} tuple. Thereafter the state callbacks are called +%% for all events to this server. +-callback init(Args :: term()) -> + {callback_mode(), state(), data()} | + {callback_mode(), state(), data(), [action()] | action()} | + 'ignore' | + {'stop', Reason :: term()}. + +%% Example state callback for callback_mode() =:= state_functions +%% state name 'state_name'. +%% +%% In this mode all states has to be type state_name() i.e atom(). +%% +%% Note that state callbacks and only state callbacks have arity 5 +%% and that is intended. +-callback state_name( + event_type(), + EventContent :: term(), + Data :: data()) -> + state_function_result(). +%% +%% State callback for callback_mode() =:= handle_event_function. +%% +%% Note that state callbacks and only state callbacks have arity 5 +%% and that is intended. +-callback handle_event( + event_type(), + EventContent :: term(), + State :: state(), % Current state + Data :: data()) -> + handle_event_result(). + +%% Clean up before the server terminates. +-callback terminate( + Reason :: 'normal' | 'shutdown' | {'shutdown', term()} + | term(), + State :: state(), + Data :: data()) -> + any(). + +%% Note that the new code can expect to get an OldState from +%% the old code version not only in code_change/4 but in the first +%% state callback function called thereafter +-callback code_change( + OldVsn :: term() | {'down', term()}, + OldState :: state(), + OldData :: data(), + Extra :: term()) -> + {NewCallbackMode :: callback_mode(), + NewState :: state(), + NewData :: data()}. + +%% Format the callback module state in some sensible that is +%% often condensed way. For StatusOption =:= 'normal' the perferred +%% return term is [{data,[{"State",FormattedState}]}], and for +%% StatusOption =:= 'terminate' it is just FormattedState. +-callback format_status( + StatusOption, + [ [{Key :: term(), Value :: term()}] | + state() | + data()]) -> + Status :: term() when + StatusOption :: 'normal' | 'terminate'. + +-optional_callbacks( + [init/1, % One may use enter_loop/5,6,7 instead + format_status/2, % Has got a default implementation + %% + state_name/3, % Example for callback_mode =:= state_functions: + %% there has to be a StateName/5 callback function for every StateName. + %% + handle_event/4]). % For callback_mode =:= handle_event_function + +%% Type validation functions +callback_mode(CallbackMode) -> + case CallbackMode of + state_functions -> + true; + handle_event_function -> + true; + _ -> + false + end. +%% +from({Pid,_}) when is_pid(Pid) -> + true; +from(_) -> + false. +%% +event_type({call,From}) -> + from(From); +event_type(Type) -> + case Type of + cast -> + true; + info -> + true; + timeout -> + true; + internal -> + true; + _ -> + false + end. + + + +-define( + STACKTRACE(), + try throw(ok) catch _ -> erlang:get_stacktrace() end). + +-define( + TERMINATE(Class, Reason, Debug, S, Q), + terminate( + begin Class end, + begin Reason end, + ?STACKTRACE(), + begin Debug end, + begin S end, + begin Q end)). + +%%%========================================================================== +%%% API + +-type server_name() :: + {'global', GlobalName :: term()} + | {'via', RegMod :: module(), Name :: term()} + | {'local', atom()}. +-type server_ref() :: + {'global', GlobalName :: term()} + | {'via', RegMod :: module(), ViaName :: term()} + | (LocalName :: atom()) + | {Name :: atom(), Node :: atom()} + | pid(). +-type debug_opt() :: + {'debug', + Dbgs :: + ['trace' | 'log' | 'statistics' | 'debug' + | {'logfile', string()}]}. +-type start_opt() :: + debug_opt() + | {'timeout', Time :: timeout()} + | {'spawn_opt', [proc_lib:spawn_option()]}. +-type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}. + + + +%% Start a state machine +-spec start( + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_ret(). +start(Module, Args, Opts) -> + gen:start(?MODULE, nolink, Module, Args, Opts). +%% +-spec start( + ServerName :: server_name(), + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_ret(). +start(ServerName, Module, Args, Opts) -> + gen:start(?MODULE, nolink, ServerName, Module, Args, Opts). + +%% Start and link to a state machine +-spec start_link( + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_ret(). +start_link(Module, Args, Opts) -> + gen:start(?MODULE, link, Module, Args, Opts). +%% +-spec start_link( + ServerName :: server_name(), + Module :: module(), Args :: term(), Opts :: [start_opt()]) -> + start_ret(). +start_link(ServerName, Module, Args, Opts) -> + gen:start(?MODULE, link, ServerName, Module, Args, Opts). + +%% Stop a state machine +-spec stop(ServerRef :: server_ref()) -> ok. +stop(ServerRef) -> + gen:stop(ServerRef). +%% +-spec stop( + ServerRef :: server_ref(), + Reason :: term(), + Timeout :: timeout()) -> ok. +stop(ServerRef, Reason, Timeout) -> + gen:stop(ServerRef, Reason, Timeout). + +%% Send an event to a state machine that arrives with type 'event' +-spec cast(ServerRef :: server_ref(), Msg :: term()) -> ok. +cast({global,Name}, Msg) -> + try global:send(Name, wrap_cast(Msg)) of + _ -> ok + catch + _:_ -> ok + end; +cast({via,RegMod,Name}, Msg) -> + try RegMod:send(Name, wrap_cast(Msg)) of + _ -> ok + catch + _:_ -> ok + end; +cast({Name,Node} = ServerRef, Msg) when is_atom(Name), is_atom(Node) -> + send(ServerRef, wrap_cast(Msg)); +cast(ServerRef, Msg) when is_atom(ServerRef) -> + send(ServerRef, wrap_cast(Msg)); +cast(ServerRef, Msg) when is_pid(ServerRef) -> + send(ServerRef, wrap_cast(Msg)). + +%% Call a state machine (synchronous; a reply is expected) that +%% arrives with type {call,From} +-spec call(ServerRef :: server_ref(), Request :: term()) -> Reply :: term(). +call(ServerRef, Request) -> + call(ServerRef, Request, infinity). +%% +-spec call( + ServerRef :: server_ref(), + Request :: term(), + Timeout :: timeout()) -> + Reply :: term(). +call(ServerRef, Request, infinity) -> + try gen:call(ServerRef, '$gen_call', Request, infinity) of + {ok,Reply} -> + Reply + catch + Class:Reason -> + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,infinity]}}, + erlang:get_stacktrace()) + end; +call(ServerRef, Request, Timeout) -> + %% Call server through proxy process to dodge any late reply + Ref = make_ref(), + Self = self(), + Pid = spawn( + fun () -> + Self ! + try gen:call( + ServerRef, '$gen_call', Request, Timeout) of + Result -> + {Ref,Result} + catch Class:Reason -> + {Ref,Class,Reason,erlang:get_stacktrace()} + end + end), + Mref = monitor(process, Pid), + receive + {Ref,Result} -> + demonitor(Mref, [flush]), + case Result of + {ok,Reply} -> + Reply + end; + {Ref,Class,Reason,Stacktrace} -> + demonitor(Mref, [flush]), + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + Stacktrace); + {'DOWN',Mref,_,_,Reason} -> + %% There is a theoretical possibility that the + %% proxy process gets killed between try--of and ! + %% so this clause is in case of that + exit(Reason) + end. + +%% Reply from a state machine callback to whom awaits in call/2 +-spec reply([reply_action()] | reply_action()) -> ok. +reply({reply,From,Reply}) -> + reply(From, Reply); +reply(Replies) when is_list(Replies) -> + replies(Replies). +%% +-spec reply(From :: from(), Reply :: term()) -> ok. +reply({To,Tag}, Reply) when is_pid(To) -> + Msg = {Tag,Reply}, + try To ! Msg of + _ -> + ok + catch + _:_ -> ok + end. + +%% Instead of starting the state machine through start/3,4 +%% or start_link/3,4 turn the current process presumably +%% started by proc_lib into a state machine using +%% the same arguments as you would have returned from init/1 +-spec enter_loop( + Module :: module(), Opts :: [debug_opt()], + CallbackMode :: callback_mode(), + State :: state(), Data :: data()) -> + no_return(). +enter_loop(Module, Opts, CallbackMode, State, Data) -> + enter_loop(Module, Opts, CallbackMode, State, Data, self()). +%% +-spec enter_loop( + Module :: module(), Opts :: [debug_opt()], + CallbackMode :: callback_mode(), + State :: state(), Data :: data(), + Server_or_Actions :: + server_name() | pid() | [action()]) -> + no_return(). +enter_loop(Module, Opts, CallbackMode, State, Data, Server_or_Actions) -> + if + is_list(Server_or_Actions) -> + enter_loop( + Module, Opts, CallbackMode, State, Data, + self(), Server_or_Actions); + true -> + enter_loop( + Module, Opts, CallbackMode, State, Data, + Server_or_Actions, []) + end. +%% +-spec enter_loop( + Module :: module(), Opts :: [debug_opt()], + CallbackMode :: callback_mode(), + State :: state(), Data :: data(), + Server :: server_name() | pid(), + Actions :: [action()] | action()) -> + no_return(). +enter_loop(Module, Opts, CallbackMode, State, Data, Server, Actions) -> + is_atom(Module) orelse error({atom,Module}), + callback_mode(CallbackMode) orelse error({callback_mode,CallbackMode}), + Parent = gen:get_parent(), + enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent). + +%%--------------------------------------------------------------------------- +%% API helpers + +wrap_cast(Event) -> + {'$gen_cast',Event}. + +replies([{reply,From,Reply}|Replies]) -> + reply(From, Reply), + replies(Replies); +replies([]) -> + ok. + +%% Might actually not send the message in case of caught exception +send(Proc, Msg) -> + try erlang:send(Proc, Msg, [noconnect]) of + noconnect -> + _ = spawn(erlang, send, [Proc,Msg]), + ok; + ok -> + ok + catch + _:_ -> + ok + end. + +%% Here init_it/6 and enter_loop/5,6,7 functions converge +enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) -> + %% The values should already have been type checked + Name = gen:get_proc_name(Server), + Debug = gen:debug_options(Name, Opts), + PrevState = make_ref(), % Will be discarded by loop_event_actions/9 + NewActions = + if + is_list(Actions) -> + Actions ++ [{postpone,false}]; + true -> + [Actions,{postpone,false}] + end, + S = #{ + callback_mode => CallbackMode, + module => Module, + name => Name, + state => PrevState, + data => Data, + timer => undefined, + postponed => [], + hibernate => false}, + loop_event_actions( + Parent, Debug, S, [], + {event,undefined}, % Will be discarded thanks to {postpone,false} + PrevState, State, Data, NewActions). + +%%%========================================================================== +%%% gen callbacks + +init_it(Starter, self, ServerRef, Module, Args, Opts) -> + init_it(Starter, self(), ServerRef, Module, Args, Opts); +init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> + try Module:init(Args) of + Result -> + init_result(Starter, Parent, ServerRef, Module, Result, Opts) + catch + Result -> + init_result(Starter, Parent, ServerRef, Module, Result, Opts); + Class:Reason -> + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, {error,Reason}), + erlang:raise(Class, Reason, erlang:get_stacktrace()) + end. + +%%--------------------------------------------------------------------------- +%% gen callbacks helpers + +init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> + case Result of + {CallbackMode,State,Data} -> + case callback_mode(CallbackMode) of + true -> + proc_lib:init_ack(Starter, {ok,self()}), + enter( + Module, Opts, CallbackMode, State, Data, + ServerRef, [], Parent); + false -> + Error = {callback_mode,CallbackMode}, + proc_lib:init_ack(Starter, {error,Error}), + exit(Error) + end; + {CallbackMode,State,Data,Actions} -> + case callback_mode(CallbackMode) of + true -> + proc_lib:init_ack(Starter, {ok,self()}), + enter( + Module, Opts, CallbackMode, State, Data, + ServerRef, Actions, Parent); + false -> + Error = {callback_mode,CallbackMode}, + proc_lib:init_ack(Starter, {error,Error}), + exit(Error) + end; + {stop,Reason} -> + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, {error,Reason}), + exit(Reason); + ignore -> + gen:unregister_name(ServerRef), + proc_lib:init_ack(Starter, ignore), + exit(normal); + _ -> + Error = {bad_return_value,Result}, + proc_lib:init_ack(Starter, {error,Error}), + exit(Error) + end. + +%%%========================================================================== +%%% sys callbacks + +system_continue(Parent, Debug, S) -> + loop(Parent, Debug, S). + +system_terminate(Reason, _Parent, Debug, S) -> + ?TERMINATE(exit, Reason, Debug, S, []). + +system_code_change( + #{module := Module, + state := State, + data := Data} = S, + _Mod, OldVsn, Extra) -> + case + try Module:code_change(OldVsn, State, Data, Extra) + catch + Result -> Result + end + of + {NewCallbackMode,NewState,NewData} -> + callback_mode(NewCallbackMode) orelse + error({callback_mode,NewCallbackMode}), + {ok,S#{state := NewState, data := NewData}}; + {ok,_} = Error -> + error({case_clause,Error}); + Error -> + Error + end. + +system_get_state(#{state := State, data := Data}) -> + {ok,{State,Data}}. + +system_replace_state( + StateFun, + #{state := State, + data := Data} = S) -> + {NewState,NewData} = Result = StateFun({State,Data}), + {ok,Result,S#{state := NewState, data := NewData}}. + +format_status( + Opt, + [PDict,SysState,Parent,Debug, + #{name := Name, postponed := P} = S]) -> + Header = gen:format_status_header("Status for state machine", Name), + Log = sys:get_debug(log, Debug, []), + [{header,Header}, + {data, + [{"Status",SysState}, + {"Parent",Parent}, + {"Logged Events",Log}, + {"Postponed",P}]} | + case format_status(Opt, PDict, S) of + L when is_list(L) -> L; + T -> [T] + end]. + +%%--------------------------------------------------------------------------- +%% Format debug messages. Print them as the call-back module sees +%% them, not as the real erlang messages. Use trace for that. +%%--------------------------------------------------------------------------- + +print_event(Dev, {in,Event}, #{name := Name}) -> + io:format( + Dev, "*DBG* ~p received ~s~n", + [Name,event_string(Event)]); +print_event(Dev, {out,Reply,{To,_Tag}}, #{name := Name}) -> + io:format( + Dev, "*DBG* ~p sent ~p to ~p~n", + [Name,Reply,To]); +print_event(Dev, {Tag,Event,NewState}, #{name := Name, state := State}) -> + StateString = + case NewState of + State -> + io_lib:format("~p", [State]); + _ -> + io_lib:format("~p => ~p", [State,NewState]) + end, + io:format( + Dev, "*DBG* ~p ~w ~s in state ~s~n", + [Name,Tag,event_string(Event),StateString]). + +event_string(Event) -> + case Event of + {{call,{Pid,_Tag}},Request} -> + io_lib:format("call ~p from ~w", [Request,Pid]); + {Tag,Content} -> + io_lib:format("~w ~p", [Tag,Content]) + end. + +sys_debug(Debug, S, Entry) -> + case Debug of + [] -> + Debug; + _ -> + sys:handle_debug(Debug, fun print_event/3, S, Entry) + end. + +%%%========================================================================== +%%% Internal callbacks + +wakeup_from_hibernate(Parent, Debug, S) -> + %% It is a new message that woke us up so we have to receive it now + loop_receive(Parent, Debug, S). + +%%%========================================================================== +%%% State Machine engine implementation of proc_lib/gen server + +%% Server loop, consists of all loop* functions +%% and some detours through sys and proc_lib + +%% Entry point for system_continue/3 +loop(Parent, Debug, #{hibernate := Hibernate} = S) -> + case Hibernate of + true -> + %% Does not return but restarts process at + %% wakeup_from_hibernate/3 that jumps to loop_receive/3 + proc_lib:hibernate( + ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), + error( + {should_not_have_arrived_here_but_instead_in, + {wakeup_from_hibernate,3}}); + false -> + loop_receive(Parent, Debug, S) + end. + +%% Entry point for wakeup_from_hibernate/3 +loop_receive(Parent, Debug, #{timer := Timer} = S) -> + receive + Msg -> + case Msg of + {system,Pid,Req} -> + #{hibernate := Hibernate} = S, + %% Does not return but tail recursively calls + %% system_continue/3 that jumps to loop/3 + sys:handle_system_msg( + Req, Pid, Parent, ?MODULE, Debug, S, Hibernate); + {'EXIT',Parent,Reason} = EXIT -> + %% EXIT is not a 2-tuple and therefore + %% not an event and has no event_type(), + %% but this will stand out in the crash report... + ?TERMINATE(exit, Reason, Debug, S, [EXIT]); + {timeout,Timer,Content} when Timer =/= undefined -> + loop_event(Parent, Debug, S, {timeout,Content}); + _ -> + %% Cancel Timer if running + case Timer of + undefined -> + ok; + _ -> + case erlang:cancel_timer(Timer) of + TimeLeft when is_integer(TimeLeft) -> + ok; + false -> + receive + {timeout,Timer,_} -> + ok + after 0 -> + ok + end + end + end, + Event = + case Msg of + {'$gen_call',From,Request} -> + {{call,From},Request}; + {'$gen_cast',E} -> + {cast,E}; + _ -> + {info,Msg} + end, + loop_event(Parent, Debug, S, Event) + end + end. + +loop_event(Parent, Debug, S, Event) -> + %% The timer field and the hibernate flag in S + %% are now invalid and ignored until we get back to loop/3 + NewDebug = sys_debug(Debug, S, {in,Event}), + %% Here the queue of not yet processed events is created + loop_events(Parent, NewDebug, S, [Event], false). + +%% Process first the event queue, or if it is empty +%% loop back to receive a new event +loop_events(Parent, Debug, S, [], _Hibernate) -> + loop(Parent, Debug, S); +loop_events( + Parent, Debug, + #{callback_mode := CallbackMode, + module := Module, + state := State, + data := Data} = S, + [{Type,Content} = Event|Events] = Q, + Hibernate) -> + %% If the Hibernate flag is true here it can only be + %% because it was set from an event action + %% and we did not go into hibernation since there + %% were events in queue, so we do what the user + %% might depend on i.e collect garbage which + %% would have happened if we actually hibernated + %% and immediately was awakened + Hibernate andalso garbage_collect(), + try + case CallbackMode of + state_functions -> + Module:State(Type, Content, Data); + handle_event_function -> + Module:handle_event(Type, Content, State, Data) + end of + Result -> + loop_event_result( + Parent, Debug, S, Events, Event, Result) + catch + Result -> + loop_event_result( + Parent, Debug, S, Events, Event, Result); + error:badarg when CallbackMode =:= state_functions -> + case erlang:get_stacktrace() of + [{erlang,apply,[Module,State,_],_}|Stacktrace] -> + Args = [Type,Content,Data], + terminate( + error, + {undef_state_function,{Module,State,Args}}, + Stacktrace, + Debug, S, Q); + Stacktrace -> + terminate(error, badarg, Stacktrace, Debug, S, Q) + end; + error:undef -> + %% Process an undef to check for the simple mistake + %% of calling a nonexistent state function + case erlang:get_stacktrace() of + [{Module,State, + [Type,Content,Data]=Args, + _} + |Stacktrace] + when CallbackMode =:= state_functions -> + terminate( + error, + {undef_state_function,{Module,State,Args}}, + Stacktrace, + Debug, S, Q); + [{Module,handle_event, + [Type,Content,State,Data]=Args, + _} + |Stacktrace] + when CallbackMode =:= handle_event_function -> + terminate( + error, + {undef_state_function, + {Module,handle_event,Args}}, + Stacktrace, + Debug, S, Q); + Stacktrace -> + terminate(error, undef, Stacktrace, Debug, S, Q) + end; + Class:Reason -> + Stacktrace = erlang:get_stacktrace(), + terminate(Class, Reason, Stacktrace, Debug, S, Q) + end. + +%% Interpret all callback return variants +loop_event_result( + Parent, Debug, + #{state := State, data := Data} = S, + Events, Event, Result) -> + %% From now until we loop back to the loop_events/4 + %% the state and data fields in S are old + case Result of + stop -> + ?TERMINATE(exit, normal, Debug, S, [Event|Events]); + {stop,Reason} -> + ?TERMINATE(exit, Reason, Debug, S, [Event|Events]); + {stop,Reason,NewData} -> + NewS = S#{data := NewData}, + Q = [Event|Events], + ?TERMINATE(exit, Reason, Debug, NewS, Q); + {stop_and_reply,Reason,Replies} -> + Q = [Event|Events], + [Class,NewReason,Stacktrace,NewDebug] = + reply_then_terminate( + exit, Reason, ?STACKTRACE(), Debug, S, Q, Replies), + %% Since we got back here Replies was bad + terminate(Class, NewReason, Stacktrace, NewDebug, S, Q); + {stop_and_reply,Reason,Replies,NewData} -> + NewS = S#{data := NewData}, + Q = [Event|Events], + [Class,NewReason,Stacktrace,NewDebug] = + reply_then_terminate( + exit, Reason, ?STACKTRACE(), Debug, NewS, Q, Replies), + %% Since we got back here Replies was bad + terminate(Class, NewReason, Stacktrace, NewDebug, NewS, Q); + {next_state,NextState,NewData} -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, []); + {next_state,NextState,NewData,Actions} -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions); + {keep_state,NewData} -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, State, NewData, []); + {keep_state,NewData,Actions} -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, State, NewData, Actions); + keep_state_and_data -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, State, Data, []); + {keep_state_and_data,Actions} -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, State, Data, Actions); + _ -> + ?TERMINATE( + error, {bad_return_value,Result}, Debug, S, [Event|Events]) + end. + +loop_event_actions( + Parent, Debug, S, Events, Event, State, NextState, NewData, Actions) -> + Postpone = false, % Shall we postpone this event, true or false + Hibernate = false, + Timeout = undefined, + NextEvents = [], + loop_event_actions( + Parent, Debug, S, Events, Event, State, NextState, NewData, + if + is_list(Actions) -> + Actions; + true -> + [Actions] + end, + Postpone, Hibernate, Timeout, NextEvents). +%% +%% Process all action()s +loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, [Action|Actions], + Postpone, Hibernate, Timeout, NextEvents) -> + case Action of + %% Actual actions + {reply,From,Reply} -> + case from(From) of + true -> + NewDebug = do_reply(Debug, S, From, Reply), + loop_event_actions( + Parent, NewDebug, S, Events, Event, + State, NextState, NewData, Actions, + Postpone, Hibernate, Timeout, NextEvents); + false -> + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]) + end; + {next_event,Type,Content} -> + case event_type(Type) of + true -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions, + Postpone, Hibernate, Timeout, + [{Type,Content}|NextEvents]); + false -> + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]) + end; + %% Actions that set options + {postpone,NewPostpone} when is_boolean(NewPostpone) -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions, + NewPostpone, Hibernate, Timeout, NextEvents); + {postpone,_} -> + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]); + postpone -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions, + true, Hibernate, Timeout, NextEvents); + {hibernate,NewHibernate} when is_boolean(NewHibernate) -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions, + Postpone, NewHibernate, Timeout, NextEvents); + {hibernate,_} -> + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]); + hibernate -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions, + Postpone, true, Timeout, NextEvents); + {timeout,infinity,_} -> % Clear timer - it will never trigger + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions, + Postpone, Hibernate, undefined, NextEvents); + {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions, + Postpone, Hibernate, NewTimeout, NextEvents); + {timeout,_,_} -> + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]); + infinity -> % Clear timer - it will never trigger + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions, + Postpone, Hibernate, undefined, NextEvents); + Time when is_integer(Time), Time >= 0 -> + NewTimeout = {timeout,Time,Time}, + loop_event_actions( + Parent, Debug, S, Events, Event, + State, NextState, NewData, Actions, + Postpone, Hibernate, NewTimeout, NextEvents); + _ -> + ?TERMINATE( + error, {bad_action,Action}, Debug, S, [Event|Events]) + end; +%% +%% End of actions list +loop_event_actions( + Parent, Debug, #{postponed := P0} = S, Events, Event, + State, NextState, NewData, [], + Postpone, Hibernate, Timeout, NextEvents) -> + %% + %% All options have been collected and next_events are buffered. + %% Do the actual state transition. + %% + P1 = % Move current event to postponed if Postpone + case Postpone of + true -> + [Event|P0]; + false -> + P0 + end, + {Q2,P} = % Move all postponed events to queue if state change + if + NextState =:= State -> + {Events,P1}; + true -> + {lists:reverse(P1, Events),[]} + end, + %% Place next events first in queue + Q3 = lists:reverse(NextEvents, Q2), + %% + NewDebug = + sys_debug( + Debug, S, + case Postpone of + true -> + {postpone,Event,NextState}; + false -> + {consume,Event,NextState} + end), + %% Have a peek on the event queue so we can avoid starting + %% the state timer unless we have to + {Q,Timer} = + case Timeout of + undefined -> + %% No state timeout has been requested + {Q3,undefined}; + {timeout,Time,EventContent} -> + %% A state timeout has been requested + case Q3 of + [] when Time =:= 0 -> + %% Immediate timeout - simulate it + %% so we do not get the timeout message + %% after any received event + {[{timeout,EventContent}],undefined}; + [] -> + %% Actually start a timer + {Q3,erlang:start_timer(Time, self(), EventContent)}; + _ -> + %% Do not start a timer since any queued + %% event cancels the state timer so we pretend + %% that the timer has been started and cancelled + {Q3,undefined} + end + end, + %% Loop to top of event queue loop; process next event + loop_events( + Parent, NewDebug, + S#{ + state := NextState, + data := NewData, + timer := Timer, + postponed := P, + hibernate := Hibernate}, + Q, Hibernate). + +%%--------------------------------------------------------------------------- +%% Server helpers + +reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, Replies) -> + if + is_list(Replies) -> + do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, S, Q, Replies); + true -> + do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, S, Q, [Replies]) + end. +%% +do_reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, []) -> + terminate(Class, Reason, Stacktrace, Debug, S, Q); +do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, S, Q, [R|Rs]) -> + case R of + {reply,{_To,_Tag}=From,Reply} -> + NewDebug = do_reply(Debug, S, From, Reply), + do_reply_then_terminate( + Class, Reason, Stacktrace, NewDebug, S, Q, Rs); + _ -> + [error,{bad_action,R},?STACKTRACE(),Debug] + end. + +do_reply(Debug, S, From, Reply) -> + reply(From, Reply), + sys_debug(Debug, S, {out,Reply,From}). + + +terminate( + Class, Reason, Stacktrace, Debug, + #{module := Module, + state := State, data := Data} = S, + Q) -> + try Module:terminate(Reason, State, Data) of + _ -> ok + catch + _ -> ok; + C:R -> + ST = erlang:get_stacktrace(), + error_info( + C, R, ST, Debug, S, Q, + format_status(terminate, get(), S)), + erlang:raise(C, R, ST) + end, + case Reason of + normal -> ok; + shutdown -> ok; + {shutdown,_} -> ok; + _ -> + error_info( + Class, Reason, Stacktrace, Debug, S, Q, + format_status(terminate, get(), S)) + end, + case Stacktrace of + [] -> + erlang:Class(Reason); + _ -> + erlang:raise(Class, Reason, Stacktrace) + end. + +error_info( + Class, Reason, Stacktrace, Debug, + #{name := Name, callback_mode := CallbackMode, + state := State, postponed := P}, + Q, FmtData) -> + {FixedReason,FixedStacktrace} = + case Stacktrace of + [{M,F,Args,_}|ST] + when Class =:= error, Reason =:= undef -> + case code:is_loaded(M) of + false -> + {{'module could not be loaded',M},ST}; + _ -> + Arity = + if + is_list(Args) -> + length(Args); + is_integer(Args) -> + Args + end, + case erlang:function_exported(M, F, Arity) of + true -> + {Reason,Stacktrace}; + false -> + {{'function not exported',{M,F,Arity}}, + ST} + end + end; + _ -> {Reason,Stacktrace} + end, + error_logger:format( + "** State machine ~p terminating~n" ++ + case Q of + [] -> + ""; + _ -> + "** Last event = ~p~n" + end ++ + "** When Server state = ~p~n" ++ + "** Reason for termination = ~w:~p~n" ++ + "** State = ~p~n" ++ + "** Callback mode = ~p~n" ++ + "** Queued/Postponed = ~w/~w~n" ++ + case FixedStacktrace of + [] -> + ""; + _ -> + "** Stacktrace =~n" + "** ~p~n" + end, + [Name | + case Q of + [] -> + []; + [Event|_] -> + [Event] + end] ++ + [FmtData,Class,FixedReason, + State,CallbackMode,length(Q),length(P)] ++ + case FixedStacktrace of + [] -> + []; + _ -> + [FixedStacktrace] + end), + sys:print_log(Debug), + ok. + + +%% Call Module:format_status/2 or return a default value +format_status( + Opt, PDict, + #{module := Module, state := State, data := Data}) -> + case erlang:function_exported(Module, format_status, 2) of + true -> + try Module:format_status(Opt, [PDict,State,Data]) + catch + Result -> Result; + _:_ -> + format_status_default( + Opt, State, + "Module:format_status/2 crashed") + end; + false -> + format_status_default(Opt, State, Data) + end. + +%% The default Module:format_status/2 +format_status_default(Opt, State, Data) -> + SSD = {State,Data}, + case Opt of + terminate -> + SSD; + _ -> + [{data,[{"State",SSD}]}] + end. diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index f070a7192d..ad98bc0420 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -112,14 +112,14 @@ -type format_spec() :: #{ - control_char => char(), - args => [any()], - width => 'none' | integer(), - adjust => 'left' | 'right', - precision => 'none' | integer(), - pad_char => char(), - encoding => 'unicode' | 'latin1', - strings => boolean() + control_char := char(), + args := [any()], + width := 'none' | integer(), + adjust := 'left' | 'right', + precision := 'none' | integer(), + pad_char := char(), + encoding := 'unicode' | 'latin1', + strings := boolean() }. %%---------------------------------------------------------------------- diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index 2b4472cdf7..af9d63ddd6 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -39,7 +39,8 @@ -export([all/2,any/2,map/2,flatmap/2,foldl/3,foldr/3,filter/2, partition/2,zf/2,filtermap/2, mapfoldl/3,mapfoldr/3,foreach/2,takewhile/2,dropwhile/2,splitwith/2, - split/2]). + split/2, + join/2]). %%% BIFs -export([keyfind/3, keymember/3, keysearch/3, member/2, reverse/2]). @@ -1439,6 +1440,18 @@ split(N, [H|T], R) -> split(_, [], _) -> badarg. +-spec join(Sep, List1) -> List2 when + Sep :: T, + List1 :: [T], + List2 :: [T], + T :: term(). + +join(_Sep, []) -> []; +join(Sep, [H|T]) -> [H|join_prepend(Sep, T)]. + +join_prepend(_Sep, []) -> []; +join_prepend(Sep, [H|T]) -> [Sep,H|join_prepend(Sep,T)]. + %%% ================================================================= %%% Here follows the implementation of the sort functions. %%% diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index a52928f77f..5dafdb282a 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -20,17 +20,18 @@ -module(maps). --export([get/3,filter/2,fold/3, map/2, - size/1, +-export([get/3, filter/2,fold/3, + map/2, size/1, + update_with/3, update_with/4, without/2, with/2]). - -%%% BIFs +%% BIFs -export([get/2, find/2, from_list/1, is_key/2, keys/1, merge/2, - new/0, put/3, remove/2, + new/0, put/3, remove/2, take/2, to_list/1, update/3, values/1]). +%% Shadowed by erl_bif_types: maps:get/2 -spec get(Key,Map) -> Value when Key :: term(), Map :: map(), @@ -46,7 +47,7 @@ get(_,_) -> erlang:nif_error(undef). find(_,_) -> erlang:nif_error(undef). - +%% Shadowed by erl_bif_types: maps:from_list/1 -spec from_list(List) -> Map when List :: [{Key,Value}], Key :: term(), @@ -56,6 +57,7 @@ find(_,_) -> erlang:nif_error(undef). from_list(_) -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:is_key/2 -spec is_key(Key,Map) -> boolean() when Key :: term(), Map :: map(). @@ -71,6 +73,7 @@ is_key(_,_) -> erlang:nif_error(undef). keys(_) -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:merge/2 -spec merge(Map1,Map2) -> Map3 when Map1 :: map(), Map2 :: map(), @@ -86,6 +89,7 @@ merge(_,_) -> erlang:nif_error(undef). new() -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:put/3 -spec put(Key,Value,Map1) -> Map2 when Key :: term(), Value :: term(), @@ -102,7 +106,15 @@ put(_,_,_) -> erlang:nif_error(undef). remove(_,_) -> erlang:nif_error(undef). +-spec take(Key,Map1) -> {Value,Map2} | error when + Key :: term(), + Map1 :: map(), + Value :: term(), + Map2 :: map(). + +take(_,_) -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:to_list/1 -spec to_list(Map) -> [{Key,Value}] when Map :: map(), Key :: term(), @@ -111,6 +123,7 @@ remove(_,_) -> erlang:nif_error(undef). to_list(_) -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:update/3 -spec update(Key,Value,Map1) -> Map2 when Key :: term(), Value :: term(), @@ -127,8 +140,40 @@ update(_,_,_) -> erlang:nif_error(undef). values(_) -> erlang:nif_error(undef). +%% End of BIFs + +-spec update_with(Key,Fun,Map1) -> Map2 when + Key :: term(), + Map1 :: map(), + Map2 :: map(), + Fun :: fun((Value1 :: term()) -> Value2 :: term()). + +update_with(Key,Fun,Map) when is_function(Fun,1), is_map(Map) -> + try maps:get(Key,Map) of + Val -> maps:update(Key,Fun(Val),Map) + catch + error:{badkey,_} -> + erlang:error({badkey,Key},[Key,Fun,Map]) + end; +update_with(Key,Fun,Map) -> + erlang:error(error_type(Map),[Key,Fun,Map]). + + +-spec update_with(Key,Fun,Init,Map1) -> Map2 when + Key :: term(), + Map1 :: Map1, + Map2 :: Map2, + Fun :: fun((Value1 :: term()) -> Value2 :: term()), + Init :: term(). + +update_with(Key,Fun,Init,Map) when is_function(Fun,1), is_map(Map) -> + case maps:find(Key,Map) of + {ok,Val} -> maps:update(Key,Fun(Val),Map); + error -> maps:put(Key,Init,Map) + end; +update_with(Key,Fun,Init,Map) -> + erlang:error(error_type(Map),[Key,Fun,Init,Map]). -%%% End of BIFs -spec get(Key, Map, Default) -> Value | Default when Key :: term(), diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 052dffdbfd..7a59523f06 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -58,7 +58,12 @@ obsolete_1(erlang, now, 0) -> obsolete_1(calendar, local_time_to_universal_time, 1) -> {deprecated, {calendar, local_time_to_universal_time_dst, 1}}; -%% *** CRYPTO add in R16B01 *** +%% *** CRYPTO added in OTP 19 *** + +obsolete_1(crypto, rand_bytes, 1) -> + {deprecated, {crypto, strong_rand_bytes, 1}}; + +%% *** CRYPTO added in R16B01 *** obsolete_1(crypto, md4, 1) -> {deprecated, {crypto, hash, 2}}; diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index c47d30c8b8..3f79ed0f87 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -472,13 +472,15 @@ trans_init(gen,init_it,[gen_server,_,_,supervisor_bridge,[Module|_],_]) -> {supervisor_bridge,Module,1}; trans_init(gen,init_it,[gen_server,_,_,_,supervisor_bridge,[Module|_],_]) -> {supervisor_bridge,Module,1}; -trans_init(gen,init_it,[gen_server,_,_,Module,_,_]) -> +trans_init(gen,init_it,[GenMod,_,_,Module,_,_]) + when GenMod =:= gen_server; + GenMod =:= gen_statem; + GenMod =:= gen_fsm -> {Module,init,1}; -trans_init(gen,init_it,[gen_server,_,_,_,Module|_]) -> - {Module,init,1}; -trans_init(gen,init_it,[gen_fsm,_,_,Module,_,_]) -> - {Module,init,1}; -trans_init(gen,init_it,[gen_fsm,_,_,_,Module|_]) -> +trans_init(gen,init_it,[GenMod,_,_,_,Module|_]) + when GenMod =:= gen_server; + GenMod =:= gen_statem; + GenMod =:= gen_fsm -> {Module,init,1}; trans_init(gen,init_it,[gen_event|_]) -> {gen_event,init_it,6}; diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index d455abf7b0..93409d95df 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -44,11 +44,11 @@ %% This depends on the algorithm handler function -type alg_seed() :: exs64_state() | exsplus_state() | exs1024_state(). %% This is the algorithm handler function within this module --type alg_handler() :: #{type => alg(), - max => integer(), - next => fun(), - uniform => fun(), - uniform_n => fun()}. +-type alg_handler() :: #{type := alg(), + max := integer(), + next := fun(), + uniform := fun(), + uniform_n := fun()}. %% Internal state -opaque state() :: {alg_handler(), alg_seed()}. diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index e3950ee795..32bcdc4f2a 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -65,6 +65,7 @@ gen_event, gen_fsm, gen_server, + gen_statem, io, io_lib, io_lib_format, diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 37c3927739..38b764541a 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -57,8 +57,8 @@ | {'global', Name :: atom()} | {'via', Module :: module(), Name :: any()} | pid(). --type child_spec() :: #{id => child_id(), % mandatory - start => mfargs(), % mandatory +-type child_spec() :: #{id := child_id(), % mandatory + start := mfargs(), % mandatory restart => restart(), % optional shutdown => shutdown(), % optional type => worker(), % optional diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 287f63b2be..28c35aed55 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -46,6 +46,7 @@ MODULES= \ gen_event_SUITE \ gen_fsm_SUITE \ gen_server_SUITE \ + gen_statem_SUITE \ id_transform_SUITE \ io_SUITE \ io_proto_SUITE \ diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 29a389d4b8..6fea198af3 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -2703,9 +2703,8 @@ otp_11872(Config) when is_list(Config) -> t() -> 1. ">>, - {error,[{6,erl_lint,{undefined_type,{product,0}}}, - {8,erl_lint,{undefined_type,{dict,0}}}], - [{8,erl_lint,{new_builtin_type,{map,0}}}]} = + {errors,[{6,erl_lint,{undefined_type,{product,0}}}, + {8,erl_lint,{builtin_type,{map,0}}}], []} = run_test2(Config, Ts, []), ok. @@ -3689,7 +3688,7 @@ maps_type(Config) when is_list(Config) -> t(M) -> M. ">>, [], - {warnings,[{3,erl_lint,{new_builtin_type,{map,0}}}]}}], + {errors,[{3,erl_lint,{builtin_type,{map,0}}}],[]}}], [] = run(Config, Ts), ok. diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 6dc285e448..a48ba7b5b7 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -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_11861/1]). + otp_10302/1, otp_10820/1, otp_11100/1, otp_11861/1, pr_1014/1]). %% Internal export. -export([ehook/6]). @@ -79,7 +79,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_11861]}]. + otp_10302, otp_10820, otp_11100, otp_11861, pr_1014]}]. init_per_suite(Config) -> Config. @@ -902,6 +902,7 @@ maps_syntax(Config) when is_list(Config) -> "-compile(export_all).\n" "-type t1() :: map().\n" "-type t2() :: #{ atom() => integer(), atom() => float() }.\n" + "-type t3() :: #{ atom() := integer(), atom() := float() }.\n" "-type u() :: #{a => (I :: integer()) | (A :: atom()),\n" " (X :: atom()) | (Y :: atom()) =>\n" " (I :: integer()) | (A :: atom())}.\n" @@ -1106,6 +1107,24 @@ otp_11861(Config) when is_list(Config) -> pf(Form) -> lists:flatten(erl_pp:form(Form, none)). +pr_1014(Config) -> + ok = pp_forms(<<"-type t() :: #{_ => _}. ">>), + ok = pp_forms(<<"-type t() :: #{any() => _}. ">>), + ok = pp_forms(<<"-type t() :: #{_ => any()}. ">>), + ok = pp_forms(<<"-type t() :: #{any() => any()}. ">>), + ok = pp_forms(<<"-type t() :: #{...}. ">>), + ok = pp_forms(<<"-type t() :: #{atom() := integer(), ...}. ">>), + + FileName = filename('pr_1014.erl', Config), + C = <<"-module pr_1014.\n" + "-compile export_all.\n" + "-type m() :: #{..., a := integer()}.\n">>, + ok = file:write_file(FileName, C), + {error,[{_,[{3,erl_parse,["syntax error before: ","','"]}]}],_} = + compile:file(FileName, [return]), + + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% compile(Config, Tests) -> diff --git a/lib/stdlib/test/error_logger_forwarder.erl b/lib/stdlib/test/error_logger_forwarder.erl index 0aecd41ba9..6bbf180585 100644 --- a/lib/stdlib/test/error_logger_forwarder.erl +++ b/lib/stdlib/test/error_logger_forwarder.erl @@ -20,7 +20,7 @@ -module(error_logger_forwarder). %% API. --export([register/0]). +-export([register/0, unregister/0]). %% Internal export for error_logger. -export([init/1, @@ -33,6 +33,10 @@ register() -> error_logger:add_report_handler(?MODULE, self()). +unregister() -> + Self = self(), + Self = error_logger:delete_report_handler(?MODULE). + init(Tester) -> {ok,Tester}. diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl new file mode 100644 index 0000000000..3deb5fd986 --- /dev/null +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -0,0 +1,1578 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(gen_statem_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-compile(export_all). +-behaviour(gen_statem). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. + +all() -> + [{group, start}, + {group, start_handle_event}, + {group, stop}, + {group, stop_handle_event}, + {group, abnormal}, + {group, abnormal_handle_event}, + shutdown, stop_and_reply, event_order, + {group, sys}, + hibernate, enter_loop]. + +groups() -> + [{start, [], + [start1, start2, start3, start4, start5, start6, start7, + start8, start9, start10, start11, start12, next_events]}, + {start_handle_event, [], + [start1, start2, start3, start4, start5, start6, start7, + start8, start9, start10, start11, start12, next_events]}, + {stop, [], + [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]}, + {stop_handle_event, [], + [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]}, + {abnormal, [], [abnormal1, abnormal2]}, + {abnormal_handle_event, [], [abnormal1, abnormal2]}, + {sys, [], + [sys1, code_change, + call_format_status, + error_format_status, terminate_crash_format, + get_state, replace_state]}, + {sys_handle_event, [], + [sys1, + call_format_status, + error_format_status, terminate_crash_format, + get_state, replace_state]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(GroupName, Config) + when GroupName =:= start_handle_event; + GroupName =:= stop_handle_event; + GroupName =:= abnormal_handle_event; + GroupName =:= sys_handle_event -> + [{callback_mode,handle_event_function}|Config]; +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(_CaseName, Config) -> + flush(), +%%% dbg:tracer(), +%%% dbg:p(all, c), +%%% dbg:tpl(gen_statem, cx), +%%% dbg:tpl(proc_lib, cx), +%%% dbg:tpl(gen, cx), +%%% dbg:tpl(sys, cx), + Config. + +end_per_testcase(_CaseName, Config) -> +%%% dbg:stop(), + Config. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-define(EXPECT_FAILURE(Code, Reason), + try begin Code end of + Reason -> + ct:fail({unexpected,Reason}) + catch + error:Reason -> Reason; + exit:Reason -> Reason + end). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% anonymous +start1(Config) -> + %%OldFl = process_flag(trap_exit, true), + + {ok,Pid0} = gen_statem:start_link(?MODULE, start_arg(Config, []), []), + ok = do_func_test(Pid0), + ok = do_sync_func_test(Pid0), + stop_it(Pid0), +%% stopped = gen_statem:call(Pid0, stop), +%% timeout = +%% ?EXPECT_FAILURE(gen_statem:call(Pid0, hej), Reason), + + %%process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +%% anonymous w. shutdown +start2(Config) -> + %% Dont link when shutdown + {ok,Pid0} = gen_statem:start(?MODULE, start_arg(Config, []), []), + ok = do_func_test(Pid0), + ok = do_sync_func_test(Pid0), + stopped = gen_statem:call(Pid0, {stop,shutdown}), + check_stopped(Pid0), + ok = verify_empty_msgq(). + +%% anonymous with timeout +start3(Config) -> + %%OldFl = process_flag(trap_exit, true), + + {ok,Pid0} = + gen_statem:start(?MODULE, start_arg(Config, []), [{timeout,5}]), + ok = do_func_test(Pid0), + ok = do_sync_func_test(Pid0), + stop_it(Pid0), + + {error,timeout} = + gen_statem:start( + ?MODULE, start_arg(Config, sleep), [{timeout,5}]), + + %%process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +%% anonymous with ignore +start4(Config) -> + OldFl = process_flag(trap_exit, true), + + ignore = gen_statem:start(?MODULE, start_arg(Config, ignore), []), + + process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +%% anonymous with stop +start5(Config) -> + OldFl = process_flag(trap_exit, true), + + {error,stopped} = gen_statem:start(?MODULE, start_arg(Config, stop), []), + + process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +%% anonymous linked +start6(Config) -> + {ok,Pid} = gen_statem:start_link(?MODULE, start_arg(Config, []), []), + ok = do_func_test(Pid), + ok = do_sync_func_test(Pid), + stop_it(Pid), + + ok = verify_empty_msgq(). + +%% global register linked +start7(Config) -> + STM = {global,my_stm}, + + {ok,Pid} = + gen_statem:start_link(STM, ?MODULE, start_arg(Config, []), []), + {error,{already_started,Pid}} = + gen_statem:start_link(STM, ?MODULE, start_arg(Config, []), []), + {error,{already_started,Pid}} = + gen_statem:start(STM, ?MODULE, start_arg(Config, []), []), + + ok = do_func_test(Pid), + ok = do_sync_func_test(Pid), + ok = do_func_test(STM), + ok = do_sync_func_test(STM), + stop_it(STM), + + ok = verify_empty_msgq(). + + +%% local register +start8(Config) -> + %%OldFl = process_flag(trap_exit, true), + Name = my_stm, + STM = {local,Name}, + + {ok,Pid} = + gen_statem:start(STM, ?MODULE, start_arg(Config, []), []), + {error,{already_started,Pid}} = + gen_statem:start(STM, ?MODULE, start_arg(Config, []), []), + + ok = do_func_test(Pid), + ok = do_sync_func_test(Pid), + ok = do_func_test(Name), + ok = do_sync_func_test(Name), + stop_it(Pid), + + %%process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +%% local register linked +start9(Config) -> + %%OldFl = process_flag(trap_exit, true), + Name = my_stm, + STM = {local,Name}, + + {ok,Pid} = + gen_statem:start_link(STM, ?MODULE, start_arg(Config, []), []), + {error,{already_started,Pid}} = + gen_statem:start(STM, ?MODULE, start_arg(Config, []), []), + + ok = do_func_test(Pid), + ok = do_sync_func_test(Pid), + ok = do_func_test(Name), + ok = do_sync_func_test(Name), + stop_it(Pid), + + %%process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +%% global register +start10(Config) -> + STM = {global,my_stm}, + + {ok,Pid} = + gen_statem:start(STM, ?MODULE, start_arg(Config, []), []), + {error,{already_started,Pid}} = + gen_statem:start(STM, ?MODULE, start_arg(Config, []), []), + {error,{already_started,Pid}} = + gen_statem:start_link(STM, ?MODULE, start_arg(Config, []), []), + + ok = do_func_test(Pid), + ok = do_sync_func_test(Pid), + ok = do_func_test(STM), + ok = do_sync_func_test(STM), + stop_it(STM), + + ok = verify_empty_msgq(). + +%% Stop registered processes +start11(Config) -> + Name = my_stm, + LocalSTM = {local,Name}, + GlobalSTM = {global,Name}, + + {ok,Pid} = + gen_statem:start_link(LocalSTM, ?MODULE, start_arg(Config, []), []), + stop_it(Pid), + + {ok,_Pid1} = + gen_statem:start_link(LocalSTM, ?MODULE, start_arg(Config, []), []), + stop_it(Name), + + {ok,Pid2} = + gen_statem:start(GlobalSTM, ?MODULE, start_arg(Config, []), []), + stop_it(Pid2), + receive after 1 -> true end, + Result = + gen_statem:start(GlobalSTM, ?MODULE, start_arg(Config, []), []), + ct:log("Result = ~p~n",[Result]), + {ok,_Pid3} = Result, + stop_it(GlobalSTM), + + ok = verify_empty_msgq(). + +%% Via register linked +start12(Config) -> + dummy_via:reset(), + VIA = {via,dummy_via,my_stm}, + + {ok,Pid} = + gen_statem:start_link(VIA, ?MODULE, start_arg(Config, []), []), + {error,{already_started,Pid}} = + gen_statem:start_link(VIA, ?MODULE, start_arg(Config, []), []), + {error,{already_started,Pid}} = + gen_statem:start(VIA, ?MODULE, start_arg(Config, []), []), + + ok = do_func_test(Pid), + ok = do_sync_func_test(Pid), + ok = do_func_test(VIA), + ok = do_sync_func_test(VIA), + stop_it(VIA), + + ok = verify_empty_msgq(). + + +%% Anonymous, reason 'normal' +stop1(Config) -> + {ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []), + ok = gen_statem:stop(Pid), + false = erlang:is_process_alive(Pid), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(Pid), Reason). + +%% Anonymous, other reason +stop2(Config) -> + {ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []), + ok = gen_statem:stop(Pid, other_reason, infinity), + false = erlang:is_process_alive(Pid), + ok. + +%% Anonymous, invalid timeout +stop3(Config) -> + {ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []), + _ = + ?EXPECT_FAILURE( + gen_statem:stop(Pid, other_reason, invalid_timeout), + Reason), + true = erlang:is_process_alive(Pid), + ok = gen_statem:stop(Pid), + false = erlang:is_process_alive(Pid), + ok. + +%% Registered name +stop4(Config) -> + {ok,Pid} = + gen_statem:start( + {local,to_stop},?MODULE, start_arg(Config, []), []), + ok = gen_statem:stop(to_stop), + false = erlang:is_process_alive(Pid), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(to_stop), Reason), + ok. + +%% Registered name and local node +stop5(Config) -> + Name = to_stop, + {ok,Pid} = + gen_statem:start( + {local,Name},?MODULE, start_arg(Config, []), []), + ok = gen_statem:stop({Name,node()}), + false = erlang:is_process_alive(Pid), + noproc = + ?EXPECT_FAILURE(gen_statem:stop({Name,node()}), Reason), + ok. + +%% Globally registered name +stop6(Config) -> + STM = {global,to_stop}, + {ok,Pid} = gen_statem:start(STM, ?MODULE, start_arg(Config, []), []), + ok = gen_statem:stop(STM), + false = erlang:is_process_alive(Pid), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(STM), Reason), + ok. + +%% 'via' registered name +stop7(Config) -> + VIA = {via,dummy_via,to_stop}, + dummy_via:reset(), + {ok,Pid} = gen_statem:start(VIA, ?MODULE, start_arg(Config, []), []), + ok = gen_statem:stop(VIA), + false = erlang:is_process_alive(Pid), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(VIA), Reason), + ok. + +%% Anonymous on remote node +stop8(Config) -> + Node = gen_statem_stop8, + {ok,NodeName} = ct_slave:start(Node), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(NodeName, code, add_path, [Dir]), + {ok,Pid} = + rpc:call( + NodeName, gen_statem,start, + [?MODULE,start_arg(Config, []),[]]), + ok = gen_statem:stop(Pid), + false = rpc:call(NodeName, erlang, is_process_alive, [Pid]), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(Pid), Reason1), + {ok,NodeName} = ct_slave:stop(Node), + {{nodedown,NodeName},{sys,terminate,_}} = + ?EXPECT_FAILURE(gen_statem:stop(Pid), Reason2), + ok. + +%% Registered name on remote node +stop9(Config) -> + Name = to_stop, + LocalSTM = {local,Name}, + Node = gen_statem__stop9, + {ok,NodeName} = ct_slave:start(Node), + STM = {Name,NodeName}, + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(NodeName, code, add_path, [Dir]), + {ok,Pid} = + rpc:call( + NodeName, gen_statem, start, + [LocalSTM,?MODULE,start_arg(Config, []),[]]), + ok = gen_statem:stop(STM), + undefined = rpc:call(NodeName,erlang,whereis,[Name]), + false = rpc:call(NodeName,erlang,is_process_alive,[Pid]), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(STM), Reason1), + {ok,NodeName} = ct_slave:stop(Node), + {{nodedown,NodeName},{sys,terminate,_}} = + ?EXPECT_FAILURE(gen_statem:stop(STM), Reason2), + ok. + +%% Globally registered name on remote node +stop10(Config) -> + Node = gen_statem_stop10, + STM = {global,to_stop}, + {ok,NodeName} = ct_slave:start(Node), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(NodeName,code,add_path,[Dir]), + {ok,Pid} = + rpc:call( + NodeName, gen_statem, start, + [STM,?MODULE,start_arg(Config, []),[]]), + global:sync(), + ok = gen_statem:stop(STM), + false = rpc:call(NodeName, erlang, is_process_alive, [Pid]), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(STM), Reason1), + {ok,NodeName} = ct_slave:stop(Node), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(STM), Reason2), + ok. + +%% Check that time outs in calls work +abnormal1(Config) -> + Name = abnormal1, + LocalSTM = {local,Name}, + + {ok, _Pid} = + gen_statem:start(LocalSTM, ?MODULE, start_arg(Config, []), []), + + %% timeout call. + delayed = gen_statem:call(Name, {delayed_answer,1}, 100), + {timeout,_} = + ?EXPECT_FAILURE( + gen_statem:call(Name, {delayed_answer,1000}, 10), + Reason), + ok = gen_statem:stop(Name), + ok = verify_empty_msgq(). + +%% Check that bad return values makes the stm crash. Note that we must +%% trap exit since we must link to get the real bad_return_ error +abnormal2(Config) -> + OldFl = process_flag(trap_exit, true), + {ok,Pid} = gen_statem:start_link(?MODULE, start_arg(Config, []), []), + + %% bad return value in the gen_statem loop + {{bad_return_value,badreturn},_} = + ?EXPECT_FAILURE(gen_statem:call(Pid, badreturn), Reason), + receive + {'EXIT',Pid,{bad_return_value,badreturn}} -> ok + after 5000 -> + ct:fail(gen_statem_did_not_die) + end, + + process_flag(trap_exit, OldFl), + ok = verify_empty_msgq(). + +shutdown(Config) -> + process_flag(trap_exit, true), + + {ok,Pid0} = gen_statem:start_link(?MODULE, start_arg(Config, []), []), + ok = do_func_test(Pid0), + ok = do_sync_func_test(Pid0), + stopped = gen_statem:call(Pid0, {stop,{shutdown,reason}}), + receive {'EXIT',Pid0,{shutdown,reason}} -> ok end, + process_flag(trap_exit, false), + + {noproc,_} = + ?EXPECT_FAILURE(gen_statem:call(Pid0, hej), Reason), + + receive + Any -> + ct:log("Unexpected: ~p", [Any]), + ct:fail({unexpected,Any}) + after 500 -> + ok + end. + + + +stop_and_reply(_Config) -> + process_flag(trap_exit, true), + + Machine = + %% Abusing the internal format of From... + #{init => + fun () -> + {ok,start,undefined} + end, + start => + fun (cast, {echo,From1,Reply1}, undefined) -> + {next_state,wait,{reply,From1,Reply1}} + end, + wait => + fun (cast, {stop_and_reply,Reason,From2,Reply2},R1) -> + {stop_and_reply,Reason, + [R1,{reply,From2,Reply2}]} + end}, + {ok,STM} = gen_statem:start_link(?MODULE, {map_statem,Machine}, []), + + Self = self(), + Tag1 = make_ref(), + gen_statem:cast(STM, {echo,{Self,Tag1},reply1}), + Tag2 = make_ref(), + gen_statem:cast(STM, {stop_and_reply,reason,{Self,Tag2},reply2}), + case flush() of + [{Tag1,reply1},{Tag2,reply2},{'EXIT',STM,reason}] -> + ok; + Other1 -> + ct:fail({unexpected,Other1}) + end, + + {noproc,_} = + ?EXPECT_FAILURE(gen_statem:call(STM, hej), Reason), + case flush() of + [] -> + ok; + Other2 -> + ct:fail({unexpected,Other2}) + end. + + + +event_order(_Config) -> + process_flag(trap_exit, true), + + Machine = + %% Abusing the internal format of From... + #{init => + fun () -> + {ok,start,undefined} + end, + start => + fun (cast, _, _) -> + {keep_state_and_data,postpone}; %% Handled in 'buffer' + ({call,From}, {buffer,Pid,[Tag3,Tag4,Tag5]}, + undefined) -> + {next_state,buffer,[], + [{next_event,internal,{reply,{Pid,Tag3},ok3}}, + {next_event,internal,{reply,{Pid,Tag4},ok4}}, + {timeout,0,{reply,{Pid,Tag5},ok5}}, + %% The timeout should not happen since there + %% are events that cancel it i.e next_event + %% and postponed + {reply,From,ok}]} + end, + buffer => + fun (internal, Reply, Replies) -> + {keep_state,[Reply|Replies]}; + (timeout, Reply, Replies) -> + {keep_state,[Reply|Replies]}; + (cast, Reply, Replies) -> + {keep_state,[Reply|Replies]}; + ({call,From}, {stop,Reason}, Replies) -> + {next_state,stop,undefined, + lists:reverse( + Replies, + [{reply,From,ok}, + {next_event,internal,{stop,Reason}}])} + end, + stop => + fun (internal, Result, undefined) -> + Result + end}, + + {ok,STM} = gen_statem:start_link(?MODULE, {map_statem,Machine}, []), + Self = self(), + Tag1 = make_ref(), + gen_statem:cast(STM, {reply,{Self,Tag1},ok1}), + Tag2 = make_ref(), + gen_statem:cast(STM, {reply,{Self,Tag2},ok2}), + Tag3 = make_ref(), + Tag4 = make_ref(), + Tag5 = make_ref(), + ok = gen_statem:call(STM, {buffer,Self,[Tag3,Tag4,Tag5]}), + ok = gen_statem:call(STM, {stop,reason}), + case flush() of + [{Tag3,ok3},{Tag4,ok4},{Tag1,ok1},{Tag2,ok2}, + {'EXIT',STM,reason}] -> + ok; + Other1 -> + ct:fail({unexpected,Other1}) + end, + + {noproc,_} = + ?EXPECT_FAILURE(gen_statem:call(STM, hej), Reason), + case flush() of + [] -> + ok; + Other2 -> + ct:fail({unexpected,Other2}) + end. + + + +sys1(Config) -> + {ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []), + {status, Pid, {module,gen_statem}, _} = sys:get_status(Pid), + sys:suspend(Pid), + Parent = self(), + Tag = make_ref(), + Caller = + spawn( + fun () -> + Parent ! {Tag,gen_statem:call(Pid, hej)} + end), + receive + {Tag,_} -> + ct:fail(should_be_suspended) + after 3000 -> + exit(Caller, ok) + end, + + %% {timeout,_} = + %% ?EXPECT_FAILURE(gen_statem:call(Pid, hej), Reason), + sys:resume(Pid), + stop_it(Pid). + +code_change(Config) -> + {ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []), + {idle,data} = sys:get_state(Pid), + sys:suspend(Pid), + sys:change_code(Pid, ?MODULE, old_vsn, state_functions), + sys:resume(Pid), + {idle,{old_vsn,data,state_functions}} = sys:get_state(Pid), + stop_it(Pid). + +call_format_status(Config) -> + {ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []), + Status = sys:get_status(Pid), + {status,Pid,_Mod,[_PDict,running,_,_, Data]} = Status, + [format_status_called|_] = lists:reverse(Data), + stop_it(Pid), + + %% check that format_status can handle a name being an atom (pid is + %% already checked by the previous test) + {ok, Pid2} = + gen_statem:start( + {local, gstm}, ?MODULE, start_arg(Config, []), []), + Status2 = sys:get_status(gstm), + {status,Pid2,_Mod,[_PDict2,running,_,_,Data2]} = Status2, + [format_status_called|_] = lists:reverse(Data2), + stop_it(Pid2), + + %% check that format_status can handle a name being a term other than a + %% pid or atom + GlobalName1 = {global,"CallFormatStatus"}, + {ok,Pid3} = + gen_statem:start( + GlobalName1, ?MODULE, start_arg(Config, []), []), + Status3 = sys:get_status(GlobalName1), + {status,Pid3,_Mod,[_PDict3,running,_,_,Data3]} = Status3, + [format_status_called|_] = lists:reverse(Data3), + stop_it(Pid3), + GlobalName2 = {global,{name, "term"}}, + {ok,Pid4} = + gen_statem:start( + GlobalName2, ?MODULE, start_arg(Config, []), []), + Status4 = sys:get_status(GlobalName2), + {status,Pid4,_Mod,[_PDict4,running,_,_, Data4]} = Status4, + [format_status_called|_] = lists:reverse(Data4), + stop_it(Pid4), + + %% check that format_status can handle a name being a term other than a + %% pid or atom + dummy_via:reset(), + ViaName1 = {via,dummy_via,"CallFormatStatus"}, + {ok,Pid5} = gen_statem:start(ViaName1, ?MODULE, start_arg(Config, []), []), + Status5 = sys:get_status(ViaName1), + {status,Pid5,_Mod, [_PDict5,running,_,_, Data5]} = Status5, + [format_status_called|_] = lists:reverse(Data5), + stop_it(Pid5), + ViaName2 = {via,dummy_via,{name,"term"}}, + {ok, Pid6} = + gen_statem:start( + ViaName2, ?MODULE, start_arg(Config, []), []), + Status6 = sys:get_status(ViaName2), + {status,Pid6,_Mod,[_PDict6,running,_,_,Data6]} = Status6, + [format_status_called|_] = lists:reverse(Data6), + stop_it(Pid6). + + + +error_format_status(Config) -> + error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + Data = "called format_status", + {ok,Pid} = + gen_statem:start( + ?MODULE, start_arg(Config, {data,Data}), []), + %% bad return value in the gen_statem loop + {{bad_return_value,badreturn},_} = + ?EXPECT_FAILURE(gen_statem:call(Pid, badreturn), Reason), + receive + {error,_, + {Pid, + "** State machine"++_, + [Pid,{{call,_},badreturn}, + {formatted,idle,Data}, + error,{bad_return_value,badreturn}|_]}} -> + ok; + Other when is_tuple(Other), element(1, Other) =:= error -> + error_logger_forwarder:unregister(), + ct:fail({unexpected,Other}) + after 1000 -> + error_logger_forwarder:unregister(), + ct:fail(timeout) + end, + process_flag(trap_exit, OldFl), + error_logger_forwarder:unregister(), + receive + %% Comes with SASL + {error_report,_,{Pid,crash_report,_}} -> + ok + after 500 -> + ok + end, + ok = verify_empty_msgq(). + +terminate_crash_format(Config) -> + error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + Data = crash_terminate, + {ok,Pid} = + gen_statem:start( + ?MODULE, start_arg(Config, {data,Data}), []), + stop_it(Pid), + Self = self(), + receive + {error,_GroupLeader, + {Pid, + "** State machine"++_, + [Pid, + {{call,{Self,_}},stop}, + {formatted,idle,Data}, + exit,{crash,terminate}|_]}} -> + ok; + Other when is_tuple(Other), element(1, Other) =:= error -> + error_logger_forwarder:unregister(), + ct:fail({unexpected,Other}) + after 1000 -> + error_logger_forwarder:unregister(), + ct:fail(timeout) + end, + process_flag(trap_exit, OldFl), + error_logger_forwarder:unregister(), + receive + %% Comes with SASL + {error_report,_,{Pid,crash_report,_}} -> + ok + after 500 -> + ok + end, + ok = verify_empty_msgq(). + + +get_state(Config) -> + State = self(), + {ok,Pid} = + gen_statem:start( + ?MODULE, start_arg(Config, {data,State}), []), + {idle,State} = sys:get_state(Pid), + {idle,State} = sys:get_state(Pid, 5000), + stop_it(Pid), + + %% check that get_state can handle a name being an atom (pid is + %% already checked by the previous test) + {ok,Pid2} = + gen_statem:start( + {local,gstm}, ?MODULE, start_arg(Config, {data,State}), []), + {idle,State} = sys:get_state(gstm), + {idle,State} = sys:get_state(gstm, 5000), + stop_it(Pid2), + + %% check that get_state works when pid is sys suspended + {ok,Pid3} = + gen_statem:start( + ?MODULE, start_arg(Config, {data,State}), []), + {idle,State} = sys:get_state(Pid3), + ok = sys:suspend(Pid3), + {idle,State} = sys:get_state(Pid3, 5000), + ok = sys:resume(Pid3), + stop_it(Pid3), + ok = verify_empty_msgq(). + +replace_state(Config) -> + State = self(), + {ok, Pid} = + gen_statem:start( + ?MODULE, start_arg(Config, {data,State}), []), + {idle,State} = sys:get_state(Pid), + NState1 = "replaced", + Replace1 = fun({StateName, _}) -> {StateName,NState1} end, + {idle,NState1} = sys:replace_state(Pid, Replace1), + {idle,NState1} = sys:get_state(Pid), + NState2 = "replaced again", + Replace2 = fun({idle, _}) -> {state0,NState2} end, + {state0,NState2} = sys:replace_state(Pid, Replace2, 5000), + {state0,NState2} = sys:get_state(Pid), + %% verify no change in state if replace function crashes + Replace3 = fun(_) -> error(fail) end, + {callback_failed, + {gen_statem,system_replace_state},{error,fail}} = + ?EXPECT_FAILURE(sys:replace_state(Pid, Replace3), Reason), + {state0, NState2} = sys:get_state(Pid), + %% verify state replaced if process sys suspended + ok = sys:suspend(Pid), + Suffix2 = " and again", + NState3 = NState2 ++ Suffix2, + Replace4 = fun({StateName, _}) -> {StateName, NState3} end, + {state0,NState3} = sys:replace_state(Pid, Replace4), + ok = sys:resume(Pid), + {state0,NState3} = sys:get_state(Pid, 5000), + stop_it(Pid), + ok = verify_empty_msgq(). + +%% Hibernation +hibernate(Config) -> + OldFl = process_flag(trap_exit, true), + + {ok,Pid0} = + gen_statem:start_link( + ?MODULE, start_arg(Config, hiber_now), []), + is_in_erlang_hibernate(Pid0), + stop_it(Pid0), + receive + {'EXIT',Pid0,normal} -> ok + after 5000 -> + ct:fail(gen_statem_did_not_die) + end, + + {ok,Pid} = + gen_statem:start_link(?MODULE, start_arg(Config, hiber), []), + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid,current_function)), + hibernating = gen_statem:call(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + good_morning = gen_statem:call(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + hibernating = gen_statem:call(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + please_just_five_more = gen_statem:call(Pid, snooze_sync), + is_in_erlang_hibernate(Pid), + good_morning = gen_statem:call(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, hibernate_async), + is_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, wakeup_async), + is_not_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, hibernate_async), + is_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, snooze_async), + is_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, wakeup_async), + is_not_in_erlang_hibernate(Pid), + + Pid ! hibernate_later, + true = + ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + is_in_erlang_hibernate(Pid), + + 'alive!' = gen_statem:call(Pid, 'alive?'), + true = + ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + Pid ! hibernate_now, + is_in_erlang_hibernate(Pid), + + 'alive!' = gen_statem:call(Pid, 'alive?'), + true = + ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + + hibernating = gen_statem:call(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + good_morning = gen_statem:call(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + hibernating = gen_statem:call(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + please_just_five_more = gen_statem:call(Pid, snooze_sync), + is_in_erlang_hibernate(Pid), + good_morning = gen_statem:call(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, hibernate_async), + is_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, wakeup_async), + is_not_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, hibernate_async), + is_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, snooze_async), + is_in_erlang_hibernate(Pid), + ok = gen_statem:cast(Pid, wakeup_async), + is_not_in_erlang_hibernate(Pid), + + hibernating = gen_statem:call(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + sys:suspend(Pid), + is_in_erlang_hibernate(Pid), + sys:resume(Pid), + is_in_erlang_hibernate(Pid), + receive after 1000 -> ok end, + is_in_erlang_hibernate(Pid), + + good_morning = gen_statem:call(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + stop_it(Pid), + process_flag(trap_exit, OldFl), + receive + {'EXIT',Pid,normal} -> ok + after 5000 -> + ct:fail(gen_statem_did_not_die) + end, + ok = verify_empty_msgq(). + +is_in_erlang_hibernate(Pid) -> + receive after 1 -> ok end, + is_in_erlang_hibernate_1(200, Pid). + +is_in_erlang_hibernate_1(0, Pid) -> + ct:log("~p\n", [erlang:process_info(Pid, current_function)]), + ct:fail(not_in_erlang_hibernate_3); +is_in_erlang_hibernate_1(N, Pid) -> + {current_function,MFA} = erlang:process_info(Pid, current_function), + case MFA of + {erlang,hibernate,3} -> + ok; + _ -> + receive after 10 -> ok end, + is_in_erlang_hibernate_1(N-1, Pid) + end. + +is_not_in_erlang_hibernate(Pid) -> + receive after 1 -> ok end, + is_not_in_erlang_hibernate_1(200, Pid). + +is_not_in_erlang_hibernate_1(0, Pid) -> + ct:log("~p\n", [erlang:process_info(Pid, current_function)]), + ct:fail(not_in_erlang_hibernate_3); +is_not_in_erlang_hibernate_1(N, Pid) -> + {current_function,MFA} = erlang:process_info(Pid, current_function), + case MFA of + {erlang,hibernate,3} -> + receive after 10 -> ok end, + is_not_in_erlang_hibernate_1(N-1, Pid); + _ -> + ok + end. + + +enter_loop(_Config) -> + OldFlag = process_flag(trap_exit, true), + + dummy_via:reset(), + + %% Locally registered process + {local,Name} + {ok,Pid1a} = + proc_lib:start_link(?MODULE, enter_loop, [local,local]), + yes = gen_statem:call(Pid1a, 'alive?'), + stopped = gen_statem:call(Pid1a, stop), + receive + {'EXIT',Pid1a,normal} -> + ok + after 5000 -> + ct:fail(gen_statem_did_not_die) + end, + + %% Unregistered process + {local,Name} + {ok,Pid1b} = + proc_lib:start_link(?MODULE, enter_loop, [anon,local]), + receive + {'EXIT',Pid1b,process_not_registered} -> + ok + after 5000 -> + ct:fail(gen_statem_did_not_die) + end, + + %% Globally registered process + {global,Name} + {ok,Pid2a} = + proc_lib:start_link(?MODULE, enter_loop, [global,global]), + yes = gen_statem:call(Pid2a, 'alive?'), + stopped = gen_statem:call(Pid2a, stop), + receive + {'EXIT',Pid2a,normal} -> + ok + after 5000 -> + ct:fail(gen_statem_did_not_die) + end, + + %% Unregistered process + {global,Name} + {ok,Pid2b} = + proc_lib:start_link(?MODULE, enter_loop, [anon,global]), + receive + {'EXIT',Pid2b,process_not_registered_globally} -> + ok + after 5000 -> + ct:fail(gen_statem_did_not_die) + end, + + %% Unregistered process + no name + {ok,Pid3} = + proc_lib:start_link(?MODULE, enter_loop, [anon,anon]), + yes = gen_statem:call(Pid3, 'alive?'), + stopped = gen_statem:call(Pid3, stop), + receive + {'EXIT',Pid3,normal} -> + ok + after 5000 -> + ct:fail(gen_statem_did_not_die) + end, + + %% Process not started using proc_lib + CallbackMode = state_functions, + Pid4 = + spawn_link( + gen_statem, enter_loop, + [?MODULE,[],CallbackMode,state0,[]]), + receive + {'EXIT',Pid4,process_was_not_started_by_proc_lib} -> + ok + after 5000 -> + ct:fail(gen_statem_did_not_die) + end, + + %% Make sure I am the parent, ie that ordering a shutdown will + %% result in the process terminating with Reason==shutdown + {ok,Pid5} = + proc_lib:start_link(?MODULE, enter_loop, [anon,anon]), + yes = gen_statem:call(Pid5, 'alive?'), + exit(Pid5, shutdown), + receive + {'EXIT',Pid5,shutdown} -> + ok + after 5000 -> + ct:fail(gen_statem_did_not_die) + end, + + %% Make sure gen_statem:enter_loop does not accept {local,Name} + %% when it's another process than the calling one which is + %% registered under that name + register(armitage, self()), + {ok,Pid6a} = + proc_lib:start_link(?MODULE, enter_loop, [anon,local]), + receive + {'EXIT',Pid6a,process_not_registered} -> + ok + after 1000 -> + ct:fail(gen_statem_started) + end, + unregister(armitage), + + %% Make sure gen_statem:enter_loop does not accept {global,Name} + %% when it's another process than the calling one which is + %% registered under that name + global:register_name(armitage, self()), + {ok,Pid6b} = + proc_lib:start_link(?MODULE, enter_loop, [anon,global]), + receive + {'EXIT',Pid6b,process_not_registered_globally} -> + ok + after 1000 -> + ct:fail(gen_statem_started) + end, + global:unregister_name(armitage), + + dummy_via:register_name(armitage, self()), + {ok,Pid6c} = + proc_lib:start_link(?MODULE, enter_loop, [anon,via]), + receive + {'EXIT',Pid6c,{process_not_registered_via,dummy_via}} -> + ok + after 1000 -> + ct:fail( + {gen_statem_started, + process_info(self(), messages)}) + end, + dummy_via:unregister_name(armitage), + + process_flag(trap_exit, OldFlag), + ok = verify_empty_msgq(). + +enter_loop(Reg1, Reg2) -> + process_flag(trap_exit, true), + case Reg1 of + local -> register(armitage, self()); + global -> global:register_name(armitage, self()); + via -> dummy_via:register_name(armitage, self()); + anon -> ignore + end, + proc_lib:init_ack({ok, self()}), + CallbackMode = state_functions, + case Reg2 of + local -> + gen_statem:enter_loop( + ?MODULE, [], CallbackMode, state0, [], {local,armitage}); + global -> + gen_statem:enter_loop( + ?MODULE, [], CallbackMode, state0, [], {global,armitage}); + via -> + gen_statem:enter_loop( + ?MODULE, [], CallbackMode, state0, [], + {via, dummy_via, armitage}); + anon -> + gen_statem:enter_loop( + ?MODULE, [], CallbackMode, state0, []) + end. + + +%% Test the order for multiple {next_event,T,C} +next_events(Config) -> + {ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []), + ok = gen_statem:cast(Pid, next_event), + {state,next_events,[]} = gen_statem:call(Pid, get), + ok = gen_statem:stop(Pid), + false = erlang:is_process_alive(Pid), + noproc = + ?EXPECT_FAILURE(gen_statem:stop(Pid), Reason). + + +%% +%% Functionality check +%% + +wfor(Msg) -> + receive + Msg -> ok + after 5000 -> + error(timeout) + end. + + +stop_it(STM) -> + stopped = gen_statem:call(STM, stop), + check_stopped(STM). + + +check_stopped(STM) -> + Call = there_you_are, + {_,{gen_statem,call,[_,Call,infinity]}} = + ?EXPECT_FAILURE(gen_statem:call(STM, Call), Reason), + ok. + + +do_func_test(STM) -> + ok = gen_statem:cast(STM, {'alive?',self()}), + wfor(yes), + ok = do_connect(STM), + ok = gen_statem:cast(STM, {'alive?',self()}), + wfor(yes), + ?t:do_times(3, ?MODULE, do_msg, [STM]), + ok = gen_statem:cast(STM, {'alive?',self()}), + wfor(yes), + ok = do_disconnect(STM), + ok = gen_statem:cast(STM, {'alive?',self()}), + wfor(yes), + ok. + + +do_connect(STM) -> + check_state(STM, idle), + gen_statem:cast(STM, {connect,self()}), + wfor(accept), + check_state(STM, wfor_conf), + Tag = make_ref(), + gen_statem:cast(STM, {ping,self(),Tag}), + gen_statem:cast(STM, confirm), + wfor({pong,Tag}), + check_state(STM, connected), + ok. + +do_msg(STM) -> + check_state(STM, connected), + R = make_ref(), + ok = gen_statem:cast(STM, {msg,self(),R}), + wfor({ack,R}). + + +do_disconnect(STM) -> + ok = gen_statem:cast(STM, disconnect), + check_state(STM, idle). + +check_state(STM, State) -> + case gen_statem:call(STM, get) of + {state, State, _} -> ok + end. + +do_sync_func_test(STM) -> + yes = gen_statem:call(STM, 'alive?'), + ok = do_sync_connect(STM), + yes = gen_statem:call(STM, 'alive?'), + ?t:do_times(3, ?MODULE, do_sync_msg, [STM]), + yes = gen_statem:call(STM, 'alive?'), + ok = do_sync_disconnect(STM), + yes = gen_statem:call(STM, 'alive?'), + check_state(STM, idle), + ok = gen_statem:call(STM, {timeout,200}), + yes = gen_statem:call(STM, 'alive?'), + check_state(STM, idle), + ok. + + +do_sync_connect(STM) -> + check_state(STM, idle), + accept = gen_statem:call(STM, connect), + check_state(STM, wfor_conf), + Tag = make_ref(), + gen_statem:cast(STM, {ping,self(),Tag}), + yes = gen_statem:call(STM, confirm), + wfor({pong,Tag}), + check_state(STM, connected), + ok. + +do_sync_msg(STM) -> + check_state(STM, connected), + R = make_ref(), + {ack,R} = gen_statem:call(STM, {msg,R}), + ok. + +do_sync_disconnect(STM) -> + yes = gen_statem:call(STM, disconnect), + check_state(STM, idle). + + +verify_empty_msgq() -> + [] = flush(), + ok. + +start_arg(Config, Arg) -> + case lists:keyfind(callback_mode, 1, Config) of + {_,CallbackMode} -> + {callback_mode,CallbackMode,Arg}; + false -> + Arg + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% The State Machine +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +init(ignore) -> + ignore; +init(stop) -> + {stop,stopped}; +init(stop_shutdown) -> + {stop,shutdown}; +init(sleep) -> + ?t:sleep(1000), + {state_functions,idle,data}; +init(hiber) -> + {state_functions,hiber_idle,[]}; +init(hiber_now) -> + {state_functions,hiber_idle,[],[hibernate]}; +init({data, Data}) -> + {state_functions,idle,Data}; +init({callback_mode,CallbackMode,Arg}) -> + case init(Arg) of + {_,State,Data,Ops} -> + {CallbackMode,State,Data,Ops}; + {_,State,Data} -> + {CallbackMode,State,Data}; + Other -> + Other + end; +init({map_statem,#{init := Init}=Machine}) -> + case Init() of + {ok,State,Data,Ops} -> + {handle_event_function,State,[Data|Machine],Ops}; + {ok,State,Data} -> + {handle_event_function,State,[Data|Machine]}; + Other -> + Other + end; +init([]) -> + {state_functions,idle,data}. + +terminate(_, _State, crash_terminate) -> + exit({crash,terminate}); +terminate({From,stopped}, State, _Data) -> + From ! {self(),{stopped,State}}, + ok; +terminate(_Reason, _State, _Data) -> + ok. + + +%% State functions + +idle(cast, {connect,Pid}, Data) -> + Pid ! accept, + {next_state,wfor_conf,Data,infinity}; % NoOp timeout just to test API +idle({call,From}, connect, Data) -> + gen_statem:reply(From, accept), + {next_state,wfor_conf,Data,infinity}; % NoOp timeout just to test API +idle(cast, badreturn, _Data) -> + badreturn; +idle({call,_From}, badreturn, _Data) -> + badreturn; +idle({call,From}, {delayed_answer,T}, Data) -> + receive + after T -> + gen_statem:reply({reply,From,delayed}), + throw({keep_state,Data}) + end; +idle({call,From}, {timeout,Time}, _Data) -> + {next_state,timeout,{From,Time}, + {timeout,Time,idle}}; +idle(cast, next_event, _Data) -> + {next_state,next_events,[a,b,c], + [{next_event,internal,a}, + {next_event,internal,b}, + {next_event,internal,c}]}; +idle(Type, Content, Data) -> + case handle_common_events(Type, Content, idle, Data) of + undefined -> + case Type of + {call,From} -> + throw({keep_state,Data,[{reply,From,'eh?'}]}); + _ -> + throw( + {stop,{unexpected,idle,Type,Content}}) + end; + Result -> + Result + end. + +timeout(timeout, idle, {From,Time}) -> + TRef = erlang:start_timer(Time, self(), ok), + {keep_state,{From,TRef},0}; % Immediate timeout 0 +timeout(timeout, 0, {From,TRef}) -> + {next_state,timeout2,{From,TRef}, + [{timeout,1,should_be_cancelled}, + postpone]}; % Should cancel state timeout +timeout(_, _, _) -> + keep_state_and_data. + +timeout2(timeout, 0, _) -> + keep_state_and_data; +timeout2(timeout, Reason, _) -> + {stop,Reason}; +timeout2(info, {timeout,TRef,Result}, {From,TRef}) -> + gen_statem:reply([{reply,From,Result}]), + {next_state,idle,state}; +timeout2(_, _, _) -> + {keep_state_and_data,[]}. + +wfor_conf({call,From}, confirm, Data) -> + {next_state,connected,Data, + {reply,From,yes}}; +wfor_conf(cast, {ping,_,_}, _) -> + {keep_state_and_data,[postpone]}; +wfor_conf(cast, confirm, Data) -> + {next_state,connected,Data}; +wfor_conf(Type, Content, Data) -> + case handle_common_events(Type, Content, wfor_conf, Data) of + undefined -> + case Type of + {call,From} -> + {next_state,idle,Data, + [{reply,From,'eh?'}]}; + _ -> + throw(keep_state_and_data) + end; + Result -> + Result + end. + +connected({call,From}, {msg,Ref}, Data) -> + {keep_state,Data, + {reply,From,{ack,Ref}}}; +connected(cast, {msg,From,Ref}, Data) -> + From ! {ack,Ref}, + {keep_state,Data}; +connected({call,From}, disconnect, Data) -> + {next_state,idle,Data, + [{reply,From,yes}]}; +connected(cast, disconnect, Data) -> + {next_state,idle,Data}; +connected(cast, {ping,Pid,Tag}, Data) -> + Pid ! {pong,Tag}, + {keep_state,Data}; +connected(Type, Content, Data) -> + case handle_common_events(Type, Content, connected, Data) of + undefined -> + case Type of + {call,From} -> + {keep_state,Data, + [{reply,From,'eh?'}]}; + _ -> + {keep_state,Data} + end; + Result -> + Result + end. + +state0({call,From}, stop, Data) -> + {stop_and_reply,normal,[{reply,From,stopped}],Data}; +state0(Type, Content, Data) -> + case handle_common_events(Type, Content, state0, Data) of + undefined -> + {keep_state,Data}; + Result -> + Result + end. + +hiber_idle({call,From}, 'alive?', Data) -> + {keep_state,Data, + [{reply,From,'alive!'}]}; +hiber_idle({call,From}, hibernate_sync, Data) -> + {next_state,hiber_wakeup,Data, + [{reply,From,hibernating}, + hibernate]}; +hiber_idle(info, hibernate_later, _) -> + Tref = erlang:start_timer(1000, self(), hibernate), + {keep_state,Tref}; +hiber_idle(info, hibernate_now, Data) -> + {keep_state,Data, + [hibernate]}; +hiber_idle(info, {timeout,Tref,hibernate}, Tref) -> + {keep_state,[], + [hibernate]}; +hiber_idle(cast, hibernate_async, Data) -> + {next_state,hiber_wakeup,Data, + [hibernate]}; +hiber_idle(Type, Content, Data) -> + case handle_common_events(Type, Content, hiber_idle, Data) of + undefined -> + {keep_state,Data}; + Result -> + Result + end. + +hiber_wakeup({call,From}, wakeup_sync, Data) -> + {next_state,hiber_idle,Data, + [{reply,From,good_morning}]}; +hiber_wakeup({call,From}, snooze_sync, Data) -> + {keep_state,Data, + [{reply,From,please_just_five_more}, + hibernate]}; +hiber_wakeup(cast, wakeup_async, Data) -> + {next_state,hiber_idle,Data}; +hiber_wakeup(cast, snooze_async, Data) -> + {keep_state,Data, + [hibernate]}; +hiber_wakeup(Type, Content, Data) -> + case handle_common_events(Type, Content, hiber_wakeup, Data) of + undefined -> + {keep_state,Data}; + Result -> + Result + end. + +next_events(internal, Msg, [Msg|Msgs]) -> + {keep_state,Msgs}; +next_events(Type, Content, Data) -> + case handle_common_events(Type, Content, next_events, Data) of + undefined -> + {keep_state,Data}; + Result -> + Result + end. + + +handle_common_events({call,From}, get, State, Data) -> + {keep_state,Data, + [{reply,From,{state,State,Data}}]}; +handle_common_events(cast, {get,Pid}, State, Data) -> + Pid ! {state,State,Data}, + {keep_state,Data}; +handle_common_events({call,From}, stop, _, Data) -> + {stop_and_reply,normal,[{reply,From,stopped}],Data}; +handle_common_events(cast, stop, _, _) -> + stop; +handle_common_events({call,From}, {stop,Reason}, _, Data) -> + {stop_and_reply,Reason,{reply,From,stopped},Data}; +handle_common_events(cast, {stop,Reason}, _, _) -> + {stop,Reason}; +handle_common_events({call,From}, 'alive?', _, Data) -> + {keep_state,Data, + [{reply,From,yes}]}; +handle_common_events(cast, {'alive?',Pid}, _, Data) -> + Pid ! yes, + {keep_state,Data}; +handle_common_events(_, _, _, _) -> + undefined. + +%% Wrapper state machine that uses a map state machine spec +handle_event( + Type, Event, State, [Data|Machine]) + when is_map(Machine) -> + #{State := HandleEvent} = Machine, + case + try HandleEvent(Type, Event, Data) of + Result -> + Result + catch + Result -> + Result + end of + {stop,Reason,NewData} -> + {stop,Reason,[NewData|Machine]}; + {next_state,NewState,NewData} -> + {next_state,NewState,[NewData|Machine]}; + {next_state,NewState,NewData,Ops} -> + {next_state,NewState,[NewData|Machine],Ops}; + {keep_state,NewData} -> + {keep_state,[NewData|Machine]}; + {keep_state,NewData,Ops} -> + {keep_state,[NewData|Machine],Ops}; + Other -> + Other + end; +%% +%% Dispatcher to test callback_mode handle_event_function +%% +%% Wrap the state in a 1 element list just to test non-atom +%% states. Note that the state from init/1 is not wrapped +%% so both atom and non-atom states are tested. +handle_event(Type, Event, State, Data) -> + StateName = unwrap_state(State), + try ?MODULE:StateName(Type, Event, Data) of + Result -> + wrap_result(Result) + catch + throw:Result -> + erlang:raise( + throw, wrap_result(Result), erlang:get_stacktrace()) + end. + +unwrap_state([State]) -> + State; +unwrap_state(State) -> + State. + +wrap_result(Result) -> + case Result of + {next_state,NewState,NewData} -> + {next_state,[NewState],NewData}; + {next_state,NewState,NewData,StateOps} -> + {next_state,[NewState],NewData,StateOps}; + Other -> + Other + end. + + + +code_change(OldVsn, State, Data, CallbackMode) -> + {CallbackMode,State,{OldVsn,Data,CallbackMode}}. + +format_status(terminate, [_Pdict,State,Data]) -> + {formatted,State,Data}; +format_status(normal, [_Pdict,_State,_Data]) -> + [format_status_called]. + +flush() -> + receive + Msg -> + [Msg|flush()] + after 500 -> + [] + end. diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl index 6f2a510f65..531e97e8d6 100644 --- a/lib/stdlib/test/lists_SUITE.erl +++ b/lib/stdlib/test/lists_SUITE.erl @@ -55,6 +55,7 @@ ufunsort_error/1, zip_unzip/1, zip_unzip3/1, zipwith/1, zipwith3/1, filter_partition/1, + join/1, otp_5939/1, otp_6023/1, otp_6606/1, otp_7230/1, suffix/1, subtract/1, droplast/1, hof/1]). @@ -119,7 +120,7 @@ groups() -> {tickets, [parallel], [otp_5939, otp_6023, otp_6606, otp_7230]}, {zip, [parallel], [zip_unzip, zip_unzip3, zipwith, zipwith3]}, {misc, [parallel], [reverse, member, dropwhile, takewhile, - filter_partition, suffix, subtract, + filter_partition, suffix, subtract, join, hof]} ]. @@ -2413,6 +2414,19 @@ zipwith3(Config) when is_list(Config) -> ok. +%% Test lists:join/2 +join(Config) when is_list(Config) -> + A = [a,b,c], + Sep = x, + [a,x,b,x,c] = lists:join(Sep, A), + + B = [b], + [b] = lists:join(Sep, B), + + C = [], + [] = lists:join(Sep, C), + ok. + %% Test lists:filter/2, lists:partition/2. filter_partition(Config) when is_list(Config) -> F = fun(I) -> I rem 2 =:= 0 end, diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl index 8b3a8d7ae2..42e669a799 100644 --- a/lib/stdlib/test/maps_SUITE.erl +++ b/lib/stdlib/test/maps_SUITE.erl @@ -25,15 +25,10 @@ -include_lib("common_test/include/ct.hrl"). -%% Test server specific exports --export([all/0]). --export([suite/0]). --export([init_per_suite/1]). --export([end_per_suite/1]). --export([init_per_testcase/2]). --export([end_per_testcase/2]). - --export([t_get_3/1, t_filter_2/1, +-export([all/0, suite/0]). + +-export([t_update_with_3/1, t_update_with_4/1, + t_get_3/1, t_filter_2/1, t_fold_3/1,t_map_2/1,t_size_1/1, t_with_2/1,t_without_2/1]). @@ -41,29 +36,56 @@ %%-define(badarg(F,Args), {'EXIT', {badarg, [{maps,F,Args,_}|_]}}). %% silly broken hipe -define(badmap(V,F,_Args), {'EXIT', {{badmap,V}, [{maps,F,_,_}|_]}}). +-define(badkey(K,F,_Args), {'EXIT', {{badkey,K}, [{maps,F,_,_}|_]}}). -define(badarg(F,_Args), {'EXIT', {badarg, [{maps,F,_,_}|_]}}). suite() -> - [{ct_hooks, [ts_install_cth]}, + [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. all() -> - [t_get_3,t_filter_2, + [t_update_with_3,t_update_with_4, + t_get_3,t_filter_2, t_fold_3,t_map_2,t_size_1, t_with_2,t_without_2]. -init_per_suite(Config) -> - Config. +t_update_with_3(Config) when is_list(Config) -> + V1 = value1, + V2 = <<"value2">>, + V3 = "value3", + Map = #{ key1 => V1, key2 => V2, "key3" => V3 }, + Fun = fun(V) -> [V,V,{V,V}] end, + + #{ key1 := [V1,V1,{V1,V1}] } = maps:update_with(key1,Fun,Map), + #{ key2 := [V2,V2,{V2,V2}] } = maps:update_with(key2,Fun,Map), + #{ "key3" := [V3,V3,{V3,V3}] } = maps:update_with("key3",Fun,Map), -end_per_suite(_Config) -> + %% error case + ?badmap(b,update_with,[[a,b],a,b]) = (catch maps:update_with([a,b],id(a),b)), + ?badarg(update_with,[[a,b],a,#{}]) = (catch maps:update_with([a,b],id(a),#{})), + ?badkey([a,b],update_with,[[a,b],Fun,#{}]) = (catch maps:update_with([a,b],Fun,#{})), ok. -init_per_testcase(_Case, Config) -> - Config. +t_update_with_4(Config) when is_list(Config) -> + V1 = value1, + V2 = <<"value2">>, + V3 = "value3", + Map = #{ key1 => V1, key2 => V2, "key3" => V3 }, + Fun = fun(V) -> [V,V,{V,V}] end, + Init = 3, + + #{ key1 := [V1,V1,{V1,V1}] } = maps:update_with(key1,Fun,Init,Map), + #{ key2 := [V2,V2,{V2,V2}] } = maps:update_with(key2,Fun,Init,Map), + #{ "key3" := [V3,V3,{V3,V3}] } = maps:update_with("key3",Fun,Init,Map), -end_per_testcase(_Case, _Config) -> + #{ key3 := Init } = maps:update_with(key3,Fun,Init,Map), + + %% error case + ?badmap(b,update_with,[[a,b],a,b]) = (catch maps:update_with([a,b],id(a),b)), + ?badarg(update_with,[[a,b],a,#{}]) = (catch maps:update_with([a,b],id(a),#{})), ok. + t_get_3(Config) when is_list(Config) -> Map = #{ key1 => value1, key2 => value2 }, DefaultValue = "Default value", diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index 3fd5ed4ccf..1bcdc3ccd0 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -377,7 +377,7 @@ crypto_seed() -> crypto_next(<<Num:64, Bin/binary>>) -> {Num, Bin}; crypto_next(_) -> - crypto_next(crypto:rand_bytes((64 div 8)*100)). + crypto_next(crypto:strong_rand_bytes((64 div 8)*100)). crypto_uniform({Api, Data0}) -> {Int, Data} = crypto_next(Data0), diff --git a/lib/tools/doc/src/erlang_mode.xml b/lib/tools/doc/src/erlang_mode.xml index 0ab272fb2f..00cf5196b4 100644 --- a/lib/tools/doc/src/erlang_mode.xml +++ b/lib/tools/doc/src/erlang_mode.xml @@ -252,6 +252,7 @@ behavior</item> <item>gen_event - skeleton for the OTP gen_event behavior</item> <item>gen_fsm - skeleton for the OTP gen_fsm behavior</item> + <item>gen_statem - skeleton for the OTP gen_statem behavior</item> <item>Library module - skeleton for a module that does not implement a process.</item> <item>Corba callback - skeleton for a Corba callback module.</item> diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el index 3bb1dda6db..ce26c83295 100644 --- a/lib/tools/emacs/erlang-skels.el +++ b/lib/tools/emacs/erlang-skels.el @@ -56,6 +56,8 @@ erlang-skel-gen-event erlang-skel-header) ("gen_fsm" "gen-fsm" erlang-skel-gen-fsm erlang-skel-header) + ("gen_statem" "gen-statem" + erlang-skel-gen-statem erlang-skel-header) ("wx_object" "wx-object" erlang-skel-wx-object erlang-skel-header) ("Library module" "gen-lib" @@ -858,6 +860,122 @@ Please see the function `tempo-define-template'.") "*The template of a gen_fsm. Please see the function `tempo-define-template'.") +(defvar erlang-skel-gen-statem + '((erlang-skel-include erlang-skel-large-header) + "-behaviour(gen_statem)." n n + + "%% API" n + "-export([start_link/0])." n + n + "%% gen_statem callbacks" n + "-export([init/1, terminate/3, code_change/4])." n + "-export([state_name/3])." n + "-export([handle_event/4])." n + n + "-define(SERVER, ?MODULE)." n + n + "-record(data, {})." n + n + (erlang-skel-double-separator-start 3) + "%%% API" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @doc" n + "%% Creates a gen_statem process which calls Module:init/1 to" n + "%% initialize. To ensure a synchronized start-up procedure, this" n + "%% function does not return until Module:init/1 has returned." n + "%%" n + (erlang-skel-separator-end 2) + "-spec start_link() ->" n> + "{ok, Pid :: pid()} |" n> + "ignore |" n> + "{error, Error :: term()}." n + "start_link() ->" n> + "gen_statem:start_link({local, ?SERVER}, ?MODULE, [], [])." n + n + (erlang-skel-double-separator-start 3) + "%%% gen_statem callbacks" n + (erlang-skel-double-separator-end 3) n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Whenever a gen_statem is started using gen_statem:start/[3,4] or" n + "%% gen_statem:start_link/[3,4], this function is called by the new" n + "%% process to initialize." n + (erlang-skel-separator-end 2) + "-spec init(Args :: term()) -> " n> + "{gen_statem:callback_mode()," n> + "State :: term(), Data :: term()} |" n> + "{gen_statem:callback_mode()," n> + "State :: term(), Data :: term()," n> + "[gen_statem:action()] | gen_statem:action()} |" n> + "ignore |" n> + "{stop, Reason :: term()}." n + "init([]) ->" n> + "{state_functions, state_name, #data{}}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% If the gen_statem runs with CallbackMode =:= state_functions" n + "%% there should be one instance of this function for each possible" n + "%% state name. Whenever a gen_statem receives an event," n + "%% the instance of this function with the same name" n + "%% as the current state name StateName is called to" n + "%% handle the event." n + (erlang-skel-separator-end 2) + "-spec state_name(" n> + "gen_statem:event_type(), Msg :: term()," n> + "Data :: term()) ->" n> + "gen_statem:state_function_result(). " n + "state_name({call,Caller}, _Msg, Data) ->" n> + "{next_state, state_name, Data, [{reply,Caller,ok}]}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% If the gen_statem runs with CallbackMode =:= handle_event_function" n + "%% this function is called for every event a gen_statem receives." n + (erlang-skel-separator-end 2) + "-spec handle_event(" n> + "gen_statem:event_type(), Msg :: term()," n> + "State :: term(), Data :: term()) ->" n> + "gen_statem:handle_event_result(). " n + "handle_event({call,From}, _Msg, State, Data) ->" n> + "{next_state, State, Data, [{reply,From,ok}]}." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% This function is called by a gen_statem when it is about to" n + "%% terminate. It should be the opposite of Module:init/1 and do any" n + "%% necessary cleaning up. When it returns, the gen_statem terminates with" n + "%% Reason. The return value is ignored." n + (erlang-skel-separator-end 2) + "-spec terminate(Reason :: term(), State :: term(), Data :: term()) ->" n> + "any()." n + "terminate(_Reason, _State, _Data) ->" n> + "void." n + n + (erlang-skel-separator-start 2) + "%% @private" n + "%% @doc" n + "%% Convert process state when code is changed" n + (erlang-skel-separator-end 2) + "-spec code_change(" n> + "OldVsn :: term() | {down,term()}," n> + "State :: term(), Data :: term(), Extra :: term()) ->" n> + "{ok, NewState :: term(), NewData :: term()}." n + "code_change(_OldVsn, State, Data, _Extra) ->" n> + "{ok, State, Data}." n + n + (erlang-skel-double-separator-start 3) + "%%% Internal functions" n + (erlang-skel-double-separator-end 3) + ) + "*The template of a gen_statem. +Please see the function `tempo-define-template'.") + (defvar erlang-skel-wx-object '((erlang-skel-include erlang-skel-large-header) "-behaviour(wx_object)." n n diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 17a156ff00..0a3fc0ddff 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -1345,7 +1345,7 @@ Lock syntax table. The effect is that `apply' in the atom ;;;###autoload -(defun erlang-mode () +(define-derived-mode erlang-mode prog-mode "Erlang" "Major mode for editing Erlang source files in Emacs. It knows about syntax and comment, it can indent code, it is capable of fontifying the source file, the TAGS commands are aware of Erlang @@ -1404,12 +1404,9 @@ and examples of hooks. Other commands: \\{erlang-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'erlang-mode) - (setq mode-name "Erlang") + ;; Use our own syntax table function + :syntax-table nil (erlang-syntax-table-init) - (use-local-map erlang-mode-map) (erlang-electric-init) (erlang-menu-init) (erlang-mode-variables) @@ -1419,12 +1416,8 @@ Other commands: (erlang-font-lock-init) (erlang-skel-init) (tempo-use-tag-list 'erlang-tempo-tags) - (run-hooks 'erlang-mode-hook) (if (zerop (buffer-size)) - (run-hooks 'erlang-new-file-hook)) - ;; Doesn't exist in Emacs v21.4; required by Emacs v23. - (if (boundp 'after-change-major-mode-hook) - (run-hooks 'after-change-major-mode-hook))) + (run-hooks 'erlang-new-file-hook))) ;;;###autoload (dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript" diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl index c5c24c8eb3..b21eedc625 100644 --- a/lib/tools/src/fprof.erl +++ b/lib/tools/src/fprof.erl @@ -1567,13 +1567,20 @@ trace_handler({trace_ts, Pid, return_to, {_M, _F, Args} = MFArgs, TS} = Trace, trace_return_to(Table, Pid, Func, TS), TS; %% -%% spawn +%% spawn, only needed (and reliable) prior to 19.0 trace_handler({trace_ts, Pid, spawn, Child, MFArgs, TS} = Trace, Table, _, Dump) -> dump_stack(Dump, get(Pid), Trace), trace_spawn(Table, Child, MFArgs, TS, Pid), TS; %% +%% spawned, added in 19.0 +trace_handler({trace_ts, Pid, spawned, Parent, MFArgs, TS} = Trace, + Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + trace_spawn(Table, Pid, MFArgs, TS, Parent), + TS; +%% %% exit trace_handler({trace_ts, Pid, exit, _Reason, TS} = Trace, Table, _, Dump) -> @@ -1622,15 +1629,24 @@ trace_handler({trace_ts, Pid, in, {_M, _F, Args} = MFArgs, TS} = Trace, TS; %% %% gc_start -trace_handler({trace_ts, Pid, gc_start, _Func, TS} = Trace, - Table, _, Dump) -> +trace_handler({trace_ts, Pid, gc_minor_start, _Func, TS} = Trace, Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + trace_gc_start(Table, Pid, TS), + TS; + +trace_handler({trace_ts, Pid, gc_major_start, _Func, TS} = Trace, Table, _, Dump) -> dump_stack(Dump, get(Pid), Trace), trace_gc_start(Table, Pid, TS), TS; + %% %% gc_end -trace_handler({trace_ts, Pid, gc_end, _Func, TS} = Trace, - Table, _, Dump) -> +trace_handler({trace_ts, Pid, gc_minor_end, _Func, TS} = Trace, Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + trace_gc_end(Table, Pid, TS), + TS; + +trace_handler({trace_ts, Pid, gc_major_end, _Func, TS} = Trace, Table, _, Dump) -> dump_stack(Dump, get(Pid), Trace), trace_gc_end(Table, Pid, TS), TS; @@ -2014,8 +2030,10 @@ trace_spawn(Table, Pid, MFArgs, TS, Parent) -> ets:insert(Table, #proc{id = Pid, parent = Parent, spawned_as = MFArgs}); _ -> - throw({inconsistent_trace_data, ?MODULE, ?LINE, - [Pid, MFArgs, TS, Parent, Stack]}) + %% In 19.0 we get both a spawn and spawned event, + %% however we do not know the order so we just ignore + %% the second event that comes + ok end. diff --git a/lib/tools/test/eprof_SUITE.erl b/lib/tools/test/eprof_SUITE.erl index ba3b71cc1f..e908413315 100644 --- a/lib/tools/test/eprof_SUITE.erl +++ b/lib/tools/test/eprof_SUITE.erl @@ -81,9 +81,6 @@ basic(Config) when is_list(Config) -> %% error case - error = eprof:profile([Pid], fun() -> eprof_test:go(10) end), - Pid = whereis(eprof), - error = eprof:profile([Pid], fun() -> eprof_test:go(10) end), A = spawn(fun() -> receive _ -> ok end end), profiling = eprof:profile([A]), true = exit(A, kill_it), diff --git a/lib/tools/test/fprof_SUITE.erl b/lib/tools/test/fprof_SUITE.erl index 244bdaaf0e..affb45b7a6 100644 --- a/lib/tools/test/fprof_SUITE.erl +++ b/lib/tools/test/fprof_SUITE.erl @@ -949,8 +949,8 @@ handle_trace({trace_ts,Pid,return_to,MFA,TS},P) -> end, put({Pid,last_ts},TS), P; -handle_trace({trace_ts,Pid,gc_start,_,TS},P) -> - ?dbg("~p",[{{gc_start,Pid},get(Pid)}]), +handle_trace({trace_ts,Pid,gc_minor_start,_,TS},P) -> + ?dbg("~p",[{{gc_minor_start,Pid},get(Pid)}]), case get(Pid) of [suspend|_] = Stack -> T = ts_sub(TS,get({Pid,last_ts})), @@ -970,8 +970,40 @@ handle_trace({trace_ts,Pid,gc_start,_,TS},P) -> end, put({Pid,last_ts},TS), P; -handle_trace({trace_ts,Pid,gc_end,_,TS},P) -> - ?dbg("~p",[{{gc_end,Pid},get(Pid)}]), +handle_trace({trace_ts,Pid,gc_major_start,_,TS},P) -> + ?dbg("~p",[{{gc_minor_start,Pid},get(Pid)}]), + case get(Pid) of + [suspend|_] = Stack -> + T = ts_sub(TS,get({Pid,last_ts})), + insert(Pid,garbage_collect), + update_acc(Pid,Stack,T), + put(Pid,[garbage_collect|Stack]); + [CallingMFA|_] = Stack -> + T = ts_sub(TS,get({Pid,last_ts})), + insert(Pid,garbage_collect), + update_own(Pid,CallingMFA,T), + update_acc(Pid,Stack,T), + put(Pid,[garbage_collect|Stack]); + undefined -> + put(first_ts,TS), + put(Pid,[garbage_collect]), + insert(Pid,garbage_collect) + end, + put({Pid,last_ts},TS), + P; +handle_trace({trace_ts,Pid,gc_minor_end,_,TS},P) -> + ?dbg("~p",[{{gc_minor_end,Pid},get(Pid)}]), + T = ts_sub(TS,get({Pid,last_ts})), + case get(Pid) of + [garbage_collect|RestOfStack] = Stack -> + update_own(Pid,garbage_collect,T), + update_acc(Pid,Stack,T), + put(Pid,RestOfStack) + end, + put({Pid,last_ts},TS), + P; +handle_trace({trace_ts,Pid,gc_major_end,_,TS},P) -> + ?dbg("~p",[{{gc_major_end,Pid},get(Pid)}]), T = ts_sub(TS,get({Pid,last_ts})), case get(Pid) of [garbage_collect|RestOfStack] = Stack -> @@ -985,10 +1017,15 @@ handle_trace({trace_ts,Pid,spawn,NewPid,{M,F,Args},TS},P) -> MFA = {M,F,length(Args)}, ?dbg("~p",[{{spawn,Pid,NewPid,MFA},get(Pid)}]), T = ts_sub(TS,get({Pid,last_ts})), - put({NewPid,last_ts},TS), - put(NewPid,[suspend,MFA]), - insert(NewPid,suspend), - insert(NewPid,MFA), + case get(NewPid) of + undefined -> + put({NewPid,last_ts},TS), + put(NewPid,[suspend,MFA]), + insert(NewPid,suspend), + insert(NewPid,MFA); + _Else -> + ok + end, case get(Pid) of [SpawningMFA|_] = Stack -> update_own(Pid,SpawningMFA,T), @@ -996,6 +1033,19 @@ handle_trace({trace_ts,Pid,spawn,NewPid,{M,F,Args},TS},P) -> end, put({Pid,last_ts},TS), P; +handle_trace({trace_ts,NewPid,spawned,Pid,{M,F,Args},TS},P) -> + MFA = {M,F,length(Args)}, + ?dbg("~p",[{{spawned,NewPid,Pid,MFA},get(NewPid)}]), + case get(NewPid) of + undefined -> + put({NewPid,last_ts},TS), + put(NewPid,[suspend,MFA]), + insert(NewPid,suspend), + insert(NewPid,MFA); + _Else -> + ok + end, + P; handle_trace({trace_ts,Pid,exit,_Reason,TS},P) -> ?dbg("~p",[{{exit,Pid,_Reason},get(Pid)}]), T = ts_sub(TS,get({Pid,last_ts})), @@ -1023,6 +1073,7 @@ handle_trace(end_of_trace,P) -> P ! {result,[{totals,TotAcc,TotOwn}|ProcOwns]++Result}, P; handle_trace(Other,_P) -> + ct:log("Got unexpected trace message: ~p",[Other]), exit({unexpected,Other}). find_return_to(MFA,[MFA|_]=Stack) -> diff --git a/lib/wx/api_gen/wx_extra/wxEvtHandler.c_src b/lib/wx/api_gen/wx_extra/wxEvtHandler.c_src index 08fef1c2ff..b9cb4f08cc 100644 --- a/lib/wx/api_gen/wx_extra/wxEvtHandler.c_src +++ b/lib/wx/api_gen/wx_extra/wxEvtHandler.c_src @@ -43,7 +43,7 @@ case 101: { // wxEvtHandler::Disconnect int eventType = wxeEventTypeFromAtom(bp); bp += *eventTypeLen; if(eventType > 0) { if(recurse_level > 1) { - delayed_delete->Append(Ecmd.Save()); + delayed_delete->Append(Ecmd.Save(op)); } else { bool Result = This->Disconnect((int) *winid,(int) *lastId,eventType, (wxObjectEventFunction)(wxEventFunction) diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl index 07486e801b..55c179142d 100644 --- a/lib/wx/api_gen/wx_gen_cpp.erl +++ b/lib/wx/api_gen/wx_gen_cpp.erl @@ -195,11 +195,13 @@ gen_funcs(Defs) -> w("void WxeApp::wxe_dispatch(wxeCommand& Ecmd)~n{~n"), w(" char * bp = Ecmd.buffer;~n"), + w(" int op = Ecmd.op;~n"), + w(" Ecmd.op = -1;~n"), w(" wxeMemEnv *memenv = getMemEnv(Ecmd.port);~n"), %% w(" wxMBConvUTF32 UTFconverter;~n"), - w(" wxeReturn rt = wxeReturn(WXE_DRV_PORT, Ecmd.caller, true);~n"), + w(" wxeReturn rt = wxeReturn(WXE_DRV_PORT, Ecmd.caller, true);~n"), w(" try {~n"), - w(" switch (Ecmd.op)~n{~n"), + w(" switch (op)~n{~n"), %% w(" case WXE_CREATE_PORT:~n", []), %% w(" { newMemEnv(Ecmd.port); } break;~n", []), %% w(" case WXE_REMOVE_PORT:~n", []), @@ -209,7 +211,7 @@ gen_funcs(Defs) -> w(" wxeRefData *refd = getRefData(This);~n"), w(" if(This && refd) {~n"), w(" if(recurse_level > 1 && refd->type != 4) {~n"), - w(" delayed_delete->Append(Ecmd.Save());~n"), + w(" delayed_delete->Append(Ecmd.Save(op));~n"), w(" } else {~n"), w(" delete_object(This, refd);~n"), w(" ((WxeApp *) wxTheApp)->clearPtr(This);}~n"), @@ -228,7 +230,7 @@ gen_funcs(Defs) -> w(" default: {~n"), w(" wxeReturn error = wxeReturn(WXE_DRV_PORT, Ecmd.caller, false);"), w(" error.addAtom(\"_wxe_error_\");~n"), - w(" error.addInt((int) Ecmd.op);~n"), + w(" error.addInt((int) op);~n"), w(" error.addAtom(\"not_supported\");~n"), w(" error.addTupleCount(3);~n"), w(" error.send();~n"), @@ -239,7 +241,7 @@ gen_funcs(Defs) -> w("} catch (wxe_badarg badarg) { // try~n"), w(" wxeReturn error = wxeReturn(WXE_DRV_PORT, Ecmd.caller, false);"), w(" error.addAtom(\"_wxe_error_\");~n"), - w(" error.addInt((int) Ecmd.op);~n"), + w(" error.addInt((int) op);~n"), w(" error.addAtom(\"badarg\");~n"), w(" error.addInt((int) badarg.ref);~n"), w(" error.addTupleCount(2);~n"), diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp index 059cee59f4..283e97f4e2 100644 --- a/lib/wx/c_src/gen/wxe_funcs.cpp +++ b/lib/wx/c_src/gen/wxe_funcs.cpp @@ -40,17 +40,19 @@ void WxeApp::wxe_dispatch(wxeCommand& Ecmd) { char * bp = Ecmd.buffer; + int op = Ecmd.op; + Ecmd.op = -1; wxeMemEnv *memenv = getMemEnv(Ecmd.port); - wxeReturn rt = wxeReturn(WXE_DRV_PORT, Ecmd.caller, true); + wxeReturn rt = wxeReturn(WXE_DRV_PORT, Ecmd.caller, true); try { - switch (Ecmd.op) + switch (op) { case DESTROY_OBJECT: { void *This = getPtr(bp,memenv); wxeRefData *refd = getRefData(This); if(This && refd) { if(recurse_level > 1 && refd->type != 4) { - delayed_delete->Append(Ecmd.Save()); + delayed_delete->Append(Ecmd.Save(op)); } else { delete_object(This, refd); ((WxeApp *) wxTheApp)->clearPtr(This);} @@ -114,7 +116,7 @@ case 101: { // wxEvtHandler::Disconnect int eventType = wxeEventTypeFromAtom(bp); bp += *eventTypeLen; if(eventType > 0) { if(recurse_level > 1) { - delayed_delete->Append(Ecmd.Save()); + delayed_delete->Append(Ecmd.Save(op)); } else { bool Result = This->Disconnect((int) *winid,(int) *lastId,eventType, (wxObjectEventFunction)(wxEventFunction) @@ -32077,7 +32079,7 @@ case wxDCOverlay_Clear: { // wxDCOverlay::Clear } default: { wxeReturn error = wxeReturn(WXE_DRV_PORT, Ecmd.caller, false); error.addAtom("_wxe_error_"); - error.addInt((int) Ecmd.op); + error.addInt((int) op); error.addAtom("not_supported"); error.addTupleCount(3); error.send(); @@ -32087,7 +32089,7 @@ case wxDCOverlay_Clear: { // wxDCOverlay::Clear rt.send(); } catch (wxe_badarg badarg) { // try wxeReturn error = wxeReturn(WXE_DRV_PORT, Ecmd.caller, false); error.addAtom("_wxe_error_"); - error.addInt((int) Ecmd.op); + error.addInt((int) op); error.addAtom("badarg"); error.addInt((int) badarg.ref); error.addTupleCount(2); diff --git a/lib/wx/c_src/wxe_helpers.cpp b/lib/wx/c_src/wxe_helpers.cpp index 76958a346f..4798e605e8 100644 --- a/lib/wx/c_src/wxe_helpers.cpp +++ b/lib/wx/c_src/wxe_helpers.cpp @@ -47,8 +47,8 @@ void wxeCommand::Delete() if(len > 64) driver_free(buffer); buffer = NULL; - op = -1; } + op = -1; } /* **************************************************************************** @@ -226,7 +226,7 @@ unsigned int wxeFifo::Cleanup(unsigned int def) // Realloced we need to start from the beginning return 0; } else { - return def; + return def < cb_start? def : cb_start; } } diff --git a/lib/wx/c_src/wxe_helpers.h b/lib/wx/c_src/wxe_helpers.h index 3f66b6d97a..70ffccdc13 100644 --- a/lib/wx/c_src/wxe_helpers.h +++ b/lib/wx/c_src/wxe_helpers.h @@ -46,7 +46,7 @@ class wxeCommand wxeCommand(); virtual ~wxeCommand(); // Use Delete() - wxeCommand * Save() { return this; }; + wxeCommand * Save(int Op) { op = Op; return this; }; void Delete(); ErlDrvTermData caller; diff --git a/lib/wx/c_src/wxe_impl.cpp b/lib/wx/c_src/wxe_impl.cpp index f899839782..175bcfce54 100644 --- a/lib/wx/c_src/wxe_impl.cpp +++ b/lib/wx/c_src/wxe_impl.cpp @@ -238,9 +238,10 @@ void WxeApp::dispatch_cmds() if(wxe_status != WXE_INITIATED) return; recurse_level++; - // fprintf(stderr, "\r\ndispatch_normal %d\r\n", level);fflush(stderr); + // fprintf(stderr, "\r\ndispatch_normal %d\r\n", recurse_level);fflush(stderr); + wxe_queue->cb_start = 0; dispatch(wxe_queue); - // fprintf(stderr, "\r\ndispatch_done \r\n");fflush(stderr); + // fprintf(stderr, "\r\ndispatch_done %d\r\n", recurse_level);fflush(stderr); recurse_level--; // Cleanup old memenv's and deleted objects diff --git a/lib/wx/src/wx.erl b/lib/wx/src/wx.erl index a1a9344316..6498b58cda 100644 --- a/lib/wx/src/wx.erl +++ b/lib/wx/src/wx.erl @@ -66,7 +66,7 @@ get_env/0,set_env/1, debug/1, batch/1,foreach/2,map/2,foldl/3,foldr/3, getObjectType/1, typeCast/2, - null/0, is_null/1]). + null/0, is_null/1, equal/2]). -export([create_memory/1, get_memory_bin/1, retain_memory/1, release_memory/1]). @@ -153,6 +153,10 @@ null() -> -spec is_null(wx_object()) -> boolean(). is_null(#wx_ref{ref=NULL}) -> NULL =:= 0. +%% @doc Returns true if both arguments references the same object, false otherwise +-spec equal(wx_object(), wx_object()) -> boolean(). +equal(#wx_ref{ref=Ref1}, #wx_ref{ref=Ref2}) -> Ref1 =:= Ref2. + %% @doc Returns the object type -spec getObjectType(wx_object()) -> atom(). getObjectType(#wx_ref{type=Type}) -> diff --git a/lib/wx/src/wx_object.erl b/lib/wx/src/wx_object.erl index a2acbb0a63..c22a083eb9 100644 --- a/lib/wx/src/wx_object.erl +++ b/lib/wx/src/wx_object.erl @@ -107,7 +107,8 @@ call/2, call/3, cast/2, reply/2, - get_pid/1 + get_pid/1, + set_pid/2 ]). %% -export([behaviour_info/1]). @@ -306,6 +307,11 @@ cast(Name, Request) when is_atom(Name) orelse is_pid(Name) -> get_pid(#wx_ref{state=Pid}) when is_pid(Pid) -> Pid. +%% @spec (Ref::wxObject(), pid()) -> wxObject() +%% @doc Sets the controlling process of the object handle. +set_pid(#wx_ref{}=R, Pid) when is_pid(Pid) -> + R#wx_ref{state=Pid}. + %% ----------------------------------------------------------------- %% Send a reply to the client. %% ----------------------------------------------------------------- diff --git a/lib/wx/test/wx_app_SUITE.erl b/lib/wx/test/wx_app_SUITE.erl index 0b885a78b8..3fd5bf689d 100644 --- a/lib/wx/test/wx_app_SUITE.erl +++ b/lib/wx/test/wx_app_SUITE.erl @@ -49,7 +49,7 @@ end_per_testcase(Func,Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,5}}]. all() -> [fields, modules, exportall, app_depend, undef_funcs, appup]. @@ -221,12 +221,10 @@ check_apps([App|Apps]) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -undef_funcs(suite) -> - []; -undef_funcs(doc) -> - []; +undef_funcs() -> + [{timetrap,{minutes,10}}]. + undef_funcs(Config) when is_list(Config) -> - catch test_server:timetrap(timer:minutes(10)), App = wx, AppFile = key1search(app_file, Config), Mods = key1search(modules, AppFile), diff --git a/lib/wx/test/wx_basic_SUITE.erl b/lib/wx/test/wx_basic_SUITE.erl index 5dffdea6be..f89f25274a 100644 --- a/lib/wx/test/wx_basic_SUITE.erl +++ b/lib/wx/test/wx_basic_SUITE.erl @@ -45,7 +45,7 @@ end_per_testcase(Func,Config) -> wx_test_lib:end_per_testcase(Func,Config). %% SUITE specification -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,2}}]. all() -> [silent_start, create_window, several_apps, wx_api, wx_misc, @@ -344,13 +344,13 @@ data_types(_Config) -> ImgRGB = ?mt(wxImage, wxImage:new(128, 64, Colors)), ?m(true, wxImage:ok(ImgRGB)), ?m(false, wxImage:hasAlpha(ImgRGB)), - ?m(Colors, wxImage:getData(ImgRGB)), + ?m(ok, case wxImage:getData(ImgRGB) of Colors -> ok; Other -> Other end), ImgRGBA = ?mt(wxImage, wxImage:new(128, 64, Colors, Alpha)), ?m(true, wxImage:ok(ImgRGBA)), ?m(true, wxImage:hasAlpha(ImgRGBA)), - ?m(Colors, wxImage:getData(ImgRGBA)), - ?m(Alpha, wxImage:getAlpha(ImgRGBA)), + ?m(ok, case wxImage:getData(ImgRGBA) of Colors -> ok; Other -> Other end), + ?m(ok, case wxImage:getAlpha(ImgRGBA) of Alpha -> ok; Other -> Other end), wxClientDC:destroy(CDC), %%wx_test_lib:wx_destroy(Frame,Config). @@ -361,7 +361,8 @@ wx_object(Config) -> wx:new(), Me = self(), Init = fun() -> - Frame = wxFrame:new(wx:null(), ?wxID_ANY, "Test wx_object", [{size, {500, 400}}]), + Frame0 = wxFrame:new(wx:null(), ?wxID_ANY, "Test wx_object", [{size, {500, 400}}]), + Frame = wx_object:set_pid(Frame0, self()), Sz = wxBoxSizer:new(?wxHORIZONTAL), Panel = wxPanel:new(Frame), wxSizer:add(Sz, Panel, [{flag, ?wxEXPAND}, {proportion, 1}]), @@ -371,6 +372,7 @@ wx_object(Config) -> {Frame, {Frame, Panel}} end, Frame = ?mt(wxFrame, wx_obj_test:start([{init, Init}])), + timer:sleep(500), ?m(ok, check_events(flush())), @@ -378,6 +380,11 @@ wx_object(Config) -> ?m({call, foobar, {Me, _}}, wx_object:call(Frame, foobar)), ?m(ok, wx_object:cast(Frame, foobar2)), ?m([{cast, foobar2}|_], flush()), + + ?m(Frame, wx_obj_test:who_are_you(Frame)), + {call, {Frame,Panel}, _} = wx_object:call(Frame, fun(US) -> US end), + ?m(false, wxWindow:getParent(Panel) =:= Frame), + ?m(true, wx:equal(wxWindow:getParent(Panel),Frame)), FramePid = wx_object:get_pid(Frame), io:format("wx_object pid ~p~n",[FramePid]), FramePid ! foo3, diff --git a/lib/wx/test/wx_class_SUITE.erl b/lib/wx/test/wx_class_SUITE.erl index e23fd901f5..f88c10f987 100644 --- a/lib/wx/test/wx_class_SUITE.erl +++ b/lib/wx/test/wx_class_SUITE.erl @@ -46,12 +46,12 @@ end_per_testcase(Func,Config) -> wx_test_lib:end_per_testcase(Func,Config). %% SUITE specification -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,2}}]. all() -> [calendarCtrl, treeCtrl, notebook, staticBoxSizer, clipboard, helpFrame, htmlWindow, listCtrlSort, listCtrlVirtual, - radioBox, systemSettings, taskBarIcon, toolbar, popup]. + radioBox, systemSettings, taskBarIcon, toolbar, popup, modal]. groups() -> []. @@ -621,3 +621,67 @@ lang_env() -> format_env({match, List}) -> [io:format(" ~ts~n",[L]) || L <- List]; format_env(nomatch) -> ok. + +%% Add a testcase that tests that we can recurse in showModal +%% because it hangs in observer if object are not destroyed correctly +%% when popping the stack + +modal(Config) -> + Wx = wx:new(), + case {?wxMAJOR_VERSION, ?wxMINOR_VERSION, ?wxRELEASE_NUMBER} of + {2, Min, Rel} when Min < 8 orelse (Min =:= 8 andalso Rel < 11) -> + {skip, "old wxWidgets version"}; + _ -> + Frame = wxFrame:new(Wx, -1, "Test Modal windows"), + wxFrame:show(Frame), + Env = wx:get_env(), + Tester = self(), + ets:new(test_state, [named_table, public]), + Upd = wxUpdateUIEvent:getUpdateInterval(), + wxUpdateUIEvent:setUpdateInterval(500), + _Pid = spawn(fun() -> + wx:set_env(Env), + modal_dialog(Frame, 1, Tester) + end), + receive {dialog, M1, 1} -> timer:sleep(200), ets:insert(test_state, {M1, ready}) end, + receive {dialog, M2, 2} -> timer:sleep(200), ets:insert(test_state, {M2, ready}) end, + + receive done -> ok end, + receive {dialog_done, M2, 2} -> M2 end, + receive {dialog_done, M1, 1} -> M1 end, + + wxUpdateUIEvent:setUpdateInterval(Upd), + wx_test_lib:wx_destroy(Frame,Config) + end. + +modal_dialog(Parent, Level, Tester) when Level < 3 -> + M1 = wxTextEntryDialog:new(Parent, "Dialog " ++ integer_to_list(Level)), + io:format("Creating dialog ~p ~p~n",[Level, M1]), + wxDialog:connect(M1, show, [{callback, fun(#wx{event=Ev},_) -> + case Ev of + #wxShow{show=true} -> + Tester ! {dialog, M1, Level}; + _ -> ignore + end + end}]), + DoOnce = fun(_,_) -> + case ets:take(test_state, M1) of + [] -> ignore; + [_] -> modal_dialog(M1, Level+1, Tester) + end + end, + wxDialog:connect(M1, update_ui, [{callback, DoOnce}]), + ?wxID_OK = wxDialog:showModal(M1), + wxDialog:destroy(M1), + case Level > 1 of + true -> + io:format("~p: End dialog ~p ~p~n",[?LINE, Level-1, Parent]), + wxDialog:endModal(Parent, ?wxID_OK); + false -> ok + end, + Tester ! {dialog_done, M1, Level}, + ok; +modal_dialog(Parent, Level, Tester) -> + io:format("~p: End dialog ~p ~p~n",[?LINE, Level-1, Parent]), + wxDialog:endModal(Parent, ?wxID_OK), + Tester ! done. diff --git a/lib/wx/test/wx_event_SUITE.erl b/lib/wx/test/wx_event_SUITE.erl index 62fcf44033..6512cedaf2 100644 --- a/lib/wx/test/wx_event_SUITE.erl +++ b/lib/wx/test/wx_event_SUITE.erl @@ -44,7 +44,7 @@ end_per_testcase(Func,Config) -> wx_test_lib:end_per_testcase(Func,Config). %% SUITE specification -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,2}}]. all() -> [connect, disconnect, disconnect_cb, connect_msg_20, connect_cb_20, diff --git a/lib/wx/test/wx_obj_test.erl b/lib/wx/test/wx_obj_test.erl index cf99728c1a..23142e28b2 100644 --- a/lib/wx/test/wx_obj_test.erl +++ b/lib/wx/test/wx_obj_test.erl @@ -19,13 +19,13 @@ -module(wx_obj_test). -include_lib("wx/include/wx.hrl"). --export([start/1, stop/1]). +-export([start/1, stop/1, who_are_you/1]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, handle_sync_event/3, handle_event/2, handle_cast/2]). --record(state, {parent, opts, user_state}). +-record(state, {parent, me, opts, user_state}). start(Opts) -> wx_object:start_link(?MODULE, [{parent, self()}| Opts], []). @@ -33,12 +33,15 @@ start(Opts) -> stop(Object) -> wx_object:stop(Object). +who_are_you(Object) -> + wx_object:call(Object, who_are_you). + init(Opts) -> Parent = proplists:get_value(parent, Opts), put(parent_pid, Parent), Init = proplists:get_value(init, Opts), {Obj, UserState} = Init(), - {Obj, #state{parent=Parent, opts=Opts, user_state=UserState}}. + {Obj, #state{me=Obj, parent=Parent, opts=Opts, user_state=UserState}}. handle_sync_event(Event = #wx{obj=Panel, event=#wxPaint{}}, WxEvent, #state{parent=Parent, user_state=US, opts=Opts}) -> @@ -59,6 +62,8 @@ handle_event(Event, State = #state{parent=Parent}) -> Parent ! {event, Event}, {noreply, State}. +handle_call(who_are_you, _From, State = #state{me=Me}) -> + {reply, Me, State}; handle_call(What, From, State = #state{user_state=US}) when is_function(What) -> Result = What(US), {reply, {call, Result, From}, State}; diff --git a/lib/wx/test/wx_opengl_SUITE.erl b/lib/wx/test/wx_opengl_SUITE.erl index 5162078dbf..643a0df6a3 100644 --- a/lib/wx/test/wx_opengl_SUITE.erl +++ b/lib/wx/test/wx_opengl_SUITE.erl @@ -52,7 +52,7 @@ end_per_testcase(Func,Config) -> wx_test_lib:end_per_testcase(Func,Config). %% SUITE specification -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,2}}]. all() -> [canvas, glu_tesselation]. diff --git a/lib/wx/test/wx_xtra_SUITE.erl b/lib/wx/test/wx_xtra_SUITE.erl index 7aba17ee74..c6268a7f46 100644 --- a/lib/wx/test/wx_xtra_SUITE.erl +++ b/lib/wx/test/wx_xtra_SUITE.erl @@ -45,7 +45,7 @@ end_per_testcase(Func,Config) -> wx_test_lib:end_per_testcase(Func,Config). %% SUITE specification -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,2}}]. all() -> [destroy_app, multiple_add_in_sizer, app_dies, diff --git a/lib/wx/test/wxt.erl b/lib/wx/test/wxt.erl index fc828e47e8..265cd5c981 100644 --- a/lib/wx/test/wxt.erl +++ b/lib/wx/test/wxt.erl @@ -16,13 +16,9 @@ %% limitations under the License. %% %% %CopyrightEnd% -%%%------------------------------------------------------------------- -%%% File : wxt.erl -%%% Author : Dan Gudmundsson <[email protected]> -%%% Description : Shortcuts for starting test with wx internal test_server -%%% -%%% Created : 4 Nov 2008 by Dan Gudmundsson <[email protected]> -%%%------------------------------------------------------------------- +%% +%% Description : Shortcuts for running tests with wx internal test_server +%%------------------------------------------------------------------- -module(wxt). -compile(export_all). @@ -40,7 +36,7 @@ t(Mod, TC) when is_atom(Mod), is_atom(TC) -> t({Mod,TC}, []); t(all, Config) when is_list(Config) -> Fs = filelib:wildcard("wx_*_SUITE.erl"), - t([list_to_atom(filename:rootname(File)) || File <- Fs], Config); + t([list_to_atom(filename:rootname(File)) || File <- Fs, File =/= "wx_app_SUITE.erl"], Config); t(Test,Config) when is_list(Config) -> Tests = resolve(Test), write_test_case(Test), diff --git a/otp_versions.table b/otp_versions.table index f339eab796..79e1c14c49 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-18.3.2 : inets-6.2.2 ssl-7.3.1 # asn1-4.0.2 common_test-1.12 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 : OTP-18.3.1 : erts-7.3.1 inets-6.2.1 mnesia-4.13.4 # asn1-4.0.2 common_test-1.12 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2 ssl-7.3 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 : OTP-18.3 : asn1-4.0.2 common_test-1.12 compiler-6.0.3 cosNotification-1.2.1 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3 eunit-2.2.13 hipe-3.15 inets-6.2 kernel-4.2 mnesia-4.13.3 observer-2.1.2 orber-3.8.1 public_key-1.1.1 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2 ssl-7.3 stdlib-2.8 test_server-3.10 tools-2.8.3 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 # cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosProperty-1.2 et-1.5.1 gs-1.6 ic-4.4 jinterface-1.6.1 megaco-3.18 odbc-2.11.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 reltool-0.7 syntax_tools-1.7 typer-0.9.10 : OTP-18.2.4 : common_test-1.11.2 # asn1-4.0.1 compiler-6.0.2 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2 cosProperty-1.2 cosTime-1.2 cosTransactions-1.3 crypto-3.6.2 debugger-4.1.1 dialyzer-2.8.2 diameter-1.11.1 edoc-0.7.17 eldap-1.2 erl_docgen-0.4.1 erl_interface-3.8.1 erts-7.2.1 et-1.5.1 eunit-2.2.12 gs-1.6 hipe-3.14 ic-4.4 inets-6.1.1 jinterface-1.6.1 kernel-4.1.1 megaco-3.18 mnesia-4.13.2 observer-2.1.1 odbc-2.11.1 orber-3.8 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1 reltool-0.7 runtime_tools-1.9.2 sasl-2.6.1 snmp-5.2.1 ssh-4.2.1 ssl-7.2 stdlib-2.7 syntax_tools-1.7 test_server-3.9.1 tools-2.8.2 typer-0.9.10 webtool-0.9 wx-1.6 xmerl-1.3.9 : diff --git a/system/doc/definitions/term.defs b/system/doc/definitions/term.defs index 6091a46a20..921175a7f0 100644 --- a/system/doc/definitions/term.defs +++ b/system/doc/definitions/term.defs @@ -76,6 +76,7 @@ the module Erlang in the application kernel","kenneth"}, {"gen_event","gen_event","A behaviour used for programming event handling mechanisms, such as alarm handlers, error loggers, and plug-and-play handlers.","mbj"}, {"gen_fsm","gen_fsm","A behaviour used for programming finite state machines.","mbj"}, {"gen_server","gen_server","A behaviour used for programming client-server processes.","mbj"}, +{"gen_statem","gen_statem","A behaviour used for programming generic state machines.","raimo"}, {"gterm","Global Glossary Database","A glossary database used to list common acronymns and defintions etc.","jocke"}, {"xref","xref","A cross reference tool that can be used for finding dependencies between functions, modules, applications and releases. Part of the Tools application.","gunilla"}, {"GSlong","Graphics System","A library module which provides a graphics interface for Erlang.","mbj"}, diff --git a/system/doc/design_principles/Makefile b/system/doc/design_principles/Makefile index 653072bc65..937b3e28c8 100644 --- a/system/doc/design_principles/Makefile +++ b/system/doc/design_principles/Makefile @@ -58,6 +58,12 @@ GIF_FILES = \ sup5.gif \ sup6.gif +PNG_FILES = \ + code_lock.png \ + code_lock_2.png + +IMAGE_FILES = $(GIF_FILES) $(PNG_FILES) + XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) @@ -85,13 +91,16 @@ _create_dirs := $(shell mkdir -p $(HTMLDIR)) $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ +$(HTMLDIR)/%.png: %.png + $(INSTALL_DATA) $< $@ + docs: html local_docs: PDFDIR=../../pdf -html: $(HTML_UG_FILE) gifs +html: $(HTML_UG_FILE) images -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) +images: $(IMAGE_FILES:%=$(HTMLDIR)/%) debug opt: @@ -109,7 +118,7 @@ release_docs_spec: docs # $(INSTALL_DIR) "$(RELEASE_PATH)/pdf" # $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELEASE_PATH)/pdf" $(INSTALL_DIR) $(RELSYSDIR) - $(INSTALL_DATA) $(GIF_FILES) $(HTMLDIR)/*.html \ + $(INSTALL_DATA) $(IMAGE_FILES) $(HTMLDIR)/*.html \ $(RELSYSDIR) diff --git a/system/doc/design_principles/appup_cookbook.xml b/system/doc/design_principles/appup_cookbook.xml index 417b482fba..4f23c42c59 100644 --- a/system/doc/design_principles/appup_cookbook.xml +++ b/system/doc/design_principles/appup_cookbook.xml @@ -50,7 +50,8 @@ <p>In a system implemented according to the OTP design principles, all processes, except system processes and special processes, reside in one of the behaviours <c>supervisor</c>, - <c>gen_server</c>, <c>gen_fsm</c>, or <c>gen_event</c>. These + <c>gen_server</c>, <c>gen_fsm</c>, + <c>gen_statem</c> or <c>gen_event</c>. These belong to the STDLIB application and upgrading/downgrading normally requires an emulator restart.</p> <p>OTP thus provides no support for changing residence modules except diff --git a/system/doc/design_principles/code_lock.dia b/system/doc/design_principles/code_lock.dia Binary files differnew file mode 100644 index 0000000000..bed6d8ee86 --- /dev/null +++ b/system/doc/design_principles/code_lock.dia diff --git a/system/doc/design_principles/code_lock.png b/system/doc/design_principles/code_lock.png Binary files differnew file mode 100644 index 0000000000..e40f0320aa --- /dev/null +++ b/system/doc/design_principles/code_lock.png diff --git a/system/doc/design_principles/code_lock_2.dia b/system/doc/design_principles/code_lock_2.dia Binary files differnew file mode 100644 index 0000000000..4e82a9e1d6 --- /dev/null +++ b/system/doc/design_principles/code_lock_2.dia diff --git a/system/doc/design_principles/code_lock_2.png b/system/doc/design_principles/code_lock_2.png Binary files differnew file mode 100644 index 0000000000..138fbdef6c --- /dev/null +++ b/system/doc/design_principles/code_lock_2.png diff --git a/system/doc/design_principles/des_princ.xml b/system/doc/design_principles/des_princ.xml index 0cf9f28bdc..8ab8661c2d 100644 --- a/system/doc/design_principles/des_princ.xml +++ b/system/doc/design_principles/des_princ.xml @@ -226,7 +226,9 @@ free(Ch, {Alloc, Free} = Channels) -> <item><p><seealso marker="gen_server_concepts">gen_server</seealso></p> <p>For implementing the server of a client-server relation</p></item> <item><p><seealso marker="fsm">gen_fsm</seealso></p> - <p>For implementing finite-state machines</p></item> + <p>For implementing finite-state machines (Old)</p></item> + <item><p><seealso marker="statem">gen_statem</seealso></p> + <p>For implementing state machines (New)</p></item> <item><p><seealso marker="events">gen_event</seealso></p> <p>For implementing event handling functionality</p></item> <item><p><seealso marker="sup_princ">supervisor</seealso></p> diff --git a/system/doc/design_principles/fsm.xml b/system/doc/design_principles/fsm.xml index f20d20fb7e..3468f93ae0 100644 --- a/system/doc/design_principles/fsm.xml +++ b/system/doc/design_principles/fsm.xml @@ -30,6 +30,16 @@ <file>fsm.xml</file> </header> <marker id="gen_fsm behaviour"></marker> + <note> + <p> + There is a new behaviour + <seealso marker="gen_statem"><c>gen_statem</c></seealso> + that is intended to replace <c>gen_fsm</c> for new code. + It has the same features and add some really useful. + This module will not be removed for the foreseeable future + to keep old state machine implementations running. + </p> + </note> <p>This section is to be read with the <c>gen_fsm(3)</c> manual page in STDLIB, where all interface functions and callback functions are described in detail.</p> diff --git a/system/doc/design_principles/part.xml b/system/doc/design_principles/part.xml index 7862a2d650..6495211e04 100644 --- a/system/doc/design_principles/part.xml +++ b/system/doc/design_principles/part.xml @@ -31,6 +31,7 @@ <xi:include href="des_princ.xml"/> <xi:include href="gen_server_concepts.xml"/> <xi:include href="fsm.xml"/> + <xi:include href="statem.xml"/> <xi:include href="events.xml"/> <xi:include href="sup_princ.xml"/> <xi:include href="spec_proc.xml"/> diff --git a/system/doc/design_principles/release_handling.xml b/system/doc/design_principles/release_handling.xml index c38cca248f..4f71ad4437 100644 --- a/system/doc/design_principles/release_handling.xml +++ b/system/doc/design_principles/release_handling.xml @@ -249,7 +249,7 @@ <p>If <c>Modules=dynamic</c>, which is the case for event managers, the event manager process informs the release handler about the list of currently installed event handlers - (<c>gen_fsm</c>), and it is checked if the module name is in + (<c>gen_event</c>), and it is checked if the module name is in this list instead.</p> <p>The release handler suspends, asks for code change, and resumes processes by calling the functions diff --git a/system/doc/design_principles/statem.xml b/system/doc/design_principles/statem.xml new file mode 100644 index 0000000000..ca0fce55e2 --- /dev/null +++ b/system/doc/design_principles/statem.xml @@ -0,0 +1,1522 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2016</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>gen_statem Behaviour</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + <file>statem.xml</file> + </header> + <marker id="gen_statem behaviour"></marker> + <p> + This section is to be read with the + <seealso marker="stdlib:gen_statem"><c>gen_statem(3)</c></seealso> + manual page in STDLIB, where all interface functions and callback + functions are described in detail. + </p> + <p> + This is a new behaviour in OTP-19.0. + It has been thoroughly reviewed, is stable enough + to be used by at least two heavy OTP applications, and is here to stay. + But depending on user feedback, we do not expect + but might find it necessary to make minor + not backwards compatible changes into OTP-20.0, + so its state can be designated as "not quite experimental"... + </p> + +<!-- =================================================================== --> + + <section> + <title>Event Driven State Machines</title> + <p> + Established Automata theory does not deal much with + how a state transition is triggered, + but in general assumes that the output is a function + of the input (and the state) and that they are + some kind of values. + </p> + <p> + For an Event Driven State Machine the input is an event + that triggers a state transition and the output + is actions executed during the state transition. + It can analogously to the mathematical model of a + Finite State Machine be described as + a set of relations of the form: + </p> + <pre> +State(S) x Event(E) -> Actions(A), State(S')</pre> + <p>These relations are interpreted as meaning:</p> + <p> + If we are in state <c>S</c> and event <c>E</c> occurs, we + are to perform actions <c>A</c> and make a transition to + state <c>S'</c>. + </p> + <p> + Note that <c>S'</c> may be equal to <c>S</c>. + </p> + <p> + Since <c>A</c> and <c>S'</c> depend only on + <c>S</c> and <c>E</c> the kind of state machine described + here is a Mealy Machine. + (See for example the corresponding Wikipedia article) + </p> + <p> + Like most <c>gen_</c> behaviours, <c>gen_statem</c> keeps + a server <c>Data</c> besides the state. This and the fact that + there is no restriction on the number of states + (assuming enough virtual machine memory) + or on the number of distinct input events actually makes + a state machine implemented with this behaviour Turing complete. + But it feels mostly like an Event Driven Mealy Machine. + </p> + </section> + +<!-- =================================================================== --> + + <section> + <marker id="callback_modes" /> + <title>Callback Modes</title> + <p> + The <c>gen_statem</c> behaviour supports two different callback modes. + In the mode + <seealso marker="stdlib:gen_statem#type-callback_mode"> + <c>state_functions</c>, + </seealso> + the state transition rules are written as a number of Erlang + functions, which conform to the following convention: + </p> + <pre> +StateName(EventType, EventContent, Data) -> + .. code for actions here ... + {next_state, NewStateName, NewData}.</pre> + <p> + In the mode + <seealso marker="stdlib:gen_statem#type-callback_mode"> + <c>handle_event_function</c> + </seealso> + there is only one + Erlang function that implements all state transition rules: + </p> + <pre> +handle_event(EventType, EventContent, State, Data) -> + .. code for actions here ... + {next_state, State', Data'}</pre> + <p> + Both these modes allow other return tuples + that you can find in the + <seealso marker="stdlib:gen_statem#Module:StateName/3"> + reference manual. + </seealso> + These other return tuples can for example stop the machine, + execute state transition actions on the machine engine itself + and send replies. + </p> + + <section> + <title>Choosing the Callback Mode</title> + <p> + The two + <seealso marker="#callback_modes">callback modes</seealso> + gives different possibilities + and restrictions, but one goal remains: + you want to handle all possible combinations of + events and states. + </p> + <p> + You can for example do this by focusing on one state at the time + and for every state ensure that all events are handled, + or the other way around focus on one event at the time + and ensure that it is handled in every state, + or mix these strategies. + </p> + <p> + With <c>state_functions</c> you are restricted to use + atom only states, and the <c>gen_statem</c> engine dispatches + on state name for you. This encourages the callback module + to gather the implementation of all event actions particular + to one state in the same place in the code + hence to focus on one state at the time. + </p> + <p> + This mode fits well when you have a regular state diagram + like the ones in this chapter that describes all events and actions + belonging to a state visually around that state, + and each state has its unique name. + </p> + <p> + With <c>handle_event_function</c> you are free to mix strategies + as you like because all events and states + are handled in the the same callback function. + </p> + <p> + This mode works equally well when you want to focus on + one event at the time or when you want to focus on + one state at the time, but the <c>handle_event/4</c> function + quickly grows too large to handle without introducing dispatching. + </p> + <p> + The mode enables the use of non-atom states for example + complex states or even hiearchical states. + If, for example, a state diagram is largely alike + for the client and for the server side of a protocol; + then you can have a state <c>{StateName,server}</c> or + <c>{StateName,client}</c> and since you do the dispatching + yourself you make <c>StateName</c> decide where in the code + to handle most events in the state. + The second element of the tuple is then used to select + whether to handle special client side or server side events. + </p> + </section> + </section> + +<!-- =================================================================== --> + + <section> + <title>Example</title> + <p> + This is an example starting off as equivalent to the the example in the + <seealso marker="fsm"><c>gen_fsm</c> behaviour</seealso> + description. In later chapters additions and tweaks are made + using features in <c>gen_statem</c> that <c>gen_fsm</c> does not have. + At the end of this section you can find the example again + with all the added features. + </p> + <p> + A door with a code lock can be viewed as a state machine. + Initially, the door is locked. Anytime someone presses a button, + this generates an event. + Depending on what buttons have been pressed before, + the sequence so far can be correct, incomplete, or wrong. + </p> + <p> + If it is correct, the door is unlocked for 10 seconds (10000 ms). + If it is incomplete, we wait for another button to be pressed. If + it is is wrong, we start all over, + waiting for a new button sequence. + </p> + <image file="../design_principles/code_lock.png"> + <icaption>Code lock state diagram</icaption> + </image> + <p> + We can implement such a code lock state machine using + <c>gen_statem</c> with the following callback module: + </p> + <marker id="ex"></marker> + <code type="erl"><![CDATA[ +-module(code_lock). +-behaviour(gen_statem). +-define(NAME, code_lock). +-define(CALLBACK_MODE, state_functions). + +-export([start_link/1]). +-export([button/1]). +-export([init/1,terminate/3,code_change/4]). +-export([locked/3,open/3]). + +start_link(Code) -> + gen_statem:start_link({local,?NAME}, ?MODULE, Code, []). + +button(Digit) -> + gen_statem:cast(?NAME, {button,Digit}). + + +init(Code) -> + do_lock(), + Data = #{code => Code, remaining => Code}, + {?CALLBACK_MODE,locked,Data}. + +locked( + cast, {button,Digit}, + #{code := Code, remaining := Remaining} = Data) -> + case Remaining of + [Digit] -> + do_unlock(), + {next_state,open,Data#{remaining := Code},10000}; + [Digit|Rest] -> % Incomplete + {next_state,locked,Data#{remaining := Rest}}; + _Wrong -> + {next_state,locked,Data#{remaining := Code}} + end. + +open(timeout, _, Data) -> + do_lock(), + {next_state,locked,Data}; +open(cast, {button,_}, Data) -> + do_lock(), + {next_state,locked,Data}. + +do_lock() -> + io:format("Lock~n", []). +do_unlock() -> + io:format("Unlock~n", []). + +terminate(_Reason, State, _Data) -> + State =/= locked andalso do_lock(), + ok. +code_change(_Vsn, State, Data, _Extra) -> + {?CALLBACK_MODE,State,Data}. + ]]></code> + <p>The code is explained in the next sections.</p> + </section> + +<!-- =================================================================== --> + + <section> + <title>Starting gen_statem</title> + <p> + In the example in the previous section, the <c>gen_statem</c> is + started by calling <c>code_lock:start_link(Code)</c>: + </p> + <code type="erl"><![CDATA[ +start_link(Code) -> + gen_statem:start_link({local,?NAME}, ?MODULE, Code, []). + ]]></code> + <p> + <c>start_link</c> calls the function + <seealso marker="stdlib:gen_statem#start_link/4"> + <c>gen_statem:start_link/4</c> + </seealso> + which spawns and links to a new process; a <c>gen_statem</c>. + </p> + <list type="bulleted"> + <item> + <p> + The first argument, <c>{local,?NAME}</c>, specifies + the name. In this case, the <c>gen_statem</c> is locally + registered as <c>code_lock</c> through the macro <c>?NAME</c>. + </p> + <p> + If the name is omitted, the <c>gen_statem</c> is not registered. + Instead its pid must be used. The name can also be given + as <c>{global,Name}</c>, in which case the <c>gen_statem</c> is + registered using + <seealso marker="kernel:global#register_name/2"> + <c>global:register_name/2</c>. + </seealso> + </p> + </item> + <item> + <p> + The second argument, <c>?MODULE</c>, is the name of + the callback module, that is; the module where the callback + functions are located, which is this module. + </p> + <p> + The interface functions (<c>start_link/1</c> and <c>button/1</c>) + are located in the same module as the callback functions + (<c>init/1</c>, <c>locked/3</c>, and <c>open/3</c>). + It is normally good programming practice to have the client + side and the server side code contained in one module. + </p> + </item> + <item> + <p> + The third argument, <c>Code</c>, is a list of digits that + is the correct unlock code which is passsed + to the callback function <c>init/1</c>. + </p> + </item> + <item> + <p> + The fourth argument, <c>[]</c>, is a list of options. See the + <seealso marker="stdlib:gen_statem#start_link/3"> + <c>gen_statem:start_link/3</c> + </seealso> + manual page for available options. + </p> + </item> + </list> + <p> + If name registration succeeds, the new <c>gen_statem</c> process + calls the callback function <c>code_lock:init(Code)</c>. + This function is expected to return <c>{CallbackMode,State,Data}</c>, + where + <seealso marker="#callback_modes"> + <c>CallbackMode</c> + </seealso> + selects callback module state function mode, in this case + <seealso marker="stdlib:gen_statem#type-callback_mode"> + <c>state_functions</c> + </seealso> + through the macro <c>?CALLBACK_MODE</c> that is; each state + has got its own handler function. + <c>State</c> is the initial state of the <c>gen_statem</c>, + in this case <c>locked</c>; assuming the door is locked to begin with. + <c>Data</c> is the internal server data of the <c>gen_statem</c>. + Here the server data is a <seealso marker="stdlib:maps">map</seealso> + with the key <c>code</c> that stores + the correct button sequence and the key <c>remaining</c> + that stores the remaining correct button sequence + (the same as the <c>code</c> to begin with). + </p> + <code type="erl"><![CDATA[ +init(Code) -> + do_lock(), + Data = #{code => Code, remaining => Code}, + {?CALLBACK_MODE,locked,Data}. + ]]></code> + <p> + <seealso marker="stdlib:gen_statem#start_link/3"> + <c>gen_statem:start_link</c> + </seealso> + is synchronous. It does not return until the <c>gen_statem</c> + has been initialized and is ready to receive events. + </p> + <p> + <seealso marker="stdlib:gen_statem#start_link/3"> + <c>gen_statem:start_link</c> + </seealso> + must be used if the <c>gen_statem</c> + is part of a supervision tree, that is; started by a supervisor. + There is another function; + <seealso marker="stdlib:gen_statem#start/3"> + <c>gen_statem:start</c> + </seealso> + to start a standalone <c>gen_statem</c>, that is; + a <c>gen_statem</c> that is not part of a supervision tree. + </p> + </section> + +<!-- =================================================================== --> + + <section> + <title>Events and Handling them</title> + <p>The function notifying the code lock about a button event is + implemented using + <seealso marker="stdlib:gen_statem#cast/2"> + <c>gen_statem:cast/2</c>: + </seealso> + </p> + <code type="erl"><![CDATA[ +button(Digit) -> + gen_statem:cast(?NAME, {button,Digit}). + ]]></code> + <p> + The first argument is the name of the <c>gen_statem</c> and must + agree with the name used to start it so therefore we use the + same macro <c>?NAME</c> as when starting. + <c>{button,Digit}</c> is the actual event content. + </p> + <p> + The event is made into a message and sent to the <c>gen_statem</c>. + When the event is received, the <c>gen_statem</c> calls + <c>StateName(cast, Event, Data)</c>, which is expected to + return a tuple <c>{next_state,NewStateName,NewData}</c>. + <c>StateName</c> is the name of the current state and + <c>NewStateName</c> is the name of the next state to go to. + <c>NewData</c> is a new value for the server data of + the <c>gen_statem</c>. + </p> + <code type="erl"><![CDATA[ +locked( + cast, {button,Digit}, + #{code := Code, remaining := Remaining} = Data) -> + case Remaining of + [Digit] -> % Complete + do_unlock(), + {next_state,open,Data#{remaining := Code},10000}; + [Digit|Rest] -> % Incomplete + {next_state,locked,Data#{remaining := Rest}}; + [_|_] -> % Wrong + {next_state,locked,Data#{remaining := Code}} + end. + +open(timeout, _, Data) -> + do_lock(), + {next_state,locked,Data}; +open(cast, {button,_}, Data) -> + do_lock(), + {next_state,locked,Data}. + ]]></code> + <p> + If the door is locked and a button is pressed, the pressed + button is compared with the next correct button and, + depending on the result, the door is either unlocked + and the <c>gen_statem</c> goes to state <c>open</c>, + or the door remains in state <c>locked</c>. + </p> + <p> + If the pressed button is incorrect the server data + restarts from the start of the code sequence. + </p> + <p> + In state <c>open</c> any button locks the door since + any event cancels the event timer so we will not get + a timeout event after a button event. + </p> + </section> + + <section> + <title>Event Time-Outs</title> + <p> + When a correct code has been given, the door is unlocked and + the following tuple is returned from <c>locked/2</c>: + </p> + <code type="erl"><![CDATA[ +{next_state,open,Data#{remaining := Code},10000}; + ]]></code> + <p> + 10000 is a time-out value in milliseconds. + After this time, that is; 10 seconds, a time-out occurs. + Then, <c>StateName(timeout, 10000, Data)</c> is called. + The time-out occurs when the door has been in state <c>open</c> + for 10 seconds. After that the door is locked again: + </p> + <code type="erl"><![CDATA[ +open(timeout, _, Data) -> + do_lock(), + {next_state,locked,Data}; + ]]></code> + </section> + +<!-- =================================================================== --> + + <section> + <title>All State Events</title> + <p> + Sometimes an event can arrive in any state of the <c>gen_statem</c>. + It is convenient to handle these in a common state handler function + that all state functions call for events not specific to the state. + </p> + <p> + Let's introduce a <c>code_length/0</c> function that returns + the length of the correct code + (that should not be sensitive to reveal...). + We'll dispatch all events that are not state specific + to the common function <c>handle_event/3</c>. + </p> + <code type="erl"><![CDATA[ +... +-export([button/1,code_length/0]). +... + +code_length() -> + gen_statem:call(?NAME, code_length). + +... +locked(...) -> ... ; +locked(EventType, EventContent, Data) -> + handle_event(EventType, EventContent, Data). + +... +open(...) -> ... ; +open(EventType, EventContent, Data) -> + handle_event(EventType, EventContent, Data). + +handle_event({call,From}, code_length, #{code := Code} = Data) -> + {keep_state,Data,[{reply,From,length(Code)}]}. + ]]></code> + <p> + This example uses + <seealso marker="stdlib:gen_statem#call/2"> + <c>gen_statem:call/2</c> + </seealso> + which waits for a reply from the server. + The reply is sent with a <c>{reply,From,Reply}</c> tuple + in an action list in the <c>{keep_state,...}</c> tuple + that retains the current state. + </p> + </section> + +<!-- =================================================================== --> + + <section> + <title>One Event Handler</title> + <p> + If you use the mode <c>handle_event_function</c> + all events are handled in <c>handle_event/4</c> and we + may (but do not have to) use an event-centered approach + where we dispatch on event first and then state: + </p> + <code type="erl"><![CDATA[ +... +-define(CALLBACK_MODE, state_functions). + +... +-export([handle_event/4]). + +... + +handle_event(cast, {button,Digit}, State, #{code := Code} = Data) -> + case State of + locked -> + case maps:get(remaining, Data) of + [Digit] -> % Complete + do_unlock(), + {next_state,open,Data#{remaining := Code},10000}; + [Digit|Rest] -> % Incomplete + {keep_state,Data#{remaining := Rest}}; + [_|_] -> % Wrong + {keep_state,Data#{remaining := Code}} + end; + open -> + do_lock(), + {next_state,locked,Data} + end; +handle_event(timeout, _, open, Data) -> + do_lock(), + {next_state,locked,Data}. + +... + ]]></code> + </section> + +<!-- =================================================================== --> + + <section> + <title>Stopping</title> + + <section> + <title>In a Supervision Tree</title> + <p> + If the <c>gen_statem</c> is part of a supervision tree, + no stop function is needed. + The <c>gen_statem</c> is automatically terminated by its supervisor. + Exactly how this is done is defined by a + <seealso marker="sup_princ#shutdown">shutdown strategy</seealso> + set in the supervisor. + </p> + <p> + If it is necessary to clean up before termination, the shutdown + strategy must be a time-out value and the <c>gen_statem</c> must + in the <c>init/1</c> function set itself to trap exit signals + by calling + <seealso marker="erts:erlang#process_flag/2"> + <c>process_flag(trap_exit, true)</c>. + </seealso> + When ordered to shutdown, the <c>gen_statem</c> then calls + the callback function + <c>terminate(shutdown, State, Data)</c>: + </p> + <code type="erl"><![CDATA[ +init(Args) -> + process_flag(trap_exit, true), + do_lock(), + ... + ]]></code> + <p> + In this example we let the <c>terminate/3</c> function + lock the door if it is open so we do not accidentally leave the door + open when the supervision tree terminates. + </p> + <code type="erl"><![CDATA[ +terminate(_Reason, State, _Data) -> + State =/= locked andalso do_lock(), + ok. + ]]></code> + </section> + + <section> + <title>Standalone gen_statem</title> + <p> + If the <c>gen_statem</c> is not part of a supervision tree, + it can be stopped using + <seealso marker="stdlib:gen_statem#stop/1"> + <c>gen_statem:stop</c>, + </seealso> + preferably through an API function: + </p> + <code type="erl"><![CDATA[ +... +-export([start_link/1,stop/0]). + +... +stop() -> + gen_statem:stop(?NAME). + ]]></code> + <p> + This makes the <c>gen_statem</c> call the <c>terminate/3</c> + callback function just like for a supervised server + and waits for the process to terminate. + </p> + </section> + </section> + +<!-- =================================================================== --> + + <section> + <title>Actions</title> + <p> + In the first chapters we mentioned actions as a part of + the general state machine model, and these actions + are implemented with the code the <c>gen_statem</c> + callback module executes in an event handling + callback function before returning + to the <c>gen_statem</c> engine. + </p> + <p> + There are more specific state transition actions + that a callback function can order the <c>gen_statem</c> + engine to do after the callback function return. + These are ordered by returning a list of + <seealso marker="stdlib:gen_statem#type-action"> + actions + </seealso> + in the + <seealso marker="stdlib:gen_statem#type-state_function_result"> + return tuple + </seealso> + from the + <seealso marker="stdlib:gen_statem#Module:StateName/3"> + callback function. + </seealso> + These state transition actions affect the <c>gen_statem</c> + engine itself. They can: + </p> + <list type="bulleted"> + <item>Postpone the current event.</item> + <item>Hibernate the <c>gen_statem</c>.</item> + <item>Start an event timeout.</item> + <item>Reply to a caller.</item> + <item>Generate the next event to handle.</item> + </list> + <p> + We have mentioned the event timeout + and replying to a caller in the example above. + An example of event postponing comes in later in this chapter. + See the + <seealso marker="stdlib:gen_statem#type-action"> + reference manual + </seealso> + for details. You can for example actually reply to several callers + and generate multiple next events to handle. + </p> + </section> + +<!-- =================================================================== --> + + <section> + <title>Event Types</title> + <p> + So far we have mentioned a few + <seealso marker="stdlib:gen_statem#type-event_type"> + event types. + </seealso> + Events of all types are handled in the same callback function, + for a given state, and the function gets + <c>EventType</c> and <c>EventContent</c> as arguments. + </p> + <p> + Here is the complete list of event types and where + they come from: + </p> + <taglist> + <tag><c>cast</c></tag> + <item> + Generated by + <seealso marker="stdlib:gen_statem#cast/2"> + <c>gen_statem:cast</c>. + </seealso> + </item> + <tag><c>{call,From}</c></tag> + <item> + Generated by + <seealso marker="stdlib:gen_statem#call/2"> + <c>gen_statem:call</c> + </seealso> + where <c>From</c> is the reply address to use + when replying either through the state transition action + <c>{reply,From,Msg}</c> or by calling + <seealso marker="stdlib:gen_statem#reply/1"> + <c>gen_statem:reply</c>. + </seealso> + </item> + <tag><c>info</c></tag> + <item> + Generated by any regular process message sent to + the <c>gen_statem</c> process. + </item> + <tag><c>timeout</c></tag> + <item> + Generated by the state transition action + <c>{timeout,Time,EventContent}</c> (or its short form <c>Time</c>) + timer timing out. + </item> + <tag><c>internal</c></tag> + <item> + Generated by the state transition action + <c>{next_event,internal,EventContent}</c>. + In fact all event types above can be generated using + <c>{next_event,EventType,EventContent}</c>. + </item> + </taglist> + </section> + +<!-- =================================================================== --> + + <section> + <title>State Timeouts</title> + <p> + The timeout event generated by the state transition action + <c>{timeout,Time,EventContent}</c> is an event timeout, + that is; if an event arrives the timer is cancelled. + You get either an event or a timeout but not both. + </p> + <p> + Often you want a timer to not be cancelled by any event + or you want to start a timer in one state and respond + to the timeout in another. This can be accomplished + with a regular erlang timer: + <seealso marker="erts:erlang#start_timer/4"> + <c>erlang:start_timer</c>. + </seealso> + </p> + <p> + Looking at the example in this chapter so far; using the + <c>gen_statem</c> event timer has the consequence that + if a button event is generated while in the <c>open</c> state, + the timeout is cancelled and the button event is delivered. + Therefore we chose to lock the door if this happended. + </p> + <p> + Suppose we do not want a button to lock the door, + instead we want to ignore button events in the <c>open</c> state. + Then we start a timer when entering the <c>open</c> state + and wait for it to expire while ignoring button events: + </p> + <code type="erl"><![CDATA[ +... +locked( + cast, {button,Digit}, + #{code := Code, remaining := Remaining} = Data) -> + case Remaining of + [Digit] -> + do_unlock(), + Tref = erlang:start_timer(10000, self(), lock), + {next_state,open,Data#{remaining := Code, timer := Tref}}; +... + +open(info, {timeout,Tref,lock}, #{timer := Tref} = Data) -> + do_lock(), + {next_state,locked,Data}; +open(cast, {button,_}, Data) -> + {keep_state,Data}; +... + ]]></code> + <p> + If you need to cancel a timer due to some other event you can use + <seealso marker="erts:erlang#cancel_timer/2"> + <c>erlang:cancel_timer(Tref)</c>. + </seealso> + Note that a timeout message can not arrive after this, + unless you have postponed it (see the next section) before, + so make sure you do not accidentally postpone such messages. + </p> + <p> + Another way to cancel a timer is to not cancel it, + but instead to ignore it if it arrives in a state + where it is known to be late. + </p> + </section> + +<!-- =================================================================== --> + + <section> + <title>Postponing Events</title> + <p> + If you want to ignore a particular event in the current state + and handle it in a future state, you can postpone the event. + A postponed event is retried after the state has + changed i.e <c>OldState =/= NewState</c>. + </p> + <p> + Postponing is ordered by the state transition + <seealso marker="stdlib:gen_statem#type-action"> + action + </seealso> + <c>postpone</c>. + </p> + <p> + In this example, instead of ignoring button events + while in the <c>open</c> state we can postpone them + and they will be queued and later handled in the <c>locked</c> state: + </p> + <code type="erl"><![CDATA[ +... +open(cast, {button,_}, Data) -> + {keep_state,Data,[postpone]}; +... + ]]></code> + <p> + The fact that a postponed event is only retried after a state change + translates into a requirement on the event and state space: + if you have a choice between storing a state data item + in the <c>State</c> or in the <c>Data</c>; + should a change in the item value affect which events that + are handled, then this item ought to be part of the state. + </p> + <p> + What you want to avoid is that you maybe much later decide + to postpone an event in one state and by misfortune it is never retried + because the code only changes the <c>Data</c> but not the <c>State</c>. + </p> + + <section> + <title>Fuzzy State Diagrams</title> + <p> + It is not uncommon that a state diagram does not specify + how to handle events that are not illustrated + in a particular state in the diagram. + Hopefully this is described in an associated text + or from the context. + </p> + <p> + Possible actions may be; ignore as in drop the event + (maybe log it) or deal with the event in some other state + as in postpone it. + </p> + </section> + + <section> + <title>Selective Receive</title> + <p> + Erlang's selective receive statement is often used to + describe simple state machine examples in straightforward + Erlang code. Here is a possible implementation of + the first example: + </p> + <code type="erl"><![CDATA[ +-module(code_lock). +-define(NAME, code_lock_1). +-export([start_link/1,button/1]). + +start_link(Code) -> + spawn( + fun () -> + true = register(?NAME, self()), + do_lock(), + locked(Code, Code) + end). + +button(Digit) -> + ?NAME ! {button,Digit}. + +locked(Code, [Digit|Remaining]) -> + receive + {button,Digit} when Remaining =:= [] -> + do_unlock(), + open(Code); + {button,Digit} -> + locked(Code, Remaining); + {button,_} -> + locked(Code, Code) + end. + +open(Code) -> + receive + after 10000 -> + do_lock(), + locked(Code, Code) + end. + +do_lock() -> + io:format("Locked~n", []). +do_unlock() -> + io:format("Open~n", []). + ]]></code> + <p> + The selective receive in this case causes <c>open</c> + to implicitly postpone any events to the <c>locked</c> state. + </p> + <p> + A selective receive can not be used from a <c>gen_statem</c> + behaviour just as for any <c>gen_*</c> behavior + since the receive statement is within the <c>gen_*</c> engine itself. + It has to be there because all + <seealso marker="stdlib:sys"><c>sys</c></seealso> + compatible behaviours must respond to system messages and therefore + do that in their engine receive loop, + passing non-system messages to the callback module. + </p> + <p> + The state transition + <seealso marker="stdlib:gen_statem#type-action"> + action + </seealso> + <c>postpone</c> is designed to be able to model + selective receives. A selective receive implicitly postpones + any not received events, but the <c>postpone</c> + state transition action explicitly postpones one received event. + </p> + <p> + Other than that both mechanisms have got the same theoretical + time and memory complexity, while the selective receive + language construct has got smaller constant factors. + </p> + </section> + </section> + +<!-- =================================================================== --> + + <section> + <title>Self Generated Events</title> + <p> + It may be beneficial in some cases to be able to generate events + to your own state machine. + This can be done with the state transition + <seealso marker="stdlib:gen_statem#type-action"> + action + </seealso> + <c>{next_event,EventType,EventContent}</c>. + </p> + <p> + You can generate events of any existing + <seealso marker="stdlib:gen_statem#type-action"> + type, + </seealso> + but the <c>internal</c> type can only be generated through the + <c>next_event</c> action and hence can not come from an external source, + so you can be certain that an <c>internal</c> event is an event + from your state machine to itself. + </p> + <p> + One example of using self generated events may be when you have + a state machine specification that uses state entry actions. + That you could code using a dedicated function + to do the state transition. But if you want that code to be + visible besides the other state logic you can insert + an <c>internal</c> event that does the entry actions. + This has the same unfortunate consequence as using + state transition functions that everywhere you go to + the state in question you will have to explicitly + insert the <c>internal</c> event + or use state transition function. + </p> + <p> + Here is an implementation of entry actions + using <c>internal</c> events with content <c>enter</c> + utilizing a helper function <c>enter/3</c> for state entry: + </p> + <code type="erl"><![CDATA[ +... +-define(CALLBACK_MODE, state_functions). + +... + +init(Code) -> + process_flag(trap_exit, true), + Data = #{code => Code}, + enter(?CALLBACK_MODE, locked, Data). + +... + +locked(internal, enter, _Data) -> + do_lock(), + {keep_state,Data#{remaining => Code}}; +locked( + cast, {button,Digit}, + #{code := Code, remaining := Remaining} = Data) -> + case Remaining of + [Digit] -> + enter(next_state, open, Data); +... + +open(internal, enter, _Data) -> + Tref = erlang:start_timer(10000, self(), lock), + do_unlock(), + {keep_state,Data#{timer => Tref}}; +open(info, {timeout,Tref,lock}, #{timer := Tref} = Data) -> + enter(next_state, locked, Data); +... + +enter(Tag, State, Data) -> + {Tag,State,Data,[{next_event,internal,enter}]}. + ]]></code> + </section> + +<!-- =================================================================== --> + + <section> + <title>Example Revisited</title> + <p> + Here is the example after all mentioned modifications + and some more utilizing the entry actions, + which deserves a new state diagram: + </p> + <image file="../design_principles/code_lock_2.png"> + <icaption>Code lock state diagram revisited</icaption> + </image> + <p> + Note that this state diagram does not specify how to handle + a button event in the state <c>open</c>, so you will have to + read some other place that is here that unspecified events + shall be ignored as in not consumed but handled in some other state. + Nor does it show that the <c>code_length/0</c> call shall be + handled in every state. + </p> + + <section> + <title>Callback Mode: state_functions</title> + <p> + Using state functions: + </p> + <code type="erl"><![CDATA[ +-module(code_lock). +-behaviour(gen_statem). +-define(NAME, code_lock_2). +-define(CALLBACK_MODE, state_functions). + +-export([start_link/1,stop/0]). +-export([button/1,code_length/0]). +-export([init/1,terminate/3,code_change/4]). +-export([locked/3,open/3]). + +start_link(Code) -> + gen_statem:start_link({local,?NAME}, ?MODULE, Code, []). +stop() -> + gen_statem:stop(?NAME). + +button(Digit) -> + gen_statem:cast(?NAME, {button,Digit}). +code_length() -> + gen_statem:call(?NAME, code_length). + +init(Code) -> + process_flag(trap_exit, true), + Data = #{code => Code}, + enter(?CALLBACK_MODE, locked, Data). + +locked(internal, enter, #{code := Code} = Data) -> + do_lock(), + {keep_state,Data#{remaining => Code}}; +locked( + cast, {button,Digit}, + #{code := Code, remaining := Remaining} = Data) -> + case Remaining of + [Digit] -> % Complete + enter(next_state, open, Data); + [Digit|Rest] -> % Incomplete + {keep_state,Data#{remaining := Rest}}; + [_|_] -> % Wrong + {keep_state,Data#{remaining := Code}} + end; +locked(EventType, EventContent, Data) -> + handle_event(EventType, EventContent, Data). + +open(internal, enter, Data) -> + Tref = erlang:start_timer(10000, self(), lock), + do_unlock(), + {keep_state,Data#{timer => Tref}}; +open(info, {timeout,Tref,lock}, #{timer := Tref} = Data) -> + enter(next_state, locked, Data); +open(cast, {button,_}, _) -> + {keep_state_and_data,[postpone]}; +open(EventType, EventContent, Data) -> + handle_event(EventType, EventContent, Data). + +handle_event({call,From}, code_length, #{code := Code}) -> + {keep_state_and_data,[{reply,From,length(Code)}]}. +enter(Tag, State, Data) -> + {Tag,State,Data,[{next_event,internal,enter}]}. + +do_lock() -> + io:format("Locked~n", []). +do_unlock() -> + io:format("Open~n", []). + +terminate(_Reason, State, _Data) -> + State =/= locked andalso do_lock(), + ok. +code_change(_Vsn, State, Data, _Extra) -> + {?CALLBACK_MODE,State,Data}. + ]]></code> + </section> + + <section> + <title>Callback Mode: handle_event_function</title> + <p> + What to change to use one <c>handle_event/4</c> function. + Here a clean first-dispatch-on-event approach + does not work that well due to the generated + entry actions: + </p> + <code type="erl"><![CDATA[ +... +-define(CALLBACK_MODE, handle_event_function). + +... +-export([handle_event/4]). + +... + +%% State: locked +handle_event(internal, enter, locked, #{code := Code} = Data) -> + do_lock(), + {keep_state,Data#{remaining => Code}}; +handle_event( + cast, {button,Digit}, locked, + #{code := Code, remaining := Remaining} = Data) -> + case Remaining of + [Digit] -> % Complete + enter(next_state, open, Data); + [Digit|Rest] -> % Incomplete + {keep_state,Data#{remaining := Rest}}; + [_|_] -> % Wrong + {keep_state,Data#{remaining := Code}} + end; +%% +%% State: open +handle_event(internal, enter, open, Data) -> + Tref = erlang:start_timer(10000, self(), lock), + do_unlock(), + {keep_state,Data#{timer => Tref}}; +handle_event(info, {timeout,Tref,lock}, open, #{timer := Tref} = Data) -> + enter(next_state, locked, Data); +handle_event(cast, {button,_}, open, _) -> + {keep_state_and_data,[postpone]}; +%% +%% Any state +handle_event({call,From}, code_length, _State, #{code := Code}) -> + {keep_state_and_data,[{reply,From,length(Code)}]}. + +... + ]]></code> + </section> + <p> + Note that postponing buttons from the <c>locked</c> state + to the <c>open</c> state feels like the wrong thing to do + for a code lock, but it at least illustrates event postponing. + </p> + </section> + +<!-- =================================================================== --> + + <section> + <title>Filter the State</title> + <p> + The example servers so far in this chapter will for example + when killed by an exit signal or due to an internal error + print out the full internal state in the error log. + This state contains both the code lock code + and which digits that remains to unlock. + </p> + <p> + This state data can be regarded as sensitive, + and maybe not what you want in the error log + because of something unpredictable happening. + </p> + <p> + Another reason to filter the state can be + that the state is too big to print out since it fills + the error log with uninteresting details. + </p> + <p> + To avoid this you can format the internal state + that gets in the error log and gets returned from + <seealso marker="stdlib:sys#get_status/1"> + <c>sys:get_status/1,2</c> + </seealso> + by implementing the + <seealso marker="stdlib:gen_statem#Module:format_status/2"> + <c>Module:format_status/2</c> + </seealso> + function, for example like this: + </p> + <code type="erl"><![CDATA[ +... +-export([init/1,terminate/3,code_change/4,format_status/2]). +... + +format_status(Opt, [_PDict,State,Data]) -> + StateData = + {State, + maps:filter( + fun (code, _) -> false; + (remaining, _) -> false; + (_, _) -> true + end, + Data)}, + case Opt of + terminate -> + StateData; + normal -> + [{data,[{"State",StateData}]}] + end. + ]]></code> + <p> + It is not mandatory to implement a + <seealso marker="stdlib:gen_statem#Module:format_status/2"> + <c>Module:format_status/2</c> + </seealso> + function. If you do not a default implementation is used that + does the same as this example function without filtering + the <c>Data</c> term that is: <c>StateData = {State,Data}</c>. + </p> + </section> + +<!-- =================================================================== --> + + <section> + <title>Complex State</title> + <p> + The callback mode + <seealso marker="stdlib:gen_statem#type-callback_mode"> + <c>handle_event_function</c> + </seealso> + enables using a non-atom state as described in + <seealso marker="#callback_modes"> + Callback Modes, + </seealso> + for example a complex state term like a tuple. + </p> + <p> + One reason to use this is when you have + a state item that affects the event handling + in particular when combining that with postponing events. + Let us complicate the previous example + by introducing a configurable lock button + (this is the state item in question) + that in the <c>open</c> state immediately locks the door, + and an API function <c>set_lock_button/1</c> to set the lock button. + </p> + <p> + Suppose now that we call <c>set_lock_button</c> + while the door is open, + and have already postponed a button event + that up until now was not the lock button; + the sensible thing might be to say that + the button was pressed too early so it should + not be recognized as the lock button, + but then it might be surprising that a button event + that now is the lock button event arrives (as retried postponed) + immediately after the state transits to <c>locked</c>. + </p> + <p> + So let us make the <c>button/1</c> function synchronous + by using <c>gen_statem:call</c>, + and still postpone its events in the <c>open</c> state. + Then a call to <c>button/1</c> during the <c>open</c> + state will not return until the state transits to <c>locked</c> + since it is there the event is handled and the reply is sent. + </p> + <p> + If now one process calls <c>set_lock_button/1</c> + to change the lock button while some other process + hangs in <c>button/1</c> with the new lock button + it could be expected that the hanging lock button call + immediately takes effect and locks the lock. + Therefore we make the current lock button a part of the state + so when we change the lock button the state will change + and all postponed events will be retried. + </p> + <p> + We define the state as <c>{StateName,LockButton}</c> + where <c>StateName</c> is as before + and <c>LockButton</c> is the current lock button: + </p> + <code type="erl"><![CDATA[ +-module(code_lock). +-behaviour(gen_statem). +-define(NAME, code_lock_3). +-define(CALLBACK_MODE, handle_event_function). + +-export([start_link/2,stop/0]). +-export([button/1,code_length/0,set_lock_button/1]). +-export([init/1,terminate/3,code_change/4,format_status/2]). +-export([handle_event/4]). + +start_link(Code, LockButton) -> + gen_statem:start_link( + {local,?NAME}, ?MODULE, {Code,LockButton}, []). +stop() -> + gen_statem:stop(?NAME). + +button(Digit) -> + gen_statem:call(?NAME, {button,Digit}). +code_length() -> + gen_statem:call(?NAME, code_length). +set_lock_button(LockButton) -> + gen_statem:call(?NAME, {set_lock_button,LockButton}). + +init({Code,LockButton}) -> + process_flag(trap_exit, true), + Data = #{code => Code, remaining => undefined, timer => undefined}, + enter(?CALLBACK_MODE, {locked,LockButton}, Data, []). + +handle_event( + {call,From}, {set_lock_button,NewLockButton}, + {StateName,OldLockButton}, Data) -> + {next_state,{StateName,NewLockButton},Data, + [{reply,From,OldLockButton}]}; +handle_event( + {call,From}, code_length, + {_StateName,_LockButton}, #{code := Code}) -> + {keep_state_and_data, + [{reply,From,length(Code)}]}; +handle_event( + EventType, EventContent, + {locked,LockButton}, #{code := Code, remaining := Remaining} = Data) -> + case {EventType,EventContent} of + {internal,enter} -> + do_lock(), + {keep_state,Data#{remaining := Code}}; + {{call,From},{button,Digit}} -> + case Remaining of + [Digit] -> % Complete + next_state( + {open,LockButton}, Data, + [{reply,From,ok}]); + [Digit|Rest] -> % Incomplete + {keep_state,Data#{remaining := Rest}, + [{reply,From,ok}]}; + [_|_] -> % Wrong + {keep_state,Data#{remaining := Code}, + [{reply,From,ok}]} + end + end; +handle_event( + EventType, EventContent, + {open,LockButton}, #{timer := Timer} = Data) -> + case {EventType,EventContent} of + {internal,enter} -> + Tref = erlang:start_timer(10000, self(), lock), + do_unlock(), + {keep_state,Data#{timer := Tref}}; + {info,{timeout,Timer,lock}} -> + next_state({locked,LockButton}, Data, []); + {{call,From},{button,Digit}} -> + if + Digit =:= LockButton -> + erlang:cancel_timer(Timer), + next_state( + {locked,LockButton}, Data, + [{reply,From,locked}]); + true -> + {keep_state_and_data, + [postpone]} + end + end. + +next_state(State, Data, Actions) -> + enter(next_state, State, Data, Actions). +enter(Tag, State, Data, Actions) -> + {Tag,State,Data,[{next_event,internal,enter}|Actions]}. + +do_lock() -> + io:format("Locked~n", []). +do_unlock() -> + io:format("Open~n", []). + +terminate(_Reason, State, _Data) -> + State =/= locked andalso do_lock(), + ok. +code_change(_Vsn, State, Data, _Extra) -> + {?CALLBACK_MODE,State,Data}. +format_status(Opt, [_PDict,State,Data]) -> + StateData = + {State, + maps:filter( + fun (code, _) -> false; + (remaining, _) -> false; + (_, _) -> true + end, + Data)}, + case Opt of + terminate -> + StateData; + normal -> + [{data,[{"State",StateData}]}] + end. + ]]></code> + <p> + It may be an ill-fitting model for a physical code lock + that the <c>button/1</c> call might hang until the lock + is locked. But for an API in general it is really not + that strange. + </p> + </section> + +<!-- =================================================================== --> + + <section> + <title>Hibernation</title> + <p> + If you have many servers in one node + and they have some state(s) in their lifetime in which + the servers can be expected to idle for a while, + and the amount of heap memory all these servers need + is a problem; then it is possible to minimize + the memory footprint of a server by hibernating it through + <seealso marker="stdlib:proc_lib#hibernate/3"> + <c>proc_lib:hibernate/3</c>. + </seealso> + </p> + <note> + <p> + To hibernate a process is rather costly. See + <seealso marker="erts:erlang#hibernate/3"> + <c>erlang:hibernate/3</c>. + </seealso> + It is in general not something you want to do + after every event. + </p> + </note> + <p> + We can in this example hibernate in the <c>{open,_}</c> state + since what normally happens in that state is that + the state timeout after a while + triggers a transition to <c>{locked,_}</c>: + </p> + <code type="erl"><![CDATA[ +... +handle_event( + EventType, EventContent, + {open,LockButton}, #{timer := Timer} = Data) -> + case {EventType,EventContent} of + {internal,enter} -> + Tref = erlang:start_timer(10000, self(), lock), + do_unlock(), + {keep_state,Data#{timer := Tref},[hibernate]}; +... + ]]></code> + <p> + The + <seealso marker="stdlib:gen_statem#type-hibernate"> + <c>[hibernate]</c> + </seealso> + action list on the last line + when entering the <c>{open,_}</c> state is the only change. + If any event arrives in the <c>{open,_},</c> state we + do not bother to re-hibernate, so the server stays + awake after any event. + </p> + <p> + To change that we would need to insert + the <c>hibernate</c> action in more places, + for example for the state independent <c>set_lock_button</c> + and <c>code_length</c> operations that then would have to + be aware of using <c>hibernate</c> while in the + <c>{open,_}</c> state which would clutter the code. + </p> + <p> + This server probably does not use an amount of + heap memory worth hibernating for. + To gain anything from hibernation your server would + have to actually produce some garbage during callback execution, + for which this example server may serve as a bad example. + </p> + </section> + +</chapter> diff --git a/system/doc/design_principles/sup_princ.xml b/system/doc/design_principles/sup_princ.xml index 7408a34442..a77b3964fc 100644 --- a/system/doc/design_principles/sup_princ.xml +++ b/system/doc/design_principles/sup_princ.xml @@ -213,6 +213,7 @@ child_spec() = #{id => child_id(), % mandatory <item><c>supervisor:start_link</c></item> <item><c>gen_server:start_link</c></item> <item><c>gen_fsm:start_link</c></item> + <item><c>gen_statem:start_link</c></item> <item><c>gen_event:start_link</c></item> <item>A function compliant with these functions. For details, see the <c>supervisor(3)</c> manual page.</item> @@ -276,7 +277,8 @@ child_spec() = #{id => child_id(), % mandatory <p><c>modules</c> are to be a list with one element <c>[Module]</c>, where <c>Module</c> is the name of the callback module, if the child process is a supervisor, - gen_server or gen_fsm. If the child process is a gen_event, + gen_server, gen_fsm or gen_statem. + If the child process is a gen_event, the value shall be <c>dynamic</c>.</p> <p>This information is used by the release handler during upgrades and downgrades, see @@ -400,8 +402,8 @@ supervisor:delete_child(Sup, Id)</code> restarts.</p> </section> - <marker id="simple"/> <section> + <marker id="simple"/> <title>Simplified one_for_one Supervisors</title> <p>A supervisor with restart strategy <c>simple_one_for_one</c> is a simplified <c>one_for_one</c> supervisor, where all child diff --git a/system/doc/design_principles/xmlfiles.mk b/system/doc/design_principles/xmlfiles.mk index 9c3836c8ac..e476255d62 100644 --- a/system/doc/design_principles/xmlfiles.mk +++ b/system/doc/design_principles/xmlfiles.mk @@ -25,6 +25,7 @@ DESIGN_PRINCIPLES_CHAPTER_FILES = \ distributed_applications.xml \ events.xml \ fsm.xml \ + statem.xml \ gen_server_concepts.xml \ included_applications.xml \ release_handling.xml \ diff --git a/system/doc/reference_manual/modules.xml b/system/doc/reference_manual/modules.xml index 5f2ac2a67d..96968b547e 100644 --- a/system/doc/reference_manual/modules.xml +++ b/system/doc/reference_manual/modules.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2015</year> + <year>2003</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -144,6 +144,7 @@ fact(0) -> % | <list type="bulleted"> <item><c>gen_server</c></item> <item><c>gen_fsm</c></item> + <item><c>gen_statem</c></item> <item><c>gen_event</c></item> <item><c>supervisor</c></item> </list> diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml index c5d24a96b5..9e26e9058d 100644 --- a/system/doc/reference_manual/typespec.xml +++ b/system/doc/reference_manual/typespec.xml @@ -132,15 +132,18 @@ | nonempty_list(Type) %% Proper non-empty list Map :: map() %% stands for a map of any size - | #{} %% stands for a map of any size + | #{} %% stands for the empty map | #{PairList} Tuple :: tuple() %% stands for a tuple of any size | {} | {TList} - PairList :: Type => Type - | Type => Type, PairList + PairList :: Pair + | Pair, PairList + + Pair :: Type := Type %% notes a pair that must be present + | Type => Type TList :: Type | Type, TList @@ -170,6 +173,23 @@ The notation <c>[]</c> specifies the singleton type for the empty list. </p> <p> + The general form of maps is <c>#{PairList}</c>. The key types in + <c>PairList</c> are allowed to overlap, and if they do, the leftmost pair + takes precedence. A map value does not belong to this type if contains a key + that is not in <c>PairList</c>. + </p> + <p> + Because it is common to end a map type with <c>any() => any()</c> to denote + that keys that do not belong to any other pair in <c>PairList</c> are + allowed, and may map to any value, the shorthand notation <c>...</c> is + allowed as the last pair of a map type. + </p> + <p> + Notice that the syntactic representation of <c>map()</c> is <c>#{...}</c> + (or <c>#{_ => _}</c>, or <c>#{any() => any()}</c>), not <c>#{}</c>. + The notation <c>#{}</c> specifies the singleton type for the empty map. + </p> + <p> For convenience, the following types are also built-in. They can be thought as predefined aliases for the type unions also shown in the table. @@ -302,12 +322,6 @@ This is described in <seealso marker="#typeinrecords"> Type Information in Record Declarations</seealso>. </p> - <note> - <p>Map types, both <c>map()</c> and <c>#{...}</c>, - are considered experimental during OTP 17.</p> - <p>No type information of maps pairs, only the containing map types, - are used by Dialyzer in OTP 17.</p> - </note> </section> <section> |
