diff options
314 files changed, 10200 insertions, 3840 deletions
diff --git a/OTP_VERSION b/OTP_VERSION index 9f09b58414..1fbc0d2431 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -17.4-rc0 +18.0-rc0 diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex c497fe37fc..7e93eb7f7a 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 c497fe37fc..7e93eb7f7a 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 f58fdd7171..0758874641 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 11482a1451..0eca719d0d 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_flatten.beam b/bootstrap/lib/compiler/ebin/beam_flatten.beam Binary files differindex 35dae78125..de1a719a4e 100644 --- a/bootstrap/lib/compiler/ebin/beam_flatten.beam +++ b/bootstrap/lib/compiler/ebin/beam_flatten.beam diff --git a/bootstrap/lib/compiler/ebin/beam_split.beam b/bootstrap/lib/compiler/ebin/beam_split.beam Binary files differindex 1d12f2cf1d..e99c0a69b9 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_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex 8507db5454..659bb08d48 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 07225dc8b1..ba1ea73dc4 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam Binary files differindex 0f0670c9ae..5e1c698ae8 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 2f7f220ebd..7328f75f34 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 1338631c23..f36cc31458 100644 --- a/bootstrap/lib/compiler/ebin/cerl_trees.beam +++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index f12713417f..5f15db4437 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -18,7 +18,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "5.0.1"}, + {vsn, "5.0.2"}, {modules, [ beam_a, beam_asm, diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup index e73b9aa60c..bde95b1878 100644 --- a/bootstrap/lib/compiler/ebin/compiler.appup +++ b/bootstrap/lib/compiler/ebin/compiler.appup @@ -15,7 +15,7 @@ %% under the License. %% %% %CopyrightEnd% -{"5.0", +{"5.0.2", [{<<".*">>,[{restart_application, compiler}]}], [{<<".*">>,[{restart_application, compiler}]}] }. diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam Binary files differindex e172ec6af7..9f83408bae 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_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam Binary files differindex e6e60fb658..cb02293c1d 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_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam Binary files differindex c0c537f623..96f22d0970 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 3670fd206c..822c7e34e6 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 5da654686a..f492d3428c 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 1e549a41c7..b56f507f47 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam Binary files differindex 6946d17545..ba3a5ef81d 100644 --- a/bootstrap/lib/kernel/ebin/application.beam +++ b/bootstrap/lib/kernel/ebin/application.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex b24c850af3..e6141fd7f1 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_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam Binary files differindex 9fd86024e0..41486bed9a 100644 --- a/bootstrap/lib/kernel/ebin/inet_dns.beam +++ b/bootstrap/lib/kernel/ebin/inet_dns.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index e60b36e1e7..1b39f7df07 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -21,7 +21,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "3.0.2"}, + {vsn, "3.0.3"}, {modules, [application, application_controller, application_master, diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index fda418ae8a..02cf129b42 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -15,11 +15,9 @@ %% under the License. %% %% %CopyrightEnd% -{"3.0", +{"3.0.3", %% Up from - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16 + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 %% Down to - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 }. diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex 95454c885a..15f0e940fd 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_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam Binary files differindex b851ca484e..d3e41be66b 100644 --- a/bootstrap/lib/stdlib/ebin/erl_internal.beam +++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 8ae35899d0..9c6c4be617 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 998bb0b209..ddef03db31 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 ff196f3a45..cb6bd2056c 100644 --- a/bootstrap/lib/stdlib/ebin/erl_pp.beam +++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam Binary files differindex 9fc7dd79cb..ab3600c2f2 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 4c64d477aa..551e2d3f01 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 6f15e461f6..b9f4b6a6d7 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 d45e508d22..4359a69f03 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 1eee773838..d04466bf92 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 cb9421b7c5..7a7b4ad0f0 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex 23b140aeb5..670943aad3 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/pg.beam b/bootstrap/lib/stdlib/ebin/pg.beam Binary files differdeleted file mode 100644 index 31f30461d8..0000000000 --- a/bootstrap/lib/stdlib/ebin/pg.beam +++ /dev/null diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam Binary files differindex 368d3e39a0..55cfff4680 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 8cbf23e958..968f2e4d2f 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -19,7 +19,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "2.1.1"}, + {vsn, "2.2"}, {modules, [array, base64, beam_lib, @@ -77,7 +77,6 @@ orddict, ordsets, otp_internal, - pg, pool, proc_lib, proplists, diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index d4db0c865e..541b1925e5 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -15,11 +15,11 @@ %% under the License. %% %% %CopyrightEnd% -{"2.0", +{"2.2", %% Up from - max one major revision back - [{<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16 + [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 + {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0 %% Down to - max one major revision back - [{<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 + [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 + {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0 }. diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex 40d9b28a18..c2f7d78ec2 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam Binary files differindex 54d7385738..d4b8cab555 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam Binary files differindex 1413b822f2..a569f8003f 100644 --- a/bootstrap/lib/stdlib/ebin/sys.beam +++ b/bootstrap/lib/stdlib/ebin/sys.beam diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index d11f6b0c6d..16000191dc 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -1145,9 +1145,9 @@ <tag><marker id="+secio"><c>+secio true|false</c></marker></tag> <item> <p>Enable or disable eager check I/O scheduling. The default - is currently <c>false</c>, but will most likely be changed - to <c>true</c> in OTP 18. The behaviour before this flag - was introduced corresponds to <c>+secio false</c>.</p> + is currently <c>true</c>. The default was changed from <c>false</c> + to <c>true</c> as of erts version 7.0. The behaviour before this + flag was introduced corresponds to <c>+secio false</c>.</p> <p>The flag effects when schedulers will check for I/O operations possible to execute, and when such I/O operations will execute. As the name of the parameter implies, diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 483d81cfb6..f9e8717847 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -1252,10 +1252,11 @@ true <fsummary>Check if a function is exported and loaded</fsummary> <desc> <p>Returns <c>true</c> if the module <c><anno>Module</anno></c> is loaded - and contains an exported function <c><anno>Function</anno>/<anno>Arity</anno></c>; - otherwise <c>false</c>.</p> - <p>Returns <c>false</c> for any BIF (functions implemented in C - rather than in Erlang).</p> + and contains an exported function <c><anno>Function</anno>/<anno>Arity</anno></c>, + or if there is a BIF (a built-in function implemented in C) + with the given name; otherwise returns <c>false</c>.</p> + <note><p>This function used to return false for built-in + functions before the 18.0 release.</p></note> </desc> </func> <func> @@ -1376,6 +1377,19 @@ true </desc> </func> <func> + <name name="get_keys" arity="0"/> + <fsummary>Return a list of all keys from the process dictionary</fsummary> + <desc> + <p>Returns a list of keys all keys present in the process dictionary.</p> + <pre> +> <input>put(dog, {animal,1}),</input> +<input>put(cow, {animal,2}),</input> +<input>put(lamb, {animal,3}),</input> +<input>get_keys().</input> +[dog,cow,lamb]</pre> + </desc> + </func> + <func> <name name="get_keys" arity="1"/> <fsummary>Return a list of keys from the process dictionary</fsummary> <desc> diff --git a/erts/doc/src/match_spec.xml b/erts/doc/src/match_spec.xml index 334b47d34c..b4cc8e9f78 100644 --- a/erts/doc/src/match_spec.xml +++ b/erts/doc/src/match_spec.xml @@ -76,22 +76,26 @@ { GuardFunction, ConditionExpression, ... } </item> <item>BoolFunction ::= <c><![CDATA[is_atom]]></c> | - <c><![CDATA[is_float]]></c> | <c><![CDATA[is_integer]]></c> | <c><![CDATA[is_list]]></c> | - <c><![CDATA[is_number]]></c> | <c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> | - <c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> | <c><![CDATA[is_binary]]></c> | - <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> | <c><![CDATA[is_seq_trace]]></c> | - <c><![CDATA['and']]></c> | <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> | <c><![CDATA['xor']]></c> | - <c><![CDATA[andalso]]></c> | <c><![CDATA[orelse]]></c></item> + <c><![CDATA[is_float]]></c> | <c><![CDATA[is_integer]]></c> | + <c><![CDATA[is_list]]></c> | <c><![CDATA[is_number]]></c> | + <c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> | + <c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> | + <c><![CDATA[is_map]]></c> | <c><![CDATA[is_binary]]></c> | + <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> | + <c><![CDATA[is_seq_trace]]></c> | <c><![CDATA['and']]></c> | + <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> | + <c><![CDATA['xor']]></c> | <c><![CDATA[andalso]]></c> | + <c><![CDATA[orelse]]></c></item> <item>ConditionExpression ::= ExprMatchVariable | { GuardFunction } | { GuardFunction, ConditionExpression, ... } | TermConstruct </item> <item>ExprMatchVariable ::= MatchVariable (bound in the MatchHead) | <c><![CDATA['$_']]></c> | <c><![CDATA['$$']]></c></item> - <item>TermConstruct = {{}} | {{ ConditionExpression, ... }} | - <c><![CDATA[[]]]></c> | [ConditionExpression, ...] | NonCompositeTerm | Constant - </item> - <item>NonCompositeTerm ::= term() (not list or tuple) - </item> + <item>TermConstruct = {{}} | {{ ConditionExpression, ... }} | + <c><![CDATA[[]]]></c> | [ConditionExpression, ...] | + <c><![CDATA[#{}]]></c> | #{term() => ConditionExpression, ...} | + NonCompositeTerm | Constant</item> + <item>NonCompositeTerm ::= term() (not list or tuple or map)</item> <item>Constant ::= {<c><![CDATA[const]]></c>, term()} </item> <item>GuardFunction ::= BoolFunction | <c><![CDATA[abs]]></c> | @@ -134,22 +138,26 @@ { GuardFunction, ConditionExpression, ... } </item> <item>BoolFunction ::= <c><![CDATA[is_atom]]></c> | - <c><![CDATA[is_float]]></c> | <c><![CDATA[is_integer]]></c> | <c><![CDATA[is_list]]></c> | - <c><![CDATA[is_number]]></c> | <c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> | - <c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> | <c><![CDATA[is_binary]]></c> | - <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> | <c><![CDATA[is_seq_trace]]></c> | - <c><![CDATA['and']]></c> | <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> | <c><![CDATA['xor']]></c> | - <c><![CDATA[andalso]]></c> | <c><![CDATA[orelse]]></c></item> + <c><![CDATA[is_float]]></c> | <c><![CDATA[is_integer]]></c> | + <c><![CDATA[is_list]]></c> | <c><![CDATA[is_number]]></c> | + <c><![CDATA[is_pid]]></c> | <c><![CDATA[is_port]]></c> | + <c><![CDATA[is_reference]]></c> | <c><![CDATA[is_tuple]]></c> | + <c><![CDATA[is_map]]></c> | <c><![CDATA[is_binary]]></c> | + <c><![CDATA[is_function]]></c> | <c><![CDATA[is_record]]></c> | + <c><![CDATA[is_seq_trace]]></c> | <c><![CDATA['and']]></c> | + <c><![CDATA['or']]></c> | <c><![CDATA['not']]></c> | + <c><![CDATA['xor']]></c> | <c><![CDATA[andalso]]></c> | + <c><![CDATA[orelse]]></c></item> <item>ConditionExpression ::= ExprMatchVariable | { GuardFunction } | { GuardFunction, ConditionExpression, ... } | TermConstruct </item> <item>ExprMatchVariable ::= MatchVariable (bound in the MatchHead) | <c><![CDATA['$_']]></c> | <c><![CDATA['$$']]></c></item> <item>TermConstruct = {{}} | {{ ConditionExpression, ... }} | - <c><![CDATA[[]]]></c> | [ConditionExpression, ...] | NonCompositeTerm | Constant - </item> - <item>NonCompositeTerm ::= term() (not list or tuple) - </item> + <c><![CDATA[[]]]></c> | [ConditionExpression, ...] | #{} | + #{term() => ConditionExpression, ...} | NonCompositeTerm | + Constant</item> + <item>NonCompositeTerm ::= term() (not list or tuple or map)</item> <item>Constant ::= {<c><![CDATA[const]]></c>, term()} </item> <item>GuardFunction ::= BoolFunction | <c><![CDATA[abs]]></c> | @@ -172,9 +180,10 @@ <title>Functions allowed in all types of match specifications</title> <p>The different functions allowed in <c><![CDATA[match_spec]]></c> work like this: </p> - <p><em>is_atom, is_float, is_integer, is_list, is_number, is_pid, is_port, is_reference, is_tuple, is_binary, is_function: </em> Like the corresponding guard tests in - Erlang, return <c><![CDATA[true]]></c> or <c><![CDATA[false]]></c>. - </p> + <p><em>is_atom, is_float, is_integer, is_list, is_number, is_pid, is_port, + is_reference, is_tuple, is_map, is_binary, is_function:</em> Like the + corresponding guard tests in Erlang, return <c><![CDATA[true]]></c> or + <c><![CDATA[false]]></c>.</p> <p><em>is_record: </em>Takes an additional parameter, which SHALL be the result of <c><![CDATA[record_info(size, <record_type>)]]></c>, like in <c><![CDATA[{is_record, '$1', rectype, record_info(size, rectype)}]]></c>. diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 7145824f91..53fc7bd713 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -112,18 +112,24 @@ NO_INLINE_FUNCTIONS=true else ifeq ($(TYPE),lcnt) -PURIFY = +PURIFY = TYPEMARKER = .lcnt TYPE_FLAGS = @CFLAGS@ -DERTS_ENABLE_LOCK_COUNT else ifeq ($(TYPE),frmptr) -PURIFY = +PURIFY = OMIT_OMIT_FP=yes TYPEMARKER = .frmptr TYPE_FLAGS = @CFLAGS@ -DERTS_FRMPTR else +ifeq ($(TYPE),icount) +PURIFY = +TYPEMARKER = .icount +TYPE_FLAGS = @CFLAGS@ -DERTS_OPCODE_COUNTER_SUPPORT +else + # If type isn't one of the above, it *is* opt type... override TYPE=opt PURIFY = @@ -138,6 +144,7 @@ endif endif endif endif +endif comma:=, space:= diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 5d06a32941..c097866c7e 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -198,6 +198,7 @@ atom dotall atom driver atom driver_options atom dsend +atom dsend_continue_trap atom dunlink atom duplicate_bag atom dupnames @@ -279,7 +280,6 @@ atom http httph https http_response http_request http_header http_eoh http_error atom id atom if_clause atom ignore -atom imports atom in atom in_exiting atom inactive @@ -335,6 +335,7 @@ atom max atom maximum atom max_tables max_processes atom mbuf_size +atom md5 atom memory atom memory_internal atom memory_types diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 8bfb7d2ad2..e9f5fd798b 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -241,10 +241,6 @@ BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ void** beam_ops; #endif -#ifndef ERTS_SMP /* Not supported with smp emulator */ -extern int count_instructions; -#endif - #define SWAPIN \ HTOP = HEAP_TOP(c_p); \ E = c_p->stop @@ -1163,14 +1159,15 @@ void process_main(void) Eterm (*arith_func)(Process* p, Eterm* reg, Uint live); -#ifndef NO_JUMP_TABLE - static void* opcodes[] = { DEFINE_OPCODES }; #ifdef ERTS_OPCODE_COUNTER_SUPPORT static void* counting_opcodes[] = { DEFINE_COUNTING_OPCODES }; -#endif +#else +#ifndef NO_JUMP_TABLE + static void* opcodes[] = { DEFINE_OPCODES }; #else int Go; #endif +#endif Uint temp_bits; /* Temporary used by BsSkipBits2 & BsGetInteger2 */ @@ -3782,8 +3779,6 @@ get_map_elements_fail: * Allocate the binary struct itself. */ bptr = erts_bin_nrml_alloc(num_bytes); - bptr->flags = 0; - bptr->orig_size = num_bytes; erts_refc_init(&bptr->refc, 1); erts_current_bin = (byte *) bptr->orig_bytes; @@ -3883,8 +3878,6 @@ get_map_elements_fail: * Allocate the binary struct itself. */ bptr = erts_bin_nrml_alloc(tmp_arg1); - bptr->flags = 0; - bptr->orig_size = tmp_arg1; erts_refc_init(&bptr->refc, 1); erts_current_bin = (byte *) bptr->orig_bytes; @@ -4987,14 +4980,14 @@ get_map_elements_fail: * ... remainder of original BEAM code */ ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI)); - c_p->hipe.ncallee = (void(*)(void)) I[-4]; + c_p->hipe.u.ncallee = (void(*)(void)) I[-4]; cmd = HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8); ++hipe_trap_count; goto L_hipe_mode_switch; } OpCase(hipe_trap_call_closure): { ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI)); - c_p->hipe.ncallee = (void(*)(void)) I[-4]; + c_p->hipe.u.ncallee = (void(*)(void)) I[-4]; cmd = HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8); ++hipe_trap_count; goto L_hipe_mode_switch; @@ -5028,7 +5021,10 @@ get_map_elements_fail: case HIPE_MODE_SWITCH_RES_RETURN: ASSERT(is_value(reg[0])); MoveReturn(reg[0], r(0)); - case HIPE_MODE_SWITCH_RES_CALL: + case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: + c_p->i = c_p->hipe.u.callee_exp->addressv[erts_active_code_ix()]; + /*fall through*/ + case HIPE_MODE_SWITCH_RES_CALL_BEAM: SET_I(c_p->i); r(0) = reg[0]; Dispatch(); @@ -5145,22 +5141,16 @@ get_map_elements_fail: #ifndef NO_JUMP_TABLE #ifdef ERTS_OPCODE_COUNTER_SUPPORT - /* Are tables correctly generated by beam_makeops? */ ASSERT(sizeof(counting_opcodes) == sizeof(opcodes)); - - if (count_instructions) { #ifdef DEBUG - counting_opcodes[op_catch_end_y] = LabelAddr(lb_catch_end_y); + counting_opcodes[op_catch_end_y] = LabelAddr(lb_catch_end_y); #endif - counting_opcodes[op_i_func_info_IaaI] = LabelAddr(lb_i_func_info_IaaI); - beam_ops = counting_opcodes; - } - else -#endif /* #ifndef ERTS_OPCODE_COUNTER_SUPPORT */ - { - beam_ops = opcodes; - } + counting_opcodes[op_i_func_info_IaaI] = LabelAddr(lb_i_func_info_IaaI); + beam_ops = counting_opcodes; +#else /* #ifndef ERTS_OPCODE_COUNTER_SUPPORT */ + beam_ops = opcodes; +#endif /* ERTS_OPCODE_COUNTER_SUPPORT */ #endif /* NO_JUMP_TABLE */ em_call_error_handler = OpCode(call_error_handler); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index cfc6146b0a..07654f6d5c 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -245,7 +245,7 @@ typedef struct { /* * This structure contains all information about the module being loaded. */ - +#define MD5_SIZE 16 typedef struct LoaderState { /* * The current logical file within the binary. @@ -292,7 +292,7 @@ typedef struct LoaderState { StringPatch* string_patches; /* Linked list of position into string table to patch. */ BeamInstr catches; /* Linked list of catch_yf instructions. */ unsigned loaded_size; /* Final size of code when loaded. */ - byte mod_md5[16]; /* MD5 for module code. */ + byte mod_md5[MD5_SIZE]; /* MD5 for module code. */ int may_load_nif; /* true if NIFs may later be loaded for this module */ int on_load; /* Index in the code for the on_load function * (or 0 if there is no on_load function) @@ -528,6 +528,7 @@ static Eterm exported_from_module(Process* p, Eterm mod); static Eterm functions_in_module(Process* p, Eterm mod); static Eterm attributes_for_module(Process* p, Eterm mod); static Eterm compilation_info_for_module(Process* p, Eterm mod); +static Eterm md5_of_module(Process* p, Eterm mod); static Eterm native_addresses(Process* p, Eterm mod); int patch_funentries(Eterm Patchlist); int patch(Eterm Addresses, Uint fe); @@ -648,6 +649,7 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader, stp->code[MI_COMPILE_PTR] = 0; stp->code[MI_COMPILE_SIZE] = 0; stp->code[MI_COMPILE_SIZE_ON_HEAP] = 0; + stp->code[MI_MD5_PTR] = 0; /* * Read the atom table. @@ -4042,7 +4044,7 @@ freeze_code(LoaderState* stp) } size = (stp->ci * sizeof(BeamInstr)) + (stp->total_literal_size * sizeof(Eterm)) + - strtab_size + attr_size + compile_size + line_size; + strtab_size + attr_size + compile_size + MD5_SIZE + line_size; /* * Move the code to its final location. @@ -4251,11 +4253,20 @@ freeze_code(LoaderState* stp) code[MI_COMPILE_SIZE_ON_HEAP] = decoded_size; } CHKBLK(ERTS_ALC_T_CODE,code); + { + byte* md5_sum = str_table + strtab_size + attr_size + compile_size; + CHKBLK(ERTS_ALC_T_CODE,code); + sys_memcpy(md5_sum, stp->mod_md5, MD5_SIZE); + CHKBLK(ERTS_ALC_T_CODE,code); + code[MI_MD5_PTR] = (BeamInstr) md5_sum; + CHKBLK(ERTS_ALC_T_CODE,code); + } + CHKBLK(ERTS_ALC_T_CODE,code); /* * Make sure that we have not overflowed the allocated code space. */ - ASSERT(str_table + strtab_size + attr_size + compile_size == + ASSERT(str_table + strtab_size + attr_size + compile_size + MD5_SIZE == ((byte *) code) + size); /* @@ -5107,10 +5118,11 @@ erts_module_info_0(Process* p, Eterm module) hp += 3; \ list = CONS(hp, tup, list) + BUILD_INFO(am_md5); BUILD_INFO(am_compile); BUILD_INFO(am_attributes); - BUILD_INFO(am_imports); BUILD_INFO(am_exports); + BUILD_INFO(am_module); #undef BUILD_INFO return list; } @@ -5120,8 +5132,8 @@ erts_module_info_1(Process* p, Eterm module, Eterm what) { if (what == am_module) { return module; - } else if (what == am_imports) { - return NIL; + } else if (what == am_md5) { + return md5_of_module(p, module); } else if (what == am_exports) { return exported_from_module(p, module); } else if (what == am_functions) { @@ -5310,7 +5322,7 @@ attributes_for_module(Process* p, /* Process whose heap to use. */ Eterm result = NIL; Eterm* end; - if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) { + if (is_not_atom(mod)) { return THE_NON_VALUE; } @@ -5349,7 +5361,7 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */ Eterm result = NIL; Eterm* end; - if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) { + if (is_not_atom(mod)) { return THE_NON_VALUE; } @@ -5372,6 +5384,33 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */ } /* + * Returns the MD5 checksum for a module + * + * Returns a tagged term, or 0 on error. + */ + +Eterm +md5_of_module(Process* p, /* Process whose heap to use. */ + Eterm mod) /* Tagged atom for module. */ +{ + Module* modp; + BeamInstr* code; + Eterm res = NIL; + + if (is_not_atom(mod)) { + return THE_NON_VALUE; + } + + modp = erts_get_module(mod, erts_active_code_ix()); + if (modp == NULL) { + return THE_NON_VALUE; + } + code = modp->curr.code; + res = new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE); + return res; +} + +/* * Build a single {M,F,A,Loction} item to be part of * a stack trace. */ @@ -5547,7 +5586,7 @@ code_module_md5_1(BIF_ALIST_1) res = am_undefined; goto done; } - res = new_binary(p, stp->mod_md5, sizeof(stp->mod_md5)); + res = new_binary(p, stp->mod_md5, MD5_SIZE); done: erts_free_aligned_binary_bytes(temp_alloc); @@ -5943,6 +5982,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) code[MI_LITERALS_END] = 0; code[MI_LITERALS_OFF_HEAP] = 0; code[MI_ON_LOAD_FUNCTION_PTR] = 0; + code[MI_MD5_PTR] = 0; ci = MI_FUNCTIONS + n + 1; /* diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h index bd22b0c4de..0e3ca0bdb0 100644 --- a/erts/emulator/beam/beam_load.h +++ b/erts/emulator/beam/beam_load.h @@ -91,7 +91,6 @@ extern Uint erts_total_code_size; #define MI_LITERALS_END 8 #define MI_LITERALS_OFF_HEAP 9 - /* * Pointer to the on_load function (or NULL if none). */ @@ -103,6 +102,11 @@ extern Uint erts_total_code_size; #define MI_LINE_TABLE 11 /* + * Pointer to the module MD5 sum (16 bytes) + */ +#define MI_MD5_PTR 12 + +/* * Start of function pointer table. This table contains pointers to * all functions in the module plus an additional pointer just beyond * the end of the last function. @@ -111,7 +115,7 @@ extern Uint erts_total_code_size; * this table. */ -#define MI_FUNCTIONS 12 +#define MI_FUNCTIONS 13 /* * Layout of the line table. diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 42dd160e38..49996e7f0b 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -28,7 +28,9 @@ #include "global.h" #include "erl_process.h" #include "error.h" +#define ERL_WANT_HIPE_BIF_WRAPPER__ #include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ #include "big.h" #include "dist.h" #include "erl_version.h" @@ -46,7 +48,7 @@ static Export* set_cpu_topology_trap = NULL; static Export* await_proc_exit_trap = NULL; static Export* await_port_send_result_trap = NULL; Export* erts_format_cpu_topology_trap = NULL; - +static Export dsend_continue_trap_export; static Export *await_sched_wall_time_mod_trap; static erts_smp_atomic32_t sched_wall_time; @@ -1777,6 +1779,8 @@ BIF_RETTYPE whereis_1(BIF_ALIST_1) * erlang:'!'/2 */ +HIPE_WRAPPER_BIF_DISABLE_GC(ebif_bang, 2) + BIF_RETTYPE ebif_bang_2(BIF_ALIST_2) { @@ -1795,34 +1799,36 @@ ebif_bang_2(BIF_ALIST_2) #define SEND_USER_ERROR (-5) #define SEND_INTERNAL_ERROR (-6) #define SEND_AWAIT_RESULT (-7) +#define SEND_YIELD_CONTINUE (-8) + -Sint do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp); +Sint do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext*); static Sint remote_send(Process *p, DistEntry *dep, - Eterm to, Eterm full_to, Eterm msg, int suspend) + Eterm to, Eterm full_to, Eterm msg, + ErtsSendContext* ctx) { Sint res; int code; - ErtsDSigData dsd; ASSERT(is_atom(to) || is_external_pid(to)); - code = erts_dsig_prepare(&dsd, dep, p, ERTS_DSP_NO_LOCK, !suspend); + code = erts_dsig_prepare(&ctx->dsd, dep, p, ERTS_DSP_NO_LOCK, !ctx->suspend); switch (code) { case ERTS_DSIG_PREP_NOT_ALIVE: case ERTS_DSIG_PREP_NOT_CONNECTED: res = SEND_TRAP; break; case ERTS_DSIG_PREP_WOULD_SUSPEND: - ASSERT(!suspend); + ASSERT(!ctx->suspend); res = SEND_YIELD; break; case ERTS_DSIG_PREP_CONNECTED: { if (is_atom(to)) - code = erts_dsig_send_reg_msg(&dsd, to, msg); + code = erts_dsig_send_reg_msg(to, msg, ctx); else - code = erts_dsig_send_msg(&dsd, to, msg); + code = erts_dsig_send_msg(to, msg, ctx); /* * Note that reductions have been bumped on calling * process by erts_dsig_send_reg_msg() or @@ -1830,6 +1836,8 @@ static Sint remote_send(Process *p, DistEntry *dep, */ if (code == ERTS_DSIG_SEND_YIELD) res = SEND_YIELD_RETURN; + else if (code == ERTS_DSIG_SEND_CONTINUE) + res = SEND_YIELD_CONTINUE; else res = 0; break; @@ -1850,7 +1858,8 @@ static Sint remote_send(Process *p, DistEntry *dep, } Sint -do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { +do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext* ctx) +{ Eterm portid; Port *pt; Process* rp; @@ -1883,7 +1892,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { #endif return 0; } - return remote_send(p, dep, to, to, msg, suspend); + return remote_send(p, dep, to, to, msg, ctx); } else if (is_atom(to)) { Eterm id = erts_whereis_name_to_id(p, to); @@ -1940,7 +1949,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { ret_val = 0; if (pt) { - int ps_flags = suspend ? 0 : ERTS_PORT_SIG_FLG_NOSUSPEND; + int ps_flags = ctx->suspend ? 0 : ERTS_PORT_SIG_FLG_NOSUSPEND; *refp = NIL; switch (erts_port_command(p, ps_flags, pt, msg, refp)) { @@ -1949,12 +1958,12 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { return SEND_USER_ERROR; case ERTS_PORT_OP_BUSY: /* Nothing has been sent */ - if (suspend) + if (ctx->suspend) erts_suspend(p, ERTS_PROC_LOCK_MAIN, pt); return SEND_YIELD; case ERTS_PORT_OP_BUSY_SCHEDULED: /* Message was sent */ - if (suspend) { + if (ctx->suspend) { erts_suspend(p, ERTS_PROC_LOCK_MAIN, pt); ret_val = SEND_YIELD_RETURN; break; @@ -2034,9 +2043,14 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { return 0; } - ret = remote_send(p, dep, tp[1], to, msg, suspend); - if (dep) - erts_deref_dist_entry(dep); + ret = remote_send(p, dep, tp[1], to, msg, ctx); + if (ret != SEND_YIELD_CONTINUE) { + if (dep) { + erts_deref_dist_entry(dep); + } + } else { + ctx->dep_to_deref = dep; + } return ret; } else { if (IS_TRACED(p)) /* XXX Is this really neccessary ??? */ @@ -2067,9 +2081,11 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { } } +HIPE_WRAPPER_BIF_DISABLE_GC(send, 3) BIF_RETTYPE send_3(BIF_ALIST_3) { + BIF_RETTYPE retval; Eterm ref; Process *p = BIF_P; Eterm to = BIF_ARG_1; @@ -2077,34 +2093,44 @@ BIF_RETTYPE send_3(BIF_ALIST_3) Eterm opts = BIF_ARG_3; int connect = !0; - int suspend = !0; Eterm l = opts; Sint result; - + DeclareTypedTmpHeap(ErtsSendContext, ctx, BIF_P); + UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P); + + ctx->suspend = !0; + ctx->dep_to_deref = NULL; + ctx->return_term = am_ok; + ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR); + ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT; + while (is_list(l)) { if (CAR(list_val(l)) == am_noconnect) { connect = 0; } else if (CAR(list_val(l)) == am_nosuspend) { - suspend = 0; + ctx->suspend = 0; } else { - BIF_ERROR(p, BADARG); + ERTS_BIF_PREP_ERROR(retval, p, BADARG); + goto done; } l = CDR(list_val(l)); } if(!is_nil(l)) { - BIF_ERROR(p, BADARG); + ERTS_BIF_PREP_ERROR(retval, p, BADARG); + goto done; } #ifdef DEBUG ref = NIL; #endif - result = do_send(p, to, msg, suspend, &ref); + result = do_send(p, to, msg, &ref, ctx); if (result > 0) { ERTS_VBUMP_REDS(p, result); if (ERTS_IS_PROC_OUT_OF_REDS(p)) goto yield_return; - BIF_RET(am_ok); + ERTS_BIF_PREP_RET(retval, am_ok); + goto done; } switch (result) { @@ -2112,68 +2138,127 @@ BIF_RETTYPE send_3(BIF_ALIST_3) /* May need to yield even though we do not bump reds here... */ if (ERTS_IS_PROC_OUT_OF_REDS(p)) goto yield_return; - BIF_RET(am_ok); + ERTS_BIF_PREP_RET(retval, am_ok); break; case SEND_TRAP: if (connect) { - BIF_TRAP3(dsend3_trap, p, to, msg, opts); + ERTS_BIF_PREP_TRAP3(retval, dsend3_trap, p, to, msg, opts); } else { - BIF_RET(am_noconnect); + ERTS_BIF_PREP_RET(retval, am_noconnect); } break; case SEND_YIELD: - if (suspend) { - ERTS_BIF_YIELD3(bif_export[BIF_send_3], p, to, msg, opts); + if (ctx->suspend) { + ERTS_BIF_PREP_YIELD3(retval, + bif_export[BIF_send_3], p, to, msg, opts); } else { - BIF_RET(am_nosuspend); + ERTS_BIF_PREP_RET(retval, am_nosuspend); } break; case SEND_YIELD_RETURN: - if (!suspend) - BIF_RET(am_nosuspend); + if (!ctx->suspend) { + ERTS_BIF_PREP_RET(retval, am_nosuspend); + break; + } yield_return: - ERTS_BIF_YIELD_RETURN(p, am_ok); + ERTS_BIF_PREP_YIELD_RETURN(retval, p, am_ok); + break; case SEND_AWAIT_RESULT: ASSERT(is_internal_ref(ref)); - BIF_TRAP3(await_port_send_result_trap, p, ref, am_nosuspend, am_ok); + ERTS_BIF_PREP_TRAP3(retval, await_port_send_result_trap, p, ref, am_nosuspend, am_ok); + break; case SEND_BADARG: - BIF_ERROR(p, BADARG); + ERTS_BIF_PREP_ERROR(retval, p, BADARG); break; case SEND_USER_ERROR: - BIF_ERROR(p, EXC_ERROR); + ERTS_BIF_PREP_ERROR(retval, p, EXC_ERROR); break; case SEND_INTERNAL_ERROR: - BIF_ERROR(p, EXC_INTERNAL_ERROR); + ERTS_BIF_PREP_ERROR(retval, p, EXC_INTERNAL_ERROR); + break; + case SEND_YIELD_CONTINUE: + BUMP_ALL_REDS(p); + erts_set_gc_state(p, 0); + ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p, + erts_dsend_export_trap_context(p, ctx)); break; default: - ASSERT(! "Illegal send result"); + erl_exit(ERTS_ABORT_EXIT, "send_3 invalid result %d\n", (int)result); break; } - ASSERT(! "Can not arrive here"); - BIF_ERROR(p, BADARG); + +done: + UnUseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P); + return retval; } +HIPE_WRAPPER_BIF_DISABLE_GC(send, 2) + BIF_RETTYPE send_2(BIF_ALIST_2) { return erl_send(BIF_P, BIF_ARG_1, BIF_ARG_2); } +static BIF_RETTYPE dsend_continue_trap_1(BIF_ALIST_1) +{ + Binary* bin = ((ProcBin*) binary_val(BIF_ARG_1))->val; + ErtsSendContext* ctx = (ErtsSendContext*) ERTS_MAGIC_BIN_DATA(bin); + Sint initial_reds = (Sint) (ERTS_BIF_REDS_LEFT(BIF_P) * TERM_TO_BINARY_LOOP_FACTOR); + int result; + + ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == erts_dsend_context_dtor); + + ctx->dss.reds = initial_reds; + result = erts_dsig_send(&ctx->dsd, &ctx->dss); + + switch (result) { + case ERTS_DSIG_SEND_OK: + erts_set_gc_state(BIF_P, 1); + BIF_RET(ctx->return_term); + break; + case ERTS_DSIG_SEND_YIELD: /*SEND_YIELD_RETURN*/ + erts_set_gc_state(BIF_P, 1); + if (!ctx->suspend) + BIF_RET(am_nosuspend); + ERTS_BIF_YIELD_RETURN(BIF_P, ctx->return_term); + + case ERTS_DSIG_SEND_CONTINUE: { /*SEND_YIELD_CONTINUE*/ + BUMP_ALL_REDS(BIF_P); + BIF_TRAP1(&dsend_continue_trap_export, BIF_P, BIF_ARG_1); + } + default: + erl_exit(ERTS_ABORT_EXIT, "dsend_continue_trap invalid result %d\n", (int)result); + break; + } + ASSERT(! "Can not arrive here"); + BIF_ERROR(BIF_P, BADARG); +} + Eterm erl_send(Process *p, Eterm to, Eterm msg) { + Eterm retval; Eterm ref; Sint result; + DeclareTypedTmpHeap(ErtsSendContext, ctx, p); + UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p); #ifdef DEBUG ref = NIL; #endif + ctx->suspend = !0; + ctx->dep_to_deref = NULL; + ctx->return_term = msg; + ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR); + ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT; - result = do_send(p, to, msg, !0, &ref); + result = do_send(p, to, msg, &ref, ctx); if (result > 0) { ERTS_VBUMP_REDS(p, result); if (ERTS_IS_PROC_OUT_OF_REDS(p)) goto yield_return; - BIF_RET(msg); + ERTS_BIF_PREP_RET(retval, msg); + goto done; } switch (result) { @@ -2181,35 +2266,46 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg) /* May need to yield even though we do not bump reds here... */ if (ERTS_IS_PROC_OUT_OF_REDS(p)) goto yield_return; - BIF_RET(msg); + ERTS_BIF_PREP_RET(retval, msg); break; case SEND_TRAP: - BIF_TRAP2(dsend2_trap, p, to, msg); + ERTS_BIF_PREP_TRAP2(retval, dsend2_trap, p, to, msg); break; case SEND_YIELD: - ERTS_BIF_YIELD2(bif_export[BIF_send_2], p, to, msg); + ERTS_BIF_PREP_YIELD2(retval, bif_export[BIF_send_2], p, to, msg); break; case SEND_YIELD_RETURN: yield_return: - ERTS_BIF_YIELD_RETURN(p, msg); + ERTS_BIF_PREP_YIELD_RETURN(retval, p, msg); + break; case SEND_AWAIT_RESULT: ASSERT(is_internal_ref(ref)); - BIF_TRAP3(await_port_send_result_trap, p, ref, msg, msg); + ERTS_BIF_PREP_TRAP3(retval, + await_port_send_result_trap, p, ref, msg, msg); + break; case SEND_BADARG: - BIF_ERROR(p, BADARG); + ERTS_BIF_PREP_ERROR(retval, p, BADARG); break; case SEND_USER_ERROR: - BIF_ERROR(p, EXC_ERROR); + ERTS_BIF_PREP_ERROR(retval, p, EXC_ERROR); break; case SEND_INTERNAL_ERROR: - BIF_ERROR(p, EXC_INTERNAL_ERROR); + ERTS_BIF_PREP_ERROR(retval, p, EXC_INTERNAL_ERROR); + break; + case SEND_YIELD_CONTINUE: + BUMP_ALL_REDS(p); + erts_set_gc_state(p, 0); + ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p, + erts_dsend_export_trap_context(p, ctx)); break; default: - ASSERT(! "Illegal send result"); + erl_exit(ERTS_ABORT_EXIT, "invalid send result %d\n", (int)result); break; } - ASSERT(! "Can not arrive here"); - BIF_ERROR(p, BADARG); + +done: + UnUseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p); + return retval; } /**********************************************************************/ @@ -3996,16 +4092,19 @@ BIF_RETTYPE halt_2(BIF_ALIST_2) BIF_RETTYPE function_exported_3(BIF_ALIST_3) { + int arity; if (is_not_atom(BIF_ARG_1) || is_not_atom(BIF_ARG_2) || is_not_small(BIF_ARG_3)) { BIF_ERROR(BIF_P, BADARG); } - if (erts_find_function(BIF_ARG_1, BIF_ARG_2, signed_val(BIF_ARG_3), - erts_active_code_ix()) == NULL) { - BIF_RET(am_false); + arity = signed_val(BIF_ARG_3); + if (erts_find_function(BIF_ARG_1, BIF_ARG_2, arity, + erts_active_code_ix()) != NULL || + erts_is_builtin(BIF_ARG_1, BIF_ARG_2, arity)) { + BIF_RET(am_true); } - BIF_RET(am_true); + BIF_RET(am_false); } /**********************************************************************/ @@ -4816,6 +4915,10 @@ void erts_init_bif(void) #endif , &bif_return_trap); + erts_init_trap_export(&dsend_continue_trap_export, + am_erts_internal, am_dsend_continue_trap, 1, + dsend_continue_trap_1); + flush_monitor_message_trap = erts_export_put(am_erlang, am_flush_monitor_message, 2); diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index 72c55ccb55..7b69b39511 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -465,6 +465,8 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, Eterm args[], int nargs); +#ifdef ERL_WANT_HIPE_BIF_WRAPPER__ + #ifndef HIPE #define HIPE_WRAPPER_BIF_DISABLE_GC(BIF_NAME, ARITY) @@ -509,6 +511,7 @@ BIF_RETTYPE hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (Process* c_p, \ #endif +#endif /* ERL_WANT_HIPE_BIF_WRAPPER__ */ #include "erl_bif_table.h" diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index e68b8e6274..55ac778475 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -578,7 +578,7 @@ bif io:printable_range/0 bif os:unsetenv/1 # -# New in R17A +# New in 17.0 # bif re:inspect/2 @@ -601,9 +601,16 @@ bif maps:values/1 bif erts_internal:cmp_term/2 # -# New in 17.1. +# New in 17.1 # + bif erlang:fun_info_mfa/1 + +# New in 18.0 +# + +bif erlang:get_keys/0 + # # Obsolete # diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index f50d484576..cc0b3b9b6c 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -26,7 +26,9 @@ #include "global.h" #include "erl_process.h" #include "error.h" +#define ERL_WANT_HIPE_BIF_WRAPPER__ #include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ #include "big.h" #include "erl_binary.h" #include "erl_bits.h" @@ -83,8 +85,6 @@ new_binary(Process *p, byte *buf, Uint len) * Allocate the binary struct itself. */ bptr = erts_bin_nrml_alloc(len); - bptr->flags = 0; - bptr->orig_size = len; erts_refc_init(&bptr->refc, 1); if (buf != NULL) { sys_memcpy(bptr->orig_bytes, buf, len); @@ -122,8 +122,6 @@ Eterm erts_new_mso_binary(Process *p, byte *buf, int len) * Allocate the binary struct itself. */ bptr = erts_bin_nrml_alloc(len); - bptr->flags = 0; - bptr->orig_size = len; erts_refc_init(&bptr->refc, 1); if (buf != NULL) { sys_memcpy(bptr->orig_bytes, buf, len); @@ -177,7 +175,6 @@ erts_realloc_binary(Eterm bin, size_t size) } else { /* REFC */ ProcBin* pb = (ProcBin *) bval; Binary* newbin = erts_bin_realloc(pb->val, size); - newbin->orig_size = size; pb->val = newbin; pb->size = size; pb->bytes = (byte*) newbin->orig_bytes; diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 08265b590d..5aee85174f 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -754,6 +754,8 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) dumpname = "erl_crash.dump"; else dumpname = &dumpnamebuf[0]; + + erts_fprintf(stderr,"\nCrash dump is being written to: %s...", dumpname); fd = open(dumpname,O_WRONLY | O_CREAT | O_TRUNC,0640); if (fd < 0) @@ -804,7 +806,7 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) erts_fdprintf(fd, "=end\n"); close(fd); - erts_fprintf(stderr,"\nCrash dump was written to: %s\n", dumpname); + erts_fprintf(stderr,"done\n"); } void diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 50548850eb..0010f6a440 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -21,6 +21,8 @@ # include "config.h" #endif +#define ERL_WANT_GC_INTERNALS__ + #include "sys.h" #include "erl_vm.h" #include "global.h" diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index ec07ddcd9c..bfecac1612 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -119,7 +119,7 @@ Export* dmonitor_p_trap = NULL; /* forward declarations */ static void clear_dist_entry(DistEntry*); -static int dsig_send(ErtsDSigData *, Eterm, Eterm, int); +static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy); static void send_nodes_mon_msgs(Process *, Eterm, Eterm, Eterm, Eterm); static void init_nodes_monitors(void); @@ -622,9 +622,7 @@ alloc_dist_obuf(Uint size) ErtsDistOutputBuf *obuf; Uint obuf_size = sizeof(ErtsDistOutputBuf)+sizeof(byte)*(size-1); Binary *bin = erts_bin_drv_alloc(obuf_size); - bin->flags = BIN_FLAG_DRV; erts_refc_init(&bin->refc, 1); - bin->orig_size = (SWord) obuf_size; obuf = (ErtsDistOutputBuf *) &bin->orig_bytes[0]; #ifdef DEBUG obuf->dbg_pattern = ERTS_DIST_OUTPUT_BUF_DBG_PATTERN; @@ -709,6 +707,55 @@ static void clear_dist_entry(DistEntry *dep) } } +void erts_dsend_context_dtor(Binary* ctx_bin) +{ + ErtsSendContext* ctx = ERTS_MAGIC_BIN_DATA(ctx_bin); + switch (ctx->dss.phase) { + case ERTS_DSIG_SEND_PHASE_MSG_SIZE: + DESTROY_SAVED_ESTACK(&ctx->dss.u.sc.estack); + break; + case ERTS_DSIG_SEND_PHASE_MSG_ENCODE: + DESTROY_SAVED_WSTACK(&ctx->dss.u.ec.wstack); + break; + default:; + } + if (ctx->dss.phase >= ERTS_DSIG_SEND_PHASE_ALLOC && ctx->dss.obuf) { + free_dist_obuf(ctx->dss.obuf); + } + if (ctx->dep_to_deref) + erts_deref_dist_entry(ctx->dep_to_deref); +} + +Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx) +{ + struct exported_ctx { + ErtsSendContext ctx; + ErtsAtomCacheMap acm; + }; + Binary* ctx_bin = erts_create_magic_binary(sizeof(struct exported_ctx), + erts_dsend_context_dtor); + struct exported_ctx* dst = ERTS_MAGIC_BIN_DATA(ctx_bin); + Uint ctl_size = !HALFWORD_HEAP ? 0 : (arityval(ctx->ctl_heap[0]) + 1); + Eterm* hp = HAlloc(p, ctl_size + PROC_BIN_SIZE); + + sys_memcpy(&dst->ctx, ctx, sizeof(ErtsSendContext)); + ASSERT(ctx->dss.ctl == make_tuple(ctx->ctl_heap)); +#if !HALFWORD_HEAP + dst->ctx.dss.ctl = make_tuple(dst->ctx.ctl_heap); +#else + /* Must put control tuple in low mem */ + sys_memcpy(hp, ctx->ctl_heap, ctl_size*sizeof(Eterm)); + dst->ctx.dss.ctl = make_tuple(hp); + hp += ctl_size; +#endif + if (ctx->dss.acmp) { + sys_memcpy(&dst->acm, ctx->dss.acmp, sizeof(ErtsAtomCacheMap)); + dst->ctx.dss.acmp = &dst->acm; + } + return erts_mk_magic_binary_term(&hp, &MSO(p), ctx_bin); +} + + /* * The erts_dsig_send_*() functions implemented below, sends asynchronous * distributed signals to other Erlang nodes. Before sending a distributed @@ -731,7 +778,7 @@ erts_dsig_send_link(ErtsDSigData *dsdp, Eterm local, Eterm remote) int res; UseTmpHeapNoproc(4); - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0); + res = dsig_send_ctl(dsdp, ctl, 0); UnUseTmpHeapNoproc(4); return res; } @@ -744,7 +791,7 @@ erts_dsig_send_unlink(ErtsDSigData *dsdp, Eterm local, Eterm remote) int res; UseTmpHeapNoproc(4); - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0); + res = dsig_send_ctl(dsdp, ctl, 0); UnUseTmpHeapNoproc(4); return res; } @@ -772,7 +819,7 @@ erts_dsig_send_m_exit(ErtsDSigData *dsdp, Eterm watcher, Eterm watched, erts_smp_de_links_unlock(dsdp->dep); #endif - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 1); + res = dsig_send_ctl(dsdp, ctl, 1); UnUseTmpHeapNoproc(6); return res; } @@ -793,7 +840,7 @@ erts_dsig_send_monitor(ErtsDSigData *dsdp, Eterm watcher, Eterm watched, make_small(DOP_MONITOR_P), watcher, watched, ref); - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0); + res = dsig_send_ctl(dsdp, ctl, 0); UnUseTmpHeapNoproc(5); return res; } @@ -815,18 +862,17 @@ erts_dsig_send_demonitor(ErtsDSigData *dsdp, Eterm watcher, make_small(DOP_DEMONITOR_P), watcher, watched, ref); - res = dsig_send(dsdp, ctl, THE_NON_VALUE, force); + res = dsig_send_ctl(dsdp, ctl, force); UnUseTmpHeapNoproc(5); return res; } int -erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message) +erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) { Eterm ctl; - DeclareTmpHeapNoproc(ctl_heap,5); Eterm token = NIL; - Process *sender = dsdp->proc; + Process *sender = ctx->dsd.proc; int res; #ifdef USE_VM_PROBES Sint tok_label = 0; @@ -838,8 +884,7 @@ erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message) DTRACE_CHARBUF(receiver_name, 64); #endif - UseTmpHeapNoproc(5); - if (SEQ_TRACE_TOKEN(sender) != NIL + if (SEQ_TRACE_TOKEN(sender) != NIL #ifdef USE_VM_PROBES && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag #endif @@ -852,7 +897,7 @@ erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message) *node_name = *sender_name = *receiver_name = '\0'; if (DTRACE_ENABLED(message_send) || DTRACE_ENABLED(message_send_remote)) { erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)), - "%T", dsdp->dep->sysname); + "%T", ctx->dsd.dep->sysname); erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), "%T", sender->common.id); erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), @@ -867,26 +912,28 @@ erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message) #endif if (token != NIL) - ctl = TUPLE4(&ctl_heap[0], + ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_SEND_TT), am_Cookie, remote, token); else - ctl = TUPLE3(&ctl_heap[0], make_small(DOP_SEND), am_Cookie, remote); + ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_SEND), am_Cookie, remote); DTRACE6(message_send, sender_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); DTRACE7(message_send_remote, sender_name, node_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); - res = dsig_send(dsdp, ctl, message, 0); - UnUseTmpHeapNoproc(5); + ctx->dss.ctl = ctl; + ctx->dss.msg = message; + ctx->dss.force_busy = 0; + res = erts_dsig_send(&ctx->dsd, &ctx->dss); return res; } int -erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message) +erts_dsig_send_reg_msg(Eterm remote_name, Eterm message, + ErtsSendContext* ctx) { Eterm ctl; - DeclareTmpHeapNoproc(ctl_heap,6); Eterm token = NIL; - Process *sender = dsdp->proc; + Process *sender = ctx->dsd.proc; int res; #ifdef USE_VM_PROBES Sint tok_label = 0; @@ -898,7 +945,6 @@ erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message) DTRACE_CHARBUF(receiver_name, 128); #endif - UseTmpHeapNoproc(6); if (SEQ_TRACE_TOKEN(sender) != NIL #ifdef USE_VM_PROBES && SEQ_TRACE_TOKEN(sender) != am_have_dt_utag @@ -912,7 +958,7 @@ erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message) *node_name = *sender_name = *receiver_name = '\0'; if (DTRACE_ENABLED(message_send) || DTRACE_ENABLED(message_send_remote)) { erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)), - "%T", dsdp->dep->sysname); + "%T", ctx->dsd.dep->sysname); erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)), "%T", sender->common.id); erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)), @@ -927,17 +973,19 @@ erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message) #endif if (token != NIL) - ctl = TUPLE5(&ctl_heap[0], make_small(DOP_REG_SEND_TT), + ctl = TUPLE5(&ctx->ctl_heap[0], make_small(DOP_REG_SEND_TT), sender->common.id, am_Cookie, remote_name, token); else - ctl = TUPLE4(&ctl_heap[0], make_small(DOP_REG_SEND), + ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_REG_SEND), sender->common.id, am_Cookie, remote_name); DTRACE6(message_send, sender_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); DTRACE7(message_send_remote, sender_name, node_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); - res = dsig_send(dsdp, ctl, message, 0); - UnUseTmpHeapNoproc(6); + ctx->dss.ctl = ctl; + ctx->dss.msg = message; + ctx->dss.force_busy = 0; + res = erts_dsig_send(&ctx->dsd, &ctx->dss); return res; } @@ -994,7 +1042,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote, DTRACE7(process_exit_signal_remote, sender_name, node_name, remote_name, reason_str, tok_label, tok_lastcnt, tok_serial); /* forced, i.e ignore busy */ - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 1); + res = dsig_send_ctl(dsdp, ctl, 1); UnUseTmpHeapNoproc(6); return res; } @@ -1010,7 +1058,7 @@ erts_dsig_send_exit(ErtsDSigData *dsdp, Eterm local, Eterm remote, Eterm reason) ctl = TUPLE4(&ctl_heap[0], make_small(DOP_EXIT), local, remote, reason); /* forced, i.e ignore busy */ - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 1); + res = dsig_send_ctl(dsdp, ctl, 1); UnUseTmpHeapNoproc(5); return res; } @@ -1026,7 +1074,7 @@ erts_dsig_send_exit2(ErtsDSigData *dsdp, Eterm local, Eterm remote, Eterm reason ctl = TUPLE4(&ctl_heap[0], make_small(DOP_EXIT2), local, remote, reason); - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0); + res = dsig_send_ctl(dsdp, ctl, 0); UnUseTmpHeapNoproc(5); return res; } @@ -1043,7 +1091,7 @@ erts_dsig_send_group_leader(ErtsDSigData *dsdp, Eterm leader, Eterm remote) ctl = TUPLE3(&ctl_heap[0], make_small(DOP_GROUP_LEADER), leader, remote); - res = dsig_send(dsdp, ctl, THE_NON_VALUE, 0); + res = dsig_send_ctl(dsdp, ctl, 0); UnUseTmpHeapNoproc(4); return res; } @@ -1693,194 +1741,235 @@ int erts_net_message(Port *prt, return -1; } -static int -dsig_send(ErtsDSigData *dsdp, Eterm ctl, Eterm msg, int force_busy) +static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy) { + struct erts_dsig_send_context ctx; + int ret; + ctx.ctl = ctl; + ctx.msg = THE_NON_VALUE; + ctx.force_busy = force_busy; + ctx.phase = ERTS_DSIG_SEND_PHASE_INIT; +#ifdef DEBUG + ctx.reds = 1; /* provoke assert below (no reduction count without msg) */ +#endif + ret = erts_dsig_send(dsdp, &ctx); + ASSERT(ret != ERTS_DSIG_SEND_CONTINUE); + return ret; +} + +int +erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx) +{ + int retval; + Sint initial_reds = ctx->reds; Eterm cid; - int suspended = 0; - int resume = 0; - Uint32 pass_through_size; - Uint data_size, dhdr_ext_size; - ErtsAtomCacheMap *acmp; - ErtsDistOutputBuf *obuf; - DistEntry *dep = dsdp->dep; - Uint32 flags = dep->flags; - Process *c_p = dsdp->proc; - if (!c_p || dsdp->no_suspend) - force_busy = 1; + while (1) { + switch (ctx->phase) { + case ERTS_DSIG_SEND_PHASE_INIT: + ctx->flags = dsdp->dep->flags; + ctx->c_p = dsdp->proc; - ERTS_SMP_LC_ASSERT(!c_p - || (ERTS_PROC_LOCK_MAIN - == erts_proc_lc_my_proc_locks(c_p))); + if (!ctx->c_p || dsdp->no_suspend) + ctx->force_busy = 1; - if (!erts_is_alive) - return ERTS_DSIG_SEND_OK; + ERTS_SMP_LC_ASSERT(!ctx->c_p + || (ERTS_PROC_LOCK_MAIN + == erts_proc_lc_my_proc_locks(ctx->c_p))); - if (flags & DFLAG_DIST_HDR_ATOM_CACHE) { - acmp = erts_get_atom_cache_map(c_p); - pass_through_size = 0; - } - else { - acmp = NULL; - pass_through_size = 1; - } + if (!erts_is_alive) + return ERTS_DSIG_SEND_OK; -#ifdef ERTS_DIST_MSG_DBG - erts_fprintf(stderr, ">>%s CTL: %T\n", pass_through_size ? "P" : " ", ctl); - if (is_value(msg)) - erts_fprintf(stderr, " MSG: %T\n", msg); -#endif + if (ctx->flags & DFLAG_DIST_HDR_ATOM_CACHE) { + ctx->acmp = erts_get_atom_cache_map(ctx->c_p); + ctx->pass_through_size = 0; + } + else { + ctx->acmp = NULL; + ctx->pass_through_size = 1; + } - data_size = pass_through_size; - erts_reset_atom_cache_map(acmp); - data_size += erts_encode_dist_ext_size(ctl, flags, acmp); - if (is_value(msg)) - data_size += erts_encode_dist_ext_size(msg, flags, acmp); - erts_finalize_atom_cache_map(acmp, flags); + #ifdef ERTS_DIST_MSG_DBG + erts_fprintf(stderr, ">>%s CTL: %T\n", ctx->pass_through_size ? "P" : " ", ctx->ctl); + if (is_value(msg)) + erts_fprintf(stderr, " MSG: %T\n", msg); + #endif + + ctx->data_size = ctx->pass_through_size; + erts_reset_atom_cache_map(ctx->acmp); + erts_encode_dist_ext_size(ctx->ctl, ctx->flags, ctx->acmp, &ctx->data_size); + + if (is_value(ctx->msg)) { + ctx->u.sc.estack.start = NULL; + ctx->u.sc.flags = ctx->flags; + ctx->u.sc.level = 0; + ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_SIZE; + } else { + ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC; + } + break; - dhdr_ext_size = erts_encode_ext_dist_header_size(acmp); - data_size += dhdr_ext_size; + case ERTS_DSIG_SEND_PHASE_MSG_SIZE: + if (erts_encode_dist_ext_size_int(ctx->msg, ctx, &ctx->data_size)) { + retval = ERTS_DSIG_SEND_CONTINUE; + goto done; + } - obuf = alloc_dist_obuf(data_size); - obuf->ext_endp = &obuf->data[0] + pass_through_size + dhdr_ext_size; + ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC; + case ERTS_DSIG_SEND_PHASE_ALLOC: + erts_finalize_atom_cache_map(ctx->acmp, ctx->flags); + + ctx->dhdr_ext_size = erts_encode_ext_dist_header_size(ctx->acmp); + ctx->data_size += ctx->dhdr_ext_size; + + ctx->obuf = alloc_dist_obuf(ctx->data_size); + ctx->obuf->ext_endp = &ctx->obuf->data[0] + ctx->pass_through_size + ctx->dhdr_ext_size; + + /* Encode internal version of dist header */ + ctx->obuf->extp = erts_encode_ext_dist_header_setup(ctx->obuf->ext_endp, ctx->acmp); + /* Encode control message */ + erts_encode_dist_ext(ctx->ctl, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, NULL, NULL); + if (is_value(ctx->msg)) { + ctx->u.ec.flags = ctx->flags; + ctx->u.ec.level = 0; + ctx->u.ec.wstack.wstart = NULL; + ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_ENCODE; + } else { + ctx->phase = ERTS_DSIG_SEND_PHASE_FIN; + } + break; - /* Encode internal version of dist header */ - obuf->extp = erts_encode_ext_dist_header_setup(obuf->ext_endp, acmp); - /* Encode control message */ - erts_encode_dist_ext(ctl, &obuf->ext_endp, flags, acmp); - if (is_value(msg)) { - /* Encode message */ - erts_encode_dist_ext(msg, &obuf->ext_endp, flags, acmp); - } + case ERTS_DSIG_SEND_PHASE_MSG_ENCODE: + if (erts_encode_dist_ext(ctx->msg, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, &ctx->u.ec, &ctx->reds)) { + retval = ERTS_DSIG_SEND_CONTINUE; + goto done; + } - ASSERT(obuf->extp < obuf->ext_endp); - ASSERT(&obuf->data[0] <= obuf->extp - pass_through_size); - ASSERT(obuf->ext_endp <= &obuf->data[0] + data_size); + ctx->phase = ERTS_DSIG_SEND_PHASE_FIN; + case ERTS_DSIG_SEND_PHASE_FIN: { + DistEntry *dep = dsdp->dep; + int suspended = 0; + int resume = 0; - data_size = obuf->ext_endp - obuf->extp; + ASSERT(ctx->obuf->extp < ctx->obuf->ext_endp); + ASSERT(&ctx->obuf->data[0] <= ctx->obuf->extp - ctx->pass_through_size); + ASSERT(ctx->obuf->ext_endp <= &ctx->obuf->data[0] + ctx->data_size); - /* - * Signal encoded; now verify that the connection still exists, - * and if so enqueue the signal and schedule it for send. - */ - obuf->next = NULL; - erts_smp_de_rlock(dep); - cid = dep->cid; - if (cid != dsdp->cid - || dep->connection_id != dsdp->connection_id - || dep->status & ERTS_DE_SFLG_EXITING) { - /* Not the same connection as when we started; drop message... */ - erts_smp_de_runlock(dep); - free_dist_obuf(obuf); - } - else { - ErtsProcList *plp = NULL; - erts_smp_mtx_lock(&dep->qlock); - dep->qsize += size_obuf(obuf); - if (dep->qsize >= erts_dist_buf_busy_limit) - dep->qflgs |= ERTS_DE_QFLG_BUSY; - if (!force_busy && (dep->qflgs & ERTS_DE_QFLG_BUSY)) { - erts_smp_mtx_unlock(&dep->qlock); + ctx->data_size = ctx->obuf->ext_endp - ctx->obuf->extp; - plp = erts_proclist_create(c_p); - erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); - suspended = 1; - erts_smp_mtx_lock(&dep->qlock); - } + /* + * Signal encoded; now verify that the connection still exists, + * and if so enqueue the signal and schedule it for send. + */ + ctx->obuf->next = NULL; + erts_smp_de_rlock(dep); + cid = dep->cid; + if (cid != dsdp->cid + || dep->connection_id != dsdp->connection_id + || dep->status & ERTS_DE_SFLG_EXITING) { + /* Not the same connection as when we started; drop message... */ + erts_smp_de_runlock(dep); + free_dist_obuf(ctx->obuf); + } + else { + ErtsProcList *plp = NULL; + erts_smp_mtx_lock(&dep->qlock); + dep->qsize += size_obuf(ctx->obuf); + if (dep->qsize >= erts_dist_buf_busy_limit) + dep->qflgs |= ERTS_DE_QFLG_BUSY; + if (!ctx->force_busy && (dep->qflgs & ERTS_DE_QFLG_BUSY)) { + erts_smp_mtx_unlock(&dep->qlock); + + plp = erts_proclist_create(ctx->c_p); + erts_suspend(ctx->c_p, ERTS_PROC_LOCK_MAIN, NULL); + suspended = 1; + erts_smp_mtx_lock(&dep->qlock); + } - /* Enqueue obuf on dist entry */ - if (dep->out_queue.last) - dep->out_queue.last->next = obuf; - else - dep->out_queue.first = obuf; - dep->out_queue.last = obuf; + /* Enqueue obuf on dist entry */ + if (dep->out_queue.last) + dep->out_queue.last->next = ctx->obuf; + else + dep->out_queue.first = ctx->obuf; + dep->out_queue.last = ctx->obuf; + + if (!ctx->force_busy) { + if (!(dep->qflgs & ERTS_DE_QFLG_BUSY)) { + if (suspended) + resume = 1; /* was busy when we started, but isn't now */ + #ifdef USE_VM_PROBES + if (resume && DTRACE_ENABLED(dist_port_not_busy)) { + DTRACE_CHARBUF(port_str, 64); + DTRACE_CHARBUF(remote_str, 64); + + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), + "%T", cid); + erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)), + "%T", dep->sysname); + DTRACE3(dist_port_not_busy, erts_this_node_sysname, + port_str, remote_str); + } + #endif + } + else { + /* Enqueue suspended process on dist entry */ + ASSERT(plp); + erts_proclist_store_last(&dep->suspended, plp); + } + } - if (!force_busy) { - if (!(dep->qflgs & ERTS_DE_QFLG_BUSY)) { - if (suspended) - resume = 1; /* was busy when we started, but isn't now */ -#ifdef USE_VM_PROBES - if (resume && DTRACE_ENABLED(dist_port_not_busy)) { - DTRACE_CHARBUF(port_str, 64); - DTRACE_CHARBUF(remote_str, 64); - - erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), - "%T", cid); - erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)), - "%T", dep->sysname); - DTRACE3(dist_port_not_busy, erts_this_node_sysname, - port_str, remote_str); - } -#endif + erts_smp_mtx_unlock(&dep->qlock); + erts_schedule_dist_command(NULL, dep); + erts_smp_de_runlock(dep); + + if (resume) { + erts_resume(ctx->c_p, ERTS_PROC_LOCK_MAIN); + erts_proclist_destroy(plp); + /* + * Note that the calling process still have to yield as if it + * suspended. If not, the calling process could later be + * erroneously scheduled when it shouldn't be. + */ + } } - else { - /* Enqueue suspended process on dist entry */ - ASSERT(plp); - erts_proclist_store_last(&dep->suspended, plp); + ctx->obuf = NULL; + + if (suspended) { + #ifdef USE_VM_PROBES + if (!resume && DTRACE_ENABLED(dist_port_busy)) { + DTRACE_CHARBUF(port_str, 64); + DTRACE_CHARBUF(remote_str, 64); + DTRACE_CHARBUF(pid_str, 16); + + erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", cid); + erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)), + "%T", dep->sysname); + erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), + "%T", ctx->c_p->common.id); + DTRACE4(dist_port_busy, erts_this_node_sysname, + port_str, remote_str, pid_str); + } + #endif + if (!resume && erts_system_monitor_flags.busy_dist_port) + monitor_generic(ctx->c_p, am_busy_dist_port, cid); + retval = ERTS_DSIG_SEND_YIELD; + } else { + retval = ERTS_DSIG_SEND_OK; } + goto done; } - - erts_smp_mtx_unlock(&dep->qlock); - erts_schedule_dist_command(NULL, dep); - erts_smp_de_runlock(dep); - - if (resume) { - erts_resume(c_p, ERTS_PROC_LOCK_MAIN); - erts_proclist_destroy(plp); - /* - * Note that the calling process still have to yield as if it - * suspended. If not, the calling process could later be - * erroneously scheduled when it shouldn't be. - */ + default: + erl_exit(ERTS_ABORT_EXIT, "dsig_send invalid phase (%d)\n", (int)ctx->phase); } } - if (c_p) { - int reds; - /* - * Bump reductions on calling process. - * - * This is the reduction cost: Always a base cost of 8 reductions - * plus 16 reductions per kilobyte generated external data. - */ - - data_size >>= (10-4); -#if defined(ARCH_64) && !HALFWORD_HEAP - data_size &= 0x003fffffffffffff; -#elif defined(ARCH_32) || HALFWORD_HEAP - data_size &= 0x003fffff; -#else -# error "Ohh come on ... !?!" -#endif - reds = 8 + ((int) data_size > 1000000 ? 1000000 : (int) data_size); - BUMP_REDS(c_p, reds); - } - - if (suspended) { -#ifdef USE_VM_PROBES - if (!resume && DTRACE_ENABLED(dist_port_busy)) { - DTRACE_CHARBUF(port_str, 64); - DTRACE_CHARBUF(remote_str, 64); - DTRACE_CHARBUF(pid_str, 16); - - erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", cid); - erts_snprintf(remote_str, sizeof(DTRACE_CHARBUF_NAME(remote_str)), - "%T", dep->sysname); - erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), - "%T", c_p->common.id); - DTRACE4(dist_port_busy, erts_this_node_sysname, - port_str, remote_str, pid_str); - } -#endif - if (!resume && erts_system_monitor_flags.busy_dist_port) - monitor_generic(c_p, am_busy_dist_port, cid); - return ERTS_DSIG_SEND_YIELD; +done: + if (ctx->msg && ctx->c_p) { + BUMP_REDS(ctx->c_p, (initial_reds - ctx->reds) / TERM_TO_BINARY_LOOP_FACTOR); } - return ERTS_DSIG_SEND_OK; + return retval; } - static Uint dist_port_command(Port *prt, ErtsDistOutputBuf *obuf) { diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index f32b999198..2a2ba0c83f 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -22,6 +22,7 @@ #include "erl_process.h" #include "erl_node_tables.h" +#include "zlib.h" #define DFLAG_PUBLISHED 0x01 #define DFLAG_ATOM_CACHE 0x02 @@ -264,17 +265,105 @@ erts_destroy_dist_link(ErtsDistLinkData *dldp) #endif + + +/* Define for testing */ +/* #define EXTREME_TTB_TRAPPING 1 */ + +#ifndef EXTREME_TTB_TRAPPING +#define TERM_TO_BINARY_LOOP_FACTOR 32 +#else +#define TERM_TO_BINARY_LOOP_FACTOR 1 +#endif + +typedef enum { TTBSize, TTBEncode, TTBCompress } TTBState; +typedef struct TTBSizeContext_ { + Uint flags; + int level; + Uint result; + Eterm obj; + ErtsEStack estack; +} TTBSizeContext; + +typedef struct TTBEncodeContext_ { + Uint flags; + int level; + byte* ep; + Eterm obj; + ErtsWStack wstack; + Binary *result_bin; +} TTBEncodeContext; + +typedef struct { + Uint real_size; + Uint dest_len; + byte *dbytes; + Binary *result_bin; + Binary *destination_bin; + z_stream stream; +} TTBCompressContext; + +typedef struct { + int alive; + TTBState state; + union { + TTBSizeContext sc; + TTBEncodeContext ec; + TTBCompressContext cc; + } s; +} TTBContext; + +enum erts_dsig_send_phase { + ERTS_DSIG_SEND_PHASE_INIT, + ERTS_DSIG_SEND_PHASE_MSG_SIZE, + ERTS_DSIG_SEND_PHASE_ALLOC, + ERTS_DSIG_SEND_PHASE_MSG_ENCODE, + ERTS_DSIG_SEND_PHASE_FIN +}; + +struct erts_dsig_send_context { + enum erts_dsig_send_phase phase; + Sint reds; + + Eterm ctl; + Eterm msg; + int force_busy; + Uint32 pass_through_size; + Uint data_size, dhdr_ext_size; + ErtsAtomCacheMap *acmp; + ErtsDistOutputBuf *obuf; + Uint32 flags; + Process *c_p; + union { + TTBSizeContext sc; + TTBEncodeContext ec; + }u; +}; + +typedef struct { + int suspend; + + Eterm ctl_heap[6]; + ErtsDSigData dsd; + DistEntry* dep_to_deref; + struct erts_dsig_send_context dss; + + Eterm return_term; +}ErtsSendContext; + + /* * erts_dsig_send_* return values. */ #define ERTS_DSIG_SEND_OK 0 #define ERTS_DSIG_SEND_YIELD 1 +#define ERTS_DSIG_SEND_CONTINUE 2 extern int erts_dsig_send_link(ErtsDSigData *, Eterm, Eterm); -extern int erts_dsig_send_msg(ErtsDSigData *, Eterm, Eterm); +extern int erts_dsig_send_msg(Eterm, Eterm, ErtsSendContext*); extern int erts_dsig_send_exit_tt(ErtsDSigData *, Eterm, Eterm, Eterm, Eterm); extern int erts_dsig_send_unlink(ErtsDSigData *, Eterm, Eterm); -extern int erts_dsig_send_reg_msg(ErtsDSigData *, Eterm, Eterm); +extern int erts_dsig_send_reg_msg(Eterm, Eterm, ErtsSendContext*); extern int erts_dsig_send_group_leader(ErtsDSigData *, Eterm, Eterm); extern int erts_dsig_send_exit(ErtsDSigData *, Eterm, Eterm, Eterm); extern int erts_dsig_send_exit2(ErtsDSigData *, Eterm, Eterm, Eterm); @@ -282,6 +371,10 @@ extern int erts_dsig_send_demonitor(ErtsDSigData *, Eterm, Eterm, Eterm, int); extern int erts_dsig_send_monitor(ErtsDSigData *, Eterm, Eterm, Eterm); extern int erts_dsig_send_m_exit(ErtsDSigData *, Eterm, Eterm, Eterm, Eterm); +extern int erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx); +extern void erts_dsend_context_dtor(Binary*); +extern Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx); + extern int erts_dist_command(Port *prt, int reds); extern void erts_dist_port_not_busy(Port *prt); extern void erts_kill_dist_connection(DistEntry *dep, Uint32); diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 21434eb117..61def65235 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -415,6 +415,8 @@ type CS_PROG_PATH LONG_LIVED SYSTEM cs_prog_path type ENVIRONMENT TEMPORARY SYSTEM environment type PUTENV_STR SYSTEM SYSTEM putenv_string type PRT_REP_EXIT STANDARD SYSTEM port_report_exit +type SYS_BLOCKING STANDARD SYSTEM sys_blocking +type SYS_WRITE_BUF TEMPORARY SYSTEM sys_write_buf +endif diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 3bf78adce7..bd0d7c71cc 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -32,7 +32,9 @@ #include "global.h" #include "erl_process.h" #include "error.h" +#define ERL_WANT_HIPE_BIF_WRAPPER__ #include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ #include "big.h" #include "erl_binary.h" #include "erl_bits.h" @@ -2424,8 +2426,6 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en) } cbs->result = erts_bin_nrml_alloc(target_size); /* Always offheap if trapping */ - cbs->result->flags = 0; - cbs->result->orig_size = target_size; erts_refc_init(&(cbs->result->refc), 1); t = (byte *) cbs->result->orig_bytes; /* No offset or anything */ pos = 0; diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index b90362d82c..d2ee5e4224 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -116,6 +116,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE #ifdef ERTS_ENABLE_LOCK_COUNT " [lock-counting]" #endif +#ifdef ERTS_OPCODE_COUNTER_SUPPORT + " [instruction-counting]" +#endif #ifdef PURIFY " [purify-compiled]" #endif @@ -2301,7 +2304,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) for (i = num_instructions-1; i >= 0; i--) { res = erts_bld_cons(hpp, hszp, erts_bld_tuple(hpp, hszp, 2, - erts_atom_put(opc[i].name, + erts_atom_put((byte *)opc[i].name, strlen(opc[i].name), ERTS_ATOM_ENC_LATIN1, 1), diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index 06dfeb1260..8d264d166e 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -231,41 +231,58 @@ erts_free_aligned_binary_bytes(byte* buf) # define CHICKEN_PAD (sizeof(void*) - 1) #endif +/* Caller must initialize 'refc' +*/ ERTS_GLB_INLINE Binary * erts_bin_drv_alloc_fnf(Uint size) { Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; - void *res; + Binary *res; + if (bsize < size) /* overflow */ return NULL; res = erts_alloc_fnf(ERTS_ALC_T_DRV_BINARY, bsize); ERTS_CHK_BIN_ALIGNMENT(res); - return (Binary *) res; + if (res) { + res->orig_size = size; + res->flags = BIN_FLAG_DRV; + } + return res; } +/* Caller must initialize 'refc' +*/ ERTS_GLB_INLINE Binary * erts_bin_drv_alloc(Uint size) { Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; - void *res; + Binary *res; + if (bsize < size) /* overflow */ erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, size); res = erts_alloc(ERTS_ALC_T_DRV_BINARY, bsize); ERTS_CHK_BIN_ALIGNMENT(res); - return (Binary *) res; + res->orig_size = size; + res->flags = BIN_FLAG_DRV; + return res; } +/* Caller must initialize 'refc' +*/ ERTS_GLB_INLINE Binary * erts_bin_nrml_alloc(Uint size) { Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; - void *res; + Binary *res; + if (bsize < size) /* overflow */ erts_alloc_enomem(ERTS_ALC_T_BINARY, size); res = erts_alloc(ERTS_ALC_T_BINARY, bsize); ERTS_CHK_BIN_ALIGNMENT(res); - return (Binary *) res; + res->orig_size = size; + res->flags = 0; + return res; } ERTS_GLB_INLINE Binary * @@ -280,6 +297,8 @@ erts_bin_realloc_fnf(Binary *bp, Uint size) return NULL; nbp = erts_realloc_fnf(type, (void *) bp, bsize); ERTS_CHK_BIN_ALIGNMENT(nbp); + if (nbp) + nbp->orig_size = size; return nbp; } @@ -297,6 +316,7 @@ erts_bin_realloc(Binary *bp, Uint size) if (!nbp) erts_realloc_enomem(type, bp, bsize); ERTS_CHK_BIN_ALIGNMENT(nbp); + nbp->orig_size = size; return nbp; } @@ -329,4 +349,4 @@ erts_create_magic_binary(Uint size, void (*destructor)(Binary *)) #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ -#endif +#endif /* !__ERL_BINARY_H */ diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 73765772c8..71d31c01aa 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -1299,7 +1299,6 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term, if (binp->orig_size < pb->size) { Uint new_size = 2*pb->size; binp = erts_bin_realloc(binp, new_size); - binp->orig_size = new_size; pb->val = binp; pb->bytes = (byte *) binp->orig_bytes; } @@ -1371,8 +1370,6 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term, * Allocate the binary data struct itself. */ bptr = erts_bin_nrml_alloc(bin_size); - bptr->flags = 0; - bptr->orig_size = bin_size; erts_refc_init(&bptr->refc, 1); erts_current_bin = (byte *) bptr->orig_bytes; @@ -1475,7 +1472,6 @@ erts_bs_private_append(Process* p, Eterm bin, Eterm build_size_term, Uint unit) * is safe to reallocate it. */ binp = erts_bin_realloc(binp, new_size); - binp->orig_size = new_size; pb->val = binp; pb->bytes = (byte *) binp->orig_bytes; } else { @@ -1488,8 +1484,6 @@ erts_bs_private_append(Process* p, Eterm bin, Eterm build_size_term, Uint unit) * binary and copy the contents of the old binary into it. */ Binary* bptr = erts_bin_nrml_alloc(new_size); - bptr->flags = 0; - bptr->orig_size = new_size; erts_refc_init(&bptr->refc, 1); sys_memcpy(bptr->orig_bytes, binp->orig_bytes, binp->orig_size); pb->flags |= PB_IS_WRITABLE | PB_ACTIVE_WRITER; @@ -1537,8 +1531,6 @@ erts_bs_init_writable(Process* p, Eterm sz) * Allocate the binary data struct itself. */ bptr = erts_bin_nrml_alloc(bin_size); - bptr->flags = 0; - bptr->orig_size = bin_size; erts_refc_init(&bptr->refc, 1); /* @@ -1585,9 +1577,7 @@ erts_emasculate_writable_binary(ProcBin* pb) /* Our allocators are 8 byte aligned, i.e., shrinking with less than 8 bytes will have no real effect */ if (unused >= 8) { - Uint new_size = pb->size; binp = erts_bin_realloc(binp, pb->size); - binp->orig_size = new_size; pb->val = binp; pb->bytes = (byte *) binp->orig_bytes; } diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h index 908cec11d4..e68081a5b1 100644 --- a/erts/emulator/beam/erl_db_hash.h +++ b/erts/emulator/beam/erl_db_hash.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. All Rights Reserved. + * Copyright Ericsson AB 1998-2014. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -42,7 +42,7 @@ typedef struct hash_db_term { typedef struct db_table_hash_fine_locks { union { erts_smp_rwmtx_t lck; - byte _cache_line_alignment[64]; + byte _cache_line_alignment[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_smp_rwmtx_t))]; }lck_vec[DB_HASH_LOCK_CNT]; } DbTableHashFineLocks; diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 3927615e04..b9fd3b208e 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -198,11 +198,6 @@ set_match_trace(Process *tracee_p, Eterm fail_term, Eterm tracer, return ret; } - -/* Type checking... */ - -#define BOXED_IS_TUPLE(Boxed) is_arity_value(*boxed_val((Boxed))) - /* ** ** Types and enum's (compiled matches) @@ -218,6 +213,8 @@ typedef enum { matchTuple, matchPushT, matchPushL, + matchPushM, + matchPushK, matchPop, matchBind, matchCmp, @@ -227,11 +224,13 @@ typedef enum { matchEqRef, matchEq, matchList, + matchMap, matchSkip, matchPushC, matchConsA, /* Car is below Cdr */ matchConsB, /* Cdr is below Car (unusual) */ matchMkTuple, + matchMkMap, matchCall0, matchCall1, matchCall2, @@ -856,6 +855,13 @@ static int match_compact(ErlHeapFragment *expr, DMCErrInfo *err_info); static Uint my_size_object(Eterm t); static Eterm my_copy_struct(Eterm t, Eterm **hp, ErlOffHeap* off_heap); +/* Guard subroutines */ +static void +dmc_rearrange_constants(DMCContext *context, DMC_STACK_TYPE(UWord) *text, + int textpos, Eterm *p, Uint nelems); +static DMCRet +dmc_array(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, + Eterm *p, Uint nelems, int *constant); /* Guard compilation */ static void do_emit_constant(DMCContext *context, DMC_STACK_TYPE(UWord) *text, Eterm t); @@ -869,6 +875,9 @@ static DMCRet dmc_tuple(DMCContext *context, DMC_STACK_TYPE(UWord) *text, Eterm t, int *constant); +static DMCRet +dmc_map(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, + Eterm t, int *constant); static DMCRet dmc_variable(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, @@ -888,12 +897,14 @@ static DMCRet compile_guard_expr(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, Eterm t); -/* match expression subroutine */ +/* match expression subroutines */ static DMCRet dmc_one_term(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(Eterm) *stack, DMC_STACK_TYPE(UWord) *text, Eterm c); +static Eterm +dmc_private_copy(DMCContext *context, Eterm c); #ifdef DMC_DEBUG @@ -1364,7 +1375,51 @@ restart: for (;;) { switch (t & _TAG_PRIMARY_MASK) { case TAG_PRIMARY_BOXED: - if (!BOXED_IS_TUPLE(t)) { + if (is_map(t)) { + num_iters = map_get_size(map_val(t)); + if (!structure_checked) { + DMC_PUSH(text, matchMap); + DMC_PUSH(text, num_iters); + } + structure_checked = 0; + for (i = 0; i < num_iters; ++i) { + Eterm key = map_get_keys(map_val(t))[i]; + if (db_is_variable(key) >= 0) { + if (context.err_info) { + add_dmc_err(context.err_info, + "Variable found in map key.", + -1, 0UL, dmcError); + } + goto error; + } else if (key == am_Underscore) { + if (context.err_info) { + add_dmc_err(context.err_info, + "Underscore found in map key.", + -1, 0UL, dmcError); + } + goto error; + } + DMC_PUSH(text, matchPushK); + ++(context.stack_used); + DMC_PUSH(text, dmc_private_copy(&context, key)); + } + if (context.stack_used > context.stack_need) { + context.stack_need = context.stack_used; + } + for (i = num_iters; i--; ) { + Eterm value = map_get_values(map_val(t))[i]; + DMC_PUSH(text, matchPop); + --(context.stack_used); + res = dmc_one_term(&context, &heap, &stack, &text, + value); + ASSERT(res != retFail); + if (res == retRestart) { + goto restart; + } + } + break; + } + if (!is_tuple(t)) { goto simple_term; } num_iters = arityval(*tuple_val(t)); @@ -1715,10 +1770,8 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, Uint32 *return_flags) { MatchProg *prog = Binary2MatchProg(bprog); - Eterm *ep; - Eterm *tp; + const Eterm *ep, *tp, **sp; Eterm t; - Eterm **sp; Eterm *esp; MatchVariable* variables; BeamInstr *cp; @@ -1808,7 +1861,7 @@ Eterm db_prog_match(Process *c_p, Binary *bprog, restart: ep = &term; esp = (Eterm*)((char*)mpsp->u.heap + prog->stack_offset); - sp = (Eterm **) esp; + sp = (const Eterm **)esp; ret = am_true; do_catch = 0; fail_label = -1; @@ -1887,6 +1940,34 @@ restart: *sp++ = list_val_rel(*ep,base); ++ep; break; + case matchMap: + if (!is_map_rel(*ep, base)) { + FAIL(); + } + n = *pc++; + if (map_get_size(map_val_rel(*ep, base)) < n) { + FAIL(); + } + ep = map_val_rel(*ep, base); + break; + case matchPushM: + if (!is_map_rel(*ep, base)) { + FAIL(); + } + n = *pc++; + if (map_get_size(map_val_rel(*ep, base)) < n) { + FAIL(); + } + *sp++ = map_val_rel(*ep++, base); + break; + case matchPushK: + t = (Eterm) *pc++; + tp = erts_maps_get_rel(t, make_map_rel(ep, base), base); + if (!tp) { + FAIL(); + } + *sp++ = tp; + break; case matchPop: ep = *(--sp); break; @@ -1987,6 +2068,23 @@ restart: } *esp++ = t; break; + case matchMkMap: + n = *pc++; + ehp = HAllocX(build_proc, 1 + MAP_HEADER_SIZE + n, HEAP_XTRA); + t = *ehp++ = *--esp; + { + map_t *m = (map_t *)ehp; + m->thing_word = MAP_HEADER; + m->size = n; + m->keys = t; + } + t = make_map(ehp); + ehp += MAP_HEADER_SIZE; + while (n--) { + *ehp++ = *--esp; + } + *esp++ = t; + break; case matchCall0: bif = (Eterm (*)(Process*, ...)) *pc++; t = (*bif)(build_proc, bif_args); @@ -3168,7 +3266,7 @@ int db_has_variable(Eterm obj) return(db_has_variable(obj)); /* Non wellformed list or [] */ } case TAG_PRIMARY_BOXED: - if (!BOXED_IS_TUPLE(obj)) { + if (!is_tuple(obj)) { return 0; } else { Eterm *tuple = tuple_val(obj); @@ -3243,7 +3341,6 @@ static DMCRet dmc_one_term(DMCContext *context, { Sint n; Eterm *hp; - ErlHeapFragment *tmp_mb; Uint sz, sz2, sz3; Uint i, j; @@ -3334,6 +3431,13 @@ static DMCRet dmc_one_term(DMCContext *context, DMC_PUSH(*text, n); DMC_PUSH(*stack, c); break; + case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE): + n = map_get_size(map_val(c)); + DMC_PUSH(*text, matchPushM); + ++(context->stack_used); + DMC_PUSH(*text, n); + DMC_PUSH(*stack, c); + break; case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): { Eterm* ref_val = internal_ref_val(c); @@ -3415,16 +3519,8 @@ static DMCRet dmc_one_term(DMCContext *context, #endif break; default: /* BINARY, FUN, VECTOR, or EXTERNAL */ - /* - ** Make a private copy... - */ - n = size_object(c); - tmp_mb = new_message_buffer(n); - hp = tmp_mb->mem; DMC_PUSH(*text, matchEqBin); - DMC_PUSH(*text, copy_struct(c, n, &hp, &(tmp_mb->off_heap))); - tmp_mb->next = context->save; - context->save = tmp_mb; + DMC_PUSH(*text, dmc_private_copy(context, c)); break; } break; @@ -3437,6 +3533,22 @@ static DMCRet dmc_one_term(DMCContext *context, } /* +** Make a private copy of a term in a context. +*/ + +static Eterm +dmc_private_copy(DMCContext *context, Eterm c) +{ + Uint n = size_object(c); + ErlHeapFragment *tmp_mb = new_message_buffer(n); + Eterm *hp = tmp_mb->mem; + Eterm copy = copy_struct(c, n, &hp, &(tmp_mb->off_heap)); + tmp_mb->next = context->save; + context->save = tmp_mb; + return copy; +} + +/* ** Match guard compilation */ @@ -3527,57 +3639,78 @@ static DMCRet dmc_list(DMCContext *context, return retOk; } -static DMCRet dmc_tuple(DMCContext *context, - DMCHeap *heap, - DMC_STACK_TYPE(UWord) *text, - Eterm t, - int *constant) +static void +dmc_rearrange_constants(DMCContext *context, DMC_STACK_TYPE(UWord) *text, + int textpos, Eterm *p, Uint nelems) { DMC_STACK_TYPE(UWord) instr_save; + Uint i; + + DMC_INIT_STACK(instr_save); + while (DMC_STACK_NUM(*text) > textpos) { + DMC_PUSH(instr_save, DMC_POP(*text)); + } + for (i = nelems; i--;) { + do_emit_constant(context, text, p[i]); + } + while(!DMC_EMPTY(instr_save)) { + DMC_PUSH(*text, DMC_POP(instr_save)); + } + DMC_FREE(instr_save); +} + +static DMCRet +dmc_array(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, + Eterm *p, Uint nelems, int *constant) +{ int all_constant = 1; int textpos = DMC_STACK_NUM(*text); - Eterm *p = tuple_val(t); - Uint nelems = arityval(*p); Uint i; - int c; - DMCRet ret; /* - ** We remember where we started to layout code, + ** We remember where we started to layout code, ** assume all is constant and back up and restart if not so. - ** The tuple should be laid out with the last element first, - ** so we can memcpy the tuple to the eheap. + ** The array should be laid out with the last element first, + ** so we can memcpy it to the eheap. */ - for (i = nelems; i > 0; --i) { - if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk) - return ret; - if (!c && all_constant) { - all_constant = 0; - if (i < nelems) { - Uint j; + for (i = nelems; i--;) { + DMCRet ret; + int c; - /* - * Oops, we need to relayout the constants. - * Save the already laid out instructions. - */ - DMC_INIT_STACK(instr_save); - while (DMC_STACK_NUM(*text) > textpos) - DMC_PUSH(instr_save, DMC_POP(*text)); - for (j = nelems; j > i; --j) - do_emit_constant(context, text, p[j]); - while(!DMC_EMPTY(instr_save)) - DMC_PUSH(*text, DMC_POP(instr_save)); - DMC_FREE(instr_save); - } - } else if (c && !all_constant) { - /* push a constant */ - do_emit_constant(context, text, p[i]); - } + ret = dmc_expr(context, heap, text, p[i], &c); + if (ret != retOk) { + return ret; + } + if (!c && all_constant) { + all_constant = 0; + if (i < nelems - 1) { + dmc_rearrange_constants(context, text, textpos, + p + i + 1, nelems - i - 1); + } + } else if (c && !all_constant) { + do_emit_constant(context, text, p[i]); + } + } + *constant = all_constant; + return retOk; +} + +static DMCRet +dmc_tuple(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, + Eterm t, int *constant) +{ + int all_constant; + Eterm *p = tuple_val(t); + Uint nelems = arityval(*p); + DMCRet ret; + + ret = dmc_array(context, heap, text, p + 1, nelems, &all_constant); + if (ret != retOk) { + return ret; } - if (all_constant) { - *constant = 1; - return retOk; + *constant = 1; + return retOk; } DMC_PUSH(*text, matchMkTuple); DMC_PUSH(*text, nelems); @@ -3586,6 +3719,36 @@ static DMCRet dmc_tuple(DMCContext *context, return retOk; } +static DMCRet +dmc_map(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, + Eterm t, int *constant) +{ + map_t *m = (map_t *)map_val(t); + Eterm *values = map_get_values(m); + int nelems = map_get_size(m); + int constant_values; + DMCRet ret; + + ret = dmc_array(context, heap, text, values, nelems, &constant_values); + if (ret != retOk) { + return ret; + } + if (constant_values) { + *constant = 1; + return retOk; + } + DMC_PUSH(*text, matchPushC); + DMC_PUSH(*text, dmc_private_copy(context, m->keys)); + if (++context->stack_used > context->stack_need) { + context->stack_need = context->stack_used; + } + DMC_PUSH(*text, matchMkMap); + DMC_PUSH(*text, nelems); + context->stack_used -= nelems; + *constant = 0; + return retOk; +} + static DMCRet dmc_whole_expression(DMCContext *context, DMCHeap *heap, DMC_STACK_TYPE(UWord) *text, @@ -4580,7 +4743,10 @@ static DMCRet dmc_expr(DMCContext *context, return ret; break; case TAG_PRIMARY_BOXED: - if (!BOXED_IS_TUPLE(t)) { + if (is_map(t)) { + return dmc_map(context, heap, text, t, constant); + } + if (!is_tuple(t)) { goto simple_term; } p = tuple_val(t); @@ -4855,7 +5021,7 @@ static Eterm my_copy_struct(Eterm t, Eterm **hp, ErlOffHeap* off_heap) *hp += 2; break; case TAG_PRIMARY_BOXED: - if (BOXED_IS_TUPLE(t)) { + if (is_tuple(t)) { if (arityval(*tuple_val(t)) == 1 && is_tuple(a = tuple_val(t)[1])) { Uint i,n; @@ -5126,6 +5292,12 @@ void db_match_dis(Binary *bp) ++t; erts_printf("Tuple\t%beu\n", n); break; + case matchMap: + ++t; + n = *t; + ++t; + erts_printf("Map\t%beu\n", n); + break; case matchPushT: ++t; n = *t; @@ -5136,6 +5308,18 @@ void db_match_dis(Binary *bp) ++t; erts_printf("PushL\n"); break; + case matchPushM: + ++t; + n = *t; + ++t; + erts_printf("PushM\t%beu\n", n); + break; + case matchPushK: + ++t; + p = (Eterm) *t; + ++t; + erts_printf("PushK\t%p (%T)\n", t, p); + break; case matchPop: ++t; erts_printf("Pop\n"); @@ -5252,6 +5436,12 @@ void db_match_dis(Binary *bp) ++t; erts_printf("MkTuple\t%beu\n", n); break; + case matchMkMap: + ++t; + n = *t; + ++t; + erts_printf("MkMapA\t%beu\n", n); + break; case matchOr: ++t; n = *t; diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 0db42d4325..5f78a7b532 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -20,6 +20,8 @@ # include "config.h" #endif +#define ERL_WANT_GC_INTERNALS__ + #include "sys.h" #include "erl_vm.h" #include "global.h" @@ -2400,7 +2402,6 @@ sweep_off_heap(Process *p, int fullsweep) } pb->val = erts_bin_realloc(pb->val, new_size); - pb->val->orig_size = new_size; pb->bytes = (byte *) pb->val->orig_bytes; } } diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h index 5203dda263..bf0496c112 100644 --- a/erts/emulator/beam/erl_gc.h +++ b/erts/emulator/beam/erl_gc.h @@ -20,10 +20,12 @@ #ifndef __ERL_GC_H__ #define __ERL_GC_H__ -#include "erl_map.h" +#if defined(ERL_WANT_GC_INTERNALS__) || defined(ERTS_DO_INCL_GLB_INLINE_FUNC_DEF) /* GC declarations shared by beam/erl_gc.c and hipe/hipe_gc.c */ +#include "erl_map.h" + #if defined(DEBUG) && !ERTS_GLB_INLINE_INCL_FUNC_DEF # define HARDDEBUG 1 #endif @@ -67,8 +69,6 @@ do { \ #define in_area(ptr,start,nbytes) \ ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes)) -extern Uint erts_test_long_gc_sleep; - #if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG) int within(Eterm *ptr, Process *p); #endif @@ -97,4 +97,33 @@ ERTS_GLB_INLINE Eterm follow_moved(Eterm term) } #endif +#endif /* ERL_GC_C__ || HIPE_GC_C__ */ + +/* + * Global exported + */ + +extern Uint erts_test_long_gc_sleep; + +typedef struct { + Uint64 reclaimed; + Uint64 garbage_cols; +} ErtsGCInfo; + +void erts_gc_info(ErtsGCInfo *gcip); +void erts_init_gc(void); +int erts_garbage_collect(struct process*, int, Eterm*, int); +void erts_garbage_collect_hibernate(struct process* p); +Eterm erts_gc_after_bif_call(struct process* p, Eterm result, Eterm* regs, Uint arity); +void erts_garbage_collect_literals(struct process* p, Eterm* literals, + Uint lit_size, + struct erl_off_heap_header* oh); +Uint erts_next_heap_size(Uint, Uint); +Eterm erts_heap_sizes(struct process* p); + +void erts_offset_off_heap(struct erl_off_heap*, Sint, Eterm*, Eterm*); +void erts_offset_heap_ptr(Eterm*, Uint, Sint, Eterm*, Eterm*); +void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*); +void erts_free_heap_frags(struct process* p); + #endif /* __ERL_GC_H__ */ diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 61f8385efc..77445ef1ff 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -161,9 +161,6 @@ int H_MIN_SIZE; /* The minimum heap grain */ int BIN_VH_MIN_SIZE; /* The minimum binary virtual*/ Uint32 erts_debug_flags; /* Debug flags. */ -#ifdef ERTS_OPCODE_COUNTER_SUPPORT -int count_instructions; -#endif int erts_backtrace_depth; /* How many functions to show in a backtrace * in error codes. */ @@ -1900,11 +1897,6 @@ erl_start(int argc, char **argv) if (argv[i][2] == 0) { /* -c: documented option */ erts_disable_tolerant_timeofday = 1; } -#ifdef ERTS_OPCODE_COUNTER_SUPPORT - else if (argv[i][2] == 'i') { /* -ci: undcoumented option*/ - count_instructions = 1; - } -#endif break; case 'W': arg = get_arg(argv[i]+2, argv[i+1], &i); diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index 5e740aacdd..b2a16eb5ed 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -113,36 +113,55 @@ BIF_RETTYPE maps_to_list_1(BIF_ALIST_1) { * return value if key *matches* a key in the map */ -int erts_maps_find(Eterm key, Eterm map, Eterm *value) { - - Eterm *ks,*vs; +const Eterm * +#if HALFWORD_HEAP +erts_maps_get_rel(Eterm key, Eterm map, Eterm *map_base) +#else +erts_maps_get(Eterm key, Eterm map) +#endif +{ + Eterm *ks, *vs; map_t *mp; - Uint n,i; + Uint n, i; - mp = (map_t*)map_val(map); + mp = (map_t *)map_val_rel(map, map_base); n = map_get_size(mp); - ks = map_get_keys(mp); + + if (n == 0) { + return NULL; + } + + ks = (Eterm *)tuple_val_rel(mp->keys, map_base) + 1; vs = map_get_values(mp); - for( i = 0; i < n; i++) { - if (EQ(ks[i], key)) { - *value = vs[i]; - return 1; - } + if (is_immed(key)) { + for (i = 0; i < n; i++) { + if (ks[i] == key) { + return &vs[i]; + } + } + } + + for (i = 0; i < n; i++) { + if (eq_rel(ks[i], NULL, key, map_base)) { + return &vs[i]; + } } - return 0; + return NULL; } BIF_RETTYPE maps_find_2(BIF_ALIST_2) { if (is_map(BIF_ARG_2)) { - Eterm *hp, value,res; + Eterm *hp, res; + const Eterm *value; - if (erts_maps_find(BIF_ARG_1, BIF_ARG_2, &value)) { + value = erts_maps_get(BIF_ARG_1, BIF_ARG_2); + if (value) { hp = HAlloc(BIF_P, 3); res = make_tuple(hp); *hp++ = make_arityval(2); *hp++ = am_ok; - *hp++ = value; + *hp++ = *value; BIF_RET(res); } @@ -150,52 +169,22 @@ BIF_RETTYPE maps_find_2(BIF_ALIST_2) { } BIF_ERROR(BIF_P, BADARG); } + /* maps:get/2 * return value if key *matches* a key in the map * exception bad_key if none matches */ - -int erts_maps_get(Eterm key, Eterm map, Eterm *value) { - Eterm *ks,*vs; - map_t *mp; - Uint n,i; - - mp = (map_t*)map_val(map); - n = map_get_size(mp); - - if (n == 0) - return 0; - - ks = map_get_keys(mp); - vs = map_get_values(mp); - - if (is_immed(key)) { - for( i = 0; i < n; i++) { - if (ks[i] == key) { - *value = vs[i]; - return 1; - } - } - } - - for( i = 0; i < n; i++) { - if (EQ(ks[i], key)) { - *value = vs[i]; - return 1; - } - } - return 0; -} - BIF_RETTYPE maps_get_2(BIF_ALIST_2) { if (is_map(BIF_ARG_2)) { Eterm *hp; - Eterm value, error; + Eterm error; + const Eterm *value; char *s_error; - if (erts_maps_get(BIF_ARG_1, BIF_ARG_2, &value)) { - BIF_RET(value); + value = erts_maps_get(BIF_ARG_1, BIF_ARG_2); + if (value) { + BIF_RET(*value); } s_error = "bad_key"; diff --git a/erts/emulator/beam/erl_map.h b/erts/emulator/beam/erl_map.h index cfacb2ec28..2e02ca4677 100644 --- a/erts/emulator/beam/erl_map.h +++ b/erts/emulator/beam/erl_map.h @@ -64,9 +64,17 @@ typedef struct map_s { 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_find(Eterm key, Eterm map, Eterm *value); -int erts_maps_get(Eterm key, Eterm map, Eterm *value); int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res); int erts_validate_and_sort_map(map_t* map); + +#if HALFWORD_HEAP +const Eterm * +erts_maps_get_rel(Eterm key, Eterm map, Eterm *map_base); +# define erts_maps_get(A, B) erts_maps_get_rel(A, B, NULL) +#else +const Eterm * +erts_maps_get(Eterm key, Eterm map); +# define erts_maps_get_rel(A, B, B_BASE) erts_maps_get(A, B) #endif +#endif diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index adc3520ebb..198acfd128 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -551,9 +551,7 @@ int enif_alloc_binary(size_t size, ErlNifBinary* bin) if (refbin == NULL) { return 0; /* The NIF must take action */ } - refbin->flags = BIN_FLAG_DRV; /* BUGBUG: Flag? */ erts_refc_init(&refbin->refc, 1); - refbin->orig_size = (SWord) size; bin->size = size; bin->data = (unsigned char*) refbin->orig_bytes; @@ -573,7 +571,6 @@ int enif_realloc_binary(ErlNifBinary* bin, size_t size) if (!newbin) { return 0; } - newbin->orig_size = size; bin->ref_bin = newbin; bin->data = (unsigned char*) newbin->orig_bytes; bin->size = size; @@ -1958,10 +1955,16 @@ int enif_get_map_value(ErlNifEnv* env, Eterm key, Eterm *value) { + const Eterm *ret; if (is_not_map(map)) { return 0; } - return erts_maps_get(key, map, value); + ret = erts_maps_get(key, map); + if (ret) { + *value = *ret; + return 1; + } + return 0; } int enif_make_map_update(ErlNifEnv* env, diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index d18760dc43..74e38c13df 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2013. All Rights Reserved. + * Copyright Ericsson AB 2005-2014. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -25,6 +25,7 @@ #include "sys.h" #include "big.h" #include "erl_map.h" +#include "erl_binary.h" #define PRINT_CHAR(CNT, FN, ARG, C) \ do { \ @@ -138,6 +139,25 @@ is_printable_string(Eterm list, Eterm* base) return 0; } +static int is_printable_ascii(byte* bytep, Uint bytesize, Uint bitoffs) +{ + if (!bitoffs) { + while (bytesize--) { + if (*bytep < ' ' || *bytep >= 127) + return 0; + bytep++; + } + } else { + while (bytesize--) { + byte octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs)); + if (octet < ' ' || octet >= 127) + return 0; + bytep++; + } + } + return 1; +} + /* print a atom doing what quoting is necessary */ static int print_atom_name(fmtfn_t fn, void* arg, Eterm atom, long *dcount) { @@ -283,13 +303,9 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, tl = CDR(cons); if (is_not_nil(tl)) { if (is_list(tl)) { - WSTACK_PUSH(s, tl); - WSTACK_PUSH(s, PRT_ONE_CONS); - WSTACK_PUSH(s, PRT_COMMA); + WSTACK_PUSH3(s, tl, PRT_ONE_CONS, PRT_COMMA); } else { - WSTACK_PUSH(s, tl); - WSTACK_PUSH(s, PRT_TERM); - WSTACK_PUSH(s, PRT_BAR); + WSTACK_PUSH3(s, tl, PRT_TERM, PRT_BAR); } } } @@ -299,9 +315,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, break; default: /* PRT_LAST_ARRAY_ELEMENT+1 and upwards */ obj = *popped.ptr; - WSTACK_PUSH(s, (UWord) (popped.ptr + 1)); - WSTACK_PUSH(s, val-1); - WSTACK_PUSH(s, PRT_COMMA); + WSTACK_PUSH3(s, (UWord) (popped.ptr + 1), val-1, PRT_COMMA); break; } break; @@ -431,8 +445,7 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, WSTACK_PUSH(s,PRT_CLOSE_TUPLE); ++nobj; if (i > 0) { - WSTACK_PUSH(s, (UWord) nobj); - WSTACK_PUSH(s, PRT_LAST_ARRAY_ELEMENT+i-1); + WSTACK_PUSH2(s, (UWord) nobj, PRT_LAST_ARRAY_ELEMENT+i-1); } break; case FLOAT_DEF: { @@ -446,13 +459,65 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, PRINT_STRING(res, fn, arg, "#MatchState"); } else { - ProcBin* pb = (ProcBin *) binary_val(wobj); - if (pb->size == 1) - PRINT_STRING(res, fn, arg, "<<1 byte>>"); - else { + byte* bytep; + Uint bytesize = binary_size_rel(obj,obj_base); + Uint bitoffs; + Uint bitsize; + byte octet; + ERTS_GET_BINARY_BYTES_REL(obj, bytep, bitoffs, bitsize, obj_base); + + if (bitsize || !bytesize + || !is_printable_ascii(bytep, bytesize, bitoffs)) { + int is_first = 1; PRINT_STRING(res, fn, arg, "<<"); - PRINT_UWORD(res, fn, arg, 'u', 0, 1, (ErlPfUWord) pb->size); - PRINT_STRING(res, fn, arg, " bytes>>"); + while (bytesize) { + if (is_first) + is_first = 0; + else + PRINT_CHAR(res, fn, arg, ','); + if (bitoffs) + octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs)); + else + octet = bytep[0]; + PRINT_UWORD(res, fn, arg, 'u', 0, 1, octet); + ++bytep; + --bytesize; + } + if (bitsize) { + Uint bits = bitoffs + bitsize; + octet = bytep[0]; + if (bits < 8) + octet >>= 8 - bits; + else if (bits > 8) { + bits -= 8; /* bits in last byte */ + octet <<= bits; + octet |= bytep[1] >> (8 - bits); + } + octet &= (1 << bitsize) - 1; + if (is_first) + is_first = 0; + else + PRINT_CHAR(res, fn, arg, ','); + PRINT_UWORD(res, fn, arg, 'u', 0, 1, octet); + PRINT_CHAR(res, fn, arg, ':'); + PRINT_UWORD(res, fn, arg, 'u', 0, 1, bitsize); + } + PRINT_STRING(res, fn, arg, ">>"); + } + else { + PRINT_STRING(res, fn, arg, "<<\""); + while (bytesize) { + if (bitoffs) + octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs)); + else + octet = bytep[0]; + if (octet == '"') + PRINT_CHAR(res, fn, arg, '\\'); + PRINT_CHAR(res, fn, arg, octet); + ++bytep; + --bytesize; + } + PRINT_STRING(res, fn, arg, "\">>"); } } break; @@ -502,19 +567,10 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, WSTACK_PUSH(s, PRT_CLOSE_TUPLE); if (n > 0) { n--; - WSTACK_PUSH(s, vs[n]); - WSTACK_PUSH(s, PRT_TERM); - WSTACK_PUSH(s, PRT_ASSOC); - WSTACK_PUSH(s, ks[n]); - WSTACK_PUSH(s, PRT_TERM); - + WSTACK_PUSH5(s, vs[n], PRT_TERM, PRT_ASSOC, ks[n], PRT_TERM); while (n--) { - WSTACK_PUSH(s, PRT_COMMA); - WSTACK_PUSH(s, vs[n]); - WSTACK_PUSH(s, PRT_TERM); - WSTACK_PUSH(s, PRT_ASSOC); - WSTACK_PUSH(s, ks[n]); - WSTACK_PUSH(s, PRT_TERM); + WSTACK_PUSH6(s, PRT_COMMA, vs[n], PRT_TERM, PRT_ASSOC, + ks[n], PRT_TERM); } } } diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index f84677dea4..b0e0cf13f8 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -152,7 +152,7 @@ extern BeamInstr beam_continue_exit[]; /* Eager check I/O not supported on OSE yet. */ int erts_eager_check_io = 0; #else -int erts_eager_check_io = 0; +int erts_eager_check_io = 1; #endif int erts_sched_compact_load; int erts_sched_balance_util = 0; diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 27a3a3553b..3d08be25ff 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -58,6 +58,7 @@ typedef struct process Process; #include "external.h" #include "erl_mseg.h" #include "erl_async.h" +#include "erl_gc.h" #ifdef HIPE #include "hipe_process.h" @@ -489,11 +490,6 @@ typedef struct { } ErtsSchedWallTime; typedef struct { - Uint64 reclaimed; - Uint64 garbage_cols; -} ErtsGCInfo; - -typedef struct { int sched; erts_aint32_t aux_work; } ErtsDelayedAuxWorkWakeupJob; diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index 23e5bf737f..3ce707efda 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -82,6 +82,7 @@ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret); static void pd_hash_erase_all(Process *p); static Eterm pd_hash_get_keys(Process *p, Eterm value); +static Eterm pd_hash_get_all_keys(Process *p, ProcDict *pd); static Eterm pd_hash_get_all(Process *p, ProcDict *pd); static Eterm pd_hash_put(Process *p, Eterm id, Eterm value); @@ -275,6 +276,16 @@ BIF_RETTYPE get_1(BIF_ALIST_1) BIF_RET(ret); } +BIF_RETTYPE get_keys_0(BIF_ALIST_0) +{ + Eterm ret; + + PD_CHECK(BIF_P->dictionary); + ret = pd_hash_get_all_keys(BIF_P,BIF_P->dictionary); + PD_CHECK(BIF_P->dictionary); + BIF_RET(ret); +} + BIF_RETTYPE get_keys_1(BIF_ALIST_1) { Eterm ret; @@ -412,6 +423,47 @@ Eterm erts_pd_hash_get(Process *p, Eterm id) return am_undefined; } +#define PD_GET_TKEY(Dst,Src) \ +do { \ + ASSERT(is_tuple((Src))); \ + ASSERT(arityval(*((Eterm*)tuple_val((Src)))) == 2); \ + (Dst) = ((Eterm*)tuple_val((Src)))[1]; \ +} while(0) + +static Eterm pd_hash_get_all_keys(Process *p, ProcDict *pd) { + Eterm* hp; + Eterm res = NIL; + Eterm tmp, tmp2; + unsigned int i; + unsigned int num; + + if (pd == NULL) { + return res; + } + + num = HASH_RANGE(pd); + hp = HAlloc(p, pd->numElements * 2); + + for (i = 0; i < num; ++i) { + tmp = ARRAY_GET(pd, i); + if (is_boxed(tmp)) { + PD_GET_TKEY(tmp,tmp); + res = CONS(hp, tmp, res); + hp += 2; + } else if (is_list(tmp)) { + while (tmp != NIL) { + tmp2 = TCAR(tmp); + PD_GET_TKEY(tmp2,tmp2); + res = CONS(hp, tmp2, res); + hp += 2; + tmp = TCDR(tmp); + } + } + } + return res; +} +#undef PD_GET_TKEY + static Eterm pd_hash_get_keys(Process *p, Eterm value) { Eterm *hp; diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index b7de8208ad..78d98229d8 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -20,8 +20,6 @@ #ifndef __ERL_VM_H__ #define __ERL_VM_H__ -/* #define ERTS_OPCODE_COUNTER_SUPPORT */ - /* FORCE_HEAP_FRAGS: * Debug provocation to make HAlloc always create heap fragments (if allowed) * even if there is room on heap. diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 9b9b4b2a62..601cbe9d7d 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -36,7 +36,9 @@ #include "erl_process.h" #include "error.h" #include "external.h" +#define ERL_WANT_HIPE_BIF_WRAPPER__ #include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ #include "big.h" #include "dist.h" #include "erl_binary.h" @@ -498,15 +500,37 @@ byte *erts_encode_ext_dist_header_finalize(byte *ext, ErtsAtomCache *cache, Uint return ep; } -Uint erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp) +int erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp, + Uint* szp) { - Uint sz = 0; + Uint sz; + if (encode_size_struct_int(NULL, acmp, term, flags, NULL, &sz)) { + return -1; + } else { #ifndef ERTS_DEBUG_USE_DIST_SEP - if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) + if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) #endif - sz++ /* VERSION_MAGIC */; - sz += encode_size_struct2(acmp, term, flags); - return sz; + sz++ /* VERSION_MAGIC */; + + *szp += sz; + return 0; + } +} + +int erts_encode_dist_ext_size_int(Eterm term, struct erts_dsig_send_context* ctx, Uint* szp) +{ + Uint sz; + if (encode_size_struct_int(&ctx->u.sc, ctx->acmp, term, ctx->flags, &ctx->reds, &sz)) { + return -1; + } else { +#ifndef ERTS_DEBUG_USE_DIST_SEP + if (!(ctx->flags & DFLAG_DIST_HDR_ATOM_CACHE)) +#endif + sz++ /* VERSION_MAGIC */; + + *szp += sz; + return 0; + } } Uint erts_encode_ext_size(Eterm term) @@ -527,19 +551,16 @@ Uint erts_encode_ext_size_ets(Eterm term) } -void erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp) +int erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp, + TTBEncodeContext* ctx, Sint* reds) { - byte *ep = *ext; -#ifndef ERTS_DEBUG_USE_DIST_SEP - if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) -#endif - *ep++ = VERSION_MAGIC; - ep = enc_term(acmp, term, ep, flags, NULL); - if (!ep) - erl_exit(ERTS_ABORT_EXIT, - "%s:%d:erts_encode_dist_ext(): Internal data structure error\n", - __FILE__, __LINE__); - *ext = ep; + if (!ctx || !ctx->wstack.wstart) { + #ifndef ERTS_DEBUG_USE_DIST_SEP + if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) + #endif + *(*ext)++ = VERSION_MAGIC; + } + return enc_term_int(ctx, acmp, term, *ext, flags, NULL, reds, ext); } void erts_encode_ext(Eterm term, byte **ext) @@ -1740,54 +1761,14 @@ erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) { return erts_term_to_binary_simple(p, Term, size, level, flags); } -/* Define for testing */ -/* #define EXTREME_TTB_TRAPPING 1 */ +/* Define EXTREME_TTB_TRAPPING for testing in dist.h */ #ifndef EXTREME_TTB_TRAPPING -#define TERM_TO_BINARY_LOOP_FACTOR 32 #define TERM_TO_BINARY_COMPRESS_CHUNK (1 << 18) #else -#define TERM_TO_BINARY_LOOP_FACTOR 1 #define TERM_TO_BINARY_COMPRESS_CHUNK 10 #endif - - -typedef enum { TTBSize, TTBEncode, TTBCompress } TTBState; -typedef struct TTBSizeContext_ { - Uint flags; - int level; - Uint result; - Eterm obj; - ErtsEStack estack; -} TTBSizeContext; - -typedef struct TTBEncodeContext_ { - Uint flags; - int level; - byte* ep; - Eterm obj; - ErtsWStack wstack; - Binary *result_bin; -} TTBEncodeContext; - -typedef struct { - Uint real_size; - Uint dest_len; - byte *dbytes; - Binary *result_bin; - Binary *destination_bin; - z_stream stream; -} TTBCompressContext; - -typedef struct { - int alive; - TTBState state; - union { - TTBSizeContext sc; - TTBEncodeContext ec; - TTBCompressContext cc; - } s; -} TTBContext; +#define TERM_TO_BINARY_MEMCPY_FACTOR 8 static void ttb_context_destructor(Binary *context_bin) { @@ -1899,8 +1880,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla } result_bin = erts_bin_nrml_alloc(size); - result_bin->flags = 0; - result_bin->orig_size = size; erts_refc_init(&result_bin->refc, 0); result_bin->orig_bytes[0] = VERSION_MAGIC; /* Next state immediately, no need to export context */ @@ -1925,7 +1904,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla } real_size = endp - bytes; result_bin = erts_bin_realloc(context->s.ec.result_bin,real_size); - result_bin->orig_size = real_size; level = context->s.ec.level; BUMP_REDS(p, (initial_reds - reds) / TERM_TO_BINARY_LOOP_FACTOR); if (level == 0 || real_size < 6) { /* We are done */ @@ -1962,8 +1940,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla context->s.cc.result_bin = result_bin; result_bin = erts_bin_nrml_alloc(real_size); - result_bin->flags = 0; - result_bin->orig_size = real_size; erts_refc_init(&result_bin->refc, 0); result_bin->orig_bytes[0] = VERSION_MAGIC; @@ -2005,7 +1981,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla erl_zlib_deflate_finish(&(context->s.cc.stream)); result_bin = erts_bin_realloc(context->s.cc.destination_bin, context->s.cc.dest_len+6); - result_bin->orig_size = context->s.cc.dest_len+6; context->s.cc.destination_bin = NULL; pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); pb->thing_word = HEADER_PROC_BIN; @@ -2327,8 +2302,9 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete #define ENC_TERM ((Eterm) 0) #define ENC_ONE_CONS ((Eterm) 1) #define ENC_PATCH_FUN_SIZE ((Eterm) 2) -#define ENC_LAST_ARRAY_ELEMENT ((Eterm) 3) - +#define ENC_BIN_COPY ((Eterm) 3) +#define ENC_MAP_PAIR ((Eterm) 4) +#define ENC_LAST_ARRAY_ELEMENT ((Eterm) 5) static byte* enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, @@ -2364,6 +2340,9 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, WSTACK_RESTORE(s, &ctx->wstack); ep = ctx->ep; obj = ctx->obj; + if (is_non_value(obj)) { + goto outer_loop; + } } } @@ -2387,8 +2366,8 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, obj = CAR(cons); tl = CDR(cons); - WSTACK_PUSH(s, is_list(tl) ? ENC_ONE_CONS : ENC_TERM); - WSTACK_PUSH(s, tl); + WSTACK_PUSH2(s, (is_list(tl) ? ENC_ONE_CONS : ENC_TERM), + tl); } break; case ENC_PATCH_FUN_SIZE: @@ -2401,6 +2380,39 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, put_int32(ep - size_p, size_p); } goto outer_loop; + case ENC_BIN_COPY: { + Uint bits = (Uint)obj; + Uint bitoffs = WSTACK_POP(s); + byte* bytes = (byte*) WSTACK_POP(s); + byte* dst = (byte*) WSTACK_POP(s); + if (bits > r * (TERM_TO_BINARY_MEMCPY_FACTOR * 8)) { + Uint n = r * TERM_TO_BINARY_MEMCPY_FACTOR; + WSTACK_PUSH5(s, (UWord)(dst + n), (UWord)(bytes + n), bitoffs, + ENC_BIN_COPY, bits - 8*n); + bits = 8*n; + copy_binary_to_buffer(dst, 0, bytes, bitoffs, bits); + obj = THE_NON_VALUE; + r = 0; /* yield */ + break; + } else { + copy_binary_to_buffer(dst, 0, bytes, bitoffs, bits); + r -= bits / (TERM_TO_BINARY_MEMCPY_FACTOR * 8); + goto outer_loop; + } + } + case ENC_MAP_PAIR: { + Uint pairs_left = obj; + Eterm *vptr = (Eterm*) WSTACK_POP(s); + Eterm *kptr = (Eterm*) WSTACK_POP(s); + + obj = *kptr; + if (--pairs_left > 0) { + WSTACK_PUSH4(s, (UWord)(kptr+1), (UWord)(vptr+1), + ENC_MAP_PAIR, pairs_left); + } + WSTACK_PUSH2(s, ENC_TERM, *vptr); + break; + } case ENC_LAST_ARRAY_ELEMENT: /* obj is the tuple */ { @@ -2419,17 +2431,16 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, #else Eterm* ptr = (Eterm *) obj; #endif - WSTACK_PUSH(s, val-1); obj = *ptr++; - WSTACK_PUSH(s, (UWord)ptr); + WSTACK_PUSH2(s, val-1, (UWord)ptr); } break; } L_jump_start: - if (ctx && --r == 0) { - *reds = r; + if (ctx && --r <= 0) { + *reds = 0; ctx->obj = obj; ctx->ep = ep; WSTACK_SAVE(s, &ctx->wstack); @@ -2578,8 +2589,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, ep += 4; } if (i > 0) { - WSTACK_PUSH(s, ENC_LAST_ARRAY_ELEMENT+i-1); - WSTACK_PUSH(s, (UWord)ptr); + WSTACK_PUSH2(s, ENC_LAST_ARRAY_ELEMENT+i-1, (UWord)ptr); } break; @@ -2595,18 +2605,8 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Eterm *kptr = map_get_keys(mp); Eterm *vptr = map_get_values(mp); - for (i = size-1; i >= 1; i--) { - WSTACK_PUSH(s, ENC_TERM); - WSTACK_PUSH(s, (UWord) vptr[i]); - WSTACK_PUSH(s, ENC_TERM); - WSTACK_PUSH(s, (UWord) kptr[i]); - } - - WSTACK_PUSH(s, ENC_TERM); - WSTACK_PUSH(s, (UWord) vptr[0]); - - obj = kptr[0]; - goto L_jump_start; + WSTACK_PUSH4(s, (UWord)kptr, (UWord)vptr, + ENC_MAP_PAIR, size); } } break; @@ -2644,6 +2644,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint bitoffs; Uint bitsize; byte* bytes; + byte* data_dst; ERTS_GET_BINARY_BYTES(obj, bytes, bitoffs, bitsize); if (dflags & DFLAG_INTERNAL_TAGS) { @@ -2689,7 +2690,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, j = binary_size(obj); put_int32(j, ep); ep += 4; - copy_binary_to_buffer(ep, 0, bytes, bitoffs, 8*j); + data_dst = ep; ep += j; } else if (dflags & DFLAG_BIT_BINARIES) { /* Bit-level binary. */ @@ -2699,7 +2700,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, ep += 4; *ep++ = bitsize; ep[j] = 0; /* Zero unused bits at end of binary */ - copy_binary_to_buffer(ep, 0, bytes, bitoffs, 8*j+bitsize); + data_dst = ep; ep += j + 1; } else { /* @@ -2713,11 +2714,18 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, put_int32((j+1), ep); ep += 4; ep[j] = 0; /* Zero unused bits at end of binary */ - copy_binary_to_buffer(ep, 0, bytes, bitoffs, 8*j+bitsize); + data_dst = ep; ep += j+1; *ep++ = SMALL_INTEGER_EXT; *ep++ = bitsize; } + if (ctx && j > r * TERM_TO_BINARY_MEMCPY_FACTOR) { + WSTACK_PUSH5(s, (UWord)data_dst, (UWord)bytes, bitoffs, + ENC_BIN_COPY, 8*j + bitsize); + } else { + copy_binary_to_buffer(data_dst, 0, bytes, bitoffs, + 8 * j + bitsize); + } } break; case EXPORT_DEF: @@ -2746,13 +2754,12 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, case FUN_DEF: { ErlFunThing* funp = (ErlFunThing *) fun_val(obj); + int ei; if ((dflags & DFLAG_NEW_FUN_TAGS) != 0) { - int ei; - *ep++ = NEW_FUN_EXT; - WSTACK_PUSH(s, ENC_PATCH_FUN_SIZE); - WSTACK_PUSH(s, (UWord) ep); /* Position for patching in size */ + WSTACK_PUSH2(s, ENC_PATCH_FUN_SIZE, + (UWord) ep); /* Position for patching in size */ ep += 4; *ep = funp->arity; ep += 1; @@ -2766,16 +2773,6 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags, off_heap); ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags, off_heap); ep = enc_pid(acmp, funp->creator, ep, dflags); - - fun_env: - for (ei = funp->num_free-1; ei > 0; ei--) { - WSTACK_PUSH(s, ENC_TERM); - WSTACK_PUSH(s, (UWord) funp->env[ei]); - } - if (funp->num_free != 0) { - obj = funp->env[0]; - goto L_jump_start; - } } else { /* * Communicating with an obsolete erl_interface or @@ -2807,7 +2804,13 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, *ep++ = SMALL_TUPLE_EXT; put_int8(funp->num_free, ep); ep += 1; - goto fun_env; + } + for (ei = funp->num_free-1; ei > 0; ei--) { + WSTACK_PUSH2(s, ENC_TERM, (UWord) funp->env[ei]); + } + if (funp->num_free != 0) { + obj = funp->env[0]; + goto L_jump_start; } } break; @@ -3387,8 +3390,6 @@ dec_term_atom_common: } else { Binary* dbin = erts_bin_nrml_alloc(n); ProcBin* pb; - dbin->flags = 0; - dbin->orig_size = n; erts_refc_init(&dbin->refc, 1); pb = (ProcBin *) hp; hp += PROC_BIN_SIZE; @@ -3441,8 +3442,6 @@ dec_term_atom_common: Binary* dbin = erts_bin_nrml_alloc(n); ProcBin* pb; - dbin->flags = 0; - dbin->orig_size = n; erts_refc_init(&dbin->refc, 1); pb = (ProcBin *) hp; pb->thing_word = HEADER_PROC_BIN; diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index bf00958eb1..f120e96e3b 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -150,6 +150,7 @@ typedef struct { Uint extsize; } ErtsBinary2TermState; + /* -------------------------------------------------------------------------- */ void erts_init_atom_cache_map(ErtsAtomCacheMap *); @@ -161,8 +162,12 @@ Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *); Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *); byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *); byte *erts_encode_ext_dist_header_finalize(byte *, ErtsAtomCache *, Uint32); -Uint erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap *); -void erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *); +struct erts_dsig_send_context; +int erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap*, Uint* szp); +int erts_encode_dist_ext_size_int(Eterm term, struct erts_dsig_send_context* ctx, Uint* szp); +struct TTBEncodeContext_; +int erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *, + struct TTBEncodeContext_ *, Sint* reds); Uint erts_encode_ext_size(Eterm); Uint erts_encode_ext_size_2(Eterm, unsigned); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 891046a8b5..ec8c1e3ccb 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -41,6 +41,7 @@ #include "error.h" #include "erl_utils.h" #include "erl_port.h" +#include "erl_gc.h" struct enif_environment_t /* ErlNifEnv */ { @@ -479,6 +480,17 @@ do { \ *s.sp++ = (z); \ } while(0) +#define ESTACK_PUSH4(s, E1, E2, E3, E4) \ +do { \ + if (s.sp > s.end - 4) { \ + erl_grow_estack(&s, ESTK_DEF_STACK(s)); \ + } \ + *s.sp++ = (E1); \ + *s.sp++ = (E2); \ + *s.sp++ = (E3); \ + *s.sp++ = (E4); \ +} while(0) + #define ESTACK_COUNT(s) (s.sp - s.start) #define ESTACK_ISEMPTY(s) (s.sp == s.start) #define ESTACK_POP(s) (*(--s.sp)) @@ -597,6 +609,42 @@ do { \ *s.wsp++ = (z); \ } while(0) +#define WSTACK_PUSH4(s, A1, A2, A3, A4) \ +do { \ + if (s.wsp > s.wend - 4) { \ + erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \ + } \ + *s.wsp++ = (A1); \ + *s.wsp++ = (A2); \ + *s.wsp++ = (A3); \ + *s.wsp++ = (A4); \ +} while(0) + +#define WSTACK_PUSH5(s, A1, A2, A3, A4, A5) \ +do { \ + if (s.wsp > s.wend - 5) { \ + erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \ + } \ + *s.wsp++ = (A1); \ + *s.wsp++ = (A2); \ + *s.wsp++ = (A3); \ + *s.wsp++ = (A4); \ + *s.wsp++ = (A5); \ +} while(0) + +#define WSTACK_PUSH6(s, A1, A2, A3, A4, A5, A6) \ +do { \ + if (s.wsp > s.wend - 6) { \ + erl_grow_wstack(&s, WSTK_DEF_STACK(s)); \ + } \ + *s.wsp++ = (A1); \ + *s.wsp++ = (A2); \ + *s.wsp++ = (A3); \ + *s.wsp++ = (A4); \ + *s.wsp++ = (A5); \ + *s.wsp++ = (A6); \ +} while(0) + #define WSTACK_COUNT(s) (s.wsp - s.wstart) #define WSTACK_ISEMPTY(s) (s.wsp == s.wstart) #define WSTACK_POP(s) (*(--s.wsp)) @@ -809,23 +857,6 @@ void MD5Init(MD5_CTX *); void MD5Update(MD5_CTX *, unsigned char *, unsigned int); void MD5Final(unsigned char [16], MD5_CTX *); -/* ggc.c */ - -void erts_gc_info(ErtsGCInfo *gcip); -void erts_init_gc(void); -int erts_garbage_collect(Process*, int, Eterm*, int); -void erts_garbage_collect_hibernate(Process* p); -Eterm erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity); -void erts_garbage_collect_literals(Process* p, Eterm* literals, - Uint lit_size, - struct erl_off_heap_header* oh); -Uint erts_next_heap_size(Uint, Uint); -Eterm erts_heap_sizes(Process* p); - -void erts_offset_off_heap(ErlOffHeap *, Sint, Eterm*, Eterm*); -void erts_offset_heap_ptr(Eterm*, Uint, Sint, Eterm*, Eterm*); -void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*); -void erts_free_heap_frags(Process* p); /* io.c */ diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 9ae973e108..4d262ff022 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -3153,8 +3153,6 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, Binary* bptr; bptr = erts_bin_nrml_alloc(len); - bptr->flags = 0; - bptr->orig_size = len; erts_refc_init(&bptr->refc, 1); sys_memcpy(bptr->orig_bytes, buf, len); @@ -5506,8 +5504,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) ProcBin* pbp; Binary* bp = erts_bin_nrml_alloc(size); ASSERT(bufp); - bp->flags = 0; - bp->orig_size = (SWord) size; erts_refc_init(&bp->refc, 1); sys_memcpy((void *) bp->orig_bytes, (void *) bufp, size); pbp = (ProcBin *) hp; @@ -5999,9 +5995,7 @@ driver_alloc_binary(ErlDrvSizeT size) bin = erts_bin_drv_alloc_fnf((Uint) size); if (!bin) return NULL; /* The driver write must take action */ - bin->flags = BIN_FLAG_DRV; erts_refc_init(&bin->refc, 1); - bin->orig_size = (SWord) size; return Binary2ErlDrvBinary(bin); } @@ -6031,7 +6025,6 @@ ErlDrvBinary* driver_realloc_binary(ErlDrvBinary* bin, ErlDrvSizeT size) if (!newbin) return NULL; - newbin->orig_size = size; return Binary2ErlDrvBinary(newbin); } diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index f20e6e5665..e03cd22070 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -49,6 +49,9 @@ #include "beam_bp.h" #include "erl_ptab.h" #include "erl_check_io.h" +#ifdef HIPE +# include "hipe_mode_switch.h" +#endif #undef M_TRIM_THRESHOLD #undef M_TOP_PAD @@ -1229,25 +1232,20 @@ make_hash2(Eterm term) if (size == 0) { goto hash2_common; } - ESTACK_PUSH(s, hash_xor_values); - ESTACK_PUSH(s, hash_xor_keys); - ESTACK_PUSH(s, hash); - ESTACK_PUSH(s, HASH_MAP_TAIL); + ESTACK_PUSH4(s, hash_xor_values, hash_xor_keys, hash, HASH_MAP_TAIL); hash = 0; hash_xor_keys = 0; hash_xor_values = 0; for (i = size - 1; i >= 0; i--) { tmp = vs[i]; - ESTACK_PUSH(s, HASH_MAP_VAL); - ESTACK_PUSH(s, tmp); + ESTACK_PUSH2(s, HASH_MAP_VAL, tmp); } /* We do not want to expose the tuple representation. * Do not push the keys as a tuple. */ for (i = size - 1; i >= 0; i--) { tmp = ks[i]; - ESTACK_PUSH(s, HASH_MAP_KEY); - ESTACK_PUSH(s, tmp); + ESTACK_PUSH2(s, HASH_MAP_KEY, tmp); } goto hash2_common; } diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index 491e0a090e..be2fee1f25 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -32,6 +32,10 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*); #ifdef HAVE_TERMCAP /* else make an empty driver that can not be opened */ +#ifndef WANT_NONBLOCKING +#define WANT_NONBLOCKING +#endif + #include "sys.h" #include <ctype.h> #include <stdlib.h> @@ -39,6 +43,7 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*); #include <string.h> #include <signal.h> #include <fcntl.h> +#include <limits.h> #include <locale.h> #include <unistd.h> #include <termios.h> @@ -57,6 +62,14 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*); #include <langinfo.h> #endif +#if defined IOV_MAX +#define MAXIOV IOV_MAX +#elif defined UIO_MAXIOV +#define MAXIOV UIO_MAXIOV +#else +#define MAXIOV 16 +#endif + #define TRUE 1 #define FALSE 0 @@ -80,12 +93,15 @@ static volatile int cols_needs_update = FALSE; #define OP_INSC 2 #define OP_DELC 3 #define OP_BEEP 4 +#define OP_PUTC_SYNC 5 /* Control op */ #define CTRL_OP_GET_WINSIZE 100 #define CTRL_OP_GET_UNICODE_STATE 101 #define CTRL_OP_SET_UNICODE_STATE 102 - +/* We use 1024 as the buf size as that was the default buf size of FILE streams + on all platforms that I checked. */ +#define TTY_BUFFSIZE 1024 static int lbuf_size = BUFSIZ; static Uint32 *lbuf; /* The current line buffer */ @@ -113,13 +129,19 @@ static int lpos; /* The current "cursor position" in the line buf /* Main interface functions. */ static void ttysl_stop(ErlDrvData); static void ttysl_from_erlang(ErlDrvData, char*, ErlDrvSizeT); +static void ttysl_to_tty(ErlDrvData, ErlDrvEvent); +static void ttysl_flush_tty(ErlDrvData); static void ttysl_from_tty(ErlDrvData, ErlDrvEvent); static void ttysl_stop_select(ErlDrvEvent, void*); static Sint16 get_sint16(char*); static ErlDrvPort ttysl_port; static int ttysl_fd; -static FILE *ttysl_out; +static int ttysl_terminate = 0; +static int ttysl_send_ok = 0; +static ErlDrvBinary *putcbuf; +static int putcpos; +static int putclen; /* Functions that work on the line buffer. */ static int start_lbuf(void); @@ -201,22 +223,22 @@ struct erl_drv_entry ttsl_driver_entry = { IF_IMPL(ttysl_stop), IF_IMPL(ttysl_from_erlang), IF_IMPL(ttysl_from_tty), - NULL, - "tty_sl", - NULL, - NULL, + IF_IMPL(ttysl_to_tty), + "tty_sl", /* driver_name */ + NULL, /* finish */ + NULL, /* handle */ IF_IMPL(ttysl_control), NULL, /* timeout */ NULL, /* outputv */ NULL, /* ready_async */ - NULL, /* flush */ + IF_IMPL(ttysl_flush_tty), NULL, /* call */ NULL, /* event */ ERL_DRV_EXTENDED_MARKER, ERL_DRV_EXTENDED_MAJOR_VERSION, ERL_DRV_EXTENDED_MINOR_VERSION, 0, /* ERL_DRV_FLAGs */ - NULL, + NULL, /* handle2 */ NULL, /* process_exit */ IF_IMPL(ttysl_stop_select) }; @@ -296,8 +318,7 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) return ERL_DRV_ERROR_GENERAL; } - /* Open the terminal and set the terminal */ - ttysl_out = fdopen(ttysl_fd, "w"); + SET_NONBLOCKING(ttysl_fd); #ifdef PRIMITIVE_UTF8_CHECK setlocale(LC_CTYPE, ""); /* Set international environment, @@ -400,12 +421,14 @@ static void ttysl_stop(ErlDrvData ttysl_data) stop_lbuf(); stop_termcap(); tty_reset(ttysl_fd); - driver_select(ttysl_port, (ErlDrvEvent)(UWord)ttysl_fd, ERL_DRV_READ|ERL_DRV_USE, 0); + driver_select(ttysl_port, (ErlDrvEvent)(UWord)ttysl_fd, + ERL_DRV_WRITE|ERL_DRV_READ|ERL_DRV_USE, 0); sys_sigset(SIGCONT, SIG_DFL); sys_sigset(SIGWINCH, SIG_DFL); } ttysl_port = (ErlDrvPort)-1; ttysl_fd = -1; + ttysl_terminate = 0; /* return TRUE; */ } @@ -650,10 +673,26 @@ static int check_buf_size(byte *s, int n) static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT count) { + ErlDrvSizeT sz; + + sz = driver_sizeq(ttysl_port); + + putclen = count > TTY_BUFFSIZE ? TTY_BUFFSIZE : count; + putcbuf = driver_alloc_binary(putclen); + putcpos = 0; + if (lpos > MAXSIZE) put_chars((byte*)"\n", 1); switch (buf[0]) { + case OP_PUTC_SYNC: + /* Using sync means that we have to send an ok to the + controlling process for each command call. We delay + sending ok if the driver queue exceeds a certain size. + We do not set ourselves as a busy port, as this + could be very bad for user_drv, if it gets blocked on + the port_command. */ + /* fall through */ case OP_PUTC: DEBUGLOG(("OP: Putc(%lu)",(unsigned long) count-1)); if (check_buf_size((byte*)buf+1, count-1) == 0) @@ -678,10 +717,104 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun /* Unknown op, just ignore. */ break; } - fflush(ttysl_out); + + driver_enq_bin(ttysl_port,putcbuf,0,putcpos); + + if (sz == 0) { + for (;;) { + int written, qlen; + SysIOVec *iov; + + iov = driver_peekq(ttysl_port,&qlen); + if (iov) + written = writev(ttysl_fd, iov, qlen > MAXIOV ? MAXIOV : qlen); + else + written = 0; + if (written < 0) { + if (errno == EAGAIN) { + driver_select(ttysl_port,(ErlDrvEvent)(long)ttysl_fd, + ERL_DRV_USE|ERL_DRV_WRITE,1); + break; + } else { + /* we ignore all other errors */ + break; + } + } else { + if (driver_deq(ttysl_port, written) == 0) + break; + } + } + } + + if (buf[0] == OP_PUTC_SYNC) { + if (driver_sizeq(ttysl_port) > TTY_BUFFSIZE && !ttysl_terminate) { + /* We delay sending the ack until the buffer has been consumed */ + ttysl_send_ok = 1; + } else { + ErlDrvTermData spec[] = { + ERL_DRV_PORT, driver_mk_port(ttysl_port), + ERL_DRV_ATOM, driver_mk_atom("ok"), + ERL_DRV_TUPLE, 2 + }; + ASSERT(ttysl_send_ok == 0); + erl_drv_output_term(driver_mk_port(ttysl_port), spec, + sizeof(spec) / sizeof(spec[0])); + } + } + return; /* TRUE; */ } +static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) { + for (;;) { + int written, qlen; + SysIOVec *iov; + ErlDrvSizeT sz; + + iov = driver_peekq(ttysl_port,&qlen); + if (iov) + written = writev(ttysl_fd, iov, qlen > MAXIOV ? MAXIOV : qlen); + else + written = 0; + if (written < 0) { + if (errno == EAGAIN) { + break; + } else { + /* we ignore all other errors */ + } + } else { + sz = driver_deq(ttysl_port, written); + if (sz < TTY_BUFFSIZE && ttysl_send_ok) { + ErlDrvTermData spec[] = { + ERL_DRV_PORT, driver_mk_port(ttysl_port), + ERL_DRV_ATOM, driver_mk_atom("ok"), + ERL_DRV_TUPLE, 2 + }; + ttysl_send_ok = 0; + erl_drv_output_term(driver_mk_port(ttysl_port), spec, + sizeof(spec) / sizeof(spec[0])); + } + if (sz == 0) { + driver_select(ttysl_port,(ErlDrvEvent)(long)ttysl_fd, + ERL_DRV_WRITE,0); + if (ttysl_terminate) + /* flush has been called, which means we should terminate + when queue is empty. This will not send any exit + message */ + driver_failure_atom(ttysl_port, "normal"); + break; + } + } + } + + return; +} + +static void ttysl_flush_tty(ErlDrvData ttysl_data) { + ttysl_terminate = 1; + return; +} + static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) { byte b[1024]; @@ -1070,7 +1203,14 @@ static int write_buf(Uint32 *s, int n) /* The basic procedure for outputting one character. */ static int outc(int c) { - return (int)putc(c, ttysl_out); + putcbuf->orig_bytes[putcpos++] = c; + if (putcpos == putclen) { + driver_enq_bin(ttysl_port,putcbuf,0,putclen); + putcpos = 0; + putclen = TTY_BUFFSIZE; + putcbuf = driver_alloc_binary(BUFSIZ); + } + return 1; } static int move_cursor(int from, int to) diff --git a/erts/emulator/drivers/win32/ttsl_drv.c b/erts/emulator/drivers/win32/ttsl_drv.c index 502cb58dfa..851c336a11 100644 --- a/erts/emulator/drivers/win32/ttsl_drv.c +++ b/erts/emulator/drivers/win32/ttsl_drv.c @@ -46,6 +46,7 @@ static int rows; /* Number of rows available. */ #define OP_INSC 2 #define OP_DELC 3 #define OP_BEEP 4 +#define OP_PUTC_SYNC 5 /* Control op */ #define CTRL_OP_GET_WINSIZE 100 @@ -458,6 +459,7 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun switch (buf[0]) { case OP_PUTC: + case OP_PUTC_SYNC: DEBUGLOG(("OP: Putc(%I64u)",(unsigned long long)count-1)); if (check_buf_size((byte*)buf+1, count-1) == 0) return; @@ -481,6 +483,20 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun /* Unknown op, just ignore. */ break; } + + if (buf[0] == OP_PUTC_SYNC) { + /* On windows we do a blocking write to the tty so we just + send the ack immidiately. If at some point in the future + someone has a problem with tty output being blocking + this has to be changed. */ + ErlDrvTermData spec[] = { + ERL_DRV_PORT, driver_mk_port(ttysl_port), + ERL_DRV_ATOM, driver_mk_atom("ok"), + ERL_DRV_TUPLE, 2 + }; + erl_drv_output_term(driver_mk_port(ttysl_port), spec, + sizeof(spec) / sizeof(spec[0])); + } return; } diff --git a/erts/emulator/hipe/hipe_amd64.c b/erts/emulator/hipe/hipe_amd64.c index b5dff06987..16c597e7b4 100644 --- a/erts/emulator/hipe/hipe_amd64.c +++ b/erts/emulator/hipe/hipe_amd64.c @@ -224,18 +224,19 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process * return alloc_code(nrbytes); } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) + +/* Make stub for native code calling exported beam function. +*/ +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { /* * This creates a native code stub with the following contents: * - * movq $Address, P_BEAM_IP(%ebp) %% Actually two movl + * movq $Address, P_CALLEE_EXP(%ebp) %% Actually two movl * movb $Arity, P_ARITY(%ebp) * jmp callemu * - * The stub has variable size, depending on whether the P_BEAM_IP + * The stub has variable size, depending on whether the P_CALLEE_EXP * and P_ARITY offsets fit in 8-bit signed displacements or not. * The rel32 offset in the final jmp depends on its actual location, * which also depends on the size of the previous instructions. @@ -248,49 +249,49 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) codeSize = /* 23, 26, 29, or 32 bytes */ 23 + /* 23 when all offsets are 8-bit */ - (P_BEAM_IP >= 128 ? 3 : 0) + - ((P_BEAM_IP + 4) >= 128 ? 3 : 0) + + (P_CALLEE_EXP >= 128 ? 3 : 0) + + ((P_CALLEE_EXP + 4) >= 128 ? 3 : 0) + (P_ARITY >= 128 ? 3 : 0); codep = code = alloc_code(codeSize); - /* movl $beamAddress, P_BEAM_IP(%ebp); 3 or 6 bytes, plus 4 */ + /* movl $callee_exp, P_CALLEE_EXP(%ebp); 3 or 6 bytes, plus 4 */ codep[0] = 0xc7; -#if P_BEAM_IP >= 128 +#if P_CALLEE_EXP >= 128 codep[1] = 0x85; /* disp32[EBP] */ - codep[2] = P_BEAM_IP & 0xFF; - codep[3] = (P_BEAM_IP >> 8) & 0xFF; - codep[4] = (P_BEAM_IP >> 16) & 0xFF; - codep[5] = (P_BEAM_IP >> 24) & 0xFF; + codep[2] = P_CALLEE_EXP & 0xFF; + codep[3] = (P_CALLEE_EXP >> 8) & 0xFF; + codep[4] = (P_CALLEE_EXP >> 16) & 0xFF; + codep[5] = (P_CALLEE_EXP >> 24) & 0xFF; codep += 6; #else codep[1] = 0x45; /* disp8[EBP] */ - codep[2] = P_BEAM_IP; + codep[2] = P_CALLEE_EXP; codep += 3; #endif - codep[0] = ((unsigned long)beamAddress ) & 0xFF; - codep[1] = ((unsigned long)beamAddress >> 8) & 0xFF; - codep[2] = ((unsigned long)beamAddress >> 16) & 0xFF; - codep[3] = ((unsigned long)beamAddress >> 24) & 0xFF; + codep[0] = ((unsigned long)callee_exp ) & 0xFF; + codep[1] = ((unsigned long)callee_exp >> 8) & 0xFF; + codep[2] = ((unsigned long)callee_exp >> 16) & 0xFF; + codep[3] = ((unsigned long)callee_exp >> 24) & 0xFF; codep += 4; - /* movl (shl 32 $beamAddress), P_BEAM_IP+4(%ebp); 3 or 6 bytes, plus 4 */ + /* movl (shl 32 $callee_exp), P_CALLEE_EXP+4(%ebp); 3 or 6 bytes, plus 4 */ codep[0] = 0xc7; -#if P_BEAM_IP+4 >= 128 +#if P_CALLEE_EXP+4 >= 128 codep[1] = 0x85; /* disp32[EBP] */ - codep[2] = (P_BEAM_IP+4) & 0xFF; - codep[3] = ((P_BEAM_IP+4) >> 8) & 0xFF; - codep[4] = ((P_BEAM_IP+4) >> 16) & 0xFF; - codep[5] = ((P_BEAM_IP+4) >> 24) & 0xFF; + codep[2] = (P_CALLEE_EXP+4) & 0xFF; + codep[3] = ((P_CALLEE_EXP+4) >> 8) & 0xFF; + codep[4] = ((P_CALLEE_EXP+4) >> 16) & 0xFF; + codep[5] = ((P_CALLEE_EXP+4) >> 24) & 0xFF; codep += 6; #else codep[1] = 0x45; /* disp8[EBP] */ - codep[2] = (P_BEAM_IP+4); + codep[2] = (P_CALLEE_EXP+4); codep += 3; #endif - codep[0] = ((unsigned long)beamAddress >> 32) & 0xFF; - codep[1] = ((unsigned long)beamAddress >> 40) & 0xFF; - codep[2] = ((unsigned long)beamAddress >> 48) & 0xFF; - codep[3] = ((unsigned long)beamAddress >> 56) & 0xFF; + codep[0] = ((unsigned long)callee_exp >> 32) & 0xFF; + codep[1] = ((unsigned long)callee_exp >> 40) & 0xFF; + codep[2] = ((unsigned long)callee_exp >> 48) & 0xFF; + codep[3] = ((unsigned long)callee_exp >> 56) & 0xFF; codep += 4; /* movb $beamArity, P_ARITY(%ebp); 3 or 6 bytes */ diff --git a/erts/emulator/hipe/hipe_amd64_asm.m4 b/erts/emulator/hipe/hipe_amd64_asm.m4 index 7c81040b8b..b4b3c073ab 100644 --- a/erts/emulator/hipe/hipe_amd64_asm.m4 +++ b/erts/emulator/hipe/hipe_amd64_asm.m4 @@ -33,7 +33,35 @@ define(HEAP_LIMIT_IN_REGISTER,0)dnl global for HL define(SIMULATE_NSP,0)dnl change to 1 to simulate call/ret insns `#define AMD64_LEAF_WORDS 'LEAF_WORDS -`#define LEAF_WORDS 'LEAF_WORDS +`#define LEAF_WORDS 'LEAF_WORDS +`#define AMD64_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + +`#define AMD64_HP_IN_REGISTER 'HP_IN_REGISTER +`#if AMD64_HP_IN_REGISTER' +`#define AMD64_HEAP_POINTER 15' +define(HP,%r15)dnl Only change this together with above +`#endif' + +`#define AMD64_FCALLS_IN_REGISTER 'FCALLS_IN_REGISTER +`#if AMD64_FCALLS_IN_REGISTER' +`#define AMD64_FCALLS_REGISTER 11' +define(FCALLS,%r11)dnl This goes together with line above +`#endif' + +`#define AMD64_HEAP_LIMIT_IN_REGISTER 'HEAP_LIMIT_IN_REGISTER +`#if AMD64_HEAP_LIMIT_IN_REGISTER' +`#define AMD64_HEAP_LIMIT_REGISTER 12' +define(HEAP_LIMIT,%r12)dnl Change this together with line above +`#endif' + +`#define AMD64_SIMULATE_NSP 'SIMULATE_NSP + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ /* * Workarounds for Darwin. @@ -63,33 +91,24 @@ ifelse(OPSYS,darwin,`` */ `#define P %rbp' -`#define AMD64_HP_IN_REGISTER 'HP_IN_REGISTER `#if AMD64_HP_IN_REGISTER -#define AMD64_HEAP_POINTER 15' -define(HP,%r15)dnl Only change this together with above -`#define SAVE_HP movq 'HP`, P_HP(P) +#define SAVE_HP movq 'HP`, P_HP(P) #define RESTORE_HP movq P_HP(P), 'HP` #else #define SAVE_HP /*empty*/ #define RESTORE_HP /*empty*/ #endif' -`#define AMD64_FCALLS_IN_REGISTER 'FCALLS_IN_REGISTER `#if AMD64_FCALLS_IN_REGISTER -#define AMD64_FCALLS_REGISTER 11' -define(FCALLS,%r11)dnl This goes together with line above -`#define SAVE_FCALLS movq 'FCALLS`, P_FCALLS(P) +#define SAVE_FCALLS movq 'FCALLS`, P_FCALLS(P) #define RESTORE_FCALLS movq P_FCALLS(P), 'FCALLS` #else #define SAVE_FCALLS /*empty*/ #define RESTORE_FCALLS /*empty*/ #endif' -`#define AMD64_HEAP_LIMIT_IN_REGISTER 'HEAP_LIMIT_IN_REGISTER `#if AMD64_HEAP_LIMIT_IN_REGISTER -#define AMD64_HEAP_LIMIT_REGISTER 12' -define(HEAP_LIMIT,%r12)dnl Change this together with line above -`#define RESTORE_HEAP_LIMIT movq P_HP_LIMIT(P), 'HEAP_LIMIT` +#define RESTORE_HEAP_LIMIT movq P_HP_LIMIT(P), 'HEAP_LIMIT` #else #define RESTORE_HEAP_LIMIT /*empty*/ #endif' @@ -99,7 +118,6 @@ define(NSP,%rsp)dnl `#define SAVE_CSP movq %rsp, P_CSP(P) #define RESTORE_CSP movq P_CSP(P), %rsp' -`#define AMD64_SIMULATE_NSP 'SIMULATE_NSP /* * Context switching macros. @@ -132,8 +150,6 @@ define(NSP,%rsp)dnl /* * Argument (parameter) registers. */ -`#define AMD64_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS define(defarg,`define(ARG$1,`$2')dnl #`define ARG'$1 $2' @@ -263,4 +279,6 @@ define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl `/* #define NBIF_RET_3 'NBIF_RET(3)` */' `/* #define NBIF_RET_5 'NBIF_RET(5)` */' +`#endif /* ASM */' + `#endif /* HIPE_AMD64_ASM_H */' diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4 index a3219c7586..7a4bb30447 100644 --- a/erts/emulator/hipe/hipe_amd64_bifs.m4 +++ b/erts/emulator/hipe/hipe_amd64_bifs.m4 @@ -18,7 +18,7 @@ changecom(`/*', `*/')dnl * %CopyrightEnd% */ - +#`define ASM' include(`hipe/hipe_amd64_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" diff --git a/erts/emulator/hipe/hipe_amd64_glue.S b/erts/emulator/hipe/hipe_amd64_glue.S index 8816906870..955f7362b4 100644 --- a/erts/emulator/hipe/hipe_amd64_glue.S +++ b/erts/emulator/hipe/hipe_amd64_glue.S @@ -17,10 +17,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_amd64_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" /* @@ -109,7 +108,7 @@ ASYM(nbif_return): * stub (hipe_x86_loader.erl) which should look as follows: * * stub for f/N: - * movq $<f's BEAM code address>, P_BEAM_IP(P) + * movq $<f's export entry address>, P_CALLEE_EXP(P) * movb $<N>, P_ARITY(P) * jmp nbif_callemu * @@ -119,7 +118,7 @@ ASYM(nbif_return): GLOBAL(ASYM(nbif_callemu)) ASYM(nbif_callemu): STORE_ARG_REGS - movl $HIPE_MODE_SWITCH_RES_CALL, %eax + movl $HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %eax jmp .suspend_exit /* diff --git a/erts/emulator/hipe/hipe_arm.c b/erts/emulator/hipe/hipe_arm.c index 3db3ffe9b1..165eb543c8 100644 --- a/erts/emulator/hipe/hipe_arm.c +++ b/erts/emulator/hipe/hipe_arm.c @@ -260,9 +260,9 @@ int hipe_patch_insn(void *address, Uint32 value, Eterm type) return 0; } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +/* Make stub for native code calling exported beam function +*/ +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { unsigned int *code; unsigned int *tramp_callemu; @@ -272,9 +272,9 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) * Native code calls BEAM via a stub looking as follows: * * mov r0, #beamArity - * ldr r8, [pc,#0] // beamAddress + * ldr r8, [pc,#0] // callee_exp * b nbif_callemu - * .long beamAddress + * .long callee_exp * * I'm using r0 and r8 since they aren't used for * parameter passing in native code. The branch to @@ -292,12 +292,12 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) /* mov r0, #beamArity */ code[0] = 0xE3A00000 | (beamArity & 0xFF); - /* ldr r8, [pc,#0] // beamAddress */ + /* ldr r8, [pc,#0] // callee_exp */ code[1] = 0xE59F8000; /* b nbif_callemu */ code[2] = 0xEA000000 | (callemu_offset & 0x00FFFFFF); - /* .long beamAddress */ - code[3] = (unsigned int)beamAddress; + /* .long callee_exp */ + code[3] = (unsigned int)callee_exp; hipe_flush_icache_range(code, 4*sizeof(int)); diff --git a/erts/emulator/hipe/hipe_arm_asm.m4 b/erts/emulator/hipe/hipe_arm_asm.m4 index 85dc84973d..b2e3f83d1e 100644 --- a/erts/emulator/hipe/hipe_arm_asm.m4 +++ b/erts/emulator/hipe/hipe_arm_asm.m4 @@ -29,6 +29,14 @@ define(LEAF_WORDS,16)dnl number of stack words for leaf functions define(NR_ARG_REGS,3)dnl admissible values are 0 to 6, inclusive `#define ARM_LEAF_WORDS 'LEAF_WORDS +`#define ARM_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ /* * Reserved registers. @@ -77,8 +85,6 @@ define(NR_ARG_REGS,3)dnl admissible values are 0 to 6, inclusive /* * Argument (parameter) registers. */ -`#define ARM_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS define(defarg,`define(ARG$1,`$2')dnl #`define ARG'$1 $2' @@ -195,4 +201,6 @@ define(QUICK_CALL_RET,`NBIF_POP_N(eval(RET_POP($2)))b $1')dnl `/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */' `/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */' +`#endif /* ASM */' + `#endif /* HIPE_ARM_ASM_H */' diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4 index bd8bc5ab6b..57e51bb8b1 100644 --- a/erts/emulator/hipe/hipe_arm_bifs.m4 +++ b/erts/emulator/hipe/hipe_arm_bifs.m4 @@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl */ +#`define ASM' include(`hipe/hipe_arm_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" diff --git a/erts/emulator/hipe/hipe_arm_glue.S b/erts/emulator/hipe/hipe_arm_glue.S index 2e2b8604a6..069cb4512e 100644 --- a/erts/emulator/hipe/hipe_arm_glue.S +++ b/erts/emulator/hipe/hipe_arm_glue.S @@ -17,10 +17,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_arm_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" .text @@ -135,7 +134,7 @@ hipe_arm_throw_to_native: * which should look as follows: * * stub for f/N: - * <set r8 to f's BEAM code address> + * <set r8 to f's export entry address> * <set r0 to N> * b nbif_callemu * @@ -143,10 +142,10 @@ hipe_arm_throw_to_native: */ .global nbif_callemu nbif_callemu: - str r8, [P, #P_BEAM_IP] + str r8, [P, #P_CALLEE_EXP] str r0, [P, #P_ARITY] STORE_ARG_REGS - mov r0, #HIPE_MODE_SWITCH_RES_CALL + mov r0, #HIPE_MODE_SWITCH_RES_CALL_EXPORTED b .suspend_exit /* diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index c9eee2acf2..9eb0b88ced 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -89,25 +89,6 @@ static Eterm address_to_term(const void *address, Process *p) /* * BIFs for reading and writing memory. Used internally by HiPE. */ -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_read_u8_1(BIF_ALIST_1) -{ - unsigned char *address = term_to_address(BIF_ARG_1); - if (!address) - BIF_ERROR(BIF_P, BADARG); - BIF_RET(make_small(*address)); -} -#endif - -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_read_u32_1(BIF_ALIST_1) -{ - Uint32 *address = term_to_address(BIF_ARG_1); - if (!address || !hipe_word32_address_ok(address)) - BIF_ERROR(BIF_P, BADARG); - BIF_RET(Uint_to_term(*address, BIF_P)); -} -#endif BIF_RETTYPE hipe_bifs_write_u8_2(BIF_ALIST_2) { @@ -120,22 +101,6 @@ BIF_RETTYPE hipe_bifs_write_u8_2(BIF_ALIST_2) BIF_RET(NIL); } -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_write_s32_2(BIF_ALIST_2) -{ - Sint32 *address; - Sint value; - - address = term_to_address(BIF_ARG_1); - if (!address || !hipe_word32_address_ok(address)) - BIF_ERROR(BIF_P, BADARG); - if (!term_to_Sint32(BIF_ARG_2, &value)) - BIF_ERROR(BIF_P, BADARG); - *address = value; - BIF_RET(NIL); -} -#endif - BIF_RETTYPE hipe_bifs_write_u32_2(BIF_ALIST_2) { Uint32 *address; @@ -639,33 +604,6 @@ BIF_RETTYPE hipe_bifs_fun_to_address_1(BIF_ALIST_1) BIF_RET(address_to_term(pc, BIF_P)); } -static void *hipe_get_emu_address(Eterm m, Eterm f, unsigned int arity, int is_remote) -{ - void *address = NULL; - if (!is_remote) - address = hipe_find_emu_address(m, f, arity); - if (!address) { - /* if not found, stub it via the export entry */ - /* no lock needed around erts_export_get_or_make_stub() */ - Export *export_entry = erts_export_get_or_make_stub(m, f, arity); - address = export_entry->addressv[erts_active_code_ix()]; - } - return address; -} - -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_get_emu_address_1(BIF_ALIST_1) -{ - struct mfa mfa; - void *address; - - if (!term_to_mfa(BIF_ARG_1, &mfa)) - BIF_ERROR(BIF_P, BADARG); - address = hipe_get_emu_address(mfa.mod, mfa.fun, mfa.ari); - BIF_RET(address_to_term(address, BIF_P)); -} -#endif - BIF_RETTYPE hipe_bifs_set_native_address_3(BIF_ALIST_3) { Eterm *pc; @@ -713,33 +651,6 @@ BIF_RETTYPE hipe_bifs_set_native_address_3(BIF_ALIST_3) BIF_RET(am_false); } -#if 0 /* XXX: unused */ -/* - * hipe_bifs_address_to_fun(Address) - * - Address is the address of the start of a emu function's code - * - returns {Module, Function, Arity} - */ -BIF_RETTYPE hipe_bifs_address_to_fun_1(BIF_ALIST_1) -{ - Eterm *pc; - Eterm *funcinfo; - Eterm *hp; - - pc = term_to_address(BIF_ARG_1); - if (!pc) - BIF_ERROR(BIF_P, BADARG); - funcinfo = find_function_from_pc(pc); - if (!funcinfo) - BIF_RET(am_false); - hp = HAlloc(BIF_P, 4); - hp[0] = make_arityval(3); - hp[1] = funcinfo[0]; - hp[2] = funcinfo[1]; - hp[3] = make_small(funcinfo[2]); - BIF_RET(make_tuple(hp)); -} -#endif - BIF_RETTYPE hipe_bifs_enter_sdesc_1(BIF_ALIST_1) { struct sdesc *sdesc; @@ -948,37 +859,6 @@ BIF_RETTYPE hipe_bifs_primop_address_1(BIF_ALIST_1) BIF_RET(address_to_term(primop->address, BIF_P)); } -#if 0 /* XXX: unused */ -/* - * hipe_bifs_gbif_address(F,A) -> address or false - */ -#define GBIF_LIST(ATOM,ARY,CFUN) extern Eterm gbif_##CFUN(void); -#include "hipe_gbif_list.h" -#undef GBIF_LIST - -BIF_RETTYPE hipe_bifs_gbif_address_2(BIF_ALIST_2) -{ - Uint arity; - void *address; - - if (is_not_atom(BIF_ARG_1) || is_not_small(BIF_ARG_2)) - BIF_RET(am_false); /* error or false, does it matter? */ - arity = signed_val(BIF_ARG_2); - /* XXX: replace with a hash table later */ - do { /* trick to let us use 'break' instead of 'goto' */ -#define GBIF_LIST(ATOM,ARY,CFUN) if (BIF_ARG_1 == ATOM && arity == ARY) { address = CFUN; break; } -#include "hipe_gbif_list.h" -#undef GBIF_LIST - printf("\r\n%s: guard BIF ", __FUNCTION__); - fflush(stdout); - erts_printf("%T", BIF_ARG_1); - printf("/%lu isn't listed in hipe_gbif_list.h\r\n", arity); - BIF_RET(am_false); - } while (0); - BIF_RET(address_to_term(address, BIF_P)); -} -#endif - BIF_RETTYPE hipe_bifs_atom_to_word_1(BIF_ALIST_1) { if (is_not_atom(BIF_ARG_1)) @@ -1028,77 +908,6 @@ void hipe_emulate_fpe(Process* p) } #endif -#if 0 /* XXX: unused */ -/* - * At least parts of this should be inlined in native code. - * The rest could be made a primop used by both the emulator and - * native code... - */ -BIF_RETTYPE hipe_bifs_make_fun_3(BIF_ALIST_3) -{ - Eterm free_vars; - Eterm mod; - Eterm *tp; - Uint index; - Uint uniq; - Uint num_free; - Eterm tmp_var; - Uint *tmp_ptr; - unsigned needed; - ErlFunThing *funp; - Eterm *hp; - int i; - - if (is_not_list(BIF_ARG_1) && is_not_nil(BIF_ARG_1)) - BIF_ERROR(BIF_P, BADARG); - free_vars = BIF_ARG_1; - - if (is_not_atom(BIF_ARG_2)) - BIF_ERROR(BIF_P, BADARG); - mod = BIF_ARG_2; - - if (is_not_tuple(BIF_ARG_3) || - (arityval(*tuple_val(BIF_ARG_3)) != 3)) - BIF_ERROR(BIF_P, BADARG); - tp = tuple_val(BIF_ARG_3); - - if (term_to_Uint(tp[1], &index) == 0) - BIF_ERROR(BIF_P, BADARG); - if (term_to_Uint(tp[2], &uniq) == 0) - BIF_ERROR(BIF_P, BADARG); - if (term_to_Uint(tp[3], &num_free) == 0) - BIF_ERROR(BIF_P, BADARG); - - needed = ERL_FUN_SIZE + num_free; - funp = (ErlFunThing *) HAlloc(BIF_P, needed); - hp = funp->env; - - funp->thing_word = HEADER_FUN; - - /* Need a ErlFunEntry *fe - * fe->refc++; - * funp->fe = fe; - */ - - funp->num_free = num_free; - funp->creator = BIF_P->id; - for (i = 0; i < num_free; i++) { - if (is_nil(free_vars)) - BIF_ERROR(BIF_P, BADARG); - tmp_ptr = list_val(free_vars); - tmp_var = CAR(tmp_ptr); - free_vars = CDR(tmp_ptr); - *hp++ = tmp_var; - } - if (is_not_nil(free_vars)) - BIF_ERROR(BIF_P, BADARG); - - funp->next = MSO(BIF_P).funs; - MSO(BIF_P).funs = funp; - - BIF_RET(make_fun(funp)); -} -#endif /* * args: Module, {Uniq, Index, BeamAddress} @@ -1163,22 +972,6 @@ BIF_RETTYPE hipe_bifs_set_native_address_in_fe_2(BIF_ALIST_2) BIF_RET(am_true); } -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_make_native_stub_2(BIF_ALIST_2) -{ - void *beamAddress; - Uint beamArity; - void *stubAddress; - - if ((beamAddress = term_to_address(BIF_ARG_1)) == 0 || - is_not_small(BIF_ARG_2) || - (beamArity = unsigned_val(BIF_ARG_2)) >= 256) - BIF_ERROR(BIF_P, BADARG); - stubAddress = hipe_make_native_stub(beamAddress, beamArity); - BIF_RET(address_to_term(stubAddress, BIF_P)); -} -#endif - /* * MFA info hash table: * - maps MFA to native code entry point @@ -1323,16 +1116,6 @@ static inline struct hipe_mfa_info *hipe_mfa_info_table_get_locked(Eterm m, Eter return NULL; } -#if 0 /* XXX: unused */ -void *hipe_mfa_find_na(Eterm m, Eterm f, unsigned int arity) -{ - const struct hipe_mfa_info *p; - - p = hipe_mfa_info_table_get(m, f, arity); - return p ? p->address : NULL; -} -#endif - static struct hipe_mfa_info *hipe_mfa_info_table_put_locked(Eterm m, Eterm f, unsigned int arity) { unsigned long h; @@ -1490,18 +1273,13 @@ void hipe_mfa_save_orig_beam_op(Eterm mod, Eterm fun, unsigned int ari, Eterm *p static void *hipe_make_stub(Eterm m, Eterm f, unsigned int arity, int is_remote) { - void *BEAMAddress; + Export *export_entry; void *StubAddress; -#if 0 - if (is_not_atom(m) || is_not_atom(f) || arity > 255) - return NULL; -#endif - BEAMAddress = hipe_get_emu_address(m, f, arity, is_remote); - StubAddress = hipe_make_native_stub(BEAMAddress, arity); -#if 0 - hipe_mfa_set_na(m, f, arity, StubAddress); -#endif + ASSERT(is_remote); + + export_entry = erts_export_get_or_make_stub(m, f, arity); + StubAddress = hipe_make_native_stub(export_entry, arity); return StubAddress; } diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index 5f92b6bac4..96a849621f 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -277,7 +277,10 @@ ifelse($1,list_to_binary_1,hipe_wrapper_list_to_binary_1, ifelse($1,iolist_to_binary_1,hipe_wrapper_iolist_to_binary_1, ifelse($1,binary_list_to_bin_1,hipe_wrapper_binary_list_to_bin_1, ifelse($1,list_to_bitstring_1,hipe_wrapper_list_to_bitstring_1, -$1)))))))))))') +ifelse($1,send_2,hipe_wrapper_send_2, +ifelse($1,send_3,hipe_wrapper_send_3, +ifelse($1,ebif_bang_2,hipe_wrapper_ebif_bang_2, +$1))))))))))))))') define(BIF_LIST,`standard_bif_interface_$3(nbif_$4, CFUN($4))') include(TARGET/`erl_bif_list.h') diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c index 32694a8f97..61406b92af 100644 --- a/erts/emulator/hipe/hipe_debug.c +++ b/erts/emulator/hipe/hipe_debug.c @@ -172,8 +172,10 @@ void hipe_print_pcb(Process *p) printf("P: 0x%0*lx\r\n", 2*(int)sizeof(long), (unsigned long)p); printf("-----------------------------------------------\r\n"); printf("Offset| Name | Value | *Value |\r\n"); +#undef U #define U(n,x) \ printf(" % 4d | %s | 0x%0*lx | |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x) +#undef P #define P(n,x) \ printf(" % 4d | %s | 0x%0*lx | 0x%0*lx |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x, 2*(int)sizeof(long), p->x ? (unsigned long)*(p->x) : -1UL) @@ -231,7 +233,7 @@ void hipe_print_pcb(Process *p) U("nsp ", hipe.nsp); U("nstack ", hipe.nstack); U("nstend ", hipe.nstend); - U("ncallee ", hipe.ncallee); + U("ncallee ", hipe.u.ncallee); hipe_arch_print_pcb(&p->hipe); #endif /* HIPE */ #undef U diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c index 86c4068072..b10263f6e2 100644 --- a/erts/emulator/hipe/hipe_gc.c +++ b/erts/emulator/hipe/hipe_gc.c @@ -22,6 +22,9 @@ #ifdef HAVE_CONFIG_H #include "config.h" #endif + +#define ERL_WANT_GC_INTERNALS__ + #include "global.h" #include "erl_gc.h" diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c index 0e287908b1..ed355ce264 100644 --- a/erts/emulator/hipe/hipe_mkliterals.c +++ b/erts/emulator/hipe/hipe_mkliterals.c @@ -498,8 +498,8 @@ static const struct rts_param rts_params[] = { { 38, "P_ARG4", 1, offsetof(struct process, def_arg_reg[4]) }, { 39, "P_ARG5", 1, offsetof(struct process, def_arg_reg[5]) }, { 40, "P_NSP", 1, offsetof(struct process, hipe.nsp) }, - { 41, "P_NCALLEE", 1, offsetof(struct process, hipe.ncallee) }, - { 42, "P_CLOSURE", 1, offsetof(struct process, hipe.closure) }, + { 41, "P_NCALLEE", 1, offsetof(struct process, hipe.u.ncallee) }, + { 42, "P_CLOSURE", 1, offsetof(struct process, hipe.u.closure) }, { 43, "P_NSP_LIMIT", 1, offsetof(struct process, hipe.nstack) }, { 44, "P_CSP", #if defined(__i386__) || defined(__x86_64__) @@ -524,6 +524,7 @@ static const struct rts_param rts_params[] = { }, { 49, "P_MSG_FIRST", 1, offsetof(struct process, msg.first) }, { 50, "P_MSG_SAVE", 1, offsetof(struct process, msg.save) }, + { 51, "P_CALLEE_EXP", 1, offsetof(struct process, hipe.u.callee_exp) }, }; #define NR_PARAMS ARRAY_SIZE(rts_params) diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index 1ae1d17b7f..8c73312d45 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -140,7 +140,6 @@ void hipe_check_pcb(Process *p, const char *file, unsigned line) #endif /* HIPE_DEBUG > 0 */ /* ensure that at least nwords words are available on the native stack */ -static void hipe_check_nstack(Process *p, unsigned nwords); #if defined(__sparc__) #include "hipe_sparc_glue.h" @@ -159,7 +158,7 @@ static void hipe_check_nstack(Process *p, unsigned nwords); Uint hipe_beam_pc_return[1]; /* needed in hipe_debug.c */ Uint hipe_beam_pc_throw[1]; /* needed in hipe_debug.c */ Uint hipe_beam_pc_resume[1]; /* needed by hipe_set_timeout() */ -static Eterm hipe_beam_catch_throw; +Eterm hipe_beam_catch_throw; void hipe_mode_switch_init(void) { @@ -185,22 +184,6 @@ void hipe_set_call_trap(Uint *bfun, void *nfun, int is_closure) bfun[-4] = (Uint)nfun; } -void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) -{ - if (!hipe_bifcall_from_native_is_recursive(p)) - return; - - /* ensure that at least 2 words are available on the BEAM stack */ - if ((p->stop - 2) < p->htop) { - DPRINTF("calling gc to reserve BEAM stack size"); - p->fcalls -= erts_garbage_collect(p, 2, reg, arity); - ASSERT(!((p->stop - 2) < p->htop)); - } - p->stop -= 2; - p->stop[0] = NIL; - p->stop[1] = hipe_beam_catch_throw; -} - static __inline__ void hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) { @@ -223,15 +206,6 @@ hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) p->cp = hipe_beam_pc_return; } -void hipe_unreserve_beam_trap_frame(Process *p) -{ - if (!hipe_bifcall_from_native_is_recursive(p)) - return; - - ASSERT(p->stop[0] == NIL && p->stop[1] == hipe_beam_catch_throw); - p->stop += 2; -} - static __inline__ void hipe_pop_beam_trap_frame(Process *p) { ASSERT(p->stop[1] == hipe_beam_catch_throw); @@ -265,14 +239,14 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) /* BEAM calls a native code function */ unsigned arity = cmd >> 8; - /* p->hipe.ncallee set in beam_emu */ + /* p->hipe.u.ncallee set in beam_emu */ if (p->cp == hipe_beam_pc_return) { /* Native called BEAM, which now tailcalls native. */ hipe_pop_beam_trap_frame(p); result = hipe_tailcall_to_native(p, arity, reg); break; } - DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity); + DPRINTF("calling %#lx/%u", (long)p->hipe.u.ncallee, arity); result = hipe_call_to_native(p, arity, reg); break; } @@ -290,18 +264,18 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) arity -= funp->num_free; /* arity == #formals */ reg[arity] = fun; ++arity; /* correct for having added the closure */ - /* HIPE_ASSERT(p->hipe.ncallee == (void(*)(void))funp->native_address); */ + /* HIPE_ASSERT(p->hipe.u.ncallee == (void(*)(void))funp->native_address); */ /* just like a normal call from now on */ - /* p->hipe.ncallee set in beam_emu */ + /* p->hipe.u.ncallee set in beam_emu */ if (p->cp == hipe_beam_pc_return) { /* Native called BEAM, which now tailcalls native. */ hipe_pop_beam_trap_frame(p); result = hipe_tailcall_to_native(p, arity, reg); break; } - DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity); + DPRINTF("calling %#lx/%u", (long)p->hipe.u.ncallee, arity); result = hipe_call_to_native(p, arity, reg); break; } @@ -404,13 +378,13 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) if (is_recursive) hipe_push_beam_trap_frame(p, reg, p->arity); - result = HIPE_MODE_SWITCH_RES_CALL; + result = HIPE_MODE_SWITCH_RES_CALL_BEAM; break; } - case HIPE_MODE_SWITCH_RES_CALL: { + case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: { /* Native code calls or tailcalls BEAM. * - * p->i is the callee's BEAM code + * p->hipe.u.callee_exp is the callee's export entry * p->arity is the callee's arity * p->def_arg_reg[] contains the register parameters * p->hipe.nsp[] contains the stacked parameters @@ -430,15 +404,15 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) * F(A1, ..., AN, FV1, ..., FVM, Closure) * (Where Ai is argument i and FVj is free variable j) * - * p->hipe.closure contains the closure + * p->hipe.u.closure contains the closure * p->def_arg_reg[] contains the register parameters * p->hipe.nsp[] contains the stacked parameters */ ErlFunThing *closure; unsigned num_free, arity, i, is_recursive; - HIPE_ASSERT(is_fun(p->hipe.closure)); - closure = (ErlFunThing*)fun_val(p->hipe.closure); + HIPE_ASSERT(is_fun(p->hipe.u.closure)); + closure = (ErlFunThing*)fun_val(p->hipe.u.closure); num_free = closure->num_free; arity = closure->fe->arity; @@ -468,10 +442,10 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) p->i = closure->fe->address; /* Change result code to the faster plain CALL type. */ - result = HIPE_MODE_SWITCH_RES_CALL; + result = HIPE_MODE_SWITCH_RES_CALL_BEAM; } /* Append the closure as the last parameter. Don't increment arity. */ - reg[arity] = p->hipe.closure; + reg[arity] = p->hipe.u.closure; if (is_recursive) { /* BEAM called native, which now calls BEAM. @@ -549,7 +523,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) } } HIPE_CHECK_PCB(p); - result = HIPE_MODE_SWITCH_RES_CALL; + result = HIPE_MODE_SWITCH_RES_CALL_BEAM; p->def_arg_reg[3] = result; return p; } @@ -577,7 +551,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) address = hipe_get_remote_na(mfa[0], mfa[1], arity); if (!address) goto do_apply_fail; - p->hipe.ncallee = (void(*)(void)) address; + p->hipe.u.ncallee = (void(*)(void)) address; result = hipe_tailcall_to_native(p, arity, reg); goto do_return_from_native; do_apply_fail: @@ -607,7 +581,6 @@ static unsigned hipe_next_nstack_size(unsigned size) } #if 0 && defined(HIPE_NSTACK_GROWS_UP) -#define hipe_nstack_avail(p) ((p)->hipe.nstend - (p)->hipe.nsp) void hipe_inc_nstack(Process *p) { Eterm *old_nstack = p->hipe.nstack; @@ -631,7 +604,6 @@ void hipe_inc_nstack(Process *p) #endif #if defined(HIPE_NSTACK_GROWS_DOWN) -#define hipe_nstack_avail(p) ((unsigned)((p)->hipe.nsp - (p)->hipe.nstack)) void hipe_inc_nstack(Process *p) { unsigned old_size = p->hipe.nstend - p->hipe.nstack; @@ -663,12 +635,6 @@ void hipe_empty_nstack(Process *p) p->hipe.nstend = NULL; } -static void hipe_check_nstack(Process *p, unsigned nwords) -{ - while (hipe_nstack_avail(p) < nwords) - hipe_inc_nstack(p); -} - void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free) { unsigned arity; diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h index 06721e3c04..b8de12fcbb 100644 --- a/erts/emulator/hipe/hipe_mode_switch.h +++ b/erts/emulator/hipe/hipe_mode_switch.h @@ -31,7 +31,7 @@ /* result codes for beam_emu <- hipe_mode_switch() return */ #define HIPE_MODE_SWITCH_RES_RETURN 4 -#define HIPE_MODE_SWITCH_RES_CALL 5 +#define HIPE_MODE_SWITCH_RES_CALL_EXPORTED 5 #define HIPE_MODE_SWITCH_RES_THROW 6 /* additional result codes for hipe_mode_switch() <- native return */ @@ -45,6 +45,8 @@ #define HIPE_MODE_SWITCH_RES_APPLY 13 /* mode_switch <- native */ +#define HIPE_MODE_SWITCH_RES_CALL_BEAM 14 + #ifndef ASM #include "error.h" @@ -59,13 +61,58 @@ void hipe_empty_nstack(Process *p); void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free); Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s); -void hipe_reserve_beam_trap_frame(Process*, Eterm reg[], unsigned arity); -void hipe_unreserve_beam_trap_frame(Process*); +ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process*, Eterm reg[], unsigned arity); +ERTS_GLB_INLINE void hipe_unreserve_beam_trap_frame(Process*); extern Uint hipe_beam_pc_return[]; extern Uint hipe_beam_pc_throw[]; extern Uint hipe_beam_pc_resume[]; +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +#include "erl_gc.h" +#include "hipe_stack.h" + +#if defined(__sparc__) +#include "hipe_sparc_glue.h" +#elif defined(__i386__) +#include "hipe_x86_glue.h" +#elif defined(__x86_64__) +#include "hipe_amd64_glue.h" +#elif defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) +#include "hipe_ppc_glue.h" +#elif defined(__arm__) +#include "hipe_arm_glue.h" +#endif + +extern Eterm hipe_beam_catch_throw; + +ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) +{ + if (!hipe_bifcall_from_native_is_recursive(p)) + return; + + /* ensure that at least 2 words are available on the BEAM stack */ + if ((p->stop - 2) < p->htop) { + p->fcalls -= erts_garbage_collect(p, 2, reg, arity); + ASSERT(!((p->stop - 2) < p->htop)); + } + p->stop -= 2; + p->stop[0] = NIL; + p->stop[1] = hipe_beam_catch_throw; +} + +ERTS_GLB_INLINE void hipe_unreserve_beam_trap_frame(Process *p) +{ + if (!hipe_bifcall_from_native_is_recursive(p)) + return; + + ASSERT(p->stop[0] == NIL && p->stop[1] == hipe_beam_catch_throw); + p->stop += 2; +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + #endif /* ASM */ #endif /* HIPE_MODE_SWITCH_H */ diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 7d343dd91e..7e8632b50d 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -330,8 +330,6 @@ char *hipe_bs_allocate(int len) Binary *bptr; bptr = erts_bin_nrml_alloc(len); - bptr->flags = 0; - bptr->orig_size = len; erts_smp_atomic_init_nob(&bptr->refc, 1); return bptr->orig_bytes; } @@ -341,7 +339,6 @@ Binary *hipe_bs_reallocate(Binary* oldbptr, int newsize) Binary *bptr; bptr = erts_bin_realloc(oldbptr, newsize); - bptr->orig_size = newsize; return bptr; } diff --git a/erts/emulator/hipe/hipe_ppc.c b/erts/emulator/hipe/hipe_ppc.c index 2d8fd61e1e..4dc26cdbc8 100644 --- a/erts/emulator/hipe/hipe_ppc.c +++ b/erts/emulator/hipe/hipe_ppc.c @@ -285,7 +285,7 @@ int hipe_patch_insn(void *address, Uint64 value, Eterm type) } } -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { unsigned int *code; @@ -294,16 +294,16 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) code = alloc_stub(7); - /* addis r12,0,beamAddress@highest */ - code[0] = 0x3d800000 | (((unsigned long)beamAddress >> 48) & 0xffff); - /* ori r12,r12,beamAddress@higher */ - code[1] = 0x618c0000 | (((unsigned long)beamAddress >> 32) & 0xffff); + /* addis r12,0,callee_exp@highest */ + code[0] = 0x3d800000 | (((unsigned long)callee_exp >> 48) & 0xffff); + /* ori r12,r12,callee_exp@higher */ + code[1] = 0x618c0000 | (((unsigned long)callee_exp >> 32) & 0xffff); /* sldi r12,r12,32 (rldicr r12,r12,32,31) */ code[2] = 0x798c07c6; - /* oris r12,r12,beamAddress@h */ - code[3] = 0x658c0000 | (((unsigned long)beamAddress >> 16) & 0xffff); - /* ori r12,r12,beamAddress@l */ - code[4] = 0x618c0000 | ((unsigned long)beamAddress & 0xffff); + /* oris r12,r12,callee_exp@h */ + code[3] = 0x658c0000 | (((unsigned long)callee_exp >> 16) & 0xffff); + /* ori r12,r12,callee_exp@l */ + code[4] = 0x618c0000 | ((unsigned long)callee_exp & 0xffff); /* addi r0,0,beamArity */ code[5] = 0x38000000 | (beamArity & 0x7FFF); /* ba nbif_callemu */ @@ -355,18 +355,16 @@ int hipe_patch_insn(void *address, Uint32 value, Eterm type) return 0; } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { unsigned int *code; /* * Native code calls BEAM via a stub looking as follows: * - * addi r12,0,beamAddress@l + * addi r12,0,callee_exp@l * addi r0,0,beamArity - * addis r12,r12,beamAddress@ha + * addis r12,r12,callee_exp@ha * ba nbif_callemu * * I'm using r0 and r12 since the standard SVR4 ABI allows @@ -384,12 +382,12 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) code = alloc_stub(4); - /* addi r12,0,beamAddress@l */ - code[0] = 0x39800000 | ((unsigned long)beamAddress & 0xFFFF); + /* addi r12,0,callee_exp@l */ + code[0] = 0x39800000 | ((unsigned long)callee_exp & 0xFFFF); /* addi r0,0,beamArity */ code[1] = 0x38000000 | (beamArity & 0x7FFF); - /* addis r12,r12,beamAddress@ha */ - code[2] = 0x3D8C0000 | at_ha((unsigned long)beamAddress); + /* addis r12,r12,callee_exp@ha */ + code[2] = 0x3D8C0000 | at_ha((unsigned long)callee_exp); /* ba nbif_callemu */ code[3] = 0x48000002 | (unsigned long)&nbif_callemu; diff --git a/erts/emulator/hipe/hipe_ppc_asm.m4 b/erts/emulator/hipe/hipe_ppc_asm.m4 index 343402f9f0..4a1caa1543 100644 --- a/erts/emulator/hipe/hipe_ppc_asm.m4 +++ b/erts/emulator/hipe/hipe_ppc_asm.m4 @@ -23,6 +23,22 @@ changecom(`/*', `*/')dnl #define HIPE_PPC_ASM_H' /* + * Tunables. + */ +define(LEAF_WORDS,16)dnl number of stack words for leaf functions +define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive + +`#define PPC_LEAF_WORDS 'LEAF_WORDS +`#define PPC_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ + +/* * Handle 32 vs 64-bit. */ ifelse(ARCH,ppc64,` @@ -53,13 +69,6 @@ define(WSIZE,4)dnl `#define STORE 'STORE `#define CMPI 'CMPI -/* - * Tunables. - */ -define(LEAF_WORDS,16)dnl number of stack words for leaf functions -define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive - -`#define PPC_LEAF_WORDS 'LEAF_WORDS /* * Workarounds for Darwin. @@ -193,8 +202,6 @@ NAME: \ /* * Argument (parameter) registers. */ -`#define PPC_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS define(defarg,`define(ARG$1,`$2')dnl #`define ARG'$1 $2' @@ -309,4 +316,6 @@ define(QUICK_CALL_RET,`NBIF_POP_N(eval(RET_POP($2)))b $1')dnl `/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */' `/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */' +`#endif /* ASM */' + `#endif /* HIPE_PPC_ASM_H */' diff --git a/erts/emulator/hipe/hipe_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4 index 7cc2b5c7b6..f53b79b52e 100644 --- a/erts/emulator/hipe/hipe_ppc_bifs.m4 +++ b/erts/emulator/hipe/hipe_ppc_bifs.m4 @@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl */ +#`define ASM' include(`hipe/hipe_ppc_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" diff --git a/erts/emulator/hipe/hipe_ppc_glue.S b/erts/emulator/hipe/hipe_ppc_glue.S index 6f0217c738..c48fb150af 100644 --- a/erts/emulator/hipe/hipe_ppc_glue.S +++ b/erts/emulator/hipe/hipe_ppc_glue.S @@ -17,10 +17,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_ppc_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" .text @@ -296,7 +295,7 @@ CSYM(hipe_ppc_throw_to_native): * which should look as follows: * * stub for f/N: - * <set r12 to f's BEAM code address> + * <set r12 to f's export entry address> * <set r0 to N> * b nbif_callemu * @@ -312,10 +311,10 @@ CSYM(hipe_ppc_throw_to_native): */ GLOBAL(ASYM(nbif_callemu)) ASYM(nbif_callemu): - STORE r12, P_BEAM_IP(P) + STORE r12, P_CALLEE_EXP(P) STORE r0, P_ARITY(P) STORE_ARG_REGS - li r3, HIPE_MODE_SWITCH_RES_CALL + li r3, HIPE_MODE_SWITCH_RES_CALL_EXPORTED b .suspend_exit /* diff --git a/erts/emulator/hipe/hipe_process.h b/erts/emulator/hipe/hipe_process.h index 4ee99d78a2..86655ad42c 100644 --- a/erts/emulator/hipe/hipe_process.h +++ b/erts/emulator/hipe/hipe_process.h @@ -23,14 +23,17 @@ #define HIPE_PROCESS_H #include "erl_alloc.h" +#include "export.h" struct hipe_process_state { Eterm *nsp; /* Native stack pointer. */ Eterm *nstack; /* Native stack block start. */ Eterm *nstend; /* Native stack block end (start+size). */ - /* XXX: ncallee and closure could share space in a union */ - void (*ncallee)(void); /* Native code callee (label) to invoke. */ - Eterm closure; /* Used to pass a closure from native code. */ + union { + void (*ncallee)(void); /* Native code callee (label) to invoke. */ + Eterm closure; /* Used to pass a closure from native code. */ + Export* callee_exp; /* Used to pass export entry from native code */ + }u; Eterm *nstgraylim; /* Gray/white stack boundary. */ Eterm *nstblacklim; /* Black/gray stack boundary. Must exist if graylim exists. Ignored if no graylim. */ diff --git a/erts/emulator/hipe/hipe_risc_stack.c b/erts/emulator/hipe/hipe_risc_stack.c index 1183856c7e..bea3a0fecd 100644 --- a/erts/emulator/hipe/hipe_risc_stack.c +++ b/erts/emulator/hipe/hipe_risc_stack.c @@ -226,7 +226,7 @@ void (*hipe_handle_stack_trap(Process *p))(void) * The native stack MUST contain a stack frame as it appears on * entry to a function (actuals, caller's frame, caller's return address). * p->hipe.narity MUST contain the arity (number of actuals). - * On exit, p->hipe.ncallee is set to the handler's PC and p->hipe.nsp + * On exit, p->hipe.u.ncallee is set to the handler's PC and p->hipe.nsp * is set to its SP (low address of its stack frame). */ void hipe_find_handler(Process *p) @@ -254,7 +254,7 @@ void hipe_find_handler(Process *p) if ((exnra = sdesc_exnra(sdesc)) != 0 && (p->catches >= 0 || exnra == (unsigned long)&nbif_fail)) { - p->hipe.ncallee = (void(*)(void)) exnra; + p->hipe.u.ncallee = (void(*)(void)) exnra; p->hipe.nsp = nsp; p->hipe.narity = 0; /* update the gray/white boundary if we threw past it */ diff --git a/erts/emulator/hipe/hipe_sparc.c b/erts/emulator/hipe/hipe_sparc.c index 49d4da7bab..2052aa8498 100644 --- a/erts/emulator/hipe/hipe_sparc.c +++ b/erts/emulator/hipe/hipe_sparc.c @@ -204,9 +204,7 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process * return alloc_code(nrbytes); } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { unsigned int *code; unsigned int callEmuOffset; @@ -215,11 +213,11 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) code = alloc_code(5*sizeof(int)); /* sethi %hi(Address), %i4 */ - code[0] = 0x39000000 | (((unsigned int)beamAddress >> 10) & 0x3FFFFF); + code[0] = 0x39000000 | (((unsigned int)callee_exp >> 10) & 0x3FFFFF); /* or %g0, %o7, %i3 ! mov %o7, %i3 */ code[1] = 0xB610000F; /* or %i4, %lo(Address), %i4 */ - code[2] = 0xB8172000 | ((unsigned int)beamAddress & 0x3FF); + code[2] = 0xB8172000 | ((unsigned int)callee_exp & 0x3FF); /* call callemu */ callEmuOffset = (char*)nbif_callemu - (char*)&code[3]; code[3] = (1 << 30) | ((callEmuOffset >> 2) & 0x3FFFFFFF); diff --git a/erts/emulator/hipe/hipe_sparc_asm.m4 b/erts/emulator/hipe/hipe_sparc_asm.m4 index 227d10ed80..c3c3bcb74a 100644 --- a/erts/emulator/hipe/hipe_sparc_asm.m4 +++ b/erts/emulator/hipe/hipe_sparc_asm.m4 @@ -29,6 +29,14 @@ define(LEAF_WORDS,16)dnl number of stack words for leaf functions define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive `#define SPARC_LEAF_WORDS 'LEAF_WORDS +`#define SPARC_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ /* * Reserved registers. @@ -80,9 +88,6 @@ define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive /* * Argument (parameter) registers. */ -`#define SPARC_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS - define(defarg,`define(ARG$1,`$2')dnl #`define ARG'$1 $2' )dnl @@ -210,4 +215,6 @@ define(QUICK_CALL_RET,`ba $1; NBIF_POP_N(eval(RET_POP($2)))')dnl `/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */' `/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */' +`#endif /* ASM */' + `#endif /* HIPE_SPARC_ASM_H */' diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4 index ca5af45d58..2bfe3a4646 100644 --- a/erts/emulator/hipe/hipe_sparc_bifs.m4 +++ b/erts/emulator/hipe/hipe_sparc_bifs.m4 @@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl */ +#`define ASM' include(`hipe/hipe_sparc_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" diff --git a/erts/emulator/hipe/hipe_sparc_glue.S b/erts/emulator/hipe/hipe_sparc_glue.S index 44bdf1bc7e..6c8c841194 100644 --- a/erts/emulator/hipe/hipe_sparc_glue.S +++ b/erts/emulator/hipe/hipe_sparc_glue.S @@ -18,10 +18,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_sparc_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" .section ".text" @@ -155,9 +154,9 @@ hipe_sparc_throw_to_native: * which should look as follows: * * stub for f/N: - * sethi %hi(f's BEAM code address), TEMP_ARG0 + * sethi %hi(f's export entry address), TEMP_ARG0 * mov RA, TEMP_RA ! because the call below clobbers RA (%o7) - * or TEMP_ARG0, %lo(f's BEAM code address), TEMP_ARG0 + * or TEMP_ARG0, %lo(f's export entry address), TEMP_ARG0 * call nbif_callemu ! clobbers RA! * mov N, TEMP_ARG1 ! delay slot: TEMP_ARG1 := ARITY * @@ -165,12 +164,12 @@ hipe_sparc_throw_to_native: */ .global nbif_callemu nbif_callemu: - st TEMP_ARG0, [P+P_BEAM_IP] + st TEMP_ARG0, [P+P_CALLEE_EXP] st TEMP_ARG1, [P+P_ARITY] st TEMP_RA, [P+P_NRA] STORE_ARG_REGS ba .flush_exit - mov HIPE_MODE_SWITCH_RES_CALL, %o0 + mov HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %o0 /* * nbif_apply diff --git a/erts/emulator/hipe/hipe_stack.h b/erts/emulator/hipe/hipe_stack.h index 66f9f04c73..4cfdb54dd8 100644 --- a/erts/emulator/hipe/hipe_stack.h +++ b/erts/emulator/hipe/hipe_stack.h @@ -108,12 +108,23 @@ extern int hipe_fill_stacktrace(Process*, int, Eterm**); #if 0 && defined(HIPE_NSTACK_GROWS_UP) #define hipe_nstack_start(p) ((p)->hipe.nstack) #define hipe_nstack_used(p) ((p)->hipe.nsp - (p)->hipe.nstack) +#define hipe_nstack_avail(p) ((p)->hipe.nstend - (p)->hipe.nsp) #endif #if defined(HIPE_NSTACK_GROWS_DOWN) #define hipe_nstack_start(p) ((p)->hipe.nsp) #define hipe_nstack_used(p) ((p)->hipe.nstend - (p)->hipe.nsp) +#define hipe_nstack_avail(p) ((unsigned)((p)->hipe.nsp - (p)->hipe.nstack)) #endif +/* ensure that at least nwords words are available on the native stack */ +static __inline__ void hipe_check_nstack(Process *p, unsigned nwords) +{ + extern void hipe_inc_nstack(Process *p); + + while (hipe_nstack_avail(p) < nwords) + hipe_inc_nstack(p); +} + /* * GC support procedures */ diff --git a/erts/emulator/hipe/hipe_x86.c b/erts/emulator/hipe/hipe_x86.c index 327c74e9aa..314f6b597c 100644 --- a/erts/emulator/hipe/hipe_x86.c +++ b/erts/emulator/hipe/hipe_x86.c @@ -182,18 +182,16 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process * return alloc_code(nrbytes); } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { /* * This creates a native code stub with the following contents: * - * movl $Address, P_BEAM_IP(%ebp) + * movl $Address, P_CALLEE_EXP(%ebp) * movb $Arity, P_ARITY(%ebp) * jmp callemu * - * The stub has variable size, depending on whether the P_BEAM_IP + * The stub has variable size, depending on whether the P_CALLEE_EXP * and P_ARITY offsets fit in 8-bit signed displacements or not. * The rel32 offset in the final jmp depends on its actual location, * which also depends on the size of the previous instructions. @@ -206,28 +204,28 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) codeSize = /* 16, 19, or 22 bytes */ 16 + /* 16 when both offsets are 8-bit */ - (P_BEAM_IP >= 128 ? 3 : 0) + + (P_CALLEE_EXP >= 128 ? 3 : 0) + (P_ARITY >= 128 ? 3 : 0); codep = code = alloc_code(codeSize); - /* movl $beamAddress, P_BEAM_IP(%ebp); 3 or 6 bytes, plus 4 */ + /* movl $beamAddress, P_CALLEE_EXP(%ebp); 3 or 6 bytes, plus 4 */ codep[0] = 0xc7; -#if P_BEAM_IP >= 128 +#if P_CALLEE_EXP >= 128 codep[1] = 0x85; /* disp32[EBP] */ - codep[2] = P_BEAM_IP & 0xFF; - codep[3] = (P_BEAM_IP >> 8) & 0xFF; - codep[4] = (P_BEAM_IP >> 16) & 0xFF; - codep[5] = (P_BEAM_IP >> 24) & 0xFF; + codep[2] = P_CALLEE_EXP & 0xFF; + codep[3] = (P_CALLEE_EXP >> 8) & 0xFF; + codep[4] = (P_CALLEE_EXP >> 16) & 0xFF; + codep[5] = (P_CALLEE_EXP >> 24) & 0xFF; codep += 6; #else codep[1] = 0x45; /* disp8[EBP] */ - codep[2] = P_BEAM_IP; + codep[2] = P_CALLEE_EXP; codep += 3; #endif - codep[0] = ((unsigned int)beamAddress) & 0xFF; - codep[1] = ((unsigned int)beamAddress >> 8) & 0xFF; - codep[2] = ((unsigned int)beamAddress >> 16) & 0xFF; - codep[3] = ((unsigned int)beamAddress >> 24) & 0xFF; + codep[0] = ((unsigned int)callee_exp) & 0xFF; + codep[1] = ((unsigned int)callee_exp >> 8) & 0xFF; + codep[2] = ((unsigned int)callee_exp >> 16) & 0xFF; + codep[3] = ((unsigned int)callee_exp >> 24) & 0xFF; codep += 4; /* movb $beamArity, P_ARITY(%ebp); 3 or 6 bytes */ diff --git a/erts/emulator/hipe/hipe_x86_asm.m4 b/erts/emulator/hipe/hipe_x86_asm.m4 index 020ccf8d4b..39c5cb1044 100644 --- a/erts/emulator/hipe/hipe_x86_asm.m4 +++ b/erts/emulator/hipe/hipe_x86_asm.m4 @@ -33,6 +33,18 @@ define(SIMULATE_NSP,0)dnl change to 1 to simulate call/ret insns `#define X86_LEAF_WORDS 'LEAF_WORDS `#define LEAF_WORDS 'LEAF_WORDS +`#define X86_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + +`#define X86_HP_IN_ESI 'HP_IN_ESI +`#define X86_SIMULATE_NSP 'SIMULATE_NSP + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ + /* * Workarounds for Darwin. */ @@ -60,7 +72,6 @@ ifelse(OPSYS,darwin,`` */ `#define P %ebp' -`#define X86_HP_IN_ESI 'HP_IN_ESI `#if X86_HP_IN_ESI #define SAVE_HP movl %esi, P_HP(P) #define RESTORE_HP movl P_HP(P), %esi @@ -73,7 +84,6 @@ ifelse(OPSYS,darwin,`` #define SAVE_CSP movl %esp, P_CSP(P) #define RESTORE_CSP movl P_CSP(P), %esp' -`#define X86_SIMULATE_NSP 'SIMULATE_NSP /* * Context switching macros. @@ -100,12 +110,10 @@ ifelse(OPSYS,darwin,`` SAVE_CACHED_STATE; \ SWITCH_ERLANG_TO_C_QUICK' + /* * Argument (parameter) registers. */ -`#define X86_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS - ifelse(eval(NR_ARG_REGS >= 1),0,, ``#define ARG0 %eax '')dnl @@ -282,4 +290,6 @@ define(LOAD_CALLER_SAVE,`LAR_N(eval(NR_CALLER_SAVE-1))')dnl `#define STORE_CALLER_SAVE 'STORE_CALLER_SAVE `#define LOAD_CALLER_SAVE 'LOAD_CALLER_SAVE +`#endif /* ASM */' + `#endif /* HIPE_X86_ASM_H */' diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4 index dd6980f555..a0f16efa33 100644 --- a/erts/emulator/hipe/hipe_x86_bifs.m4 +++ b/erts/emulator/hipe/hipe_x86_bifs.m4 @@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl */ +#`define ASM' include(`hipe/hipe_x86_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" diff --git a/erts/emulator/hipe/hipe_x86_glue.S b/erts/emulator/hipe/hipe_x86_glue.S index 88b86f4de7..9d38eaaafd 100644 --- a/erts/emulator/hipe/hipe_x86_glue.S +++ b/erts/emulator/hipe/hipe_x86_glue.S @@ -18,10 +18,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_x86_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" /* @@ -104,7 +103,7 @@ ASYM(nbif_return): * stub (hipe_x86_loader.erl) which should look as follows: * * stub for f/N: - * movl $<f's BEAM code address>, P_BEAM_IP(P) + * movl $<f's export entry address>, P_CALLEE_EXP(P) * movb $<N>, P_ARITY(P) * jmp nbif_callemu * @@ -114,7 +113,7 @@ ASYM(nbif_return): GLOBAL(ASYM(nbif_callemu)) ASYM(nbif_callemu): STORE_ARG_REGS - movl $HIPE_MODE_SWITCH_RES_CALL, %eax + movl $HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %eax jmp .suspend_exit /* diff --git a/erts/emulator/hipe/hipe_x86_stack.c b/erts/emulator/hipe/hipe_x86_stack.c index 9ad3fa9d31..7f1c2f7d41 100644 --- a/erts/emulator/hipe/hipe_x86_stack.c +++ b/erts/emulator/hipe/hipe_x86_stack.c @@ -209,7 +209,7 @@ void (*hipe_handle_stack_trap(Process *p))(void) * The native stack MUST contain a stack frame as it appears on * entry to a function (return address, actuals, caller's frame). * p->hipe.narity MUST contain the arity (number of actuals). - * On exit, p->hipe.ncallee is set to the handler's PC and p->hipe.nsp + * On exit, p->hipe.u.ncallee is set to the handler's PC and p->hipe.nsp * is set to its SP (low address of its stack frame). */ void hipe_find_handler(Process *p) @@ -240,7 +240,7 @@ void hipe_find_handler(Process *p) if ((exnra = sdesc_exnra(sdesc)) != 0 && (p->catches >= 0 || exnra == (unsigned long)nbif_fail)) { - p->hipe.ncallee = (void(*)(void)) exnra; + p->hipe.u.ncallee = (void(*)(void)) exnra; p->hipe.nsp = nsp; p->hipe.narity = 0; /* update the gray/white boundary if we threw past it */ diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 0d677d5f34..5de0c281c4 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -34,6 +34,7 @@ #include <termios.h> #include <ctype.h> #include <sys/utsname.h> +#include <sys/select.h> #ifdef ISC32 #include <sys/bsdtypes.h> @@ -91,8 +92,10 @@ static erts_smp_rwmtx_t environ_rwmtx; # else # define CHLDWTHR 0 # endif +# define FDBLOCK 1 #else # define CHLDWTHR 0 +# define FDBLOCK 0 #endif /* * [OTP-3906] @@ -121,6 +124,15 @@ struct ErtsSysReportExit_ { #endif }; +/* Used by the fd driver iff the fd could not be set to non-blocking */ +typedef struct ErtsSysBlocking_ { + ErlDrvPDL pdl; + int res; + int err; + unsigned int pkey; +} ErtsSysBlocking; + + /* This data is shared by these drivers - initialized by spawn_init() */ static struct driver_data { ErlDrvPort port_num; @@ -129,6 +141,8 @@ static struct driver_data { int pid; int alive; int status; + int terminating; + ErtsSysBlocking *blocking; } *driver_data; /* indexed by fd */ static ErtsSysReportExit *report_exit_list; @@ -1108,11 +1122,16 @@ void fini_getenv_state(GETENV_STATE *state) /* Driver interfaces */ static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*); +#if FDBLOCK +static void fd_async(void *); +static void fd_ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data); +#endif static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT, char **, ErlDrvSizeT); static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*); static int spawn_init(void); static void fd_stop(ErlDrvData); +static void fd_flush(ErlDrvData); static void stop(ErlDrvData); static void ready_input(ErlDrvData, ErlDrvEvent); static void ready_output(ErlDrvData, ErlDrvEvent); @@ -1157,8 +1176,12 @@ struct erl_drv_entry fd_driver_entry = { fd_control, NULL, outputv, - NULL, /* ready_async */ - NULL, /* flush */ +#if FDBLOCK + fd_ready_async, /* ready_async */ +#else + NULL, +#endif + fd_flush, /* flush */ NULL, /* call */ NULL, /* event */ ERL_DRV_EXTENDED_MARKER, @@ -1212,13 +1235,28 @@ static RETSIGTYPE onchld(int signum) #endif } +static int set_blocking_data(struct driver_data *dd) { + + dd->blocking = erts_alloc(ERTS_ALC_T_SYS_BLOCKING, sizeof(ErtsSysBlocking)); + + erts_smp_atomic_add_nob(&sys_misc_mem_sz, sizeof(ErtsSysBlocking)); + + dd->blocking->pdl = driver_pdl_create(dd->port_num); + dd->blocking->res = 0; + dd->blocking->err = 0; + dd->blocking->pkey = driver_async_port_key(dd->port_num); + + return 1; +} + static int set_driver_data(ErlDrvPort port_num, int ifd, int ofd, int packet_bytes, int read_write, int exit_status, - int pid) + int pid, + int is_blocking) { Port *prt; ErtsSysReportExit *report_exit; @@ -1250,8 +1288,13 @@ static int set_driver_data(ErlDrvPort port_num, driver_data[ifd].pid = pid; driver_data[ifd].alive = 1; driver_data[ifd].status = 0; + driver_data[ifd].terminating = 0; + driver_data[ifd].blocking = NULL; if (read_write & DO_WRITE) { driver_data[ifd].ofd = ofd; + if (is_blocking && FDBLOCK) + if (!set_blocking_data(driver_data+ifd)) + return -1; if (ifd != ofd) driver_data[ofd] = driver_data[ifd]; /* structure copy */ } else { /* DO_READ only */ @@ -1267,6 +1310,11 @@ static int set_driver_data(ErlDrvPort port_num, driver_data[ofd].pid = pid; driver_data[ofd].alive = 1; driver_data[ofd].status = 0; + driver_data[ofd].terminating = 0; + driver_data[ofd].blocking = NULL; + if (is_blocking && FDBLOCK) + if (!set_blocking_data(driver_data+ofd)) + return -1; return(ofd); } } @@ -1276,6 +1324,7 @@ static int spawn_init() int i; #if CHLDWTHR erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER; + thr_opts.detached = 0; thr_opts.suggested_stack_size = 0; /* Smallest possible */ #endif @@ -1755,7 +1804,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op } res = set_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes, - opts->read_write, opts->exit_status, pid); + opts->read_write, opts->exit_status, pid, 0); /* Don't unblock SIGCHLD until now, since the call above must first complete putting away the info about our new subprocess. */ unblock_signals(); @@ -1840,6 +1889,7 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) { ErlDrvData res; + int non_blocking = 0; if (((opts->read_write & DO_READ) && opts->ifd >= max_files) || ((opts->read_write & DO_WRITE) && opts->ofd >= max_files)) @@ -1912,6 +1962,20 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, * case - it can be called with any old pre-existing file descriptors, * the relations between which (if they're even two) we can only guess * at - still, we try our best... + * + * Added note OTP 18: Some systems seem to use stdout/stderr to log data + * using unix pipes, so we cannot allow the system to block on a write. + * Therefore we use an async thread to write the data to fd's that could + * not be set to non-blocking. When no async threads are available we + * fall back on the old behaviour. + * + * Also the guarantee about what is delivered to the OS has changed. + * Pre 18 the fd driver did no flushing of data before terminating. + * Now it does. This is because we want to be able to guarantee that things + * such as escripts and friends really have outputted all data before + * terminating. This could potentially block the termination of the system + * for a very long time, but if the user wants to terminate fast she should + * use erlang:halt with flush=false. */ if (opts->read_write & DO_READ) { @@ -1934,6 +1998,7 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, imagine a scenario where setting non-blocking mode here would cause problems - go ahead and do it. */ + non_blocking = 1; SET_NONBLOCKING(opts->ofd); } else { /* output fd is a tty, input fd isn't */ @@ -1976,6 +2041,7 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, (nfd = open(tty, O_WRONLY)) != -1) { dup2(nfd, opts->ofd); close(nfd); + non_blocking = 1; SET_NONBLOCKING(opts->ofd); } } @@ -1984,8 +2050,9 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, } CHLD_STAT_LOCK; res = (ErlDrvData)(long)set_driver_data(port_num, opts->ifd, opts->ofd, - opts->packet_bytes, - opts->read_write, 0, -1); + opts->packet_bytes, + opts->read_write, 0, -1, + !non_blocking); CHLD_STAT_UNLOCK; return res; } @@ -2011,14 +2078,30 @@ static void nbio_stop_fd(ErlDrvPort prt, int fd) SET_BLOCKING(fd); } -static void fd_stop(ErlDrvData fd) /* Does not close the fds */ +static void fd_stop(ErlDrvData ev) /* Does not close the fds */ { int ofd; + int fd = (int)(long)ev; + ErlDrvPort prt = driver_data[fd].port_num; - nbio_stop_fd(driver_data[(int)(long)fd].port_num, (int)(long)fd); - ofd = driver_data[(int)(long)fd].ofd; - if (ofd != (int)(long)fd && ofd != -1) - nbio_stop_fd(driver_data[(int)(long)fd].port_num, (int)(long)ofd); +#if FDBLOCK + if (driver_data[fd].blocking) { + erts_free(ERTS_ALC_T_SYS_BLOCKING,driver_data[fd].blocking); + driver_data[fd].blocking = NULL; + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*sizeof(ErtsSysBlocking)); + } +#endif + + nbio_stop_fd(prt, fd); + ofd = driver_data[fd].ofd; + if (ofd != fd && ofd != -1) + nbio_stop_fd(prt, ofd); +} + +static void fd_flush(ErlDrvData fd) +{ + if (!driver_data[(int)(long)fd].terminating) + driver_data[(int)(long)fd].terminating = 1; } static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name, @@ -2041,8 +2124,8 @@ static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name, CHLD_STAT_LOCK; res = (ErlDrvData)(long)set_driver_data(port_num, fd, fd, - opts->packet_bytes, - opts->read_write, 0, -1); + opts->packet_bytes, + opts->read_write, 0, -1, 0); CHLD_STAT_UNLOCK; return res; } @@ -2079,6 +2162,7 @@ static void stop(ErlDrvData fd) } } +/* used by fd_driver */ static void outputv(ErlDrvData e, ErlIOVec* ev) { int fd = (int)(long)e; @@ -2104,12 +2188,21 @@ static void outputv(ErlDrvData e, ErlIOVec* ev) ev->iov[0].iov_base = lbp; ev->iov[0].iov_len = pb; ev->size += pb; + + if (driver_data[fd].blocking && FDBLOCK) + driver_pdl_lock(driver_data[fd].blocking->pdl); + if ((sz = driver_sizeq(ix)) > 0) { driver_enqv(ix, ev, 0); + + if (driver_data[fd].blocking && FDBLOCK) + driver_pdl_unlock(driver_data[fd].blocking->pdl); + if (sz + ev->size >= (1 << 13)) set_busy_port(ix, 1); } - else { + else if (!driver_data[fd].blocking || !FDBLOCK) { + /* We try to write directly if the fd in non-blocking */ int vsize = ev->vsize > MAX_VSIZE ? MAX_VSIZE : ev->vsize; n = writev(ofd, (const void *) (ev->iov), vsize); @@ -2125,10 +2218,22 @@ static void outputv(ErlDrvData e, ErlIOVec* ev) driver_enqv(ix, ev, n); /* n is the skip value */ driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1); } +#if FDBLOCK + else { + if (ev->size != 0) { + driver_enqv(ix, ev, 0); + driver_pdl_unlock(driver_data[fd].blocking->pdl); + driver_async(ix, &driver_data[fd].blocking->pkey, + fd_async, driver_data+fd, NULL); + } else { + driver_pdl_unlock(driver_data[fd].blocking->pdl); + } + } +#endif /* return 0;*/ } - +/* Used by spawn_driver and vanilla driver */ static void output(ErlDrvData e, char* buf, ErlDrvSizeT len) { int fd = (int)(long)e; @@ -2191,6 +2296,23 @@ static int port_inp_failure(ErlDrvPort port_num, int ready_fd, int res) ASSERT(res <= 0); (void) driver_select(port_num, ready_fd, ERL_DRV_READ|ERL_DRV_WRITE, 0); clear_fd_data(ready_fd); + + if (driver_data[ready_fd].blocking && FDBLOCK) { + driver_pdl_lock(driver_data[ready_fd].blocking->pdl); + if (driver_sizeq(driver_data[ready_fd].port_num) > 0) { + driver_pdl_unlock(driver_data[ready_fd].blocking->pdl); + /* We have stuff in the output queue, so we just + set the state to terminating and wait for fd_async_ready + to terminate the port */ + if (res == 0) + driver_data[ready_fd].terminating = 2; + else + driver_data[ready_fd].terminating = -err; + return 0; + } + driver_pdl_unlock(driver_data[ready_fd].blocking->pdl); + } + if (res == 0) { if (driver_data[ready_fd].report_exit) { CHLD_STAT_LOCK; @@ -2241,6 +2363,7 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) port_num = driver_data[fd].port_num; packet_bytes = driver_data[fd].packet_bytes; + if (packet_bytes == 0) { byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, ERTS_SYS_READ_BUF_SZ); @@ -2364,6 +2487,8 @@ static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd) if ((iv = (struct iovec*) driver_peekq(ix, &vsize)) == NULL) { driver_select(ix, ready_fd, ERL_DRV_WRITE, 0); + if (driver_data[fd].terminating) + driver_failure_atom(driver_data[fd].port_num,"normal"); return; /* 0; */ } vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize; @@ -2389,6 +2514,82 @@ static void stop_select(ErlDrvEvent fd, void* _) close((int)fd); } +#if FDBLOCK + +static void +fd_async(void *async_data) +{ + int res; + struct driver_data *dd = (struct driver_data*)async_data; + SysIOVec *iov0; + SysIOVec *iov; + int iovlen; + int iovcnt; + int p; + /* much of this code is stolen from efile_drv:invoke_writev */ + driver_pdl_lock(dd->blocking->pdl); + iov0 = driver_peekq(dd->port_num, &iovlen); + /* Calculate iovcnt */ + for (p = 0, iovcnt = 0; iovcnt < iovlen; + p += iov0[iovcnt++].iov_len) + ; + iov = erts_alloc_fnf(ERTS_ALC_T_SYS_WRITE_BUF, + sizeof(SysIOVec)*iovcnt); + if (!iov) { + res = -1; + errno = ENOMEM; + erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov); + driver_pdl_unlock(dd->blocking->pdl); + } else { + memcpy(iov,iov0,iovcnt*sizeof(SysIOVec)); + driver_pdl_unlock(dd->blocking->pdl); + + res = writev(dd->ofd, iov, iovlen); + + erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov); + } + dd->blocking->res = res; + dd->blocking->err = errno; +} + +void fd_ready_async(ErlDrvData drv_data, + ErlDrvThreadData thread_data) { + struct driver_data *dd = (struct driver_data *)thread_data; + ErlDrvPort port_num = dd->port_num; + + ASSERT(dd->blocking); + ASSERT(dd == (driver_data + (int)(long)drv_data)); + + if (dd->blocking->res > 0) { + driver_pdl_lock(dd->blocking->pdl); + if (driver_deq(port_num, dd->blocking->res) == 0) { + driver_pdl_unlock(dd->blocking->pdl); + set_busy_port(port_num, 0); + if (dd->terminating) { + /* The port is has been ordered to terminate + from either fd_flush or port_inp_failure */ + if (dd->terminating == 1) + driver_failure_atom(port_num, "normal"); + else if (dd->terminating == 2) + driver_failure_eof(port_num); + else if (dd->terminating < 0) + driver_failure_posix(port_num, -dd->terminating); + return; /* -1; */ + } + } else { + driver_pdl_unlock(dd->blocking->pdl); + /* still data left to write in queue */ + driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL); + return /* 0; */; + } + } else if (dd->blocking->res < 0) { + driver_failure_posix(port_num, dd->blocking->err); + return; /* -1; */ + } + return; /* 0; */ +} + +#endif void erts_do_break_handling(void) { @@ -2658,18 +2859,30 @@ void sys_preload_end(Preload* p) /* Nothing */ } -/* Read a key from console (?) */ - +/* Read a key from console, used by break.c + Here we assume that all schedulers are stopped so that erl_poll + does not interfere with the select below. +*/ int sys_get_key(fd) int fd; { - int c; + int c, ret; unsigned char rbuf[64]; + fd_set fds; fflush(stdout); /* Flush query ??? */ - if ((c = read(fd,rbuf,64)) <= 0) { - return c; + FD_ZERO(&fds); + FD_SET(fd,&fds); + + ret = select(fd+1, &fds, NULL, NULL, NULL); + + if (ret == 1) { + do { + c = read(fd,rbuf,64); + } while (c < 0 && errno == EAGAIN); + if (c <= 0) + return c; } return rbuf[0]; diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 0ded6b274e..164ef95629 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -1392,39 +1392,46 @@ int parse_command(wchar_t* cmd){ return i; } -static BOOL need_quotes(wchar_t *str) -{ - int in_quote = 0; - int backslashed = 0; - int naked_space = 0; - while (*str != L'\0') { - switch (*str) { - case L'\\' : - backslashed = !backslashed; - break; - case L'"': - if (backslashed) { - backslashed=0; - } else { - in_quote = !in_quote; - } - break; - case L' ': - backslashed = 0; - if (!(backslashed || in_quote)) { - naked_space++; - } - break; - default: - backslashed = 0; +/* + * Translating of command line arguments to correct format. In the examples + * below the '' are not part of the actual string. + * 'io:format("hello").' -> 'io:format(\"hello\").' + * 'io:format("is anybody in there?").' -> '"io:format(\"is anybody in there?\")."' + * 'Just nod if you can hear me.' -> '"Just nod if you can hear me."' + * 'Is there ""anyone at home?' -> '"Is there \"\"anyone at home?"' + * 'Relax."' -> 'Relax.\"' + * + * If new == NULL we just calculate the length. + * + * The reason for having to quote all of the is becasue CreateProcessW removes + * one level of escaping since it takes a single long command line rather + * than the argument chunks that unix uses. + */ +static int escape_and_quote(wchar_t *str, wchar_t *new, BOOL *quoted) { + int i, j = 0; + if (new == NULL) + *quoted = FALSE; + else if (*quoted) + new[j++] = L'"'; + for ( i = 0; str[i] != L'\0'; i++,j++) { + if (str[i] == L' ' && new == NULL && *quoted == FALSE) { + *quoted = TRUE; + j++; + } + /* check if we have to escape quotes */ + if (str[i] == L'"') { + if (new) new[j] = L'\\'; + j++; } - ++str; + if (new) new[j] = str[i]; } - return (naked_space > 0); + if (*quoted) { + if (new) new[j] = L'"'; + j++; + } + return j; } - - /* *---------------------------------------------------------------------- @@ -1585,31 +1592,24 @@ create_child_process wcscpy(appname, execPath); } if (argv == NULL) { - BOOL orig_need_q = need_quotes(execPath); + BOOL orig_need_q; wchar_t *ptr; - int ocl = wcslen(execPath); + int ocl = escape_and_quote(execPath, NULL, &orig_need_q); if (run_cmd) { newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, - (ocl + ((orig_need_q) ? 3 : 1) - + 11)*sizeof(wchar_t)); + (ocl + 1 + 11)*sizeof(wchar_t)); memcpy(newcmdline,L"cmd.exe /c ",11*sizeof(wchar_t)); ptr = newcmdline + 11; } else { newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, - (ocl + ((orig_need_q) ? 3 : 1))*sizeof(wchar_t)); + (ocl + 1)*sizeof(wchar_t)); ptr = (wchar_t *) newcmdline; } - if (orig_need_q) { - *ptr++ = L'"'; - } - memcpy(ptr,execPath,ocl*sizeof(wchar_t)); - ptr += ocl; - if (orig_need_q) { - *ptr++ = L'"'; - } - *ptr = L'\0'; + ptr += escape_and_quote(execPath, ptr, &orig_need_q); + ptr[0] = L'\0'; } else { - int sum = 1; /* '\0' */ + int sum = 0; + BOOL *qte = NULL; wchar_t **ar = argv; wchar_t *n; wchar_t *save_arg0 = NULL; @@ -1620,11 +1620,13 @@ create_child_process if (run_cmd) { sum += 11; /* cmd.exe /c */ } + + while (*ar != NULL) ar++; + qte = erts_alloc(ERTS_ALC_T_TMP, (ar - argv)*sizeof(BOOL)); + + ar = argv; while (*ar != NULL) { - sum += wcslen(*ar); - if (need_quotes(*ar)) { - sum += 2; /* quotes */ - } + sum += escape_and_quote(*ar,NULL,qte+(ar - argv)); sum++; /* space */ ++ar; } @@ -1636,26 +1638,18 @@ create_child_process n += 11; } while (*ar != NULL) { - int q = need_quotes(*ar); - sum = wcslen(*ar); - if (q) { - *n++ = L'"'; - } - memcpy(n,*ar,sum*sizeof(wchar_t)); - n += sum; - if (q) { - *n++ = L'"'; - } + n += escape_and_quote(*ar,n,qte+(ar - argv)); *n++ = L' '; ++ar; } - *(n-1) = L'\0'; + *(n-1) = L'\0'; /* overwrite last space with '\0' */ if (save_arg0 != NULL) { argv[0] = save_arg0; } + erts_free(ERTS_ALC_T_TMP, qte); } - DEBUGF(("Creating child process: %s, createFlags = %d\n", newcmdline, createFlags)); + DEBUGF((stderr,"Creating child process: %S, createFlags = %d\n", newcmdline, createFlags)); ok = CreateProcessW((wchar_t *) appname, (wchar_t *) newcmdline, NULL, @@ -2190,7 +2184,7 @@ static void fd_stop(ErlDrvData data) ASSERT(dp->out.flushEvent); SetEvent(dp->out.flushEvent); } while (WaitForSingleObject(dp->out.flushReplyEvent, 10) == WAIT_TIMEOUT - || !(dp->out.flags & DF_THREAD_FLUSHED)); + && !(dp->out.flags & DF_THREAD_FLUSHED)); } } diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index fdce157abc..fc4a5028e1 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -30,6 +30,7 @@ -export([fpe/1]). -export([otp_9422/1]). -export([faulty_seq_trace/1, do_faulty_seq_trace/0]). +-export([maps/1]). -export([runner/2, loop_runner/3]). -export([f1/1, f2/2, f3/2, fn/1, fn/2, fn/3]). -export([do_boxed_and_small/0]). @@ -62,7 +63,8 @@ all() -> moving_labels, faulty_seq_trace, empty_list, - otp_9422]; + otp_9422, + maps]; true -> [not_run] end. @@ -899,6 +901,31 @@ fpe(Config) when is_list(Config) -> _ -> ok end. +maps(Config) when is_list(Config) -> + {ok,#{},[],[]} = erlang:match_spec_test(#{}, [{'_',[],['$_']}], table), + {ok,#{},[],[]} = erlang:match_spec_test(#{}, [{#{},[],['$_']}], table), + {ok,false,[],[]} = + erlang:match_spec_test(#{}, [{not_a_map,[],['$_']}], table), + {ok,bar,[],[]} = + erlang:match_spec_test(#{foo => bar}, + [{#{foo => '$1'},[],['$1']}], + table), + {ok,false,[],[]} = + erlang:match_spec_test(#{foo => bar}, + [{#{foo => qux},[],[qux]}], + table), + {ok,false,[],[]} = + erlang:match_spec_test(#{}, [{#{foo => '_'},[],[foo]}], table), + {error,_} = + erlang:match_spec_test(#{}, [{#{'$1' => '_'},[],[foo]}], table), + {ok,bar,[],[]} = + erlang:match_spec_test({#{foo => bar}}, + [{{#{foo => '$1'}},[],['$1']}], + table), + {ok,#{foo := 3},[],[]} = + erlang:match_spec_test({}, [{{},[],[#{foo => {'+',1,2}}]}], table), + ok. + empty_list(Config) when is_list(Config) -> Val=[{'$1',[], [{message,'$1'},{message,{caller}},{return_trace}]}], %% Did crash debug VM in faulty assert: diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl index 8a63d9fe3e..f3986f0c4f 100644 --- a/erts/emulator/test/module_info_SUITE.erl +++ b/erts/emulator/test/module_info_SUITE.erl @@ -24,7 +24,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, - exports/1,functions/1,native/1]). + exports/1,functions/1,native/1,info/1]). %%-compile(native). @@ -52,8 +52,8 @@ end_per_group(_GroupName, Config) -> Config. -modules() -> - [exports, functions, native]. +modules() -> + [exports, functions, native, info]. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog = ?t:timetrap(?t:minutes(3)), @@ -122,6 +122,22 @@ native_proj({Name,Arity,Addr}) -> native_filter(Set) -> sofs:no_elements(Set) =/= 1. +%% Test that the module info of this module is correct. Use +%% erlang:get_module_info(?MODULE) to avoid compiler optimization tricks. +info(Config) when is_list(Config) -> + Info = erlang:get_module_info(?MODULE), + All = all_exported(), + {ok,{?MODULE,MD5}} = beam_lib:md5(code:which(?MODULE)), + {module, ?MODULE} = lists:keyfind(module, 1, Info), + {md5, MD5} = lists:keyfind(md5, 1, Info), + {exports, Exports} = lists:keyfind(exports, 1, Info), + All = lists:sort(Exports), + {attributes, Attrs} = lists:keyfind(attributes, 1, Info), + {vsn,_} = lists:keyfind(vsn, 1, Attrs), + {compile, Compile} = lists:keyfind(compile, 1, Info), + {options,_} = lists:keyfind(options, 1, Compile), + ok. + %% Helper functions (local). add_arity(L) -> diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 9083545060..6bbf93b7d7 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -1407,6 +1407,12 @@ spawn_executable(Config) when is_list(Config) -> run_echo_args(SpaceDir,[ExactFile2,"hello world","dlrow olleh"]), [ExactFile2,"hello world","dlrow olleh"] = run_echo_args(SpaceDir,[binary, ExactFile2,"hello world","dlrow olleh"]), + + [ExactFile2,"hello \"world\"","\"dlrow\" olleh"] = + run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]), + [ExactFile2,"hello \"world\"","\"dlrow\" olleh"] = + run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]), + [ExactFile2] = run_echo_args(SpaceDir,[default]), [ExactFile2,"hello world","dlrow olleh"] = run_echo_args(SpaceDir,[switch_order,ExactFile2,"hello world", diff --git a/erts/emulator/valgrind/suppress.patched.3.6.0 b/erts/emulator/valgrind/suppress.patched.3.6.0 index b3507bdba7..f79e3ff634 100644 --- a/erts/emulator/valgrind/suppress.patched.3.6.0 +++ b/erts/emulator/valgrind/suppress.patched.3.6.0 @@ -273,6 +273,11 @@ obj:*/ssleay.* fun:AES_cbc_encrypt ... } +{ + crypto RC4 can do harmless word aligned read past end of input + Memcheck:Addr8 + fun:RC4 +} { erts_bits_init_state; Why is this needed? diff --git a/erts/emulator/valgrind/suppress.standard b/erts/emulator/valgrind/suppress.standard index a4da31a61d..b3c77119fb 100644 --- a/erts/emulator/valgrind/suppress.standard +++ b/erts/emulator/valgrind/suppress.standard @@ -260,6 +260,11 @@ obj:*/ssleay.* fun:AES_cbc_encrypt ... } +{ + crypto RC4 can do harmless word aligned read past end of input + Memcheck:Addr8 + fun:RC4 +} { Prebuilt constant terms in os_info_init (PossiblyLost) diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c index 9699491526..447aae47aa 100644 --- a/erts/epmd/src/epmd.c +++ b/erts/epmd/src/epmd.c @@ -345,7 +345,7 @@ static void run_daemon(EpmdVars *g) inform it of that the log is closed. */ closelog(); - /* These chouldn't be needed but for safety... */ + /* These shouldn't be needed but for safety... */ open("/dev/null", O_RDONLY); /* Order is important! */ open("/dev/null", O_WRONLY); @@ -386,7 +386,7 @@ static void run_daemon(EpmdVars *g) close(1); close(2); - /* These chouldn't be needed but for safety... */ + /* These shouldn't be needed but for safety... */ open("nul", O_RDONLY); open("nul", O_WRONLY); diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index 78fefbea55..aa51eabfc5 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -43,6 +43,7 @@ # -gcov Run emulator compiled for gcov # -valgrind Run emulator compiled for valgrind # -lcnt Run emulator compiled for lock counting +# -icount Run emulator compiled for instruction counting # -nox Unset the DISPLAY variable to disable us of X Windows # # FIXME For GDB you can also set the break point using "-break FUNCTION". @@ -180,6 +181,11 @@ while [ $# -gt 0 ]; do cargs="$cargs -frmptr" TYPE=.frmptr ;; + "-icount") + shift + cargs="$cargs -icount" + TYPE=.icount + ;; "-dump") shift GDB=dump diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index 0190ea613e..8ebb65ad77 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -1065,8 +1065,8 @@ define etp-cp-1 set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2 end if $etp_cp_p - # 12 = MI_FUNCTIONS - set $etp_cp_low = (Eterm**)($etp_cp_p->start + 12) + # 13 = MI_FUNCTIONS + set $etp_cp_low = (Eterm**)($etp_cp_p->start + 13) # 0 = MI_NUM_FUNCTIONS set $etp_cp_high = $etp_cp_low +$etp_cp_p->start[0] set $etp_cp_p = 0 @@ -3514,11 +3514,13 @@ end define etp-carrier-blocks set $etp_crr = (Carrier_t*) $arg0 set $etp_alc = (Allctr_t*)($etp_crr->allctr.counter & ~7) + set $etp_crr_end = ((char*)$etp_crr + ($etp_crr->chdr & ~7) - (sizeof(void*) & ~8)) set $etp_blk = (Block_t*) ((char*)$etp_crr + $etp_alc->mbc_header_size) set $etp_prev_blk = 0 set $etp_error_cnt = 0 set $etp_ablk_cnt = 0 set $etp_fblk_cnt = 0 + set $etp_aborted = 0 if $argc == 2 set $etp_be_silent = $arg1 @@ -3565,14 +3567,21 @@ define etp-carrier-blocks end set $etp_prev_blk = $etp_blk set $etp_blk = (Block_t*) ((char*)$etp_blk + $etp_blk_sz) + if $etp_blk < (Block_t*) ((char*)$etp_prev_blk + $etp_alc->min_block_size) || $etp_blk >= $etp_crr_end + printf "ERROR: Invalid size of block at %#lx. ABORTING\n", $etp_prev_blk + set $etp_aborted = 1 + loop_break + end end - if ((char*)$etp_blk + $etp_blk_sz) != ((char*)$etp_crr + ($etp_crr->chdr & ~7)) - printf "ERROR: Last block not at end of carrier\n" - set $etp_error_cnt = $etp_error_cnt + 1 + if !$etp_aborted + if ((char*)$etp_blk + $etp_blk_sz) != $etp_crr_end + printf "ERROR: Last block not at end of carrier\n" + set $etp_error_cnt = $etp_error_cnt + 1 + end + printf "Allocated blocks: %u\n", $etp_ablk_cnt + printf "Free blocks: %u\n", $etp_fblk_cnt end - printf "Allocated blocks: %u\n", $etp_ablk_cnt - printf "Free blocks: %u\n", $etp_fblk_cnt if $etp_error_cnt printf "%u ERRORs reported above\n", $etp-error-cnt end diff --git a/erts/lib_src/Makefile.in b/erts/lib_src/Makefile.in index b680c03b1d..d0ebab49d8 100644 --- a/erts/lib_src/Makefile.in +++ b/erts/lib_src/Makefile.in @@ -92,6 +92,11 @@ CFLAGS += -DERTS_FRMPTR OMIT_OMIT_FP=yes PRE_LD= else +ifeq ($(TYPE),icount) +TYPE_SUFFIX = .icount +CFLAGS += -DERTS_OPCODE_COUNTER_SUPPORT +PRE_LD= +else override TYPE=opt OMIT_FP=true TYPE_SUFFIX= @@ -105,6 +110,7 @@ endif endif endif endif +endif OPSYS=@OPSYS@ sol2CFLAGS= diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 001c9c76ed..c8ec111e57 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 1893dd84ac..d0f9907709 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex b467633a4d..ba45e4e011 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 915a2d1aef..26f779500c 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 df1bf932a3..4d22d8bace 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 95b4bbca2d..efc8347b6e 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 5e4fc5ba84..6c49b5185e 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 9d9a4886d9..f58ee4b4d5 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 d98b0275f4..73be297bbb 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 0744bdb21d..193cebdc31 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 611a568014..2e4331e15f 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -93,7 +93,7 @@ float_to_list/1, float_to_list/2]). -export([fun_info/2, fun_info_mfa/1, fun_to_list/1, function_exported/3]). -export([garbage_collect/0, garbage_collect/1, garbage_collect/2]). --export([garbage_collect_message_area/0, get/0, get/1, get_keys/1]). +-export([garbage_collect_message_area/0, get/0, get/1, get_keys/0, get_keys/1]). -export([get_module_info/1, get_stacktrace/0, group_leader/0]). -export([group_leader/2, halt/0, halt/1, halt/2, hash/2, hibernate/3]). -export([insert_element/3]). @@ -931,6 +931,12 @@ get() -> get(_Key) -> erlang:nif_error(undefined). +%% get_keys/0 +-spec get_keys() -> [Key] when + Key :: term(). +get_keys() -> + erlang:nif_error(undefined). + %% get_keys/1 -spec get_keys(Val) -> [Key] when Val :: term(), @@ -1651,7 +1657,7 @@ element(_N, _Tuple) -> %% Not documented -spec erlang:get_module_info(Module, Item) -> ModuleInfo when Module :: atom(), - Item :: module | imports | exports | functions | attributes | compile | native_addresses, + Item :: module | imports | exports | functions | attributes | compile | native_addresses | md5, ModuleInfo :: atom() | [] | [{atom(), arity()}] | [{atom(), term()}] | [{atom(), arity(), integer()}]. get_module_info(_Module, _Item) -> erlang:nif_error(undefined). diff --git a/erts/test/erlc_SUITE_data/src/start_ok.script b/erts/test/erlc_SUITE_data/src/start_ok.script index 4cd89f0439..7ef97dc3f3 100644 --- a/erts/test/erlc_SUITE_data/src/start_ok.script +++ b/erts/test/erlc_SUITE_data/src/start_ok.script @@ -52,7 +52,6 @@ shell_default, timer, gen_fsm, - pg, unix, dict, pool, @@ -156,7 +155,6 @@ {timer,1}, {gen_fsm,1}, {io_lib_pretty,1}, - {pg,1}, {slave,1}, {unix,1}, {dict,1}, diff --git a/erts/test/upgrade_SUITE.erl b/erts/test/upgrade_SUITE.erl index d5a920e03d..7b3bc1b063 100644 --- a/erts/test/upgrade_SUITE.erl +++ b/erts/test/upgrade_SUITE.erl @@ -237,7 +237,10 @@ do_upgrade(FromVsn,FromApps,ToRel,ToApps,InstallDir) -> [{"OTP upgrade test",FromVsn,_,permanent}] = rpc:call(Node,release_handler,which_releases,[]), - {ok,ToVsn} = rpc:call(Node,release_handler,unpack_release,[ToRel]), + ToRelName = filename:basename(ToRel), + copy_file(ToRel++".tar.gz", + filename:join([InstallDir,releases,ToRelName++".tar.gz"])), + {ok,ToVsn} = rpc:call(Node,release_handler,unpack_release,[ToRelName]), [{"OTP upgrade test",ToVsn,_,unpacked}, {"OTP upgrade test",FromVsn,_,permanent}] = rpc:call(Node,release_handler,which_releases,[]), diff --git a/erts/vsn.mk b/erts/vsn.mk index c8c533a221..ab98bd4a17 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -17,7 +17,7 @@ # %CopyrightEnd% # -VSN = 6.2.1 +VSN = 7.0 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/common_test/doc/src/ct_master_chapter.xml b/lib/common_test/doc/src/ct_master_chapter.xml index 37a0805055..adfe79e41a 100644 --- a/lib/common_test/doc/src/ct_master_chapter.xml +++ b/lib/common_test/doc/src/ct_master_chapter.xml @@ -198,7 +198,7 @@ <section> <title>Automatic startup of test target nodes</title> <marker id="ct_slave"></marker> - <p>Is is possible to automatically start, and perform initial actions, on + <p>It is possible to automatically start, and perform initial actions, on test target nodes by using the test specification term <c>init</c>.</p> <p>Currently, two sub-terms are supported, <c>node_start</c> and <c>eval</c>.</p> <p>Example:</p> diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 8d74546880..2723b066f0 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2013. All Rights Reserved. +# Copyright Ericsson AB 2003-2014. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -75,7 +75,8 @@ MODULES= \ ct_conn_log_h \ cth_conn_log \ ct_groups \ - ct_property_test + ct_property_test \ + ct_release_test TARGET_MODULES= $(MODULES:%=$(EBIN)/%) BEAM_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index a3861dc745..2f66c7613c 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -190,6 +190,7 @@ get_config/4, edit_config/3, edit_config/4, + edit_config/5, delete_config/2, delete_config/3, copy_config/3, @@ -678,15 +679,39 @@ get_config(Client, Source, Filter, Timeout) -> %%---------------------------------------------------------------------- %% @spec edit_config(Client, Target, Config) -> Result -%% @equiv edit_config(Client, Target, Config, infinity) +%% @equiv edit_config(Client, Target, Config, [], infinity) edit_config(Client, Target, Config) -> edit_config(Client, Target, Config, ?DEFAULT_TIMEOUT). %%---------------------------------------------------------------------- --spec edit_config(Client, Target, Config, Timeout) -> Result when +-spec edit_config(Client, Target, Config, OptParamsOrTimeout) -> Result when Client :: client(), Target :: netconf_db(), Config :: simple_xml(), + OptParamsOrTimeout :: [simple_xml()] | timeout(), + Result :: ok | {error,error_reason()}. +%% @doc +%% +%% If `OptParamsOrTimeout' is a timeout value, then this is +%% equivalent to {@link edit_config/5. edit_config(Client, Target, +%% Config, [], Timeout)}. +%% +%% If `OptParamsOrTimeout' is a list of simple XML, then this is +%% equivalent to {@link edit_config/5. edit_config(Client, Target, +%% Config, OptParams, infinity)}. +%% +%% @end +edit_config(Client, Target, Config, Timeout) when ?is_timeout(Timeout) -> + edit_config(Client, Target, Config, [], Timeout); +edit_config(Client, Target, Config, OptParams) when is_list(OptParams) -> + edit_config(Client, Target, Config, OptParams, ?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec edit_config(Client, Target, Config, OptParams, Timeout) -> Result when + Client :: client(), + Target :: netconf_db(), + Config :: simple_xml(), + OptParams :: [simple_xml()], Timeout :: timeout(), Result :: ok | {error,error_reason()}. %% @doc Edit configuration data. @@ -695,10 +720,20 @@ edit_config(Client, Target, Config) -> %% include `:candidate' or `:startup' in its list of %% capabilities. %% +%% `OptParams' can be used for specifying optional parameters +%% (`default-operation', `test-option' or `error-option') that will be +%% added to the `edit-config' request. The value must be a list +%% containing valid simple XML, for example +%% +%% ``` +%% [{'default-operation', ["none"]}, +%% {'error-option', ["rollback-on-error"]}] +%%''' +%% %% @end %%---------------------------------------------------------------------- -edit_config(Client, Target, Config, Timeout) -> - call(Client, {send_rpc_op, edit_config, [Target,Config], Timeout}). +edit_config(Client, Target, Config, OptParams, Timeout) -> + call(Client, {send_rpc_op, edit_config, [Target,Config,OptParams], Timeout}). %%---------------------------------------------------------------------- @@ -1086,6 +1121,7 @@ handle_msg({get_event_streams=Op,Streams,Timeout}, From, State) -> SimpleXml = encode_rpc_operation(get,[Filter]), do_send_rpc(Op, SimpleXml, Timeout, From, State). +%% @private handle_msg({ssh_cm, CM, {data, Ch, _Type, Data}}, State) -> ssh_connection:adjust_window(CM,Ch,size(Data)), handle_data(Data, State); @@ -1234,8 +1270,8 @@ encode_rpc_operation(get,[Filter]) -> {get,filter(Filter)}; encode_rpc_operation(get_config,[Source,Filter]) -> {'get-config',[{source,[Source]}] ++ filter(Filter)}; -encode_rpc_operation(edit_config,[Target,Config]) -> - {'edit-config',[{target,[Target]},{config,[Config]}]}; +encode_rpc_operation(edit_config,[Target,Config,OptParams]) -> + {'edit-config',[{target,[Target]}] ++ OptParams ++ [{config,[Config]}]}; encode_rpc_operation(delete_config,[Target]) -> {'delete-config',[{target,[Target]}]}; encode_rpc_operation(copy_config,[Target,Source]) -> @@ -1707,6 +1743,7 @@ log(#connection{host=Host,port=Port,name=Name},Action,Data) -> %% Log callback - called from the error handler process +%% @private format_data(How,Data) -> %% Assuming that the data is encoded as UTF-8. If it is not, then %% the printout might be wrong, but the format function will not diff --git a/lib/common_test/src/ct_release_test.erl b/lib/common_test/src/ct_release_test.erl new file mode 100644 index 0000000000..eb9e9c832f --- /dev/null +++ b/lib/common_test/src/ct_release_test.erl @@ -0,0 +1,847 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%%----------------------------------------------------------------- +%% @doc EXPERIMENTAL support for testing of upgrade. +%% +%% This is a library module containing support for test of release +%% related activities in one or more applications. Currenty it +%% supports upgrade only. +%% +%% == Configuration == +%% +%% In order to find version numbers of applications to upgrade from, +%% `{@module}' needs to access and start old OTP +%% releases. A `common_test' configuration file can be used for +%% specifying the location of such releases, for example: +%% +%% ``` +%% %% old-rels.cfg +%% {otp_releases,[{r16b,"/path/to/R16B03-1/bin/erl"}, +%% {'17',"/path/to/17.3/bin/erl"}]}.''' +%% +%% The configuration file should preferably point out the latest patch +%% level on each major release. +%% +%% If no such configuration file is given, {@link init/1} will return +%% `{skip,Reason}' and any attempt at running {@link upgrade/4} +%% will fail. +%% +%% == Callback functions == +%% +%% The following functions should be exported from a {@module} +%% callback module. +%% +%% All callback functions are called on the node where the upgrade is +%% executed. +%% +%% <dl> +%% <dt>Module:upgrade_init(State) -> NewState</dt> +%% <dd>Types: +%% +%% <b><c>State = NewState = cb_state()</c></b> +%% +%% Initialyze system before upgrade test starts. +%% +%% This function is called before the upgrade is started. All +%% applications given in {@link upgrade/4} are already started by +%% the boot script, so this callback is intended for additional +%% initialization, if necessary. +%% +%% Example: +%% +%% ``` +%% upgrade_init(State) -> +%% open_connection(State).''' +%% </dd> +%% +%% <dt>Module:upgrade_upgraded(State) -> NewState</dt> +%% <dd>Types: +%% +%% <b><c>State = NewState = cb_state()</c></b> +%% +%% Check that upgrade was successful. +%% +%% This function is called after the release_handler has +%% successfully unpacked and installed the new release, and it has +%% been made permanent. It allows application specific checks to +%% ensure that the upgrade was successful. +%% +%% Example: +%% +%% ``` +%% upgrade_upgraded(State) -> +%% check_connection_still_open(State).''' +%% </dd> +%% +%% <dt>Module:upgrade_downgraded(State) -> NewState</dt> +%% <dd>Types: +%% +%% <b><c>State = NewState = cb_state()</c></b> +%% +%% Check that downgrade was successful. +%% +%% This function is called after the release_handler has +%% successfully re-installed the original release, and it has been +%% made permanent. It allows application specific checks to ensure +%% that the downgrade was successful. +%% +%% Example: +%% +%% ``` +%% upgrade_init(State) -> +%% check_connection_closed(State).''' +%% </dd> +%% </dl> +%% @end +%%----------------------------------------------------------------- +-module(ct_release_test). + +-export([init/1, upgrade/4, cleanup/1]). + +-include_lib("kernel/include/file.hrl"). + +%%----------------------------------------------------------------- +-define(testnode, otp_upgrade). +-define(exclude_apps, [hipe, typer, dialyzer]). % never include these apps + +%%----------------------------------------------------------------- +-type config() :: [{atom(),term()}]. +-type cb_state() :: term(). + +-callback upgrade_init(cb_state()) -> cb_state(). +-callback upgrade_upgraded(cb_state()) -> cb_state(). +-callback upgrade_downgraded(cb_state()) -> cb_state(). + +%%----------------------------------------------------------------- +-spec init(Config) -> Result when + Config :: config(), + Result :: config() | SkipOrFail, + SkipOrFail :: {skip,Reason} | {fail,Reason}. +%% @doc Initialize `{@module}'. +%% +%% This function can be called from any of the +%% `init_per_*' functions in the test suite. It updates +%% the given `Config' with data that will be +%% used by future calls to other functions in this module. The +%% returned configuration must therefore also be returned from +%% the calling `init_per_*'. +%% +%% If the initialization fails, e.g. if a required release can +%% not be found, the function returns `{skip,Reason}'. In +%% this case the other test support functions in this mudule +%% can not be used. +%% +%% Example: +%% +%% ``` +%% init_per_suite(Config) -> +%% ct_release_test:init(Config).''' +%% +init(Config) -> + try init_upgrade_test() of + {Major,Minor} -> + [{release_test,[{major,Major},{minor,Minor}]} | Config] + catch throw:Thrown -> + Thrown + end. + +%%----------------------------------------------------------------- +-spec upgrade(App,Level,Callback,Config) -> any() when + App :: atom(), + Level :: minor | major, + Callback :: {module(),InitState}, + InitState :: cb_state(), + Config :: config(); + (Apps,Level,Callback,Config) -> any() when + Apps :: [App], + App :: atom(), + Level :: minor | major, + Callback :: {module(),InitState}, + InitState :: cb_state(), + Config :: config(). +%% @doc Test upgrade of the given application(s). +%% +%% This function can be called from a test case. It requires that +%% `Config' has been initialized by calling {@link +%% init/1} prior to this, for example from `init_per_suite/1'. +%% +%% Upgrade tests are performed as follows: +%% +%% <ol> +%% <li>Figure out which OTP release to test upgrade +%% from. Start a node running that release and find the +%% application versions on that node. Terminate the +%% node.</li> +%% <li>Figure out all dependencies for the applications under +%% test.</li> +%% <li>Create a release containing the core +%% applications `kernel', `stdlib' and `sasl' +%% in addition to the application(s) under test and all +%% dependencies of these. The versions of the applications +%% under test will be the ones found on the OTP release to +%% upgrade from. The versions of all other applications will +%% be those found on the current node, i.e. the common_test +%% node. This is the "From"-release.</li> +%% <li>Create another release containing the same +%% applications as in the previous step, but with all +%% application versions taken from the current node. This is +%% the "To"-release.</li> +%% <li>Install the "From"-release and start a new node +%% running this release.</li> +%% <li>Perform the upgrade test and allow customized +%% control by using callbacks: +%% <ol> +%% <li>Callback: `upgrade_init/1'</li> +%% <li>Unpack the new release</li> +%% <li>Install the new release</li> +%% <li>Callback: `upgrade_upgraded/1'</li> +%% <li>Install the original release</li> +%% <li>Callback: `upgrade_downgraded/1'</li> +%% </ol> +%% </li> +%% </ol> +%% +%% `App' or `Apps' +%% specifies the applications under test, i.e. the applications +%% which shall be upgraded. All other applications that are +%% included have the same releases in the "From"- and +%% "To"-releases and will therefore not be upgraded. +%% +%% `Level' specifies which OTP release to +%% pick the "From" versions from. +%% <dl> +%% <dt>major</dt> +%% <dd>From verions are picked from the previous major +%% release. For example, if the test is run on an OTP-17 +%% node, `{@module}' will pick the application +%% "From" versions from an OTP installation running OTP +%% R16B.</dd> +%% +%% <dt>minor</dt> +%% <dd>From verions are picked from the current major +%% release. For example, if the test is run on an OTP-17 +%% node, `{@module}' will pick the application +%% "From" versions from an OTP installation running an +%% earlier patch level of OTP-17.</dd> +%% </dl> +%% +%% The application "To" versions are allways picked from the +%% current node, i.e. the common_test node. +%% +%% `Callback' specifies the module (normally the +%% test suite) which implements the {@section Callback functions}, and +%% the initial value of the `State' variable used in these +%% functions. +%% +%% `Config' is the input argument received +%% in the test case function. +%% +%% Example: +%% +%% ``` +%% minor_upgrade(Config) -> +%% ct_release_test:upgrade(ssl,minor,{?MODULE,[]},Config). +%% ''' +%% +upgrade(App,Level,Callback,Config) when is_atom(App) -> + upgrade([App],Level,Callback,Config); +upgrade(Apps,Level,Callback,Config) -> + Dir = proplists:get_value(priv_dir,Config), + CreateDir = filename:join([Dir,Level,create]), + InstallDir = filename:join([Dir,Level,install]), + ok = filelib:ensure_dir(filename:join(CreateDir,"*")), + ok = filelib:ensure_dir(filename:join(InstallDir,"*")), + try upgrade(Apps,Level,Callback,CreateDir,InstallDir,Config) of + ok -> + %%rm_rf(CreateDir), + Tars = filelib:wildcard(filename:join(CreateDir,"*.tar.gz")), + _ = [file:delete(Tar) || Tar <- Tars], + rm_rf(InstallDir), + ok + catch throw:{fail,Reason} -> + ct:fail(Reason); + throw:{skip,Reason} -> + rm_rf(CreateDir), + rm_rf(InstallDir), + {skip,Reason} + after + %% Brutally kill all nodes that erroneously survived the test. + %% Note, we will not reach this if the test fails with a + %% timetrap timeout in the test suite! Thus we can have + %% hanging nodes... + Nodes = nodes(), + [rpc:call(Node,erlang,halt,[]) || Node <- Nodes] + end. + +%%----------------------------------------------------------------- +-spec cleanup(Config) -> Result when + Config :: config(), + Result :: config(). +%% @doc Clean up after tests. +%% +%% This function shall be called from the `end_per_*' function +%% complementing the `init_per_*' function where {@link init/1} +%% is called. +%% +%% It cleans up after the test, for example kills hanging +%% nodes. +%% +%% Example: +%% +%% ``` +%% end_per_suite(Config) -> +%% ct_release_test:cleanup(Config).''' +%% +cleanup(Config) -> + Nodes = [node_name(?testnode)|nodes()], + [rpc:call(Node,erlang,halt,[]) || Node <- Nodes], + Config. + +%%----------------------------------------------------------------- +init_upgrade_test() -> + %% Check that a real release is running, not e.g. cerl + ok = application:ensure_started(sasl), + case release_handler:which_releases() of + [{_,_,[],_}] -> + %% Fake release, no applications + throw({skip, "Need a real release running to create other releases"}); + _ -> + Major = init_upgrade_test(major), + Minor = init_upgrade_test(minor), + {Major,Minor} + end. + +init_upgrade_test(Level) -> + {FromVsn,ToVsn} = get_rels(Level), + OldRel = + case test_server:is_release_available(FromVsn) of + true -> + {release,FromVsn}; + false -> + case ct:get_config({otp_releases,list_to_atom(FromVsn)}) of + undefined -> + false; + Prog0 -> + case os:find_executable(Prog0) of + false -> + false; + Prog -> + {prog,Prog} + end + end + end, + case OldRel of + false -> + ct:log("Release ~p is not available." + " Upgrade on '~p' level can not be tested.", + [FromVsn,Level]), + undefined; + _ -> + init_upgrade_test(FromVsn,ToVsn,OldRel) + end. + +get_rels(major) -> + %% Given that the current major release is X, then this is an + %% upgrade from major release X-1 to the current release. + Current = erlang:system_info(otp_release), + PreviousMajor = previous_major(Current), + {PreviousMajor,Current}; +get_rels(minor) -> + %% Given that this is a (possibly) patched version of major + %% release X, then this is an upgrade from major release X to the + %% current release. + CurrentMajor = erlang:system_info(otp_release), + Current = CurrentMajor++"_patched", + {CurrentMajor,Current}. + +init_upgrade_test(FromVsn,ToVsn,OldRel) -> + OtpRel = list_to_atom("otp-"++FromVsn), + ct:log("Starting node to fetch application versions to upgrade from"), + {ok,Node} = test_server:start_node(OtpRel,peer,[{erl,[OldRel]}]), + {Apps,Path} = fetch_all_apps(Node), + test_server:stop_node(Node), + {FromVsn,ToVsn,Apps,Path}. + +fetch_all_apps(Node) -> + Paths = rpc:call(Node,code,get_path,[]), + %% Find all possible applications in the path + AppFiles = + lists:flatmap( + fun(P) -> + filelib:wildcard(filename:join(P,"*.app")) + end, + Paths), + %% Figure out which version of each application is running on this + %% node. Using application:load and application:get_key instead of + %% reading the .app files since there might be multiple versions + %% of a .app file and we only want the one that is actually + %% running. + AppVsns = + lists:flatmap( + fun(F) -> + A = list_to_atom(filename:basename(filename:rootname(F))), + _ = rpc:call(Node,application,load,[A]), + case rpc:call(Node,application,get_key,[A,vsn]) of + {ok,V} -> [{A,V}]; + _ -> [] + end + end, + AppFiles), + ErtsVsn = rpc:call(Node, erlang, system_info, [version]), + {[{erts,ErtsVsn}|AppVsns], Paths}. + + +%%----------------------------------------------------------------- +upgrade(Apps,Level,Callback,CreateDir,InstallDir,Config) -> + ct:log("Test upgrade of the following applications: ~p",[Apps]), + ct:log(".rel files and start scripts are created in:~n~ts",[CreateDir]), + ct:log("The release is installed in:~n~ts",[InstallDir]), + case proplists:get_value(release_test,Config) of + undefined -> + throw({fail,"ct_release_test:init/1 not run"}); + RTConfig -> + case proplists:get_value(Level,RTConfig) of + undefined -> + throw({skip,"Old release not available"}); + Data -> + {FromVsn,FromRel,FromAppsVsns} = + target_system(Apps, CreateDir, InstallDir, Data), + {ToVsn,ToRel,ToAppsVsns} = + upgrade_system(Apps, FromRel, CreateDir, + InstallDir, Data), + ct:log("Upgrade from: OTP-~ts, ~p",[FromVsn, FromAppsVsns]), + ct:log("Upgrade to: OTP-~ts, ~p",[ToVsn, ToAppsVsns]), + do_upgrade(Callback, FromVsn, FromAppsVsns, ToRel, + ToAppsVsns, InstallDir) + end + end. + +%%% This is similar to sasl/examples/src/target_system.erl, but with +%%% the following adjustments: +%%% - add a log directory +%%% - use an own 'start' script +%%% - chmod 'start' and 'start_erl' +target_system(Apps,CreateDir,InstallDir,{FromVsn,_,AllAppsVsns,Path}) -> + RelName0 = "otp-"++FromVsn, + + AppsVsns = [{A,V} || {A,V} <- AllAppsVsns, lists:member(A,Apps)], + {RelName,ErtsVsn} = create_relfile(AppsVsns,CreateDir,RelName0,FromVsn), + + %% Create .script and .boot + ok = systools(make_script,[RelName,[{path,Path}]]), + + %% Create base tar file - i.e. erts and all apps + ok = systools(make_tar,[RelName,[{erts,code:root_dir()}, + {path,Path}]]), + + %% Unpack the tar to complete the installation + erl_tar:extract(RelName ++ ".tar.gz", [{cwd, InstallDir}, compressed]), + + %% Add bin and log dirs + BinDir = filename:join([InstallDir, "bin"]), + file:make_dir(BinDir), + file:make_dir(filename:join(InstallDir,"log")), + + %% Delete start scripts - they will be added later + ErtsBinDir = filename:join([InstallDir, "erts-" ++ ErtsVsn, "bin"]), + file:delete(filename:join([ErtsBinDir, "erl"])), + file:delete(filename:join([ErtsBinDir, "start"])), + file:delete(filename:join([ErtsBinDir, "start_erl"])), + + %% Copy .boot to bin/start.boot + copy_file(RelName++".boot",filename:join([BinDir, "start.boot"])), + + %% Copy scripts from erts-xxx/bin to bin + copy_file(filename:join([ErtsBinDir, "epmd"]), + filename:join([BinDir, "epmd"]), [preserve]), + copy_file(filename:join([ErtsBinDir, "run_erl"]), + filename:join([BinDir, "run_erl"]), [preserve]), + copy_file(filename:join([ErtsBinDir, "to_erl"]), + filename:join([BinDir, "to_erl"]), [preserve]), + + %% create start_erl.data, sys.config and start.src + StartErlData = filename:join([InstallDir, "releases", "start_erl.data"]), + write_file(StartErlData, io_lib:fwrite("~s ~s~n", [ErtsVsn, FromVsn])), + SysConfig = filename:join([InstallDir, "releases", FromVsn, "sys.config"]), + write_file(SysConfig, "[]."), + StartSrc = filename:join(ErtsBinDir,"start.src"), + write_file(StartSrc,start_script()), + ok = file:change_mode(StartSrc,8#0755), + + %% Make start_erl executable + %% (this has been fixed in OTP 17 - it is now installed with + %% $INSTALL_SCRIPT instead of $INSTALL_DATA and should therefore + %% be executable from the start) + ok = file:change_mode(filename:join(ErtsBinDir,"start_erl.src"),8#0755), + + %% Substitute variables in erl.src, start.src and start_erl.src + %% (.src found in erts-xxx/bin - result stored in bin) + subst_src_scripts(["erl", "start", "start_erl"], ErtsBinDir, BinDir, + [{"FINAL_ROOTDIR", InstallDir}, {"EMU", "beam"}], + [preserve]), + + %% Create RELEASES + RelFile = filename:join([InstallDir, "releases", + filename:basename(RelName) ++ ".rel"]), + release_handler:create_RELEASES(InstallDir, RelFile), + + {FromVsn, RelName,AppsVsns}. + +systools(Func,Args) -> + case apply(systools,Func,Args) of + ok -> + ok; + error -> + throw({fail,{systools,Func,Args}}) + end. + +%%% This is a copy of $ROOT/erts-xxx/bin/start.src, modified to add +%%% sname and heart +start_script() -> + ["#!/bin/sh\n" + "ROOTDIR=%FINAL_ROOTDIR%\n" + "\n" + "if [ -z \"$RELDIR\" ]\n" + "then\n" + " RELDIR=$ROOTDIR/releases\n" + "fi\n" + "\n" + "START_ERL_DATA=${1:-$RELDIR/start_erl.data}\n" + "\n" + "$ROOTDIR/bin/run_erl -daemon /tmp/ $ROOTDIR/log \"exec $ROOTDIR/bin/start_erl $ROOTDIR $RELDIR $START_ERL_DATA -sname ",atom_to_list(?testnode)," -heart\"\n"]. + +%%% Create a release containing the current (the test node) OTP +%%% release, including relup to allow upgrade from an earlier OTP +%%% release. +upgrade_system(Apps, FromRel, CreateDir, InstallDir, {_,ToVsn,_,_}) -> + ct:log("Generating release to upgrade to."), + + RelName0 = "otp-"++ToVsn, + + AppsVsns = get_vsns(Apps), + {RelName,_} = create_relfile(AppsVsns,CreateDir,RelName0,ToVsn), + FromPath = filename:join([InstallDir,lib,"*",ebin]), + + ok = systools(make_script,[RelName]), + ok = systools(make_relup,[RelName,[FromRel],[FromRel], + [{path,[FromPath]}, + {outdir,CreateDir}]]), + SysConfig = filename:join([CreateDir, "sys.config"]), + write_file(SysConfig, "[]."), + + ok = systools(make_tar,[RelName,[{erts,code:root_dir()}]]), + + {ToVsn, RelName,AppsVsns}. + +%%% Start a new node running the release from target_system/6 +%%% above. Then upgrade to the system from upgrade_system/6. +do_upgrade({Cb,InitState},FromVsn,FromAppsVsns,ToRel,ToAppsVsns,InstallDir) -> + ct:log("Upgrade test attempting to start node.~n" + "If test fails, logs can be found in:~n~ts", + [filename:join(InstallDir,log)]), + Start = filename:join([InstallDir,bin,start]), + {ok,Node} = start_node(Start,FromVsn,FromAppsVsns), + + ct:log("Node started: ~p",[Node]), + State1 = do_callback(Node,Cb,upgrade_init,InitState), + + [{"OTP upgrade test",FromVsn,_,permanent}] = + rpc:call(Node,release_handler,which_releases,[]), + ToRelName = filename:basename(ToRel), + copy_file(ToRel++".tar.gz", + filename:join([InstallDir,releases,ToRelName++".tar.gz"])), + ct:log("Unpacking new release"), + {ok,ToVsn} = rpc:call(Node,release_handler,unpack_release,[ToRelName]), + [{"OTP upgrade test",ToVsn,_,unpacked}, + {"OTP upgrade test",FromVsn,_,permanent}] = + rpc:call(Node,release_handler,which_releases,[]), + ct:log("Installing new release"), + case rpc:call(Node,release_handler,install_release,[ToVsn]) of + {ok,FromVsn,_} -> + ok; + {continue_after_restart,FromVsn,_} -> + ct:log("Waiting for node restart") + end, + %% even if install_release returned {ok,...} there might be an + %% emulator restart (instruction restart_emulator), so we must + %% always make sure the node is running. + wait_node_up(current,ToVsn,ToAppsVsns), + + [{"OTP upgrade test",ToVsn,_,current}, + {"OTP upgrade test",FromVsn,_,permanent}] = + rpc:call(Node,release_handler,which_releases,[]), + ct:log("Permanenting new release"), + ok = rpc:call(Node,release_handler,make_permanent,[ToVsn]), + [{"OTP upgrade test",ToVsn,_,permanent}, + {"OTP upgrade test",FromVsn,_,old}] = + rpc:call(Node,release_handler,which_releases,[]), + + State2 = do_callback(Node,Cb,upgrade_upgraded,State1), + + ct:log("Re-installing old release"), + case rpc:call(Node,release_handler,install_release,[FromVsn]) of + {ok,FromVsn,_} -> + ok; + {continue_after_restart,FromVsn,_} -> + ct:log("Waiting for node restart") + end, + %% even if install_release returned {ok,...} there might be an + %% emulator restart (instruction restart_emulator), so we must + %% always make sure the node is running. + wait_node_up(current,FromVsn,FromAppsVsns), + + [{"OTP upgrade test",ToVsn,_,permanent}, + {"OTP upgrade test",FromVsn,_,current}] = + rpc:call(Node,release_handler,which_releases,[]), + ct:log("Permanenting old release"), + ok = rpc:call(Node,release_handler,make_permanent,[FromVsn]), + [{"OTP upgrade test",ToVsn,_,old}, + {"OTP upgrade test",FromVsn,_,permanent}] = + rpc:call(Node,release_handler,which_releases,[]), + + _State3 = do_callback(Node,Cb,upgrade_downgraded,State2), + + ct:log("Terminating node ~p",[Node]), + erlang:monitor_node(Node,true), + _ = rpc:call(Node,init,stop,[]), + receive {nodedown,Node} -> ok end, + ct:log("Node terminated"), + + ok. + +do_callback(Node,Mod,Func,State) -> + Dir = filename:dirname(code:which(Mod)), + _ = rpc:call(Node,code,add_path,[Dir]), + ct:log("Calling ~p:~p/1",[Mod,Func]), + R = rpc:call(Node,Mod,Func,[State]), + ct:log("~p:~p/1 returned: ~p",[Mod,Func,R]), + case R of + {badrpc,Error} -> + test_server:fail({test_upgrade_callback,Mod,Func,State,Error}); + NewState -> + NewState + end. + +%%% Library functions +previous_major("17") -> + "r16b"; +previous_major(Rel) -> + integer_to_list(list_to_integer(Rel)-1). + +create_relfile(AppsVsns,CreateDir,RelName0,RelVsn) -> + UpgradeAppsVsns = [{A,V,restart_type(A)} || {A,V} <- AppsVsns], + + CoreAppVsns0 = get_vsns([kernel,stdlib,sasl]), + CoreAppVsns = + [{A,V,restart_type(A)} || {A,V} <- CoreAppVsns0, + false == lists:keymember(A,1,AppsVsns)], + + Apps = [App || {App,_} <- AppsVsns], + StartDepsVsns = get_start_deps(Apps,CoreAppVsns), + StartApps = [StartApp || {StartApp,_,_} <- StartDepsVsns] ++ Apps, + + {RuntimeDepsVsns,_} = get_runtime_deps(StartApps,StartApps,[],[]), + + AllAppsVsns0 = StartDepsVsns ++ UpgradeAppsVsns ++ RuntimeDepsVsns, + + %% Should test tools really be included? Some library functions + %% here could be used by callback, but not everything since + %% processes of these applications will not be running. + TestToolAppsVsns0 = get_vsns([test_server,common_test]), + TestToolAppsVsns = + [{A,V,none} || {A,V} <- TestToolAppsVsns0, + false == lists:keymember(A,1,AllAppsVsns0)], + + AllAppsVsns1 = AllAppsVsns0 ++ TestToolAppsVsns, + AllAppsVsns = [AV || AV={A,_,_} <- AllAppsVsns1, + false == lists:member(A,?exclude_apps)], + + ErtsVsn = erlang:system_info(version), + + %% Create the .rel file + RelContent = {release,{"OTP upgrade test",RelVsn},{erts,ErtsVsn},AllAppsVsns}, + RelName = filename:join(CreateDir,RelName0), + RelFile = RelName++".rel", + {ok,Fd} = file:open(RelFile,[write,{encoding,utf8}]), + io:format(Fd,"~tp.~n",[RelContent]), + ok = file:close(Fd), + {RelName,ErtsVsn}. + +get_vsns(Apps) -> + [begin + _ = application:load(A), + {ok,V} = application:get_key(A,vsn), + {A,V} + end || A <- Apps]. + +get_start_deps([App|Apps],Acc) -> + _ = application:load(App), + {ok,StartDeps} = application:get_key(App,applications), + StartDepsVsns = + [begin + _ = application:load(StartApp), + {ok,StartVsn} = application:get_key(StartApp,vsn), + {StartApp,StartVsn,restart_type(StartApp)} + end || StartApp <- StartDeps, + false == lists:keymember(StartApp,1,Acc)], + DepsStartDeps = get_start_deps(StartDeps,Acc ++ StartDepsVsns), + get_start_deps(Apps,DepsStartDeps); +get_start_deps([],Acc) -> + Acc. + +get_runtime_deps([App|Apps],StartApps,Acc,Visited) -> + case lists:member(App,Visited) of + true -> + get_runtime_deps(Apps,StartApps,Acc,Visited); + false -> + %% runtime_dependencies should be possible to read with + %% application:get_key/2, but still isn't so we need to + %% read the .app file... + AppFile = code:where_is_file(atom_to_list(App) ++ ".app"), + {ok,[{application,App,Attrs}]} = file:consult(AppFile), + RuntimeDeps = + lists:flatmap( + fun(Str) -> + [RuntimeAppStr,_] = string:tokens(Str,"-"), + RuntimeApp = list_to_atom(RuntimeAppStr), + case {lists:keymember(RuntimeApp,1,Acc), + lists:member(RuntimeApp,StartApps)} of + {false,false} when RuntimeApp=/=erts -> + [RuntimeApp]; + _ -> + [] + end + end, + proplists:get_value(runtime_dependencies,Attrs,[])), + RuntimeDepsVsns = + [begin + _ = application:load(RuntimeApp), + {ok,RuntimeVsn} = application:get_key(RuntimeApp,vsn), + {RuntimeApp,RuntimeVsn,none} + end || RuntimeApp <- RuntimeDeps], + {DepsRuntimeDeps,NewVisited} = + get_runtime_deps(RuntimeDeps,StartApps,Acc++RuntimeDepsVsns,[App|Visited]), + get_runtime_deps(Apps,StartApps,DepsRuntimeDeps,NewVisited) + end; +get_runtime_deps([],_,Acc,Visited) -> + {Acc,Visited}. + +restart_type(App) when App==kernel; App==stdlib; App==sasl -> + permanent; +restart_type(_) -> + temporary. + +copy_file(Src, Dest) -> + copy_file(Src, Dest, []). + +copy_file(Src, Dest, Opts) -> + {ok,_} = file:copy(Src, Dest), + case lists:member(preserve, Opts) of + true -> + {ok, FileInfo} = file:read_file_info(Src), + file:write_file_info(Dest, FileInfo); + false -> + ok + end. + +write_file(FName, Conts) -> + Enc = file:native_name_encoding(), + {ok, Fd} = file:open(FName, [write]), + file:write(Fd, unicode:characters_to_binary(Conts,Enc,Enc)), + file:close(Fd). + +%% Substitute all occurrences of %Var% for Val in the given scripts +subst_src_scripts(Scripts, SrcDir, DestDir, Vars, Opts) -> + lists:foreach(fun(Script) -> + subst_src_script(Script, SrcDir, DestDir, + Vars, Opts) + end, Scripts). + +subst_src_script(Script, SrcDir, DestDir, Vars, Opts) -> + subst_file(filename:join([SrcDir, Script ++ ".src"]), + filename:join([DestDir, Script]), + Vars, Opts). + +subst_file(Src, Dest, Vars, Opts) -> + {ok, Bin} = file:read_file(Src), + Conts = binary_to_list(Bin), + NConts = subst(Conts, Vars), + write_file(Dest, NConts), + case lists:member(preserve, Opts) of + true -> + {ok, FileInfo} = file:read_file_info(Src), + file:write_file_info(Dest, FileInfo); + false -> + ok + end. + +subst(Str, [{Var,Val}|Vars]) -> + subst(re:replace(Str,"%"++Var++"%",Val,[{return,list}]),Vars); +subst(Str, []) -> + Str. + +%%% Start a node by executing the given start command. This node will +%%% be used for upgrade. +start_node(Start,ExpVsn,ExpAppsVsns) -> + Port = open_port({spawn_executable, Start}, []), + unlink(Port), + erlang:port_close(Port), + wait_node_up(permanent,ExpVsn,ExpAppsVsns). + +wait_node_up(ExpStatus,ExpVsn,ExpAppsVsns) -> + Node = node_name(?testnode), + wait_node_up(Node,ExpStatus,ExpVsn,lists:keysort(1,ExpAppsVsns),60). + +wait_node_up(Node,ExpStatus,ExpVsn,ExpAppsVsns,0) -> + test_server:fail({node_not_started,app_check_failed,ExpVsn,ExpAppsVsns, + rpc:call(Node,release_handler,which_releases,[ExpStatus]), + rpc:call(Node,application,which_applications,[])}); +wait_node_up(Node,ExpStatus,ExpVsn,ExpAppsVsns,N) -> + case {rpc:call(Node,release_handler,which_releases,[ExpStatus]), + rpc:call(Node, application, which_applications, [])} of + {[{_,ExpVsn,_,_}],Apps} when is_list(Apps) -> + case [{A,V} || {A,_,V} <- lists:keysort(1,Apps), + lists:keymember(A,1,ExpAppsVsns)] of + ExpAppsVsns -> + {ok,Node}; + _ -> + timer:sleep(2000), + wait_node_up(Node,ExpStatus,ExpVsn,ExpAppsVsns,N-1) + end; + _ -> + timer:sleep(2000), + wait_node_up(Node,ExpStatus,ExpVsn,ExpAppsVsns,N-1) + end. + +node_name(Sname) -> + {ok,Host} = inet:gethostname(), + list_to_atom(atom_to_list(Sname) ++ "@" ++ Host). + +rm_rf(Dir) -> + case file:read_file_info(Dir) of + {ok, #file_info{type = directory}} -> + {ok, Content} = file:list_dir_all(Dir), + [rm_rf(filename:join(Dir,C)) || C <- Content], + ok=file:del_dir(Dir), + ok; + {ok, #file_info{}} -> + ok=file:delete(Dir); + _ -> + ok + end. diff --git a/lib/common_test/test/ct_netconfc_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE.erl index c89a4cdabe..2959f77087 100644 --- a/lib/common_test/test/ct_netconfc_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -63,7 +63,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [ - default + netconfc1_SUITE, + netconfc_remote_SUITE ]. %%-------------------------------------------------------------------- @@ -72,14 +73,21 @@ all() -> %%%----------------------------------------------------------------- %%% -default(Config) when is_list(Config) -> +netconfc1_SUITE(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), Suite = filename:join(DataDir, "netconfc1_SUITE"), CfgFile = filename:join(DataDir, "netconfc1.cfg"), {Opts,ERPid} = setup([{suite,Suite},{config,CfgFile}, - {label,default}], Config), + {label,netconfc1_SUITE}], Config), - ok = execute(default, Opts, ERPid, Config). + ok = execute(netconfc1_SUITE, Opts, ERPid, Config). + +netconfc_remote_SUITE(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + Suite = filename:join(DataDir, "netconfc_remote_SUITE"), + {Opts,ERPid} = setup([{suite,Suite},{label,netconfc_remote_SUITE}], Config), + + ok = execute(netconfc_remote_SUITE, Opts, ERPid, Config). %%%----------------------------------------------------------------- @@ -112,16 +120,15 @@ reformat(Events, EH) -> %%%----------------------------------------------------------------- %%% TEST EVENTS %%%----------------------------------------------------------------- -events_to_check(default,Config) -> - {module,_} = code:load_abs(filename:join(?config(data_dir,Config), - netconfc1_SUITE)), - TCs = netconfc1_SUITE:all(), - code:purge(netconfc1_SUITE), - code:delete(netconfc1_SUITE), +events_to_check(Suite,Config) -> + {module,_} = code:load_abs(filename:join(?config(data_dir,Config),Suite)), + TCs = Suite:all(), + code:purge(Suite), + code:delete(Suite), OneTest = [{?eh,start_logging,{'DEF','RUNDIR'}}] ++ - [{?eh,tc_done,{netconfc1_SUITE,TC,ok}} || TC <- TCs] ++ + [{?eh,tc_done,{Suite,TC,ok}} || TC <- TCs] ++ [{?eh,stop_logging,[]}], %% 2 tests (ct:run_test + script_start) is default diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl index 2bcfeeec0c..332e54d1a7 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl @@ -1,7 +1,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -30,25 +30,10 @@ -module(netconfc1_SUITE). -include_lib("common_test/include/ct.hrl"). -include_lib("common_test/src/ct_netconfc.hrl"). --include_lib("public_key/include/public_key.hrl"). +-include("netconfc_test_lib.hrl"). -compile(export_all). -%% Default timetrap timeout (set in init_per_testcase). --define(default_timeout, ?t:minutes(1)). - --define(NS,ns). --define(LOCALHOST, "127.0.0.1"). --define(SSH_PORT, 2060). - --define(DEFAULT_SSH_OPTS,[{ssh,?LOCALHOST}, - {port,?SSH_PORT}, - {user,"xxx"}, - {password,"xxx"}]). --define(DEFAULT_SSH_OPTS(Dir), ?DEFAULT_SSH_OPTS++[{user_dir,Dir}]). - --define(ok,ok). - suite() -> [{ct_hooks, [{cth_conn_log, [{ct_netconfc,[{log_type,html}, %will be overwritten by config @@ -91,6 +76,7 @@ all() -> get_config, get_config_xpath, edit_config, + edit_config_opt_params, copy_config, delete_config, lock, @@ -136,8 +122,8 @@ end_per_testcase(_Case, Config) -> init_per_suite(Config) -> case catch {crypto:start(), ssh:start()} of {ok, ok} -> - {ok, _} = get_id_keys(Config), - make_dsa_files(Config), + {ok, _} = netconfc_test_lib:get_id_keys(Config), + netconfc_test_lib:make_dsa_files(Config), Server = ?NS:start(?config(data_dir,Config)), [{server,Server}|Config]; _ -> @@ -148,7 +134,7 @@ end_per_suite(Config) -> ?NS:stop(?config(server,Config)), ssh:stop(), crypto:stop(), - remove_id_keys(Config), + netconfc_test_lib:remove_id_keys(Config), Config. hello(Config) -> @@ -415,6 +401,18 @@ edit_config(Config) -> ?ok = ct_netconfc:close_session(Client), ok. +edit_config_opt_params(Config) -> + DataDir = ?config(data_dir,Config), + {ok,Client} = open_success(DataDir), + ?NS:expect_reply({'edit-config',{'default-operation',"none"}},ok), + ?ok = ct_netconfc:edit_config(Client,running, + {server,[{xmlns,"myns"}], + [{name,["myserver"]}]}, + [{'default-operation',["none"]}]), + ?NS:expect_do_reply('close-session',close,ok), + ?ok = ct_netconfc:close_session(Client), + ok. + copy_config(Config) -> DataDir = ?config(data_dir,Config), {ok,Client} = open_success(DataDir), @@ -1001,165 +999,3 @@ pad(I) when I<10 -> "0"++integer_to_list(I); pad(I) -> integer_to_list(I). - - -%%%----------------------------------------------------------------- -%%% BEGIN SSH key management -%% copy private keys to given dir from ~/.ssh -get_id_keys(Config) -> - DstDir = ?config(priv_dir, Config), - SrcDir = filename:join(os:getenv("HOME"), ".ssh"), - RsaOk = copyfile(SrcDir, DstDir, "id_rsa"), - DsaOk = copyfile(SrcDir, DstDir, "id_dsa"), - case {RsaOk, DsaOk} of - {{ok, _}, {ok, _}} -> {ok, both}; - {{ok, _}, _} -> {ok, rsa}; - {_, {ok, _}} -> {ok, dsa}; - {Error, _} -> Error - end. - -%% Remove later on. Use make_dsa_files instead. -remove_id_keys(Config) -> - Dir = ?config(priv_dir, Config), - file:delete(filename:join(Dir, "id_rsa")), - file:delete(filename:join(Dir, "id_dsa")). - - -make_dsa_files(Config) -> - make_dsa_files(Config, rfc4716_public_key). -make_dsa_files(Config, Type) -> - {DSA, EncodedKey} = gen_dsa(128, 20), - PKey = DSA#'DSAPrivateKey'.y, - P = DSA#'DSAPrivateKey'.p, - Q = DSA#'DSAPrivateKey'.q, - G = DSA#'DSAPrivateKey'.g, - Dss = #'Dss-Parms'{p=P, q=Q, g=G}, - {ok, Hostname} = inet:gethostname(), - {ok, {A, B, C, D}} = inet:getaddr(Hostname, inet), - IP = lists:concat([A, ".", B, ".", C, ".", D]), - Attributes = [], % Could be [{comment,"user@" ++ Hostname}], - HostNames = [{hostnames,[IP, IP]}], - PublicKey = [{{PKey, Dss}, Attributes}], - KnownHosts = [{{PKey, Dss}, HostNames}], - - KnownHostsEnc = public_key:ssh_encode(KnownHosts, known_hosts), - KnownHosts = public_key:ssh_decode(KnownHostsEnc, known_hosts), - - PublicKeyEnc = public_key:ssh_encode(PublicKey, Type), - - SystemTmpDir = ?config(data_dir, Config), - filelib:ensure_dir(SystemTmpDir), - file:make_dir(SystemTmpDir), - - DSAFile = filename:join(SystemTmpDir, "ssh_host_dsa_key.pub"), - file:delete(DSAFile), - - DSAPrivateFile = filename:join(SystemTmpDir, "ssh_host_dsa_key"), - file:delete(DSAPrivateFile), - - KHFile = filename:join(SystemTmpDir, "known_hosts"), - file:delete(KHFile), - - PemBin = public_key:pem_encode([EncodedKey]), - - file:write_file(DSAFile, PublicKeyEnc), - file:write_file(KHFile, KnownHostsEnc), - file:write_file(DSAPrivateFile, PemBin), - ok. - - -%%-------------------------------------------------------------------- -%% @doc Creates a dsa key (OBS: for testing only) -%% the sizes are in bytes -%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} -%% @end -%%-------------------------------------------------------------------- -gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) -> - Key = gen_dsa2(LSize, NSize), - {Key, encode_key(Key)}. - -encode_key(Key = #'DSAPrivateKey'{}) -> - Der = public_key:der_encode('DSAPrivateKey', Key), - {'DSAPrivateKey', Der, not_encrypted}. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% DSA key generation (OBS: for testing only) -%% See http://en.wikipedia.org/wiki/Digital_Signature_Algorithm -%% and the fips_186-3.pdf -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -gen_dsa2(LSize, NSize) -> - Q = prime(NSize), %% Choose N-bit prime Q - X0 = prime(LSize), - P0 = prime((LSize div 2) +1), - - %% Choose L-bit prime modulus P such that p-1 is a multiple of q. - case dsa_search(X0 div (2*Q*P0), P0, Q, 1000) of - error -> - gen_dsa2(LSize, NSize); - P -> - G = crypto:mod_pow(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q. - %% such that This may be done by setting g = h^(p-1)/q mod p, commonly h=2 is used. - - X = prime(20), %% Choose x by some random method, where 0 < x < q. - Y = crypto:mod_pow(G, X, P), %% Calculate y = g^x mod p. - - #'DSAPrivateKey'{version=0, p = P, q = Q, - g = crypto:bytes_to_integer(G), y = crypto:bytes_to_integer(Y), x = X} - end. - -%% See fips_186-3.pdf -dsa_search(T, P0, Q, Iter) when Iter > 0 -> - P = 2*T*Q*P0 + 1, - case is_prime(P, 50) of - true -> P; - false -> dsa_search(T+1, P0, Q, Iter-1) - end; -dsa_search(_,_,_,_) -> - error. - - -%%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -prime(ByteSize) -> - Rand = odd_rand(ByteSize), - prime_odd(Rand, 0). - -prime_odd(Rand, N) -> - case is_prime(Rand, 50) of - true -> - Rand; - false -> - prime_odd(Rand+2, N+1) - end. - -%% see http://en.wikipedia.org/wiki/Fermat_primality_test -is_prime(_, 0) -> true; -is_prime(Candidate, Test) -> - CoPrime = odd_rand(10000, Candidate), - Result = crypto:mod_pow(CoPrime, Candidate, Candidate) , - is_prime(CoPrime, crypto:bytes_to_integer(Result), Candidate, Test). - -is_prime(CoPrime, CoPrime, Candidate, Test) -> - is_prime(Candidate, Test-1); -is_prime(_,_,_,_) -> - false. - -odd_rand(Size) -> - Min = 1 bsl (Size*8-1), - Max = (1 bsl (Size*8))-1, - odd_rand(Min, Max). - -odd_rand(Min,Max) -> - Rand = crypto:rand_uniform(Min,Max), - case Rand rem 2 of - 0 -> - Rand + 1; - _ -> - Rand - end. - -copyfile(SrcDir, DstDir, Fn) -> - file:copy(filename:join(SrcDir, Fn), - filename:join(DstDir, Fn)). - -%%% END SSH key management -%%%----------------------------------------------------------------- diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl new file mode 100644 index 0000000000..7a44d148dd --- /dev/null +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl @@ -0,0 +1,147 @@ +%%-------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%%---------------------------------------------------------------------- +-module(netconfc_remote_SUITE). +-include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/src/ct_netconfc.hrl"). +-include("netconfc_test_lib.hrl"). + +-compile(export_all). + +suite() -> + [{ct_hooks, [{cth_conn_log,[{ct_netconfc,[{log_type,html}]}]}]}]. + +all() -> + case os:find_executable("ssh") of + false -> + {skip, "SSH not installed on host"}; + _ -> + [remote_crash + ] + end. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(Case, Config) -> + stop_node(Case), + Dog = test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. + +end_per_testcase(Case, Config) -> + stop_node(Case), + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +stop_node(Case) -> + {ok,Host} = inet:gethostname(), + Node = list_to_atom("nc_" ++ atom_to_list(Case)++ "@" ++ Host), + rpc:call(Node,erlang,halt,[]). + + +init_per_suite(Config) -> + case {crypto:start(),ssh:start()} of + {ok,ok} -> + {ok, _} = netconfc_test_lib:get_id_keys(Config), + netconfc_test_lib:make_dsa_files(Config), + Config; + _ -> + {skip, "Crypto and/or SSH could not be started locally!"} + end. + +end_per_suite(Config) -> + ssh:stop(), + crypto:stop(), + netconfc_test_lib:remove_id_keys(Config), + Config. + +%% This test case is related to seq12645 +%% Running the netconf server in a remote node, test that the client +%% process terminates if the remote node goes down. +remote_crash(Config) -> + {ok,Node} = ct_slave:start(nc_remote_crash), + Pa = filename:dirname(code:which(?NS)), + true = rpc:call(Node,code,add_patha,[Pa]), + + case {rpc:call(Node,crypto,start,[]),rpc:call(Node,ssh,start,[])} of + {ok,ok} -> + Server = rpc:call(Node,?NS,start,[?config(data_dir,Config)]), + remote_crash(Node,Config); + _ -> + {skip, "Crypto and/or SSH could not be started remote!"} + end. + +remote_crash(Node,Config) -> + DataDir = ?config(data_dir,Config), + {ok,Client} = open_success(Node,DataDir), + + ns(Node,expect_reply,[{'create-subscription',[stream]},ok]), + ?ok = ct_netconfc:create_subscription(Client), + + true = erlang:is_process_alive(Client), + Ref = erlang:monitor(process,Client), + rpc:call(Node,erlang,halt,[]), % take the node down as brutally as possible + receive {'DOWN',Ref,process,Client,_} -> + ok + after 10000 -> + ct:fail(client_still_alive) + end. + +%%%----------------------------------------------------------------- + +break(_Config) -> + test_server:break("break test case"). + +%%%----------------------------------------------------------------- +%% Open a netconf session which is not specified in a config file +open_success(Node,Dir) -> + open_success(Node,Dir,[]). + +%% Open a netconf session which is not specified in a config file, and +%% give som extra options in addition to the test defaults. +open_success(Node,Dir,ExtraOpts) when is_list(Dir), is_list(ExtraOpts) -> + ns(Node,hello,[1]), % tell server to send hello with session id 1 + ns(Node,expect,[hello]), % tell server to expect a hello message from client + open(Dir,ExtraOpts); + +%% Open a named netconf session which is not specified in a config file +open_success(Node,KeyOrName,Dir) when is_atom(KeyOrName), is_list(Dir) -> + ns(Node,hello,[1]), + ns(Node,expect,[hello]), + ct_netconfc:open(KeyOrName,?DEFAULT_SSH_OPTS(Dir)). + +open(Dir) -> + open(Dir,[]). +open(Dir,ExtraOpts) -> + Opts = lists:ukeymerge(1,lists:keysort(1,ExtraOpts), + lists:keysort(1,?DEFAULT_SSH_OPTS(Dir))), + ct_netconfc:open(Opts). + +%%%----------------------------------------------------------------- +%%% Call server on remote node +ns(Node,Func,Args) -> + rpc:call(Node,?NS,Func,Args). + diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.erl new file mode 100644 index 0000000000..e058bc7600 --- /dev/null +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.erl @@ -0,0 +1,166 @@ +-module(netconfc_test_lib). + +-export([get_id_keys/1, remove_id_keys/1, make_dsa_files/1]). +-include_lib("common_test/include/ct.hrl"). +-include_lib("public_key/include/public_key.hrl"). + +%%%----------------------------------------------------------------- +%%% BEGIN SSH key management +%% copy private keys to given dir from ~/.ssh +get_id_keys(Config) -> + DstDir = ?config(priv_dir, Config), + SrcDir = filename:join(os:getenv("HOME"), ".ssh"), + RsaOk = copyfile(SrcDir, DstDir, "id_rsa"), + DsaOk = copyfile(SrcDir, DstDir, "id_dsa"), + case {RsaOk, DsaOk} of + {{ok, _}, {ok, _}} -> {ok, both}; + {{ok, _}, _} -> {ok, rsa}; + {_, {ok, _}} -> {ok, dsa}; + {Error, _} -> Error + end. + +%% Remove later on. Use make_dsa_files instead. +remove_id_keys(Config) -> + Dir = ?config(priv_dir, Config), + file:delete(filename:join(Dir, "id_rsa")), + file:delete(filename:join(Dir, "id_dsa")). + + +make_dsa_files(Config) -> + make_dsa_files(Config, rfc4716_public_key). +make_dsa_files(Config, Type) -> + {DSA, EncodedKey} = gen_dsa(128, 20), + PKey = DSA#'DSAPrivateKey'.y, + P = DSA#'DSAPrivateKey'.p, + Q = DSA#'DSAPrivateKey'.q, + G = DSA#'DSAPrivateKey'.g, + Dss = #'Dss-Parms'{p=P, q=Q, g=G}, + {ok, Hostname} = inet:gethostname(), + {ok, {A, B, C, D}} = inet:getaddr(Hostname, inet), + IP = lists:concat([A, ".", B, ".", C, ".", D]), + Attributes = [], % Could be [{comment,"user@" ++ Hostname}], + HostNames = [{hostnames,[IP, IP]}], + PublicKey = [{{PKey, Dss}, Attributes}], + KnownHosts = [{{PKey, Dss}, HostNames}], + + KnownHostsEnc = public_key:ssh_encode(KnownHosts, known_hosts), + KnownHosts = public_key:ssh_decode(KnownHostsEnc, known_hosts), + + PublicKeyEnc = public_key:ssh_encode(PublicKey, Type), + + SystemTmpDir = ?config(data_dir, Config), + filelib:ensure_dir(SystemTmpDir), + file:make_dir(SystemTmpDir), + + DSAFile = filename:join(SystemTmpDir, "ssh_host_dsa_key.pub"), + file:delete(DSAFile), + + DSAPrivateFile = filename:join(SystemTmpDir, "ssh_host_dsa_key"), + file:delete(DSAPrivateFile), + + KHFile = filename:join(SystemTmpDir, "known_hosts"), + file:delete(KHFile), + + PemBin = public_key:pem_encode([EncodedKey]), + + file:write_file(DSAFile, PublicKeyEnc), + file:write_file(KHFile, KnownHostsEnc), + file:write_file(DSAPrivateFile, PemBin), + ok. + + +%%-------------------------------------------------------------------- +%% @doc Creates a dsa key (OBS: for testing only) +%% the sizes are in bytes +%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} +%% @end +%%-------------------------------------------------------------------- +gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) -> + Key = gen_dsa2(LSize, NSize), + {Key, encode_key(Key)}. + +encode_key(Key = #'DSAPrivateKey'{}) -> + Der = public_key:der_encode('DSAPrivateKey', Key), + {'DSAPrivateKey', Der, not_encrypted}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% DSA key generation (OBS: for testing only) +%% See http://en.wikipedia.org/wiki/Digital_Signature_Algorithm +%% and the fips_186-3.pdf +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +gen_dsa2(LSize, NSize) -> + Q = prime(NSize), %% Choose N-bit prime Q + X0 = prime(LSize), + P0 = prime((LSize div 2) +1), + + %% Choose L-bit prime modulus P such that p-1 is a multiple of q. + case dsa_search(X0 div (2*Q*P0), P0, Q, 1000) of + error -> + gen_dsa2(LSize, NSize); + P -> + G = crypto:mod_pow(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q. + %% such that This may be done by setting g = h^(p-1)/q mod p, commonly h=2 is used. + + X = prime(20), %% Choose x by some random method, where 0 < x < q. + Y = crypto:mod_pow(G, X, P), %% Calculate y = g^x mod p. + + #'DSAPrivateKey'{version=0, p = P, q = Q, + g = crypto:bytes_to_integer(G), y = crypto:bytes_to_integer(Y), x = X} + end. + +%% See fips_186-3.pdf +dsa_search(T, P0, Q, Iter) when Iter > 0 -> + P = 2*T*Q*P0 + 1, + case is_prime(P, 50) of + true -> P; + false -> dsa_search(T+1, P0, Q, Iter-1) + end; +dsa_search(_,_,_,_) -> + error. + + +%%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +prime(ByteSize) -> + Rand = odd_rand(ByteSize), + prime_odd(Rand, 0). + +prime_odd(Rand, N) -> + case is_prime(Rand, 50) of + true -> + Rand; + false -> + prime_odd(Rand+2, N+1) + end. + +%% see http://en.wikipedia.org/wiki/Fermat_primality_test +is_prime(_, 0) -> true; +is_prime(Candidate, Test) -> + CoPrime = odd_rand(10000, Candidate), + Result = crypto:mod_pow(CoPrime, Candidate, Candidate) , + is_prime(CoPrime, crypto:bytes_to_integer(Result), Candidate, Test). + +is_prime(CoPrime, CoPrime, Candidate, Test) -> + is_prime(Candidate, Test-1); +is_prime(_,_,_,_) -> + false. + +odd_rand(Size) -> + Min = 1 bsl (Size*8-1), + Max = (1 bsl (Size*8))-1, + odd_rand(Min, Max). + +odd_rand(Min,Max) -> + Rand = crypto:rand_uniform(Min,Max), + case Rand rem 2 of + 0 -> + Rand + 1; + _ -> + Rand + end. + +copyfile(SrcDir, DstDir, Fn) -> + file:copy(filename:join(SrcDir, Fn), + filename:join(DstDir, Fn)). + +%%% END SSH key management +%%%----------------------------------------------------------------- diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.hrl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.hrl new file mode 100644 index 0000000000..dcaad5ba93 --- /dev/null +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.hrl @@ -0,0 +1,14 @@ +%% Default timetrap timeout (set in init_per_testcase). +-define(default_timeout, ?t:minutes(1)). + +-define(NS,ns). % netconf server module +-define(LOCALHOST, "127.0.0.1"). +-define(SSH_PORT, 2060). + +-define(DEFAULT_SSH_OPTS,[{ssh,?LOCALHOST}, + {port,?SSH_PORT}, + {user,"xxx"}, + {password,"xxx"}]). +-define(DEFAULT_SSH_OPTS(Dir), ?DEFAULT_SSH_OPTS++[{user_dir,Dir}]). + +-define(ok,ok). diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl index fb0734d48e..f7c7b891bb 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl @@ -1,7 +1,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -382,6 +382,7 @@ event({startElement,_,Name,_,Attrs},[ignore,{se,Name,As}|Match]) -> event({startPrefixMapping,_,Ns},[{ns,Ns}|Match]) -> Match; event({startPrefixMapping,_,Ns},[ignore,{ns,Ns}|Match]) -> Match; event({endPrefixMapping,_},Match) -> Match; +event({characters,Chs},[{characters,Chs}|Match]) -> Match; event({endElement,_,Name,_},[{ee,Name}|Match]) -> Match; event({endElement,_,Name,_},[ignore,{ee,Name}|Match]) -> Match; event(endDocument,Match) when Match==[]; Match==[ignore] -> ok; @@ -471,14 +472,17 @@ capabilities(no_caps) -> %%% expect_do_reply/3. %%% %%% match(term()) -> [Match]. -%%% Match = ignore | {se,Name} | {se,Name,Attrs} | {ee,Name} | {ns,Namespace} +%%% Match = ignore | {se,Name} | {se,Name,Attrs} | {ee,Name} | +%%% {ns,Namespace} | {characters,Chs} %%% Name = string() +%%% Chs = string() %%% Attrs = [{atom(),string()}] %%% Namespace = string() %%% %%% 'se' means start element, 'ee' means end element - i.e. to match %%% an XML element you need one 'se' entry and one 'ee' entry with the -%%% same name in the match list. +%%% same name in the match list. 'characters' can be used for matching +%%% character data (cdata) inside an element. match(hello) -> [ignore,{se,"hello"},ignore,{ee,"hello"},ignore]; match('close-session') -> @@ -487,6 +491,10 @@ match('close-session') -> match('edit-config') -> [ignore,{se,"rpc"},{se,"edit-config"},{se,"target"},ignore,{ee,"target"}, {se,"config"},ignore,{ee,"config"},{ee,"edit-config"},{ee,"rpc"},ignore]; +match({'edit-config',{'default-operation',DO}}) -> + [ignore,{se,"rpc"},{se,"edit-config"},{se,"target"},ignore,{ee,"target"}, + {se,"default-operation"},{characters,DO},{ee,"default-operation"}, + {se,"config"},ignore,{ee,"config"},{ee,"edit-config"},{ee,"rpc"},ignore]; match('get') -> match({get,subtree}); match({'get',FilterType}) -> diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 7a30c68593..5626aa34ab 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -155,7 +155,8 @@ collect(remove_message) -> {set,[],[],remove_message}; collect({put_map,F,Op,S,D,R,{list,Puts}}) -> {set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}; collect({get_map_elements,F,S,{list,Gets}}) -> - {set,Gets,[S],{get_map_elements,F}}; + {Ss,Ds} = beam_utils:spliteven(Gets), + {set,Ds,[S|Ss],{get_map_elements,F}}; collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; collect(fclearerror) -> {set,[],[],fclearerror}; collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror}; diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 46835bece1..05d067dc48 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -63,7 +63,8 @@ norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I}; norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2}; norm({set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}) -> {put_map,F,Op,S,D,R,{list,Puts}}; -norm({set,Gets,[S],{get_map_elements,F}}) -> +norm({set,Ds,[S|Ss],{get_map_elements,F}}) -> + Gets = beam_utils:joineven(Ss,Ds), {get_map_elements,F,S,{list,Gets}}; norm({set,[],[],remove_message}) -> remove_message; norm({set,[],[],fclearerror}) -> fclearerror; diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index 688bba9a94..f5dba314ae 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -53,8 +53,9 @@ split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is], Bl, Acc) when Lbl =/= 0 -> split_block(Is, [], [{put_map,Fail,Op,S,D,R,{list,Puts}}| make_block(Bl, Acc)]); -split_block([{set,Gets,[S],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc) +split_block([{set,Ds,[S|Ss],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 -> + Gets = beam_utils:joineven(Ss,Ds), split_block(Is, [], [{get_map_elements,Fail,S,{list,Gets}}|make_block(Bl, Acc)]); split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 58c0f765ae..cdddad4153 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -106,6 +106,20 @@ simplify_basic_1([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Acc) -> Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]) end; +simplify_basic_1([{test,is_map,_,[R]}=I|Is], Ts0, Acc) -> + case tdb_find(R, Ts0) of + map -> simplify_basic_1(Is, Ts0, Acc); + _Other -> + Ts = update(I, Ts0), + simplify_basic_1(Is, Ts, [I|Acc]) + end; +simplify_basic_1([{test,is_nonempty_list,_,[R]}=I|Is], Ts0, Acc) -> + case tdb_find(R, Ts0) of + nonempty_list -> simplify_basic_1(Is, Ts0, Acc); + _Other -> + Ts = update(I, Ts0), + simplify_basic_1(Is, Ts, [I|Acc]) + end; simplify_basic_1([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Acc0) -> Acc = case tdb_find(R, Ts0) of {atom,_}=Atom -> Acc0; @@ -402,6 +416,10 @@ update({test,is_float,_Fail,[Src]}, Ts0) -> tdb_update([{Src,float}], Ts0); update({test,test_arity,_Fail,[Src,Arity]}, Ts0) -> tdb_update([{Src,{tuple,Arity,[]}}], Ts0); +update({test,is_map,_Fail,[Src]}, Ts0) -> + tdb_update([{Src,map}], Ts0); +update({test,is_nonempty_list,_Fail,[Src]}, Ts0) -> + tdb_update([{Src,nonempty_list}], Ts0); update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) -> case tdb_find(Reg, Ts) of error -> @@ -710,6 +728,8 @@ merge_type_info(NewType, _) -> verify_type(NewType), NewType. +verify_type(map) -> ok; +verify_type(nonempty_list) -> ok; verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok; verify_type({tuple,Sz,[_]}) when is_integer(Sz) -> ok; verify_type({tuple_element,_,_}) -> ok; diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 8ca368c167..e82ba82d38 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -26,6 +26,8 @@ code_at/2,bif_to_test/3,is_pure_test/1, live_opt/1,delete_live_annos/1,combine_heap_needs/2]). +-export([joineven/2,spliteven/1]). + -import(lists, [member/2,sort/1,reverse/1,splitwith/2]). -record(live, @@ -832,3 +834,15 @@ x_live([_|Rs], Regs) -> x_live(Rs, Regs); x_live([], Regs) -> Regs. is_live(X, Regs) -> ((Regs bsr X) band 1) =:= 1. + +%% spliteven/1 +%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]} +spliteven(Rs) -> spliteven(Rs,[],[]). +spliteven([],Ss,Ds) -> {reverse(Ss),reverse(Ds)}; +spliteven([S,D|Rs],Ss,Ds) -> + spliteven(Rs,[S|Ss],[D|Ds]). + +%% joineven/1 +%% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6] +joineven([],[]) -> []; +joineven([S|Ss],[D|Ds]) -> [S,D|joineven(Ss,Ds)]. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 9d5563d13b..0acc7a227f 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1123,7 +1123,9 @@ assert_freg_set(Fr, _) -> error({bad_source,Fr}). %%% Maps %% ensure that a list of literals has a strict -%% ascending term order (also meaning unique literals) +%% ascending term order (also meaning unique literals). +%% Single item lists may have registers. +assert_strict_literal_termorder([_]) -> ok; assert_strict_literal_termorder(Ls) -> Vs = lists:map(fun (L) -> get_literal(L) end, Ls), case check_strict_value_termorder(Vs) of diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 9d6768b157..7a2c3d70de 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -3063,10 +3063,12 @@ pat_vars(Node, Vs) -> map -> pat_list_vars(map_es(Node), Vs); map_pair -> - pat_list_vars([map_pair_op(Node),map_pair_key(Node),map_pair_val(Node)],Vs); + %% map_pair_key is not a pattern var, excluded + pat_list_vars([map_pair_op(Node),map_pair_val(Node)],Vs); binary -> pat_list_vars(binary_segments(Node), Vs); bitstr -> + %% bitstr_size is not a pattern var, excluded pat_vars(bitstr_val(Node), Vs); alias -> pat_vars(alias_pat(Node), [alias_var(Node) | Vs]) diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index 75740e8b9d..f8489a800b 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -1341,23 +1341,23 @@ i_bitstr(E, Ren, Env, S) -> S3 = count_size(weight(bitstr), S2), {update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}. -i_map(E, Ctx, Ren, Env, S) -> +i_map(E, Ctx, Ren, Env, S0) -> %% Visit the segments for value. - {M1, S1} = i(map_arg(E), value, Ren, Env, S), + {M1, S1} = i(map_arg(E), value, Ren, Env, S0), {Es, S2} = mapfoldl(fun (E, S) -> i_map_pair(E, Ctx, Ren, Env, S) end, S1, map_es(E)), S3 = count_size(weight(map), S2), {update_c_map(E, M1,Es), S3}. -i_map_pair(E, Ctx, Ren, Env, S) -> - %% It is not necessary to visit the Op and Key fields, - %% since these are always literals. - {Val, S1} = i(map_pair_val(E), Ctx, Ren, Env, S), +i_map_pair(E, Ctx, Ren, Env, S0) -> + %% It is not necessary to visit the Op field + %% since it is always a literal. + {Key, S1} = i(map_pair_key(E), value, Ren, Env, S0), + {Val, S2} = i(map_pair_val(E), Ctx, Ren, Env, S1), Op = map_pair_op(E), - Key = map_pair_key(E), - S2 = count_size(weight(map_pair), S1), - {update_c_map_pair(E, Op, Key, Val), S2}. + S3 = count_size(weight(map_pair), S2), + {update_c_map_pair(E, Op, Key, Val), S3}. %% This is a simplified version of `i_pattern', for lists of parameter @@ -1420,15 +1420,11 @@ i_pattern(E, Ren, Env, Ren0, Env0, S) -> S2 = count_size(weight(binary), S1), {update_c_binary(E, Es), S2}; map -> - %% map patterns should not have args - M = map_arg(E), - {Es, S1} = mapfoldl(fun (E, S) -> i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) - end, - S, map_es(E)), + end, S, map_es(E)), S2 = count_size(weight(map), S1), - {update_c_map(E, M, Es), S2}; + {update_c_map(E, map_arg(E), Es), S2}; _ -> case is_literal(E) of true -> @@ -1464,12 +1460,12 @@ i_bitstr_pattern(E, Ren, Env, Ren0, Env0, S) -> i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) -> %% It is not necessary to visit the Op it is always a literal. - %% Same goes for Key - {Val, S1} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S), + %% Key is an expression + {Key, S1} = i(map_pair_key(E), value, Ren0, Env0, S), + {Val, S2} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S1), Op = map_pair_op(E), %% should be 'exact' literal - Key = map_pair_key(E), - S2 = count_size(weight(map_pair), S1), - {update_c_map_pair(E, Op, Key, Val), S2}. + S3 = count_size(weight(map_pair), S2), + {update_c_map_pair(E, Op, Key, Val), S3}. %% --------------------------------------------------------------------- diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index e53bdd4efb..b93da8e97f 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -520,9 +520,9 @@ variables(T, S) -> tuple -> vars_in_list(tuple_es(T), S); map -> - vars_in_list(map_es(T), S); + vars_in_list([map_arg(T)|map_es(T)], S); map_pair -> - vars_in_list([map_pair_op(T),map_pair_key(T), map_pair_val(T)], S); + vars_in_list([map_pair_op(T),map_pair_key(T),map_pair_val(T)], S); 'let' -> Vs = variables(let_body(T), S), Vs1 = var_list_names(let_vars(T)), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index c7d91070f6..f347438509 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -431,11 +431,6 @@ pass(from_core) -> {".core",[?pass(parse_core)|core_passes()]}; pass(from_asm) -> {".S",[?pass(beam_consult_asm)|asm_passes()]}; -pass(asm) -> - %% TODO: remove 'asm' in 18.0 - io:format("compile:file/2 option 'asm' has been deprecated and will be~n" - "removed in the 18.0 release. Use 'from_asm' instead.~n"), - pass(from_asm); pass(from_beam) -> {".beam",[?pass(read_beam_file)|binary_passes()]}; pass(_) -> none. diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 25df33a287..c0e2bdaba0 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -33,9 +33,6 @@ %% Values only as multiple values/variables/patterns. %% Return same number of values as requested %% Correct number of arguments -%% -%% Checks to add: -%% %% Consistency of values/variables %% Consistency of function return values/calls. %% @@ -211,7 +208,7 @@ functions(Fs, Def, St0) -> function({#c_var{name={_,_}},B}, Def, St) -> %% Body must be a fun! case B of - #c_fun{} -> expr(B, Def, any, St); + #c_fun{} -> expr(B, Def, 1, St); _ -> add_error({illegal_expr,St#lint.func}, St) end. @@ -247,40 +244,42 @@ gbody(E, Def, Rt, St0) -> false -> St1 end. -gexpr(#c_var{name=N}, Def, _Rt, St) when is_atom(N); is_integer(N) -> - expr_var(N, Def, St); -gexpr(#c_literal{}, _Def, _Rt, St) -> St; -gexpr(#c_cons{hd=H,tl=T}, Def, _Rt, St) -> - gexpr_list([H,T], Def, St); -gexpr(#c_tuple{es=Es}, Def, _Rt, St) -> - gexpr_list(Es, Def, St); -gexpr(#c_map{es=Es}, Def, _Rt, St) -> - gexpr_list(Es, Def, St); -gexpr(#c_map_pair{key=K,val=V}, Def, _Rt, St) -> - gexpr_list([K,V], Def, St); -gexpr(#c_binary{segments=Ss}, Def, _Rt, St) -> - gbitstr_list(Ss, Def, St); +gexpr(#c_var{name=N}, Def, Rt, St) when is_atom(N); is_integer(N) -> + return_match(Rt, 1, expr_var(N, Def, St)); +gexpr(#c_literal{}, _Def, Rt, St) -> + return_match(Rt, 1, St); +gexpr(#c_cons{hd=H,tl=T}, Def, Rt, St) -> + return_match(Rt, 1, gexpr_list([H,T], Def, St)); +gexpr(#c_tuple{es=Es}, Def, Rt, St) -> + return_match(Rt, 1, gexpr_list(Es, Def, St)); +gexpr(#c_map{es=Es}, Def, Rt, St) -> + return_match(Rt, 1, gexpr_list(Es, Def, St)); +gexpr(#c_map_pair{key=K,val=V}, Def, Rt, St) -> + return_match(Rt, 1, gexpr_list([K,V], Def, St)); +gexpr(#c_binary{segments=Ss}, Def, Rt, St) -> + return_match(Rt, 1, gbitstr_list(Ss, Def, St)); gexpr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) -> - St1 = gexpr(Arg, Def, any, St0), %Ignore values - gbody(B, Def, Rt, St1); + St1 = gexpr(Arg, Def, 1, St0), + return_match(Rt, 1, gbody(B, Def, Rt, St1)); gexpr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) -> St1 = gbody(Arg, Def, let_varcount(Vs), St0), %This is a guard body {Lvs,St2} = variable_list(Vs, St1), gbody(B, union(Lvs, Def), Rt, St2); gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}, args=[Arg,#c_literal{val=Tag},#c_literal{val=Size}]}, - Def, 1, St) when is_atom(Tag), is_integer(Size) -> - gexpr(Arg, Def, 1, St); + Def, Rt, St) when is_atom(Tag), is_integer(Size) -> + return_match(Rt, 1, gexpr(Arg, Def, 1, St)); gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}}, - _Def, 1, St) -> - add_error({illegal_guard,St#lint.func}, St); + _Def, Rt, St) -> + return_match(Rt, 1, add_error({illegal_guard,St#lint.func}, St)); gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As}, - Def, 1, St) when is_atom(Name) -> + Def, Rt, St0) when is_atom(Name) -> + St1 = return_match(Rt, 1, St0), case is_guard_bif(Name, length(As)) of true -> - gexpr_list(As, Def, St); + gexpr_list(As, Def, St1); false -> - add_error({illegal_guard,St#lint.func}, St) + add_error({illegal_guard,St1#lint.func}, St1) end; gexpr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) -> gexpr_list(As, Def, St0); @@ -319,23 +318,25 @@ is_guard_bif(Name, Arity) -> %% expr(Expr, Defined, RetCount, State) -> State. -expr(#c_var{name={_,_}=FA}, Def, _Rt, St) -> - expr_fname(FA, Def, St); -expr(#c_var{name=N}, Def, _Rt, St) -> expr_var(N, Def, St); -expr(#c_literal{}, _Def, _Rt, St) -> St; -expr(#c_cons{hd=H,tl=T}, Def, _Rt, St) -> - expr_list([H,T], Def, St); -expr(#c_tuple{es=Es}, Def, _Rt, St) -> - expr_list(Es, Def, St); -expr(#c_map{es=Es}, Def, _Rt, St) -> - expr_list(Es, Def, St); -expr(#c_map_pair{key=K,val=V},Def,_Rt,St) -> - expr_list([K,V],Def,St); -expr(#c_binary{segments=Ss}, Def, _Rt, St) -> - bitstr_list(Ss, Def, St); +expr(#c_var{name={_,_}=FA}, Def, Rt, St) -> + return_match(Rt, 1, expr_fname(FA, Def, St)); +expr(#c_var{name=N}, Def, Rt, St) -> + return_match(Rt, 1, expr_var(N, Def, St)); +expr(#c_literal{}, _Def, Rt, St) -> + return_match(Rt, 1, St); +expr(#c_cons{hd=H,tl=T}, Def, Rt, St) -> + return_match(Rt, 1, expr_list([H,T], Def, St)); +expr(#c_tuple{es=Es}, Def, Rt, St) -> + return_match(Rt, 1, expr_list(Es, Def, St)); +expr(#c_map{es=Es}, Def, Rt, St) -> + return_match(Rt, 1, expr_list(Es, Def, St)); +expr(#c_map_pair{key=K,val=V}, Def, Rt, St) -> + return_match(Rt, 1, expr_list([K,V], Def, St)); +expr(#c_binary{segments=Ss}, Def, Rt, St) -> + return_match(Rt, 1, bitstr_list(Ss, Def, St)); expr(#c_fun{vars=Vs,body=B}, Def, Rt, St0) -> {Vvs,St1} = variable_list(Vs, St0), - return_match(Rt, 1, body(B, union(Vvs, Def), any, St1)); + return_match(Rt, 1, body(B, union(Vvs, Def), 1, St1)); expr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) -> St1 = expr(Arg, Def, 1, St0), body(B, Def, Rt, St1); @@ -361,15 +362,26 @@ expr(#c_receive{clauses=Cs,timeout=T,action=A}, Def, Rt, St0) -> St1 = expr(T, Def, 1, St0), St2 = body(A, Def, Rt, St1), clauses(Cs, Def, 1, Rt, St2); -expr(#c_apply{op=Op,args=As}, Def, _Rt, St0) -> +expr(#c_apply{op=Op,args=As}, Def, Rt, St0) -> St1 = apply_op(Op, Def, length(As), St0), - expr_list(As, Def, St1); + return_match(Rt, 1, expr_list(As, Def, St1)); +expr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As}, + Def, Rt, St0) when is_atom(Name) -> + St1 = expr_list(As, Def, St0), + case erl_bifs:is_exit_bif(erlang, Name, length(As)) of + true -> St1; + false -> return_match(Rt, 1, St1) + end; expr(#c_call{module=M,name=N,args=As}, Def, _Rt, St0) -> St1 = expr(M, Def, 1, St0), St2 = expr(N, Def, 1, St1), expr_list(As, Def, St2); -expr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) -> - expr_list(As, Def, St0); +expr(#c_primop{name=#c_literal{val=A},args=As}, Def, Rt, St0) when is_atom(A) -> + St1 = expr_list(As, Def, St0), + case A of + match_fail -> St1; + _ -> return_match(Rt, 1, St1) + end; expr(#c_catch{body=B}, Def, Rt, St) -> return_match(Rt, 1, body(B, Def, 1, St)); expr(#c_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Def, Rt, St0) -> diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index 83412ecdd7..03801a9b6d 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -125,8 +125,8 @@ format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) -> _ -> assoc end, Cpairs = [#c_map_pair{op=#c_literal{val=Op}, - key=#c_literal{val=V}, - val=#c_literal{val=K}} || {K,V} <- Pairs], + key=#c_literal{val=K}, + val=#c_literal{val=V}} || {K,V} <- Pairs], format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt); format_1(#c_var{name={I,A}}, _) -> [core_atom(I),$/,integer_to_list(A)]; diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 761ae8409c..f99307c865 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -33,12 +33,15 @@ -include("../include/erl_bits.hrl"). +-type fa() :: {atom(), arity()}. + -record(expand, {module=[], %Module name exports=[], %Exports imports=[], %Imports compile=[], %Compile flags attributes=[], %Attributes callbacks=[], %Callbacks + optional_callbacks=[] :: [fa()], %Optional callbacks defined, %Defined functions (gb_set) vcount=0, %Variable counter func=[], %Current function @@ -99,7 +102,21 @@ define_functions(Forms, #expand{defined=Predef}=St) -> module_attrs(#expand{attributes=Attributes}=St) -> Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes], Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs], - {Attrs,St#expand{callbacks=Callbacks}}. + OptionalCallbacks = get_optional_callbacks(Attrs), + {Attrs,St#expand{callbacks=Callbacks, + optional_callbacks=OptionalCallbacks}}. + +get_optional_callbacks(Attrs) -> + L = [O || + {attribute, _, optional_callbacks, O} <- Attrs, + is_fa_list(O)], + lists:append(L). + +is_fa_list([{FuncName, Arity}|L]) + when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> + is_fa_list(L); +is_fa_list([]) -> true; +is_fa_list(_) -> false. module_predef_funcs(St) -> {Mpf1,St1}=module_predef_func_beh_info(St), @@ -108,19 +125,24 @@ module_predef_funcs(St) -> module_predef_func_beh_info(#expand{callbacks=[]}=St) -> {[], St}; -module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined, +module_predef_func_beh_info(#expand{callbacks=Callbacks, + optional_callbacks=OptionalCallbacks, + defined=Defined, exports=Exports}=St) -> PreDef=[{behaviour_info,1}], PreExp=PreDef, - {[gen_beh_info(Callbacks)], + {[gen_beh_info(Callbacks, OptionalCallbacks)], St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined), exports=union(from_list(PreExp), Exports)}}. -gen_beh_info(Callbacks) -> +gen_beh_info(Callbacks, OptionalCallbacks) -> List = make_list(Callbacks), + OptionalList = make_optional_list(OptionalCallbacks), {function,0,behaviour_info,1, [{clause,0,[{atom,0,callbacks}],[], - [List]}]}. + [List]}, + {clause,0,[{atom,0,optional_callbacks}],[], + [OptionalList]}]}. make_list([]) -> {nil,0}; make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) -> @@ -130,6 +152,14 @@ make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) -> {integer,0,Arity}]}, make_list(Rest)}. +make_optional_list([]) -> {nil,0}; +make_optional_list([{Name,Arity}|Rest]) -> + {cons,0, + {tuple,0, + [{atom,0,Name}, + {integer,0,Arity}]}, + make_optional_list(Rest)}. + module_predef_funcs_mod_info(St) -> PreDef = [{module_info,0},{module_info,1}], PreExp = PreDef, @@ -232,9 +262,18 @@ pattern({map,Line,Ps}, St0) -> {TPs,St1} = pattern_list(Ps, St0), {{map,Line,TPs},St1}; pattern({map_field_exact,Line,K0,V0}, St0) -> - {K,St1} = expr(K0, St0), + %% Key should be treated as an expression + %% but since expressions are not allowed yet, + %% process it through pattern .. and handle assoc + %% (normalise unary op integer -> integer) + {K,St1} = pattern(K0, St0), {V,St2} = pattern(V0, St1), {{map_field_exact,Line,K,V},St2}; +pattern({map_field_assoc,Line,K0,V0}, St0) -> + %% when keys are Maps + {K,St1} = pattern(K0, St0), + {V,St2} = pattern(V0, St1), + {{map_field_assoc,Line,K,V},St2}; %%pattern({struct,Line,Tag,Ps}, St0) -> %% {TPs,TPsvs,St1} = pattern_list(Ps, St0), %% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1}; diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 47a357c23d..8c1a0c08ac 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -210,7 +210,7 @@ need_heap_0([], H, Acc) -> need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H) -> {need_heap_need(I, H),0}; -need_heap_1(#l{ke={set,_,{map,_,_}},i=I}, H) -> +need_heap_1(#l{ke={set,_,{map,_,_,_}},i=I}, H) -> {need_heap_need(I, H),0}; need_heap_1(#l{ke={set,_,Val}}, H) -> %% Just pass through adding to needed heap. @@ -643,10 +643,6 @@ select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> [{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis]; select_val_cg(tuple, R, Vls, Tf, Vf, Sis) -> [{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis]; -select_val_cg(map, R, [_Val,{f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> - [{test,is_map,{f,Fail},[R]}|Sis]; -select_val_cg(map, R, [_Val,{f,Lbl}|_], Tf, _Vf, [{label,Lbl}|Sis]) -> - [{test,is_map,{f,Tf},[R]}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> [{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> @@ -947,27 +943,34 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) -> %% Assume keys are term-sorted Rsrc = fetch_var(Src, Bef), - {{HasKs,GetVs},Aft} = lists:foldr(fun - ({map_pair,Key,{var,V}},{{HasKsi,GetVsi},Int0}) -> + {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} = lists:foldr(fun + ({map_pair,{var,K},{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> case vdb_find(V, Vdb) of {V,_,L} when L =< I -> - {{[Key|HasKsi],GetVsi},Int0}; + RK = fetch_var(K,Int0), + {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0}; _Other -> Reg1 = put_reg(V, Int0#sr.reg), Int1 = Int0#sr{reg=Reg1}, - {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi]},Int1} + RK = fetch_var(K,Int0), + RV = fetch_reg(V,Reg1), + {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1} + end; + ({map_pair,Key,{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> + case vdb_find(V, Vdb) of + {V,_,L} when L =< I -> + {{[Key|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0}; + _Other -> + Reg1 = put_reg(V, Int0#sr.reg), + Int1 = Int0#sr{reg=Reg1}, + {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi],HasVarVsi,GetVarVsi},Int1} end - end, {{[],[]},Bef}, Vs), - - Code = case {HasKs,GetVs} of - {HasKs,[]} -> - [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}}]; - {[],GetVs} -> - [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}}]; - {HasKs,GetVs} -> - [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}}, - {get_map_elements, {f,Fail},Rsrc,{list,GetVs}}] - end, + end, {{[],[],[],[]},Bef}, Vs), + + Code = [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}} || HasKs =/= []] ++ + [{test,has_map_fields,{f,Fail},Rsrc,{list,[K]}} || K <- HasVarKs] ++ + [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}} || GetVs =/= []] ++ + [{get_map_elements, {f,Fail},Rsrc,{list,[K,V]}} || [K,V] <- GetVarVs], {Code, Aft, St}. @@ -1504,9 +1507,39 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, %% Now generate the complete code for constructing the binary. Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a), {Sis++Code,Aft,St}; +% Map single variable key +set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, + #cg{in_catch=InCatch,bfail=Bfail}=St) -> + + Fail = {f,Bfail}, + {Sis,Int0} = + case InCatch of + true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); + false -> {[],Bef} + end, + SrcReg = cg_reg_arg(Map,Int0), + Line = line(Le#l.a), + + List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)], + + Live = max_reg(Bef#sr.reg), + Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, + Aft = clear_dead(Int1, Le#l.i, Vdb), + Target = fetch_reg(R, Int1#sr.reg), + + I = case Op of + assoc -> put_map_assoc; + exact -> put_map_exact + end, + {Sis++[Line]++[{I,Fail,SrcReg,Target,Live,{list,List}}],Aft,St}; + +% Map (possibly) multiple literal keys set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, #cg{in_catch=InCatch,bfail=Bfail}=St) -> + %% assert key literals + [] = [Var||{map_pair,{var,_}=Var,_} <- Es], + Fail = {f,Bfail}, {Sis,Int0} = case InCatch of diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index caf5298d38..612660c2d6 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -78,7 +78,7 @@ -import(ordsets, [add_element/2,del_element/2,is_element/2, union/1,union/2,intersection/2,subtract/2]). -import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1, - ann_c_map/2, ann_c_map/3]). + ann_c_map/3]). -include("core_parse.hrl"). @@ -169,60 +169,81 @@ form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) -> attribute({attribute,Line,Name,Val}) -> {#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}. +%% function_dump(module_info,_,_,_) -> ok; +%% function_dump(Name,Arity,Format,Terms) -> +%% io:format("~w/~w " ++ Format,[Name,Arity]++Terms), +%% ok. + function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) -> - %%ok = io:fwrite("~p - ", [{Name,Arity}]), St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]}, {B0,St1} = body(Cs0, Name, Arity, St0), - %%ok = io:fwrite("1", []), - %%ok = io:fwrite("~w:~p~n", [?LINE,B0]), + %% ok = function_dump(Name,Arity,"body:~n~p~n",[B0]), {B1,St2} = ubody(B0, St1), - %%ok = io:fwrite("2", []), - %%ok = io:fwrite("~w:~p~n", [?LINE,B1]), + %% ok = function_dump(Name,Arity,"ubody:~n~p~n",[B1]), {B2,#core{ws=Ws}} = cbody(B1, St2), - %%ok = io:fwrite("3~n", []), - %%ok = io:fwrite("~w:~p~n", [?LINE,B2]), + %% ok = function_dump(Name,Arity,"cbody:~n~p~n",[B2]), {{#c_var{name={Name,Arity}},B2},Ws}. body(Cs0, Name, Arity, St0) -> Anno = lineno_anno(element(2, hd(Cs0)), St0), {Args,St1} = new_vars(Anno, Arity, St0), - {Cs1,St2} = clauses(Cs0, St1), - {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Fc = function_clause(Ps, Anno, {Name,Arity}), - {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}. + case clauses(Cs0, St1) of + {Cs1,[],St2} -> + {Ps,St3} = new_vars(Arity, St2), %Need new variables here + Fc = function_clause(Ps, Anno, {Name,Arity}), + {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}; + {Cs1,Eps,St2} -> + %% We have pre-expressions from patterns and + %% these needs to be letified before matching + %% since only bound variables are allowed + AnnoGen = #a{anno=[compiler_generated]}, + {Ps1,St3} = new_vars(Arity, St2), %Need new variables here + Fc1 = function_clause(Ps1, Anno, {Name,Arity}), + {Ps2,St4} = new_vars(Arity, St3), %Need new variables here + Fc2 = function_clause(Ps2, Anno, {Name,Arity}), + Case = #icase{anno=AnnoGen,args=Args, + clauses=Cs1, + fc=Fc2}, + {#ifun{anno=#a{anno=Anno},id=[],vars=Args, + clauses=[#iclause{anno=AnnoGen,pats=Ps1, + guard=[#c_literal{val=true}], + body=Eps ++ [Case]}], + fc=Fc1},St4} + end. %% clause(Clause, State) -> {Cclause,State} | noclause. %% clauses([Clause], State) -> {[Cclause],State}. %% Convert clauses. Trap bad pattern aliases and remove clause from %% clause list. -clauses([C0|Cs0], St0) -> +clauses([C0|Cs0],St0) -> case clause(C0, St0) of - {noclause,St} -> clauses(Cs0, St); - {C,St1} -> - {Cs,St2} = clauses(Cs0, St1), - {[C|Cs],St2} + {noclause,_,St} -> clauses(Cs0,St); + {C,Eps1,St1} -> + {Cs,Eps2,St2} = clauses(Cs0, St1), + {[C|Cs],Eps1++Eps2,St2} end; -clauses([], St) -> {[],St}. +clauses([],St) -> {[],[],St}. clause({clause,Lc,H0,G0,B0}, St0) -> try head(H0, St0) of - H1 -> - {G1,St1} = guard(G0, St0), - {B1,St2} = exprs(B0, St1), - Anno = lineno_anno(Lc, St2), - {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},St2} + {H1,Eps,St1} -> + {G1,St2} = guard(G0, St1), + {B1,St3} = exprs(B0, St2), + Anno = lineno_anno(Lc, St3), + {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},Eps,St3} catch throw:nomatch -> St = add_warning(Lc, nomatch, St0), - {noclause,St} %Bad pattern + {noclause,[],St} %Bad pattern end. clause_arity({clause,_,H0,_,_}) -> length(H0). -%% head([P], State) -> [P]. +%% head([P], State) -> {[P],[Cexpr],State}. -head(Ps, St) -> pattern_list(Ps, St). +head(Ps, St) -> + pattern_list(Ps, St). %% guard([Expr], State) -> {[Cexpr],State}. %% Build an explict and/or tree of guard alternatives, then traverse @@ -514,22 +535,7 @@ expr({tuple,L,Es0}, St0) -> A = record_anno(L, St1), {annotate_tuple(A, Es1, St1),Eps,St1}; expr({map,L,Es0}, St0) -> - % erl_lint should make sure only #{ K => V } are allowed - % in map construction. - try map_pair_list(Es0, St0) of - {Es1,Eps,St1} -> - A = lineno_anno(L, St1), - {ann_c_map(A,Es1),Eps,St1} - catch - throw:{bad_map,Warning} -> - St = add_warning(L, Warning, St0), - LineAnno = lineno_anno(L, St), - As = [#c_literal{anno=LineAnno,val=badarg}], - {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} - module=#c_literal{anno=LineAnno,val=erlang}, - name=#c_literal{anno=LineAnno,val=error}, - args=As},[],St} - end; + map_build_pair_chain(#c_literal{val=#{}},Es0,lineno_anno(L,St0),St0); expr({map,L,M0,Es0}, St0) -> try expr_map(M0,Es0,lineno_anno(L, St0),St0) of {_,_,_}=Res -> Res @@ -562,26 +568,26 @@ expr({block,_,Es0}, St0) -> {E1,Eps,St2} = expr(last(Es0), St1), {E1,Es1 ++ Eps,St2}; expr({'if',L,Cs0}, St0) -> - {Cs1,St1} = clauses(Cs0, St0), + {Cs1,Ceps,St1} = clauses(Cs0, St0), Lanno = lineno_anno(L, St1), Fc = fail_clause([], Lanno, #c_literal{val=if_clause}), - {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},[],St1}; + {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},Ceps,St1}; expr({'case',L,E0,Cs0}, St0) -> {E1,Eps,St1} = novars(E0, St0), - {Cs1,St2} = clauses(Cs0, St1), + {Cs1,Ceps,St2} = clauses(Cs0, St1), {Fpat,St3} = new_var(St2), Lanno = lineno_anno(L, St2), Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=case_clause},Fpat])), - {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps,St3}; + {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps++Ceps,St3}; expr({'receive',L,Cs0}, St0) -> - {Cs1,St1} = clauses(Cs0, St0), - {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1}, [], St1}; + {Cs1,Ceps,St1} = clauses(Cs0, St0), + {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1},Ceps, St1}; expr({'receive',L,Cs0,Te0,Tes0}, St0) -> {Te1,Teps,St1} = novars(Te0, St0), {Tes1,St2} = exprs(Tes0, St1), - {Cs1,St3} = clauses(Cs0, St2), + {Cs1,Ceps,St3} = clauses(Cs0, St2), {#ireceive2{anno=#a{anno=lineno_anno(L, St3)}, - clauses=Cs1,timeout=Te1,action=Tes1},Teps,St3}; + clauses=Cs1,timeout=Te1,action=Tes1},Teps++Ceps,St3}; expr({'try',L,Es0,[],Ecs,[]}, St0) -> %% 'try ... catch ... end' {Es1,St1} = exprs(Es0, St0), @@ -595,7 +601,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> %% 'try ... of ... catch ... end' {Es1,St1} = exprs(Es0, St0), {V,St2} = new_var(St1), %This name should be arbitrary - {Cs1,St3} = clauses(Cs0, St2), + {Cs1,Ceps,St3} = clauses(Cs0, St2), {Fpat,St4} = new_var(St3), Lanno = lineno_anno(L, St4), Fc = fail_clause([Fpat], Lanno, @@ -604,7 +610,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> {#itry{anno=#a{anno=lineno_anno(L, St5)},args=Es1, vars=[V],body=[#icase{anno=#a{anno=Lanno},args=[V],clauses=Cs1,fc=Fc}], evars=Evs,handler=Hs}, - [],St5}; + Ceps,St5}; expr({'try',L,Es0,[],[],As0}, St0) -> %% 'try ... after ... end' {Es1,St1} = exprs(Es0, St0), @@ -673,24 +679,24 @@ expr({match,L,P0,E0}, St0) -> {var,_,'_'} -> St0#core{wanted=false}; _ -> St0 end, - {E2,Eps,St2} = novars(E1, St1), + {E2,Eps1,St2} = novars(E1, St1), St3 = St2#core{wanted=St0#core.wanted}, - P2 = try - pattern(P1, St3) + {P2,Eps2,St4} = try + pattern(P1, St3) catch throw:Thrown -> - Thrown + {Thrown,[],St3} end, - {Fpat,St4} = new_var(St3), - Lanno = lineno_anno(L, St4), + {Fpat,St5} = new_var(St4), + Lanno = lineno_anno(L, St5), Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])), case P2 of nomatch -> - St = add_warning(L, nomatch, St4), + St = add_warning(L, nomatch, St5), {#icase{anno=#a{anno=Lanno}, - args=[E2],clauses=[],fc=Fc},Eps,St}; + args=[E2],clauses=[],fc=Fc},Eps1++Eps2,St}; Other when not is_atom(Other) -> - {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4} + {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5} end; expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> %% Optimise '++' here because of the list comprehension algorithm. @@ -772,44 +778,77 @@ expr_map(M0,Es0,A,St0) -> Fc = fail_clause([Fpat], A, #c_literal{val=badarg}), {#icase{anno=#a{anno=A},args=[M1],clauses=Cs,fc=Fc},Mps,St3}; {_,_} -> - {Es1,Eps,St2} = map_pair_list(Es0, St1), - {ann_c_map(A,M1,Es1),Mps++Eps,St2} + {M2,Eps,St2} = map_build_pair_chain(M1,Es0,A,St1), + {M2,Mps++Eps,St2} end; false -> throw({bad_map,bad_map}) end. +%% Group continuous literal blocks and single variables, i.e. +%% M0#{ a := 1, b := V1, K1 := V2, K2 := 42} +%% becomes equivalent to +%% M1 = M0#{ a := 1, b := V1 }, +%% M2 = M1#{ K1 := V1 }, +%% M3 = M2#{ K2 := 42 } + +map_build_pair_chain(M,Es,A,St) -> + %% hack, remove iset if only literal + case map_build_pair_chain(M,Es,A,St,[]) of + {_,[#iset{arg=#c_literal{}=Val}],St1} -> {Val,[],St1}; + Normal -> Normal + end. + +map_build_pair_chain(M0,[],_,St,Mps) -> + {M0,Mps,St}; +map_build_pair_chain(M0,Es0,A,St0,Mps) -> + % group continuous literal blocks + % Anno = #a{anno=[compiler_generated]}, + % order is important, we need to reverse the literals + case map_pair_block(Es0,[],[],St0) of + {{CesL,EspL},{[],[]},Es1,St1} -> + {MVar,St2} = new_var(St1), + Pre = [#iset{var=MVar, arg=ann_c_map(A,M0,reverse(CesL))}], + map_build_pair_chain(MVar,Es1,A,St2,Mps++EspL++Pre); + {{[],[]},{CesV,EspV},Es1,St1} -> + {MVar,St2} = new_var(St1), + Pre = [#iset{var=MVar, arg=#c_map{arg=M0,es=CesV, anno=A}}], + map_build_pair_chain(MVar,Es1,A,St2,Mps ++ EspV++Pre); + {{CesL,EspL},{CesV,EspV},Es1,St1} -> + {MVarL,St2} = new_var(St1), + {MVarV,St3} = new_var(St2), + Pre = [#iset{var=MVarL, arg=ann_c_map(A,M0,reverse(CesL))}, + #iset{var=MVarV, arg=#c_map{arg=MVarL,es=CesV,anno=A}}], + map_build_pair_chain(MVarV,Es1,A,St3,Mps++EspL++EspV++Pre) + end. + +map_pair_block([{Op,L,K0,V0}|Es],Ces,Esp,St0) -> + {K,Ep0,St1} = safe(K0, St0), + {V,Ep1,St2} = safe(V0, St1), + A = lineno_anno(L, St2), + Pair0 = map_op_to_c_map_pair(Op), + Pair1 = Pair0#c_map_pair{anno=A,key=K,val=V}, + case cerl:is_literal(K) of + true -> + map_pair_block(Es,[Pair1|Ces],Ep0 ++ Ep1 ++ Esp,St2); + false -> + {{Ces,Esp},{[Pair1],Ep0++Ep1},Es,St2} + end; +map_pair_block([],Ces,Esp,St) -> + {{Ces,Esp},{[],[]},[],St}. + +map_op_to_c_map_pair(map_field_assoc) -> #c_map_pair{op=#c_literal{val=assoc}}; +map_op_to_c_map_pair(map_field_exact) -> #c_map_pair{op=#c_literal{val=exact}}. + is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true; -is_valid_map_src(#c_map{}) -> true; is_valid_map_src(#c_var{}) -> true; is_valid_map_src(_) -> false. -map_pair_list(Es, St) -> - foldr(fun - ({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) -> - {K,Ep0,St1} = safe(K0, St0), - ok = ensure_valid_map_key(K), - {V,Ep1,St2} = safe(V0, St1), - A = lineno_anno(L, St2), - Pair = #c_map_pair{op=#c_literal{val=assoc},anno=A,key=K,val=V}, - {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2}; - ({map_field_exact,L,K0,V0}, {Ces,Esp,St0}) -> - {K,Ep0,St1} = safe(K0, St0), - ok = ensure_valid_map_key(K), - {V,Ep1,St2} = safe(V0, St1), - A = lineno_anno(L, St2), - Pair = #c_map_pair{op=#c_literal{val=exact},anno=A,key=K,val=V}, - {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2} - end, {[],[],St}, Es). - -ensure_valid_map_key(#c_literal{}) -> ok; -ensure_valid_map_key(_) -> throw({bad_map,bad_map_key}). - %% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}. try_exception(Ecs0, St0) -> %% Note that Tag is not needed for rethrow - it is already in Info. {Evs,St1} = new_vars(3, St0), % Tag, Value, Info - {Ecs1,St2} = clauses(Ecs0, St1), + {Ecs1,Ceps,St2} = clauses(Ecs0, St1), [_,Value,Info] = Evs, Ec = #iclause{anno=#a{anno=[compiler_generated]}, pats=[c_tuple(Evs)],guard=[#c_literal{val=true}], @@ -817,15 +856,15 @@ try_exception(Ecs0, St0) -> name=#c_literal{val=raise}, args=[Info,Value]}]}, Hs = [#icase{anno=#a{},args=[c_tuple(Evs)],clauses=Ecs1,fc=Ec}], - {Evs,Hs,St2}. + {Evs,Ceps++Hs,St2}. try_after(As, St0) -> %% See above. - {Evs,St1} = new_vars(3, St0), % Tag, Value, Info + {Evs,St1} = new_vars(3, St0), % Tag, Value, Info [_,Value,Info] = Evs, - B = As ++ [#iprimop{anno=#a{}, %Must have an #a{} - name=#c_literal{val=raise}, - args=[Info,Value]}], + B = As ++ [#iprimop{anno=#a{}, % Must have an #a{} + name=#c_literal{val=raise}, + args=[Info,Value]}], Ec = #iclause{anno=#a{anno=[compiler_generated]}, pats=[c_tuple(Evs)],guard=[#c_literal{val=true}], body=B}, @@ -959,7 +998,7 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> Arity = clause_arity(hd(Cs0)), - {Cs1,St1} = clauses(Cs0, St0), + {Cs1,Ceps,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), {Ps,St3} = new_vars(Arity, St2), %Need new variables here Anno = lineno_anno(L, St3), @@ -967,7 +1006,7 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! vars=Args,clauses=Cs1,fc=Fc,name=NameInfo}, - {Fun,[],St3}. + {Fun,Ceps,St3}. %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. %% This TQ from Simon PJ pp 127-138. @@ -1134,7 +1173,7 @@ preprocess_quals(Line, [Q|Qs0], St0, Acc) -> {Gen,St} = generator(Line, Q, Gs, St0), preprocess_quals(Line, Qs, St, [Gen|Acc]); false -> - LAnno = #a{anno=lineno_anno(get_anno(Q), St0)}, + LAnno = #a{anno=lineno_anno(get_qual_anno(Q), St0)}, case is_guard_test(Q) of true -> %% When a filter is a guard test, its argument in the @@ -1159,6 +1198,11 @@ is_generator({generate,_,_,_}) -> true; is_generator({b_generate,_,_,_}) -> true; is_generator(_) -> false. +%% Retrieve the annotation from an Erlang AST form. +%% (Use get_anno/1 to retrieve the annotation from Core Erlang forms). + +get_qual_anno(Abstract) -> element(2, Abstract). + %% %% Generators are abstracted as sextuplets: %% - acc_pat is the accumulator pattern, e.g. [Pat|Tail] for Pat <- Expr. @@ -1181,7 +1225,7 @@ is_generator(_) -> false. generator(Line, {generate,Lg,P0,E}, Gs, St0) -> LA = lineno_anno(Line, St0), GA = lineno_anno(Lg, St0), - {Head,St1} = list_gen_pattern(P0, Line, St0), + {Head,Ceps,St1} = list_gen_pattern(P0, Line, St0), {[Tail,Skip],St2} = new_vars(2, St1), {Cg,St3} = lc_guard_tests(Gs, St2), {AccPat,SkipPat} = case Head of @@ -1202,24 +1246,25 @@ generator(Line, {generate,Lg,P0,E}, Gs, St0) -> end, {Ce,Pre,St4} = safe(E, St3), Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, - tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Pre,Ce}}, + tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Ceps++Pre,Ce}}, {Gen,St4}; generator(Line, {b_generate,Lg,P,E}, Gs, St0) -> LA = lineno_anno(Line, St0), GA = lineno_anno(Lg, St0), - Cp = #c_binary{segments=Segs} = pattern(P, St0), + {Cp = #c_binary{segments=Segs},[],St1} = pattern(P, St0), + %% The function append_tail_segment/2 keeps variable patterns as-is, making %% it possible to have the same skip clause removal as with list generators. - {AccSegs,Tail,TailSeg,St1} = append_tail_segment(Segs, St0), + {AccSegs,Tail,TailSeg,St2} = append_tail_segment(Segs, St1), AccPat = Cp#c_binary{segments=AccSegs}, - {Cg,St2} = lc_guard_tests(Gs, St1), - {SkipSegs,St3} = emasculate_segments(AccSegs, St2), + {Cg,St3} = lc_guard_tests(Gs, St2), + {SkipSegs,St4} = emasculate_segments(AccSegs, St3), SkipPat = Cp#c_binary{segments=SkipSegs}, - {Ce,Pre,St4} = safe(E, St3), + {Ce,Pre,St5} = safe(E, St4), Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, tail=Tail,tail_pat=#c_binary{anno=LA,segments=[TailSeg]}, arg={Pre,Ce}}, - {Gen,St4}. + {Gen,St5}. append_tail_segment(Segs, St0) -> {Var,St} = new_var(St0), @@ -1248,9 +1293,9 @@ lc_guard_tests(Gs0, St0) -> list_gen_pattern(P0, Line, St) -> try - {pattern(P0, St),St} + pattern(P0,St) catch - nomatch -> {nomatch,add_warning(Line, nomatch, St)} + nomatch -> {nomatch,[],add_warning(Line, nomatch, St)} end. %%% @@ -1473,6 +1518,18 @@ force_novars(#ibinary{}=Bin, St) -> {Bin,[],St}; force_novars(Ce, St) -> force_safe(Ce, St). + +%% safe_pattern_expr(Expr, State) -> {Cexpr,[PreExpr],State}. +%% only literals and variables are safe expressions in patterns +safe_pattern_expr(E,St0) -> + case safe(E,St0) of + {#c_var{},_,_}=Safe -> Safe; + {#c_literal{},_,_}=Safe -> Safe; + {Ce,Eps,St1} -> + {V,St2} = new_var(St1), + {V,Eps++[#iset{var=V,arg=Ce}],St2} + end. + %% safe(Expr, State) -> {Safe,[PreExpr],State}. %% Generate an internal safe expression. These are simples without %% binaries which can fail. At this level we do not need to do a @@ -1547,84 +1604,109 @@ fold_match({match,L,P0,E0}, P) -> {{match,L,P0,P1},E1}; fold_match(E, P) -> {P,E}. -%% pattern(Pattern, State) -> CorePat. +%% pattern(Pattern, State) -> {CorePat,[PreExp],State}. %% Transform a pattern by removing line numbers. We also normalise %% aliases in patterns to standard form, {alias,Pat,[Var]}. - -pattern({var,L,V}, St) -> #c_var{anno=lineno_anno(L, St),name=V}; -pattern({char,L,C}, St) -> #c_literal{anno=lineno_anno(L, St),val=C}; -pattern({integer,L,I}, St) -> #c_literal{anno=lineno_anno(L, St),val=I}; -pattern({float,L,F}, St) -> #c_literal{anno=lineno_anno(L, St),val=F}; -pattern({atom,L,A}, St) -> #c_literal{anno=lineno_anno(L, St),val=A}; -pattern({string,L,S}, St) -> #c_literal{anno=lineno_anno(L, St),val=S}; -pattern({nil,L}, St) -> #c_literal{anno=lineno_anno(L, St),val=[]}; +%% +%% In patterns we may have expressions +%% 1) Binaries -> #c_bitstr{size=Expr} +%% 2) Maps -> #c_map_pair{key=Expr} +%% +%% Both of these may generate pre-expressions since only bound variables +%% or literals are allowed for these in core patterns. +%% +%% Therefor, we need to drag both the state and the collection of pre-expression +%% around in the whole pattern transformation tree. + +pattern({var,L,V}, St) -> {#c_var{anno=lineno_anno(L, St),name=V},[],St}; +pattern({char,L,C}, St) -> {#c_literal{anno=lineno_anno(L, St),val=C},[],St}; +pattern({integer,L,I}, St) -> {#c_literal{anno=lineno_anno(L, St),val=I},[],St}; +pattern({float,L,F}, St) -> {#c_literal{anno=lineno_anno(L, St),val=F},[],St}; +pattern({atom,L,A}, St) -> {#c_literal{anno=lineno_anno(L, St),val=A},[],St}; +pattern({string,L,S}, St) -> {#c_literal{anno=lineno_anno(L, St),val=S},[],St}; +pattern({nil,L}, St) -> {#c_literal{anno=lineno_anno(L, St),val=[]},[],St}; pattern({cons,L,H,T}, St) -> - annotate_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St), St); + {Ph,Eps1,St1} = pattern(H, St), + {Pt,Eps2,St2} = pattern(T, St1), + {annotate_cons(lineno_anno(L, St), Ph, Pt, St2),Eps1++Eps2,St2}; pattern({tuple,L,Ps}, St) -> - annotate_tuple(record_anno(L, St), pattern_list(Ps, St), St); -pattern({map,L,Ps}, St) -> - #c_map{anno=lineno_anno(L, St), es=pattern_map_pairs(Ps, St)}; + {Ps1,Eps,St1} = pattern_list(Ps,St), + {annotate_tuple(record_anno(L, St), Ps1, St),Eps,St1}; +pattern({map,L,Pairs}, St0) -> + {Ps,Eps,St1} = pattern_map_pairs(Pairs, St0), + {#c_map{anno=lineno_anno(L, St1), es=Ps},Eps,St1}; pattern({bin,L,Ps}, St) -> %% We don't create a #ibinary record here, since there is %% no need to hold any used/new annotations in a pattern. - #c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)}; + {#c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)},[],St}; pattern({match,_,P1,P2}, St) -> - pat_alias(pattern(P1, St), pattern(P2, St)). + {Cp1,Eps1,St1} = pattern(P1,St), + {Cp2,Eps2,St2} = pattern(P2,St1), + {pat_alias(Cp1,Cp2),Eps1++Eps2,St2}. %% pattern_map_pairs([MapFieldExact],State) -> [#c_map_pairs{}] pattern_map_pairs(Ps, St) -> - %% check literal key uniqueness (dict is needed) - %% pattern all pairs - {CMapPairs, Kdb} = lists:mapfoldl(fun - (P,Kdbi) -> - #c_map_pair{key=Ck,val=Cv} = CMapPair = pattern_map_pair(P,St), - K = core_lib:literal_value(Ck), - case dict:find(K,Kdbi) of - {ok, Vs} -> - {CMapPair, dict:store(K,[Cv|Vs],Kdbi)}; - _ -> - {CMapPair, dict:store(K,[Cv],Kdbi)} + %% check literal key uniqueness + %% - guaranteed via aliasing map pairs + %% pattern all pairs in two steps + %% 1) Construct Core Pattern + %% 2) Alias Keys in Core Pattern + {CMapPairs, {Eps,St1}} = lists:mapfoldl(fun + (P,{EpsM,Sti0}) -> + {CMapPair,EpsP,Sti1} = pattern_map_pair(P,Sti0), + {CMapPair, {EpsM++EpsP,Sti1}} + end, {[],St}, Ps), + {pat_alias_map_pairs(CMapPairs,[]),Eps,St1}. + +%% remove cluddering annotations +pattern_map_clean_key(#c_literal{val=V}) -> {literal,V}; +pattern_map_clean_key(#c_var{name=V}) -> {var,V}. + +pat_alias_map_pairs(Ps1,Ps2) -> + Ps = Ps1 ++ Ps2, + F = fun(#c_map_pair{key=Ck,val=Cv},Dbi) -> + K = pattern_map_clean_key(Ck), + case dict:find(K,Dbi) of + {ok,Cvs} -> dict:store(K,[Cv|Cvs],Dbi); + _ -> dict:store(K,[Cv],Dbi) end - end, dict:new(), Ps), - pattern_alias_map_pairs(CMapPairs,Kdb,dict:new(),St). - -pattern_alias_map_pairs([],_,_,_) -> []; -pattern_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Kset,St) -> - %% alias same keys if needed - K = core_lib:literal_value(Ck), - case dict:find(K,Kset) of - {ok,processed} -> - pattern_alias_map_pairs(Pairs,Kdb,Kset,St); - _ -> + end, + Kdb = lists:foldl(F,dict:new(),Ps), + pat_alias_map_pairs(Ps,Kdb,sets:new()). + +pat_alias_map_pairs([],_,_) -> []; +pat_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Set) -> + K = pattern_map_clean_key(Ck), + case sets:is_element(K,Set) of + true -> + pat_alias_map_pairs(Pairs,Kdb,Set); + false -> Cvs = dict:fetch(K,Kdb), - Cv = pattern_alias_map_pair_patterns(Cvs), - Kset1 = dict:store(K, processed, Kset), - [Pair#c_map_pair{val=Cv}|pattern_alias_map_pairs(Pairs,Kdb,Kset1,St)] + Cv = pat_alias_map_pair_values(Cvs), + Set1 = sets:add_element(K,Set), + [Pair#c_map_pair{val=Cv}|pat_alias_map_pairs(Pairs,Kdb,Set1)] end. -pattern_alias_map_pair_patterns([Cv]) -> Cv; -pattern_alias_map_pair_patterns([Cv1,Cv2|Cvs]) -> - pattern_alias_map_pair_patterns([pat_alias(Cv1,Cv2)|Cvs]). - -pattern_map_pair({map_field_exact,L,K,V}, St) -> - case expr(K,St) of - {#c_literal{}=Key,_,_} -> - #c_map_pair{anno=lineno_anno(L, St), - op=#c_literal{val=exact}, - key=Key, - val=pattern(V, St)}; - _ -> - %% this will throw a cryptic error message - %% but it is better than nothing - throw(nomatch) - end. +pat_alias_map_pair_values([Cv]) -> Cv; +pat_alias_map_pair_values([Cv1,Cv2|Cvs]) -> + pat_alias_map_pair_values([pat_alias(Cv1,Cv2)|Cvs]). + +pattern_map_pair({map_field_exact,L,K,V}, St0) -> + {Ck,EpsK,St1} = safe_pattern_expr(K,St0), + {Cv,EpsV,St2} = pattern(V, St1), + {#c_map_pair{anno=lineno_anno(L,St2), + op=#c_literal{val=exact}, + key=Ck, + val=Cv},EpsK++EpsV,St2}. %% pat_bin([BinElement], State) -> [BinSeg]. pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps]. -pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}, St) -> - #c_bitstr{val=pattern(Term, St),size=pattern(Size, St), +pat_segment({bin_element,_,Val,Size,[Type,{unit,Unit}|Flags]}, St) -> + {Pval,[],St1} = pattern(Val,St), + {Psize,[],_St2} = pattern(Size,St1), + #c_bitstr{val=Pval,size=Psize, unit=#c_literal{val=Unit}, type=#c_literal{val=Type}, flags=#c_literal{val=Flags}}. @@ -1634,6 +1716,8 @@ pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}, St) -> pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2}; pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1}; + +%% alias cons pat_alias(#c_cons{}=Cons, #c_literal{anno=A,val=[H|T]}=S) -> pat_alias(Cons, ann_c_cons_skel(A, #c_literal{anno=A,val=H}, S#c_literal{val=T})); @@ -1642,6 +1726,8 @@ pat_alias(#c_literal{anno=A,val=[H|T]}=S, #c_cons{}=Cons) -> S#c_literal{val=T}), Cons); pat_alias(#c_cons{anno=Anno,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) -> ann_c_cons(Anno, pat_alias(H1, H2), pat_alias(T1, T2)); + +%% alias tuples pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_literal{val=T}) when is_tuple(T) -> Es2 = [#c_literal{val=E} || E <- tuple_to_list(T)], ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); @@ -1650,6 +1736,12 @@ pat_alias(#c_literal{anno=Anno,val=T}, #c_tuple{es=Es2}) when is_tuple(T) -> ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_tuple{es=Es2}) -> ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); + +%% alias maps +%% There are no literals in maps patterns (patterns are always abstract) +pat_alias(#c_map{es=Es1}=M,#c_map{es=Es2}) -> + M#c_map{es=pat_alias_map_pairs(Es1,Es2)}; + pat_alias(#c_alias{var=V1,pat=P1}, #c_alias{var=V2,pat=P2}) -> if V1 =:= V2 -> #c_alias{var=V1,pat=pat_alias(P1, P2)}; @@ -1672,9 +1764,15 @@ pat_alias_list([A1|A1s], [A2|A2s]) -> pat_alias_list([], []) -> []; pat_alias_list(_, _) -> throw(nomatch). -%% pattern_list([P], State) -> [P]. +%% pattern_list([P], State) -> {[P],Exprs,St} + +pattern_list([P0|Ps0], St0) -> + {P1,Eps,St1} = pattern(P0, St0), + {Ps1,Epsl,St2} = pattern_list(Ps0, St1), + {[P1|Ps1], Eps ++ Epsl, St2}; +pattern_list([], St) -> + {[],[],St}. -pattern_list(Ps, St) -> [pattern(P, St) || P <- Ps]. %% make_vars([Name]) -> [{Var,Name}]. @@ -1974,9 +2072,14 @@ upattern(#c_tuple{es=Es0}=Tuple, Ks, St0) -> upattern(#c_map{es=Es0}=Map, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0), {Map#c_map{es=Es1},Esg,Esv,Eus,St1}; -upattern(#c_map_pair{op=#c_literal{val=exact},val=V0}=MapPair, Ks, St0) -> - {V,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0), - {MapPair#c_map_pair{val=V},Vg,Vv,Vu,St1}; +upattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,Ks,St0) -> + {V,Vg,Vn,Vu,St1} = upattern(V0, Ks, St0), + % A variable key must be considered used here + Ku = case K0 of + #c_var{name=Name} -> [Name]; + _ -> [] + end, + {Pair#c_map_pair{val=V},Vg,Vn,union(Ku,Vu),St1}; upattern(#c_binary{segments=Es0}=Bin, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upat_bin(Es0, Ks, St0), {Bin#c_binary{segments=Es1},Esg,Esv,Eus,St1}; @@ -2347,8 +2450,6 @@ format_error(nomatch) -> "pattern cannot possibly match"; format_error(bad_binary) -> "binary construction will fail because of a type mismatch"; -format_error(bad_map_key) -> - "map construction will fail because of none literal key (large binaries are not literals)"; format_error(bad_map) -> "map construction will fail because of a type mismatch". diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 40d2f72b4c..6504351c02 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -527,9 +527,9 @@ map_split_pairs(A, Var, Ces, Sub, St0) -> Pairs0 = [{Op,K,V} || #c_map_pair{op=#c_literal{val=Op},key=K,val=V} <- Ces], {Pairs,Esp,St1} = foldr(fun ({Op,K0,V0}, {Ops,Espi,Sti0}) when Op =:= assoc; Op =:= exact -> - {K,[],Sti1} = expr(K0, Sub, Sti0), - {V,Ep,Sti2} = atomic(V0, Sub, Sti1), - {[{Op,K,V}|Ops],Ep ++ Espi,Sti2} + {K,Eps1,Sti1} = atomic(K0, Sub, Sti0), + {V,Eps2,Sti2} = atomic(V0, Sub, Sti1), + {[{Op,K,V}|Ops],Eps1 ++ Eps2 ++ Espi,Sti2} end, {[],[],St0}, Pairs0), case map_group_pairs(Pairs) of @@ -577,11 +577,12 @@ map_key_is_used(K,Used) -> dict:find(map_key_clean(K),Used). %% Be explicit instead of using set_kanno(K,[]) -map_key_clean(#k_literal{val=V}) -> {k_literal,V}; -map_key_clean(#k_int{val=V}) -> {k_int,V}; -map_key_clean(#k_float{val=V}) -> {k_float,V}; -map_key_clean(#k_atom{val=V}) -> {k_atom,V}; -map_key_clean(#k_nil{}) -> k_nil. +map_key_clean(#k_var{name=V}) -> {var,V}; +map_key_clean(#k_literal{val=V}) -> {lit,V}; +map_key_clean(#k_int{val=V}) -> {lit,V}; +map_key_clean(#k_float{val=V}) -> {lit,V}; +map_key_clean(#k_atom{val=V}) -> {lit,V}; +map_key_clean(#k_nil{}) -> {lit,[]}. %% call_type(Module, Function, Arity) -> call | bif | apply | error. @@ -757,23 +758,22 @@ flatten_alias(#c_alias{var=V,pat=P}) -> flatten_alias(Pat) -> {[],Pat}. pattern_map_pairs(Ces0, Isub, Osub0, St0) -> - %% It is assumed that all core keys are literals - %% It is later assumed that these keys are term sorted - %% so we need to sort them here - Ces1 = lists:sort(fun - (#c_map_pair{key=CkA},#c_map_pair{key=CkB}) -> - A = core_lib:literal_value(CkA), - B = core_lib:literal_value(CkB), - erts_internal:cmp_term(A,B) < 0 - end, Ces0), %% pattern the pair keys and values as normal {Kes,{Osub1,St1}} = lists:mapfoldl(fun (#c_map_pair{anno=A,key=Ck,val=Cv},{Osubi0,Sti0}) -> - {Kk,Osubi1,Sti1} = pattern(Ck, Isub, Osubi0, Sti0), - {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi1, Sti1), + {Kk,[],Sti1} = expr(Ck, Isub, Sti0), + {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi0, Sti1), {#k_map_pair{anno=A,key=Kk,val=Kv},{Osubi2,Sti2}} - end, {Osub0, St0}, Ces1), - {Kes,Osub1,St1}. + end, {Osub0, St0}, Ces0), + %% It is later assumed that these keys are term sorted + %% so we need to sort them here + Kes1 = lists:sort(fun + (#k_map_pair{key=KkA},#k_map_pair{key=KkB}) -> + A = map_key_clean(KkA), + B = map_key_clean(KkB), + erts_internal:cmp_term(A,B) < 0 + end, Kes), + {Kes1,Osub1,St1}. pattern_bin(Es, Isub, Osub0, St0) -> {Kbin,{_,Osub},St} = pattern_bin_1(Es, Isub, Osub0, St0), @@ -1550,13 +1550,11 @@ arg_val(Arg, C) -> {set_kanno(S, []),U,T,Fs} end; #k_map{op=exact,es=Es} -> - Keys = [begin - #k_map_pair{key=#k_literal{val=Key}} = Pair, - Key - end || Pair <- Es], - %% multiple keys may have the same name - %% do not use ordsets - lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Keys) + lists:sort(fun(A,B) -> + %% on the form K :: {'lit' | 'var', term()} + %% lit < var as intended + erts_internal:cmp_term(A,B) < 0 + end, [map_key_clean(Key) || #k_map_pair{key=Key} <- Es]) end. %% ubody_used_vars(Expr, State) -> [UsedVar] @@ -1943,6 +1941,7 @@ lit_list_vars(Ps) -> %% pat_vars(Pattern) -> {[UsedVarName],[NewVarName]}. %% Return variables in a pattern. All variables are new variables %% except those in the size field of binary segments. +%% and map_pair keys pat_vars(#k_var{name=N}) -> {[],[N]}; %%pat_vars(#k_char{}) -> {[],[]}; @@ -1967,8 +1966,10 @@ pat_vars(#k_tuple{es=Es}) -> pat_list_vars(Es); pat_vars(#k_map{es=Es}) -> pat_list_vars(Es); -pat_vars(#k_map_pair{val=V}) -> - pat_vars(V). +pat_vars(#k_map_pair{key=K,val=V}) -> + {U1,New} = pat_vars(V), + {[], U2} = pat_vars(K), + {union(U1,U2),New}. pat_list_vars(Ps) -> foldl(fun (P, {Used0,New0}) -> diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index ab66445f73..b008285d9f 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -38,7 +38,7 @@ -record(k_nil, {anno=[]}). -record(k_tuple, {anno=[],es}). --record(k_map, {anno=[],var,op,es}). +-record(k_map, {anno=[],var=#k_literal{val=#{}},op,es}). -record(k_map_pair, {anno=[],key,val}). -record(k_cons, {anno=[],hd,tl}). -record(k_binary, {anno=[],segs}). diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 0b56a49cd6..892a401c75 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -108,7 +108,7 @@ RELSYSDIR = $(RELEASE_PATH)/compiler_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +clint +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +clint +clint0 EBIN = . diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index f7b1dbdddf..8711f35e8e 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -436,7 +436,7 @@ self_compile_1(Config, Prefix, Opts) -> %% Compile the compiler. (In this node to get better coverage.) ?line CompA = make_compiler_dir(Priv, Prefix++"compiler_a"), ?line VsnA = Version ++ ".0", - ?line compile_compiler(compiler_src(), CompA, VsnA, [clint|Opts]), + compile_compiler(compiler_src(), CompA, VsnA, [clint0,clint|Opts]), %% Compile the compiler again using the newly compiled compiler. %% (In another node because reloading the compiler would disturb cover.) diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 8cb7d1b55b..128291dc67 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -365,7 +365,7 @@ listings_big(Config) when is_list(Config) -> ?line do_listing(Big, TargetDir, dkern, ".kernel"), ?line Target = filename:join(TargetDir, big), - ?line {ok,big} = compile:file(Target, [asm,{outdir,TargetDir}]), + {ok,big} = compile:file(Target, [from_asm,{outdir,TargetDir}]), %% Cleanup. ?line ok = file:delete(Target ++ ".beam"), diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index bd877bb528..0d23f12fb5 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -23,7 +23,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, head_mismatch_line/1,warnings_as_errors/1, bif_clashes/1, - transforms/1,forbidden_maps/1,bad_utf8/1]). + transforms/1,maps_warnings/1,bad_utf8/1]). %% Used by transforms/1 test case. -export([parse_transform/2]). @@ -37,7 +37,7 @@ all() -> groups() -> [{p,test_lib:parallel(), [head_mismatch_line,warnings_as_errors,bif_clashes, - transforms,forbidden_maps,bad_utf8]}]. + transforms,maps_warnings,bad_utf8]}]. init_per_suite(Config) -> Config. @@ -241,17 +241,30 @@ parse_transform(_, _) -> error(too_bad). -forbidden_maps(Config) when is_list(Config) -> - Ts1 = [{map_illegal_use_of_pattern, +maps_warnings(Config) when is_list(Config) -> + Ts1 = [{map_ok_use_of_pattern, <<" - -export([t/0]). + -export([t/1]). + t(K) -> + #{K := 1 = V} = id(#{<<\"hi all\">> => 1}), + V. + id(I) -> I. + ">>, + [return], + []}, + {map_illegal_use_of_pattern, + <<" + -export([t/0,t/2]). + t(K,#{ K := V }) -> V. t() -> V = 32, #{<<\"hi\",V,\"all\">> := 1} = id(#{<<\"hi all\">> => 1}). id(I) -> I. ">>, [return], - {error,[{5,erl_lint,{illegal_map_key_variable,'V'}}], []}}], + {error,[{3,erl_lint,{unbound_var,'K'}}, + {6,erl_lint,illegal_map_key}],[]}} + ], [] = run2(Config, Ts1), ok. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 403b7e8405..75efce9d7b 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -21,6 +21,7 @@ ]). -export([ + %% literals t_build_and_match_literals/1, t_update_literals/1,t_match_and_update_literals/1, t_update_map_expressions/1, @@ -32,6 +33,15 @@ t_map_size/1, t_build_and_match_aliasing/1, + %% variables + t_build_and_match_variables/1, + t_update_assoc_variables/1,t_update_exact_variables/1, + t_nested_pattern_expressions/1, + t_guard_update_variables/1, + t_guard_sequence_variables/1, + t_guard_sequence_mixed/1, + t_frequency_table/1, + %% warnings t_warn_useless_build/1, t_warn_pair_key_overloaded/1, @@ -52,6 +62,7 @@ suite() -> []. all() -> [ + %% literals t_build_and_match_literals, t_update_literals, t_match_and_update_literals, t_update_map_expressions, @@ -62,6 +73,15 @@ all() -> [ t_map_size, t_build_and_match_aliasing, + %% variables + t_build_and_match_variables, + t_update_assoc_variables,t_update_exact_variables, + t_nested_pattern_expressions, + t_guard_update_variables, + t_guard_sequence_variables, + t_guard_sequence_mixed, + t_frequency_table, + %% warnings t_warn_useless_build, t_warn_pair_key_overloaded, @@ -73,6 +93,7 @@ all() -> [ t_build_and_match_nil, t_build_and_match_structure, + %% errors in 17.0-rc1 t_update_values, t_expand_map_update, @@ -119,6 +140,11 @@ t_build_and_match_literals(Config) when is_list(Config) -> %% nil key #{[]:=ok,1:=2} = id(#{[]=>ok,1=>2}), + #{1:=2,[]:=ok,1:=2} = id(#{[]=>ok,1=>2}), + + %% pseudo literals + #{ -3 := yep } = id(#{ -3 => yep }), + #{ <<0:358>> := "three" } = id(#{<<0:358>> =>"three"}), %% error case {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))), @@ -126,10 +152,10 @@ t_build_and_match_literals(Config) when is_list(Config) -> {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))), {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))), {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), - {'EXIT',{badarg,_}} = (catch id(#{<<0:258>> =>"three"})), {'EXIT',{{badmatch,_},_}} = (catch (#{#{"a"=>42} := 3}=id(#{#{"a"=>3}=>42}))), ok. + t_build_and_match_aliasing(Config) when is_list(Config) -> M1 = id(#{a=>1,b=>2,c=>3,d=>4}), #{c:=C1=_=_=C2} = M1, @@ -143,6 +169,19 @@ t_build_and_match_aliasing(Config) when is_list(Config) -> M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}), #{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2, #{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2, + + #{a:=A1,a:=A1,a:=A1,b:=B1,b:=B1} = #{a:=A1,a:=A1,a:=A1,b:=B1,b:=B1,b:=2} = M1, + #{"a":=A3,"b":=B3} = #{"a":=A3,"a":=A3} = #{"b":=B3,"b":=2} = M2, + + #{"a":=1,"b":=2,"c":=3,"d":=4} = #{"a":=A4,"b":=B4} = #{"a":=A4,"a":=A4} = #{"b":=B4,"d":=4} = M2, + #{"a":=A5,"b":=B5} = #{"a":=A5,"a":=A5} = #{"b":=B5,"d":=4} = #{"a":=1,"b":=2,"c":=3,"d":=4} = M2, + #{"a":=_,"b":=_} = #{"a":=_,"a":=_} = #{"b":=_,"d":=4} = #{"a":=1,"b":=2,"c":=3,"d":=4} = M2, + + M3 = id(#{<<12:300>>=>1,<<13:300>>=>2}), + #{<<12:300>> := V1, <<13:300>> := V2} = #{<<13:300>> := V2, <<12:300>> := V1} = M3, + #{<<12:300>> := 1, <<13:300>> := 2} = #{<<13:300>> := _, <<12:300>> := _} = M3, + #{<<13:300>> := _, <<12:300>> := _} = #{<<12:300>> := 1, <<13:300>> := 2} = M3, + ok. t_map_size(Config) when is_list(Config) -> @@ -241,11 +280,14 @@ t_update_assoc(Config) when is_list(Config) -> #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, M2 = M0#{3.0:=wrong,3.0=>new}, + % Can't handle directly yet + Bin = <<0:257>>, + #{ Bin := val } = id(M0#{<<0:257>> => val}), %% binary limitation + %% Errors cases. BadMap = id(badmap), {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}), - {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> => val}), %% limitation ok. t_update_exact(Config) when is_list(Config) -> @@ -281,8 +323,10 @@ t_update_values(Config) when is_list(Config) -> V0 = id(1337), M0 = #{ a => 1, val => V0}, V1 = get_val(M0), - M1 = M0#{ val := [V0,V1], "wazzup" => 42 }, + M1 = id(M0#{ val := [V0,V1], "wazzup" => 42 }), [1337, {some_val, 1337}] = get_val(M1), + M2 = id(M1#{ <<42:333>> => 1337 }), + {bin_key,1337} = get_val(M2), N = 110, List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)], @@ -308,6 +352,7 @@ t_export(Config) when is_list(Config) -> check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok. +get_val(#{ <<42:333>> := V }) -> {bin_key, V}; get_val(#{ "wazzup" := _, val := V}) -> V; get_val(#{ val := V }) -> {some_val, V}. @@ -437,7 +482,10 @@ guard_receive_loop() -> t_list_comprehension(Config) when is_list(Config) -> - [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + [#{k:=1},#{k:=2},#{k:=3}] = id([#{k=>I} || I <- [1,2,3]]), + Ls = id([#{<<2:301>> => I, "wat" => I + 1} || I <- [1,2,3]]), + [#{<<2:301>>:=1,"wat":=2},#{<<2:301>>:=2,"wat":=3},#{<<2:301>>:=3,"wat":=4}] = Ls, + [{1,2},{2,3},{3,4}] = id([{I2,I1} || #{"wat" := I1, <<2:301>> := I2} <- Ls]), ok. t_guard_fun(Config) when is_list(Config) -> @@ -601,5 +649,325 @@ t_build_and_match_structure(Config) when is_list(Config) -> end, ok. +%% simple build and match variables +t_build_and_match_variables(Config) when is_list(Config) -> + K0 = id(#{}), + K1 = id(1), V1 = id(a), + K2 = id(2), V2 = id(b), + K3 = id(3), V3 = id("c"), + K4 = id("4"), V4 = id("d"), + K5 = id(<<"5">>), V5 = id(<<"e">>), + K6 = id({"6",7}), V6 = id("f"), + K7 = id(#{ "a" => 3 }), + #{K1:=V1} = id(#{K1=>V1}), + #{K1:=V1,K2:=V2} = id(#{K1=>V1,K2=>V2}), + #{K1:=V1,K2:=V2,K3:=V3} = id(#{K1=>V1,K2=>V2,K3=>V3}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5,K6:=V6} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5,K6=>V6}), + + #{K5:=X,K5:=X=3,K4:=4} = id(#{K5=>3,K4=>4}), + #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{K5=>3,K4=>4}), + #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{<<"5">>=>3,K4=>4}), + + #{ K4:=#{ K3:=#{K1:=V1, K2:=V2}}, K5:=V5} = + id(#{ K5=>V5, K4=>#{ K3=>#{K2 => V2, K1 => V1}}}), + #{ K4 := #{ K5 := Res }, K6 := Res} = id(#{K4=>#{K5 => 99}, K6 => 99}), + + %% has keys + #{a :=_,b :=_,K1:=_,K2:=_,K3:=V3,K4:=ResKey,K4:=ResKey,"4":=ResKey,"4":="ok"} = + id(#{ a=>1, b=>1, K1=>V1, K2=>V2, K3=>V3, K4=>"nope", "4"=>"ok" }), + + %% function + ok = match_function_map_neg_keys(#{ -1 => a, -2 => b, -3 => c }), + + %% map key + #{ K0 := 42 } = id(#{ K0 => 42 }), + #{ K7 := 42 } = id(#{ K7 => 42 }), + + %% nil key + KNIL = id([]), + #{KNIL:=ok,1:=2} = id(#{KNIL=>ok,1=>2}), + + Bin = <<0:258>>, + #{ Bin := "three" } = id(#{<<0:258>> =>"three"}), + + %% error case + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3,x:=2} = id(#{K5=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=2} = id(#{K5=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id({a,b,c}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(#{K6=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(K7))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K7:=3} = id(#{K7=>42}))), + ok. + + +match_function_map_neg_keys(#{ -1 := a, -2 := b, -3 := c }) -> ok. + +t_update_assoc_variables(Config) when is_list(Config) -> + K1 = id(1), + K2 = id(2), + K3 = id(3.0), + K4 = id(4), + K5 = id(5), + K6 = id(2.0), + + M0 = #{K1=>a,K2=>b,K3=>c,K4=>d,K5=>e}, + + M1 = M0#{K1=>42,K2=>100,K4=>[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + #{1:=42,2:=b,4:=d,5:=e,2.0:=100,K3:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,K6=>100,4.0=>[a,b,c]}, + + M2 = M0#{K3=>new}, + #{1:=a,2:=b,K3:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,K3=>new}, + + #{ <<0:258>> := val } = id(M0#{<<0:258>> => val}), %% binary limitation + + %% Errors cases. + BadMap = id(badmap), + {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), + {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}), + ok. + +t_update_exact_variables(Config) when is_list(Config) -> + K1 = id(1), + K2 = id(2), + K3 = id(3.0), + K4 = id(4), + + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{K1:=42,K2:=100,K4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,K4:=[a,b,c],5:=e} = M1, + M1 = M0#{K1:=wrong,1:=also_wrong,K1=>42,2=>wrong,K2:=100,4:=[a,b,c]}, + + M2 = M0#{K3:=new}, + #{1:=a,K2:=b,3.0:=new,K4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,K3:=new}, + true = M2 =/= M0#{3=>right,3.0:=new}, + #{ 3 := right, 3.0 := new } = M0#{3=>right,K3:=new}, + + M3 = id(#{ 1 => val}), + #{1 := update2,1.0 := new_val4} = M3#{ + 1.0 => new_val1, K1 := update, K1=> update3, + K1 := update2, 1.0 := new_val2, 1.0 => new_val3, + 1.0 => new_val4 }, + + #{ "wat" := 3, 2 := a } = id(#{ "wat" => 1, K2 => 2 }#{ K2 := a, "wat" := 3 }), + + %% Errors cases. + {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })), + {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation + ok. + +t_nested_pattern_expressions(Config) when is_list(Config) -> + K1 = id("hello"), + %K2 = id({ok}), + [_,_,#{ <<"hi">> := wat, K1 := 42 }|_] = id([k,k,#{<<"hi">> => wat, K1 => 42}]), + [_,_,#{ -1 := wat, K1 := 42 }|_] = id([k,k,#{-1 => wat, K1 => 42}]), + [_,_,{#{ -1 := #{ {-3,<<0:300>>} := V1 }, K1 := 42 },3}|_] = id([k,k,{#{-1 => #{{-3,<<0:300>>}=>"hi"}, K1 => 42},3}]), + "hi" = V1, + %[k,#{ {-1,K1,[]} := {wat,K1}, K2 := 42 }|_] = id([k,#{{-1,K1,[]} => {wat,K1}, K2 => 42}]), + %[k,#{ [-1,K2,[]] := {wat,K1}, K1 := 42 }|_] = id([k,#{[-1,K2,[]] => {wat,K1}, K1 => 42}]), + + M0 = id(#{ <<33:333>> => 1, <<332:333>> => ok, a => ok, wat => yep, watzor => ok }), + F0 = map_nested_pattern_funs(M0), + F1 = F0(wat), + F2 = F1(watzor), + {yep,ok} = F2(M0), + ok. + +map_nested_pattern_funs(M) -> + K0 = id(a), + fun(K1) -> + case M of + #{ K0 := ok, K1 := yep, <<33:333>> := 1 } -> + fun(K2) -> + case M of + #{ K2 := ok, K1 := yep, <<33:333>> := 1 } -> + fun + (#{ <<332:333>> := ok, K1 := V1, K2 := V2 }) -> + {V1,V2} + end + end + end + end + end. + +t_guard_update_variables(Config) when is_list(Config) -> + error = map_guard_update_variables(n,#{},#{}), + first = map_guard_update_variables(x,#{}, #{x=>first}), + second = map_guard_update_variables(x,#{y=>old}, #{x=>second,y=>old}), + third = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>third,y=>old}), + fourth = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>4,y=>new}), + ok. + +map_guard_update_variables(K,M1,M2) when M1#{K=>first} =:= M2 -> first; +map_guard_update_variables(K,M1,M2) when M1#{K=>second} =:= M2 -> second; +map_guard_update_variables(K,M1,M2) when M1#{K:=third} =:= M2 -> third; +map_guard_update_variables(K,M1,M2) when M1#{K:=4,y=>new} =:= M2 -> fourth; +map_guard_update_variables(_,_,_) -> error. + +t_guard_sequence_variables(Config) when is_list(Config) -> + {1,"a"} = map_guard_sequence_var_1(a,#{seq=>1,a=>id("a"),b=>no}), + {2,"b"} = map_guard_sequence_var_1(b,#{seq=>2,b=>id("b"),a=>no}), + {3,"c"} = map_guard_sequence_var_1(a,#{seq=>3,a=>id("c"),b=>no}), + {4,"d"} = map_guard_sequence_var_1(b,#{seq=>4,b=>id("d"),a=>no}), + {4,4} = map_guard_sequence_var_1(seq,#{seq=>4}), + {4,4,y} = map_guard_sequence_var_1(seq,#{seq=>4,b=>id("d"),a=>y}), + {5,"d"} = map_guard_sequence_var_1(b,#{seq=>5,b=>id("d"),a=>y}), + + %% error case + {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_var_1("a",#{seq=>4,val=>id("e")})), + ok. + + +map_guard_sequence_var_1(K,M) -> + case M of + #{seq:=1=Seq, K:=Val} -> {Seq,Val}; + #{seq:=2=Seq, K:=Val} -> {Seq,Val}; + #{seq:=3=Seq, K:=Val} -> {Seq,Val}; + #{K:=4=Seq, K:=Val1,a:=Val2} -> {Seq,Val1,Val2}; + #{seq:=4=Seq, K:=Val} -> {Seq,Val}; + #{K:=4=Seq, K:=Val} -> {Seq,Val}; + #{seq:=5=Seq, K:=Val} -> {Seq,Val} + end. + + +t_guard_sequence_mixed(Config) when is_list(Config) -> + M0 = id(#{ a=>1, b=>1, c=>1, d=>1, e=>1, f=>1, g=>1, h=>1 }), + M1 = id(M0#{ d := 3 }), + 1 = map_guard_sequence_mixed(a,d,M1), + M2 = id(M1#{ b := 2, d := 4, h := 2 }), + 2 = map_guard_sequence_mixed(a,d,M2), + M3 = id(M2#{ b := 3, e := 5, g := 3 }), + 3 = map_guard_sequence_mixed(a,e,M3), + M4 = id(M3#{ c := 4, e := 6, h := 1 }), + 4 = map_guard_sequence_mixed(a,e,M4), + M5 = id(M4#{ c := 5, f := 7, g := 2 }), + 5 = map_guard_sequence_mixed(a,f,M5), + M6 = id(M5#{ c := 6, f := 8, h := 3 }), + 6 = map_guard_sequence_mixed(a,f,M6), + + %% error case + {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_mixed(a,b,M0)), + ok. + +map_guard_sequence_mixed(K1,K2,M) -> + case M of + #{ K1 := 1, b := 1, K2 := 3, g := 1} -> 1; + #{ K1 := 1, b := 2, K2 := 4, h := 2} -> 2; + #{ K1 := 1, b := 3, K2 := 5, g := 3} -> 3; + #{ K1 := 1, c := 4, K2 := 6, h := 1} -> 4; + #{ K1 := 1, c := 5, K2 := 7, g := 2} -> 5; + #{ K1 := 1, c := 6, K2 := 8, h := 3} -> 6 + end. + + + +t_frequency_table(Config) when is_list(Config) -> + random:seed({13,1337,54}), % pseudo random + N = 100000, + Ts = rand_terms(N), + #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}), + ok = check_frequency(Ts,Tf), + ok. + + +frequency_table([T|Ts], M) -> + case M of + #{ n := N, tf := #{ T := C } = F } -> + frequency_table(Ts,M#{ n := N + 1, tf := F#{ T := C + 1 }}); + #{ n := N, tf := F } -> + frequency_table(Ts,M#{ n := N + 1, tf := F#{ T => 1 }}) + end; +frequency_table([], M) -> M. + + +check_frequency(Ts,Tf) -> + check_frequency(Ts,Tf,dict:new()). + +check_frequency([T|Ts],Tf,D) -> + case dict:find(T,D) of + error -> check_frequency(Ts,Tf,dict:store(T,1,D)); + {ok,C} -> check_frequency(Ts,Tf,dict:store(T,C+1,D)) + end; +check_frequency([],Tf,D) -> + validate_frequency(dict:to_list(D),Tf). + +validate_frequency([{T,C}|Fs],Tf) -> + case Tf of + #{ T := C } -> validate_frequency(Fs,Tf); + _ -> error + end; +validate_frequency([], _) -> ok. + + +%% aux + +rand_terms(0) -> []; +rand_terms(N) -> [rand_term()|rand_terms(N-1)]. + +rand_term() -> + case random:uniform(6) of + 1 -> rand_binary(); + 2 -> rand_number(); + 3 -> rand_atom(); + 4 -> rand_tuple(); + 5 -> rand_list(); + 6 -> rand_map() + end. + +rand_binary() -> + case random:uniform(3) of + 1 -> <<>>; + 2 -> <<"hi">>; + 3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">> + end. + +rand_number() -> + case random:uniform(3) of + 1 -> random:uniform(5); + 2 -> float(random:uniform(5)); + 3 -> 1 bsl (63 + random:uniform(3)) + end. + +rand_atom() -> + case random:uniform(3) of + 1 -> hi; + 2 -> some_atom; + 3 -> some_other_atom + end. + + +rand_tuple() -> + case random:uniform(3) of + 1 -> {ok, rand_term()}; % careful + 2 -> {1, 2, 3}; + 3 -> {<<"yep">>, 1337} + end. + +rand_list() -> + case random:uniform(3) of + 1 -> "hi"; + 2 -> [1,rand_term()]; % careful + 3 -> [improper|list] + end. + +rand_map() -> + case random:uniform(3) of + 1 -> #{ hi => 3 }; + 2 -> #{ wat => rand_term(), other => 3 }; % careful + 3 -> #{ hi => 42, other => 42, yet_anoter => 1337 } + end. + + + %% Use this function to avoid compile-time evaluation of an expression. id(I) -> I. diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 0637041873..be0348a92d 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -601,7 +601,7 @@ maps(Config) when is_list(Config) -> ">>, [], {warnings,[{3,v3_core,bad_map}]}}, - {bad_map_literal_key, + {ok_map_literal_key, <<" t() -> V = id(1), @@ -614,7 +614,7 @@ maps(Config) when is_list(Config) -> id(I) -> I. ">>, [], - {warnings,[{6,v3_core,nomatch}]}}], + []}], run(Config, Ts), ok. diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index e7215eeb64..a42de9adb1 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -54,6 +54,10 @@ #include <openssl/evp.h> #include <openssl/hmac.h> +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +#include <openssl/modes.h> +#endif + #include "crypto_callback.h" #if OPENSSL_VERSION_NUMBER >= 0x00908000L && !defined(OPENSSL_NO_SHA224) && defined(NID_sha224)\ @@ -85,13 +89,32 @@ # define HAVE_AES_IGE #endif +#if OPENSSL_VERSION_NUMBER >= 0x1000100fL +# define HAVE_GCM +#endif + +#if defined(NID_chacha20) && !defined(OPENSSL_NO_CHACHA) && !defined(OPENSSL_NO_POLY1305) +# define HAVE_CHACHA20_POLY1305 +#endif + #if defined(HAVE_EC) #include <openssl/ec.h> #include <openssl/ecdh.h> #include <openssl/ecdsa.h> #endif +#if defined(HAVE_CHACHA20_POLY1305) +#include <openssl/chacha.h> +#include <openssl/poly1305.h> +#if !defined(CHACHA20_NONCE_LEN) +# define CHACHA20_NONCE_LEN 8 +#endif +#if !defined(POLY1305_TAG_LEN) +# define POLY1305_TAG_LEN 16 +#endif + +#endif #ifdef VALGRIND # include <valgrind/memcheck.h> @@ -257,6 +280,11 @@ static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); /* helpers */ static void init_algorithms_types(ErlNifEnv*); @@ -387,7 +415,15 @@ static ErlNifFunc nif_funcs[] = { {"ecdsa_verify_nif", 5, ecdsa_verify_nif}, {"ecdh_compute_key_nif", 3, ecdh_compute_key_nif}, - {"rand_seed_nif", 1, rand_seed_nif} + {"rand_seed_nif", 1, rand_seed_nif}, + + {"aes_gcm_encrypt", 4, aes_gcm_encrypt}, + {"aes_gcm_decrypt", 5, aes_gcm_decrypt}, + + {"chacha20_poly1305_encrypt", 4, chacha20_poly1305_encrypt}, + {"chacha20_poly1305_decrypt", 5, chacha20_poly1305_decrypt} + + }; ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload) @@ -725,7 +761,7 @@ static ERL_NIF_TERM algo_hash[8]; /* increase when extending the list */ static int algo_pubkey_cnt; static ERL_NIF_TERM algo_pubkey[3]; /* increase when extending the list */ static int algo_cipher_cnt; -static ERL_NIF_TERM algo_cipher[2]; /* increase when extending the list */ +static ERL_NIF_TERM algo_cipher[4]; /* increase when extending the list */ static void init_algorithms_types(ErlNifEnv* env) { @@ -763,6 +799,12 @@ static void init_algorithms_types(ErlNifEnv* env) #ifdef HAVE_AES_IGE algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_ige256"); #endif +#if defined(HAVE_GCM) + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_gcm"); +#endif +#if defined(HAVE_CHACHA20_POLY1305) + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"chacha20_poly1305"); +#endif ASSERT(algo_hash_cnt <= sizeof(algo_hash)/sizeof(ERL_NIF_TERM)); ASSERT(algo_pubkey_cnt <= sizeof(algo_pubkey)/sizeof(ERL_NIF_TERM)); @@ -1760,6 +1802,236 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N return ret; } +static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key,Iv,AAD,In) */ +#if defined(HAVE_GCM) + GCM128_CONTEXT *ctx = NULL; + ErlNifBinary key, iv, aad, in; + AES_KEY aes_key; + unsigned char *outp; + ERL_NIF_TERM out, out_tag; + + CHECK_OSE_CRYPTO(); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) + || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 + || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0 + || !enif_inspect_iolist_as_binary(env, argv[2], &aad) + || !enif_inspect_iolist_as_binary(env, argv[3], &in)) { + return enif_make_badarg(env); + } + + if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt))) + return atom_error; + + CRYPTO_gcm128_setiv(ctx, iv.data, iv.size); + + if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size)) + goto out_err; + + outp = enif_make_new_binary(env, in.size, &out); + + /* encrypt */ + if (CRYPTO_gcm128_encrypt(ctx, in.data, outp, in.size)) + goto out_err; + + /* calculate the tag */ + CRYPTO_gcm128_tag(ctx, enif_make_new_binary(env, EVP_GCM_TLS_TAG_LEN, &out_tag), EVP_GCM_TLS_TAG_LEN); + CRYPTO_gcm128_release(ctx); + + CONSUME_REDS(env, in); + + return enif_make_tuple2(env, out, out_tag); + +out_err: + CRYPTO_gcm128_release(ctx); + return atom_error; + +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key,Iv,AAD,In,Tag) */ +#if defined(HAVE_GCM) + GCM128_CONTEXT *ctx; + ErlNifBinary key, iv, aad, in, tag; + AES_KEY aes_key; + unsigned char *outp; + ERL_NIF_TERM out; + + CHECK_OSE_CRYPTO(); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) + || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 + || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0 + || !enif_inspect_iolist_as_binary(env, argv[2], &aad) + || !enif_inspect_iolist_as_binary(env, argv[3], &in) + || !enif_inspect_iolist_as_binary(env, argv[4], &tag) || tag.size != EVP_GCM_TLS_TAG_LEN) { + return enif_make_badarg(env); + } + + if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt))) + return atom_error; + + CRYPTO_gcm128_setiv(ctx, iv.data, iv.size); + + if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size)) + goto out_err; + + outp = enif_make_new_binary(env, in.size, &out); + + /* decrypt */ + if (CRYPTO_gcm128_decrypt(ctx, in.data, outp, in.size)) + goto out_err; + + /* calculate and check the tag */ + if (CRYPTO_gcm128_finish(ctx, tag.data, EVP_GCM_TLS_TAG_LEN)) + goto out_err; + + CRYPTO_gcm128_release(ctx); + CONSUME_REDS(env, in); + + return out; + +out_err: + CRYPTO_gcm128_release(ctx); + return atom_error; +#else + return atom_notsup; +#endif +} + +#if defined(HAVE_CHACHA20_POLY1305) +static void +poly1305_update_with_length(poly1305_state *poly1305, + const unsigned char *data, size_t data_len) +{ + size_t j = data_len; + unsigned char length_bytes[8]; + unsigned i; + + for (i = 0; i < sizeof(length_bytes); i++) { + length_bytes[i] = j; + j >>= 8; + } + + CRYPTO_poly1305_update(poly1305, data, data_len); + CRYPTO_poly1305_update(poly1305, length_bytes, sizeof(length_bytes)); +} +#endif + +static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key,Iv,AAD,In) */ +#if defined(HAVE_CHACHA20_POLY1305) + ErlNifBinary key, iv, aad, in; + unsigned char *outp; + ERL_NIF_TERM out, out_tag; + ErlNifUInt64 in_len_64; + unsigned char poly1305_key[32]; + poly1305_state poly1305; + + CHECK_OSE_CRYPTO(); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 + || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN + || !enif_inspect_iolist_as_binary(env, argv[2], &aad) + || !enif_inspect_iolist_as_binary(env, argv[3], &in)) { + return enif_make_badarg(env); + } + + /* Take from OpenSSL patch set/LibreSSL: + * + * The underlying ChaCha implementation may not overflow the block + * counter into the second counter word. Therefore we disallow + * individual operations that work on more than 2TB at a time. + * in_len_64 is needed because, on 32-bit platforms, size_t is only + * 32-bits and this produces a warning because it's always false. + * Casting to uint64_t inside the conditional is not sufficient to stop + * the warning. */ + in_len_64 = in.size; + if (in_len_64 >= (1ULL << 32) * 64 - 64) + return enif_make_badarg(env); + + memset(poly1305_key, 0, sizeof(poly1305_key)); + CRYPTO_chacha_20(poly1305_key, poly1305_key, sizeof(poly1305_key), key.data, iv.data, 0); + + outp = enif_make_new_binary(env, in.size, &out); + + CRYPTO_poly1305_init(&poly1305, poly1305_key); + poly1305_update_with_length(&poly1305, aad.data, aad.size); + CRYPTO_chacha_20(outp, in.data, in.size, key.data, iv.data, 1); + poly1305_update_with_length(&poly1305, outp, in.size); + + CRYPTO_poly1305_finish(&poly1305, enif_make_new_binary(env, POLY1305_TAG_LEN, &out_tag)); + + CONSUME_REDS(env, in); + + return enif_make_tuple2(env, out, out_tag); + +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key,Iv,AAD,In,Tag) */ +#if defined(HAVE_CHACHA20_POLY1305) + ErlNifBinary key, iv, aad, in, tag; + unsigned char *outp; + ERL_NIF_TERM out; + ErlNifUInt64 in_len_64; + unsigned char poly1305_key[32]; + unsigned char mac[POLY1305_TAG_LEN]; + poly1305_state poly1305; + + CHECK_OSE_CRYPTO(); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 + || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN + || !enif_inspect_iolist_as_binary(env, argv[2], &aad) + || !enif_inspect_iolist_as_binary(env, argv[3], &in) + || !enif_inspect_iolist_as_binary(env, argv[4], &tag) || tag.size != POLY1305_TAG_LEN) { + return enif_make_badarg(env); + } + + /* Take from OpenSSL patch set/LibreSSL: + * + * The underlying ChaCha implementation may not overflow the block + * counter into the second counter word. Therefore we disallow + * individual operations that work on more than 2TB at a time. + * in_len_64 is needed because, on 32-bit platforms, size_t is only + * 32-bits and this produces a warning because it's always false. + * Casting to uint64_t inside the conditional is not sufficient to stop + * the warning. */ + in_len_64 = in.size; + if (in_len_64 >= (1ULL << 32) * 64 - 64) + return enif_make_badarg(env); + + memset(poly1305_key, 0, sizeof(poly1305_key)); + CRYPTO_chacha_20(poly1305_key, poly1305_key, sizeof(poly1305_key), key.data, iv.data, 0); + + CRYPTO_poly1305_init(&poly1305, poly1305_key); + poly1305_update_with_length(&poly1305, aad.data, aad.size); + poly1305_update_with_length(&poly1305, in.data, in.size); + CRYPTO_poly1305_finish(&poly1305, mac); + + if (memcmp(mac, tag.data, POLY1305_TAG_LEN) != 0) + return atom_error; + + outp = enif_make_new_binary(env, in.size, &out); + + CRYPTO_chacha_20(outp, in.data, in.size, key.data, iv.data, 1); + + CONSUME_REDS(env, in); + + return out; +#else + return atom_notsup; +#endif +} + static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Bytes) */ unsigned bytes; diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 98384978a5..271130a9e6 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -41,7 +41,7 @@ </item> <item> <p>Block ciphers - <url href="http://csrc.nist.gov/groups/ST/toolkit/block_ciphers.html"> </url> DES and AES in - Block Cipher Modes - <url href="http://csrc.nist.gov/groups/ST/toolkit/BCM/index.html"> ECB, CBC, CFB, OFB and CTR </url></p> + Block Cipher Modes - <url href="http://csrc.nist.gov/groups/ST/toolkit/BCM/index.html"> ECB, CBC, CFB, OFB, CTR and GCM </url></p> </item> <item> <p><url href="http://www.ietf.org/rfc/rfc1321.txt"> RSA encryption RFC 1321 </url> </p> @@ -53,6 +53,12 @@ <item> <p><url href="http://www.ietf.org/rfc/rfc2945.txt"> Secure Remote Password Protocol (SRP - RFC 2945) </url></p> </item> + <item> + <p>gcm: Dworkin, M., "Recommendation for Block Cipher Modes of + Operation: Galois/Counter Mode (GCM) and GMAC", + National Institute of Standards and Technology SP 800- + 38D, November 2007.</p> + </item> </list> </description> @@ -132,6 +138,8 @@ blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | rc2_cbc </code></p> + <p><code>aead_cipher() = aes_gcm | chacha20_poly1305 </code></p> + <p><code>stream_key() = aes_key() | rc4_key() </code></p> <p><code>block_key() = aes_key() | blowfish_key() | des_key()| des3_key() </code></p> @@ -152,7 +160,7 @@ Note that both md4 and md5 are recommended only for compatibility with existing applications. </p> <p><code> cipher_algorithms() = des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | - blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128| aes_cbc256 | aes_ige256 | rc2_cbc | aes_ctr| rc4 </code> </p> + blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128| aes_cbc256 | aes_ige256 | aes_gcm | chacha20_poly1305 | rc2_cbc | aes_ctr| rc4 </code> </p> <p><code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code> Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported with ecdsa and ecdh. @@ -161,18 +169,23 @@ </section> <funcs> - <func> + <func> <name>block_encrypt(Type, Key, Ivec, PlainText) -> CipherText</name> - <fsummary>Encrypt <c>PlainText</c>according to <c>Type</c> block cipher</fsummary> + <name>block_encrypt(AeadType, Key, Ivec, {AAD, PlainText}) -> {CipherText, CipherTag}</name> + <fsummary>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher</fsummary> <type> <v>Type = block_cipher() </v> + <v>AeadType = aead_cipher() </v> <v>Key = block_key() </v> <v>PlainText = iodata() </v> - <v>IVec = CipherText = binary()</v> + <v>AAD = IVec = CipherText = CipherTag = binary()</v> </type> <desc> <p>Encrypt <c>PlainText</c>according to <c>Type</c> block cipher. <c>IVec</c> is an arbitrary initializing vector.</p> + <p>In AEAD (Authenticated Encryption with Associated Data) mode, encrypt + <c>PlainText</c>according to <c>Type</c> block cipher and calculate + <c>CipherTag</c> that also authenticates the <c>AAD</c> (Associated Authenticated Data).</p> <p>May throw exception <c>notsup</c> in case the chosen <c>Type</c> is not supported by the underlying OpenSSL implementation.</p> </desc> @@ -180,16 +193,22 @@ <func> <name>block_decrypt(Type, Key, Ivec, CipherText) -> PlainText</name> - <fsummary>Decrypt <c>CipherText</c>according to <c>Type</c> block cipher</fsummary> + <name>block_decrypt(AeadType, Key, Ivec, {AAD, CipherText, CipherTag}) -> PlainText | error</name> + <fsummary>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher</fsummary> <type> <v>Type = block_cipher() </v> + <v>AeadType = aead_cipher() </v> <v>Key = block_key() </v> <v>PlainText = iodata() </v> - <v>IVec = CipherText = binary()</v> + <v>AAD = IVec = CipherText = CipherTag = binary()</v> </type> <desc> <p>Decrypt <c>CipherText</c>according to <c>Type</c> block cipher. <c>IVec</c> is an arbitrary initializing vector.</p> + <p>In AEAD (Authenticated Encryption with Associated Data) mode, decrypt + <c>CipherText</c>according to <c>Type</c> block cipher and check the authenticity + the <c>PlainText</c> and <c>AAD</c> (Associated Authenticated Data) using the + <c>CipherTag</c>. May return <c>error</c> if the decryption or validation fail's</p> <p>May throw exception <c>notsup</c> in case the chosen <c>Type</c> is not supported by the underlying OpenSSL implementation.</p> </desc> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index e1fbbf9ab8..7f82fa83fd 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -282,7 +282,8 @@ hmac_final_n(_Context, _HashLen) -> ? nif_stub. -spec block_encrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | rc2_cbc, - Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(). + Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); + (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}. block_encrypt(des_cbc, Key, Ivec, Data) -> des_cbc_encrypt(Key, Ivec, Data); @@ -310,14 +311,25 @@ block_encrypt(aes_cfb8, Key, Ivec, Data) -> aes_cfb_8_encrypt(Key, Ivec, Data); block_encrypt(aes_cfb128, Key, Ivec, Data) -> aes_cfb_128_encrypt(Key, Ivec, Data); +block_encrypt(aes_gcm, Key, Ivec, {AAD, Data}) -> + case aes_gcm_encrypt(Key, Ivec, AAD, Data) of + notsup -> erlang:error(notsup); + Return -> Return + end; +block_encrypt(chacha20_poly1305, Key, Ivec, {AAD, Data}) -> + case chacha20_poly1305_encrypt(Key, Ivec, AAD, Data) of + notsup -> erlang:error(notsup); + Return -> Return + end; block_encrypt(rc2_cbc, Key, Ivec, Data) -> rc2_cbc_encrypt(Key, Ivec, Data). -spec block_decrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc | - blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cbc256 | aes_ige256 | - aes_cfb8 | aes_cfb128 | rc2_cbc, - Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(). - + blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cbc256 | aes_ige256 | + aes_cfb8 | aes_cfb128 | rc2_cbc, + Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); + (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), + {AAD::binary(), Data::iodata(), Tag::binary()}) -> binary() | error. block_decrypt(des_cbc, Key, Ivec, Data) -> des_cbc_decrypt(Key, Ivec, Data); block_decrypt(des_cfb, Key, Ivec, Data) -> @@ -344,9 +356,18 @@ block_decrypt(aes_cfb8, Key, Ivec, Data) -> aes_cfb_8_decrypt(Key, Ivec, Data); block_decrypt(aes_cfb128, Key, Ivec, Data) -> aes_cfb_128_decrypt(Key, Ivec, Data); +block_decrypt(aes_gcm, Key, Ivec, {AAD, Data, Tag}) -> + case aes_gcm_decrypt(Key, Ivec, AAD, Data, Tag) of + notsup -> erlang:error(notsup); + Return -> Return + end; +block_decrypt(chacha20_poly1305, Key, Ivec, {AAD, Data, Tag}) -> + case chacha20_poly1305_decrypt(Key, Ivec, AAD, Data, Tag) of + notsup -> erlang:error(notsup); + Return -> Return + end; block_decrypt(rc2_cbc, Key, Ivec, Data) -> rc2_cbc_decrypt(Key, Ivec, Data). - -spec block_encrypt(des_ecb | blowfish_ecb, Key::iodata(), Data::iodata()) -> binary(). block_encrypt(des_ecb, Key, Data) -> @@ -1190,6 +1211,17 @@ aes_cfb_128_decrypt(Key, IVec, Data) -> aes_cfb_128_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. +%% +%% AES - in Galois/Counter Mode (GCM) +%% +aes_gcm_encrypt(_Key, _Ivec, _AAD, _In) -> ?nif_stub. +aes_gcm_decrypt(_Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub. + +%% +%% Chacha20/Ppoly1305 +%% +chacha20_poly1305_encrypt(_Key, _Ivec, _AAD, _In) -> ?nif_stub. +chacha20_poly1305_decrypt(_Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub. %% %% DES - in cipher block chaining mode (CBC) diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 03aa3964a5..1031e6403f 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -62,6 +62,8 @@ all() -> {group, rc2_cbc}, {group, rc4}, {group, aes_ctr}, + {group, aes_gcm}, + {group, chacha20_poly1305}, mod_pow, exor, rand_uniform @@ -100,7 +102,9 @@ groups() -> {blowfish_cfb64, [], [block]}, {blowfish_ofb64,[], [block]}, {rc4, [], [stream]}, - {aes_ctr, [], [stream]} + {aes_ctr, [], [stream]}, + {aes_gcm, [], [aead]}, + {chacha20_poly1305, [], [aead]} ]. %%------------------------------------------------------------------- @@ -203,6 +207,14 @@ stream(Config) when is_list(Config) -> lists:foreach(fun stream_cipher/1, stream_iolistify(Streams)), lists:foreach(fun stream_cipher_incment/1, stream_iolistify(Streams)). +%%-------------------------------------------------------------------- +aead() -> + [{doc, "Test AEAD ciphers"}]. +aead(Config) when is_list(Config) -> + AEADs = lazy_eval(proplists:get_value(aead, Config)), + + lists:foreach(fun aead_cipher/1, AEADs). + %%-------------------------------------------------------------------- sign_verify() -> [{doc, "Sign/verify digital signatures"}]. @@ -406,7 +418,22 @@ stream_cipher_incment(_State, OrigState, [], Acc, Plain) -> stream_cipher_incment(State0, OrigState, [PlainText | PlainTexts], Acc, Plain) -> {State, CipherText} = crypto:stream_encrypt(State0, PlainText), stream_cipher_incment(State, OrigState, PlainTexts, [CipherText | Acc], Plain). - + +aead_cipher({Type, Key, PlainText, IV, AAD, CipherText, CipherTag}) -> + Plain = iolist_to_binary(PlainText), + case crypto:block_encrypt(Type, Key, IV, {AAD, Plain}) of + {CipherText, CipherTag} -> + ok; + Other0 -> + ct:fail({{crypto, block_encrypt, [Plain, PlainText]}, {expected, {CipherText, CipherTag}}, {got, Other0}}) + end, + case crypto:block_decrypt(Type, Key, IV, {AAD, CipherText, CipherTag}) of + Plain -> + ok; + Other1 -> + ct:fail({{crypto, block_decrypt, [CipherText]}, {expected, Plain}, {got, Other1}}) + end. + do_sign_verify({Type, Hash, Public, Private, Msg}) -> Signature = crypto:sign(Type, Hash, Msg, Private), case crypto:verify(Type, Hash, Msg, Signature, Public) of @@ -749,6 +776,12 @@ group_config(rc4, Config) -> group_config(aes_ctr, Config) -> Stream = aes_ctr(), [{stream, Stream} | Config]; +group_config(aes_gcm, Config) -> + AEAD = aes_gcm(), + [{aead, AEAD} | Config]; +group_config(chacha20_poly1305, Config) -> + AEAD = chacha20_poly1305(), + [{aead, AEAD} | Config]; group_config(_, Config) -> Config. @@ -1378,6 +1411,269 @@ aes_ctr() -> long_msg()} ]. + +%% AES GCM test vectors from http://csrc.nist.gov/groups/ST/toolkit/BCM/documents/proposedmodes/gcm/gcm-spec.pdf +aes_gcm() -> + [ + %% Test Case 1 + {aes_gcm, hexstr2bin("00000000000000000000000000000000"), %% Key + hexstr2bin(""), %% PlainText + hexstr2bin("000000000000000000000000"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin(""), %% CipherText + hexstr2bin("58e2fccefa7e3061367f1d57a4e7455a")}, %% CipherTag + + %% Test Case 2 + {aes_gcm, hexstr2bin("00000000000000000000000000000000"), %% Key + hexstr2bin("00000000000000000000000000000000"), %% PlainText + hexstr2bin("000000000000000000000000"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin("0388dace60b6a392f328c2b971b2fe78"), %% CipherText + hexstr2bin("ab6e47d42cec13bdf53a67b21257bddf")}, %% CipherTag + + %% Test Case 3 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308"), %% Key + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b391aafd255"), + hexstr2bin("cafebabefacedbaddecaf888"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin("42831ec2217774244b7221b784d0d49c" %% CipherText + "e3aa212f2c02a4e035c17e2329aca12e" + "21d514b25466931c7d8f6a5aac84aa05" + "1ba30b396a0aac973d58e091473f5985"), + hexstr2bin("4d5c2af327cd64a62cf35abd2ba6fab4")}, %% CipherTag + + %% Test Case 4 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308"), %% Key + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("cafebabefacedbaddecaf888"), %% IV + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("42831ec2217774244b7221b784d0d49c" %% CipherText + "e3aa212f2c02a4e035c17e2329aca12e" + "21d514b25466931c7d8f6a5aac84aa05" + "1ba30b396a0aac973d58e091"), + hexstr2bin("5bc94fbc3221a5db94fae95ae7121a47")}, %% CipherTag + + %% Test Case 5 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308"), %% Key + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("cafebabefacedbad"), %% IV + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("61353b4c2806934a777ff51fa22a4755" %% CipherText + "699b2a714fcdc6f83766e5f97b6c7423" + "73806900e49f24b22b097544d4896b42" + "4989b5e1ebac0f07c23f4598"), + hexstr2bin("3612d2e79e3b0785561be14aaca2fccb")}, %% CipherTag + + %% Test Case 6" + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308"), %% Key + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("9313225df88406e555909c5aff5269aa" %% IV + "6a7a9538534f7da1e4c303d2a318a728" + "c3c0c95156809539fcf0e2429a6b5254" + "16aedbf5a0de6a57a637b39b"), + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("8ce24998625615b603a033aca13fb894" %% CipherText + "be9112a5c3a211a8ba262a3cca7e2ca7" + "01e4a9a4fba43c90ccdcb281d48c7c6f" + "d62875d2aca417034c34aee5"), + hexstr2bin("619cc5aefffe0bfa462af43c1699d050")}, %% CipherTag + + %% Test Case 7 + {aes_gcm, hexstr2bin("00000000000000000000000000000000" %% Key + "0000000000000000"), + hexstr2bin(""), %% PlainText + hexstr2bin("000000000000000000000000"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin(""), %% CipherText + hexstr2bin("cd33b28ac773f74ba00ed1f312572435")}, %% CipherTag + + %% Test Case 8 + {aes_gcm, hexstr2bin("00000000000000000000000000000000" %% Key + "0000000000000000"), + hexstr2bin("00000000000000000000000000000000"), %% PlainText + hexstr2bin("000000000000000000000000"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin("98e7247c07f0fe411c267e4384b0f600"), %% CipherText + hexstr2bin("2ff58d80033927ab8ef4d4587514f0fb")}, %% CipherTag + + %% Test Case 9 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b391aafd255"), + hexstr2bin("cafebabefacedbaddecaf888"), %% IV + hexstr2bin(""), %% ADD + hexstr2bin("3980ca0b3c00e841eb06fac4872a2757" %% CipherText + "859e1ceaa6efd984628593b40ca1e19c" + "7d773d00c144c525ac619d18c84a3f47" + "18e2448b2fe324d9ccda2710acade256"), + hexstr2bin("9924a7c8587336bfb118024db8674a14")}, %% CipherTag + + %% Test Case 10 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("cafebabefacedbaddecaf888"), %% IV + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("3980ca0b3c00e841eb06fac4872a2757" %% CipherText + "859e1ceaa6efd984628593b40ca1e19c" + "7d773d00c144c525ac619d18c84a3f47" + "18e2448b2fe324d9ccda2710"), + hexstr2bin("2519498e80f1478f37ba55bd6d27618c")}, %% CipherTag + + %% Test Case 11 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("cafebabefacedbad"), %% IV + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("0f10f599ae14a154ed24b36e25324db8" %% CipherText + "c566632ef2bbb34f8347280fc4507057" + "fddc29df9a471f75c66541d4d4dad1c9" + "e93a19a58e8b473fa0f062f7"), + hexstr2bin("65dcc57fcf623a24094fcca40d3533f8")}, %% CipherTag + + %% Test Case 12 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("9313225df88406e555909c5aff5269aa" %% IV + "6a7a9538534f7da1e4c303d2a318a728" + "c3c0c95156809539fcf0e2429a6b5254" + "16aedbf5a0de6a57a637b39b"), + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("d27e88681ce3243c4830165a8fdcf9ff" %% CipherText + "1de9a1d8e6b447ef6ef7b79828666e45" + "81e79012af34ddd9e2f037589b292db3" + "e67c036745fa22e7e9b7373b"), + hexstr2bin("dcf566ff291c25bbb8568fc3d376a6d9")}, %% CipherTag + + %% Test Case 13 + {aes_gcm, hexstr2bin("00000000000000000000000000000000" %% Key + "00000000000000000000000000000000"), + hexstr2bin(""), %% PlainText + hexstr2bin("000000000000000000000000"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin(""), %% CipherText + hexstr2bin("530f8afbc74536b9a963b4f1c4cb738b")}, %% CipherTag + + %% Test Case 14 + {aes_gcm, hexstr2bin("00000000000000000000000000000000" %% Key + "00000000000000000000000000000000"), + hexstr2bin("00000000000000000000000000000000"), %% PlainText + hexstr2bin("000000000000000000000000"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin("cea7403d4d606b6e074ec5d3baf39d18"), %% CipherText + hexstr2bin("d0d1c8a799996bf0265b98b5d48ab919")}, %% CipherTag + + %% Test Case 15 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c6d6a8f9467308308"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b391aafd255"), + hexstr2bin("cafebabefacedbaddecaf888"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin("522dc1f099567d07f47f37a32a84427d" %% CipherText + "643a8cdcbfe5c0c97598a2bd2555d1aa" + "8cb08e48590dbb3da7b08b1056828838" + "c5f61e6393ba7a0abcc9f662898015ad"), + hexstr2bin("b094dac5d93471bdec1a502270e3cc6c")}, %% CipherTag + + %% Test Case 16 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c6d6a8f9467308308"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("cafebabefacedbaddecaf888"), %% IV + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("522dc1f099567d07f47f37a32a84427d" %% CipherText + "643a8cdcbfe5c0c97598a2bd2555d1aa" + "8cb08e48590dbb3da7b08b1056828838" + "c5f61e6393ba7a0abcc9f662"), + hexstr2bin("76fc6ece0f4e1768cddf8853bb2d551b")}, %% CipherTag + + %% Test Case 17 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c6d6a8f9467308308"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("cafebabefacedbad"), %% IV + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("c3762df1ca787d32ae47c13bf19844cb" %% CipherText + "af1ae14d0b976afac52ff7d79bba9de0" + "feb582d33934a4f0954cc2363bc73f78" + "62ac430e64abe499f47c9b1f"), + hexstr2bin("3a337dbf46a792c45e454913fe2ea8f2")}, %% CipherTag + + %% Test Case 18 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c6d6a8f9467308308"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("9313225df88406e555909c5aff5269aa" %% IV + "6a7a9538534f7da1e4c303d2a318a728" + "c3c0c95156809539fcf0e2429a6b5254" + "16aedbf5a0de6a57a637b39b"), + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("5a8def2f0c9e53f1f75d7853659e2a20" %% CipherText + "eeb2b22aafde6419a058ab4f6f746bf4" + "0fc0c3b780f244452da3ebf1c5d82cde" + "a2418997200ef82e44ae7e3f"), + hexstr2bin("a44a8266ee1c8eb0c8b5d4cf5ae9f19a")} %% CipherTag + ]. + +%% http://tools.ietf.org/html/draft-agl-tls-chacha20poly1305-04 +chacha20_poly1305() -> + [ + {chacha20_poly1305, hexstr2bin("4290bcb154173531f314af57f3be3b500" %% Key + "6da371ece272afa1b5dbdd1100a1007"), + hexstr2bin("86d09974840bded2a5ca"), %% PlainText + hexstr2bin("cd7cf67be39c794a"), %% Nonce + hexstr2bin("87e229d4500845a079c0"), %% AAD + hexstr2bin("e3e446f7ede9a19b62a4"), %% CipherText + hexstr2bin("677dabf4e3d24b876bb284753896e1d6")} %% CipherTag + ]. + rsa_plain() -> <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" "09812312908312378623487263487623412039812 huagasd">>. diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl index 0076193725..e525484a8e 100644 --- a/lib/debugger/test/map_SUITE.erl +++ b/lib/debugger/test/map_SUITE.erl @@ -32,9 +32,30 @@ t_guard_receive/1, t_guard_fun/1, t_list_comprehension/1, t_map_sort_literals/1, - %t_size/1, t_map_size/1, - + t_build_and_match_aliasing/1, + + %% variables + t_build_and_match_variables/1, + t_update_assoc_variables/1,t_update_exact_variables/1, + t_nested_pattern_expressions/1, + t_guard_update_variables/1, + t_guard_sequence_variables/1, + t_guard_sequence_mixed/1, + t_frequency_table/1, + + %% not covered in 17.0-rc1 + t_build_and_match_over_alloc/1, + t_build_and_match_empty_val/1, + t_build_and_match_val/1, + t_build_and_match_nil/1, + t_build_and_match_structure/1, + + %% errors in 17.0-rc1 + t_update_values/1, + t_expand_map_update/1, + t_export/1, + %% Specific Map BIFs t_bif_map_get/1, t_bif_map_find/1, @@ -61,8 +82,7 @@ %% misc t_pdict/1, - t_ets/1, - t_dets/1 + t_ets/1 ]). -include_lib("stdlib/include/ms_transform.hrl"). @@ -77,7 +97,30 @@ all() -> [ t_guard_bifs, t_guard_sequence, t_guard_update, t_guard_receive,t_guard_fun, t_list_comprehension, t_map_sort_literals, - + t_build_and_match_aliasing, + + %% variables + t_build_and_match_variables, + t_update_assoc_variables,t_update_exact_variables, + t_nested_pattern_expressions, + t_guard_update_variables, + t_guard_sequence_variables, + t_guard_sequence_mixed, + t_frequency_table, + + %% not covered in 17.0-rc1 + t_build_and_match_over_alloc, + t_build_and_match_empty_val, + t_build_and_match_val, + t_build_and_match_nil, + t_build_and_match_structure, + + + %% errors in 17.0-rc1 + t_update_values, + t_expand_map_update, + t_export, + %% Specific Map BIFs t_bif_map_get,t_bif_map_find,t_bif_map_is_key, t_bif_map_keys, t_bif_map_merge, t_bif_map_new, @@ -94,7 +137,6 @@ all() -> [ t_maps_fold, t_maps_map, t_maps_size, t_maps_without, - %% Other functions t_pdict, t_ets @@ -147,18 +189,6 @@ t_build_and_match_literals(Config) when is_list(Config) -> {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), ok. - -%% Tests size(Map). -%% not implemented, perhaps it shouldn't be either - -%t_size(Config) when is_list(Config) -> -% 0 = size(#{}), -% 1 = size(#{a=>1}), -% 1 = size(#{a=>#{a=>1}}), -% 2 = size(#{a=>1, b=>2}), -% 3 = size(#{a=>1, b=>2, b=>"3"}), -% ok. - t_map_size(Config) when is_list(Config) -> 0 = map_size(id(#{})), 1 = map_size(id(#{a=>1})), @@ -268,6 +298,44 @@ t_update_exact(Config) when is_list(Config) -> ok. +t_update_values(Config) when is_list(Config) -> + V0 = id(1337), + M0 = #{ a => 1, val => V0}, + V1 = get_val(M0), + M1 = id(M0#{ val := [V0,V1], "wazzup" => 42 }), + [1337, {some_val, 1337}] = get_val(M1), + M2 = id(M1#{ <<42:333>> => 1337 }), + {bin_key,1337} = get_val(M2), + + N = 110, + List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)], + + {_,_,#{val2 := {1,2,3,"wat",N}, val1 := [N,1,2,3,N]}} = lists:foldl(fun + ({V2,V3},{Old2,Old3,Mi}) -> + ok = check_val(Mi,Old2,Old3), + #{ val1 := Old2, val2 := Old3 } = Mi, + {V2,V3, Mi#{ val1 := id(V2), val2 := V1, val2 => id(V3)}} + end, {none, none, #{val1=>none,val2=>none}},List), + ok. + +t_expand_map_update(Config) when is_list(Config) -> + M = #{<<"hello">> => <<"world">>}#{<<"hello">> := <<"les gens">>}, + #{<<"hello">> := <<"les gens">>} = M, + ok. + +t_export(Config) when is_list(Config) -> + Raclette = id(#{}), + case brie of brie -> Fromage = Raclette end, + Raclette = Fromage#{}, + ok. + +check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok. + +get_val(#{ <<42:333>> := V }) -> {bin_key, V}; +get_val(#{ "wazzup" := _, val := V}) -> V; +get_val(#{ val := V }) -> {some_val, V}. + + t_guard_bifs(Config) when is_list(Config) -> true = map_guard_head(#{a=>1}), false = map_guard_head([]), @@ -988,16 +1056,385 @@ t_ets(_Config) -> ets:delete(Tid), ok. -t_dets(_Config) -> +t_build_and_match_aliasing(Config) when is_list(Config) -> + M1 = id(#{a=>1,b=>2,c=>3,d=>4}), + #{c:=C1=_=_=C2} = M1, + true = C1 =:= C2, + #{a:=A,a:=A,a:=A,b:=B,b:=B} = M1, + #{a:=A,a:=A,a:=A,b:=B,b:=B,b:=2} = M1, + #{a:=A=1,a:=A,a:=A,b:=B=2,b:=B,b:=2} = M1, + #{c:=C1, c:=_, c:=3, c:=_, c:=C2} = M1, + #{c:=C=_=3=_=C} = M1, + + M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}), + #{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2, + #{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2, + ok. + +%% simple build and match variables +t_build_and_match_variables(Config) when is_list(Config) -> + K0 = id(#{}), + K1 = id(1), V1 = id(a), + K2 = id(2), V2 = id(b), + K3 = id(3), V3 = id("c"), + K4 = id("4"), V4 = id("d"), + K5 = id(<<"5">>), V5 = id(<<"e">>), + K6 = id({"6",7}), V6 = id("f"), + K7 = id(#{ "a" => 3 }), + #{K1:=V1} = id(#{K1=>V1}), + #{K1:=V1,K2:=V2} = id(#{K1=>V1,K2=>V2}), + #{K1:=V1,K2:=V2,K3:=V3} = id(#{K1=>V1,K2=>V2,K3=>V3}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5,K6:=V6} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5,K6=>V6}), + + #{K5:=X,K5:=X=3,K4:=4} = id(#{K5=>3,K4=>4}), + #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{K5=>3,K4=>4}), + #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{<<"5">>=>3,K4=>4}), + + #{ K4:=#{ K3:=#{K1:=V1, K2:=V2}}, K5:=V5} = + id(#{ K5=>V5, K4=>#{ K3=>#{K2 => V2, K1 => V1}}}), + #{ K4 := #{ K5 := Res }, K6 := Res} = id(#{K4=>#{K5 => 99}, K6 => 99}), + + %% has keys + #{a :=_,b :=_,K1:=_,K2:=_,K3:=V3,K4:=ResKey,K4:=ResKey,"4":=ResKey,"4":="ok"} = + id(#{ a=>1, b=>1, K1=>V1, K2=>V2, K3=>V3, K4=>"nope", "4"=>"ok" }), + + %% function + ok = match_function_map_neg_keys(#{ -1 => a, -2 => b, -3 => c }), + + %% map key + #{ K0 := 42 } = id(#{ K0 => 42 }), + #{ K7 := 42 } = id(#{ K7 => 42 }), + + %% nil key + KNIL = id([]), + #{KNIL:=ok,1:=2} = id(#{KNIL=>ok,1=>2}), + + Bin = <<0:258>>, + #{ Bin := "three" } = id(#{<<0:258>> =>"three"}), + + %% error case + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3,x:=2} = id(#{K5=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=2} = id(#{K5=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id({a,b,c}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(#{K6=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(K7))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K7:=3} = id(#{K7=>42}))), + ok. + + +match_function_map_neg_keys(#{ -1 := a, -2 := b, -3 := c }) -> ok. + +t_update_assoc_variables(Config) when is_list(Config) -> + K1 = id(1), + K2 = id(2), + K3 = id(3.0), + K4 = id(4), + K5 = id(5), + K6 = id(2.0), + + M0 = #{K1=>a,K2=>b,K3=>c,K4=>d,K5=>e}, + + M1 = M0#{K1=>42,K2=>100,K4=>[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + #{1:=42,2:=b,4:=d,5:=e,2.0:=100,K3:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,K6=>100,4.0=>[a,b,c]}, + + M2 = M0#{K3=>new}, + #{1:=a,2:=b,K3:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,K3=>new}, + + #{ <<0:258>> := val } = id(M0#{<<0:258>> => val}), %% binary limitation + + %% Errors cases. + BadMap = id(badmap), + {'EXIT',{{badarg,_},_}} = (catch BadMap#{nonexisting=>val}), + {'EXIT',{{badarg,_},_}} = (catch <<>>#{nonexisting=>val}), + ok. + +t_update_exact_variables(Config) when is_list(Config) -> + K1 = id(1), + K2 = id(2), + K3 = id(3.0), + K4 = id(4), + + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{K1:=42,K2:=100,K4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,K4:=[a,b,c],5:=e} = M1, + M1 = M0#{K1:=wrong,1:=also_wrong,K1=>42,2=>wrong,K2:=100,4:=[a,b,c]}, + + M2 = M0#{K3:=new}, + #{1:=a,K2:=b,3.0:=new,K4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,K3:=new}, + true = M2 =/= M0#{3=>right,3.0:=new}, + #{ 3 := right, 3.0 := new } = M0#{3=>right,K3:=new}, + + M3 = id(#{ 1 => val}), + #{1 := update2,1.0 := new_val4} = M3#{ + 1.0 => new_val1, K1 := update, K1=> update3, + K1 := update2, 1.0 := new_val2, 1.0 => new_val3, + 1.0 => new_val4 }, + + %% Errors cases. + {'EXIT',{{badarg,_},_}} = (catch ((id(nil))#{ a := b })), + {'EXIT',{{badarg,_},_}} = (catch <<>>#{nonexisting:=val}), + + {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation + ok. + +t_nested_pattern_expressions(Config) when is_list(Config) -> + K1 = id("hello"), + %K2 = id({ok}), + [_,_,#{ <<"hi">> := wat, K1 := 42 }|_] = id([k,k,#{<<"hi">> => wat, K1 => 42}]), + [_,_,#{ -1 := wat, K1 := 42 }|_] = id([k,k,#{-1 => wat, K1 => 42}]), + [_,_,{#{ -1 := #{ {-3,<<0:300>>} := V1 }, K1 := 42 },3}|_] = id([k,k,{#{-1 => #{{-3,<<0:300>>}=>"hi"}, K1 => 42},3}]), + "hi" = V1, + %[k,#{ {-1,K1,[]} := {wat,K1}, K2 := 42 }|_] = id([k,#{{-1,K1,[]} => {wat,K1}, K2 => 42}]), + %[k,#{ [-1,K2,[]] := {wat,K1}, K1 := 42 }|_] = id([k,#{[-1,K2,[]] => {wat,K1}, K1 => 42}]), + ok. + +t_guard_update_variables(Config) when is_list(Config) -> + error = map_guard_update_variables(n,#{},#{}), + first = map_guard_update_variables(x,#{}, #{x=>first}), + second = map_guard_update_variables(x,#{y=>old}, #{x=>second,y=>old}), + third = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>third,y=>old}), + fourth = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>4,y=>new}), + ok. + +map_guard_update_variables(K,M1,M2) when M1#{K=>first} =:= M2 -> first; +map_guard_update_variables(K,M1,M2) when M1#{K=>second} =:= M2 -> second; +map_guard_update_variables(K,M1,M2) when M1#{K:=third} =:= M2 -> third; +map_guard_update_variables(K,M1,M2) when M1#{K:=4,y=>new} =:= M2 -> fourth; +map_guard_update_variables(_,_,_) -> error. + +t_guard_sequence_variables(Config) when is_list(Config) -> + {1,"a"} = map_guard_sequence_var_1(a,#{seq=>1,a=>id("a"),b=>no}), + {2,"b"} = map_guard_sequence_var_1(b,#{seq=>2,b=>id("b"),a=>no}), + {3,"c"} = map_guard_sequence_var_1(a,#{seq=>3,a=>id("c"),b=>no}), + {4,"d"} = map_guard_sequence_var_1(b,#{seq=>4,b=>id("d"),a=>no}), + {4,4} = map_guard_sequence_var_1(seq,#{seq=>4}), + {4,4,y} = map_guard_sequence_var_1(seq,#{seq=>4,b=>id("d"),a=>y}), + {5,"d"} = map_guard_sequence_var_1(b,#{seq=>5,b=>id("d"),a=>y}), + + %% error case + {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_var_1("a",#{seq=>4,val=>id("e")})), + ok. + + +map_guard_sequence_var_1(K,M) -> + case M of + #{seq:=1=Seq, K:=Val} -> {Seq,Val}; + #{seq:=2=Seq, K:=Val} -> {Seq,Val}; + #{seq:=3=Seq, K:=Val} -> {Seq,Val}; + #{K:=4=Seq, K:=Val1,a:=Val2} -> {Seq,Val1,Val2}; + #{seq:=4=Seq, K:=Val} -> {Seq,Val}; + #{K:=4=Seq, K:=Val} -> {Seq,Val}; + #{seq:=5=Seq, K:=Val} -> {Seq,Val} + end. + + +t_guard_sequence_mixed(Config) when is_list(Config) -> + M0 = id(#{ a=>1, b=>1, c=>1, d=>1, e=>1, f=>1, g=>1, h=>1 }), + M1 = id(M0#{ d := 3 }), + 1 = map_guard_sequence_mixed(a,d,M1), + M2 = id(M1#{ b := 2, d := 4, h := 2 }), + 2 = map_guard_sequence_mixed(a,d,M2), + M3 = id(M2#{ b := 3, e := 5, g := 3 }), + 3 = map_guard_sequence_mixed(a,e,M3), + M4 = id(M3#{ c := 4, e := 6, h := 1 }), + 4 = map_guard_sequence_mixed(a,e,M4), + M5 = id(M4#{ c := 5, f := 7, g := 2 }), + 5 = map_guard_sequence_mixed(a,f,M5), + M6 = id(M5#{ c := 6, f := 8, h := 3 }), + 6 = map_guard_sequence_mixed(a,f,M6), + + %% error case + {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_mixed(a,b,M0)), + ok. + +map_guard_sequence_mixed(K1,K2,M) -> + case M of + #{ K1 := 1, b := 1, K2 := 3, g := 1} -> 1; + #{ K1 := 1, b := 2, K2 := 4, h := 2} -> 2; + #{ K1 := 1, b := 3, K2 := 5, g := 3} -> 3; + #{ K1 := 1, c := 4, K2 := 6, h := 1} -> 4; + #{ K1 := 1, c := 5, K2 := 7, g := 2} -> 5; + #{ K1 := 1, c := 6, K2 := 8, h := 3} -> 6 + end. + + + +t_frequency_table(Config) when is_list(Config) -> + random:seed({13,1337,54}), % pseudo random + N = 100000, + Ts = rand_terms(N), + #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}), + ok = check_frequency(Ts,Tf), + ok. + + +frequency_table([T|Ts], M) -> + case M of + #{ n := N, tf := #{ T := C } = F } -> + frequency_table(Ts,M#{ n := N + 1, tf := F#{ T := C + 1 }}); + #{ n := N, tf := F } -> + frequency_table(Ts,M#{ n := N + 1, tf := F#{ T => 1 }}) + end; +frequency_table([], M) -> M. + + +check_frequency(Ts,Tf) -> + check_frequency(Ts,Tf,dict:new()). + +check_frequency([T|Ts],Tf,D) -> + case dict:find(T,D) of + error -> check_frequency(Ts,Tf,dict:store(T,1,D)); + {ok,C} -> check_frequency(Ts,Tf,dict:store(T,C+1,D)) + end; +check_frequency([],Tf,D) -> + validate_frequency(dict:to_list(D),Tf). + +validate_frequency([{T,C}|Fs],Tf) -> + case Tf of + #{ T := C } -> validate_frequency(Fs,Tf); + _ -> error + end; +validate_frequency([], _) -> ok. + + +%% aux + +rand_terms(0) -> []; +rand_terms(N) -> [rand_term()|rand_terms(N-1)]. + +rand_term() -> + case random:uniform(6) of + 1 -> rand_binary(); + 2 -> rand_number(); + 3 -> rand_atom(); + 4 -> rand_tuple(); + 5 -> rand_list(); + 6 -> rand_map() + end. + +rand_binary() -> + case random:uniform(3) of + 1 -> <<>>; + 2 -> <<"hi">>; + 3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">> + end. + +rand_number() -> + case random:uniform(3) of + 1 -> random:uniform(5); + 2 -> float(random:uniform(5)); + 3 -> 1 bsl (63 + random:uniform(3)) + end. + +rand_atom() -> + case random:uniform(3) of + 1 -> hi; + 2 -> some_atom; + 3 -> some_other_atom + end. + + +rand_tuple() -> + case random:uniform(3) of + 1 -> {ok, rand_term()}; % careful + 2 -> {1, 2, 3}; + 3 -> {<<"yep">>, 1337} + end. + +rand_list() -> + case random:uniform(3) of + 1 -> "hi"; + 2 -> [1,rand_term()]; % careful + 3 -> [improper|list] + end. + +rand_map() -> + case random:uniform(3) of + 1 -> #{ hi => 3 }; + 2 -> #{ wat => rand_term(), other => 3 }; % careful + 3 -> #{ hi => 42, other => 42, yet_anoter => 1337 } + end. + + +t_build_and_match_over_alloc(Config) when is_list(Config) -> + Ls = id([1,2,3]), + V0 = [a|Ls], + M0 = id(#{ "a" => V0 }), + #{ "a" := V1 } = M0, + V2 = id([c|Ls]), + M2 = id(#{ "a" => V2 }), + #{ "a" := V3 } = M2, + {[a,1,2,3],[c,1,2,3]} = id({V1,V3}), + ok. + +t_build_and_match_empty_val(Config) when is_list(Config) -> + F = fun(#{ "hi":=_,{1,2}:=_,1337:=_}) -> ok end, + ok = F(id(#{"hi"=>ok,{1,2}=>ok,1337=>ok})), + + %% error case + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + +t_build_and_match_val(Config) when is_list(Config) -> + F = fun + (#{ "hi" := first, v := V}) -> {1,V}; + (#{ "hi" := second, v := V}) -> {2,V} + end, + + + {1,"hello"} = F(id(#{"hi"=>first,v=>"hello"})), + {2,"second"} = F(id(#{"hi"=>second,v=>"second"})), + + %% error case + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + +t_build_and_match_nil(Config) when is_list(Config) -> + %% literals removed the coverage + V1 = id(cookie), + V2 = id(cake), + V3 = id(crisps), + + #{ [] := V1, "treat" := V2, {your,treat} := V3 } = id(#{ + {your,treat} => V3, + "treat" => V2, + [] => V1 }), + #{ [] := V3, [] := V3 } = id(#{ [] => V1, [] => V3 }), + ok. + +t_build_and_match_structure(Config) when is_list(Config) -> + V2 = id("it"), + S = id([42,{"hi", "=)", #{ "a" => 42, any => any, val => "get_" ++ V2}}]), + + %% match deep map values + V2 = case S of + [42,{"hi",_, #{ "a" := 42, val := "get_" ++ V1, any := _ }}] -> V1 + end, + %% match deep map + ok = case S of + [42,{"hi",_, #{ }}] -> ok + end, ok. -getmsg(_Tracer) -> - receive V -> V after 100 -> timeout end. -trace_collector(Msg,Parent) -> - io:format("~p~n",[Msg]), - Parent ! Msg, - Parent. %% Use this function to avoid compile-time evaluation of an expression. id(I) -> I. diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index 1d458b49fc..bbedd3201e 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -102,14 +102,18 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest], #state{plt = Plt, codeserver = Codeserver, records = Records} = State, Acc) -> {{Behaviour, Function, Arity}, - {{_BehFile, _BehLine}, Callback}} = Cb, + {{_BehFile, _BehLine}, Callback, Xtra}} = Cb, CbMFA = {Module, Function, Arity}, CbReturnType = dialyzer_contracts:get_contract_return(Callback), CbArgTypes = dialyzer_contracts:get_contract_args(Callback), Acc0 = Acc, Acc1 = case dialyzer_plt:lookup(Plt, CbMFA) of - 'none' -> [{callback_missing, [Behaviour, Function, Arity]}|Acc0]; + 'none' -> + case lists:member(optional_callback, Xtra) of + true -> Acc0; + false -> [{callback_missing, [Behaviour, Function, Arity]}|Acc0] + end; {'value', RetArgTypes} -> Acc00 = Acc0, {ReturnType, ArgTypes} = RetArgTypes, @@ -137,7 +141,7 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest], Acc2 = case dialyzer_codeserver:lookup_mfa_contract(CbMFA, Codeserver) of 'error' -> Acc1; - {ok, {{File, Line}, Contract}} -> + {ok, {{File, Line}, Contract, _Xtra}} -> Acc10 = Acc1, SpecReturnType0 = dialyzer_contracts:get_contract_return(Contract), SpecArgTypes0 = dialyzer_contracts:get_contract_args(Contract), diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index aab3d6add6..593e71f30b 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -278,10 +278,10 @@ lookup_mod_contracts(Mod, #codeserver{contracts = ContDict}) case ets_dict_find(Mod, ContDict) of error -> dict:new(); {ok, Keys} -> - dict:from_list([get_contract_pair(Key, ContDict)|| Key <- Keys]) + dict:from_list([get_file_contract(Key, ContDict)|| Key <- Keys]) end. -get_contract_pair(Key, ContDict) -> +get_file_contract(Key, ContDict) -> {Key, ets:lookup_element(ContDict, Key, 2)}. -spec lookup_mfa_contract(mfa(), codeserver()) -> diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index f27fc1a842..ee147ca102 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -43,7 +43,7 @@ %% Types used in other parts of the system below %%----------------------------------------------------------------------- --type file_contract() :: {file_line(), #contract{}}. +-type file_contract() :: {file_line(), #contract{}, Extra :: [_]}. -type plt_contracts() :: [{mfa(), #contract{}}]. % actually, an orddict() @@ -146,10 +146,10 @@ process_contract_remote_types(CodeServer) -> ExpTypes = dialyzer_codeserver:get_exported_types(CodeServer), RecordDict = dialyzer_codeserver:get_records(CodeServer), ContractFun = - fun({_M, _F, _A}, {File, #tmp_contract{contract_funs = CFuns, forms = Forms}}) -> + fun({_M, _F, _A}, {File, #tmp_contract{contract_funs = CFuns, forms = Forms}, Xtra}) -> NewCs = [CFun(ExpTypes, RecordDict) || CFun <- CFuns], Args = general_domain(NewCs), - {File, #contract{contracts = NewCs, args = Args, forms = Forms}} + {File, #contract{contracts = NewCs, args = Args, forms = Forms}, Xtra} end, ModuleFun = fun(_ModuleName, ContractDict) -> @@ -175,7 +175,7 @@ check_contracts(Contracts, Callgraph, FunTypes, FindOpaques) -> case dialyzer_callgraph:lookup_name(Label, Callgraph) of {ok, {M,F,A} = MFA} -> case orddict:find(MFA, Contracts) of - {ok, {_FileLine, Contract}} -> + {ok, {_FileLine, Contract, _Xtra}} -> Opaques = FindOpaques(M), case check_contract(Contract, Type, Opaques) of ok -> @@ -362,7 +362,7 @@ contracts_without_fun(Contracts, AllFuns0, Callgraph) -> [warn_spec_missing_fun(MFA, Contracts) || MFA <- ErrorContractMFAs]. warn_spec_missing_fun({M, F, A} = MFA, Contracts) -> - {FileLine, _Contract} = dict:fetch(MFA, Contracts), + {FileLine, _Contract, _Xtra} = dict:fetch(MFA, Contracts), {?WARN_CONTRACT_SYNTAX, FileLine, {spec_missing_fun, [M, F, A]}}. %% This treats the "when" constraints. It will be extended, we hope. @@ -386,14 +386,16 @@ insert_constraints([], Dict) -> Dict. -type types() :: erl_types:type_table(). --spec store_tmp_contract(mfa(), file_line(), [_], contracts(), types()) -> +-type spec_data() :: {TypeSpec :: [_], Xtra:: [_]}. + +-spec store_tmp_contract(mfa(), file_line(), spec_data(), contracts(), types()) -> contracts(). -store_tmp_contract(MFA, FileLine, TypeSpec, SpecDict, RecordsDict) -> +store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecDict, RecordsDict) -> %% io:format("contract from form: ~p\n", [TypeSpec]), TmpContract = contract_from_form(TypeSpec, RecordsDict, FileLine), %% io:format("contract: ~p\n", [TmpContract]), - dict:store(MFA, {FileLine, TmpContract}, SpecDict). + dict:store(MFA, {FileLine, TmpContract, Xtra}, SpecDict). contract_from_form(Forms, RecDict, FileLine) -> {CFuns, Forms1} = contract_from_form(Forms, RecDict, FileLine, [], []), @@ -597,7 +599,7 @@ get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, FindOpaques, get_invalid_contract_warnings_modules([], _CodeServer, _Plt, _FindOpaques, Acc) -> Acc. -get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract}}|Left], +get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left], Plt, RecDict, FindOpaques, Acc) -> case dialyzer_plt:lookup(Plt, MFA) of none -> diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 03005e689f..46467a1303 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -2781,8 +2781,7 @@ filter_match_fail([]) -> %%% =========================================================================== state__new(Callgraph, Tree, Plt, Module, Records) -> - Opaques = erl_types:module_builtin_opaques(Module) ++ - erl_types:t_opaque_from_records(Records), + Opaques = erl_types:t_opaque_from_records(Records), TreeMap = build_tree_map(Tree), Funs = dict:fetch_keys(TreeMap), FunTab = init_fun_tab(Funs, dict:new(), TreeMap, Callgraph, Plt), diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index 63798f44b1..7c970daf41 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -158,9 +158,7 @@ lookup_contract(#mini_plt{contracts = ETSContracts}, ets_table_lookup(ETSContracts, MFA). -spec lookup_callbacks(plt(), module()) -> - 'none' | {'value', [{mfa(), {{Filename::string(), - Line::pos_integer()}, - #contract{}}}]}. + 'none' | {'value', [{mfa(), dialyzer_contracts:file_contract()}]}. lookup_callbacks(#mini_plt{callbacks = ETSCallbacks}, Mod) when is_atom(Mod) -> ets_table_lookup(ETSCallbacks, Mod). @@ -618,9 +616,7 @@ table_insert_list(Plt, [{Key, Val}|Left]) -> table_insert_list(Plt, []) -> Plt. -table_insert(Plt, Key, {_Ret, _Arg} = Obj) -> - dict:store(Key, Obj, Plt); -table_insert(Plt, Key, #contract{} = C) -> +table_insert(Plt, Key, {_File, #contract{}, _Xtra} = C) -> dict:store(Key, C, Plt). table_lookup(Plt, Obj) -> diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index ef9b00e203..6dc4285194 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -201,7 +201,7 @@ postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {CallF, CallL}, Msg}|Rest], Codeserver, WAcc, Acc) -> {contract_range, [Contract, M, F, A, ArgStrings, CRet]} = Msg, case dialyzer_codeserver:lookup_mfa_contract({M,F,A}, Codeserver) of - {ok, {{ContrF, _ContrL} = FileLine, _C}} -> + {ok, {{ContrF, _ContrL} = FileLine, _C, _X}} -> case CallF =:= ContrF of true -> NewMsg = {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]}, @@ -401,7 +401,7 @@ decorate_succ_typings(Contracts, Callgraph, FunTypes, FindOpaques) -> case dialyzer_callgraph:lookup_name(Label, Callgraph) of {ok, MFA} -> case orddict:find(MFA, Contracts) of - {ok, {_FileLine, Contract}} -> + {ok, {_FileLine, Contract, _Xtra}} -> Args = dialyzer_contracts:get_contract_args(Contract), Ret = dialyzer_contracts:get_contract_return(Contract), C = erl_types:t_fun(Args, Ret), @@ -422,10 +422,7 @@ lookup_and_find_opaques_fun(Codeserver) -> end. find_opaques_fun(Records) -> - fun(Module) -> - erl_types:module_builtin_opaques(Module) ++ - erl_types:t_opaque_from_records(Records) - end. + fun(_Module) -> erl_types:t_opaque_from_records(Records) end. get_fun_types_from_plt(FunList, Callgraph, Plt) -> get_fun_types_from_plt(FunList, Callgraph, Plt, dict:new()). diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 5297a3a7b4..e5f5c69d45 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -345,8 +345,26 @@ merge_records(NewRecords, OldRecords) -> {'ok', spec_dict(), callback_dict()} | {'error', string()}. get_spec_info(ModName, AbstractCode, RecordsDict) -> + OptionalCallbacks0 = get_optional_callbacks(AbstractCode, ModName), + OptionalCallbacks = gb_sets:from_list(OptionalCallbacks0), get_spec_info(AbstractCode, dict:new(), dict:new(), - RecordsDict, ModName, "nofile"). + RecordsDict, ModName, OptionalCallbacks, "nofile"). + +get_optional_callbacks(Abs, ModName) -> + [{ModName, F, A} || {F, A} <- get_optional_callbacks(Abs)]. + +get_optional_callbacks(Abs) -> + L = [O || + {attribute, _, optional_callbacks, O} <- Abs, + is_fa_list(O)], + lists:append(L). + +is_fa_list([{FuncName, Arity}|L]) + when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> + is_fa_list(L); +is_fa_list([]) -> true; +is_fa_list(_) -> false. + %% TypeSpec is a list of conditional contracts for a function. %% Each contract is of the form {[Argument], Range, [Constraint]} where @@ -355,13 +373,14 @@ get_spec_info(ModName, AbstractCode, RecordsDict) -> %% are erl_types:erl_type() get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left], - SpecDict, CallbackDict, RecordsDict, ModName, File) + SpecDict, CallbackDict, RecordsDict, ModName, OptCb, File) when ((Contract =:= 'spec') or (Contract =:= 'callback')), is_list(TypeSpec) -> MFA = case Id of {_, _, _} = T -> T; {F, A} -> {ModName, F, A} end, + Xtra = [optional_callback || gb_sets:is_member(MFA, OptCb)], ActiveDict = case Contract of spec -> SpecDict; @@ -369,8 +388,9 @@ get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left], end, try dict:find(MFA, ActiveDict) of error -> + SpecData = {TypeSpec, Xtra}, NewActiveDict = - dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, TypeSpec, + dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, SpecData, ActiveDict, RecordsDict), {NewSpecDict, NewCallbackDict} = case Contract of @@ -378,8 +398,8 @@ get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left], callback -> {SpecDict, NewActiveDict} end, get_spec_info(Left, NewSpecDict, NewCallbackDict, - RecordsDict, ModName,File); - {ok, {{OtherFile, L},_C}} -> + RecordsDict, ModName, OptCb, File); + {ok, {{OtherFile, L}, _D}} -> {Mod, Fun, Arity} = MFA, Msg = flat_format(" Contract/callback for function ~w:~w/~w " "already defined in ~s:~w\n", @@ -391,13 +411,15 @@ get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left], [Ln, Error])} end; get_spec_info([{attribute, _, file, {IncludeFile, _}}|Left], - SpecDict, CallbackDict, RecordsDict, ModName, _File) -> + SpecDict, CallbackDict, RecordsDict, ModName, OptCb, _File) -> get_spec_info(Left, SpecDict, CallbackDict, - RecordsDict, ModName, IncludeFile); + RecordsDict, ModName, OptCb, IncludeFile); get_spec_info([_Other|Left], SpecDict, CallbackDict, - RecordsDict, ModName, File) -> - get_spec_info(Left, SpecDict, CallbackDict, RecordsDict, ModName, File); -get_spec_info([], SpecDict, CallbackDict, _RecordsDict, _ModName, _File) -> + RecordsDict, ModName, OptCb, File) -> + get_spec_info(Left, SpecDict, CallbackDict, + RecordsDict, ModName, OptCb, File); +get_spec_info([], SpecDict, CallbackDict, + _RecordsDict, _ModName, _OptCb, _File) -> {ok, SpecDict, CallbackDict}. %% ============================================================================ @@ -449,7 +471,6 @@ cleanup_compile_options(Opts) -> %% Using abstract, not asm or core. keep_compile_option(from_asm) -> false; -keep_compile_option(asm) -> false; keep_compile_option(from_core) -> false; %% The parse transform will already have been applied, may cause %% problems if it is re-applied. diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return index e89caf3cf7..4103a2d8b4 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(),non_neg_integer()} | {'one_for_one',non_neg_integer(),non_neg_integer()} | {'rest_for_one',non_neg_integer(),non_neg_integer()} | {'simple_one_for_one',non_neg_integer(),non_neg_integer()},[{_,{atom() | tuple(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom() | tuple()]}]}}, 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()} | #{},[{_,{atom() | tuple(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom() | tuple()]} | #{}]}}, which is the expected return type for the callback of supervisor behaviour diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/custom_sup.erl b/lib/dialyzer/test/behaviour_SUITE_data/src/custom_sup.erl index 76da1fda70..401ee88eab 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/src/custom_sup.erl +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/custom_sup.erl @@ -13,7 +13,7 @@ -export([init/1]). -spec init(atom()) -> - {ok, {{supervisor:strategy(), non_neg_integer(), non_neg_integer()}, + {ok, {{supervisor:strategy(), non_neg_integer(), pos_integer()}, [supervisor:child_spec()]}} | ignore. init(StorageName) -> diff --git a/lib/dialyzer/test/small_SUITE_data/results/behaviour_info b/lib/dialyzer/test/small_SUITE_data/results/behaviour_info new file mode 100644 index 0000000000..2da4d26acb --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/behaviour_info @@ -0,0 +1,2 @@ + +with_bad_format_status.erl:12: The inferred type for the 1st argument of format_status/2 ('bad_arg') is not a supertype of 'normal' | 'terminate', which is expected type for this argument in the callback of the gen_server behaviour diff --git a/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_bad_format_status.erl b/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_bad_format_status.erl new file mode 100644 index 0000000000..24591e08fa --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_bad_format_status.erl @@ -0,0 +1,12 @@ +-module(with_bad_format_status). + +-behaviour(gen_server). +-export([handle_call/3,handle_cast/2,handle_info/2, + code_change/3, init/1, terminate/2, format_status/2]). +handle_call(_, _, S) -> {noreply, S}. +handle_cast(_, S) -> {noreply, S}. +handle_info(_, S) -> {noreply, S}. +code_change(_, _, _) -> {error, not_implemented}. +init(_) -> {ok, state}. +terminate(_, _) -> ok. +format_status(bad_arg, _) -> ok. % optional callback diff --git a/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_format_status.erl b/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_format_status.erl new file mode 100644 index 0000000000..a56ff63d1d --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_format_status.erl @@ -0,0 +1,13 @@ +-module(with_format_status). + +-behaviour(gen_server). +-export([handle_call/3,handle_cast/2,handle_info/2, + code_change/3, init/1, terminate/2, format_status/2]). +-export([handle_call/3,handle_cast/2,handle_info/2]). +handle_call(_, _, S) -> {noreply, S}. +handle_cast(_, S) -> {noreply, S}. +handle_info(_, S) -> {noreply, S}. +code_change(_, _, _) -> {error, not_implemented}. +init(_) -> {ok, state}. +terminate(_, _) -> ok. +format_status(normal, _) -> ok. % optional callback diff --git a/lib/dialyzer/test/small_SUITE_data/src/predef2.erl b/lib/dialyzer/test/small_SUITE_data/src/predef2.erl deleted file mode 100644 index b1d941a49a..0000000000 --- a/lib/dialyzer/test/small_SUITE_data/src/predef2.erl +++ /dev/null @@ -1,56 +0,0 @@ --module(predef2). - --export([array/1, dict/1, digraph/1, digraph2/1, gb_set/1, gb_tree/1, - queue/1, set/1, tid/0, tid2/0]). - --export_type([array/0, digraph/0, gb_set/0]). - --spec array(array()) -> array:array(). - -array(A) -> - array:relax(A). - --spec dict(dict()) -> dict:dict(). - -dict(D) -> - dict:store(1, a, D). - --spec digraph(digraph()) -> [digraph:edge()]. - -digraph(G) -> - digraph:edges(G). - --spec digraph2(digraph:graph()) -> [digraph:edge()]. - -digraph2(G) -> - digraph:edges(G). - --spec gb_set(gb_set()) -> gb_sets:set(). - -gb_set(S) -> - gb_sets:balance(S). - --spec gb_tree(gb_tree()) -> gb_trees:tree(). - -gb_tree(S) -> - gb_trees:balance(S). - --spec queue(queue()) -> queue:queue(). - -queue(Q) -> - queue:reverse(Q). - --spec set(set()) -> sets:set(). - -set(S) -> - sets:union([S]). - --spec tid() -> tid(). - -tid() -> - ets:new(tid, []). - --spec tid2() -> ets:tid(). - -tid2() -> - ets:new(tid, []). diff --git a/lib/edoc/src/edoc_data.erl b/lib/edoc/src/edoc_data.erl index f88ba05f4b..eceb5cb1bd 100644 --- a/lib/edoc/src/edoc_data.erl +++ b/lib/edoc/src/edoc_data.erl @@ -173,21 +173,34 @@ callbacks(Es, Module, Env, Opts) -> lists:keymember(callback, 1, Module#module.attributes) of true -> - try (Module#module.name):behaviour_info(callbacks) of - Fs -> - Fs1 = [{F,A} || {F,A} <- Fs, is_atom(F), is_integer(A)], - if Fs1 =:= [] -> - []; - true -> - [{callbacks, - [callback(F, Env, Opts) || F <- Fs1]}] - end - catch - _:_ -> [] - end; + M = Module#module.name, + Fs = get_callback_functions(M, callbacks), + Os1 = get_callback_functions(M, optional_callbacks), + Fs1 = [FA || FA <- Fs, not lists:member(FA, Os1)], + Req = if Fs1 =:= [] -> + []; + true -> + [{callbacks, + [callback(FA, Env, Opts) || FA <- Fs1]}] + end, + Opt = if Os1 =:= [] -> + []; + true -> + [{optional_callbacks, + [callback(FA, Env, Opts) || FA <- Os1]}] + end, + Req ++ Opt; false -> [] end. +get_callback_functions(M, Callbacks) -> + try + [FA || {F, A} = FA <- M:behaviour_info(Callbacks), + is_atom(F), is_integer(A), A >= 0] + catch + _:_ -> [] + end. + %% <!ELEMENT callback EMPTY> %% <!ATTLIST callback %% name CDATA #REQUIRED diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index a102d432bc..36d067d9bc 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -701,6 +701,8 @@ deprecated(Es, S) -> end. behaviours(Es, Name) -> + CBs = get_content(callbacks, Es), + OCBs = get_content(optional_callbacks, Es), (case get_elem(behaviour, Es) of [] -> []; Es1 -> @@ -709,13 +711,24 @@ behaviours(Es, Name) -> ?NL] end ++ - case get_content(callbacks, Es) of - [] -> []; - Es1 -> + if CBs =:= [], OCBs =:= [] -> + []; + true -> + Req = if CBs =:= [] -> + []; + true -> + [br, " Required callback functions: "] + ++ seq(fun callback/1, CBs, ["."]) + end, + Opt = if OCBs =:= [] -> + []; + true -> + [br, " Optional callback functions: "] + ++ seq(fun callback/1, OCBs, ["."]) + end, [{p, ([{b, ["This module defines the ", {tt, [Name]}, - " behaviour."]}, - br, " Required callback functions: "] - ++ seq(fun callback/1, Es1, ["."]))}, + " behaviour."]}] + ++ Req ++ Opt)}, ?NL] end). diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index 211a354c74..3bf81c6503 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -362,7 +362,7 @@ d2e({type,_,map,any}) -> #t_map{ types = []}; d2e({type,_,map,Es}) -> #t_map{ types = d2e(Es) }; -d2e({type,_,map_field_assoc,K,V}) -> +d2e({type,_,map_field_assoc,[K,V]}) -> #t_map_field{ k_type = d2e(K), v_type=d2e(V) }; d2e({type,_,map_field_exact,K,V}) -> #t_map_field{ k_type = d2e(K), v_type=d2e(V) }; @@ -388,6 +388,9 @@ d2e({record_field,L,_Name}=F) -> d2e({type,_,Name,Types0}) -> Types = d2e(Types0), typevar_anno(#t_type{name = #t_name{name = Name}, args = Types}, Types); +d2e({user_type,_,Name,Types0}) -> + Types = d2e(Types0), + typevar_anno(#t_type{name = #t_name{name = Name}, args = Types}, Types); d2e({var,_,'_'}) -> #t_type{name = #t_name{name = ?TOP_TYPE}}; d2e({var,_,TypeName}) -> diff --git a/lib/edoc/src/edoc_tags.erl b/lib/edoc/src/edoc_tags.erl index 264a533a52..82a1b72d84 100644 --- a/lib/edoc/src/edoc_tags.erl +++ b/lib/edoc/src/edoc_tags.erl @@ -329,10 +329,7 @@ parse_typedef(Data, Line, _Env, Where) -> NAs = length(As), case edoc_types:is_predefined(T, NAs) of true -> - case - edoc_types:is_new_predefined(T, NAs) - orelse edoc_types:is_predefined_otp_type(T, NAs) - of + case edoc_types:is_new_predefined(T, NAs) of false -> throw_error(Line, {"redefining built-in type '~w'.", [T]}); @@ -499,7 +496,6 @@ check_used_type(#t_name{name = N, module = Mod}=Name, Args, P, LocalTypes) -> Mod =/= [] orelse lists:member(TypeName, ets:lookup(DT, Name)) orelse edoc_types:is_predefined(N, NArgs) - orelse edoc_types:is_predefined_otp_type(N, NArgs) orelse lists:member(TypeName, LocalTypes) of true -> diff --git a/lib/edoc/src/edoc_types.erl b/lib/edoc/src/edoc_types.erl index 8a6c8eb33e..65fba61a72 100644 --- a/lib/edoc/src/edoc_types.erl +++ b/lib/edoc/src/edoc_types.erl @@ -25,7 +25,7 @@ -module(edoc_types). --export([is_predefined/2, is_new_predefined/2, is_predefined_otp_type/2, +-export([is_predefined/2, is_new_predefined/2, to_ref/1, to_xml/2, to_label/1, arg_names/1, set_arg_names/2, arg_descs/1, range_desc/1]). @@ -34,67 +34,13 @@ -include("edoc_types.hrl"). -include_lib("xmerl/include/xmerl.hrl"). - -is_predefined(any, 0) -> true; -is_predefined(atom, 0) -> true; -is_predefined(binary, 0) -> true; -is_predefined(bool, 0) -> true; % kept for backwards compatibility -is_predefined(char, 0) -> true; is_predefined(cons, 2) -> true; is_predefined(deep_string, 0) -> true; -is_predefined(float, 0) -> true; -is_predefined(function, 0) -> true; -is_predefined(integer, 0) -> true; -is_predefined(list, 0) -> true; -is_predefined(list, 1) -> true; -is_predefined(nil, 0) -> true; -is_predefined(none, 0) -> true; -is_predefined(no_return, 0) -> true; -is_predefined(number, 0) -> true; -is_predefined(pid, 0) -> true; -is_predefined(port, 0) -> true; -is_predefined(reference, 0) -> true; -is_predefined(string, 0) -> true; -is_predefined(term, 0) -> true; -is_predefined(tuple, 0) -> true; -is_predefined(F, A) -> is_new_predefined(F, A). +is_predefined(F, A) -> erl_internal:is_type(F, A). -%% Should eventually be coalesced with is_predefined/2. -is_new_predefined(arity, 0) -> true; -is_new_predefined(bitstring, 0) -> true; -is_new_predefined(boolean, 0) -> true; -is_new_predefined(byte, 0) -> true; -is_new_predefined(iodata, 0) -> true; -is_new_predefined(iolist, 0) -> true; is_new_predefined(map, 0) -> true; -is_new_predefined(maybe_improper_list, 0) -> true; -is_new_predefined(maybe_improper_list, 2) -> true; -is_new_predefined(mfa, 0) -> true; -is_new_predefined(module, 0) -> true; -is_new_predefined(neg_integer, 0) -> true; -is_new_predefined(node, 0) -> true; -is_new_predefined(non_neg_integer, 0) -> true; -is_new_predefined(nonempty_improper_list, 2) -> true; -is_new_predefined(nonempty_list, 0) -> true; -is_new_predefined(nonempty_list, 1) -> true; -is_new_predefined(nonempty_maybe_improper_list, 0) -> true; -is_new_predefined(nonempty_maybe_improper_list, 2) -> true; -is_new_predefined(nonempty_string, 0) -> true; -is_new_predefined(pos_integer, 0) -> true; -is_new_predefined(timeout, 0) -> true; is_new_predefined(_, _) -> false. -%% The following types will be removed later, but they are currently -%% kind of built-in. -is_predefined_otp_type(array, 0) -> true; -is_predefined_otp_type(dict, 0) -> true; -is_predefined_otp_type(digraph, 0) -> true; -is_predefined_otp_type(gb_set, 0) -> true; -is_predefined_otp_type(gb_tree, 0) -> true; -is_predefined_otp_type(queue, 0) -> true; -is_predefined_otp_type(set, 0) -> true; -is_predefined_otp_type(_, _) -> false. - to_ref(#t_typedef{name = N}) -> to_ref(N); to_ref(#t_def{name = N}) -> @@ -129,8 +75,7 @@ to_xml(#t_type{name = N, args = As}, Env) -> Predef = case N of #t_name{module = [], name = T} -> NArgs = length(As), - (is_predefined(T, NArgs) - orelse is_predefined_otp_type(T, NArgs)); + is_predefined(T, NArgs); _ -> false end, diff --git a/lib/eldap/asn1/ELDAPv3.asn1 b/lib/eldap/asn1/ELDAPv3.asn1 index 72b87d7221..3fe7e815cc 100644 --- a/lib/eldap/asn1/ELDAPv3.asn1 +++ b/lib/eldap/asn1/ELDAPv3.asn1 @@ -274,5 +274,17 @@ IntermediateResponse ::= [APPLICATION 25] SEQUENCE { responseName [0] LDAPOID OPTIONAL, responseValue [1] OCTET STRING OPTIONAL } +-- Extended syntax for Password Modify (RFC 3062, Section 2) + +-- passwdModifyOID OBJECT IDENTIFIER ::= 1.3.6.1.4.1.4203.1.11.1 + +PasswdModifyRequestValue ::= SEQUENCE { + userIdentity [0] OCTET STRING OPTIONAL, + oldPasswd [1] OCTET STRING OPTIONAL, + newPasswd [2] OCTET STRING OPTIONAL } + +PasswdModifyResponseValue ::= SEQUENCE { + genPasswd [0] OCTET STRING OPTIONAL } + END diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml index 4417551aa8..718a8afeec 100644 --- a/lib/eldap/doc/src/eldap.xml +++ b/lib/eldap/doc/src/eldap.xml @@ -214,6 +214,46 @@ filter() See present/1, substrings/2, </desc> </func> <func> + <name>modify_password(Handle, Dn, NewPasswd) -> ok | {ok, GenPasswd} | {error, Reason}</name> + <fsummary>Modify the password of a user.</fsummary> + <type> + <v>Dn = string()</v> + <v>NewPasswd = string()</v> + </type> + <desc> + <p>Modify the password of a user. See <seealso marker="#modify_password/4">modify_password/4</seealso>.</p> + </desc> + </func> + <func> + <name>modify_password(Handle, Dn, NewPasswd, OldPasswd) -> ok | {ok, GenPasswd} | {error, Reason}</name> + <fsummary>Modify the password of a user.</fsummary> + <type> + <v>Dn = string()</v> + <v>NewPasswd = string()</v> + <v>OldPasswd = string()</v> + <v>GenPasswd = string()</v> + </type> + <desc> + <p>Modify the password of a user.</p> + <list type="bulleted"> + <item> + <p><c>Dn</c>. The user to modify. Should be "" if the + modify request is for the user of the LDAP session.</p> + </item> + <item> + <p><c>NewPasswd</c>. The new password to set. Should be "" + if the server is to generate the password. In this case, + the result will be <c>{ok, GenPasswd}</c>.</p> + </item> + <item> + <p><c>OldPasswd</c>. Sometimes required by server policy + for a user to change their password. If not required, use + <seealso marker="#modify_password/3">modify_password/3</seealso>.</p> + </item> + </list> + </desc> + </func> + <func> <name>modify_dn(Handle, Dn, NewRDN, DeleteOldRDN, NewSupDN) -> ok | {error, Reason}</name> <fsummary>Modify the DN of an entry.</fsummary> <type> diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 3fa440d37d..66f80d8d8f 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -12,6 +12,7 @@ -vc('$Id$ '). -export([open/1,open/2,simple_bind/3,controlling_process/2, start_tls/2, start_tls/3, + modify_password/3, modify_password/4, getopts/2, baseObject/0,singleLevel/0,wholeSubtree/0,close/1, equalityMatch/2,greaterOrEqual/2,lessOrEqual/2, @@ -94,6 +95,23 @@ start_tls(Handle, TlsOptions, Timeout) -> recv(Handle). %%% -------------------------------------------------------------------- +%%% Modify the password of a user. +%%% +%%% Dn - Name of the entry to modify. If empty, the session user. +%%% NewPasswd - New password. If empty, the server returns a new password. +%%% OldPasswd - Original password for server verification, may be empty. +%%% +%%% Returns: ok | {ok, GenPasswd} | {error, term()} +%%% -------------------------------------------------------------------- +modify_password(Handle, Dn, NewPasswd) -> + modify_password(Handle, Dn, NewPasswd, []). + +modify_password(Handle, Dn, NewPasswd, OldPasswd) + when is_pid(Handle), is_list(Dn), is_list(NewPasswd), is_list(OldPasswd) -> + send(Handle, {passwd_modify,optional(Dn),optional(NewPasswd),optional(OldPasswd)}), + recv(Handle). + +%%% -------------------------------------------------------------------- %%% Ask for option values on the socket. %%% Warning: This is an undocumented function for testing purposes only. %%% Use at own risk... @@ -505,6 +523,11 @@ loop(Cpid, Data) -> send(From,Res), ?MODULE:loop(Cpid, NewData); + {From, {passwd_modify,Dn,NewPasswd,OldPasswd}} -> + {Res,NewData} = do_passwd_modify(Data, Dn, NewPasswd, OldPasswd), + send(From, Res), + ?MODULE:loop(Cpid, NewData); + {_From, close} -> unlink(Cpid), exit(closed); @@ -795,6 +818,60 @@ do_modify_0(Data, Obj, Mod) -> check_reply(Data#eldap{id = Id}, Resp, modifyResponse). %%% -------------------------------------------------------------------- +%%% PasswdModifyRequest +%%% -------------------------------------------------------------------- + +-define(PASSWD_MODIFY_OID, "1.3.6.1.4.1.4203.1.11.1"). + +do_passwd_modify(Data, Dn, NewPasswd, OldPasswd) -> + case catch do_passwd_modify_0(Data, Dn, NewPasswd, OldPasswd) of + {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; + {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; + {ok,NewData} -> {ok,NewData}; + {ok,Passwd,NewData} -> {{ok, Passwd},NewData}; + Else -> {ldap_closed_p(Data, Else),Data} + end. + +do_passwd_modify_0(Data, Dn, NewPasswd, OldPasswd) -> + Req = #'PasswdModifyRequestValue'{userIdentity = Dn, + oldPasswd = OldPasswd, + newPasswd = NewPasswd}, + log2(Data, "modify password request = ~p~n", [Req]), + {ok, Bytes} = 'ELDAPv3':encode('PasswdModifyRequestValue', Req), + ExtReq = #'ExtendedRequest'{requestName = ?PASSWD_MODIFY_OID, + requestValue = Bytes}, + Id = bump_id(Data), + log2(Data, "extended request = ~p~n", [ExtReq]), + Reply = request(Data#eldap.fd, Data, Id, {extendedReq, ExtReq}), + log2(Data, "modify password reply = ~p~n", [Reply]), + exec_passwd_modify_reply(Data#eldap{id = Id}, Reply). + +exec_passwd_modify_reply(Data, {ok,Msg}) when + Msg#'LDAPMessage'.messageID == Data#eldap.id -> + case Msg#'LDAPMessage'.protocolOp of + {extendedResp, Result} -> + case Result#'ExtendedResponse'.resultCode of + success -> + case Result#'ExtendedResponse'.responseValue of + asn1_NOVALUE -> + {ok, Data}; + Value -> + case 'ELDAPv3':decode('PasswdModifyResponseValue', Value) of + {ok,#'PasswdModifyResponseValue'{genPasswd = Passwd}} -> + {ok, Passwd, Data}; + Error -> + throw(Error) + end + end; + Error -> + {error, {response,Error}} + end; + Other -> {error, Other} + end; +exec_passwd_modify_reply(_, Error) -> + {error, Error}. + +%%% -------------------------------------------------------------------- %%% modifyDNRequest %%% -------------------------------------------------------------------- diff --git a/lib/eldap/test/eldap_basic_SUITE.erl b/lib/eldap/test/eldap_basic_SUITE.erl index d87f3ac4ac..7f2be54b71 100644 --- a/lib/eldap/test/eldap_basic_SUITE.erl +++ b/lib/eldap/test/eldap_basic_SUITE.erl @@ -200,6 +200,7 @@ do_api_checks(H, Config) -> chk_add(H, BasePath), {ok,FB} = chk_search(H, BasePath), chk_modify(H, FB), + chk_modify_password(H, FB), chk_delete(H, BasePath), chk_modify_dn(H, FB). @@ -250,6 +251,23 @@ chk_modify(H, FB) -> %% DELETE ATTR ok = eldap:modify(H, FB, [eldap:mod_delete("telephoneNumber", [])]). +chk_modify_password(H, FB) -> + %% Change password, and ensure we can bind with it. + ok = eldap:simple_bind(H, "cn=Manager,dc=ericsson,dc=se", "hejsan"), + ok = eldap:modify_password(H, FB, "example"), + ok = eldap:simple_bind(H, FB, "example"), + %% Change password to a server generated value. + ok = eldap:simple_bind(H, "cn=Manager,dc=ericsson,dc=se", "hejsan"), + {ok, Passwd} = eldap:modify_password(H, FB, []), + ok = eldap:simple_bind(H, FB, Passwd), + %% Change own password to server generated value. + {ok, NewPasswd} = eldap:modify_password(H, [], [], Passwd), + ok = eldap:simple_bind(H, FB, NewPasswd), + %% Change own password to explicit value. + ok = eldap:modify_password(H, [], "example", NewPasswd), + ok = eldap:simple_bind(H, FB, "example"), + %% Restore original binding. + ok = eldap:simple_bind(H, "cn=Manager,dc=ericsson,dc=se", "hejsan"). chk_delete(H, BasePath) -> {error, entryAlreadyExists} = eldap:add(H, "cn=Jonas Jonsson," ++ BasePath, diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl index 1075c47801..e2eee2b3c0 100644 --- a/lib/erl_docgen/src/docgen_otp_specs.erl +++ b/lib/erl_docgen/src/docgen_otp_specs.erl @@ -616,7 +616,7 @@ ot_map(Es) -> {type,0,map,[ot_map_field(E) || E <- get_elem(map_field,Es)]}. ot_map_field(#xmlElement{content=[K,V]}) -> - {type,0,map_field_assoc, ot_utype_elem(K), ot_utype_elem(V)}. + {type,0,map_field_assoc,[ot_utype_elem(K),ot_utype_elem(V)]}. ot_fun(Es) -> Range = ot_utype(get_elem(type, Es)), diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 4b2bec5fa8..5124e7238a 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -40,7 +40,6 @@ any_none_or_unit/1, lookup_record/3, max/2, - module_builtin_opaques/1, min/2, number_max/1, number_max/2, number_min/1, number_min/2, @@ -188,7 +187,6 @@ t_subtract_list/2, t_sup/1, t_sup/2, - t_tid/0, t_timeout/0, t_to_string/1, t_to_string/2, @@ -466,16 +464,6 @@ has_opaque_subtype(T) -> t_opaque_structure(?opaque(Elements)) -> t_sup([Struct || #opaque{struct = Struct} <- ordsets:to_list(Elements)]). --spec t_opaque_modules(erl_type()) -> [module()]. - -t_opaque_modules(?opaque(Elements)) -> - case ordsets:size(Elements) of - 1 -> - [#opaque{mod = Mod}] = set_to_list(Elements), - [Mod]; - _ -> throw({error, "Unexpected multiple opaque types"}) - end. - -spec t_contains_opaque(erl_type()) -> boolean(). t_contains_opaque(Type) -> @@ -801,11 +789,6 @@ t_struct_from_opaque(Type, _Opaques) -> Type. list_struct_from_opaque(Types, Opaques) -> [t_struct_from_opaque(Type, Opaques) || Type <- Types]. --spec module_builtin_opaques(module()) -> [erl_type()]. - -module_builtin_opaques(Module) -> - [O || O <- all_opaque_builtins(), lists:member(Module, t_opaque_modules(O))]. - %%----------------------------------------------------------------------------- %% Remote types: these types are used for preprocessing; %% they should never reach the analysis stage. @@ -1987,82 +1970,6 @@ t_parameterized_module() -> t_timeout() -> t_sup(t_non_neg_integer(), t_atom('infinity')). -%%----------------------------------------------------------------------------- -%% Some built-in opaque types -%% - --spec t_array() -> erl_type(). - -t_array() -> - t_opaque(array, array, [t_any()], - t_tuple([t_atom('array'), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_any(), - t_any()])). - --spec t_dict() -> erl_type(). - -t_dict() -> - t_opaque(dict, dict, [t_any(), t_any()], - t_tuple([t_atom('dict'), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_tuple()]), - t_sup([t_atom('undefined'), t_tuple()])])). - --spec t_digraph() -> erl_type(). - -t_digraph() -> - t_opaque(digraph, digraph, [], - t_tuple([t_atom('digraph'), - t_sup(t_atom(), t_tid()), - t_sup(t_atom(), t_tid()), - t_sup(t_atom(), t_tid()), - t_boolean()])). - --spec t_gb_set() -> erl_type(). - -t_gb_set() -> - t_opaque(gb_sets, gb_set, [], - t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(3))])). - --spec t_gb_tree() -> erl_type(). - -t_gb_tree() -> - t_opaque(gb_trees, gb_tree, [], - t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(4))])). - --spec t_queue() -> erl_type(). - -t_queue() -> - t_opaque(queue, queue, [t_any()], t_tuple([t_list(), t_list()])). - --spec t_set() -> erl_type(). - -t_set() -> - t_opaque(sets, set, [t_any()], - t_tuple([t_atom('set'), t_non_neg_integer(), t_non_neg_integer(), - t_pos_integer(), t_non_neg_integer(), t_non_neg_integer(), - t_non_neg_integer(), - t_sup([t_atom('undefined'), t_tuple()]), - t_sup([t_atom('undefined'), t_tuple()])])). - --spec t_tid() -> erl_type(). - -t_tid() -> - t_opaque(ets, tid, [], t_integer()). - --spec all_opaque_builtins() -> [erl_type(),...]. - -all_opaque_builtins() -> - [t_array(), t_dict(), t_digraph(), t_gb_set(), - t_gb_tree(), t_queue(), t_set(), t_tid()]. - %%------------------------------------ %% ?none is allowed in products. A product of size 1 is not a product. @@ -3317,8 +3224,8 @@ is_opaque_type2(#opaque{mod = Mod1, name = Name1, args = Args1}, Opaques) -> is_type_name(Mod, Name, Args1, Mod, Name, Args2) -> length(Args1) =:= length(Args2); -is_type_name(Mod1, Name1, Args1, Mod2, Name2, Args2) -> - is_same_type_name2(Mod1, Name1, Args1, Mod2, Name2, Args2). +is_type_name(_Mod1, _Name1, _Args1, _Mod2, _Name2, _Args2) -> + false. %% Two functions since t_unify is not symmetric. unify_tuple_set_and_tuple1(?tuple_set([{Arity, List}]), @@ -4156,15 +4063,7 @@ opaque_name(Mod, Name, Extra) -> flat_format("~s(~s)", [S, Extra]). mod_name(Mod, Name) -> - case is_obsolete_opaque_builtin(Mod, Name) of - true -> flat_format("~w", [Name]); - false -> flat_format("~w:~w", [Mod, Name]) - end. - -is_obsolete_opaque_builtin(digraph, digraph) -> true; -is_obsolete_opaque_builtin(gb_sets, gb_set) -> true; -is_obsolete_opaque_builtin(gb_trees, gb_tree) -> true; -is_obsolete_opaque_builtin(_, _) -> false. + flat_format("~w:~w", [Mod, Name]). %%============================================================================= %% @@ -4229,8 +4128,6 @@ t_from_form({type, _L, any, []}, _TypeNames, _RecDict, _VarDict) -> {t_any(), []}; t_from_form({type, _L, arity, []}, _TypeNames, _RecDict, _VarDict) -> {t_arity(), []}; -t_from_form({type, _L, array, []}, TypeNames, RecDict, VarDict) -> - builtin_type(array, t_array(), TypeNames, RecDict, VarDict); t_from_form({type, _L, atom, []}, _TypeNames, _RecDict, _VarDict) -> {t_atom(), []}; t_from_form({type, _L, binary, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4252,10 +4149,6 @@ t_from_form({type, _L, byte, []}, _TypeNames, _RecDict, _VarDict) -> {t_byte(), []}; t_from_form({type, _L, char, []}, _TypeNames, _RecDict, _VarDict) -> {t_char(), []}; -t_from_form({type, _L, dict, []}, TypeNames, RecDict, VarDict) -> - builtin_type(dict, t_dict(), TypeNames, RecDict, VarDict); -t_from_form({type, _L, digraph, []}, TypeNames, RecDict, VarDict) -> - builtin_type(digraph, t_digraph(), TypeNames, RecDict, VarDict); t_from_form({type, _L, float, []}, _TypeNames, _RecDict, _VarDict) -> {t_float(), []}; t_from_form({type, _L, function, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4271,10 +4164,6 @@ t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, {L, R1} = list_from_form(Domain, TypeNames, RecDict, VarDict), {T, R2} = t_from_form(Range, TypeNames, RecDict, VarDict), {t_fun(L, T), R1 ++ R2}; -t_from_form({type, _L, gb_set, []}, TypeNames, RecDict, VarDict) -> - builtin_type(gb_set, t_gb_set(), TypeNames, RecDict, VarDict); -t_from_form({type, _L, gb_tree, []}, TypeNames, RecDict, VarDict) -> - builtin_type(gb_tree, t_gb_tree(), TypeNames, RecDict, VarDict); t_from_form({type, _L, identifier, []}, _TypeNames, _RecDict, _VarDict) -> {t_identifier(), []}; t_from_form({type, _L, integer, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4347,8 +4236,6 @@ t_from_form({type, _L, maybe_improper_list, [Content, Termination]}, t_from_form({type, _L, product, Elements}, TypeNames, RecDict, VarDict) -> {L, R} = list_from_form(Elements, TypeNames, RecDict, VarDict), {t_product(L), R}; -t_from_form({type, _L, queue, []}, TypeNames, RecDict, VarDict) -> - builtin_type(queue, t_queue(), TypeNames, RecDict, VarDict); t_from_form({type, _L, range, [From, To]} = Type, _TypeNames, _RecDict, _VarDict) -> case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of @@ -4360,14 +4247,10 @@ t_from_form({type, _L, record, [Name|Fields]}, TypeNames, RecDict, VarDict) -> record_from_form(Name, Fields, TypeNames, RecDict, VarDict); t_from_form({type, _L, reference, []}, _TypeNames, _RecDict, _VarDict) -> {t_reference(), []}; -t_from_form({type, _L, set, []}, TypeNames, RecDict, VarDict) -> - builtin_type(set, t_set(), TypeNames, RecDict, VarDict); t_from_form({type, _L, string, []}, _TypeNames, _RecDict, _VarDict) -> {t_string(), []}; t_from_form({type, _L, term, []}, _TypeNames, _RecDict, _VarDict) -> {t_any(), []}; -t_from_form({type, _L, tid, []}, TypeNames, RecDict, VarDict) -> - builtin_type(tid, t_tid(), TypeNames, RecDict, VarDict); t_from_form({type, _L, timeout, []}, _TypeNames, _RecDict, _VarDict) -> {t_timeout(), []}; t_from_form({type, _L, tuple, any}, _TypeNames, _RecDict, _VarDict) -> @@ -4378,7 +4261,10 @@ t_from_form({type, _L, tuple, Args}, TypeNames, RecDict, VarDict) -> t_from_form({type, _L, union, Args}, TypeNames, RecDict, VarDict) -> {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), {t_sup(L), R}; +t_from_form({user_type, _L, Name, Args}, TypeNames, RecDict, VarDict) -> + type_from_form(Name, Args, TypeNames, RecDict, VarDict); t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) -> + %% Compatibility: modules compiled before Erlang/OTP 18.0. type_from_form(Name, Args, TypeNames, RecDict, VarDict); t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _RecDict, _VarDict) -> @@ -4622,9 +4508,12 @@ t_form_to_string({type, _L, Name, []} = T) -> try t_to_string(t_from_form(T)) catch throw:{error, _} -> atom_to_string(Name) ++ "()" end; -t_form_to_string({type, _L, Name, List}) -> +t_form_to_string({user_type, _L, Name, List}) -> flat_format("~w(~s)", - [Name, string:join(t_form_to_string_list(List), ",")]). + [Name, string:join(t_form_to_string_list(List), ",")]); +t_form_to_string({type, L, Name, List}) -> + %% Compatibility: modules compiled before Erlang/OTP 18.0. + t_form_to_string({user_type, L, Name, List}). t_form_to_string_list(List) -> t_form_to_string_list(List, []). @@ -4737,27 +4626,14 @@ do_opaque(Type, _Opaques, Pred) -> is_same_type_name(ModNameArgs, ModNameArgs) -> true; is_same_type_name({Mod, Name, Args1}, {Mod, Name, Args2}) -> all_any(Args1) orelse all_any(Args2); -is_same_type_name({Mod1, Name1, Args1}, {Mod2, Name2, Args2}) -> - is_same_type_name2(Mod1, Name1, Args1, Mod2, Name2, Args2). +is_same_type_name(_ModNameArgs1, _ModNameArgs2) -> + false. all_any([]) -> true; all_any([T|L]) -> t_is_any(T) andalso all_any(L); all_any(_) -> false. -%% Compatibility. In Erlang/OTP 17 the pre-defined opaque types -%% digraph() and so on can be used, but there are also new types such -%% as digraph:graph() with the exact same meaning. In Erlang/OTP R18.0 -%% all but the last clause can be removed. - -is_same_type_name2(digraph, digraph, [], digraph, graph, []) -> true; -is_same_type_name2(digraph, graph, [], digraph, digraph, []) -> true; -is_same_type_name2(gb_sets, gb_set, [], gb_sets, set, [_]) -> true; -is_same_type_name2(gb_sets, set, [_], gb_sets, gb_set, []) -> true; -is_same_type_name2(gb_trees, gb_tree, [], gb_trees, tree, [_, _]) -> true; -is_same_type_name2(gb_trees, tree, [_, _], gb_trees, gb_tree, []) -> true; -is_same_type_name2(_, _, _, _, _, _) -> false. - map_keys(?map(Pairs)) -> [K || {K, _} <- Pairs]. diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 0bbd40d656..0a42e7210c 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1850,6 +1850,7 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) -> Session2 = erlang:setelement(Pos, Session, Value), insert_session(Session2, ProfileName); T:E -> + Stacktrace = erlang:get_stacktrace(), error_logger:error_msg("Failed updating session: " "~n ProfileName: ~p" "~n SessionId: ~p" @@ -1873,7 +1874,7 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) -> {value, Value}, {etype, T}, {error, E}, - {stacktrace, erlang:get_stacktrace()}]}) + {stacktrace, Stacktrace}]}) end. diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index dcb9640dcf..338d62e82b 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -1693,9 +1693,9 @@ <desc> <p>Makes sure that any buffers kept by the operating system (not by the Erlang runtime system) are written to disk. In - many ways it's resembles fsync but it not requires to update - some of file's metadata such as the access time. On - some platforms, this function might have no effect.</p> + many ways it resembles fsync but it does not update + some of the file's metadata such as the access time. On + some platforms this function has no effect.</p> <p>Applications that access databases or log files often write a tiny data fragment (e.g., one line in a log file) and then call fsync() immediately in order to ensure that the written @@ -1703,11 +1703,11 @@ will always initiate two write operations: one for the newly written data and another one in order to update the modification time stored in the inode. If the modification time is not a part - of the transaction concept fdatasync() can be used to avoid + of the transaction concept, fdatasync() can be used to avoid unnecessary inode disk write operations.</p> - <p>Available only in some POSIX systems. This call results in a - call to fsync(), or has no effect, in systems not implementing - the fdatasync syscall.</p> + <p>Available only in some POSIX systems, this call results in a + call to fsync(), or has no effect in systems not implementing + the fdatasync() syscall.</p> </desc> </func> <func> diff --git a/lib/kernel/doc/src/pg2.xml b/lib/kernel/doc/src/pg2.xml index 5eb63c1ef6..35cf85470a 100644 --- a/lib/kernel/doc/src/pg2.xml +++ b/lib/kernel/doc/src/pg2.xml @@ -34,11 +34,8 @@ <module>pg2</module> <modulesummary>Distributed Named Process Groups</modulesummary> <description> - <p>This module implements process groups. The groups in this - module differ from the groups in the module <c>pg</c> in several - ways. In <c>pg</c>, each message is sent to all members in the - group. In this module, each message may be sent to one, some, or - all members. + <p>This module implements process groups. Each message may be sent + to one, some, or all members of the group. </p> <p>A group of processes can be accessed by a common name. For example, if there is a group named <c>foobar</c>, there can be a @@ -160,8 +157,7 @@ <section> <title>See Also</title> - <p><seealso marker="kernel_app">kernel(6)</seealso>, - <seealso marker="stdlib:pg">pg(3)</seealso></p> + <p><seealso marker="kernel_app">kernel(6)</seealso></p> </section> </erlref> diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 3d6665a36a..b6b153ae56 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -445,21 +445,15 @@ open(Item, ModeList) when is_list(ModeList) -> case lists:member(raw, ModeList) of %% Raw file, use ?PRIM_FILE to handle this file true -> - %% check if raw file mode is disabled - case catch application:get_env(kernel, raw_files) of - {ok,false} -> - open(Item, lists:delete(raw, ModeList)); - _ -> % undefined | {ok,true} - Args = [file_name(Item) | ModeList], - case check_args(Args) of - ok -> - [FileName | _] = Args, - %% We rely on the returned Handle (in {ok, Handle}) - %% being a pid() or a #file_descriptor{} - ?PRIM_FILE:open(FileName, ModeList); - Error -> - Error - end + Args = [file_name(Item) | ModeList], + case check_args(Args) of + ok -> + [FileName | _] = Args, + %% We rely on the returned Handle (in {ok, Handle}) + %% being a pid() or a #file_descriptor{} + ?PRIM_FILE:open(FileName, ModeList); + Error -> + Error end; false -> case lists:member(ram, ModeList) of diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl index b36dbf33dd..046885f885 100644 --- a/lib/kernel/src/group.erl +++ b/lib/kernel/src/group.erl @@ -111,8 +111,13 @@ start_shell1(Fun) -> server_loop(Drv, Shell, Buf0) -> receive {io_request,From,ReplyAs,Req} when is_pid(From) -> - Buf = io_request(Req, From, ReplyAs, Drv, Buf0), - server_loop(Drv, Shell, Buf); + %% This io_request may cause a transition to a couple of + %% selective receive loops elsewhere in this module. + Buf = io_request(Req, From, ReplyAs, Drv, Buf0), + server_loop(Drv, Shell, Buf); + {reply,{{From,ReplyAs},Reply}} -> + io_reply(From, ReplyAs, Reply), + server_loop(Drv, Shell, Buf0); {driver_id,ReplyTo} -> ReplyTo ! {self(),driver_id,Drv}, server_loop(Drv, Shell, Buf0); @@ -172,10 +177,13 @@ set_unicode_state(Drv,Bool) -> io_request(Req, From, ReplyAs, Drv, Buf0) -> - case io_request(Req, Drv, Buf0) of + case io_request(Req, Drv, {From,ReplyAs}, Buf0) of {ok,Reply,Buf} -> io_reply(From, ReplyAs, Reply), Buf; + {noreply,Buf} -> + %% We expect a {reply,_} message from the Drv when request is done + Buf; {error,Reply,Buf} -> io_reply(From, ReplyAs, Reply), Buf; @@ -196,78 +204,85 @@ io_request(Req, From, ReplyAs, Drv, Buf0) -> %% io_request({put_chars,unicode,Binary}, Drv, Buf) when is_binary(Binary) -> %% send_drv(Drv, {put_chars,Binary}), %% {ok,ok,Buf}; -io_request({put_chars,unicode,Chars}, Drv, Buf) -> +%% +%% These put requests have to be synchronous to the driver as otherwise +%% there is no guarantee that the data has actually been printed. +io_request({put_chars,unicode,Chars}, Drv, From, Buf) -> case catch unicode:characters_to_binary(Chars,utf8) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode, Binary}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}), + {noreply,Buf}; _ -> {error,{error,{put_chars, unicode,Chars}},Buf} end; -io_request({put_chars,unicode,M,F,As}, Drv, Buf) -> +io_request({put_chars,unicode,M,F,As}, Drv, From, Buf) -> case catch apply(M, F, As) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode,Binary}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}), + {noreply,Buf}; Chars -> case catch unicode:characters_to_binary(Chars,utf8) of B when is_binary(B) -> - send_drv(Drv, {put_chars, unicode,B}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, B, {From,ok}}), + {noreply,Buf}; _ -> {error,{error,F},Buf} end end; -io_request({put_chars,latin1,Binary}, Drv, Buf) when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode,unicode:characters_to_binary(Binary,latin1)}), - {ok,ok,Buf}; -io_request({put_chars,latin1,Chars}, Drv, Buf) -> +io_request({put_chars,latin1,Binary}, Drv, From, Buf) when is_binary(Binary) -> + send_drv(Drv, {put_chars_sync, unicode, + unicode:characters_to_binary(Binary,latin1), + {From,ok}}), + {noreply,Buf}; +io_request({put_chars,latin1,Chars}, Drv, From, Buf) -> case catch unicode:characters_to_binary(Chars,latin1) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode,Binary}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}), + {noreply,Buf}; _ -> {error,{error,{put_chars,latin1,Chars}},Buf} end; -io_request({put_chars,latin1,M,F,As}, Drv, Buf) -> +io_request({put_chars,latin1,M,F,As}, Drv, From, Buf) -> case catch apply(M, F, As) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode,unicode:characters_to_binary(Binary,latin1)}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, + unicode:characters_to_binary(Binary,latin1), + {From,ok}}), + {noreply,Buf}; Chars -> case catch unicode:characters_to_binary(Chars,latin1) of B when is_binary(B) -> - send_drv(Drv, {put_chars, unicode,B}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, B, {From,ok}}), + {noreply,Buf}; _ -> {error,{error,F},Buf} end end; -io_request({get_chars,Encoding,Prompt,N}, Drv, Buf) -> +io_request({get_chars,Encoding,Prompt,N}, Drv, _From, Buf) -> get_chars(Prompt, io_lib, collect_chars, N, Drv, Buf, Encoding); -io_request({get_line,Encoding,Prompt}, Drv, Buf) -> +io_request({get_line,Encoding,Prompt}, Drv, _From, Buf) -> get_chars(Prompt, io_lib, collect_line, [], Drv, Buf, Encoding); -io_request({get_until,Encoding, Prompt,M,F,As}, Drv, Buf) -> +io_request({get_until,Encoding, Prompt,M,F,As}, Drv, _From, Buf) -> get_chars(Prompt, io_lib, get_until, {M,F,As}, Drv, Buf, Encoding); -io_request({get_password,_Encoding},Drv,Buf) -> +io_request({get_password,_Encoding},Drv,_From,Buf) -> get_password_chars(Drv, Buf); -io_request({setopts,Opts}, Drv, Buf) when is_list(Opts) -> +io_request({setopts,Opts}, Drv, _From, Buf) when is_list(Opts) -> setopts(Opts, Drv, Buf); -io_request(getopts, Drv, Buf) -> +io_request(getopts, Drv, _From, Buf) -> getopts(Drv, Buf); -io_request({requests,Reqs}, Drv, Buf) -> - io_requests(Reqs, {ok,ok,Buf}, Drv); +io_request({requests,Reqs}, Drv, From, Buf) -> + io_requests(Reqs, {ok,ok,Buf}, From, Drv); %% New in R12 -io_request({get_geometry,columns},Drv,Buf) -> +io_request({get_geometry,columns},Drv,_From,Buf) -> case get_tty_geometry(Drv) of {W,_H} -> {ok,W,Buf}; _ -> {error,{error,enotsup},Buf} end; -io_request({get_geometry,rows},Drv,Buf) -> +io_request({get_geometry,rows},Drv,_From,Buf) -> case get_tty_geometry(Drv) of {_W,H} -> {ok,H,Buf}; @@ -276,38 +291,49 @@ io_request({get_geometry,rows},Drv,Buf) -> end; %% BC with pre-R13 -io_request({put_chars,Chars}, Drv, Buf) -> - io_request({put_chars,latin1,Chars}, Drv, Buf); -io_request({put_chars,M,F,As}, Drv, Buf) -> - io_request({put_chars,latin1,M,F,As}, Drv, Buf); -io_request({get_chars,Prompt,N}, Drv, Buf) -> - io_request({get_chars,latin1,Prompt,N}, Drv, Buf); -io_request({get_line,Prompt}, Drv, Buf) -> - io_request({get_line,latin1,Prompt}, Drv, Buf); -io_request({get_until, Prompt,M,F,As}, Drv, Buf) -> - io_request({get_until,latin1, Prompt,M,F,As}, Drv, Buf); -io_request(get_password,Drv,Buf) -> - io_request({get_password,latin1},Drv,Buf); - - - -io_request(_, _Drv, Buf) -> +io_request({put_chars,Chars}, Drv, From, Buf) -> + io_request({put_chars,latin1,Chars}, Drv, From, Buf); +io_request({put_chars,M,F,As}, Drv, From, Buf) -> + io_request({put_chars,latin1,M,F,As}, Drv, From, Buf); +io_request({get_chars,Prompt,N}, Drv, From, Buf) -> + io_request({get_chars,latin1,Prompt,N}, Drv, From, Buf); +io_request({get_line,Prompt}, Drv, From, Buf) -> + io_request({get_line,latin1,Prompt}, Drv, From, Buf); +io_request({get_until, Prompt,M,F,As}, Drv, From, Buf) -> + io_request({get_until,latin1, Prompt,M,F,As}, Drv, From, Buf); +io_request(get_password,Drv,From,Buf) -> + io_request({get_password,latin1},Drv,From,Buf); + + + +io_request(_, _Drv, _From, Buf) -> {error,{error,request},Buf}. -%% Status = io_requests(RequestList, PrevStat, Drv) -%% Process a list of output requests as long as the previous status is 'ok'. - -io_requests([R|Rs], {ok,ok,Buf}, Drv) -> - io_requests(Rs, io_request(R, Drv, Buf), Drv); -io_requests([_|_], Error, _Drv) -> +%% Status = io_requests(RequestList, PrevStat, From, Drv) +%% Process a list of output requests as long as +%% the previous status is 'ok' or noreply. +%% +%% We use undefined as the From for all but the last request +%% in order to discards acknowledgements from those requests. +%% +io_requests([R|Rs], {noreply,Buf}, From, Drv) -> + ReqFrom = if Rs =:= [] -> From; true -> undefined end, + io_requests(Rs, io_request(R, Drv, ReqFrom, Buf), From, Drv); +io_requests([R|Rs], {ok,ok,Buf}, From, Drv) -> + ReqFrom = if Rs =:= [] -> From; true -> undefined end, + io_requests(Rs, io_request(R, Drv, ReqFrom, Buf), From, Drv); +io_requests([_|_], Error, _From, _Drv) -> Error; -io_requests([], Stat, _) -> +io_requests([], Stat, _From, _) -> Stat. %% io_reply(From, ReplyAs, Reply) %% The function for sending i/o command acknowledgement. %% The ACK contains the return value. +io_reply(undefined, _ReplyAs, _Reply) -> + %% Ignore these replies as they are generated from io_requests/4. + ok; io_reply(From, ReplyAs, Reply) -> From ! {io_reply,ReplyAs,Reply}, ok. @@ -619,6 +645,10 @@ more_data(What, Cont0, Drv, Ls, Encoding) -> io_request(Req, From, ReplyAs, Drv, []), %WRONG!!! send_drv_reqs(Drv, edlin:redraw_line(Cont)), get_line1({more_chars,Cont,[]}, Drv, Ls, Encoding); + {reply,{{From,ReplyAs},Reply}} -> + %% We take care of replies from puts here as well + io_reply(From, ReplyAs, Reply), + more_data(What, Cont0, Drv, Ls, Encoding); {'EXIT',Drv,interrupt} -> interrupted; {'EXIT',Drv,_} -> @@ -641,6 +671,10 @@ get_line_echo_off1({Chars,[]}, Drv) -> {io_request,From,ReplyAs,Req} when is_pid(From) -> io_request(Req, From, ReplyAs, Drv, []), get_line_echo_off1({Chars,[]}, Drv); + {reply,{{From,ReplyAs},Reply}} when From =/= undefined -> + %% We take care of replies from puts here as well + io_reply(From, ReplyAs, Reply), + get_line_echo_off1({Chars,[]},Drv); {'EXIT',Drv,interrupt} -> interrupted; {'EXIT',Drv,_} -> @@ -790,6 +824,10 @@ get_password1({Chars,[]}, Drv) -> %% set to []. But do we expect anything but plain output? get_password1({Chars, []}, Drv); + {reply,{{From,ReplyAs},Reply}} -> + %% We take care of replies from puts here as well + io_reply(From, ReplyAs, Reply), + get_password1({Chars, []},Drv); {'EXIT',Drv,interrupt} -> interrupted; {'EXIT',Drv,_} -> diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src index f8f4cc1ec2..1bae762bed 100644 --- a/lib/kernel/src/kernel.appup.src +++ b/lib/kernel/src/kernel.appup.src @@ -17,9 +17,7 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16 + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 %% Down to - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 }. diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index a91c23539d..e6ce85c379 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -29,6 +29,7 @@ -define(OP_INSC,2). -define(OP_DELC,3). -define(OP_BEEP,4). +-define(OP_PUTC_SYNC,5). % Control op -define(CTRL_OP_GET_WINSIZE,100). -define(CTRL_OP_GET_UNICODE_STATE,101). @@ -133,7 +134,7 @@ server1(Iport, Oport, Shell) -> [erlang:system_info(system_version)]))}, Iport, Oport), %% Enter the server loop. - server_loop(Iport, Oport, Curr, User, Gr). + server_loop(Iport, Oport, Curr, User, Gr, queue:new()). rem_sh_opts(Node) -> [{expand_fun,fun(B)-> rpc:call(Node,edlin_expand,expand,[B]) end}]. @@ -158,42 +159,41 @@ start_user() -> User end. -server_loop(Iport, Oport, User, Gr) -> +server_loop(Iport, Oport, User, Gr, IOQueue) -> Curr = gr_cur_pid(Gr), put(current_group, Curr), - server_loop(Iport, Oport, Curr, User, Gr). + server_loop(Iport, Oport, Curr, User, Gr, IOQueue). -server_loop(Iport, Oport, Curr, User, Gr) -> +server_loop(Iport, Oport, Curr, User, Gr, IOQueue) -> receive {Iport,{data,Bs}} -> BsBin = list_to_binary(Bs), Unicode = unicode:characters_to_list(BsBin,utf8), - port_bytes(Unicode, Iport, Oport, Curr, User, Gr); + port_bytes(Unicode, Iport, Oport, Curr, User, Gr, IOQueue); {Iport,eof} -> Curr ! {self(),eof}, - server_loop(Iport, Oport, Curr, User, Gr); - {User,Req} -> % never block from user! - io_request(Req, Iport, Oport), - server_loop(Iport, Oport, Curr, User, Gr); - {Curr,tty_geometry} -> - Curr ! {self(),tty_geometry,get_tty_geometry(Iport)}, - server_loop(Iport, Oport, Curr, User, Gr); - {Curr,get_unicode_state} -> - Curr ! {self(),get_unicode_state,get_unicode_state(Iport)}, - server_loop(Iport, Oport, Curr, User, Gr); - {Curr,set_unicode_state, Bool} -> - Curr ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)}, - server_loop(Iport, Oport, Curr, User, Gr); - {Curr,Req} -> - io_request(Req, Iport, Oport), - server_loop(Iport, Oport, Curr, User, Gr); + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); + Req when element(1,Req) =:= User orelse element(1,Req) =:= Curr, + tuple_size(Req) =:= 2 orelse tuple_size(Req) =:= 3 -> + %% We match {User|Curr,_}|{User|Curr,_,_} + NewQ = handle_req(Req, Iport, Oport, IOQueue), + server_loop(Iport, Oport, Curr, User, Gr, NewQ); + {Oport,ok} -> + %% We get this ok from the port, in io_request we store + %% info about where to send reply at head of queue + {{value,{Origin,Reply}},ReplyQ} = queue:out(IOQueue), + Origin ! {reply,Reply}, + NewQ = handle_req(next, Iport, Oport, ReplyQ), + server_loop(Iport, Oport, Curr, User, Gr, NewQ); {'EXIT',Iport,_R} -> - server_loop(Iport, Oport, Curr, User, Gr); + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); {'EXIT',Oport,_R} -> - server_loop(Iport, Oport, Curr, User, Gr); + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); + {'EXIT',User,shutdown} -> % force data to port + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); {'EXIT',User,_R} -> % keep 'user' alive NewU = start_user(), - server_loop(Iport, Oport, Curr, NewU, gr_set_num(Gr, 1, NewU, {})); + server_loop(Iport, Oport, Curr, NewU, gr_set_num(Gr, 1, NewU, {}), IOQueue); {'EXIT',Pid,R} -> % shell and group leader exit case gr_cur_pid(Gr) of Pid when R =/= die , @@ -213,18 +213,51 @@ server_loop(Iport, Oport, Curr, User, Gr) -> {ok,Gr2} = gr_set_cur(gr_set_num(Gr1, Ix, Pid1, {shell,start,Params}), Ix), put(current_group, Pid1), - server_loop(Iport, Oport, Pid1, User, Gr2); + server_loop(Iport, Oport, Pid1, User, Gr2, IOQueue); _ -> % remote shell io_requests([{put_chars,unicode,"(^G to start new job) ***\n"}], Iport, Oport), - server_loop(Iport, Oport, Curr, User, Gr1) + server_loop(Iport, Oport, Curr, User, Gr1, IOQueue) end; _ -> % not current, just remove it - server_loop(Iport, Oport, Curr, User, gr_del_pid(Gr, Pid)) + server_loop(Iport, Oport, Curr, User, gr_del_pid(Gr, Pid), IOQueue) end; _X -> %% Ignore unknown messages. - server_loop(Iport, Oport, Curr, User, Gr) + server_loop(Iport, Oport, Curr, User, Gr, IOQueue) + end. + +%% We always handle geometry and unicode requests +handle_req({Curr,tty_geometry},Iport,_Oport,IOQueue) -> + Curr ! {self(),tty_geometry,get_tty_geometry(Iport)}, + IOQueue; +handle_req({Curr,get_unicode_state},Iport,_Oport,IOQueue) -> + Curr ! {self(),get_unicode_state,get_unicode_state(Iport)}, + IOQueue; +handle_req({Curr,set_unicode_state, Bool},Iport,_Oport,IOQueue) -> + Curr ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)}, + IOQueue; +handle_req(next,Iport,Oport,IOQueue) -> + case queue:out(IOQueue) of + {{value,Next},ExecQ} -> + NewQ = handle_req(Next,Iport,Oport,queue:new()), + queue:join(NewQ,ExecQ); + {empty,_} -> + IOQueue + end; +handle_req(Msg,Iport,Oport,IOQueue) -> + case queue:peek(IOQueue) of + empty -> + {Origin,Req} = Msg, + case io_request(Req, Iport, Oport) of + ok -> IOQueue; + Reply -> + %% Push reply info to front of queue + queue:in_r({Origin,Reply},IOQueue) + end; + _Else -> + %% All requests are queued when we have outstanding sync put_chars + queue:in(Msg,IOQueue) end. %% port_bytes(Bytes, InPort, OutPort, CurrentProcess, UserProcess, Group) @@ -232,34 +265,34 @@ server_loop(Iport, Oport, Curr, User, Gr) -> %% either escape to switch_loop or restart the shell. Otherwise send %% the bytes to Curr. -port_bytes([$\^G|_Bs], Iport, Oport, _Curr, User, Gr) -> - handle_escape(Iport, Oport, User, Gr); +port_bytes([$\^G|_Bs], Iport, Oport, _Curr, User, Gr, IOQueue) -> + handle_escape(Iport, Oport, User, Gr, IOQueue); -port_bytes([$\^C|_Bs], Iport, Oport, Curr, User, Gr) -> - interrupt_shell(Iport, Oport, Curr, User, Gr); +port_bytes([$\^C|_Bs], Iport, Oport, Curr, User, Gr, IOQueue) -> + interrupt_shell(Iport, Oport, Curr, User, Gr, IOQueue); -port_bytes([B], Iport, Oport, Curr, User, Gr) -> +port_bytes([B], Iport, Oport, Curr, User, Gr, IOQueue) -> Curr ! {self(),{data,[B]}}, - server_loop(Iport, Oport, Curr, User, Gr); -port_bytes(Bs, Iport, Oport, Curr, User, Gr) -> + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); +port_bytes(Bs, Iport, Oport, Curr, User, Gr, IOQueue) -> case member($\^G, Bs) of true -> - handle_escape(Iport, Oport, User, Gr); + handle_escape(Iport, Oport, User, Gr, IOQueue); false -> Curr ! {self(),{data,Bs}}, - server_loop(Iport, Oport, Curr, User, Gr) + server_loop(Iport, Oport, Curr, User, Gr, IOQueue) end. -interrupt_shell(Iport, Oport, Curr, User, Gr) -> +interrupt_shell(Iport, Oport, Curr, User, Gr, IOQueue) -> case gr_get_info(Gr, Curr) of undefined -> ok; % unknown _ -> exit(Curr, interrupt) end, - server_loop(Iport, Oport, Curr, User, Gr). + server_loop(Iport, Oport, Curr, User, Gr, IOQueue). -handle_escape(Iport, Oport, User, Gr) -> +handle_escape(Iport, Oport, User, Gr, IOQueue) -> case application:get_env(stdlib, shell_esc) of {ok,abort} -> Pid = gr_cur_pid(Gr), @@ -278,11 +311,11 @@ handle_escape(Iport, Oport, User, Gr) -> Pid1 = group:start(self(), {shell,start,[]}), io_request({put_chars,unicode,"\n"}, Iport, Oport), server_loop(Iport, Oport, User, - gr_add_cur(Gr1, Pid1, {shell,start,[]})); + gr_add_cur(Gr1, Pid1, {shell,start,[]}), IOQueue); _ -> % {ok,jcl} | undefined io_request({put_chars,unicode,"\nUser switch command\n"}, Iport, Oport), - server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr)) + server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr), IOQueue) end. switch_loop(Iport, Oport, Gr) -> @@ -492,9 +525,12 @@ set_unicode_state(Iport, Bool) -> io_request(Request, Iport, Oport) -> try io_command(Request) of - Command -> + {command,_} = Command -> Oport ! {self(),Command}, - ok + ok; + {Command,Reply} -> + Oport ! {self(),Command}, + Reply catch {requests,Rs} -> io_requests(Rs, Iport, Oport); @@ -511,6 +547,13 @@ io_requests([], _Iport, _Oport) -> put_int16(N, Tail) -> [(N bsr 8)band 255,N band 255|Tail]. +%% When a put_chars_sync command is used, user_drv guarantees that +%% the bytes have been put in the buffer of the port before an acknowledgement +%% is sent back to the process sending the request. This command was added in +%% OTP 18 to make sure that data sent from io:format is actually printed +%% to the console before the vm stops when calling erlang:halt(integer()). +io_command({put_chars_sync, unicode,Cs,Reply}) -> + {{command,[?OP_PUTC_SYNC|unicode:characters_to_binary(Cs,utf8)]},Reply}; io_command({put_chars, unicode,Cs}) -> {command,[?OP_PUTC|unicode:characters_to_binary(Cs,utf8)]}; io_command({move_rel,N}) -> diff --git a/lib/kernel/test/pdict_SUITE.erl b/lib/kernel/test/pdict_SUITE.erl index 98cff0222e..4b60beb9dc 100644 --- a/lib/kernel/test/pdict_SUITE.erl +++ b/lib/kernel/test/pdict_SUITE.erl @@ -31,7 +31,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - simple/1, complicated/1, heavy/1, info/1]). + simple/1, complicated/1, heavy/1, simple_all_keys/1, info/1]). -export([init_per_testcase/2, end_per_testcase/2]). -export([other_process/2]). @@ -46,7 +46,7 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [simple, complicated, heavy, info]. + [simple, complicated, heavy, simple_all_keys, info]. groups() -> []. @@ -70,6 +70,7 @@ simple(suite) -> []; simple(Config) when is_list(Config) -> XX = get(), + ok = match_keys(XX), erase(), L = [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p, q,r,s,t,u,v,x,y,z,'A','B','C','D'], @@ -105,6 +106,7 @@ simple(Config) when is_list(Config) -> complicated(Config) when is_list(Config) -> Previous = get(), + ok = match_keys(Previous), Previous = erase(), N = case ?t:is_debug() of false -> 500000; @@ -113,8 +115,10 @@ complicated(Config) when is_list(Config) -> comp_1(N), comp_2(N), N = comp_3(lists:sort(get()), 1), + ok = match_keys(get()), comp_4(get()), [] = get(), + [] = get_keys(), [put(Key, Value) || {Key,Value} <- Previous], ok. @@ -160,6 +164,26 @@ heavy(Config) when is_list(Config) -> [put(Key, Value) || {Key,Value} <- XX], ok. +simple_all_keys(Config) when is_list(Config) -> + erase(), + ok = simple_all_keys_add_loop(1000), + [] = get_keys(), + [] = get(), + ok. + +simple_all_keys_add_loop(0) -> + simple_all_keys_del_loop(erlang:get_keys()); +simple_all_keys_add_loop(N) -> + put(gen_key(N),value), + ok = match_keys(get()), + simple_all_keys_add_loop(N-1). + +simple_all_keys_del_loop([]) -> ok; +simple_all_keys_del_loop([K|Ks]) -> + value = erase(K), + ok = match_keys(get()), + simple_all_keys_del_loop(Ks). + info(doc) -> ["Tests process_info(Pid, dictionary)"]; info(suite) -> @@ -339,3 +363,8 @@ m(A,B,Module,Line) -> [A,B,Module,Line]), exit({no_match,{A,B},Module,Line}) end. + +match_keys(All) -> + Ks = lists:sort([K||{K,_}<-All]), + Ks = lists:sort(erlang:get_keys()), + ok. diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 03ab0c20e1..1266b1f9b9 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -101,7 +101,7 @@ end_per_group(_GroupName, Config) -> init_per_suite(Config) when is_list(Config) -> delete_saved(Config), DataDir = ?config(data_dir,Config), - Rels = [R || R <- [r15b,r16b], ?t:is_release_available(R)] ++ [current], + Rels = [R || R <- [r16b,'17'], ?t:is_release_available(R)] ++ [current], io:format("Creating crash dumps for the following releases: ~p", [Rels]), AllDumps = create_dumps(DataDir,Rels), [{dumps,AllDumps}|Config]. @@ -563,12 +563,6 @@ dump_with_strange_module_name(DataDir,Rel,DumpName) -> CD. dump(Node,DataDir,Rel,DumpName) -> - case Rel of - _ when Rel<r15b, Rel=/=current -> - rpc:call(Node,os,putenv,["ERL_CRASH_DUMP_SECONDS","600"]); - _ -> - ok - end, rpc:call(Node,erlang,halt,[DumpName]), Crashdump0 = filename:join(filename:dirname(code:which(?t)), "erl_crash_dump.n1"), @@ -623,42 +617,21 @@ dos_dump(DataDir,Rel,Dump) -> rel_opt(Rel) -> case Rel of - r9b -> [{erl,[{release,"r9b_patched"}]}]; - r9c -> [{erl,[{release,"r9c_patched"}]}]; - r10b -> [{erl,[{release,"r10b_patched"}]}]; - r11b -> [{erl,[{release,"r11b_patched"}]}]; - r12b -> [{erl,[{release,"r12b_patched"}]}]; - r13b -> [{erl,[{release,"r13b_patched"}]}]; - r14b -> [{erl,[{release,"r14b_latest"}]}]; %naming convention changed - r15b -> [{erl,[{release,"r15b_latest"}]}]; r16b -> [{erl,[{release,"r16b_latest"}]}]; + '17' -> [{erl,[{release,"17_latest"}]}]; current -> [] end. dump_prefix(Rel) -> case Rel of - r9b -> "r9b_dump."; - r9c -> "r9c_dump."; - r10b -> "r10b_dump."; - r11b -> "r11b_dump."; - r12b -> "r12b_dump."; - r13b -> "r13b_dump."; - r14b -> "r14b_dump."; - r15b -> "r15b_dump."; r16b -> "r16b_dump."; - current -> "r17b_dump." + '17' -> "r17_dump."; + current -> "r18_dump." end. compat_rel(Rel) -> case Rel of - r9b -> "+R9 "; - r9c -> "+R9 "; - r10b -> "+R10 "; - r11b -> "+R11 "; - r12b -> "+R12 "; - r13b -> "+R13 "; - r14b -> "+R14 "; - r15b -> "+R15 "; r16b -> "+R16 "; + '17' -> "+R17 "; current -> "" end. diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl index 347e80ed7c..b3b7afd1a9 100644 --- a/lib/reltool/test/reltool_server_SUITE.erl +++ b/lib/reltool/test/reltool_server_SUITE.erl @@ -1205,14 +1205,9 @@ create_slim(Config) -> RootDir = code:root_dir(), Erl = filename:join([RootDir, "bin", "erl"]), - EscapedQuote = - case os:type() of - {win32,_} -> "\\\""; - _ -> "\"" - end, Args = ["-boot_var", "RELTOOL_EXT_LIB", TargetLibDir, "-boot", filename:join(TargetRelVsnDir,RelName), - "-sasl", "releases_dir", EscapedQuote++TargetRelDir++EscapedQuote], + "-sasl", "releases_dir", "\""++TargetRelDir++"\""], {ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl, Args)), ?msym(RootDir, rpc:call(Node, code, root_dir, [])), wait_for_app(Node,sasl,50), diff --git a/lib/sasl/doc/src/appup.xml b/lib/sasl/doc/src/appup.xml index 95f315d269..f0f41b0c7e 100644 --- a/lib/sasl/doc/src/appup.xml +++ b/lib/sasl/doc/src/appup.xml @@ -180,15 +180,28 @@ <c>Mod</c> when upgrading, and vice versa when downgrading.</p> <pre> {add_module, Mod} +{add_module, Mod, DepMods} Mod = atom() + DepMods = [Mod] </pre> <p>Loads a new module <c>Mod</c>.</p> + <p><c>DepMods</c> defaults to [] and defines which other modules + <c>Mod</c> is dependent on. In <c>relup</c>, instructions + related to these modules will come before the instruction for + loading <c>Mod</c> when upgrading, and vice versa when + downgrading.</p> <pre> {delete_module, Mod} +{delete_module, Mod, DepMods} Mod = atom() </pre> <p>Deletes a module <c>Mod</c> using the low-level instructions <c>remove</c> and <c>purge</c>.</p> + <p><c>DepMods</c> defaults to [] and defines which other modules + <c>Mod</c> is dependent on. In <c>relup</c>, instructions + related to these modules will come before the instruction for + removing <c>Mod</c> when upgrading, and vice versa when + downgrading.</p> <pre> {add_application, Application} {add_application, Application, Type} diff --git a/lib/sasl/src/sasl.appup.src b/lib/sasl/src/sasl.appup.src index e789853eea..af04d007ac 100644 --- a/lib/sasl/src/sasl.appup.src +++ b/lib/sasl/src/sasl.appup.src @@ -17,9 +17,7 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}], %% R16 + [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 %% Down to - max one major revision back - [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 + [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 }. diff --git a/lib/sasl/src/systools_rc.erl b/lib/sasl/src/systools_rc.erl index 76f753c3d0..11e097996c 100644 --- a/lib/sasl/src/systools_rc.erl +++ b/lib/sasl/src/systools_rc.erl @@ -32,7 +32,6 @@ %% {load_module, Mod, PrePurge, PostPurge, [Mod]} %% {add_module, Mod} %% {add_module, Mod, [Mod]} -%% {remove_module, Mod, PrePurge, PostPurge, [Mod]} %% {restart_application, Appl} %% {add_application, Appl, Type} %% {remove_application, Appl} @@ -59,7 +58,7 @@ %% High-level instructions that contain dependencies %% --define(DEP_INSTRS, [update, load_module, add_module, remove_module]). +-define(DEP_INSTRS, [update, load_module, add_module, delete_module]). %%----------------------------------------------------------------- %% translate_scripts(Scripts, Appls, PreAppls) -> Res @@ -107,9 +106,6 @@ expand_script([I|Script]) -> {update, Mod, Change, Mods} when Change==soft, is_list(Mods) -> {update, Mod, Change, brutal_purge,brutal_purge, Mods}; - {delete_module, Mod} -> - [{remove, {Mod, brutal_purge, brutal_purge}}, - {purge, [Mod]}]; {add_application, Application} -> {add_application, Application, permanent}; _ -> @@ -301,6 +297,8 @@ normalize_instrs(Script) -> PostPurge, Mods}; ({add_module, Mod}) -> {add_module, Mod, []}; + ({delete_module, Mod}) -> + {delete_module, Mod, []}; (I) -> I end, Script). @@ -412,7 +410,7 @@ translate_add_module_instrs(Before, After) -> %%----------------------------------------------------------------- %%----------------------------------------------------------------- -%% Translates update, load_module and remove_module, and reorder the +%% Translates update, load_module and delete_module, and reorder the %% instructions according to dependencies. Leaves other instructions %% unchanged. %%----------------------------------------------------------------- @@ -538,7 +536,7 @@ get_dependent_instructions(G, WCs, Mod) -> %% Instructions are in order of dependency. %% Appls = [#application] %% -%% Instructions translated are: update, load_module, and remove_module +%% Instructions translated are: update, load_module, and delete_module %% %% Before = [{load_object_code, ...}] %% After = [{suspend, ...}] ++ CodeInstrs ++ [{resume, ...}] @@ -576,17 +574,19 @@ translate_dep_to_low(Mode, Instructions, Appls) -> end, RevUpdateMods)}] end, - LoadRemoveInstrs = + LoadRemoveInstrs0 = filtermap(fun({update, Mod, _, _, _, PreP, PostP, _}) -> {true, {load, {Mod, PreP, PostP}}}; ({load_module, Mod, PreP, PostP, _}) -> {true, {load, {Mod, PreP, PostP}}}; - ({remove_module, Mod, PreP, PostP, _}) -> - {true, {remove, {Mod, PreP, PostP}}}; + ({delete_module, Mod, _}) -> + {true,[{remove, {Mod, brutal_purge, brutal_purge}}, + {purge, [Mod]}]}; (_) -> false end, Instructions), - RevLoadRemoveInstrs = lists:reverse(LoadRemoveInstrs), + LoadRemoveInstrs = lists:flatten(LoadRemoveInstrs0), + RevLoadRemoveInstrs = lists:flatten(lists:reverse(LoadRemoveInstrs0)), %% The order of loading object code is unimportant. The order %% chosen is the order of dependency. @@ -781,10 +781,10 @@ check_op({add_module, Mod, Mods}) -> check_mod(Mod), check_list(Mods), lists:foreach(fun(M) -> check_mod(M) end, Mods); -check_op({remove_module, Mod, PrePurge, PostPurge, Mods}) -> +check_op({delete_module, Mod}) -> + check_mod(Mod); +check_op({delete_module, Mod, Mods}) -> check_mod(Mod), - check_purge(PrePurge), - check_purge(PostPurge), check_list(Mods), lists:foreach(fun(M) -> check_mod(M) end, Mods); check_op({remove_application, Appl}) -> diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/README b/lib/sasl/test/release_handler_SUITE_data/lib/README index ffb8c5120b..5d17950b0b 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/README +++ b/lib/sasl/test/release_handler_SUITE_data/lib/README @@ -21,7 +21,7 @@ start version, includes b_lib and b_server b-2.0: can be upgraded to from b-1.0. -Removes b_lib (soft_purge) and updates b_server (brutal_purge) +Removes b_lib (brutal_purge) and updates b_server (soft_purge) * The diff in purge method is important for test "check_and_purge", in order to check that the purge option to check_install_release works for both methods. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.appup b/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.appup index 001255a88c..9df590e63f 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.appup +++ b/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.appup @@ -1,6 +1,6 @@ %% -*- erlang -*- {"2.0", - [{"1.0",[{remove_module,b_lib,soft_purge,soft_purge,[]}, - {update,b_server,{advanced,[]}}]}], + [{"1.0",[{delete_module,b_lib}, + {update,b_server,{advanced,[]},soft_purge,soft_purge,[]}]}], [{"1.0",[{add_module,b_lib}, - {update,b_server,{advanced,[]}}]}]}. + {update,b_server,{advanced,[]},soft_purge,soft_purge,[]}]}]}. diff --git a/lib/sasl/test/systools_rc_SUITE.erl b/lib/sasl/test/systools_rc_SUITE.erl index 5efab7c028..1afef986d2 100644 --- a/lib/sasl/test/systools_rc_SUITE.erl +++ b/lib/sasl/test/systools_rc_SUITE.erl @@ -22,14 +22,16 @@ -include_lib("sasl/src/systools.hrl"). -export([all/0,groups/0,init_per_group/2,end_per_group/2, syntax_check/1, translate/1, translate_app/1, - translate_emulator_restarts/1]). + translate_emulator_restarts/1, + translate_add_delete_module/1]). %%----------------------------------------------------------------- %% erl -compile systools_rc_SUITE @i ../src/ @i ../../test_server/include/ %% c(systools_rc_SUITE, [{i, "../src"}, {i, "../../test_server/include"}]). %%----------------------------------------------------------------- all() -> - [syntax_check, translate, translate_app, translate_emulator_restarts]. + [syntax_check, translate, translate_app, translate_emulator_restarts, + translate_add_delete_module]. groups() -> []. @@ -707,3 +709,59 @@ translate_emulator_restarts(_Config) -> restart_emulator] = X6, ok. + +translate_add_delete_module(_Config) -> + PreApps = + [#application{name = test, + description = "TEST", + vsn = "0.1", + modules = [foo,bar,baz,old_mod], + regs = [], + mod = {sasl, []}}], + Apps = + [#application{name = test, + description = "TEST", + vsn = "1.0", + modules = [foo,bar,baz,new_mod], + regs = [], + mod = {sasl, []}}], + S1 = [ + {delete_module, old_mod}, + {add_module, new_mod}, + {load_module, foo} + ], + {ok, X1} = systools_rc:translate_scripts([S1], Apps, PreApps), + [{load_object_code,{test,"1.0",[new_mod,foo]}}, + point_of_no_return, + {remove,{old_mod,brutal_purge,brutal_purge}}, + {purge,[old_mod]}, + {load,{new_mod,brutal_purge,brutal_purge}}, + {load,{foo,brutal_purge,brutal_purge}}] = X1, + + S2 = [ + {delete_module, old_mod}, + {add_module, new_mod, [foo]}, + {load_module, foo} + ], + {ok, X2} = systools_rc:translate_scripts([S2], Apps, PreApps), + [{load_object_code,{test,"1.0",[new_mod,foo]}}, + point_of_no_return, + {remove,{old_mod,brutal_purge,brutal_purge}}, + {purge,[old_mod]}, + {load,{foo,brutal_purge,brutal_purge}}, + {load,{new_mod,brutal_purge,brutal_purge}}] = X2, + + S3 = [ + {delete_module, old_mod, [new_mod]}, + {add_module, new_mod, [foo]}, + {load_module, foo} + ], + {ok, X3} = systools_rc:translate_scripts([S3], Apps, PreApps), + [{load_object_code,{test,"1.0",[new_mod,foo]}}, + point_of_no_return, + {load,{foo,brutal_purge,brutal_purge}}, + {load,{new_mod,brutal_purge,brutal_purge}}, + {remove,{old_mod,brutal_purge,brutal_purge}}, + {purge,[old_mod]}] = X3, + + ok. diff --git a/lib/sasl/test/test_lib.hrl b/lib/sasl/test/test_lib.hrl index c8a4e92f24..b16c4ac34c 100644 --- a/lib/sasl/test/test_lib.hrl +++ b/lib/sasl/test/test_lib.hrl @@ -1,3 +1,3 @@ -define(ertsvsn,"4.4"). --define(kernelvsn,"2.16.4"). --define(stdlibvsn,"1.19.4"). +-define(kernelvsn,"3.0"). +-define(stdlibvsn,"2.0"). diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index 18841e3d2d..de6d246403 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -98,7 +98,7 @@ handle_ssh_msg({ssh_cm, ConnectionHandler, Pty = Pty0#ssh_pty{width = Width, height = Height, pixel_width = PixWidth, pixel_height = PixHeight}, - {Chars, NewBuf} = io_request({window_change, Pty0}, Buf, Pty), + {Chars, NewBuf} = io_request({window_change, Pty0}, Buf, Pty, undefined), write_chars(ConnectionHandler, ChannelId, Chars), {ok, State#state{pty = Pty, buf = NewBuf}}; @@ -188,7 +188,7 @@ handle_msg({Group, tty_geometry}, #state{group = Group, handle_msg({Group, Req}, #state{group = Group, buf = Buf, pty = Pty, cm = ConnectionHandler, channel = ChannelId} = State) -> - {Chars, NewBuf} = io_request(Req, Buf, Pty), + {Chars, NewBuf} = io_request(Req, Buf, Pty, Group), write_chars(ConnectionHandler, ChannelId, Chars), {ok, State#state{buf = NewBuf}}; @@ -263,40 +263,49 @@ eval(Error) -> %%% displaying device... %%% We are *not* really unicode aware yet, we just filter away characters %%% beyond the latin1 range. We however handle the unicode binaries... -io_request({window_change, OldTty}, Buf, Tty) -> +io_request({window_change, OldTty}, Buf, Tty, _Group) -> window_change(Tty, OldTty, Buf); -io_request({put_chars, Cs}, Buf, Tty) -> +io_request({put_chars, Cs}, Buf, Tty, _Group) -> put_chars(bin_to_list(Cs), Buf, Tty); -io_request({put_chars, unicode, Cs}, Buf, Tty) -> +io_request({put_chars, unicode, Cs}, Buf, Tty, _Group) -> put_chars(unicode:characters_to_list(Cs,unicode), Buf, Tty); -io_request({insert_chars, Cs}, Buf, Tty) -> +io_request({insert_chars, Cs}, Buf, Tty, _Group) -> insert_chars(bin_to_list(Cs), Buf, Tty); -io_request({insert_chars, unicode, Cs}, Buf, Tty) -> +io_request({insert_chars, unicode, Cs}, Buf, Tty, _Group) -> insert_chars(unicode:characters_to_list(Cs,unicode), Buf, Tty); -io_request({move_rel, N}, Buf, Tty) -> +io_request({move_rel, N}, Buf, Tty, _Group) -> move_rel(N, Buf, Tty); -io_request({delete_chars,N}, Buf, Tty) -> +io_request({delete_chars,N}, Buf, Tty, _Group) -> delete_chars(N, Buf, Tty); -io_request(beep, Buf, _Tty) -> +io_request(beep, Buf, _Tty, _Group) -> {[7], Buf}; %% New in R12 -io_request({get_geometry,columns},Buf,Tty) -> +io_request({get_geometry,columns},Buf,Tty, _Group) -> {ok, Tty#ssh_pty.width, Buf}; -io_request({get_geometry,rows},Buf,Tty) -> +io_request({get_geometry,rows},Buf,Tty, _Group) -> {ok, Tty#ssh_pty.height, Buf}; -io_request({requests,Rs}, Buf, Tty) -> - io_requests(Rs, Buf, Tty, []); -io_request(tty_geometry, Buf, Tty) -> - io_requests([{move_rel, 0}, {put_chars, unicode, [10]}], Buf, Tty, []); +io_request({requests,Rs}, Buf, Tty, Group) -> + io_requests(Rs, Buf, Tty, [], Group); +io_request(tty_geometry, Buf, Tty, Group) -> + io_requests([{move_rel, 0}, {put_chars, unicode, [10]}], + Buf, Tty, [], Group); %{[], Buf}; -io_request(_R, Buf, _Tty) -> + +%% New in 18 +io_request({put_chars_sync, Class, Cs, Reply}, Buf, Tty, Group) -> + %% We handle these asynchronous for now, if we need output guarantees + %% we have to handle these synchronously + Group ! {reply, Reply}, + io_request({put_chars, Class, Cs}, Buf, Tty, Group); + +io_request(_R, Buf, _Tty, _Group) -> {[], Buf}. -io_requests([R|Rs], Buf, Tty, Acc) -> - {Chars, NewBuf} = io_request(R, Buf, Tty), - io_requests(Rs, NewBuf, Tty, [Acc|Chars]); -io_requests([], Buf, _Tty, Acc) -> +io_requests([R|Rs], Buf, Tty, Acc, Group) -> + {Chars, NewBuf} = io_request(R, Buf, Tty, Group), + io_requests(Rs, NewBuf, Tty, [Acc|Chars], Group); +io_requests([], Buf, _Tty, Acc, _Group) -> {Acc, Buf}. %%% return commands for cursor navigation, assume everything is ansi diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index b53344e381..83e5ed82bb 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -136,7 +136,7 @@ </c></p> <p><c>cipher() = rc4_128 | des_cbc | '3des_ede_cbc' - | aes_128_cbc | aes_256_cbc </c></p> + | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm </c></p> <p> <c>hash() = md5 | sha </c></p> diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index 43cb3934f7..c8024548b5 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -75,10 +75,10 @@ </p> </item> - <tag><c><![CDATA[session_cb_init_args = list() <optional>]]></c></tag> + <tag><c><![CDATA[session_cb_init_args = proplist:proplist() <optional>]]></c></tag> <item> <p> - List of arguments to the init function in session cache + List of additional user defined arguments to the init function in session cache callback module, defaults to []. </p> </item> diff --git a/lib/ssl/doc/src/ssl_session_cache_api.xml b/lib/ssl/doc/src/ssl_session_cache_api.xml index 82de1784ca..cb97bbfbb2 100644 --- a/lib/ssl/doc/src/ssl_session_cache_api.xml +++ b/lib/ssl/doc/src/ssl_session_cache_api.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -79,17 +79,25 @@ </func> <func> - <name>init() -> opaque() </name> + <name>init(Args) -> opaque() </name> <fsummary>Return cache reference</fsummary> <type> - <v></v> + <v>Args = proplists:proplist()</v> + <d>Will always include the property {role, client | server}. Currently this + is the only predefined property, there may also be user defined properties. + <seealso marker="ssl_app"> See also application environment variable + session_cb_init_args</seealso> + </d> </type> <desc> <p>Performs possible initializations of the cache and returns a reference to it that will be used as parameter to the other - api functions. Will be called by the cache handling processes - init function, hence putting the same requirements on it as - a normal process init function. + API functions. Will be called by the cache handling processes + init function, hence putting the same requirements on it as a + normal process init function. Note that this function will be + called twice when starting the ssl application, once with the + role client and once with the role server, as the ssl application + must be prepared to take on both roles. </p> </desc> </func> diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index a7bbb6bc40..c0776e822b 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -120,6 +120,26 @@ get_dtls_records_aux(Data, Acc) -> end. encode_plain_text(Type, Version, Data, + #connection_states{current_write = + #connection_state{ + epoch = Epoch, + sequence_number = Seq, + compression_state=CompS0, + security_parameters= + #security_parameters{ + cipher_type = ?AEAD, + compression_algorithm=CompAlg} + }= WriteState0} = ConnectionStates) -> + {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), + WriteState1 = WriteState0#connection_state{compression_state = CompS1}, + AAD = calc_aad(Type, Version, Epoch, Seq), + {CipherFragment, WriteState} = ssl_record:cipher_aead(dtls_v1:corresponding_tls_version(Version), + Comp, WriteState1, AAD), + CipherText = encode_tls_cipher_text(Type, Version, Epoch, Seq, CipherFragment), + {CipherText, ConnectionStates#connection_states{current_write = + WriteState#connection_state{sequence_number = Seq +1}}}; + +encode_plain_text(Type, Version, Data, #connection_states{current_write=#connection_state{ epoch = Epoch, sequence_number = Seq, @@ -141,16 +161,44 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, sequence_number = Seq, fragment = CipherFragment} = CipherText, #connection_states{current_read = - #connection_state{compression_state = CompressionS0, - security_parameters = SecParams} = ReadState0} - = ConnnectionStates0) -> - CompressAlg = SecParams#security_parameters.compression_algorithm, + #connection_state{ + compression_state = CompressionS0, + security_parameters= + #security_parameters{ + cipher_type = ?AEAD, + compression_algorithm=CompAlg} + } = ReadState0}= ConnnectionStates0) -> + AAD = calc_aad(Type, Version, Epoch, Seq), + case ssl_record:decipher_aead(dtls_v1:corresponding_tls_version(Version), + CipherFragment, ReadState0, AAD) of + {PlainFragment, ReadState1} -> + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, + PlainFragment, CompressionS0), + ConnnectionStates = ConnnectionStates0#connection_states{ + current_read = ReadState1#connection_state{ + compression_state = CompressionS1}}, + {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + #alert{} = Alert -> + Alert + end; + +decode_cipher_text(#ssl_tls{type = Type, version = Version, + epoch = Epoch, + sequence_number = Seq, + fragment = CipherFragment} = CipherText, + #connection_states{current_read = + #connection_state{ + compression_state = CompressionS0, + security_parameters= + #security_parameters{ + compression_algorithm=CompAlg} + } = ReadState0}= ConnnectionStates0) -> {PlainFragment, Mac, ReadState1} = ssl_record:decipher(dtls_v1:corresponding_tls_version(Version), CipherFragment, ReadState0), MacHash = calc_mac_hash(ReadState1, Type, Version, Epoch, Seq, PlainFragment), case ssl_record:is_correct_mac(Mac, MacHash) of true -> - {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg, + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, PlainFragment, CompressionS0), ConnnectionStates = ConnnectionStates0#connection_states{ current_read = ReadState1#connection_state{ @@ -368,3 +416,7 @@ calc_mac_hash(#connection_state{mac_secret = MacSecret, mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> dtls_v1:mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment). + +calc_aad(Type, {MajVer, MinVer}, Epoch, SeqNo) -> + NewSeq = (Epoch bsl 48) + SeqNo, + <<NewSeq:64/integer, ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index b4bea25942..dcba69a65e 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -354,7 +354,7 @@ cipher_suites(openssl) -> cipher_suites(all) -> Version = tls_record:highest_protocol_version([]), Supported = ssl_cipher:all_suites(Version) - ++ ssl_cipher:anonymous_suites() + ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) ++ ssl_cipher:srp_suites(), ssl_cipher:filter_suites([suite_definition(S) || S <- Supported]). @@ -953,7 +953,7 @@ binary_cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> All = ssl_cipher:suites(Version) - ++ ssl_cipher:anonymous_suites() + ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) ++ ssl_cipher:srp_suites(), case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 72467ea2a0..e1d89c149e 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -33,9 +33,9 @@ -include_lib("public_key/include/public_key.hrl"). -export([security_parameters/2, security_parameters/3, suite_definition/1, - decipher/5, cipher/5, + cipher_init/3, decipher/5, cipher/5, decipher_aead/6, cipher_aead/6, suite/1, suites/1, all_suites/1, - ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0, + ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]). @@ -44,7 +44,7 @@ key_algo/0]). -type cipher() :: null |rc4_128 | idea_cbc | des40_cbc | des_cbc | '3des_ede_cbc' - | aes_128_cbc | aes_256_cbc. + | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305. -type hash() :: null | sha | md5 | sha224 | sha256 | sha384 | sha512. -type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon. -type erl_cipher_suite() :: {key_algo(), cipher(), hash()}. @@ -88,20 +88,32 @@ security_parameters(Version, CipherSuite, SecParams) -> hash_size = hash_size(Hash)}. %%-------------------------------------------------------------------- +-spec cipher_init(cipher_enum(), binary(), binary()) -> #cipher_state{}. +%% +%% Description: Initializes the #cipher_state according to BCA +%%------------------------------------------------------------------- +cipher_init(?RC4, IV, Key) -> + State = crypto:stream_init(rc4, Key), + #cipher_state{iv = IV, key = Key, state = State}; +cipher_init(?AES_GCM, IV, Key) -> + <<Nonce:64>> = ssl:random_bytes(8), + #cipher_state{iv = IV, key = Key, nonce = Nonce}; +cipher_init(_BCA, IV, Key) -> + #cipher_state{iv = IV, key = Key}. + +%%-------------------------------------------------------------------- -spec cipher(cipher_enum(), #cipher_state{}, binary(), iodata(), ssl_record:ssl_version()) -> {binary(), #cipher_state{}}. %% %% Description: Encrypts the data and the MAC using chipher described %% by cipher_enum() and updating the cipher state +%% Used for "MAC then Cipher" suites where first an HMAC of the +%% data is calculated and the data plus the HMAC is ecncrypted. %%------------------------------------------------------------------- cipher(?NULL, CipherState, <<>>, Fragment, _Version) -> GenStreamCipherList = [Fragment, <<>>], {GenStreamCipherList, CipherState}; -cipher(?RC4, CipherState, Mac, Fragment, _Version) -> - State0 = case CipherState#cipher_state.state of - undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key); - S -> S - end, +cipher(?RC4, CipherState = #cipher_state{state = State0}, Mac, Fragment, _Version) -> GenStreamCipherList = [Fragment, Mac], {State1, T} = crypto:stream_encrypt(State0, GenStreamCipherList), {T, CipherState#cipher_state{state = State1}}; @@ -113,13 +125,40 @@ cipher(?'3DES', CipherState, Mac, Fragment, Version) -> block_cipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> crypto:block_encrypt(des3_cbc, [K1, K2, K3], IV, T) end, block_size(des_cbc), CipherState, Mac, Fragment, Version); -cipher(?AES, CipherState, Mac, Fragment, Version) -> +cipher(?AES_CBC, CipherState, Mac, Fragment, Version) -> block_cipher(fun(Key, IV, T) when byte_size(Key) =:= 16 -> crypto:block_encrypt(aes_cbc128, Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> crypto:block_encrypt(aes_cbc256, Key, IV, T) end, block_size(aes_128_cbc), CipherState, Mac, Fragment, Version). +%%-------------------------------------------------------------------- +-spec cipher_aead(cipher_enum(), #cipher_state{}, integer(), binary(), iodata(), ssl_record:ssl_version()) -> + {binary(), #cipher_state{}}. +%% +%% Description: Encrypts the data and protects associated data (AAD) using chipher +%% described by cipher_enum() and updating the cipher state +%% Use for suites that use authenticated encryption with associated data (AEAD) +%%------------------------------------------------------------------- +cipher_aead(?AES_GCM, CipherState, SeqNo, AAD, Fragment, Version) -> + aead_cipher(aes_gcm, CipherState, SeqNo, AAD, Fragment, Version); +cipher_aead(?CHACHA20_POLY1305, CipherState, SeqNo, AAD, Fragment, Version) -> + aead_cipher(chacha20_poly1305, CipherState, SeqNo, AAD, Fragment, Version). + +aead_cipher(chacha20_poly1305, #cipher_state{key=Key} = CipherState, SeqNo, AAD0, Fragment, _Version) -> + CipherLen = erlang:iolist_size(Fragment), + AAD = <<AAD0/binary, ?UINT16(CipherLen)>>, + Nonce = <<SeqNo:64/integer>>, + {Content, CipherTag} = crypto:block_encrypt(chacha20_poly1305, Key, Nonce, {AAD, Fragment}), + {<<Content/binary, CipherTag/binary>>, CipherState}; +aead_cipher(Type, #cipher_state{key=Key, iv = IV0, nonce = Nonce} = CipherState, _SeqNo, AAD0, Fragment, _Version) -> + CipherLen = erlang:iolist_size(Fragment), + AAD = <<AAD0/binary, ?UINT16(CipherLen)>>, + <<Salt:4/bytes, _/binary>> = IV0, + IV = <<Salt/binary, Nonce:64/integer>>, + {Content, CipherTag} = crypto:block_encrypt(Type, Key, IV, {AAD, Fragment}), + {<<Nonce:64/integer, Content/binary, CipherTag/binary>>, CipherState#cipher_state{nonce = Nonce + 1}}. + build_cipher_block(BlockSz, Mac, Fragment) -> TotSz = byte_size(Mac) + erlang:iolist_size(Fragment) + 1, {PaddingLength, Padding} = get_padding(TotSz, BlockSz), @@ -148,14 +187,12 @@ block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, %% %% Description: Decrypts the data and the MAC using cipher described %% by cipher_enum() and updating the cipher state. +%% Used for "MAC then Cipher" suites where first the data is decrypted +%% and the an HMAC of the decrypted data is checked %%------------------------------------------------------------------- decipher(?NULL, _HashSz, CipherState, Fragment, _) -> {Fragment, <<>>, CipherState}; -decipher(?RC4, HashSz, CipherState, Fragment, _) -> - State0 = case CipherState#cipher_state.state of - undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key); - S -> S - end, +decipher(?RC4, HashSz, CipherState = #cipher_state{state = State0}, Fragment, _) -> try crypto:stream_decrypt(State0, Fragment) of {State, Text} -> GSC = generic_stream_cipher_from_bin(Text, HashSz), @@ -179,13 +216,26 @@ decipher(?'3DES', HashSz, CipherState, Fragment, Version) -> block_decipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> crypto:block_decrypt(des3_cbc, [K1, K2, K3], IV, T) end, CipherState, HashSz, Fragment, Version); -decipher(?AES, HashSz, CipherState, Fragment, Version) -> +decipher(?AES_CBC, HashSz, CipherState, Fragment, Version) -> block_decipher(fun(Key, IV, T) when byte_size(Key) =:= 16 -> crypto:block_decrypt(aes_cbc128, Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> crypto:block_decrypt(aes_cbc256, Key, IV, T) end, CipherState, HashSz, Fragment, Version). +%%-------------------------------------------------------------------- +-spec decipher_aead(cipher_enum(), #cipher_state{}, integer(), binary(), binary(), ssl_record:ssl_version()) -> + {binary(), binary(), #cipher_state{}} | #alert{}. +%% +%% Description: Decrypts the data and checks the associated data (AAD) MAC using +%% cipher described by cipher_enum() and updating the cipher state. +%% Use for suites that use authenticated encryption with associated data (AEAD) +%%------------------------------------------------------------------- +decipher_aead(?AES_GCM, CipherState, SeqNo, AAD, Fragment, Version) -> + aead_decipher(aes_gcm, CipherState, SeqNo, AAD, Fragment, Version); +decipher_aead(?CHACHA20_POLY1305, CipherState, SeqNo, AAD, Fragment, Version) -> + aead_decipher(chacha20_poly1305, CipherState, SeqNo, AAD, Fragment, Version). + block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, HashSz, Fragment, Version) -> try @@ -215,6 +265,35 @@ block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, %% bad_record_mac alert to hide the specific type of the error." ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) end. + +aead_ciphertext_to_state(chacha20_poly1305, SeqNo, _IV, AAD0, Fragment, _Version) -> + CipherLen = size(Fragment) - 16, + <<CipherText:CipherLen/bytes, CipherTag:16/bytes>> = Fragment, + AAD = <<AAD0/binary, ?UINT16(CipherLen)>>, + Nonce = <<SeqNo:64/integer>>, + {Nonce, AAD, CipherText, CipherTag}; +aead_ciphertext_to_state(_, _SeqNo, <<Salt:4/bytes, _/binary>>, AAD0, Fragment, _Version) -> + CipherLen = size(Fragment) - 24, + <<ExplicitNonce:8/bytes, CipherText:CipherLen/bytes, CipherTag:16/bytes>> = Fragment, + AAD = <<AAD0/binary, ?UINT16(CipherLen)>>, + Nonce = <<Salt/binary, ExplicitNonce/binary>>, + {Nonce, AAD, CipherText, CipherTag}. + +aead_decipher(Type, #cipher_state{key = Key, iv = IV} = CipherState, + SeqNo, AAD0, Fragment, Version) -> + try + {Nonce, AAD, CipherText, CipherTag} = aead_ciphertext_to_state(Type, SeqNo, IV, AAD0, Fragment, Version), + case crypto:block_decrypt(Type, Key, Nonce, {AAD, CipherText, CipherTag}) of + Content when is_binary(Content) -> + {Content, CipherState}; + _ -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end + catch + _:_ -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end. + %%-------------------------------------------------------------------- -spec suites(ssl_record:ssl_version()) -> [cipher_suite()]. %% @@ -227,16 +306,26 @@ suites({3, N}) -> all_suites(Version) -> suites(Version) - ++ ssl_cipher:anonymous_suites() + ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) ++ ssl_cipher:srp_suites(). %%-------------------------------------------------------------------- --spec anonymous_suites() -> [cipher_suite()]. +-spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. %% %% Description: Returns a list of the anonymous cipher suites, only supported %% if explicitly set by user. Intended only for testing. %%-------------------------------------------------------------------- -anonymous_suites() -> + +anonymous_suites({3, N}) -> + anonymous_suites(N); + +anonymous_suites(N) + when N >= 3 -> + [?TLS_DH_anon_WITH_AES_128_GCM_SHA256, + ?TLS_DH_anon_WITH_AES_256_GCM_SHA384 + ] ++ anonymous_suites(0); + +anonymous_suites(_) -> [?TLS_DH_anon_WITH_RC4_128_MD5, ?TLS_DH_anon_WITH_DES_CBC_SHA, ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA, @@ -260,13 +349,20 @@ psk_suites({3, N}) -> psk_suites(N) when N >= 3 -> - psk_suites(0) ++ - [?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384, - ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, - ?TLS_PSK_WITH_AES_256_CBC_SHA384, - ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256, - ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256, - ?TLS_PSK_WITH_AES_128_CBC_SHA256]; + [ + ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384, + ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, + ?TLS_PSK_WITH_AES_256_GCM_SHA384, + ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384, + ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, + ?TLS_PSK_WITH_AES_256_CBC_SHA384, + ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256, + ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256, + ?TLS_PSK_WITH_AES_128_CBC_SHA256 + ] ++ psk_suites(0); psk_suites(_) -> [?TLS_DHE_PSK_WITH_AES_256_CBC_SHA, @@ -418,6 +514,19 @@ suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA) -> %%% TLS 1.2 PSK Cipher Suites RFC 5487 +suite_definition(?TLS_PSK_WITH_AES_128_GCM_SHA256) -> + {psk, aes_128_gcm, null, sha256}; +suite_definition(?TLS_PSK_WITH_AES_256_GCM_SHA384) -> + {psk, aes_256_gcm, null, sha384}; +suite_definition(?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256) -> + {dhe_psk, aes_128_gcm, null, sha256}; +suite_definition(?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384) -> + {dhe_psk, aes_256_gcm, null, sha384}; +suite_definition(?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256) -> + {rsa_psk, aes_128_gcm, null, sha256}; +suite_definition(?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384) -> + {rsa_psk, aes_256_gcm, null, sha384}; + suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA256) -> {psk, aes_128_cbc, sha256, default_prf}; suite_definition(?TLS_PSK_WITH_AES_256_CBC_SHA384) -> @@ -537,7 +646,59 @@ suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> {ecdh_rsa, aes_128_cbc, sha256, sha256}; suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> - {ecdh_rsa, aes_256_cbc, sha384, sha384}. + {ecdh_rsa, aes_256_cbc, sha384, sha384}; + +%% RFC 5288 AES-GCM Cipher Suites +suite_definition(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> + {rsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> + {rsa, aes_256_gcm, null, sha384}; +suite_definition(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> + {dhe_rsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> + {dhe_rsa, aes_256_gcm, null, sha384}; +suite_definition(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> + {dh_rsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> + {dh_rsa, aes_256_gcm, null, sha384}; +suite_definition(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> + {dhe_dss, aes_128_gcm, null, sha256}; +suite_definition(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> + {dhe_dss, aes_256_gcm, null, sha384}; +suite_definition(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> + {dh_dss, aes_128_gcm, null, sha256}; +suite_definition(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> + {dh_dss, aes_256_gcm, null, sha384}; +suite_definition(?TLS_DH_anon_WITH_AES_128_GCM_SHA256) -> + {dh_anon, aes_128_gcm, null, sha256}; +suite_definition(?TLS_DH_anon_WITH_AES_256_GCM_SHA384) -> + {dh_anon, aes_256_gcm, null, sha384}; + +%% RFC 5289 ECC AES-GCM Cipher Suites +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> + {ecdhe_ecdsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> + {ecdhe_ecdsa, aes_256_gcm, null, sha384}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> + {ecdh_ecdsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> + {ecdh_ecdsa, aes_256_gcm, null, sha384}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> + {ecdhe_rsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> + {ecdhe_rsa, aes_256_gcm, null, sha384}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> + {ecdh_rsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> + {ecdh_rsa, aes_256_gcm, null, sha384}; + +%% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites +suite_definition(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> + {ecdhe_rsa, chacha20_poly1305, null, sha256}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) -> + {ecdhe_ecdsa, chacha20_poly1305, null, sha256}; +suite_definition(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> + {dhe_rsa, chacha20_poly1305, null, sha256}. %%-------------------------------------------------------------------- -spec suite(erl_cipher_suite()) -> cipher_suite(). @@ -641,6 +802,19 @@ suite({rsa_psk, aes_256_cbc,sha}) -> %%% TLS 1.2 PSK Cipher Suites RFC 5487 +suite({psk, aes_128_gcm, null}) -> + ?TLS_PSK_WITH_AES_128_GCM_SHA256; +suite({psk, aes_256_gcm, null}) -> + ?TLS_PSK_WITH_AES_256_GCM_SHA384; +suite({dhe_psk, aes_128_gcm, null}) -> + ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256; +suite({dhe_psk, aes_256_gcm, null}) -> + ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384; +suite({rsa_psk, aes_128_gcm, null}) -> + ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256; +suite({rsa_psk, aes_256_gcm, null}) -> + ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384; + suite({psk, aes_128_cbc, sha256}) -> ?TLS_PSK_WITH_AES_128_CBC_SHA256; suite({psk, aes_256_cbc, sha384}) -> @@ -760,7 +934,60 @@ suite({ecdhe_rsa, aes_256_cbc, sha384}) -> suite({ecdh_rsa, aes_128_cbc, sha256}) -> ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; suite({ecdh_rsa, aes_256_cbc, sha384}) -> - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384. + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; + +%% RFC 5288 AES-GCM Cipher Suites +suite({rsa, aes_128_gcm, null}) -> + ?TLS_RSA_WITH_AES_128_GCM_SHA256; +suite({rsa, aes_256_gcm, null}) -> + ?TLS_RSA_WITH_AES_256_GCM_SHA384; +suite({dhe_rsa, aes_128_gcm, null}) -> + ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; +suite({dhe_rsa, aes_256_gcm, null}) -> + ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; +suite({dh_rsa, aes_128_gcm, null}) -> + ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; +suite({dh_rsa, aes_256_gcm, null}) -> + ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; +suite({dhe_dss, aes_128_gcm, null}) -> + ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; +suite({dhe_dss, aes_256_gcm, null}) -> + ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; +suite({dh_dss, aes_128_gcm, null}) -> + ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; +suite({dh_dss, aes_256_gcm, null}) -> + ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; +suite({dh_anon, aes_128_gcm, null}) -> + ?TLS_DH_anon_WITH_AES_128_GCM_SHA256; +suite({dh_anon, aes_256_gcm, null}) -> + ?TLS_DH_anon_WITH_AES_256_GCM_SHA384; + +%% RFC 5289 ECC AES-GCM Cipher Suites +suite({ecdhe_ecdsa, aes_128_gcm, null}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; +suite({ecdhe_ecdsa, aes_256_gcm, null}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; +suite({ecdh_ecdsa, aes_128_gcm, null}) -> + ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; +suite({ecdh_ecdsa, aes_256_gcm, null}) -> + ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; +suite({ecdhe_rsa, aes_128_gcm, null}) -> + ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; +suite({ecdhe_rsa, aes_256_gcm, null}) -> + ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; +suite({ecdh_rsa, aes_128_gcm, null}) -> + ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; +suite({ecdh_rsa, aes_256_gcm, null}) -> + ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384; + + +%% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites +suite({ecdhe_rsa, chacha20_poly1305, null}) -> + ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256; +suite({ecdhe_ecdsa, chacha20_poly1305, null}) -> + ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256; +suite({dhe_rsa, chacha20_poly1305, null}) -> + ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256. %%-------------------------------------------------------------------- -spec openssl_suite(openssl_cipher_suite()) -> cipher_suite(). @@ -875,7 +1102,47 @@ openssl_suite("ECDHE-RSA-AES256-SHA384") -> openssl_suite("ECDH-RSA-AES128-SHA256") -> ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; openssl_suite("ECDH-RSA-AES256-SHA384") -> - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384. + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; + +%% RFC 5288 AES-GCM Cipher Suites +openssl_suite("AES128-GCM-SHA256") -> + ?TLS_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("AES256-GCM-SHA384") -> + ?TLS_RSA_WITH_AES_256_GCM_SHA384; +openssl_suite("DHE-RSA-AES128-GCM-SHA256") -> + ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("DHE-RSA-AES256-GCM-SHA384") -> + ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; +openssl_suite("DH-RSA-AES128-GCM-SHA256") -> + ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("DH-RSA-AES256-GCM-SHA384") -> + ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; +openssl_suite("DHE-DSS-AES128-GCM-SHA256") -> + ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; +openssl_suite("DHE-DSS-AES256-GCM-SHA384") -> + ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; +openssl_suite("DH-DSS-AES128-GCM-SHA256") -> + ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; +openssl_suite("DH-DSS-AES256-GCM-SHA384") -> + ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; + +%% RFC 5289 ECC AES-GCM Cipher Suites +openssl_suite("ECDHE-ECDSA-AES128-GCM-SHA256") -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; +openssl_suite("ECDHE-ECDSA-AES256-GCM-SHA384") -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; +openssl_suite("ECDH-ECDSA-AES128-GCM-SHA256") -> + ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; +openssl_suite("ECDH-ECDSA-AES256-GCM-SHA384") -> + ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; +openssl_suite("ECDHE-RSA-AES128-GCM-SHA256") -> + ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("ECDHE-RSA-AES256-GCM-SHA384") -> + ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; +openssl_suite("ECDH-RSA-AES128-GCM-SHA256") -> + ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("ECDH-RSA-AES256-GCM-SHA384") -> + ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384. %%-------------------------------------------------------------------- -spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite(). @@ -1012,6 +1279,46 @@ openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> "ECDH-RSA-AES256-SHA384"; +%% RFC 5288 AES-GCM Cipher Suites +openssl_suite_name(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> + "AES128-GCM-SHA256"; +openssl_suite_name(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> + "AES256-GCM-SHA384"; +openssl_suite_name(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> + "DHE-RSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> + "DHE-RSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> + "DH-RSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> + "DH-RSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> + "DHE-DSS-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> + "DHE-DSS-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> + "DH-DSS-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> + "DH-DSS-AES256-GCM-SHA384"; + +%% RFC 5289 ECC AES-GCM Cipher Suites +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> + "ECDHE-ECDSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> + "ECDHE-ECDSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> + "ECDH-ECDSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> + "ECDH-ECDSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> + "ECDHE-RSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> + "ECDHE-RSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> + "ECDH-RSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> + "ECDH-RSA-AES256-GCM-SHA384"; + %% No oppenssl name openssl_suite_name(Cipher) -> suite_definition(Cipher). @@ -1095,6 +1402,13 @@ is_acceptable_keyexchange(KeyExchange, Algos) is_acceptable_keyexchange(_, _) -> true. +is_acceptable_cipher(Cipher, Algos) + when Cipher == aes_128_gcm; + Cipher == aes_256_gcm -> + proplists:get_bool(aes_gcm, Algos); +is_acceptable_cipher(Cipher, Algos) + when Cipher == chacha20_poly1305 -> + proplists:get_bool(Cipher, Algos); is_acceptable_cipher(_, _) -> true. @@ -1122,7 +1436,12 @@ bulk_cipher_algorithm('3des_ede_cbc') -> ?'3DES'; bulk_cipher_algorithm(Cipher) when Cipher == aes_128_cbc; Cipher == aes_256_cbc -> - ?AES. + ?AES_CBC; +bulk_cipher_algorithm(Cipher) when Cipher == aes_128_gcm; + Cipher == aes_256_gcm -> + ?AES_GCM; +bulk_cipher_algorithm(chacha20_poly1305) -> + ?CHACHA20_POLY1305. type(Cipher) when Cipher == null; Cipher == rc4_128 -> @@ -1132,7 +1451,11 @@ type(Cipher) when Cipher == des_cbc; Cipher == '3des_ede_cbc'; Cipher == aes_128_cbc; Cipher == aes_256_cbc -> - ?BLOCK. + ?BLOCK; +type(Cipher) when Cipher == aes_128_gcm; + Cipher == aes_256_gcm; + Cipher == chacha20_poly1305 -> + ?AEAD. key_material(null) -> 0; @@ -1145,6 +1468,12 @@ key_material('3des_ede_cbc') -> key_material(aes_128_cbc) -> 16; key_material(aes_256_cbc) -> + 32; +key_material(aes_128_gcm) -> + 16; +key_material(aes_256_gcm) -> + 32; +key_material(chacha20_poly1305) -> 32. expanded_key_material(null) -> @@ -1156,7 +1485,10 @@ expanded_key_material(Cipher) when Cipher == des_cbc -> expanded_key_material('3des_ede_cbc') -> 24; expanded_key_material(Cipher) when Cipher == aes_128_cbc; - Cipher == aes_256_cbc -> + Cipher == aes_256_cbc; + Cipher == aes_128_gcm; + Cipher == aes_256_gcm; + Cipher == chacha20_poly1305 -> unknown. @@ -1165,16 +1497,25 @@ effective_key_bits(null) -> effective_key_bits(des_cbc) -> 56; effective_key_bits(Cipher) when Cipher == rc4_128; - Cipher == aes_128_cbc -> + Cipher == aes_128_cbc; + Cipher == aes_128_gcm -> 128; effective_key_bits('3des_ede_cbc') -> 168; -effective_key_bits(aes_256_cbc) -> +effective_key_bits(Cipher) when Cipher == aes_256_cbc; + Cipher == aes_256_gcm; + Cipher == chacha20_poly1305 -> 256. iv_size(Cipher) when Cipher == null; - Cipher == rc4_128 -> + Cipher == rc4_128; + Cipher == chacha20_poly1305-> 0; + +iv_size(Cipher) when Cipher == aes_128_gcm; + Cipher == aes_256_gcm -> + 4; + iv_size(Cipher) -> block_size(Cipher). @@ -1183,7 +1524,10 @@ block_size(Cipher) when Cipher == des_cbc; 8; block_size(Cipher) when Cipher == aes_128_cbc; - Cipher == aes_256_cbc -> + Cipher == aes_256_cbc; + Cipher == aes_128_gcm; + Cipher == aes_256_gcm; + Cipher == chacha20_poly1305 -> 16. prf_algorithm(default_prf, {3, N}) when N >= 3 -> @@ -1337,10 +1681,15 @@ dhe_rsa_suites() -> ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, - ?TLS_DHE_RSA_WITH_DES_CBC_SHA]. + ?TLS_DHE_RSA_WITH_DES_CBC_SHA, + ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, + ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, + ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256]. psk_rsa_suites() -> - [?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, + [?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, + ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256, ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA, ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA, @@ -1360,7 +1709,9 @@ rsa_suites() -> ?TLS_RSA_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5, - ?TLS_RSA_WITH_DES_CBC_SHA]. + ?TLS_RSA_WITH_DES_CBC_SHA, + ?TLS_RSA_WITH_AES_128_GCM_SHA256, + ?TLS_RSA_WITH_AES_256_GCM_SHA384]. ecdh_rsa_suites() -> [?TLS_ECDH_RSA_WITH_NULL_SHA, @@ -1369,7 +1720,9 @@ ecdh_rsa_suites() -> ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA, ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA, ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256, - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384]. + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384]. ecdhe_rsa_suites() -> [?TLS_ECDHE_RSA_WITH_NULL_SHA, @@ -1378,7 +1731,10 @@ ecdhe_rsa_suites() -> ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA, ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA, ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256, - ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384]. + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384, + ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256]. dsa_signed_suites() -> dhe_dss_suites() ++ srp_dss_suites(). @@ -1389,7 +1745,9 @@ dhe_dss_suites() -> ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, - ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA]. + ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, + ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256, + ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384]. srp_dss_suites() -> [?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA, @@ -1413,7 +1771,9 @@ ecdh_ecdsa_suites() -> ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA, ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256, - ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384]. + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384]. ecdhe_ecdsa_suites() -> [?TLS_ECDHE_ECDSA_WITH_NULL_SHA, @@ -1422,7 +1782,10 @@ ecdhe_ecdsa_suites() -> ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA, ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA, ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256, - ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384]. + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384, + ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256]. filter_keyuse(OtpCert, Ciphers, Suites, SignSuites) -> TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index 3ce9c19aa9..448c2405aa 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -46,7 +46,8 @@ -record(cipher_state, { iv, key, - state + state, + nonce }). %%% TLS_NULL_WITH_NULL_NULL is specified and is the initial state of a @@ -395,6 +396,24 @@ %%% TLS 1.2 PSK Cipher Suites RFC 5487 +%% TLS_PSK_WITH_AES_128_GCM_SHA256 = {0x00,0xA8}; +-define(TLS_PSK_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A8)>>). + +%% TLS_PSK_WITH_AES_256_GCM_SHA384 = {0x00,0xA9}; +-define(TLS_PSK_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A9)>>). + +%% TLS_DHE_PSK_WITH_AES_128_GCM_SHA256 = {0x00,0xAA}; +-define(TLS_DHE_PSK_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#AA)>>). + +%% TLS_DHE_PSK_WITH_AES_256_GCM_SHA384 = {0x00,0xAB}; +-define(TLS_DHE_PSK_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#AB)>>). + +%% TLS_RSA_PSK_WITH_AES_128_GCM_SHA256 = {0x00,0xAC}; +-define(TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#AC)>>). + +%% TLS_RSA_PSK_WITH_AES_256_GCM_SHA384 = {0x00,0xAD}; +-define(TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#AD)>>). + %% TLS_PSK_WITH_AES_128_CBC_SHA256 = {0x00,0xAE}; -define(TLS_PSK_WITH_AES_128_CBC_SHA256, <<?BYTE(16#00), ?BYTE(16#AE)>>). @@ -460,4 +479,79 @@ %% TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA = { 0xC0,0x22 }; -define(TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#22)>>). +%%% AES-GCM Cipher Suites RFC 5288 + +%% TLS_RSA_WITH_AES_128_GCM_SHA256 = {0x00,0x9C} +-define(TLS_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#9C)>>). + +%% TLS_RSA_WITH_AES_256_GCM_SHA384 = {0x00,0x9D} +-define(TLS_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#9D)>>). + +%% TLS_DHE_RSA_WITH_AES_128_GCM_SHA256 = {0x00,0x9E} +-define(TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#9E)>>). + +%% TLS_DHE_RSA_WITH_AES_256_GCM_SHA384 = {0x00,0x9F} +-define(TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#9F)>>). + +%% TLS_DH_RSA_WITH_AES_128_GCM_SHA256 = {0x00,0xA0} +-define(TLS_DH_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A0)>>). + +%% TLS_DH_RSA_WITH_AES_256_GCM_SHA384 = {0x00,0xA1} +-define(TLS_DH_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A1)>>). + +%% TLS_DHE_DSS_WITH_AES_128_GCM_SHA256 = {0x00,0xA2} +-define(TLS_DHE_DSS_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A2)>>). + +%% TLS_DHE_DSS_WITH_AES_256_GCM_SHA384 = {0x00,0xA3} +-define(TLS_DHE_DSS_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A3)>>). + +%% TLS_DH_DSS_WITH_AES_128_GCM_SHA256 = {0x00,0xA4} +-define(TLS_DH_DSS_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A4)>>). + +%% TLS_DH_DSS_WITH_AES_256_GCM_SHA384 = {0x00,0xA5} +-define(TLS_DH_DSS_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A5)>>). + +%% TLS_DH_anon_WITH_AES_128_GCM_SHA256 = {0x00,0xA6} +-define(TLS_DH_anon_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A6)>>). + +%% TLS_DH_anon_WITH_AES_256_GCM_SHA384 = {0x00,0xA7} +-define(TLS_DH_anon_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A7)>>). + +%%% ECC AES-GCM Cipher Suites RFC 5289 + +%% TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 = {0xC0,0x2B}; +-define(TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#C0), ?BYTE(16#2B)>>). + +%% TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x2C}; +-define(TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#2C)>>). + +%% TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256 = {0xC0,0x2D}; +-define(TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#C0), ?BYTE(16#2D)>>). + +%% TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x2E}; +-define(TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#2E)>>). + +%% TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256 = {0xC0,0x2F}; +-define(TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#C0), ?BYTE(16#2F)>>). + +%% TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x30}; +-define(TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#30)>>). + +%% TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256 = {0xC0,0x31}; +-define(TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#C0), ?BYTE(16#31)>>). + +%% TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x32}; +-define(TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#32)>>). + +%%% Chacha20/Poly1305 Suites draft-agl-tls-chacha20poly1305-04 + +%% TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x13} +-define(TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#13)>>). + +%% TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x14} +-define(TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#14)>>). + +%% TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x15} +-define(TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#15)>>). + -endif. % -ifdef(ssl_cipher). diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 88ccb94e0b..07535e79b4 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -1435,6 +1435,7 @@ calc_finished({3, N}, Role, PrfAlgo, MasterSecret, Handshake) -> master_secret(_RecordCB, Version, MasterSecret, #security_parameters{ + bulk_cipher_algorithm = BCA, client_random = ClientRandom, server_random = ServerRandom, hash_size = HashSize, @@ -1453,8 +1454,8 @@ master_secret(_RecordCB, Version, MasterSecret, ssl_record:set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret, Role, ConnStates1), - ClientCipherState = #cipher_state{iv = ClientIV, key = ClientWriteKey}, - ServerCipherState = #cipher_state{iv = ServerIV, key = ServerWriteKey}, + ClientCipherState = ssl_cipher:cipher_init(BCA, ClientIV, ClientWriteKey), + ServerCipherState = ssl_cipher:cipher_init(BCA, ServerIV, ServerWriteKey), {MasterSecret, ssl_record:set_pending_cipher_state(ConnStates2, ClientCipherState, ServerCipherState, Role)}. diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index d6e5064c39..5553fc9220 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -44,7 +44,8 @@ -include_lib("kernel/include/file.hrl"). -record(state, { - session_cache, + session_cache_client, + session_cache_server, session_cache_cb, session_lifetime, certificate_db, @@ -209,12 +210,16 @@ init([Name, Opts]) -> SessionLifeTime = proplists:get_value(session_lifetime, Opts, ?'24H_in_sec'), CertDb = ssl_pkix_db:create(), - SessionCache = CacheCb:init(proplists:get_value(session_cb_init_args, Opts, [])), + ClientSessionCache = CacheCb:init([{role, client} | + proplists:get_value(session_cb_init_args, Opts, [])]), + ServerSessionCache = CacheCb:init([{role, server} | + proplists:get_value(session_cb_init_args, Opts, [])]), Timer = erlang:send_after(SessionLifeTime * 1000 + 5000, self(), validate_sessions), erlang:send_after(?CLEAR_PEM_CACHE, self(), clear_pem_cache), {ok, #state{certificate_db = CertDb, - session_cache = SessionCache, + session_cache_client = ClientSessionCache, + session_cache_server = ServerSessionCache, session_cache_cb = CacheCb, session_lifetime = SessionLifeTime, session_validation_timer = Timer}}. @@ -230,15 +235,32 @@ init([Name, Opts]) -> %% %% Description: Handling call messages %%-------------------------------------------------------------------- -handle_call({{connection_init, <<>>, _Role}, _Pid}, _From, +handle_call({{connection_init, <<>>, client}, _Pid}, _From, #state{certificate_db = [CertDb, FileRefDb, PemChace], - session_cache = Cache} = State) -> + session_cache_client = Cache} = State) -> + Result = {ok, make_ref(),CertDb, FileRefDb, PemChace, Cache}, + {reply, Result, State}; +handle_call({{connection_init, <<>>, server}, _Pid}, _From, + #state{certificate_db = [CertDb, FileRefDb, PemChace], + session_cache_server = Cache} = State) -> Result = {ok, make_ref(),CertDb, FileRefDb, PemChace, Cache}, {reply, Result, State}; -handle_call({{connection_init, Trustedcerts, _Role}, Pid}, _From, +handle_call({{connection_init, Trustedcerts, client}, Pid}, _From, + #state{certificate_db = [CertDb, FileRefDb, PemChace] = Db, + session_cache_client = Cache} = State) -> + Result = + try + {ok, Ref} = ssl_pkix_db:add_trusted_certs(Pid, Trustedcerts, Db), + {ok, Ref, CertDb, FileRefDb, PemChace, Cache} + catch + _:Reason -> + {error, Reason} + end, + {reply, Result, State}; +handle_call({{connection_init, Trustedcerts, server}, Pid}, _From, #state{certificate_db = [CertDb, FileRefDb, PemChace] = Db, - session_cache = Cache} = State) -> + session_cache_server = Cache} = State) -> Result = try {ok, Ref} = ssl_pkix_db:add_trusted_certs(Pid, Trustedcerts, Db), @@ -249,9 +271,10 @@ handle_call({{connection_init, Trustedcerts, _Role}, Pid}, _From, end, {reply, Result, State}; + handle_call({{new_session_id,Port}, _}, _, #state{session_cache_cb = CacheCb, - session_cache = Cache} = State) -> + session_cache_server = Cache} = State) -> Id = new_id(Port, ?GEN_UNIQUE_ID_MAX_TRIES, Cache, CacheCb), {reply, Id, State}; @@ -278,16 +301,22 @@ handle_call({unconditionally_clear_pem_cache, _},_, #state{certificate_db = [_,_ %% Description: Handling cast messages %%-------------------------------------------------------------------- handle_cast({register_session, Host, Port, Session}, - #state{session_cache = Cache, + #state{session_cache_client = Cache, session_cache_cb = CacheCb} = State) -> TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}), NewSession = Session#session{time_stamp = TimeStamp}, - CacheCb:update(Cache, {{Host, Port}, - NewSession#session.session_id}, NewSession), + + case CacheCb:select_session(Cache, {Host, Port}) of + no_session -> + CacheCb:update(Cache, {{Host, Port}, + NewSession#session.session_id}, NewSession); + Sessions -> + register_unique_session(Sessions, NewSession, CacheCb, Cache, {Host, Port}) + end, {noreply, State}; handle_cast({register_session, Port, Session}, - #state{session_cache = Cache, + #state{session_cache_server = Cache, session_cache_cb = CacheCb} = State) -> TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}), NewSession = Session#session{time_stamp = TimeStamp}, @@ -296,12 +325,12 @@ handle_cast({register_session, Port, Session}, handle_cast({invalidate_session, Host, Port, #session{session_id = ID} = Session}, - #state{session_cache = Cache, + #state{session_cache_client = Cache, session_cache_cb = CacheCb} = State) -> invalidate_session(Cache, CacheCb, {{Host, Port}, ID}, Session, State); handle_cast({invalidate_session, Port, #session{session_id = ID} = Session}, - #state{session_cache = Cache, + #state{session_cache_server = Cache, session_cache_cb = CacheCb} = State) -> invalidate_session(Cache, CacheCb, {Port, ID}, Session, State). @@ -314,17 +343,18 @@ handle_cast({invalidate_session, Port, #session{session_id = ID} = Session}, %% Description: Handling all non call/cast messages %%------------------------------------------------------------------- handle_info(validate_sessions, #state{session_cache_cb = CacheCb, - session_cache = Cache, + session_cache_client = ClientCache, + session_cache_server = ServerCache, session_lifetime = LifeTime } = State) -> Timer = erlang:send_after(?SESSION_VALIDATION_INTERVAL, self(), validate_sessions), - start_session_validator(Cache, CacheCb, LifeTime), + start_session_validator(ClientCache, CacheCb, LifeTime), + start_session_validator(ServerCache, CacheCb, LifeTime), {noreply, State#state{session_validation_timer = Timer}}; -handle_info({delayed_clean_session, Key}, #state{session_cache = Cache, - session_cache_cb = CacheCb - } = State) -> +handle_info({delayed_clean_session, Key, Cache}, #state{session_cache_cb = CacheCb + } = State) -> CacheCb:delete(Cache, Key), {noreply, State}; @@ -367,12 +397,14 @@ handle_info(_Info, State) -> %% The return value is ignored. %%-------------------------------------------------------------------- terminate(_Reason, #state{certificate_db = Db, - session_cache = SessionCache, + session_cache_client = ClientSessionCache, + session_cache_server = ServerSessionCache, session_cache_cb = CacheCb, session_validation_timer = Timer}) -> erlang:cancel_timer(Timer), ssl_pkix_db:remove(Db), - CacheCb:terminate(SessionCache), + catch CacheCb:terminate(ClientSessionCache), + catch CacheCb:terminate(ServerSessionCache), ok. %%-------------------------------------------------------------------- @@ -445,7 +477,7 @@ invalidate_session(Cache, CacheCb, Key, Session, #state{last_delay_timer = LastT %% up the session data but new connections should not get to use this session. CacheCb:update(Cache, Key, Session#session{is_resumable = false}), TRef = - erlang:send_after(delay_time(), self(), {delayed_clean_session, Key}), + erlang:send_after(delay_time(), self(), {delayed_clean_session, Key, Cache}), {noreply, State#state{last_delay_timer = last_delay_timer(Key, TRef, LastTimer)}} end. @@ -494,3 +526,34 @@ clean_cert_db(Ref, CertDb, RefDb, PemCache, File) -> _ -> ok end. + +%% Do not let dumb clients create a gigantic session table +%% for itself creating big delays at connection time. +register_unique_session(Sessions, Session, CacheCb, Cache, PartialKey) -> + case exists_equivalent(Session , Sessions) of + true -> + ok; + false -> + CacheCb:update(Cache, {PartialKey, + Session#session.session_id}, Session) + end. + +exists_equivalent(_, []) -> + false; +exists_equivalent(#session{ + peer_certificate = PeerCert, + own_certificate = OwnCert, + compression_method = Compress, + cipher_suite = CipherSuite, + srp_username = SRP, + ecc = ECC} , + [#session{ + peer_certificate = PeerCert, + own_certificate = OwnCert, + compression_method = Compress, + cipher_suite = CipherSuite, + srp_username = SRP, + ecc = ECC} | _]) -> + true; +exists_equivalent(Session, [ _ | Rest]) -> + exists_equivalent(Session, Rest). diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 7337225bc4..63fc57edad 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -48,7 +48,8 @@ -export([compress/3, uncompress/3, compressions/0]). %% Payload encryption/decryption --export([cipher/4, decipher/3, is_correct_mac/2]). +-export([cipher/4, decipher/3, is_correct_mac/2, + cipher_aead/4, decipher_aead/4]). -export_type([ssl_version/0, ssl_atom_version/0]). @@ -377,6 +378,24 @@ cipher(Version, Fragment, ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version), {CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}. %%-------------------------------------------------------------------- +-spec cipher_aead(ssl_version(), iodata(), #connection_state{}, MacHash::binary()) -> + {CipherFragment::binary(), #connection_state{}}. +%% +%% Description: Payload encryption +%%-------------------------------------------------------------------- +cipher_aead(Version, Fragment, + #connection_state{cipher_state = CipherS0, + sequence_number = SeqNo, + security_parameters= + #security_parameters{bulk_cipher_algorithm = + BulkCipherAlgo} + } = WriteState0, AAD) -> + + {CipherFragment, CipherS1} = + ssl_cipher:cipher_aead(BulkCipherAlgo, CipherS0, SeqNo, AAD, Fragment, Version), + {CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}. + +%%-------------------------------------------------------------------- -spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}} | #alert{}. %% %% Description: Payload decryption @@ -396,6 +415,25 @@ decipher(Version, CipherFragment, Alert end. %%-------------------------------------------------------------------- +-spec decipher_aead(ssl_version(), binary(), #connection_state{}, binary()) -> {binary(), binary(), #connection_state{}} | #alert{}. +%% +%% Description: Payload decryption +%%-------------------------------------------------------------------- +decipher_aead(Version, CipherFragment, + #connection_state{sequence_number = SeqNo, + security_parameters = + #security_parameters{bulk_cipher_algorithm = + BulkCipherAlgo}, + cipher_state = CipherS0 + } = ReadState, AAD) -> + case ssl_cipher:decipher_aead(BulkCipherAlgo, CipherS0, SeqNo, AAD, CipherFragment, Version) of + {PlainFragment, CipherS1} -> + CS1 = ReadState#connection_state{cipher_state = CipherS1}, + {PlainFragment, CS1}; + #alert{} = Alert -> + Alert + end. +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- empty_connection_state(ConnectionEnd) -> diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index 6aab35d6da..53b5f2399b 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -90,11 +90,14 @@ -define('3DES', 4). -define(DES40, 5). -define(IDEA, 6). --define(AES, 7). +-define(AES_CBC, 7). +-define(AES_GCM, 8). +-define(CHACHA20_POLY1305, 9). %% CipherType -define(STREAM, 0). -define(BLOCK, 1). +-define(AEAD, 2). %% IsExportable %-define(TRUE, 0). %% Already defined by ssl_internal.hrl diff --git a/lib/ssl/src/ssl_session_cache.erl b/lib/ssl/src/ssl_session_cache.erl index 5c6ee3c54c..b011732f2c 100644 --- a/lib/ssl/src/ssl_session_cache.erl +++ b/lib/ssl/src/ssl_session_cache.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2012. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -31,8 +31,8 @@ %%-------------------------------------------------------------------- %% Description: Return table reference. Called by ssl_manager process. %%-------------------------------------------------------------------- -init(_) -> - ets:new(cache_name(), [ordered_set, protected]). +init(Options) -> + ets:new(cache_name(proplists:get_value(role, Options)), [ordered_set, protected]). %%-------------------------------------------------------------------- %% Description: Handles cache table at termination of ssl manager. @@ -87,5 +87,5 @@ select_session(Cache, PartialKey) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -cache_name() -> - ssl_otp_session_cache. +cache_name(Name) -> + list_to_atom(atom_to_list(Name) ++ "_ssl_otp_session_cache"). diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index f50ea22f39..544d200f70 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -132,6 +132,23 @@ encode_plain_text(Type, Version, Data, sequence_number = Seq, compression_state=CompS0, security_parameters= + #security_parameters{ + cipher_type = ?AEAD, + compression_algorithm=CompAlg} + }= WriteState0} = ConnectionStates) -> + {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), + WriteState1 = WriteState0#connection_state{compression_state = CompS1}, + AAD = calc_aad(Type, Version, WriteState1), + {CipherFragment, WriteState} = ssl_record:cipher_aead(Version, Comp, WriteState1, AAD), + CipherText = encode_tls_cipher_text(Type, Version, CipherFragment), + {CipherText, ConnectionStates#connection_states{current_write = WriteState#connection_state{sequence_number = Seq +1}}}; + +encode_plain_text(Type, Version, Data, + #connection_states{current_write = + #connection_state{ + sequence_number = Seq, + compression_state=CompS0, + security_parameters= #security_parameters{compression_algorithm=CompAlg} }= WriteState0} = ConnectionStates) -> {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), @@ -148,18 +165,45 @@ encode_plain_text(Type, Version, Data, %% Description: Decode cipher text %%-------------------------------------------------------------------- decode_cipher_text(#ssl_tls{type = Type, version = Version, - fragment = CipherFragment} = CipherText, ConnnectionStates0) -> - ReadState0 = ConnnectionStates0#connection_states.current_read, - #connection_state{compression_state = CompressionS0, - sequence_number = Seq, - security_parameters = SecParams} = ReadState0, - CompressAlg = SecParams#security_parameters.compression_algorithm, + fragment = CipherFragment} = CipherText, + #connection_states{current_read = + #connection_state{ + compression_state = CompressionS0, + sequence_number = Seq, + security_parameters= + #security_parameters{ + cipher_type = ?AEAD, + compression_algorithm=CompAlg} + } = ReadState0} = ConnnectionStates0) -> + AAD = calc_aad(Type, Version, ReadState0), + case ssl_record:decipher_aead(Version, CipherFragment, ReadState0, AAD) of + {PlainFragment, ReadState1} -> + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, + PlainFragment, CompressionS0), + ConnnectionStates = ConnnectionStates0#connection_states{ + current_read = ReadState1#connection_state{ + sequence_number = Seq + 1, + compression_state = CompressionS1}}, + {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + #alert{} = Alert -> + Alert + end; + +decode_cipher_text(#ssl_tls{type = Type, version = Version, + fragment = CipherFragment} = CipherText, + #connection_states{current_read = + #connection_state{ + compression_state = CompressionS0, + sequence_number = Seq, + security_parameters= + #security_parameters{compression_algorithm=CompAlg} + } = ReadState0} = ConnnectionStates0) -> case ssl_record:decipher(Version, CipherFragment, ReadState0) of {PlainFragment, Mac, ReadState1} -> MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1), case ssl_record:is_correct_mac(Mac, MacHash) of true -> - {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg, + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, PlainFragment, CompressionS0), ConnnectionStates = ConnnectionStates0#connection_states{ current_read = ReadState1#connection_state{ @@ -322,3 +366,7 @@ calc_mac_hash(Type, Version, mac_hash(Version, SecPars#security_parameters.mac_algorithm, MacSecret, SeqNo, Type, Length, PlainFragment). + +calc_aad(Type, {MajVer, MinVer}, + #connection_state{sequence_number = SeqNo}) -> + <<SeqNo:64/integer, ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>. diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 7a5f9c1b38..c4114278a4 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -221,25 +221,50 @@ suites(Minor) when Minor == 1; Minor == 2 -> ]; suites(3) -> [ + ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, + ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, + + ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384, + ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384, ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384, ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384, + ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384, ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384, ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384, + ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, + ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, + ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384, ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256, + ?TLS_RSA_WITH_AES_256_GCM_SHA384, ?TLS_RSA_WITH_AES_256_CBC_SHA256, + ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256, ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256, ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256, + ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256, ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256, ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256, + ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, + ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, + ?TLS_RSA_WITH_AES_128_GCM_SHA256, ?TLS_RSA_WITH_AES_128_CBC_SHA256 + + %% not supported + %% ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384, + %% ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384, + %% ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256, + %% ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256 ] ++ suites(2). + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 2f8ff6f04e..3639c2b2da 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -37,6 +37,7 @@ VSN=$(GS_VSN) MODULES = \ ssl_test_lib \ ssl_basic_SUITE \ + ssl_bench_SUITE \ ssl_cipher_SUITE \ ssl_certificate_verify_SUITE\ ssl_crl_SUITE\ @@ -130,7 +131,7 @@ release_spec: opt release_tests_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)" $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(HRL_FILES_NEEDED_IN_TEST) $(COVER_FILE) "$(RELSYSDIR)" - $(INSTALL_DATA) ssl.spec ssl.cover "$(RELSYSDIR)" + $(INSTALL_DATA) ssl.spec ssl_bench.spec ssl.cover "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) diff --git a/lib/ssl/test/ssl.spec b/lib/ssl/test/ssl.spec index fc7c1bbb82..86e14c033e 100644 --- a/lib/ssl/test/ssl.spec +++ b/lib/ssl/test/ssl.spec @@ -1 +1,4 @@ {suites,"../ssl_test",all}. +{skip_cases, "../ssl_test", + ssl_bench_SUITE, [setup_sequential, setup_concurrent, payload_simple], + "Benchmarks run separately"}. diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 1da4e88077..dc9e8934e6 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -629,7 +629,7 @@ clear_pem_cache(Config) when is_list(Config) -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), - [_,FilRefDb, _] = element(5, State), + [_,FilRefDb, _] = element(6, State), {Server, Client} = basic_verify_test_no_close(Config), 2 = ets:info(FilRefDb, size), ssl:clear_pem_cache(), @@ -2339,7 +2339,7 @@ der_input(Config) when is_list(Config) -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), - [CADb | _] = element(5, State), + [CADb | _] = element(6, State), [] = ets:tab2list(CADb). %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/ssl_bench.spec b/lib/ssl/test/ssl_bench.spec new file mode 100644 index 0000000000..d2f75b4203 --- /dev/null +++ b/lib/ssl/test/ssl_bench.spec @@ -0,0 +1 @@ +{suites,"../ssl_test",[ssl_bench_SUITE]}. diff --git a/lib/ssl/test/ssl_bench_SUITE.erl b/lib/ssl/test/ssl_bench_SUITE.erl new file mode 100644 index 0000000000..b6b3769922 --- /dev/null +++ b/lib/ssl/test/ssl_bench_SUITE.erl @@ -0,0 +1,366 @@ +%%%------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/.2 +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(ssl_bench_SUITE). +-compile(export_all). +-include_lib("common_test/include/ct_event.hrl"). + +-define(remote_host, "NETMARKS_REMOTE_HOST"). + +suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. + +all() -> [{group, setup}, {group, payload}]. + +groups() -> + [{setup, [{repeat, 3}], [setup_sequential, setup_concurrent]}, + {payload, [{repeat, 3}], [payload_simple]} + ]. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, _Config) -> + ok. + +init_per_suite(Config) -> + try + Server = setup(ssl, node()), + [{server_node, Server}|Config] + catch _:_ -> + {skipped, "Benchmark machines only"} + end. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_Func, Conf) -> + Conf. + +end_per_testcase(_Func, _Conf) -> + ok. + + +-define(COUNT, 400). +-define(TC(Cmd), tc(fun() -> Cmd end, ?MODULE, ?LINE)). + +-define(FPROF_CLIENT, false). +-define(FPROF_SERVER, false). +-define(EPROF_CLIENT, false). +-define(EPROF_SERVER, false). +-define(PERCEPT_SERVER, false). + +%% Current numbers gives roughly a testcase per minute on todays hardware.. + +setup_sequential(Config) -> + Server = proplists:get_value(server_node, Config), + Server =/= undefined orelse error(no_server), + {ok, Result} = do_test(ssl, setup_connection, ?COUNT * 20, 1, Server), + ct_event:notify(#event{name = benchmark_data, + data=[{value, Result}, + {suite, "ssl"}, {name, "Sequential setup"}]}), + ok. + +setup_concurrent(Config) -> + Server = proplists:get_value(server_node, Config), + Server =/= undefined orelse error(no_server), + {ok, Result} = do_test(ssl, setup_connection, ?COUNT, 100, Server), + ct_event:notify(#event{name = benchmark_data, + data=[{value, Result}, + {suite, "ssl"}, {name, "Concurrent setup"}]}), + ok. + +payload_simple(Config) -> + Server = proplists:get_value(server_node, Config), + Server =/= undefined orelse error(no_server), + {ok, Result} = do_test(ssl, payload, ?COUNT*300, 10, Server), + ct_event:notify(#event{name = benchmark_data, + data=[{value, Result}, + {suite, "ssl"}, {name, "Payload simple"}]}), + ok. + + +ssl() -> + test(ssl, ?COUNT, node()). + +test(Type, Count, Host) -> + Server = setup(Type, Host), + (do_test(Type, setup_connection, Count * 20, 1, Server)), + (do_test(Type, setup_connection, Count, 100, Server)), + (do_test(Type, payload, Count*300, 10, Server)), + ok. + +do_test(Type, TC, Loop, ParallellConnections, Server) -> + _ = ssl:stop(), + {ok, _} = ensure_all_started(ssl, []), + + {ok, {SPid, Host, Port}} = rpc:call(Server, ?MODULE, setup_server_init, + [Type, TC, Loop, ParallellConnections]), + link(SPid), + Me = self(), + Test = fun(Id) -> + CData = client_init(Me, Type, TC, Host, Port), + receive + go -> + ?FPROF_CLIENT andalso Id =:= 1 andalso + start_profile(fprof, [self(),new]), + ?EPROF_CLIENT andalso Id =:= 1 andalso + start_profile(eprof, [ssl_connection_sup, ssl_manager]), + ok = ?MODULE:TC(Loop, Type, CData), + ?FPROF_CLIENT andalso Id =:= 1 andalso + stop_profile(fprof, "test_connection_client_res.fprof"), + ?EPROF_CLIENT andalso Id =:= 1 andalso + stop_profile(eprof, "test_connection_client_res.eprof"), + Me ! self() + end + end, + Spawn = fun(Id) -> + Pid = spawn(fun() -> Test(Id) end), + receive {Pid, init} -> Pid end + end, + Pids = [Spawn(Id) || Id <- lists:seq(ParallellConnections, 1, -1)], + Run = fun() -> + [Pid ! go || Pid <- Pids], + [receive Pid -> ok end || Pid <- Pids] + end, + {TimeInMicro, _} = timer:tc(Run), + TotalTests = ParallellConnections * Loop, + TestPerSecond = 1000000 * TotalTests div TimeInMicro, + io:format("TC ~p ~p ~p ~p 1/s~n", [TC, Type, ParallellConnections, TestPerSecond]), + unlink(SPid), + SPid ! quit, + {ok, TestPerSecond}. + +server_init(ssl, setup_connection, _, _, Server) -> + {ok, Socket} = ssl:listen(0, ssl_opts(listen)), + {ok, {_Host, Port}} = ssl:sockname(Socket), + {ok, Host} = inet:gethostname(), + ?FPROF_SERVER andalso start_profile(fprof, [whereis(ssl_manager), new]), + %%?EPROF_SERVER andalso start_profile(eprof, [ssl_connection_sup, ssl_manager]), + ?EPROF_SERVER andalso start_profile(eprof, [ssl_manager]), + ?PERCEPT_SERVER andalso percept:profile("/tmp/ssl_server.percept"), + Server ! {self(), {init, Host, Port}}, + Test = fun(TSocket) -> + ok = ssl:ssl_accept(TSocket), + ssl:close(TSocket) + end, + setup_server_connection(Socket, Test); +server_init(ssl, payload, Loop, _, Server) -> + {ok, Socket} = ssl:listen(0, ssl_opts(listen)), + {ok, {_Host, Port}} = ssl:sockname(Socket), + {ok, Host} = inet:gethostname(), + Server ! {self(), {init, Host, Port}}, + Test = fun(TSocket) -> + ok = ssl:ssl_accept(TSocket), + Size = byte_size(msg()), + server_echo(TSocket, Size, Loop), + ssl:close(TSocket) + end, + setup_server_connection(Socket, Test); + +server_init(Type, Tc, _, _, Server) -> + io:format("No server init code for ~p ~p~n",[Type, Tc]), + Server ! {self(), no_init}. + +client_init(Master, ssl, setup_connection, Host, Port) -> + Master ! {self(), init}, + {Host, Port, ssl_opts(connect)}; +client_init(Master, ssl, payload, Host, Port) -> + {ok, Sock} = ssl:connect(Host, Port, ssl_opts(connect)), + Master ! {self(), init}, + Size = byte_size(msg()), + {Sock, Size}; +client_init(_Me, Type, Tc, Host, Port) -> + io:format("No client init code for ~p ~p~n",[Type, Tc]), + {Host, Port}. + +setup_server_connection(LSocket, Test) -> + receive quit -> + ?FPROF_SERVER andalso stop_profile(fprof, "test_server_res.fprof"), + ?EPROF_SERVER andalso stop_profile(eprof, "test_server_res.eprof"), + ?PERCEPT_SERVER andalso stop_profile(percept, "/tmp/ssl_server.percept"), + ok + after 0 -> + case ssl:transport_accept(LSocket, 2000) of + {ok, TSocket} -> spawn_link(fun() -> Test(TSocket) end); + {error, timeout} -> ok + end, + setup_server_connection(LSocket, Test) + end. + +server_echo(Socket, Size, Loop) when Loop > 0 -> + {ok, Msg} = ssl:recv(Socket, Size), + ok = ssl:send(Socket, Msg), + server_echo(Socket, Size, Loop-1); +server_echo(_, _, _) -> ok. + +setup_connection(N, ssl, Env = {Host, Port, Opts}) when N > 0 -> + case ssl:connect(Host, Port, Opts) of + {ok, Sock} -> + ssl:close(Sock), + setup_connection(N-1, ssl, Env); + {error, Error} -> + io:format("Error: ~p (~p)~n",[Error, length(erlang:ports())]), + setup_connection(N, ssl, Env) + end; +setup_connection(_, _, _) -> + ok. + +payload(Loop, ssl, D = {Socket, Size}) when Loop > 0 -> + ok = ssl:send(Socket, msg()), + {ok, _} = ssl:recv(Socket, Size), + payload(Loop-1, ssl, D); +payload(_, _, {Socket, _}) -> + ssl:close(Socket). + +msg() -> + <<"Hello", + 0:(512*8), + "asdlkjsafsdfoierwlejsdlkfjsdf", + 1:(512*8), + "asdlkjsafsdfoierwlejsdlkfjsdf">>. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +setup(_Type, nonode@nohost) -> + exit(dist_not_enabled); +setup(Type, _This) -> + Host = case os:getenv(?remote_host) of + false -> + {ok, This} = inet:gethostname(), + This; + RemHost -> + RemHost + end, + Node = list_to_atom("perf_server@" ++ Host), + SlaveArgs = case init:get_argument(pa) of + {ok, PaPaths} -> + lists:append([" -pa " ++ P || [P] <- PaPaths]); + _ -> [] + end, + %% io:format("Slave args: ~p~n",[SlaveArgs]), + Prog = + case os:find_executable("erl") of + false -> "erl"; + P -> P + end, + io:format("Prog = ~p~n", [Prog]), + + case net_adm:ping(Node) of + pong -> ok; + pang -> + {ok, Node} = slave:start(Host, perf_server, SlaveArgs, no_link, Prog) + end, + Path = code:get_path(), + true = rpc:call(Node, code, set_path, [Path]), + ok = rpc:call(Node, ?MODULE, setup_server, [Type, node()]), + io:format("Client (~p) using ~s~n",[node(), code:which(ssl)]), + (Node =:= node()) andalso restrict_schedulers(client), + Node. + +setup_server(_Type, ClientNode) -> + (ClientNode =:= node()) andalso restrict_schedulers(server), + io:format("Server (~p) using ~s~n",[node(), code:which(ssl)]), + ok. + + +ensure_all_started(App, Ack) -> + case application:start(App) of + ok -> {ok, [App|Ack]}; + {error, {not_started, Dep}} -> + {ok, Ack1} = ensure_all_started(Dep, Ack), + ensure_all_started(App, Ack1); + {error, {already_started, _}} -> + {ok, Ack} + end. + +setup_server_init(Type, Tc, Loop, PC) -> + _ = ssl:stop(), + {ok, _} = ensure_all_started(ssl, []), + Me = self(), + Pid = spawn_link(fun() -> server_init(Type, Tc, Loop, PC, Me) end), + Res = receive + {Pid, {init, Host, Port}} -> {ok, {Pid, Host, Port}}; + {Pid, Error} -> {error, Error} + end, + unlink(Pid), + Res. + +restrict_schedulers(Type) -> + %% We expect this to run on 8 core machine + Extra0 = 1, + Extra = if (Type =:= server) -> -Extra0; true -> Extra0 end, + Scheds = erlang:system_info(schedulers), + erlang:system_flag(schedulers_online, (Scheds div 2) + Extra). + +tc(Fun, Mod, Line) -> + case timer:tc(Fun) of + {_,{'EXIT',Reason}} -> + io:format("Process EXITED ~p:~p \n", [Mod, Line]), + exit(Reason); + {_T,R={error,_}} -> + io:format("Process Error ~p:~p \n", [Mod, Line]), + R; + {T,R} -> + io:format("~p:~p: Time: ~p\n", [Mod, Line, T]), + R + end. + +start_profile(eprof, Procs) -> + profiling = eprof:start_profiling(Procs), + io:format("(E)Profiling ...",[]); +start_profile(fprof, Procs) -> + fprof:trace([start, {procs, Procs}]), + io:format("(F)Profiling ...",[]). + +stop_profile(percept, File) -> + percept:stop_profile(), + percept:analyze(File), + {started, _Host, Port} = percept:start_webserver(), + wx:new(), + wx_misc:launchDefaultBrowser("http://" ++ net_adm:localhost() ++ ":" ++ integer_to_list(Port)), + ok; +stop_profile(eprof, File) -> + profiling_stopped = eprof:stop_profiling(), + eprof:log(File), + io:format(".analysed => ~s ~n",[File]), + eprof:analyze(total), + eprof:stop(); +stop_profile(fprof, File) -> + fprof:trace(stop), + io:format("..collect..",[]), + fprof:profile(), + fprof:analyse([{dest, File},{totals, true}]), + io:format(".analysed => ~s ~n",[File]), + fprof:stop(), + ok. + +ssl_opts(listen) -> + [{backlog, 500} | ssl_opts("server")]; +ssl_opts(connect) -> + [{verify, verify_peer} + | ssl_opts("client")]; +ssl_opts(Role) -> + Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]), + [{active, false}, + {depth, 2}, + {reuseaddr, true}, + {mode,binary}, + {nodelay, true}, + {ciphers, [{dhe_rsa,aes_256_cbc,sha}]}, + {cacertfile, filename:join([Dir, Role, "cacerts.pem"])}, + {certfile, filename:join([Dir, Role, "cert.pem"])}, + {keyfile, filename:join([Dir, Role, "key.pem"])}]. diff --git a/lib/ssl/test/ssl_cipher_SUITE.erl b/lib/ssl/test/ssl_cipher_SUITE.erl index 45e91786d4..f2dc1b52c1 100644 --- a/lib/ssl/test/ssl_cipher_SUITE.erl +++ b/lib/ssl/test/ssl_cipher_SUITE.erl @@ -86,9 +86,9 @@ aes_decipher_good(Config) when is_list(Config) -> Content = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56, "HELLO\n">>, Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, Version = {3,0}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + {Content, Mac, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version), Version1 = {3,1}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), + {Content, Mac, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1), ok. %%-------------------------------------------------------------------- @@ -110,9 +110,9 @@ aes_decipher_good_tls11(Config) when is_list(Config) -> NextIV = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>>, Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, Version = {3,2}, - {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version), Version1 = {3,2}, - {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), + {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1), ok. %%-------------------------------------------------------------------- @@ -130,11 +130,11 @@ aes_decipher_fail(Config) when is_list(Config) -> 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, Version = {3,0}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + {Content, Mac, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version), 32 = byte_size(Content), 32 = byte_size(Mac), Version1 = {3,1}, - {Content1, Mac1, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), + {Content1, Mac1, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1), 32 = byte_size(Content1), 32 = byte_size(Mac1), ok. @@ -156,10 +156,10 @@ aes_decipher_fail_tls11(Config) when is_list(Config) -> 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, Version = {3,2}, #alert{level = ?FATAL, description = ?BAD_RECORD_MAC} = - ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version), Version1 = {3,3}, #alert{level = ?FATAL, description = ?BAD_RECORD_MAC} = - ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), + ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1), ok. %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index c31f6c2d7d..06a41f1260 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -108,8 +108,12 @@ init_customized_session_cache(Type, Config0) -> ssl:stop(), application:load(ssl), application:set_env(ssl, session_cb, ?MODULE), - application:set_env(ssl, session_cb_init_args, [Type]), + application:set_env(ssl, session_cb_init_args, [{type, Type}]), ssl:start(), + catch (end_per_testcase(list_to_atom("session_cache_process" ++ atom_to_list(Type)), + Config)), + ets:new(ssl_test, [named_table, public, set]), + ets:insert(ssl_test, {type, Type}), [{watchdog, Dog} | Config]. end_per_testcase(session_cache_process_list, Config) -> @@ -126,7 +130,11 @@ end_per_testcase(session_cleanup, Config) -> application:unset_env(ssl, session_delay_cleanup_time), application:unset_env(ssl, session_lifetime), end_per_testcase(default_action, Config); -end_per_testcase(_TestCase, Config) -> +end_per_testcase(Case, Config) when Case == session_cache_process_list; + Case == session_cache_process_mnesia -> + ets:delete(ssl_test), + Config; +end_per_testcase(_, Config) -> Config. %%-------------------------------------------------------------------- @@ -164,12 +172,13 @@ session_cleanup(Config)when is_list(Config) -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), - Cache = element(2, State), - SessionTimer = element(6, State), + ClientCache = element(2, State), + ServerCache = element(3, State), + SessionTimer = element(7, State), Id = proplists:get_value(session_id, SessionInfo), - CSession = ssl_session_cache:lookup(Cache, {{Hostname, Port}, Id}), - SSession = ssl_session_cache:lookup(Cache, {Port, Id}), + CSession = ssl_session_cache:lookup(ClientCache, {{Hostname, Port}, Id}), + SSession = ssl_session_cache:lookup(ServerCache, {Port, Id}), true = CSession =/= undefined, true = SSession =/= undefined, @@ -185,8 +194,8 @@ session_cleanup(Config)when is_list(Config) -> ct:sleep(?SLEEP), %% Make sure clean has had time to run - undefined = ssl_session_cache:lookup(Cache, {{Hostname, Port}, Id}), - undefined = ssl_session_cache:lookup(Cache, {Port, Id}), + undefined = ssl_session_cache:lookup(ClientCache, {{Hostname, Port}, Id}), + undefined = ssl_session_cache:lookup(ServerCache, {Port, Id}), process_flag(trap_exit, false), ssl_test_lib:close(Server), @@ -208,7 +217,7 @@ get_delay_timers() -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), - case element(7, State) of + case element(8, State) of {undefined, undefined} -> ct:sleep(?SLEEP), get_delay_timers(); @@ -236,16 +245,16 @@ session_cache_process_mnesia(Config) when is_list(Config) -> %%% Session cache API callbacks %%-------------------------------------------------------------------- -init([Type]) -> - ets:new(ssl_test, [named_table, public, set]), - ets:insert(ssl_test, {type, Type}), - case Type of +init(Opts) -> + case proplists:get_value(type, Opts) of list -> spawn(fun() -> session_loop([]) end); mnesia -> mnesia:start(), - {atomic,ok} = mnesia:create_table(sess_cache, []), - sess_cache + Name = atom_to_list(proplists:get_value(role, Opts)), + TabName = list_to_atom(Name ++ "sess_cache"), + {atomic,ok} = mnesia:create_table(TabName, []), + TabName end. session_cb() -> @@ -258,7 +267,7 @@ terminate(Cache) -> Cache ! terminate; mnesia -> catch {atomic,ok} = - mnesia:delete_table(sess_cache) + mnesia:delete_table(Cache) end. lookup(Cache, Key) -> @@ -268,10 +277,10 @@ lookup(Cache, Key) -> receive {Cache, Res} -> Res end; mnesia -> case mnesia:transaction(fun() -> - mnesia:read(sess_cache, + mnesia:read(Cache, Key, read) end) of - {atomic, [{sess_cache, Key, Value}]} -> + {atomic, [{Cache, Key, Value}]} -> Value; _ -> undefined @@ -285,8 +294,8 @@ update(Cache, Key, Value) -> mnesia -> {atomic, ok} = mnesia:transaction(fun() -> - mnesia:write(sess_cache, - {sess_cache, Key, Value}, write) + mnesia:write(Cache, + {Cache, Key, Value}, write) end) end. @@ -297,7 +306,7 @@ delete(Cache, Key) -> mnesia -> {atomic, ok} = mnesia:transaction(fun() -> - mnesia:delete(sess_cache, Key) + mnesia:delete(Cache, Key) end) end. @@ -308,7 +317,7 @@ foldl(Fun, Acc, Cache) -> receive {Cache, Res} -> Res end; mnesia -> Foldl = fun() -> - mnesia:foldl(Fun, Acc, sess_cache) + mnesia:foldl(Fun, Acc, Cache) end, {atomic, Res} = mnesia:transaction(Foldl), Res @@ -325,7 +334,7 @@ select_session(Cache, PartialKey) -> mnesia -> Sel = fun() -> mnesia:select(Cache, - [{{sess_cache,{PartialKey,'$1'}, '$2'}, + [{{Cache,{PartialKey,'$1'}, '$2'}, [],['$$']}]) end, {atomic, Res} = mnesia:transaction(Sel), diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 74d71263de..d2e6e41482 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -811,48 +811,34 @@ openssl_rsa_suites(CounterPart) -> false -> "DSS | ECDHE | ECDH" end, - lists:filter(fun(Str) -> - case re:run(Str, Names,[]) of - nomatch -> - false; - _ -> - true - end - end, Ciphers). + lists:filter(fun(Str) -> string_regex_filter(Str, Names) + end, Ciphers). openssl_dsa_suites() -> Ciphers = ssl:cipher_suites(openssl), - lists:filter(fun(Str) -> - case re:run(Str,"DSS",[]) of - nomatch -> - false; - _ -> - true - end + lists:filter(fun(Str) -> string_regex_filter(Str, "DSS") end, Ciphers). openssl_ecdsa_suites() -> Ciphers = ssl:cipher_suites(openssl), - lists:filter(fun(Str) -> - case re:run(Str,"ECDHE-ECDSA",[]) of - nomatch -> - false; - _ -> - true - end + lists:filter(fun(Str) -> string_regex_filter(Str, "ECDHE-ECDSA") end, Ciphers). openssl_ecdh_rsa_suites() -> Ciphers = ssl:cipher_suites(openssl), - lists:filter(fun(Str) -> - case re:run(Str,"ECDH-RSA",[]) of - nomatch -> - false; - _ -> - true - end + lists:filter(fun(Str) -> string_regex_filter(Str, "ECDH-RSA") end, Ciphers). +string_regex_filter(Str, Search) when is_list(Str) -> + case re:run(Str, Search, []) of + nomatch -> + false; + _ -> + true + end; +string_regex_filter(Str, _Search) -> + false. + anonymous_suites() -> Suites = [{dh_anon, rc4_128, md5}, @@ -860,6 +846,8 @@ anonymous_suites() -> {dh_anon, '3des_ede_cbc', sha}, {dh_anon, aes_128_cbc, sha}, {dh_anon, aes_256_cbc, sha}, + {dh_anon, aes_128_gcm, null}, + {dh_anon, aes_256_gcm, null}, {ecdh_anon,rc4_128,sha}, {ecdh_anon,'3des_ede_cbc',sha}, {ecdh_anon,aes_128_cbc,sha}, @@ -885,8 +873,13 @@ psk_suites() -> {rsa_psk, aes_128_cbc, sha}, {rsa_psk, aes_256_cbc, sha}, {rsa_psk, aes_128_cbc, sha256}, - {rsa_psk, aes_256_cbc, sha384} -], + {rsa_psk, aes_256_cbc, sha384}, + {psk, aes_128_gcm, null}, + {psk, aes_256_gcm, null}, + {dhe_psk, aes_128_gcm, null}, + {dhe_psk, aes_256_gcm, null}, + {rsa_psk, aes_128_gcm, null}, + {rsa_psk, aes_256_gcm, null}], ssl_cipher:filter_suites(Suites). psk_anon_suites() -> @@ -1130,7 +1123,7 @@ version_flag(sslv3) -> filter_suites(Ciphers0) -> Version = tls_record:highest_protocol_version([]), Supported0 = ssl_cipher:suites(Version) - ++ ssl_cipher:anonymous_suites() + ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) ++ ssl_cipher:srp_suites(), Supported1 = ssl_cipher:filter_suites(Supported0), diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index ff77c3eea0..f5d8b2072a 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -76,7 +76,6 @@ XML_REF3_FILES = \ ms_transform.xml \ orddict.xml \ ordsets.xml \ - pg.xml \ pool.xml \ proc_lib.xml \ proplists.xml \ diff --git a/lib/stdlib/doc/src/binary.xml b/lib/stdlib/doc/src/binary.xml index 2410f1f9b8..6c0968d242 100644 --- a/lib/stdlib/doc/src/binary.xml +++ b/lib/stdlib/doc/src/binary.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2009</year> - <year>2013</year> + <year>2014</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -450,7 +450,7 @@ store(Binary, GBSet) -> </code> <p>In this example, we chose to copy the binary content before - inserting it in the <c>gb_set()</c> if it references a binary more than + inserting it in the <c>gb_sets:set()</c> if it references a binary more than twice the size of the data we're going to keep. Of course different rules for when copying will apply to different programs.</p> @@ -578,6 +578,10 @@ store(Binary, GBSet) -> <item><p>Removes trailing empty parts of the result (as does trim in <c>re:split/3</c>)</p></item> + <tag>trim_all</tag> + + <item><p>Removes all empty parts of the result.</p></item> + <tag>global</tag> <item><p>Repeats the split until the <c><anno>Subject</anno></c> is diff --git a/lib/stdlib/doc/src/gen_event.xml b/lib/stdlib/doc/src/gen_event.xml index b9dfff833e..5c96d6e576 100644 --- a/lib/stdlib/doc/src/gen_event.xml +++ b/lib/stdlib/doc/src/gen_event.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -44,6 +44,7 @@ <pre> gen_event module Callback module ---------------- --------------- +gen_event:start gen_event:start_link -----> - gen_event:add_handler @@ -177,7 +178,7 @@ gen_event:stop -----> Module:terminate/2 <name>add_handler(EventMgrRef, Handler, Args) -> Result</name> <fsummary>Add an event handler to a generic event manager.</fsummary> <type> - <v>EventMgr = Name | {Name,Node} | {global,GlobalName} + <v>EventMgrRef = Name | {Name,Node} | {global,GlobalName} | {via,Module,ViaName} | pid()</v> <v> Name = Node = atom()</v> <v> GlobalName = ViaName = term()</v> @@ -223,7 +224,7 @@ gen_event:stop -----> Module:terminate/2 <name>add_sup_handler(EventMgrRef, Handler, Args) -> Result</name> <fsummary>Add a supervised event handler to a generic event manager.</fsummary> <type> - <v>EventMgr = Name | {Name,Node} | {global,GlobalName} + <v>EventMgrRef = Name | {Name,Node} | {global,GlobalName} | {via,Module,ViaName} | pid()</v> <v> Name = Node = atom()</v> <v> GlobalName = ViaName = term()</v> @@ -456,19 +457,37 @@ gen_event:stop -----> Module:terminate/2 </func> <func> <name>stop(EventMgrRef) -> ok</name> + <name>stop(EventMgrRef, Reason, Timeout) -> ok</name> <fsummary>Terminate a generic event manager.</fsummary> <type> <v>EventMgrRef = Name | {Name,Node} | {global,GlobalName} | {via,Module,ViaName} | pid()</v> <v>Name = Node = atom()</v> <v>GlobalName = ViaName = term()</v> + <v>Reason = term()</v> + <v>Timeout = int()>0 | infinity</v> </type> <desc> - <p>Terminates the event manager <c>EventMgrRef</c>. Before - terminating, the event manager will call - <c>Module:terminate(stop,...)</c> for each installed event - handler.</p> - <p>See <c>add_handler/3</c> for a description of the argument.</p> + <p>Orders the event manager <c>EventMgrRef</c> to exit with + the given <c>Reason</c> and waits for it to + terminate. Before terminating, the gen_event will call + <seealso marker="#Module:terminate/2">Module:terminate(stop,...)</seealso> + for each installed event handler.</p> + <p>The function returns <c>ok</c> if the event manager terminates + with the expected reason. Any other reason than <c>normal</c>, + <c>shutdown</c>, or <c>{shutdown,Term}</c> will cause an + error report to be issued using + <seealso marker="kernel:error_logger#format/2">error_logger:format/2</seealso>. + The default <c>Reason</c> is <c>normal</c>.</p> + <p><c>Timeout</c> is an integer greater than zero which + specifies how many milliseconds to wait for the event manager to + terminate, or the atom <c>infinity</c> to wait + indefinitely. The default value is <c>infinity</c>. If the + event manager has not terminated within the specified time, a + <c>timeout</c> exception is raised.</p> + <p>If the process does not exist, a <c>noproc</c> exception + is raised.</p> + <p>See <c>add_handler/3</c> for a description of <c>EventMgrRef</c>.</p> </desc> </func> </funcs> diff --git a/lib/stdlib/doc/src/gen_fsm.xml b/lib/stdlib/doc/src/gen_fsm.xml index 848d57f3e6..b1bba3eff0 100644 --- a/lib/stdlib/doc/src/gen_fsm.xml +++ b/lib/stdlib/doc/src/gen_fsm.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -43,8 +43,11 @@ <pre> gen_fsm module Callback module -------------- --------------- +gen_fsm:start gen_fsm:start_link -----> Module:init/1 +gen_fsm:stop -----> Module:terminate/3 + gen_fsm:send_event -----> Module:StateName/2 gen_fsm:send_all_state_event -----> Module:handle_event/3 @@ -187,6 +190,39 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 </desc> </func> <func> + <name>stop(FsmRef) -> ok</name> + <name>stop(FsmRef, Reason, Timeout) -> ok</name> + <fsummary>Synchronously stop a generic FSM.</fsummary> + <type> + <v>FsmRef = Name | {Name,Node} | {global,GlobalName} + | {via,Module,ViaName} | pid()</v> + <v> Node = atom()</v> + <v> GlobalName = ViaName = term()</v> + <v>Reason = term()</v> + <v>Timeout = int()>0 | infinity</v> + </type> + <desc> + <p>Orders a generic FSM to exit with the given <c>Reason</c> + and waits for it to terminate. The gen_fsm will call + <seealso marker="#Module:terminate/3">Module:terminate/3</seealso> + before exiting.</p> + <p>The function returns <c>ok</c> if the generic FSM terminates + with the expected reason. Any other reason than <c>normal</c>, + <c>shutdown</c>, or <c>{shutdown,Term}</c> will cause an + error report to be issued using + <seealso marker="kernel:error_logger#format/2">error_logger:format/2</seealso>. + The default <c>Reason</c> is <c>normal</c>.</p> + <p><c>Timeout</c> is an integer greater than zero which + specifies how many milliseconds to wait for the generic FSM + to terminate, or the atom <c>infinity</c> to wait + indefinitely. The default value is <c>infinity</c>. If the + generic FSM has not terminated within the specified time, a + <c>timeout</c> exception is raised.</p> + <p>If the process does not exist, a <c>noproc</c> exception + is raised.</p> + </desc> + </func> + <func> <name>send_event(FsmRef, Event) -> ok</name> <fsummary>Send an event asynchronously to a generic FSM.</fsummary> <type> @@ -528,7 +564,8 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 <c>Module:init/1</c> for a description of <c>Timeout</c> and <c>hibernate</c>.</p> <p>If the function returns <c>{stop,Reason,NewStateData}</c>, the gen_fsm will call - <c>Module:terminate(Reason,NewStateData)</c> and terminate.</p> + <c>Module:terminate(Reason,StateName,NewStateData)</c> and + terminate.</p> </desc> </func> <func> @@ -614,7 +651,8 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 <c>{stop,Reason,NewStateData}</c>, any reply to <c>From</c> must be given explicitly using <c>gen_fsm:reply/2</c>. The gen_fsm will then call - <c>Module:terminate(Reason,NewStateData)</c> and terminate.</p> + <c>Module:terminate(Reason,StateName,NewStateData)</c> and + terminate.</p> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml index 62c0394479..a915e567a5 100644 --- a/lib/stdlib/doc/src/gen_server.xml +++ b/lib/stdlib/doc/src/gen_server.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -43,8 +43,11 @@ <pre> gen_server module Callback module ----------------- --------------- +gen_server:start gen_server:start_link -----> Module:init/1 +gen_server:stop -----> Module:terminate/2 + gen_server:call gen_server:multi_call -----> Module:handle_call/3 @@ -184,6 +187,40 @@ gen_server:abcast -----> Module:handle_cast/2 </desc> </func> <func> + <name>stop(ServerRef) -> ok</name> + <name>stop(ServerRef, Reason, Timeout) -> ok</name> + <fsummary>Synchronously stop a generic server.</fsummary> + <type> + <v>ServerRef = Name | {Name,Node} | {global,GlobalName} + | {via,Module,ViaName} | pid()</v> + <v> Node = atom()</v> + <v> GlobalName = ViaName = term()</v> + <v>Reason = term()</v> + <v>Timeout = int()>0 | infinity</v> + </type> + <desc> + <p>Orders a generic server to exit with the + given <c>Reason</c> and waits for it to terminate. The + gen_server will call + <seealso marker="#Module:terminate/2">Module:terminate/2</seealso> + before exiting.</p> + <p>The function returns <c>ok</c> if the server terminates + with the expected reason. Any other reason than <c>normal</c>, + <c>shutdown</c>, or <c>{shutdown,Term}</c> will cause an + error report to be issued using + <seealso marker="kernel:error_logger#format/2">error_logger:format/2</seealso>. + The default <c>Reason</c> is <c>normal</c>.</p> + <p><c>Timeout</c> is an integer greater than zero which + specifies how many milliseconds to wait for the server to + terminate, or the atom <c>infinity</c> to wait + indefinitely. The default value is <c>infinity</c>. If the + server has not terminated within the specified time, a + <c>timeout</c> exception is raised.</p> + <p>If the process does not exist, a <c>noproc</c> exception + is raised.</p> + </desc> + </func> + <func> <name>call(ServerRef, Request) -> Reply</name> <name>call(ServerRef, Request, Timeout) -> Reply</name> <fsummary>Make a synchronous call to a generic server.</fsummary> diff --git a/lib/stdlib/doc/src/pg.xml b/lib/stdlib/doc/src/pg.xml deleted file mode 100644 index a3b69884b6..0000000000 --- a/lib/stdlib/doc/src/pg.xml +++ /dev/null @@ -1,114 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>1996</year> - <year>2014</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>pg</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <module>pg</module> - <modulesummary>Distributed, Named Process Groups</modulesummary> - <description> - <warning> - <p>This module is deprecated and will be removed in Erlang/OTP 18.</p> - </warning> - <p>This (experimental) module implements process groups. A process - group is a group of processes that can be accessed by a common - name. For example, a group named <c>foobar</c> can include a set - of processes as members of this group and they can be located on - different nodes.</p> - <p>When messages are sent to the named group, all members of - the group receive the message. The messages are serialized. If - the process <c>P1</c> sends the message <c>M1</c> to the group, - and process <c>P2</c> simultaneously sends message <c>M2</c>, then - all members of the group receive the two messages in the same - order. If members of a group terminate, they are automatically - removed from the group.</p> - <p>This module is not complete. The module is inspired by the ISIS - system and the causal order protocol of the ISIS system should - also be implemented. At the moment, all messages are serialized - by sending them through a group master process.</p> - </description> - <funcs> - <func> - <name name="create" arity="1"/> - <fsummary>Create an empty group</fsummary> - <desc> - <p>Creates an empty group named <c><anno>PgName</anno></c> on the current - node.</p> - </desc> - </func> - <func> - <name name="create" arity="2"/> - <fsummary>Create an empty group on another node</fsummary> - <desc> - <p>Creates an empty group named <c><anno>PgName</anno></c> on the node - <c><anno>Node</anno></c>.</p> - </desc> - </func> - <func> - <name name="join" arity="2"/> - <fsummary>Join a pid to a process group</fsummary> - <desc> - <p>Joins the pid <c><anno>Pid</anno></c> to the process group - <c><anno>PgName</anno></c>. - Returns a list of all old members of the group.</p> - </desc> - </func> - <func> - <name name="send" arity="2"/> - <fsummary>Send a message to all members of a process group</fsummary> - <desc> - <p>Sends the tuple <c>{pg_message, From, PgName, Msg}</c> to - all members of the process group <c><anno>PgName</anno></c>.</p> - <p>Failure: <c>{badarg, {<anno>PgName</anno>, <anno>Msg</anno>}}</c> - if <c><anno>PgName</anno></c> is - not a process group (a globally registered name).</p> - </desc> - </func> - <func> - <name name="esend" arity="2"/> - <fsummary>Send a message to all members of a process group, except ourselves</fsummary> - <desc> - <p>Sends the tuple <c>{pg_message, From, PgName, Msg}</c> to - all members of the process group <c><anno>PgName</anno></c>, except - ourselves.</p> - <p>Failure: <c>{badarg, {<anno>PgName</anno>, <anno>Msg</anno>}}</c> - if <c><anno>PgName</anno></c> is - not a process group (a globally registered name).</p> - </desc> - </func> - <func> - <name name="members" arity="1"/> - <fsummary>Return a list of all members of a process group</fsummary> - <desc> - <p>Returns a list of all members of the process group - <c>PgName</c>.</p> - </desc> - </func> - </funcs> -</erlref> - diff --git a/lib/stdlib/doc/src/proc_lib.xml b/lib/stdlib/doc/src/proc_lib.xml index 5bf5744622..f27a974242 100644 --- a/lib/stdlib/doc/src/proc_lib.xml +++ b/lib/stdlib/doc/src/proc_lib.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -298,6 +298,40 @@ init(Parent) -> <c>proc_lib</c> functions.</p> </desc> </func> + <func> + <name name="stop" arity="1"/> + <fsummary>Terminate a process synchronously.</fsummary> + <type variable="Process"/> + <desc> + <p>Equivalent to <seealso marker="#stop/3">stop(Process, + normal, infinity)</seealso>.</p> + </desc> + </func> + <func> + <name name="stop" arity="3"/> + <fsummary>Terminate a process synchronously.</fsummary> + <type variable="Process"/> + <type variable="Reason"/> + <type variable="Timeout"/> + <desc> + <p>Orders the process to exit with the given <c>Reason</c> and + waits for it to terminate.</p> + <p>The function returns <c>ok</c> if the process exits with + the given <c>Reason</c> within <c>Timeout</c> + milliseconds.</p> + <p>If the call times out, a <c>timeout</c> exception is + raised.</p> + <p>If the process does not exist, a <c>noproc</c> + exception is raised.</p> + <p>The implementation of this function is based on the + <c>terminate</c> system message, and requires that the + process handles system messages correctly. + See <seealso marker="sys">sys(3)</seealso> + and <seealso marker="doc/design_principles:spec_proc">OTP + Design Principles</seealso> for information about system + messages.</p> + </desc> + </func> </funcs> <section> diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index 6c35578bdf..ea4009dc3e 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -73,7 +73,6 @@ <xi:include href="ms_transform.xml"/> <xi:include href="orddict.xml"/> <xi:include href="ordsets.xml"/> - <xi:include href="pg.xml"/> <xi:include href="pool.xml"/> <xi:include href="proc_lib.xml"/> <xi:include href="proplists.xml"/> diff --git a/lib/stdlib/doc/src/specs.xml b/lib/stdlib/doc/src/specs.xml index 60a04ed5e7..fd77b52da6 100644 --- a/lib/stdlib/doc/src/specs.xml +++ b/lib/stdlib/doc/src/specs.xml @@ -39,7 +39,6 @@ <xi:include href="../specs/specs_ms_transform.xml"/> <xi:include href="../specs/specs_orddict.xml"/> <xi:include href="../specs/specs_ordsets.xml"/> - <xi:include href="../specs/specs_pg.xml"/> <xi:include href="../specs/specs_pool.xml"/> <xi:include href="../specs/specs_proc_lib.xml"/> <xi:include href="../specs/specs_proplists.xml"/> diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 3a5027d595..ffac1c0bd7 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -37,12 +37,12 @@ the <c>gen_event</c>, <c>gen_fsm</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 an + for tracing and error reporting. Supervisors are used to build a hierarchical process structure called a supervision tree, a nice way to structure a fault tolerant application. Refer to <em>OTP Design Principles</em> for more information.</p> - <p>A supervisor assumes the definition of which child processes to - supervise to be located in a callback module exporting a + <p>A supervisor expects the definition of which child processes to + supervise to be specified in a callback module exporting a pre-defined set of functions.</p> <p>Unless otherwise stated, all functions in this module will fail if the specified supervisor does not exist or if bad arguments @@ -53,18 +53,30 @@ <title>Supervision Principles</title> <p>The supervisor is responsible for starting, stopping and monitoring its child processes. The basic idea of a supervisor is - that it should keep its child processes alive by restarting them + that it shall keep its child processes alive by restarting them when necessary.</p> - <p>The children of a supervisor is defined as a list of + <p>The children of a supervisor are defined as a list of <em>child specifications</em>. When the supervisor is started, the child processes are started in order from left to right according to this list. When the supervisor terminates, it first terminates its child processes in reversed start order, from right to left.</p> - <p>A supervisor can have one of the following <em>restart strategies</em>:</p> + <marker id="sup_flags"/> + <p>The properties of a supervisor are defined by the supervisor + flags. This is the type definition for the supervisor flags: + </p> + <pre>sup_flags() = #{strategy => strategy(), % optional + intensity => non_neg_integer(), % optional + period => pos_integer()} % optional + </pre> + <p>A supervisor can have one of the following <em>restart + strategies</em>, specified with the <c>strategy</c> key in the + above map: + </p> <list type="bulleted"> <item> <p><c>one_for_one</c> - if one child process terminates and - should be restarted, only that child process is affected.</p> + should be restarted, only that child process is + affected. This is the default restart strategy.</p> </item> <item> <p><c>one_for_all</c> - if one child process terminates and @@ -94,43 +106,53 @@ instead the child specification identifier is used, <c>terminate_child/2</c> will return <c>{error,simple_one_for_one}</c>.</p> - <p>Because a <c>simple_one_for_one</c> supervisor could have many - children, it shuts them all down at same time. So, order in which they - are stopped is not defined. For the same reason, it could have an - overhead with regards to the <c>Shutdown</c> strategy.</p> + <p>Because a <c>simple_one_for_one</c> supervisor could have + many children, it shuts them all down asynchronously. This + means that the children will do their cleanup in parallel, + and therefore the order in which they are stopped is not + defined.</p> </item> </list> <p>To prevent a supervisor from getting into an infinite loop of - child process terminations and restarts, a <em>maximum restart frequency</em> - is defined using two integer values <c>MaxR</c> - and <c>MaxT</c>. If more than <c>MaxR</c> restarts occur within - <c>MaxT</c> seconds, the supervisor terminates all child - processes and then itself. + child process terminations and restarts, a <em>maximum restart + intensity</em> is defined using two integer values specified + with the <c>intensity</c> and <c>period</c> keys in the above + map. Assuming the values <c>MaxR</c> for <c>intensity</c> + and <c>MaxT</c> for <c>period</c>, then if more than <c>MaxR</c> + restarts occur within <c>MaxT</c> seconds, the supervisor will + terminate all child processes and then itself. The default value + for <c>intensity</c> is <c>1</c>, and the default value + for <c>period</c> is <c>5</c>. </p> <marker id="child_spec"/> <p>This is the type definition of a child specification:</p> - <pre> -child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} - Id = term() - StartFunc = {M,F,A} - M = F = atom() - A = [term()] - Restart = permanent | transient | temporary - Shutdown = brutal_kill | int()>0 | infinity - Type = worker | supervisor - Modules = [Module] | dynamic - Module = atom()</pre> + <pre>child_spec() = #{id => child_id(), % mandatory + start => mfargs(), % mandatory + restart => restart(), % optional + shutdown => shutdown(), % optional + type => worker(), % optional + modules => modules()} % optional</pre> + <p>The old tuple format is kept for backwards compatibility, + see <seealso marker="#type-child_spec">child_spec()</seealso>, + but the map is preferred. + </p> <list type="bulleted"> <item> - <p><c>Id</c> is a name that is used to identify the child + <p><c>id</c> is used to identify the child specification internally by the supervisor.</p> + <p>The <c>id</c> key is mandatory.</p> + <p>Note that this identifier on occations has been called + "name". As far as possible, the terms "identifier" or "id" + are now used but in order to keep backwards compatibility, + some occurences of "name" can still be found, for example + in error messages.</p> </item> <item> - <p><c>StartFunc</c> defines the function call used to start - the child process. It should be a module-function-arguments + <p><c>start</c> defines the function call used to start the + child process. It must be a module-function-arguments tuple <c>{M,F,A}</c> used as <c>apply(M,F,A)</c>.</p> <p>The start function <em>must create and link to</em> the child - process, and should return <c>{ok,Child}</c> or + process, and must return <c>{ok,Child}</c> or <c>{ok,Child,Info}</c> where <c>Child</c> is the pid of the child process and <c>Info</c> an arbitrary term which is ignored by the supervisor.</p> @@ -143,20 +165,23 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} error tuple <c>{error,Error}</c>.</p> <p>Note that the <c>start_link</c> functions of the different behaviour modules fulfill the above requirements.</p> + <p>The <c>start</c> key is mandatory.</p> </item> <item> - <p><c>Restart</c> defines when a terminated child process - should be restarted. A <c>permanent</c> child process should - always be restarted, a <c>temporary</c> child process should + <p><c>restart</c> defines when a terminated child process + shall be restarted. A <c>permanent</c> child process will + always be restarted, a <c>temporary</c> child process will never be restarted (even when the supervisor's restart strategy is <c>rest_for_one</c> or <c>one_for_all</c> and a sibling's death causes the temporary process to be terminated) and a - <c>transient</c> child process should be restarted only if + <c>transient</c> child process will be restarted only if it terminates abnormally, i.e. with another exit reason than <c>normal</c>, <c>shutdown</c> or <c>{shutdown,Term}</c>.</p> + <p>The <c>restart</c> key is optional. If it is not given, the + default value <c>permanent</c> will be used.</p> </item> <item> - <p><c>Shutdown</c> defines how a child process should be + <p><c>shutdown</c> defines how a child process shall be terminated. <c>brutal_kill</c> means the child process will be unconditionally terminated using <c>exit(Child,kill)</c>. An integer timeout value means that the supervisor will tell @@ -166,35 +191,45 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} no exit signal is received within the specified number of milliseconds, the child process is unconditionally terminated using <c>exit(Child,kill)</c>.</p> - <p>If the child process is another supervisor, <c>Shutdown</c> + <p>If the child process is another supervisor, the shutdown time should be set to <c>infinity</c> to give the subtree ample - time to shutdown. It is also allowed to set it to <c>infinity</c>, + time to shut down. It is also allowed to set it to <c>infinity</c>, if the child process is a worker.</p> <warning> - <p>Be careful by setting the <c>Shutdown</c> strategy to + <p>Be careful when setting the shutdown time to <c>infinity</c> when the child process is a worker. Because, in this situation, the termination of the supervision tree depends on the child process, it must be implemented in a safe way and its cleanup procedure must always return.</p> </warning> <p>Note that all child processes implemented using the standard - OTP behavior modules automatically adhere to the shutdown + OTP behaviour modules automatically adhere to the shutdown protocol.</p> + <p>The <c>shutdown</c> key is optional. If it is not given, + the default value <c>5000</c> will be used if the child is + of type <c>worker</c>; and <c>infinity</c> will be used if + the child is of type <c>supervisor</c>.</p> </item> <item> - <p><c>Type</c> specifies if the child process is a supervisor or + <p><c>type</c> specifies if the child process is a supervisor or a worker.</p> + <p>The <c>type</c> key is optional. If it is not given, the + default value <c>worker</c> will be used.</p> </item> <item> - <p><c>Modules</c> is used by the release handler during code + <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 <c>Modules</c> should be a list - with one element <c>[Module]</c>, where <c>Module</c> is - the callback module, if the child process is a supervisor, - gen_server or gen_fsm. If the child process is an event - manager (gen_event) with a dynamic set of callback modules, - <c>Modules</c> should be <c>dynamic</c>. See <em>OTP Design Principles</em> - for more information about release handling.</p> + module. As a rule of thumb, if the child process is a + <c>supervisor</c>, <c>gen_server</c>, or <c>gen_fsm</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 + dynamic set of callback modules, the value <c>dynamic</c> + shall be used. See <em>OTP Design Principles</em> for more + information about release handling.</p> + <p>The <c>modules</c> key is optional. If it is not given, it + defaults to <c>[M]</c>, where <c>M</c> comes from the + child's start <c>{M,F,A}</c></p> </item> <item> <p>Internally, the supervisor also keeps track of the pid @@ -213,11 +248,20 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} </datatype> <datatype> <name name="child_spec"/> + <desc><p>The tuple format is kept for backwards compatibility + only. A map is preferred; see more details + <seealso marker="#child_spec">above</seealso>.</p></desc> </datatype> <datatype> <name name="mfargs"/> - <desc><p><c>A</c> (the argument list) has the value - <c>undefined</c> if <c>Restart</c> is <c>temporary</c>.</p> + <desc> + <p>The value <c>undefined</c> for <c><anno>A</anno></c> (the + argument list) is only to be used internally + in <c>supervisor</c>. If the restart type of the child + is <c>temporary</c>, then the process is never to be + restarted and therefore there is no need to store the real + argument list. The value <c>undefined</c> will then be + stored instead.</p> </desc> </datatype> <datatype> @@ -233,6 +277,12 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} <name name="strategy"/> </datatype> <datatype> + <name name="sup_flags"/> + <desc><p>The tuple format is kept for backwards compatibility + only. A map is preferred; see more details + <seealso marker="#sup_flags">above</seealso>.</p></desc> + </datatype> + <datatype> <name name="sup_ref"/> </datatype> <datatype> @@ -253,20 +303,20 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} the supervisor is linked to the calling process (its supervisor).</p> <p>The created supervisor process calls <c><anno>Module</anno>:init/1</c> to - find out about restart strategy, maximum restart frequency + find out about restart strategy, maximum restart intensity and child processes. To ensure a synchronized start-up procedure, <c>start_link/2,3</c> does not return until <c><anno>Module</anno>:init/1</c> has returned and all child processes have been started.</p> - <p>If <c><anno>SupName</anno>={local,Name}</c> the supervisor is registered + <p>If <c><anno>SupName</anno>={local,Name}</c>, the supervisor is registered locally as <c>Name</c> using <c>register/2</c>. If <c><anno>SupName</anno>={global,Name}</c> the supervisor is registered globally as <c>Name</c> using <c>global:register_name/2</c>. If <c><anno>SupName</anno>={via,<anno>Module</anno>,<anno>Name</anno>}</c> the supervisor is registered as <c>Name</c> using the registry represented by - <c>Module</c>. The <c>Module</c> callback should export the functions + <c>Module</c>. The <c>Module</c> callback must export the functions <c>register_name/2</c>, <c>unregister_name/1</c> and <c>send/2</c>, - which should behave like the corresponding functions in <c>global</c>. + which shall behave like the corresponding functions in <c>global</c>. Thus, <c>{via,global,<anno>Name</anno>}</c> is a valid reference.</p> <p>If no name is provided, the supervisor is not registered.</p> <p><c><anno>Module</anno></c> is the name of the callback module.</p> @@ -274,14 +324,14 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} the argument to <c><anno>Module</anno>:init/1</c>.</p> <p>If the supervisor and its child processes are successfully created (i.e. if all child process start functions return - <c>{ok,Child}</c>, <c>{ok,Child,Info}</c>, or <c>ignore</c>) + <c>{ok,Child}</c>, <c>{ok,Child,Info}</c>, or <c>ignore</c>), the function returns <c>{ok,Pid}</c>, where <c>Pid</c> is the pid of the supervisor. If there already exists a process - with the specified <c><anno>SupName</anno></c> the function returns + with the specified <c><anno>SupName</anno></c>, the function returns <c>{error,{already_started,Pid}}</c>, where <c>Pid</c> is the pid of that process.</p> <p>If <c><anno>Module</anno>:init/1</c> returns <c>ignore</c>, this function - returns <c>ignore</c> as well and the supervisor terminates + returns <c>ignore</c> as well, and the supervisor terminates with reason <c>normal</c>. If <c><anno>Module</anno>:init/1</c> fails or returns an incorrect value, this function returns <c>{error,Term}</c> where <c>Term</c> @@ -297,7 +347,6 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} <func> <name name="start_child" arity="2"/> <fsummary>Dynamically add a child process to a supervisor.</fsummary> - <type name="child_spec"/> <type name="startchild_ret"/> <type name="startchild_err"/> <desc> @@ -314,35 +363,35 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} <item><c>{via,Module,Name}</c>, if the supervisor is registered through an alternative process registry.</item> </list> - <p><c><anno>ChildSpec</anno></c> should be a valid child specification + <p><c><anno>ChildSpec</anno></c> must be a valid child specification (unless the supervisor is a <c>simple_one_for_one</c> - supervisor, see below). The child process will be started by + supervisor; see below). The child process will be started by using the start function as defined in the child specification.</p> - <p>If the case of a <c>simple_one_for_one</c> supervisor, + <p>In the case of a <c>simple_one_for_one</c> supervisor, the child specification defined in <c>Module:init/1</c> will - be used and <c><anno>ChildSpec</anno></c> should instead be an arbitrary + be used, and <c><anno>ChildSpec</anno></c> shall instead be an arbitrary list of terms <c><anno>List</anno></c>. The child process will then be started by appending <c><anno>List</anno></c> to the existing start function arguments, i.e. by calling <c>apply(M, F, A++<anno>List</anno>)</c> where <c>{M,F,A}</c> is the start function defined in the child specification.</p> <p>If there already exists a child specification with - the specified <c><anno>Id</anno></c>, <c><anno>ChildSpec</anno></c> is discarded and + the specified identifier, <c><anno>ChildSpec</anno></c> is discarded, and the function returns <c>{error,already_present}</c> or <c>{error,{already_started,<anno>Child</anno>}}</c>, depending on if the corresponding child process is running or not.</p> <p>If the child process start function returns <c>{ok,<anno>Child</anno>}</c> - or <c>{ok,<anno>Child</anno>,<anno>Info</anno>}</c>, the child specification and pid is + or <c>{ok,<anno>Child</anno>,<anno>Info</anno>}</c>, the child specification and pid are added to the supervisor and the function returns the same value.</p> <p>If the child process start function returns <c>ignore</c>, the child specification is added to the supervisor, the pid - is set to <c>undefined</c> and the function returns + is set to <c>undefined</c>, and the function returns <c>{ok,undefined}</c>.</p> <p>If the child process start function returns an error tuple or an erroneous value, or if it fails, the child specification is - discarded and the function returns <c>{error,Error}</c> where + discarded, and the function returns <c>{error,Error}</c> where <c>Error</c> is a term containing information about the error and child specification.</p> </desc> @@ -366,7 +415,7 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} <p>If the child is temporary, the child specification is deleted as soon as the process terminates. This means - that <c>delete_child/2</c> has no meaning + that <c>delete_child/2</c> has no meaning, and <c>restart_child/2</c> can not be used for these children.</p> @@ -375,13 +424,13 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} process is alive, but is not a child of the given supervisor, the function will return <c>{error,not_found}</c>. If the child specification - identifier is given instead instead of a <c>pid()</c>, the + identifier is given instead of a <c>pid()</c>, the function will return <c>{error,simple_one_for_one}</c>.</p> <p>If successful, the function returns <c>ok</c>. If there is no child specification with the specified <c><anno>Id</anno></c>, the function returns <c>{error,not_found}</c>.</p> - <p>See <c>start_child/2</c> for a description of - <c><anno>SupRef</anno></c>.</p> + <p>See <seealso marker="#SupRef"><c>start_child/2</c></seealso> + for a description of <c><anno>SupRef</anno></c>.</p> </desc> </func> <func> @@ -390,15 +439,15 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} <desc> <p>Tells the supervisor <c><anno>SupRef</anno></c> to delete the child specification identified by <c><anno>Id</anno></c>. The corresponding child - process must not be running, use <c>terminate_child/2</c> to + process must not be running. Use <c>terminate_child/2</c> to terminate it.</p> - <p>See <seealso marker="#SupRef"><c>start_child/2</c></seealso> for a description of - <c>SupRef</c>.</p> + <p>See <seealso marker="#SupRef"><c>start_child/2</c></seealso> + for a description of <c><anno>SupRef</anno></c>.</p> <p>If successful, the function returns <c>ok</c>. If the child specification identified by <c><anno>Id</anno></c> exists but the corresponding child process is running or about to be restarted, the function returns <c>{error,running}</c> or - <c>{error,restarting}</c> respectively. If the child specification + <c>{error,restarting}</c>, respectively. If the child specification identified by <c><anno>Id</anno></c> does not exist, the function returns <c>{error,not_found}</c>.</p> </desc> @@ -410,10 +459,10 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} <p>Tells the supervisor <c><anno>SupRef</anno></c> to restart a child process corresponding to the child specification identified by <c><anno>Id</anno></c>. The child - specification must exist and the corresponding child process + specification must exist, and the corresponding child process must not be running.</p> <p>Note that for temporary children, the child specification - is automatically deleted when the child terminates, and thus + is automatically deleted when the child terminates; thus it is not possible to restart such children.</p> <p>See <seealso marker="#SupRef"><c>start_child/2</c></seealso> for a description of <c>SupRef</c>.</p> @@ -429,7 +478,7 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} is added to the supervisor and the function returns the same value.</p> <p>If the child process start function returns <c>ignore</c>, - the pid remains set to <c>undefined</c> and the function + the pid remains set to <c>undefined</c>, and the function returns <c>{ok,undefined}</c>.</p> <p>If the child process start function returns an error tuple or an erroneous value, or if it fails, the function returns @@ -462,7 +511,7 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} <item> <p><c><anno>Child</anno></c> - the pid of the corresponding child process, the atom <c>restarting</c> if the process is about to be - restarted or <c>undefined</c> if there is no such process.</p> + restarted, or <c>undefined</c> if there is no such process.</p> </item> <item> <p><c><anno>Type</anno></c> - as defined in the child specification.</p> @@ -475,8 +524,8 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} </func> <func> <name name="count_children" arity="1"/> - <fsummary>Return counts for the number of childspecs, active children, - supervisors and workers.</fsummary> + <fsummary>Return counts for the number of child specifications, + active children, supervisors, and workers.</fsummary> <desc> <p>Returns a property list (see <c>proplists</c>) containing the counts for each of the following elements of the supervisor's @@ -500,6 +549,8 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} process is still alive.</p> </item> </list> + <p>See <seealso marker="#SupRef"><c>start_child/2</c></seealso> + for a description of <c><anno>SupRef</anno></c>.</p> </desc> </func> <func> @@ -511,11 +562,23 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} correct, or <c>{error,<anno>Error</anno>}</c> otherwise.</p> </desc> </func> + <func> + <name name="get_childspec" arity="2"/> + <fsummary>Return the child specification map for the given + child.</fsummary> + <desc> + <p>Returns the child specification map for the child identified + by <c>Id</c> under supervisor <c>SupRef</c>. The returned + map contains all keys, both mandatory and optional.</p> + <p>See <seealso marker="#SupRef"><c>start_child/2</c></seealso> + for a description of <c><anno>SupRef</anno></c>.</p> + </desc> + </func> </funcs> <section> <title>CALLBACK FUNCTIONS</title> - <p>The following functions should be exported from a + <p>The following functions must be exported from a <c>supervisor</c> callback module.</p> </section> <funcs> @@ -524,33 +587,37 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} <fsummary>Return a supervisor specification.</fsummary> <type> <v>Args = term()</v> - <v>Result = {ok,{{RestartStrategy,MaxR,MaxT},[ChildSpec]}} | ignore</v> - <v> RestartStrategy = <seealso marker="#type-strategy">strategy()</seealso></v> - <v> MaxR = integer()>=0</v> - <v> MaxT = integer()>0</v> + <v>Result = {ok,{SupFlags,[ChildSpec]}} | ignore</v> + <v> SupFlags = <seealso marker="#type-sup_flags">sup_flags()</seealso></v> <v> ChildSpec = <seealso marker="#type-child_spec">child_spec()</seealso></v> </type> <desc> <p>Whenever a supervisor is started using <c>supervisor:start_link/2,3</c>, this function is called by the new process to find out about restart strategy, maximum - restart frequency and child specifications.</p> + restart intensity, and child specifications.</p> <p><c>Args</c> is the <c>Args</c> argument provided to the start function.</p> - <p><c>RestartStrategy</c> is the restart strategy and - <c>MaxR</c> and <c>MaxT</c> defines the maximum restart - frequency of the supervisor. <c>[ChildSpec]</c> is a list of - valid child specifications defining which child processes - the supervisor should start and monitor. See the discussion - about Supervision Principles above.</p> + <p><c>SupFlags</c> is the supervisor flags defining the + restart strategy and max restart intensity for the + supervisor. <c>[ChildSpec]</c> is a list of valid child + specifications defining which child processes the supervisor + shall start and monitor. See the discussion about + Supervision Principles above.</p> <p>Note that when the restart strategy is <c>simple_one_for_one</c>, the list of child specifications must be a list with one child specification only. - (The <c>Id</c> is ignored). No child process is then started + (The child specification identifier is ignored.) No child process is then started during the initialization phase, but all children are assumed to be started dynamically using <c>supervisor:start_child/2</c>.</p> <p>The function may also return <c>ignore</c>.</p> + <p>Note that this function might also be called as a part of a + code upgrade procedure. For this reason, the function should + not have any side effects. See + <seealso marker="doc/design_principles:appup_cookbook#sup">Design + Principles</seealso> for more information about code upgrade + of supervisors.</p> </desc> </func> </funcs> diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml index 19605f325b..cf7df54d1d 100644 --- a/lib/stdlib/doc/src/sys.xml +++ b/lib/stdlib/doc/src/sys.xml @@ -359,6 +359,17 @@ installed.</p> </desc> </func> + <func> + <name name="terminate" arity="2"/> + <name name="terminate" arity="3"/> + <fsummary>Terminate the process</fsummary> + <desc> + <p>This function orders the process to terminate with the + given <c><anno>Reason</anno></c>. The termination is done + asynchronously, so there is no guarantee that the process is + actually terminated when the function returns.</p> + </desc> + </func> </funcs> <section> diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 9ab2cd4134..1b3744b6fb 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -97,7 +97,6 @@ MODULES= \ otp_internal \ orddict \ ordsets \ - pg \ re \ pool \ proc_lib \ diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl index 4850a59eb6..b94829892d 100644 --- a/lib/stdlib/src/binary.erl +++ b/lib/stdlib/src/binary.erl @@ -215,12 +215,13 @@ split(H,N) -> Subject :: binary(), Pattern :: binary() | [binary()] | cp(), Options :: [Option], - Option :: {scope, part()} | trim | global, + Option :: {scope, part()} | trim | global | trim_all, Parts :: [binary()]. split(Haystack,Needles,Options) -> try - {Part,Global,Trim} = get_opts_split(Options,{no,false,false}), + {Part,Global,Trim,TrimAll} = + get_opts_split(Options,{no,false,false,false}), Moptlist = case Part of no -> []; @@ -236,20 +237,24 @@ split(Haystack,Needles,Options) -> Match -> [Match] end end, - do_split(Haystack,MList,0,Trim) + do_split(Haystack,MList,0,Trim,TrimAll) catch _:_ -> erlang:error(badarg) end. -do_split(H,[],N,true) when N >= byte_size(H) -> +do_split(H,[],N,true,_) when N >= byte_size(H) -> []; -do_split(H,[],N,_) -> +do_split(H,[],N,_,true) when N >= byte_size(H) -> + []; +do_split(H,[],N,_,_) -> [binary:part(H,{N,byte_size(H)-N})]; -do_split(H,[{A,B}|T],N,Trim) -> +do_split(H,[{A,B}|T],N,Trim,TrimAll) -> case binary:part(H,{N,A-N}) of + <<>> when TrimAll == true -> + do_split(H,T,A+B,Trim,TrimAll); <<>> -> - Rest = do_split(H,T,A+B,Trim), + Rest = do_split(H,T,A+B,Trim,TrimAll), case {Trim, Rest} of {true,[]} -> []; @@ -257,7 +262,7 @@ do_split(H,[{A,B}|T],N,Trim) -> [<<>> | Rest] end; Oth -> - [Oth | do_split(H,T,A+B,Trim)] + [Oth | do_split(H,T,A+B,Trim,TrimAll)] end. @@ -346,14 +351,16 @@ splitat(H,N,[I|T]) -> %% Simple helper functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -get_opts_split([],{Part,Global,Trim}) -> - {Part,Global,Trim}; -get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim}) -> - get_opts_split(T,{{A,B},Global,Trim}); -get_opts_split([global | T],{Part,_Global,Trim}) -> - get_opts_split(T,{Part,true,Trim}); -get_opts_split([trim | T],{Part,Global,_Trim}) -> - get_opts_split(T,{Part,Global,true}); +get_opts_split([],{Part,Global,Trim,TrimAll}) -> + {Part,Global,Trim,TrimAll}; +get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim,TrimAll}) -> + get_opts_split(T,{{A,B},Global,Trim,TrimAll}); +get_opts_split([global | T],{Part,_Global,Trim,TrimAll}) -> + get_opts_split(T,{Part,true,Trim,TrimAll}); +get_opts_split([trim | T],{Part,Global,_Trim,TrimAll}) -> + get_opts_split(T,{Part,Global,true,TrimAll}); +get_opts_split([trim_all | T],{Part,Global,Trim,_TrimAll}) -> + get_opts_split(T,{Part,Global,Trim,true}); get_opts_split(_,_) -> throw(badopt). diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 639ddfc214..371573dc23 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1172,7 +1172,7 @@ match_tuple([], _, _, Bs, _BBs) -> match_map([{map_field_exact, _, K, V}|Fs], Map, Bs0, BBs) -> Vm = try - {value, Ke, _} = expr(K, new_bindings()), + {value, Ke, _} = expr(K, Bs0), maps:get(Ke,Map) catch error:_ -> throw(nomatch) diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index edfb097de0..2bf8b86c23 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -51,6 +51,8 @@ type_test/2,new_type_test/2,old_type_test/2,old_bif/2]). -export([arith_op/2,bool_op/2,comp_op/2,list_op/2,send_op/2,op_type/2]). +-export([is_type/2]). + %%--------------------------------------------------------------------------- %% Erlang builtin functions allowed in guards. @@ -293,6 +295,7 @@ bif(garbage_collect, 1) -> true; bif(garbage_collect, 2) -> true; bif(get, 0) -> true; bif(get, 1) -> true; +bif(get_keys, 0) -> true; bif(get_keys, 1) -> true; bif(group_leader, 0) -> true; bif(group_leader, 2) -> true; @@ -530,3 +533,53 @@ old_bif(unlink, 1) -> true; old_bif(unregister, 1) -> true; old_bif(whereis, 1) -> true; old_bif(Name, A) when is_atom(Name), is_integer(A) -> false. + +-spec is_type(Name, NumberOfTypeVariables) -> boolean() when + Name :: atom(), + NumberOfTypeVariables :: non_neg_integer(). +%% Returns true if Name/NumberOfTypeVariables is a predefined type. + +is_type(any, 0) -> true; +is_type(arity, 0) -> true; +is_type(atom, 0) -> true; +is_type(binary, 0) -> true; +is_type(bitstring, 0) -> true; +is_type(bool, 0) -> true; +is_type(boolean, 0) -> true; +is_type(byte, 0) -> true; +is_type(char, 0) -> true; +is_type(float, 0) -> true; +is_type(function, 0) -> true; +is_type(identifier, 0) -> true; +is_type(integer, 0) -> true; +is_type(iodata, 0) -> true; +is_type(iolist, 0) -> true; +is_type(list, 0) -> true; +is_type(list, 1) -> true; +is_type(map, 0) -> true; +is_type(maybe_improper_list, 0) -> true; +is_type(maybe_improper_list, 2) -> true; +is_type(mfa, 0) -> true; +is_type(module, 0) -> true; +is_type(neg_integer, 0) -> true; +is_type(nil, 0) -> true; +is_type(no_return, 0) -> true; +is_type(node, 0) -> true; +is_type(non_neg_integer, 0) -> true; +is_type(none, 0) -> true; +is_type(nonempty_improper_list, 2) -> true; +is_type(nonempty_list, 0) -> true; +is_type(nonempty_list, 1) -> true; +is_type(nonempty_maybe_improper_list, 0) -> true; +is_type(nonempty_maybe_improper_list, 2) -> true; +is_type(nonempty_string, 0) -> true; +is_type(number, 0) -> true; +is_type(pid, 0) -> true; +is_type(port, 0) -> true; +is_type(pos_integer, 0) -> true; +is_type(reference, 0) -> true; +is_type(string, 0) -> true; +is_type(term, 0) -> true; +is_type(timeout, 0) -> true; +is_type(tuple, 0) -> true; +is_type(_, _) -> false. diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 39cc03cf7a..26d8454731 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -130,6 +130,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> :: dict:dict(mfa(), line()), callbacks = dict:new() %Callback types :: dict:dict(mfa(), line()), + optional_callbacks = dict:new() %Optional callbacks + :: dict:dict(mfa(), line()), types = dict:new() %Type definitions :: dict:dict(ta(), #typeinfo{}), exp_types=gb_sets:empty() %Exported types @@ -237,10 +239,7 @@ format_error({too_many_arguments,Arity}) -> "maximum allowed is ~w", [Arity,?MAX_ARGUMENTS]); %% --- patterns and guards --- format_error(illegal_pattern) -> "illegal pattern"; -format_error(illegal_map_key) -> - "illegal map key"; -format_error({illegal_map_key_variable,K}) -> - io_lib:format("illegal use of variable ~w in map",[K]); +format_error(illegal_map_key) -> "illegal map key in pattern"; format_error(illegal_bin_pattern) -> "binary patterns cannot be matched in parallel using '='"; format_error(illegal_expr) -> "illegal expression"; @@ -313,13 +312,20 @@ format_error({undefined_behaviour,Behaviour}) -> io_lib:format("behaviour ~w undefined", [Behaviour]); format_error({undefined_behaviour_callbacks,Behaviour}) -> io_lib:format("behaviour ~w callback functions are undefined", - [Behaviour]); + [Behaviour]); format_error({ill_defined_behaviour_callbacks,Behaviour}) -> io_lib:format("behaviour ~w callback functions erroneously defined", [Behaviour]); +format_error({ill_defined_optional_callbacks,Behaviour}) -> + io_lib:format("behaviour ~w optional callback functions erroneously defined", + [Behaviour]); format_error({behaviour_info, {_M,F,A}}) -> io_lib:format("cannot define callback attibute for ~w/~w when " "behaviour_info is defined",[F,A]); +format_error({redefine_optional_callback, {F, A}}) -> + io_lib:format("optional callback ~w/~w duplicated", [F, A]); +format_error({undefined_callback, {_M, F, A}}) -> + io_lib:format("callback ~w/~w is undefined", [F, A]); %% --- types and specs --- format_error({singleton_typevar, Name}) -> io_lib:format("type variable ~w is only used once (is unbound)", [Name]); @@ -331,14 +337,10 @@ format_error({undefined_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s undefined", [TypeName, gen_type_paren(Arity)]); format_error({unused_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s is unused", [TypeName, gen_type_paren(Arity)]); -%% format_error({new_builtin_type, {TypeName, Arity}}) -> -%% io_lib:format("type ~w~s is a new builtin type; " -%% "its (re)definition is allowed only until the next release", -%% [TypeName, gen_type_paren(Arity)]); -format_error({new_var_arity_type, TypeName}) -> - io_lib:format("type ~w is a new builtin type; " +format_error({new_builtin_type, {TypeName, Arity}}) -> + io_lib:format("type ~w~s is a new builtin type; " "its (re)definition is allowed only until the next release", - [TypeName]); + [TypeName, gen_type_paren(Arity)]); format_error({builtin_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s is a builtin type; it cannot be redefined", [TypeName, gen_type_paren(Arity)]); @@ -352,10 +354,14 @@ format_error({type_syntax, Constr}) -> io_lib:format("bad ~w type", [Constr]); format_error({redefine_spec, {M, F, A}}) -> io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]); -format_error({redefine_callback, {M, F, A}}) -> - io_lib:format("callback ~w:~w/~w already defined", [M, F, A]); -format_error({spec_fun_undefined, {M, F, A}}) -> - io_lib:format("spec for undefined function ~w:~w/~w", [M, F, A]); +format_error({redefine_spec, {F, A}}) -> + io_lib:format("spec for ~w/~w already defined", [F, A]); +format_error({redefine_callback, {F, A}}) -> + io_lib:format("callback ~w/~w already defined", [F, A]); +format_error({bad_callback, {M, F, A}}) -> + io_lib:format("explicit module not allowed for callback ~w:~w/~w ", [M, F, A]); +format_error({spec_fun_undefined, {F, A}}) -> + io_lib:format("spec for undefined function ~w/~w", [F, A]); format_error({missing_spec, {F,A}}) -> io_lib:format("missing specification for function ~w/~w", [F, A]); format_error(spec_wrong_arity) -> @@ -383,9 +389,7 @@ format_error({underspecified_opaque, {TypeName, Arity}}) -> [TypeName, gen_type_paren(Arity)]); %% --- obsolete? unused? --- format_error({format_error, {Fmt, Args}}) -> - io_lib:format(Fmt, Args); -format_error({mnemosyne, What}) -> - "mnemosyne " ++ What ++ ", missing transformation". + io_lib:format(Fmt, Args). gen_type_paren(Arity) when is_integer(Arity), Arity >= 0 -> gen_type_paren_1(Arity, ")"). @@ -727,6 +731,8 @@ attribute_state({attribute,L,spec,{Fun,Types}}, St) -> spec_decl(L, Fun, Types, St); attribute_state({attribute,L,callback,{Fun,Types}}, St) -> callback_decl(L, Fun, Types, St); +attribute_state({attribute,L,optional_callbacks,Es}, St) -> + optional_callbacks(L, Es, St); attribute_state({attribute,L,on_load,Val}, St) -> on_load(L, Val, St); attribute_state({attribute,_L,_Other,_Val}, St) -> % Ignore others @@ -751,8 +757,6 @@ function_state({attribute,La,Attr,_Val}, St) -> add_error(La, {attribute,Attr}, St); function_state({function,L,N,A,Cs}, St) -> function(L, N, A, Cs, St); -function_state({rule,L,_N,_A,_Cs}, St) -> - add_error(L, {mnemosyne,"rule"}, St); function_state({eof,L}, St) -> eof(L, St). %% eof(LastLine, State) -> @@ -834,57 +838,73 @@ check_behaviour(St0) -> %% Check behaviours for existence and defined functions. behaviour_check(Bs, St0) -> - {AllBfs,St1} = all_behaviour_callbacks(Bs, [], St0), - St = behaviour_missing_callbacks(AllBfs, St1), + {AllBfs0, St1} = all_behaviour_callbacks(Bs, [], St0), + St = behaviour_missing_callbacks(AllBfs0, St1), + Exports = exports(St0), + F = fun(Bfs, OBfs) -> + [B || B <- Bfs, + not lists:member(B, OBfs) + orelse gb_sets:is_member(B, Exports)] + end, + %% After fixing missing callbacks new warnings may be emitted. + AllBfs = [{Item,F(Bfs0, OBfs0)} || {Item,Bfs0,OBfs0} <- AllBfs0], behaviour_conflicting(AllBfs, St). all_behaviour_callbacks([{Line,B}|Bs], Acc, St0) -> - {Bfs0,St} = behaviour_callbacks(Line, B, St0), - all_behaviour_callbacks(Bs, [{{Line,B},Bfs0}|Acc], St); + {Bfs0,OBfs0,St} = behaviour_callbacks(Line, B, St0), + all_behaviour_callbacks(Bs, [{{Line,B},Bfs0,OBfs0}|Acc], St); all_behaviour_callbacks([], Acc, St) -> {reverse(Acc),St}. behaviour_callbacks(Line, B, St0) -> try B:behaviour_info(callbacks) of - Funcs when is_list(Funcs) -> - All = all(fun({FuncName, Arity}) -> - is_atom(FuncName) andalso is_integer(Arity); - ({FuncName, Arity, Spec}) -> - is_atom(FuncName) andalso is_integer(Arity) - andalso is_list(Spec); - (_Other) -> - false - end, - Funcs), - MaybeRemoveSpec = fun({_F,_A}=FA) -> FA; - ({F,A,_S}) -> {F,A}; - (Other) -> Other - end, - if - All =:= true -> - {[MaybeRemoveSpec(F) || F <- Funcs], St0}; + undefined -> + St1 = add_warning(Line, {undefined_behaviour_callbacks, B}, St0), + {[], [], St1}; + Funcs -> + case is_fa_list(Funcs) of true -> + try B:behaviour_info(optional_callbacks) of + undefined -> + {Funcs, [], St0}; + OptFuncs -> + %% OptFuncs should always be OK thanks to + %% sys_pre_expand. + case is_fa_list(OptFuncs) of + true -> + {Funcs, OptFuncs, St0}; + false -> + W = {ill_defined_optional_callbacks, B}, + St1 = add_warning(Line, W, St0), + {Funcs, [], St1} + end + catch + _:_ -> + {Funcs, [], St0} + end; + false -> St1 = add_warning(Line, - {ill_defined_behaviour_callbacks,B}, + {ill_defined_behaviour_callbacks, B}, St0), - {[], St1} - end; - undefined -> - St1 = add_warning(Line, {undefined_behaviour_callbacks,B}, St0), - {[], St1}; - _Other -> - St1 = add_warning(Line, {ill_defined_behaviour_callbacks,B}, St0), - {[], St1} + {[], [], St1} + end catch _:_ -> - St1 = add_warning(Line, {undefined_behaviour,B}, St0), - {[], St1} + St1 = add_warning(Line, {undefined_behaviour, B}, St0), + {[], [], St1} end. -behaviour_missing_callbacks([{{Line,B},Bfs}|T], St0) -> +behaviour_missing_callbacks([{{Line,B},Bfs0,OBfs}|T], St0) -> + Bfs = ordsets:subtract(ordsets:from_list(Bfs0), ordsets:from_list(OBfs)), Exports = gb_sets:to_list(exports(St0)), - Missing = ordsets:subtract(ordsets:from_list(Bfs), Exports), + Missing = ordsets:subtract(Bfs, Exports), St = foldl(fun (F, S0) -> - add_warning(Line, {undefined_behaviour_func,F,B}, S0) + case is_fa(F) of + true -> + M = {undefined_behaviour_func,F,B}, + add_warning(Line, M, S0); + false -> + S0 % ill_defined_behaviour_callbacks + end end, St0, Missing), behaviour_missing_callbacks(T, St); behaviour_missing_callbacks([], St) -> St. @@ -1046,10 +1066,9 @@ check_undefined_types(#lint{usage=Usage,types=Def}=St0) -> Used = Usage#usage.used_types, UTAs = dict:fetch_keys(Used), Undef = [{TA,dict:fetch(TA, Used)} || - {T,_}=TA <- UTAs, + TA <- UTAs, not dict:is_key(TA, Def), - not is_default_type(TA), - not is_newly_introduced_var_arity_type(T)], + not is_default_type(TA)], foldl(fun ({TA,L}, St) -> add_error(L, {undefined_type,TA}, St) end, St0, Undef). @@ -1127,19 +1146,29 @@ check_unused_records(Forms, St0) -> end. check_callback_information(#lint{callbacks = Callbacks, - defined = Defined} = State) -> - case gb_sets:is_member({behaviour_info,1}, Defined) of - false -> State; + optional_callbacks = OptionalCbs, + defined = Defined} = St0) -> + OptFun = fun({MFA, Line}, St) -> + case dict:is_key(MFA, Callbacks) of + true -> + St; + false -> + add_error(Line, {undefined_callback, MFA}, St) + end + end, + St1 = lists:foldl(OptFun, St0, dict:to_list(OptionalCbs)), + case gb_sets:is_member({behaviour_info, 1}, Defined) of + false -> St1; true -> case dict:size(Callbacks) of - 0 -> State; + 0 -> St1; _ -> CallbacksList = dict:to_list(Callbacks), FoldL = - fun({Fa,Line},St) -> + fun({Fa, Line}, St) -> add_error(Line, {behaviour_info, Fa}, St) end, - lists:foldl(FoldL, State, CallbacksList) + lists:foldl(FoldL, St1, CallbacksList) end end. @@ -1404,20 +1433,7 @@ pattern({cons,_Line,H,T}, Vt, Old, Bvt, St0) -> pattern({tuple,_Line,Ps}, Vt, Old, Bvt, St) -> pattern_list(Ps, Vt, Old, Bvt, St); pattern({map,_Line,Ps}, Vt, Old, Bvt, St) -> - foldl(fun - ({map_field_assoc,L,_,_}, {Psvt,Bvt0,St0}) -> - {Psvt,Bvt0,add_error(L, illegal_pattern, St0)}; - ({map_field_exact,L,KP,VP}, {Psvt,Bvt0,St0}) -> - case is_valid_map_key(KP, pattern, St0) of - true -> - {Pvt,Bvt1,St1} = pattern(VP, Vt, Old, Bvt, St0), - {vtmerge_pat(Pvt, Psvt),vtmerge_pat(Bvt0, Bvt1), St1}; - false -> - {Psvt,Bvt0,add_error(L, illegal_map_key, St0)}; - {false,variable,Var} -> - {Psvt,Bvt0,add_error(L, {illegal_map_key_variable,Var}, St0)} - end - end, {[],[],St}, Ps); + pattern_map(Ps, Vt, Old, Bvt, St); %%pattern({struct,_Line,_Tag,Ps}, Vt, Old, Bvt, St) -> %% pattern_list(Ps, Vt, Old, Bvt, St); pattern({record_index,Line,Name,Field}, _Vt, _Old, _Bvt, St) -> @@ -1571,6 +1587,21 @@ is_pattern_expr_1({op,_Line,Op,A1,A2}) -> erl_internal:arith_op(Op, 2) andalso all(fun is_pattern_expr/1, [A1,A2]); is_pattern_expr_1(_Other) -> false. +pattern_map(Ps, Vt, Old, Bvt, St) -> + foldl(fun + ({map_field_assoc,L,_,_}, {Psvt,Bvt0,St0}) -> + {Psvt,Bvt0,add_error(L, illegal_pattern, St0)}; + ({map_field_exact,L,K,V}, {Psvt,Bvt0,St0}) -> + case is_valid_map_key(K) of + true -> + {Kvt,St1} = expr(K, Vt, St0), + {Vvt,Bvt2,St2} = pattern(V, Vt, Old, Bvt, St1), + {vtmerge_pat(vtmerge_pat(Kvt, Vvt), Psvt), vtmerge_pat(Bvt0, Bvt2), St2}; + false -> + {Psvt,Bvt0,add_error(L, illegal_map_key, St0)} + end + end, {[],[],St}, Ps). + %% pattern_bin([Element], VarTable, Old, BinVarTable, State) -> %% {UpdVarTable,UpdBinVarTable,State}. %% Check a pattern group. BinVarTable are used binsize variables. @@ -2085,8 +2116,8 @@ expr({'receive',Line,Cs,To,ToEs}, Vt, St0) -> {Cvt,St3} = icrt_clauses(Cs, Vt, St2), %% Csvts = [vtnew(Tevt, Vt)|Cvt], %This is just NEW variables! Csvts = [Tevt|Cvt], - {Rvt,St4} = icrt_export(Csvts, Vt, {'receive',Line}, St3), - {vtmerge([Tvt,Tevt,Rvt]),St4}; + Rvt = icrt_export(Csvts, Vt, {'receive',Line}), + {vtmerge([Tvt,Tevt,Rvt]),St3}; expr({'fun',Line,Body}, Vt, St) -> %%No one can think funs export! case Body of @@ -2197,21 +2228,20 @@ expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) -> %% passes cannot handle exports in combination with 'after'. {Evt0,St1} = exprs(Es, Vt, St0), TryLine = {'try',Line}, - Uvt = vtunsafe(vtnames(vtnew(Evt0, Vt)), TryLine, []), - Evt1 = vtupdate(Uvt, vtsubtract(Evt0, Uvt)), + Uvt = vtunsafe(TryLine, Evt0, Vt), + Evt1 = vtupdate(Uvt, Evt0), {Sccs,St2} = icrt_clauses(Scs++Ccs, TryLine, vtupdate(Evt1, Vt), St1), Rvt0 = Sccs, - Rvt1 = vtupdate(vtunsafe(vtnames(vtnew(Rvt0, Vt)), TryLine, []), Rvt0), + Rvt1 = vtupdate(vtunsafe(TryLine, Rvt0, Vt), Rvt0), Evt2 = vtmerge(Evt1, Rvt1), {Avt0,St} = exprs(As, vtupdate(Evt2, Vt), St2), - Avt1 = vtupdate(vtunsafe(vtnames(vtnew(Avt0, Vt)), TryLine, []), Avt0), + Avt1 = vtupdate(vtunsafe(TryLine, Avt0, Vt), Avt0), Avt = vtmerge(Evt2, Avt1), {Avt,St}; expr({'catch',Line,E}, Vt, St0) -> %% No new variables added, flag new variables as unsafe. - {Evt,St1} = expr(E, Vt, St0), - Uvt = vtunsafe(vtnames(vtnew(Evt, Vt)), {'catch',Line}, []), - {vtupdate(Uvt,vtupdate(Evt, Vt)),St1}; + {Evt,St} = expr(E, Vt, St0), + {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt),St}; expr({match,_Line,P,E}, Vt, St0) -> {Evt,St1} = expr(E, Vt, St0), {Pvt,Bvt,St2} = pattern(P, vtupdate(Evt, Vt), St1), @@ -2224,9 +2254,8 @@ expr({op,Line,Op,L,R}, Vt, St0) when Op =:= 'orelse'; Op =:= 'andalso' -> {Evt1,St1} = expr(L, Vt, St0), Vt1 = vtupdate(Evt1, Vt), {Evt2,St2} = expr(R, Vt1, St1), - Vt2 = vtmerge(Evt2, Vt1), - {Vt3,St3} = icrt_export([Vt1,Vt2], Vt1, {Op,Line}, St2), - {vtmerge(Evt1, Vt3),St3}; + Evt3 = vtupdate(vtunsafe({Op,Line}, Evt2, Vt1), Evt2), + {vtmerge(Evt1, Evt3),St2}; expr({op,_Line,_Op,L,R}, Vt, St) -> expr_list([L,R], Vt, St); %They see the same variables %% The following are not allowed to occur anywhere! @@ -2254,14 +2283,9 @@ check_assoc_fields([{map_field_assoc,_,_,_}|Fs], St) -> check_assoc_fields([], St) -> St. -map_fields([{Tag,Line,K,V}|Fs], Vt, St, F) when Tag =:= map_field_assoc; - Tag =:= map_field_exact -> - St1 = case is_valid_map_key(K, St) of - true -> St; - false -> add_error(Line, illegal_map_key, St); - {false,variable,Var} -> add_error(Line, {illegal_map_key_variable,Var}, St) - end, - {Pvt,St2} = F([K,V], Vt, St1), +map_fields([{Tag,_,K,V}|Fs], Vt, St, F) when Tag =:= map_field_assoc; + Tag =:= map_field_exact -> + {Pvt,St2} = F([K,V], Vt, St), {Vts,St3} = map_fields(Fs, Vt, St2, F), {vtupdate(Pvt, Vts),St3}; map_fields([], Vt, St, _) -> @@ -2319,21 +2343,14 @@ is_valid_call(Call) -> _ -> true end. -%% is_valid_map_key(K,St) -> true | false | {false, Var::atom()} -%% check for value expression without variables - -is_valid_map_key(K,St) -> - is_valid_map_key(K,expr,St). -is_valid_map_key(K,Ctx,St) -> - case expr(K,[],St) of - {[],_} -> - is_valid_map_key_value(K,Ctx); - {[Var|_],_} -> - {false,variable,element(1,Var)} - end. +%% is_valid_map_key(K,St) -> true | false +%% variables are allowed for patterns only at the top of the tree -is_valid_map_key_value(K,Ctx) -> +is_valid_map_key({var,_,_}) -> true; +is_valid_map_key(K) -> is_valid_map_key_value(K). +is_valid_map_key_value(K) -> case K of + {var,_,_} -> false; {char,_,_} -> true; {integer,_,_} -> true; {float,_,_} -> true; @@ -2341,36 +2358,36 @@ is_valid_map_key_value(K,Ctx) -> {nil,_} -> true; {atom,_,_} -> true; {cons,_,H,T} -> - is_valid_map_key_value(H,Ctx) andalso - is_valid_map_key_value(T,Ctx); + is_valid_map_key_value(H) andalso + is_valid_map_key_value(T); {tuple,_,Es} -> foldl(fun(E,B) -> - B andalso is_valid_map_key_value(E,Ctx) + B andalso is_valid_map_key_value(E) end,true,Es); {map,_,Arg,Ps} -> % only check for value expressions to be valid % invalid map expressions are later checked in % core and kernel - is_valid_map_key_value(Arg,Ctx) andalso foldl(fun + is_valid_map_key_value(Arg) andalso foldl(fun ({Tag,_,Ke,Ve},B) when Tag =:= map_field_assoc; - Tag =:= map_field_exact, Ctx =:= expr -> - B andalso is_valid_map_key_value(Ke,Ctx) - andalso is_valid_map_key_value(Ve,Ctx); + Tag =:= map_field_exact -> + B andalso is_valid_map_key_value(Ke) + andalso is_valid_map_key_value(Ve); (_,_) -> false end,true,Ps); {map,_,Ps} -> foldl(fun ({Tag,_,Ke,Ve},B) when Tag =:= map_field_assoc; - Tag =:= map_field_exact, Ctx =:= expr -> - B andalso is_valid_map_key_value(Ke,Ctx) - andalso is_valid_map_key_value(Ve,Ctx); + Tag =:= map_field_exact -> + B andalso is_valid_map_key_value(Ke) + andalso is_valid_map_key_value(Ve); (_,_) -> false end, true, Ps); {record,_,_,Fs} -> foldl(fun ({record_field,_,Ke,Ve},B) -> - B andalso is_valid_map_key_value(Ke,Ctx) - andalso is_valid_map_key_value(Ve,Ctx) + B andalso is_valid_map_key_value(Ke) + andalso is_valid_map_key_value(Ve) end,true,Fs); {bin,_,Es} -> % only check for value expressions to be valid @@ -2378,9 +2395,9 @@ is_valid_map_key_value(K,Ctx) -> % core and kernel foldl(fun ({bin_element,_,E,_,_},B) -> - B andalso is_valid_map_key_value(E,Ctx) + B andalso is_valid_map_key_value(E) end,true,Es); - _ -> false + Val -> is_pattern_expr(Val) end. %% record_def(Line, RecordName, [RecField], State) -> State. @@ -2615,30 +2632,21 @@ type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> true -> case is_obsolete_builtin_type(TypePair) of true -> StoreType(St0); - false -> add_error(Line, {builtin_type, TypePair}, St0) -%% case is_newly_introduced_builtin_type(TypePair) of -%% %% allow some types just for bootstrapping -%% true -> -%% Warn = {new_builtin_type, TypePair}, -%% St1 = add_warning(Line, Warn, St0), -%% StoreType(St1); -%% false -> -%% add_error(Line, {builtin_type, TypePair}, St0) -%% end + false -> + case is_newly_introduced_builtin_type(TypePair) of + %% allow some types just for bootstrapping + true -> + Warn = {new_builtin_type, TypePair}, + St1 = add_warning(Line, Warn, St0), + StoreType(St1); + false -> + add_error(Line, {builtin_type, TypePair}, St0) + end end; false -> - case - dict:is_key(TypePair, TypeDefs) orelse - is_var_arity_type(TypeName) - of + case dict:is_key(TypePair, TypeDefs) of true -> - case is_newly_introduced_var_arity_type(TypeName) of - true -> - Warn = {new_var_arity_type, TypeName}, - add_warning(Line, Warn, St0); - false -> - add_error(Line, {redefine_type, TypePair}, St0) - end; + add_error(Line, {redefine_type, TypePair}, St0); false -> St1 = case Attr =:= opaque andalso @@ -2675,7 +2683,7 @@ check_type({paren_type, _L, [Type]}, SeenVars, St) -> check_type({remote_type, L, [{atom, _, Mod}, {atom, _, Name}, Args]}, SeenVars, #lint{module=CurrentMod} = St) -> case Mod =:= CurrentMod of - true -> check_type({type, L, Name, Args}, SeenVars, St); + true -> check_type({user_type, L, Name, Args}, SeenVars, St); false -> lists:foldl(fun(T, {AccSeenVars, AccSt}) -> check_type(T, AccSeenVars, AccSt) @@ -2709,12 +2717,15 @@ check_type({type, L, range, [From, To]}, SeenVars, St) -> _ -> add_error(L, {type_syntax, range}, St) end, {SeenVars, St1}; -check_type({type, _L, map, any}, SeenVars, St) -> {SeenVars, St}; +check_type({type, L, map, any}, SeenVars, St) -> + %% To get usage right while map/0 is a newly_introduced_builtin_type. + St1 = used_type({map, 0}, L, St), + {SeenVars, St1}; check_type({type, _L, map, Pairs}, SeenVars, St) -> lists:foldl(fun(Pair, {AccSeenVars, AccSt}) -> check_type(Pair, AccSeenVars, AccSt) end, {SeenVars, St}, Pairs); -check_type({type, _L, map_field_assoc, Dom, Range}, SeenVars, St) -> +check_type({type, _L, map_field_assoc, [Dom, Range]}, SeenVars, St) -> check_type({type, -1, product, [Dom, Range]}, SeenVars, St); check_type({type, _L, tuple, any}, SeenVars, St) -> {SeenVars, St}; check_type({type, _L, any}, SeenVars, St) -> {SeenVars, St}; @@ -2733,41 +2744,39 @@ check_type({type, L, record, [Name|Fields]}, SeenVars, St) -> check_record_types(L, Atom, Fields, SeenVars, St1); _ -> {SeenVars, add_error(L, {type_syntax, record}, St)} end; -check_type({type, _L, product, Args}, SeenVars, St) -> +check_type({type, _L, Tag, Args}, SeenVars, St) when Tag =:= product; + Tag =:= union; + Tag =:= tuple -> lists:foldl(fun(T, {AccSeenVars, AccSt}) -> check_type(T, AccSeenVars, AccSt) end, {SeenVars, St}, Args); check_type({type, La, TypeName, Args}, SeenVars, St) -> - #lint{usage=Usage, module = Module, types=Types} = St, + #lint{module = Module, types=Types} = St, Arity = length(Args), TypePair = {TypeName, Arity}, - St1 = case is_var_arity_type(TypeName) of - true -> St; - false -> - Obsolete = (is_warn_enabled(deprecated_type, St) - andalso obsolete_builtin_type(TypePair)), - IsObsolete = - case Obsolete of - {deprecated, Repl, _} when element(1, Repl) =/= Module -> - case dict:find(TypePair, Types) of - {ok, _} -> false; - error -> true - end; - _ -> false - end, - case IsObsolete of - true -> + Obsolete = (is_warn_enabled(deprecated_type, St) + andalso obsolete_builtin_type(TypePair)), + St1 = case Obsolete of + {deprecated, Repl, _} when element(1, Repl) =/= Module -> + case dict:find(TypePair, Types) of + {ok, _} -> + used_type(TypePair, La, St); + error -> {deprecated, Replacement, Rel} = Obsolete, Tag = deprecated_builtin_type, W = {Tag, TypePair, Replacement, Rel}, - add_warning(La, W, St); - false -> - OldUsed = Usage#usage.used_types, - UsedTypes = dict:store(TypePair, La, OldUsed), - St#lint{usage=Usage#usage{used_types=UsedTypes}} - end - end, + add_warning(La, W, St) + end; + _ -> St + end, check_type({type, -1, product, Args}, SeenVars, St1); +check_type({user_type, L, TypeName, Args}, SeenVars, St) -> + Arity = length(Args), + TypePair = {TypeName, Arity}, + St1 = used_type(TypePair, L, St), + lists:foldl(fun(T, {AccSeenVars, AccSt}) -> + check_type(T, AccSeenVars, AccSt) + end, {SeenVars, St1}, Args); check_type(I, SeenVars, St) -> case erl_eval:partial_eval(I) of {integer,_ILn,_Integer} -> {SeenVars, St}; @@ -2809,95 +2818,24 @@ check_record_types([{type, _, field_type, [{atom, AL, FName}, Type]}|Left], check_record_types([], _Name, _DefFields, SeenVars, St, _SeenFields) -> {SeenVars, St}. -is_var_arity_type(tuple) -> true; -is_var_arity_type(map) -> true; -is_var_arity_type(product) -> true; -is_var_arity_type(union) -> true; -is_var_arity_type(record) -> true; -is_var_arity_type(_) -> false. - -is_default_type({any, 0}) -> true; -is_default_type({arity, 0}) -> true; -is_default_type({array, 0}) -> true; -is_default_type({atom, 0}) -> true; -is_default_type({atom, 1}) -> true; -is_default_type({binary, 0}) -> true; -is_default_type({binary, 2}) -> true; -is_default_type({bitstring, 0}) -> true; -is_default_type({bool, 0}) -> true; -is_default_type({boolean, 0}) -> true; -is_default_type({byte, 0}) -> true; -is_default_type({char, 0}) -> true; -is_default_type({dict, 0}) -> true; -is_default_type({digraph, 0}) -> true; -is_default_type({float, 0}) -> true; -is_default_type({'fun', 0}) -> true; -is_default_type({'fun', 2}) -> true; -is_default_type({function, 0}) -> true; -is_default_type({gb_set, 0}) -> true; -is_default_type({gb_tree, 0}) -> true; -is_default_type({identifier, 0}) -> true; -is_default_type({integer, 0}) -> true; -is_default_type({integer, 1}) -> true; -is_default_type({iodata, 0}) -> true; -is_default_type({iolist, 0}) -> true; -is_default_type({list, 0}) -> true; -is_default_type({list, 1}) -> true; -is_default_type({maybe_improper_list, 0}) -> true; -is_default_type({maybe_improper_list, 2}) -> true; -is_default_type({mfa, 0}) -> true; -is_default_type({module, 0}) -> true; -is_default_type({neg_integer, 0}) -> true; -is_default_type({nil, 0}) -> true; -is_default_type({no_return, 0}) -> true; -is_default_type({node, 0}) -> true; -is_default_type({non_neg_integer, 0}) -> true; -is_default_type({none, 0}) -> true; -is_default_type({nonempty_list, 0}) -> true; -is_default_type({nonempty_list, 1}) -> true; -is_default_type({nonempty_improper_list, 2}) -> true; -is_default_type({nonempty_maybe_improper_list, 0}) -> true; -is_default_type({nonempty_maybe_improper_list, 2}) -> true; -is_default_type({nonempty_string, 0}) -> true; -is_default_type({number, 0}) -> true; -is_default_type({pid, 0}) -> true; -is_default_type({port, 0}) -> true; -is_default_type({pos_integer, 0}) -> true; -is_default_type({queue, 0}) -> true; -is_default_type({range, 2}) -> true; -is_default_type({reference, 0}) -> true; -is_default_type({set, 0}) -> true; -is_default_type({string, 0}) -> true; -is_default_type({term, 0}) -> true; -is_default_type({timeout, 0}) -> true; -is_default_type({var, 1}) -> true; -is_default_type(_) -> false. - -is_newly_introduced_var_arity_type(map) -> true; -is_newly_introduced_var_arity_type(_) -> false. - -%% is_newly_introduced_builtin_type({Name, _}) when is_atom(Name) -> false. +used_type(TypePair, L, St) -> + Usage = St#lint.usage, + OldUsed = Usage#usage.used_types, + UsedTypes = dict:store(TypePair, L, OldUsed), + St#lint{usage=Usage#usage{used_types=UsedTypes}}. + +is_default_type({Name, NumberOfTypeVariables}) -> + erl_internal:is_type(Name, NumberOfTypeVariables). + +is_newly_introduced_builtin_type({map, 0}) -> true; +is_newly_introduced_builtin_type({Name, _}) when is_atom(Name) -> false. is_obsolete_builtin_type(TypePair) -> obsolete_builtin_type(TypePair) =/= no. -%% Obsolete in OTP 17.0. -obsolete_builtin_type({array, 0}) -> - {deprecated, {array, array, 1}, "OTP 18.0"}; -obsolete_builtin_type({dict, 0}) -> - {deprecated, {dict, dict, 2}, "OTP 18.0"}; -obsolete_builtin_type({digraph, 0}) -> - {deprecated, {digraph, graph}, "OTP 18.0"}; -obsolete_builtin_type({gb_set, 0}) -> - {deprecated, {gb_sets, set, 1}, "OTP 18.0"}; -obsolete_builtin_type({gb_tree, 0}) -> - {deprecated, {gb_trees, tree, 2}, "OTP 18.0"}; -obsolete_builtin_type({queue, 0}) -> - {deprecated, {queue, queue, 1}, "OTP 18.0"}; -obsolete_builtin_type({set, 0}) -> - {deprecated, {sets, set, 1}, "OTP 18.0"}; -obsolete_builtin_type({tid, 0}) -> - {deprecated, {ets, tid}, "OTP 18.0"}; +%% To keep Dialyzer silent... +obsolete_builtin_type({1, 255}) -> + {deprecated, {2, 255}, ""}; obsolete_builtin_type({Name, A}) when is_atom(Name), is_integer(A) -> no. %% spec_decl(Line, Fun, Types, State) -> State. @@ -2909,7 +2847,7 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> end, St1 = St0#lint{specs = dict:store(MFA, Line, Specs)}, case dict:is_key(MFA, Specs) of - true -> add_error(Line, {redefine_spec, MFA}, St1); + true -> add_error(Line, {redefine_spec, MFA0}, St1); false -> check_specs(TypeSpecs, Arity, St1) end. @@ -2917,16 +2855,50 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> callback_decl(Line, MFA0, TypeSpecs, St0 = #lint{callbacks = Callbacks, module = Mod}) -> - MFA = case MFA0 of - {F, Arity} -> {Mod, F, Arity}; - {_M, _F, Arity} -> MFA0 - end, - St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, - case dict:is_key(MFA, Callbacks) of - true -> add_error(Line, {redefine_callback, MFA}, St1); - false -> check_specs(TypeSpecs, Arity, St1) + case MFA0 of + {_M, _F, _A} -> add_error(Line, {bad_callback, MFA0}, St0); + {F, Arity} -> + MFA = {Mod, F, Arity}, + St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, + case dict:is_key(MFA, Callbacks) of + true -> add_error(Line, {redefine_callback, MFA0}, St1); + false -> check_specs(TypeSpecs, Arity, St1) + end + end. + +%% optional_callbacks(Line, FAs, State) -> State. + +optional_callbacks(Line, Term, St0) -> + try true = is_fa_list(Term), Term of + FAs -> + optional_cbs(Line, FAs, St0) + catch + _:_ -> + St0 % ignore others end. +optional_cbs(_Line, [], St) -> + St; +optional_cbs(Line, [{F,A}|FAs], St0) -> + #lint{optional_callbacks = OptionalCbs, module = Mod} = St0, + MFA = {Mod, F, A}, + St1 = St0#lint{optional_callbacks = dict:store(MFA, Line, OptionalCbs)}, + St2 = case dict:is_key(MFA, OptionalCbs) of + true -> + add_error(Line, {redefine_optional_callback, {F,A}}, St1); + false -> + St1 + end, + optional_cbs(Line, FAs, St2). + +is_fa_list([E|L]) -> is_fa(E) andalso is_fa_list(L); +is_fa_list([]) -> true; +is_fa_list(_) -> false. + +is_fa({FuncName, Arity}) + when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> true; +is_fa(_) -> false. + check_specs([FunType|Left], Arity, St0) -> {FunType1, CTypes} = case FunType of @@ -2950,10 +2922,11 @@ check_specs([], _Arity, St) -> St. check_specs_without_function(#lint{module=Mod,defined=Funcs,specs=Specs}=St) -> - Fun = fun({M, F, A} = MFA, Line, AccSt) when M =:= Mod -> - case gb_sets:is_element({F, A}, Funcs) of + Fun = fun({M, F, A}, Line, AccSt) when M =:= Mod -> + FA = {F, A}, + case gb_sets:is_element(FA, Funcs) of true -> AccSt; - false -> add_error(Line, {spec_fun_undefined, MFA}, AccSt) + false -> add_error(Line, {spec_fun_undefined, FA}, AccSt) end; ({_M, _F, _A}, _Line, AccSt) -> AccSt end, @@ -3032,11 +3005,12 @@ check_local_opaque_types(St) -> dict:fold(FoldFun, St, Ts). %% icrt_clauses(Clauses, In, ImportVarTable, State) -> -%% {NewVts,State}. +%% {UpdVt,State}. icrt_clauses(Cs, In, Vt, St0) -> {Csvt,St1} = icrt_clauses(Cs, Vt, St0), - icrt_export(Csvt, Vt, In, St1). + UpdVt = icrt_export(Csvt, Vt, In), + {UpdVt,St1}. %% icrt_clauses(Clauses, ImportVarTable, State) -> %% {NewVts,State}. @@ -3046,26 +3020,73 @@ icrt_clauses(Cs, Vt, St) -> icrt_clause({clause,_Line,H,G,B}, Vt0, St0) -> {Hvt,Binvt,St1} = head(H, Vt0, St0), - Vt1 = vtupdate(Hvt, vtupdate(Binvt, Vt0)), - {Gvt,St2} = guard(G, Vt1, St1), + Vt1 = vtupdate(Hvt, Binvt), + {Gvt,St2} = guard(G, vtupdate(Vt1, Vt0), St1), Vt2 = vtupdate(Gvt, Vt1), - {Bvt,St3} = exprs(B, Vt2, St2), + {Bvt,St3} = exprs(B, vtupdate(Vt2, Vt0), St2), {vtupdate(Bvt, Vt2),St3}. -icrt_export(Csvt, Vt, In, St) -> - Vt1 = vtmerge(Csvt), - All = ordsets:subtract(vintersection(Csvt), vtnames(Vt)), - Some = ordsets:subtract(vtnames(Vt1), vtnames(Vt)), - Xvt = vtexport(All, In, []), - Evt = vtunsafe(ordsets:subtract(Some, All), In, Xvt), - Unused = vtmerge([unused_vars(Vt0, Vt, St) || Vt0 <- Csvt]), - %% Exported and unsafe variables may be unused: - Uvt = vtmerge(Evt, Unused), - %% Make exported and unsafe unused variables unused in subsequent code: - Vt2 = vtmerge(Uvt, vtsubtract(Vt1, Uvt)), - %% Forget about old variables which were not used: - Vt3 = vtmerge(vtnew(Vt2, Vt), vt_no_unused(vtold(Vt2, Vt))), - {Vt3,St}. +icrt_export(Vts, Vt, {Tag,Attrs}) -> + {_File,Loc} = loc(Attrs), + icrt_export(lists:merge(Vts), Vt, {Tag,Loc}, length(Vts), []). + +icrt_export([{V,{{export,_},_,_}}|Vs0], [{V,{{export,_}=S0,_,Ls}}|Vt], + In, I, Acc) -> + %% V was an exported variable and has been used in an expression in at least + %% one clause. Its state needs to be merged from all clauses to silence any + %% exported var warning already emitted. + {VVs,Vs} = lists:partition(fun ({K,_}) -> K =:= V end, Vs0), + S = foldl(fun ({_,{S1,_,_}}, AccS) -> merge_state(AccS, S1) end, S0, VVs), + icrt_export(Vs, Vt, In, I, [{V,{S,used,Ls}}|Acc]); +icrt_export([{V,_}|Vs0], [{V,{_,_,Ls}}|Vt], In, I, Acc) -> + %% V was either unsafe or bound and has now been reused. It may also have + %% been an export but as it was not matched by the previous clause, it means + %% it has been changed to 'bound' in at least one clause because it was used + %% in a pattern. + Vs = lists:dropwhile(fun ({K,_}) -> K =:= V end, Vs0), + icrt_export(Vs, Vt, In, I, [{V,{bound,used,Ls}}|Acc]); +icrt_export([{V1,_}|_]=Vs, [{V2,_}|Vt], In, I, Acc) when V1 > V2 -> + %% V2 was already in scope and has not been reused in any clause. + icrt_export(Vs, Vt, In, I, Acc); +icrt_export([{V,_}|_]=Vs0, Vt, In, I, Acc) -> + %% V is a new variable. + {VVs,Vs} = lists:partition(fun ({K,_}) -> K =:= V end, Vs0), + F = fun ({_,{S,U,Ls}}, {AccI,AccS0,AccLs0}) -> + AccS = case {S,AccS0} of + {{unsafe,_},{unsafe,_}} -> + %% V was found unsafe in a previous clause, mark + %% it as unsafe for the whole parent expression. + {unsafe,In}; + {{unsafe,_},_} -> + %% V was unsafe in a clause, keep that state and + %% generalize it to the whole expression if it + %% is found unsafe in another one. + S; + _ -> + %% V is either bound or exported, keep original + %% state. + AccS0 + end, + AccLs = case U of + used -> AccLs0; + unused -> merge_lines(AccLs0, Ls) + end, + {AccI + 1,AccS,AccLs} + end, + %% Initial state is exported from the current expression. + {Count,S1,Ls} = foldl(F, {0,{export,In},[]}, VVs), + S = case Count of + I -> + %% V was found in all clauses, keep computed state. + S1; + _ -> + %% V was not bound in some clauses, mark as unsafe. + {unsafe,In} + end, + U = case Ls of [] -> used; _ -> unused end, + icrt_export(Vs, Vt, In, I, [{V,{S,U,Ls}}|Acc]); +icrt_export([], _, _, _, Acc) -> + reverse(Acc). handle_comprehension(E, Qs, Vt0, St0) -> {Vt1, Uvt, St1} = lc_quals(Qs, Vt0, St0), @@ -3163,7 +3184,8 @@ fun_clauses(Cs, Vt, St) -> {Cvt,St1} = fun_clause(C, Vt, St0), {vtmerge(Cvt, Bvt0),St1} end, {[],St#lint{recdef_top = false}}, Cs), - {vt_no_unused(vtold(Bvt, Vt)),St2#lint{recdef_top = OldRecDef}}. + Uvt = vt_no_unsafe(vt_no_unused(vtold(Bvt, Vt))), + {Uvt,St2#lint{recdef_top = OldRecDef}}. fun_clause({clause,_Line,H,G,B}, Vt0, St0) -> {Hvt,Binvt,St1} = head(H, Vt0, [], St0), % No imported pattern variables @@ -3277,19 +3299,24 @@ pat_binsize_var(V, Line, Vt, Bvt, St) -> %% exported vars are probably safe, warn only if warn_export_vars is %% set. -expr_var(V, Line, Vt, St0) -> +expr_var(V, Line, Vt, St) -> case orddict:find(V, Vt) of {ok,{bound,_Usage,Ls}} -> - {[{V,{bound,used,Ls}}],St0}; + {[{V,{bound,used,Ls}}],St}; {ok,{{unsafe,In},_Usage,Ls}} -> {[{V,{bound,used,Ls}}], - add_error(Line, {unsafe_var,V,In}, St0)}; + add_error(Line, {unsafe_var,V,In}, St)}; {ok,{{export,From},_Usage,Ls}} -> - {[{V,{bound,used,Ls}}], - exported_var(Line, V, From, St0)}; + case is_warn_enabled(export_vars, St) of + true -> + {[{V,{bound,used,Ls}}], + add_warning(Line, {exported_var,V,From}, St)}; + false -> + {[{V,{{export,From},used,Ls}}],St} + end; error -> {[{V,{bound,used,[Line]}}], - add_error(Line, {unbound_var,V}, St0)} + add_error(Line, {unbound_var,V}, St)} end. exported_var(Line, V, From, St) -> @@ -3353,17 +3380,12 @@ vtupdate(Uvt, Vt0) -> {S, merge_used(U1, U2), merge_lines(L1, L2)} end, Uvt, Vt0). -%% vtexport([Variable], From, VarTable) -> VarTable. -%% vtunsafe([Variable], From, VarTable) -> VarTable. -%% Add the variables to VarTable either as exported from From or as unsafe. +%% vtunsafe(From, UpdVarTable, VarTable) -> UnsafeVarTable. +%% Return all new variables in UpdVarTable as unsafe. -vtexport(Vs, {InTag,FileLine}, Vt0) -> +vtunsafe({Tag,FileLine}, Uvt, Vt) -> {_File,Line} = loc(FileLine), - vtupdate([{V,{{export,{InTag,Line}},unused,[]}} || V <- Vs], Vt0). - -vtunsafe(Vs, {InTag,FileLine}, Vt0) -> - {_File,Line} = loc(FileLine), - vtupdate([{V,{{unsafe,{InTag,Line}},unused,[]}} || V <- Vs], Vt0). + [{V,{{unsafe,{Tag,Line}},U,Ls}} || {V,{_,U,Ls}} <- vtnew(Uvt, Vt)]. %% vtmerge(VarTable, VarTable) -> VarTable. %% Merge two variables tables generating a new vartable. Give priority to @@ -3416,8 +3438,6 @@ vtsubtract(New, Old) -> vtold(New, Old) -> orddict:filter(fun (V, _How) -> orddict:is_key(V, Old) end, New). -vtnames(Vt) -> [ V || {V,_How} <- Vt ]. - vt_no_unsafe(Vt) -> [V || {_,{S,_U,_L}}=V <- Vt, case S of {unsafe,_} -> false; @@ -3426,29 +3446,6 @@ vt_no_unsafe(Vt) -> [V || {_,{S,_U,_L}}=V <- Vt, vt_no_unused(Vt) -> [V || {_,{_,U,_L}}=V <- Vt, U =/= unused]. -%% vunion(VarTable1, VarTable2) -> [VarName]. -%% vunion([VarTable]) -> [VarName]. -%% vintersection(VarTable1, VarTable2) -> [VarName]. -%% vintersection([VarTable]) -> [VarName]. -%% Union/intersection of names of vars in VarTable. - --ifdef(NOTUSED). -vunion(Vs1, Vs2) -> ordsets:union(vtnames(Vs1), vtnames(Vs2)). - -vunion(Vss) -> foldl(fun (Vs, Uvs) -> - ordsets:union(vtnames(Vs), Uvs) - end, [], Vss). - -vintersection(Vs1, Vs2) -> ordsets:intersection(vtnames(Vs1), vtnames(Vs2)). --endif. - -vintersection([Vs]) -> - vtnames(Vs); %Boundary conditions!!! -vintersection([Vs|Vss]) -> - ordsets:intersection(vtnames(Vs), vintersection(Vss)); -vintersection([]) -> - []. - %% copy_expr(Expr, Line) -> Expr. %% Make a copy of Expr converting all line numbers to Line. diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 1d4a2a1fef..3502a50eaa 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -42,7 +42,6 @@ function_call argument_list exprs guard atomic strings prefix_op mult_op add_op list_op comp_op -rule rule_clauses rule_clause rule_body binary bin_elements bin_element bit_expr opt_bit_size_expr bit_size_expr opt_bit_type_list bit_type_list bit_type top_type top_type_100 top_types type typed_expr typed_attr_val @@ -54,7 +53,7 @@ bin_base_type bin_unit_type type_200 type_300 type_400 type_500. Terminals char integer float atom string var -'(' ')' ',' '->' ':-' '{' '}' '[' ']' '|' '||' '<-' ';' ':' '#' '.' +'(' ')' ',' '->' '{' '}' '[' ']' '|' '||' '<-' ';' ':' '#' '.' 'after' 'begin' 'case' 'try' 'catch' 'end' 'fun' 'if' 'of' 'receive' 'when' 'andalso' 'orelse' 'bnot' 'not' @@ -73,7 +72,6 @@ Rootsymbol form. form -> attribute dot : '$1'. form -> function dot : '$1'. -form -> rule dot : '$1'. attribute -> '-' atom attr_val : build_attribute('$2', '$3'). attribute -> '-' atom typed_attr_val : build_typed_attribute('$2','$3'). @@ -146,8 +144,7 @@ type -> '(' top_type ')' : {paren_type, ?line('$2'), ['$2']}. type -> var : '$1'. type -> atom : '$1'. type -> atom '(' ')' : build_gen_type('$1'). -type -> atom '(' top_types ')' : {type, ?line('$1'), - normalise('$1'), '$3'}. +type -> atom '(' top_types ')' : build_type('$1', '$3'). type -> atom ':' atom '(' ')' : {remote_type, ?line('$1'), ['$1', '$3', []]}. type -> atom ':' atom '(' top_types ')' : {remote_type, ?line('$1'), @@ -181,7 +178,7 @@ fun_type -> '(' top_types ')' '->' top_type map_pair_types -> map_pair_type : ['$1']. map_pair_types -> map_pair_type ',' map_pair_types : ['$1'|'$3']. -map_pair_type -> top_type '=>' top_type : {type, ?line('$2'), map_field_assoc,'$1','$3'}. +map_pair_type -> top_type '=>' top_type : {type, ?line('$2'), map_field_assoc,['$1','$3']}. field_types -> field_type : ['$1']. field_types -> field_type ',' field_types : ['$1'|'$3']. @@ -521,17 +518,6 @@ comp_op -> '>' : '$1'. comp_op -> '=:=' : '$1'. comp_op -> '=/=' : '$1'. -rule -> rule_clauses : build_rule('$1'). - -rule_clauses -> rule_clause : ['$1']. -rule_clauses -> rule_clause ';' rule_clauses : ['$1'|'$3']. - -rule_clause -> atom clause_args clause_guard rule_body : - {clause,?line('$1'),element(3, '$1'),'$2','$3','$4'}. - -rule_body -> ':-' lc_exprs: '$2'. - - Erlang code. -export([parse_form/1,parse_exprs/1,parse_term/1]). @@ -665,6 +651,8 @@ find_arity_from_specs([Spec|_]) -> {type, _, 'fun', [{type, _, product, Args},_]} = Fun, length(Args). +build_def({var, L, '_'}, _Types) -> + ret_err(L, "bad type variable"); build_def(LHS, Types) -> IsSubType = {atom, ?line(LHS), is_subtype}, {type, ?line(LHS), constraint, [IsSubType, [LHS, Types]]}. @@ -684,7 +672,8 @@ build_gen_type({atom, La, tuple}) -> build_gen_type({atom, La, map}) -> {type, La, map, any}; build_gen_type({atom, La, Name}) -> - {type, La, Name, []}. + Tag = type_tag(Name, 0), + {Tag, La, Name, []}. build_bin_type([{var, _, '_'}|Left], Int) -> build_bin_type(Left, Int); @@ -693,6 +682,16 @@ build_bin_type([], Int) -> build_bin_type([{var, La, _}|_], _) -> ret_err(La, "Bad binary type"). +build_type({atom, L, Name}, Types) -> + Tag = type_tag(Name, length(Types)), + {Tag, L, Name, Types}. + +type_tag(TypeName, NumberOfTypeVariables) -> + case erl_internal:is_type(TypeName, NumberOfTypeVariables) of + true -> type; + false -> user_type + end. + %% build_attribute(AttrName, AttrValue) -> %% {attribute,Line,module,Module} %% {attribute,Line,export,Exports} @@ -834,13 +833,6 @@ build_function(Cs) -> Arity = length(element(4, hd(Cs))), {function,?line(hd(Cs)),Name,Arity,check_clauses(Cs, Name, Arity)}. -%% build_rule([Clause]) -> {rule,Line,Name,Arity,[Clause]'} - -build_rule(Cs) -> - Name = element(3, hd(Cs)), - Arity = length(element(4, hd(Cs))), - {rule,?line(hd(Cs)),Name,Arity,check_clauses(Cs, Name, Arity)}. - %% build_fun(Line, [Clause]) -> {'fun',Line,{clauses,[Clause]}}. build_fun(Line, Cs) -> diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 1fd6d2a8df..469ce544c7 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -22,7 +22,7 @@ %%% the parser. It does not always produce pretty code. -export([form/1,form/2, - attribute/1,attribute/2,function/1,function/2,rule/1,rule/2, + attribute/1,attribute/2,function/1,function/2, guard/1,guard/2,exprs/1,exprs/2,exprs/3,expr/1,expr/2,expr/3,expr/4]). -import(lists, [append/1,foldr/3,mapfoldl/3,reverse/1,reverse/2]). @@ -91,12 +91,6 @@ function(F) -> function(F, Options) -> frmt(lfunction(F, options(Options)), state(Options)). -rule(R) -> - rule(R, none). - -rule(R, Options) -> - frmt(lrule(R, options(Options)), state(Options)). - -spec(guard(Guard) -> io_lib:chars() when Guard :: [erl_parse:abstract_expr()]). @@ -199,8 +193,6 @@ lform({attribute,Line,Name,Arg}, Opts, State) -> lattribute({attribute,Line,Name,Arg}, Opts, State); lform({function,Line,Name,Arity,Clauses}, Opts, _State) -> lfunction({function,Line,Name,Arity,Clauses}, Opts); -lform({rule,Line,Name,Arity,Clauses}, Opts, _State) -> - lrule({rule,Line,Name,Arity,Clauses}, Opts); %% These are specials to make it easier for the compiler. lform({error,E}, _Opts, _State) -> leaf(format("~p\n", [{error,E}])); @@ -232,13 +224,21 @@ lattribute(import, Name, _Opts, _State) when is_list(Name) -> attr("import", [{var,0,pname(Name)}]); lattribute(import, {From,Falist}, _Opts, _State) -> attr("import",[{var,0,pname(From)},falist(Falist)]); +lattribute(optional_callbacks, Falist, Opts, _State) -> + ArgL = try falist(Falist) + catch _:_ -> abstract(Falist, Opts) + end, + call({var,0,"-optional_callbacks"}, [ArgL], 0, options(none)); lattribute(file, {Name,Line}, _Opts, State) -> attr("file", [{var,0,(State#pp.string_fun)(Name)},{integer,0,Line}]); lattribute(record, {Name,Is}, Opts, _State) -> Nl = leaf(format("-record(~w,", [Name])), [{first,Nl,record_fields(Is, Opts)},$)]; -lattribute(Name, Arg, #options{encoding = Encoding}, _State) -> - attr(write(Name), [erl_parse:abstract(Arg, [{encoding,Encoding}])]). +lattribute(Name, Arg, Options, _State) -> + attr(write(Name), [abstract(Arg, Options)]). + +abstract(Arg, #options{encoding = Encoding}) -> + erl_parse:abstract(Arg, [{encoding,Encoding}]). typeattr(Tag, {TypeName,Type,Args}, _Opts) -> {first,leaf("-"++atom_to_list(Tag)++" "), @@ -277,6 +277,9 @@ ltype({type,_,'fun',[{type,_,any},_]}=FunType) -> ltype({type,_Line,'fun',[{type,_,product,_},_]}=FunType) -> [fun_type(['fun',$(], FunType),$)]; ltype({type,Line,T,Ts}) -> + %% Compatibility. Before 18.0. + simple_type({atom,Line,T}, Ts); +ltype({user_type,Line,T,Ts}) -> simple_type({atom,Line,T}, Ts); ltype({remote_type,Line,[M,F,Ts]}) -> simple_type({remote,Line,M,F}, Ts); @@ -299,7 +302,7 @@ map_type(Fs) -> map_pair_types(Fs) -> tuple_type(Fs, fun map_pair_type/1). -map_pair_type({type,_Line,map_field_assoc,Ktype,Vtype}) -> +map_pair_type({type,_Line,map_field_assoc,[Ktype,Vtype]}) -> map_assoc_typed(ltype(Ktype), Vtype). map_assoc_typed(B, {type,_,union,Ts}) -> @@ -407,19 +410,6 @@ func_clause(Name, {clause,Line,Head,Guard,Body}, Opts) -> Bl = body(Body, Opts), {step,Gl,Bl}. -lrule({rule,_Line,Name,_Arity,Cs}, Opts) -> - Cll = nl_clauses(fun (C, H) -> rule_clause(Name, C, H) end, $;, Opts, Cs), - [Cll,leaf(".\n")]. - -rule_clause(Name, {clause,Line,Head,Guard,Body}, Opts) -> - Hl = call({atom,Line,Name}, Head, 0, Opts), - Gl = guard_when(Hl, Guard, Opts, leaf(" :-")), - Bl = rule_body(Body, Opts), - {step,Gl,Bl}. - -rule_body(Es, Opts) -> - lc_quals(Es, Opts). - guard_when(Before, Guard, Opts) -> guard_when(Before, Guard, Opts, ' ->'). diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 6fd6bb888b..4960a86760 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -599,9 +599,6 @@ scan1("|"=Cs, _St, Line, Col, Toks) -> %% := scan1(":="++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, ":=", ':=', 2); -%% :- -scan1(":-"++Cs, St, Line, Col, Toks) -> - tok2(Cs, St, Line, Col, Toks, ":-", ':-', 2); %% :: for typed records scan1("::"++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "::", '::', 2); diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index e6bde5673c..632af17e2a 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -444,6 +444,8 @@ join1([], RelativeName, [$:|Rest], win32) -> join1(RelativeName, [], [$:|Rest], win32); join1([], RelativeName, [$/|Result], OsType) -> join1(RelativeName, [], [$/|Result], OsType); +join1([], RelativeName, [$., $/|Result], OsType) -> + join1(RelativeName, [], [$/|Result], OsType); join1([], RelativeName, Result, OsType) -> join1(RelativeName, [], [$/|Result], OsType); join1([[_|_]=List|Rest], RelativeName, Result, OsType) -> @@ -470,6 +472,8 @@ join1b(<<>>, RelativeName, [$:|Rest], win32) -> join1b(RelativeName, <<>>, [$:|Rest], win32); join1b(<<>>, RelativeName, [$/|Result], OsType) -> join1b(RelativeName, <<>>, [$/|Result], OsType); +join1b(<<>>, RelativeName, [$., $/|Result], OsType) -> + join1b(RelativeName, <<>>, [$/|Result], OsType); join1b(<<>>, RelativeName, Result, OsType) -> join1b(RelativeName, <<>>, [$/|Result], OsType); join1b(<<Char,Rest/binary>>, RelativeName, Result, OsType) when is_integer(Char) -> diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 63116fa16e..6d7ca3d75c 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -26,7 +26,7 @@ %%% The standard behaviour should export init_it/6. %%%----------------------------------------------------------------- -export([start/5, start/6, debug_options/1, - call/3, call/4, reply/2]). + call/3, call/4, reply/2, stop/1, stop/3]). -export([init_it/6, init_it/7]). @@ -145,56 +145,10 @@ init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options) -> call(Process, Label, Request) -> call(Process, Label, Request, ?default_timeout). -%% Local or remote by pid -call(Pid, Label, Request, Timeout) - when is_pid(Pid), Timeout =:= infinity; - is_pid(Pid), is_integer(Timeout), Timeout >= 0 -> - do_call(Pid, Label, Request, Timeout); -%% Local by name -call(Name, Label, Request, Timeout) - when is_atom(Name), Timeout =:= infinity; - is_atom(Name), is_integer(Timeout), Timeout >= 0 -> - case whereis(Name) of - Pid when is_pid(Pid) -> - do_call(Pid, Label, Request, Timeout); - undefined -> - exit(noproc) - end; -%% Global by name call(Process, Label, Request, Timeout) - when ((tuple_size(Process) == 2 andalso element(1, Process) == global) - orelse - (tuple_size(Process) == 3 andalso element(1, Process) == via)) - andalso - (Timeout =:= infinity orelse (is_integer(Timeout) andalso Timeout >= 0)) -> - case where(Process) of - Pid when is_pid(Pid) -> - Node = node(Pid), - try do_call(Pid, Label, Request, Timeout) - catch - exit:{nodedown, Node} -> - %% A nodedown not yet detected by global, - %% pretend that it was. - exit(noproc) - end; - undefined -> - exit(noproc) - end; -%% Local by name in disguise -call({Name, Node}, Label, Request, Timeout) - when Node =:= node(), Timeout =:= infinity; - Node =:= node(), is_integer(Timeout), Timeout >= 0 -> - call(Name, Label, Request, Timeout); -%% Remote by name -call({_Name, Node}=Process, Label, Request, Timeout) - when is_atom(Node), Timeout =:= infinity; - is_atom(Node), is_integer(Timeout), Timeout >= 0 -> - if - node() =:= nonode@nohost -> - exit({nodedown, Node}); - true -> - do_call(Process, Label, Request, Timeout) - end. + when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 -> + Fun = fun(Pid) -> do_call(Pid, Label, Request, Timeout) end, + do_for_proc(Process, Fun). do_call(Process, Label, Request, Timeout) -> try erlang:monitor(process, Process) of @@ -276,6 +230,65 @@ reply({To, Tag}, Reply) -> Msg = {Tag, Reply}, try To ! Msg catch _:_ -> Msg end. +%%----------------------------------------------------------------- +%% Syncronously stop a generic process +%%----------------------------------------------------------------- +stop(Process) -> + stop(Process, normal, infinity). + +stop(Process, Reason, Timeout) + when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 -> + Fun = fun(Pid) -> proc_lib:stop(Pid, Reason, Timeout) end, + do_for_proc(Process, Fun). + +%%----------------------------------------------------------------- +%% Map different specifications of a process to either Pid or +%% {Name,Node}. Execute the given Fun with the process as only +%% argument. +%% ----------------------------------------------------------------- + +%% Local or remote by pid +do_for_proc(Pid, Fun) when is_pid(Pid) -> + Fun(Pid); +%% Local by name +do_for_proc(Name, Fun) when is_atom(Name) -> + case whereis(Name) of + Pid when is_pid(Pid) -> + Fun(Pid); + undefined -> + exit(noproc) + end; +%% Global by name +do_for_proc(Process, Fun) + when ((tuple_size(Process) == 2 andalso element(1, Process) == global) + orelse + (tuple_size(Process) == 3 andalso element(1, Process) == via)) -> + case where(Process) of + Pid when is_pid(Pid) -> + Node = node(Pid), + try Fun(Pid) + catch + exit:{nodedown, Node} -> + %% A nodedown not yet detected by global, + %% pretend that it was. + exit(noproc) + end; + undefined -> + exit(noproc) + end; +%% Local by name in disguise +do_for_proc({Name, Node}, Fun) when Node =:= node() -> + do_for_proc(Name, Fun); +%% Remote by name +do_for_proc({_Name, Node} = Process, Fun) when is_atom(Node) -> + if + node() =:= nonode@nohost -> + exit({nodedown, Node}); + true -> + Fun(Process) + end. + + %%%----------------------------------------------------------------- %%% Misc. functions. %%%----------------------------------------------------------------- diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 469acdc37c..5a1fff3a9c 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -31,8 +31,8 @@ %%% Modified by Martin - uses proc_lib, sys and gen! --export([start/0, start/1, start_link/0, start_link/1, stop/1, notify/2, - sync_notify/2, +-export([start/0, start/1, start_link/0, start_link/1, stop/1, stop/3, + notify/2, sync_notify/2, add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3, swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]). @@ -99,6 +99,14 @@ -callback code_change(OldVsn :: (term() | {down, term()}), State :: term(), Extra :: term()) -> {ok, NewState :: term()}. +-callback format_status(Opt, StatusData) -> Status when + Opt :: 'normal' | 'terminate', + StatusData :: [PDict | State], + PDict :: [{Key :: term(), Value :: term()}], + State :: term(), + Status :: term(). + +-optional_callbacks([format_status/2]). %%--------------------------------------------------------------------------- @@ -183,7 +191,11 @@ swap_sup_handler(M, {H1, A1}, {H2, A2}) -> which_handlers(M) -> rpc(M, which_handlers). -spec stop(emgr_ref()) -> 'ok'. -stop(M) -> rpc(M, stop). +stop(M) -> + gen:stop(M). + +stop(M, Reason, Timeout) -> + gen:stop(M, Reason, Timeout). rpc(M, Cmd) -> {ok, Reply} = gen:call(M, self(), Cmd, infinity), diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 5afe3e8b09..89825a6a57 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -106,6 +106,7 @@ -export([start/3, start/4, start_link/3, start_link/4, + stop/1, stop/3, send_event/2, sync_send_event/2, sync_send_event/3, send_all_state_event/2, sync_send_all_state_event/2, sync_send_all_state_event/3, @@ -160,6 +161,14 @@ -callback code_change(OldVsn :: term() | {down, term()}, StateName :: atom(), StateData :: term(), Extra :: term()) -> {ok, NextStateName :: atom(), NewStateData :: term()}. +-callback format_status(Opt, StatusData) -> Status when + Opt :: 'normal' | 'terminate', + StatusData :: [PDict | State], + PDict :: [{Key :: term(), Value :: term()}], + State :: term(), + Status :: term(). + +-optional_callbacks([format_status/2]). %%% --------------------------------------------------- %%% Starts a generic state machine. @@ -189,6 +198,11 @@ start_link(Mod, Args, Options) -> start_link(Name, Mod, Args, Options) -> gen:start(?MODULE, link, Name, Mod, Args, Options). +stop(Name) -> + gen:stop(Name). + +stop(Name, Reason, Timeout) -> + gen:stop(Name, Reason, Timeout). send_event({global, Name}, Event) -> catch global:send(Name, {'$gen_event', Event}), diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 528dd23e1c..139bf35d27 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -88,6 +88,7 @@ %% API -export([start/3, start/4, start_link/3, start_link/4, + stop/1, stop/3, call/2, call/3, cast/2, reply/2, abcast/2, abcast/3, @@ -137,6 +138,15 @@ -callback code_change(OldVsn :: (term() | {down, term()}), State :: term(), Extra :: term()) -> {ok, NewState :: term()} | {error, Reason :: term()}. +-callback format_status(Opt, StatusData) -> Status when + Opt :: 'normal' | 'terminate', + StatusData :: [PDict | State], + PDict :: [{Key :: term(), Value :: term()}], + State :: term(), + Status :: term(). + +-optional_callbacks([format_status/2]). + %%% ----------------------------------------------------------------- %%% Starts a generic server. @@ -168,6 +178,17 @@ start_link(Name, Mod, Args, Options) -> %% ----------------------------------------------------------------- +%% Stop a generic server and wait for it to terminate. +%% If the server is located at another node, that node will +%% be monitored. +%% ----------------------------------------------------------------- +stop(Name) -> + gen:stop(Name). + +stop(Name, Reason, Timeout) -> + gen:stop(Name, Reason, Timeout). + +%% ----------------------------------------------------------------- %% Make a call to a generic server. %% If the server is located at another node, that node will %% be monitored. @@ -846,22 +867,10 @@ opt(_, []) -> debug_options(Name, Opts) -> case opt(debug, Opts) of - {ok, Options} -> dbg_options(Name, Options); - _ -> dbg_options(Name, []) + {ok, Options} -> dbg_opts(Name, Options); + _ -> [] end. -dbg_options(Name, []) -> - Opts = - case init:get_argument(generic_debug) of - error -> - []; - _ -> - [log, statistics] - end, - dbg_opts(Name, Opts); -dbg_options(Name, Opts) -> - dbg_opts(Name, Opts). - dbg_opts(Name, Opts) -> case catch sys:debug_options(Opts) of {'EXIT',_} -> diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 97564e2e44..7b6f4e5b50 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -1079,6 +1079,12 @@ normalise({cons,_,Head,Tail}) -> [normalise(Head)|normalise(Tail)]; normalise({tuple,_,Args}) -> list_to_tuple(normalise_list(Args)); +normalise({map,_,Pairs0}) -> + Pairs1 = lists:map(fun ({map_field_exact,_,K,V}) -> + {normalise(K),normalise(V)} + end, + Pairs0), + maps:from_list(Pairs1); %% Special case for unary +/-. normalise({op,_,'+',{char,_,I}}) -> I; normalise({op,_,'+',{integer,_,I}}) -> I; diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 6c25beabe9..0ace87ef5c 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -577,8 +577,6 @@ obsolete_1(asn1rt, utf8_binary_to_list, 1) -> {deprecated,{unicode,characters_to_list,1}}; obsolete_1(asn1rt, utf8_list_to_binary, 1) -> {deprecated,{unicode,characters_to_binary,1}}; -obsolete_1(pg, _, _) -> - {deprecated,"deprecated; will be removed in OTP 18"}; obsolete_1(_, _, _) -> no. diff --git a/lib/stdlib/src/pg.erl b/lib/stdlib/src/pg.erl deleted file mode 100644 index a41fd329c2..0000000000 --- a/lib/stdlib/src/pg.erl +++ /dev/null @@ -1,187 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% --module(pg). --deprecated(module). - -%% pg provides a process group facility. Messages -%% can be multicasted to all members in the group - --export([create/1, - create/2, - standby/2, - join/2, - send/2, - esend/2, - members/1, - name_to_pid/1, - master/1]). - - -%% Create a brand new empty process group with the master residing -%% at the local node - --spec create(PgName) -> 'ok' | {'error', Reason} when - PgName :: term(), - Reason :: 'already_created' | term(). - -create(PgName) -> - catch begin check(PgName), - Pid = spawn(pg,master,[PgName]), - global:register_name(PgName,Pid), - ok end. - -%% Create a brand new empty process group with the master -%% residing at Node - --spec create(PgName, Node) -> 'ok' | {'error', Reason} when - PgName :: term(), - Node :: node(), - Reason :: 'already_created' | term(). - -create(PgName, Node) -> - catch begin check(PgName), - Pid = spawn(Node,pg,master,[PgName]), - global:register_name(PgName,Pid), - ok end. - -%% Have a process on Node that will act as a standby for the process -%% group manager. So if the node where the manager runs fails, the -%% process group will continue to function. - --spec standby(term(), node()) -> 'ok'. - -standby(_PgName, _Node) -> - ok. - -%% Tell process group PgName that Pid is a new member of the group -%% synchronously return a list of all old members in the group - --spec join(PgName, Pid) -> Members when - PgName :: term(), - Pid :: pid(), - Members :: [pid()]. - -join(PgName, Pid) when is_atom(PgName) -> - global:send(PgName, {join,self(),Pid}), - receive - {_P,{members,Members}} -> - Members - end. - -%% Multi cast Mess to all members in the group - --spec send(PgName, Msg) -> 'ok' when - PgName :: term(), - Msg :: term(). - -send(PgName, Mess) when is_atom(PgName) -> - global:send(PgName, {send, self(), Mess}), - ok; -send(Pg, Mess) when is_pid(Pg) -> - Pg ! {send,self(),Mess}, - ok. - -%% multi cast a message to all members in the group but ourselves -%% If we are a member - --spec esend(PgName, Msg) -> 'ok' when - PgName :: term(), - Msg :: term(). - -esend(PgName, Mess) when is_atom(PgName) -> - global:send(PgName, {esend,self(),Mess}), - ok; -esend(Pg, Mess) when is_pid(Pg) -> - Pg ! {esend,self(),Mess}, - ok. - -%% Return the members of the group - --spec members(PgName) -> Members when - PgName :: term(), - Members :: [pid()]. - -members(PgName) when is_atom(PgName) -> - global:send(PgName, {self() ,members}), - receive - {_P,{members,Members}} -> - Members - end; -members(Pg) when is_pid(Pg) -> - Pg ! {self,members}, - receive - {_P,{members,Members}} -> - Members - end. - --spec name_to_pid(atom()) -> pid() | 'undefined'. - -name_to_pid(PgName) when is_atom(PgName) -> - global:whereis_name(PgName). - --spec master(term()) -> no_return(). - -master(PgName) -> - process_flag(trap_exit, true), - master_loop(PgName, []). - -master_loop(PgName,Members) -> - receive - {send,From,Message} -> - send_all(Members,{pg_message,From,PgName,Message}), - master_loop(PgName,Members); - {esend,From,Message} -> - send_all(lists:delete(From,Members), - {pg_message,From,PgName,Message}), - master_loop(PgName,Members); - {join,From,Pid} -> - link(Pid), - send_all(Members,{new_member,PgName,Pid}), - From ! {self(),{members,Members}}, - master_loop(PgName,[Pid|Members]); - {From,members} -> - From ! {self(),{members,Members}}, - master_loop(PgName,Members); - {'EXIT',From,_} -> - L = - case lists:member(From,Members) of - true -> - NewMembers = lists:delete(From,Members), - send_all(NewMembers, {crashed_member,PgName,From}), - NewMembers; - false -> - Members - end, - master_loop(PgName,L) - end. - -send_all([], _) -> ok; -send_all([P|Ps], M) -> - P ! M, - send_all(Ps, M). - -%% Check if the process group already exists - -check(PgName) -> - case global:whereis_name(PgName) of - Pid when is_pid(Pid) -> - throw({error,already_created}); - undefined -> - ok - end. diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index bf2a4e7ac5..8792ff44d3 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -30,7 +30,8 @@ hibernate/3, init_ack/1, init_ack/2, init_p/3,init_p/5,format/1,format/2,initial_call/1, - translate_initial_call/1]). + translate_initial_call/1, + stop/1, stop/3]). %% Internal exports. -export([wake_up/3]). @@ -748,3 +749,50 @@ format_tag(Tag, Data) -> modifier(latin1) -> ""; modifier(_) -> "t". + + +%%% ----------------------------------------------------------- +%%% Stop a process and wait for it to terminate +%%% ----------------------------------------------------------- +-spec stop(Process) -> 'ok' when + Process :: pid() | RegName | {RegName,node()}, + RegName :: atom(). +stop(Process) -> + stop(Process, normal, infinity). + +-spec stop(Process, Reason, Timeout) -> 'ok' when + Process :: pid() | RegName | {RegName,node()}, + RegName :: atom(), + Reason :: term(), + Timeout :: timeout(). +stop(Process, Reason, Timeout) -> + {Pid, Mref} = erlang:spawn_monitor(do_stop(Process, Reason)), + receive + {'DOWN', Mref, _, _, Reason} -> + ok; + {'DOWN', Mref, _, _, {noproc,{sys,terminate,_}}} -> + exit(noproc); + {'DOWN', Mref, _, _, CrashReason} -> + exit(CrashReason) + after Timeout -> + exit(Pid, kill), + receive + {'DOWN', Mref, _, _, _} -> + exit(timeout) + end + end. + +-spec do_stop(Process, Reason) -> Fun when + Process :: pid() | RegName | {RegName,node()}, + RegName :: atom(), + Reason :: term(), + Fun :: fun(() -> no_return()). +do_stop(Process, Reason) -> + fun() -> + Mref = erlang:monitor(process, Process), + ok = sys:terminate(Process, Reason, infinity), + receive + {'DOWN', Mref, _, _, ExitReason} -> + exit(ExitReason) + end + end. diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index aa9899da3b..f134c75869 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -77,7 +77,6 @@ orddict, ordsets, otp_internal, - pg, pool, proc_lib, proplists, diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index 7802ea884f..5900fd3ff3 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -18,10 +18,8 @@ {"%VSN%", %% Up from - max one major revision back [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 - {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.0 - {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16 + {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0 %% Down to - max one major revision back [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 - {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.0 - {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 + {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0 }. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index ede2742875..658c00dc77 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -25,7 +25,7 @@ start_child/2, restart_child/2, delete_child/2, terminate_child/2, which_children/1, count_children/1, - check_childspecs/1]). + check_childspecs/1, get_childspec/2]). %% Internal exports -export([init/1, handle_call/3, handle_cast/2, handle_info/2, @@ -34,7 +34,7 @@ %%-------------------------------------------------------------------------- --export_type([child_spec/0, startchild_ret/0, strategy/0]). +-export_type([sup_flags/0, child_spec/0, startchild_ret/0, strategy/0]). %%-------------------------------------------------------------------------- @@ -53,7 +53,13 @@ | {'global', Name :: atom()} | {'via', Module :: module(), Name :: any()} | pid(). --type child_spec() :: {Id :: child_id(), +-type child_spec() :: #{id => child_id(), % mandatory + start => mfargs(), % mandatory + restart => restart(), % optional + shutdown => shutdown(), % optional + type => worker(), % optional + modules => modules()} % optional + | {Id :: child_id(), StartFunc :: mfargs(), Restart :: restart(), Shutdown :: shutdown(), @@ -63,6 +69,23 @@ -type strategy() :: 'one_for_all' | 'one_for_one' | 'rest_for_one' | 'simple_one_for_one'. +-type sup_flags() :: #{strategy => strategy(), % optional + intensity => non_neg_integer(), % optional + period => pos_integer()} % optional + | {RestartStrategy :: strategy(), + Intensity :: non_neg_integer(), + Period :: pos_integer()}. + +%%-------------------------------------------------------------------------- +%% Defaults +-define(default_flags, #{strategy => one_for_one, + intensity => 1, + period => 5}). +-define(default_child_spec, #{restart => permanent, + type => worker}). +%% Default 'shutdown' is 5000 for workers and infinity for supervisors. +%% Default 'modules' is [M], where M comes from the child's start {M,F,A}. + %%-------------------------------------------------------------------------- -record(child, {% pid is undefined when child is not running @@ -96,10 +119,7 @@ -define(is_simple(State), State#state.strategy =:= simple_one_for_one). -callback init(Args :: term()) -> - {ok, {{RestartStrategy :: strategy(), - MaxR :: non_neg_integer(), - MaxT :: non_neg_integer()}, - [ChildSpec :: child_spec()]}} + {ok, {SupFlags :: sup_flags(), [ChildSpec :: child_spec()]}} | ignore. -define(restarting(_Pid_), {restarting,_Pid_}). @@ -178,6 +198,14 @@ delete_child(Supervisor, Name) -> terminate_child(Supervisor, Name) -> call(Supervisor, {terminate_child, Name}). +-spec get_childspec(SupRef, Id) -> Result when + SupRef :: sup_ref(), + Id :: pid() | child_id(), + Result :: {'ok', child_spec()} | {'error', Error}, + Error :: 'not_found'. +get_childspec(Supervisor, Name) -> + call(Supervisor, {get_childspec, Name}). + -spec which_children(SupRef) -> [{Id,Child,Type,Modules}] when SupRef :: sup_ref(), Id :: child_id() | undefined, @@ -431,6 +459,14 @@ handle_call({delete_child, Name}, _From, State) -> {reply, {error, not_found}, State} end; +handle_call({get_childspec, Name}, _From, State) -> + case get_child(Name, State, ?is_simple(State)) of + {value, Child} -> + {reply, {ok, child_to_spec(Child)}, State}; + false -> + {reply, {error, not_found}, State} + end; + handle_call(which_children, _From, #state{children = [#child{restart_type = temporary, child_type = CT, modules = Mods}]} = @@ -610,13 +646,11 @@ terminate(_Reason, State) -> code_change(_, State, _) -> case (State#state.module):init(State#state.args) of {ok, {SupFlags, StartSpec}} -> - case catch check_flags(SupFlags) of - ok -> - {Strategy, MaxIntensity, Period} = SupFlags, - update_childspec(State#state{strategy = Strategy, - intensity = MaxIntensity, - period = Period}, - StartSpec); + case set_flags(SupFlags, State) of + {ok, State1} -> + update_childspec(State1, StartSpec); + {invalid_type, SupFlags} -> + {error, {bad_flags, SupFlags}}; % backwards compatibility Error -> {error, Error} end; @@ -626,14 +660,6 @@ code_change(_, State, _) -> Error end. -check_flags({Strategy, MaxIntensity, Period}) -> - validStrategy(Strategy), - validIntensity(MaxIntensity), - validPeriod(Period), - ok; -check_flags(What) -> - {bad_flags, What}. - update_childspec(State, StartSpec) when ?is_simple(State) -> case check_startspec(StartSpec) of {ok, [Child]} -> @@ -1188,25 +1214,36 @@ remove_child(Child, State) -> %% Returns: {ok, state()} | Error %%----------------------------------------------------------------- init_state(SupName, Type, Mod, Args) -> - case catch init_state1(SupName, Type, Mod, Args) of - {ok, State} -> - {ok, State}; - Error -> - Error + set_flags(Type, #state{name = supname(SupName,Mod), + module = Mod, + args = Args}). + +set_flags(Flags, State) -> + try check_flags(Flags) of + #{strategy := Strategy, intensity := MaxIntensity, period := Period} -> + {ok, State#state{strategy = Strategy, + intensity = MaxIntensity, + period = Period}} + catch + Thrown -> Thrown end. -init_state1(SupName, {Strategy, MaxIntensity, Period}, Mod, Args) -> +check_flags(SupFlags) when is_map(SupFlags) -> + do_check_flags(maps:merge(?default_flags,SupFlags)); +check_flags({Strategy, MaxIntensity, Period}) -> + check_flags(#{strategy => Strategy, + intensity => MaxIntensity, + period => Period}); +check_flags(What) -> + throw({invalid_type, What}). + +do_check_flags(#{strategy := Strategy, + intensity := MaxIntensity, + period := Period} = Flags) -> validStrategy(Strategy), validIntensity(MaxIntensity), validPeriod(Period), - {ok, #state{name = supname(SupName,Mod), - strategy = Strategy, - intensity = MaxIntensity, - period = Period, - module = Mod, - args = Args}}; -init_state1(_SupName, Type, _, _) -> - {invalid_type, Type}. + Flags. validStrategy(simple_one_for_one) -> true; validStrategy(one_for_one) -> true; @@ -1227,14 +1264,7 @@ supname(N, _) -> N. %%% ------------------------------------------------------ %%% Check that the children start specification is valid. -%%% Shall be a six (6) tuple -%%% {Name, Func, RestartType, Shutdown, ChildType, Modules} -%%% where Name is an atom -%%% Func is {Mod, Fun, Args} == {atom(), atom(), list()} -%%% RestartType is permanent | temporary | transient -%%% Shutdown = integer() > 0 | infinity | brutal_kill -%%% ChildType = supervisor | worker -%%% Modules = [atom()] | dynamic +%%% Input: [child_spec()] %%% Returns: {ok, [child_rec()]} | Error %%% ------------------------------------------------------ @@ -1244,6 +1274,9 @@ check_startspec([ChildSpec|T], Res) -> case check_childspec(ChildSpec) of {ok, Child} -> case lists:keymember(Child#child.name, #child.name, Res) of + %% The error message duplicate_child_name is kept for + %% backwards compatibility, although + %% duplicate_child_id would be more correct. true -> {duplicate_child_name, Child#child.name}; false -> check_startspec(T, [Child | Res]) end; @@ -1252,16 +1285,41 @@ check_startspec([ChildSpec|T], Res) -> check_startspec([], Res) -> {ok, lists:reverse(Res)}. +check_childspec(ChildSpec) when is_map(ChildSpec) -> + catch do_check_childspec(maps:merge(?default_child_spec,ChildSpec)); check_childspec({Name, Func, RestartType, Shutdown, ChildType, Mods}) -> - catch check_childspec(Name, Func, RestartType, Shutdown, ChildType, Mods); + check_childspec(#{id => Name, + start => Func, + restart => RestartType, + shutdown => Shutdown, + type => ChildType, + modules => Mods}); check_childspec(X) -> {invalid_child_spec, X}. -check_childspec(Name, Func, RestartType, Shutdown, ChildType, Mods) -> +do_check_childspec(#{restart := RestartType, + type := ChildType} = ChildSpec)-> + Name = case ChildSpec of + #{id := N} -> N; + _ -> throw(missing_id) + end, + Func = case ChildSpec of + #{start := F} -> F; + _ -> throw(missing_start) + end, validName(Name), validFunc(Func), validRestartType(RestartType), validChildType(ChildType), - validShutdown(Shutdown, ChildType), + Shutdown = case ChildSpec of + #{shutdown := S} -> S; + #{type := worker} -> 5000; + #{type := supervisor} -> infinity + end, + validShutdown(Shutdown), + Mods = case ChildSpec of + #{modules := Ms} -> Ms; + _ -> {M,_,_} = Func, [M] + end, validMods(Mods), {ok, #child{name = Name, mfargs = Func, restart_type = RestartType, shutdown = Shutdown, child_type = ChildType, modules = Mods}}. @@ -1282,11 +1340,11 @@ validRestartType(temporary) -> true; validRestartType(transient) -> true; validRestartType(RestartType) -> throw({invalid_restart_type, RestartType}). -validShutdown(Shutdown, _) +validShutdown(Shutdown) when is_integer(Shutdown), Shutdown > 0 -> true; -validShutdown(infinity, _) -> true; -validShutdown(brutal_kill, _) -> true; -validShutdown(Shutdown, _) -> throw({invalid_shutdown, Shutdown}). +validShutdown(infinity) -> true; +validShutdown(brutal_kill) -> true; +validShutdown(Shutdown) -> throw({invalid_shutdown, Shutdown}). validMods(dynamic) -> true; validMods(Mods) when is_list(Mods) -> @@ -1299,6 +1357,19 @@ validMods(Mods) when is_list(Mods) -> Mods); validMods(Mods) -> throw({invalid_modules, Mods}). +child_to_spec(#child{name = Name, + mfargs = Func, + restart_type = RestartType, + shutdown = Shutdown, + child_type = ChildType, + modules = Mods}) -> + #{id => Name, + start => Func, + restart => RestartType, + shutdown => Shutdown, + type => ChildType, + modules => Mods}. + %%% ------------------------------------------------------ %%% Add a new restart and calculate if the max restart %%% intensity has been reached (in that case the supervisor @@ -1367,14 +1438,14 @@ report_error(Error, Reason, Child, SupName) -> extract_child(Child) when is_list(Child#child.pid) -> [{nb_children, length(Child#child.pid)}, - {name, Child#child.name}, + {id, Child#child.name}, {mfargs, Child#child.mfargs}, {restart_type, Child#child.restart_type}, {shutdown, Child#child.shutdown}, {child_type, Child#child.child_type}]; extract_child(Child) -> [{pid, Child#child.pid}, - {name, Child#child.name}, + {id, Child#child.name}, {mfargs, Child#child.mfargs}, {restart_type, Child#child.restart_type}, {shutdown, Child#child.shutdown}, diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index d3ba09ce82..7e4bfa1fdd 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -24,6 +24,7 @@ get_state/1, get_state/2, replace_state/2, replace_state/3, change_code/4, change_code/5, + terminate/2, terminate/3, log/2, log/3, trace/2, trace/3, statistics/2, statistics/3, log_to_file/2, log_to_file/3, no_debug/1, no_debug/2, install/2, install/3, remove/2, remove/3]). @@ -163,6 +164,19 @@ change_code(Name, Mod, Vsn, Extra) -> change_code(Name, Mod, Vsn, Extra, Timeout) -> send_system_msg(Name, {change_code, Mod, Vsn, Extra}, Timeout). +-spec terminate(Name, Reason) -> 'ok' when + Name :: name(), + Reason :: term(). +terminate(Name, Reason) -> + send_system_msg(Name, {terminate, Reason}). + +-spec terminate(Name, Reason, Timeout) -> 'ok' when + Name :: name(), + Reason :: term(), + Timeout :: timeout(). +terminate(Name, Reason, Timeout) -> + send_system_msg(Name, {terminate, Reason}, Timeout). + %%----------------------------------------------------------------- %% Debug commands %%----------------------------------------------------------------- @@ -298,6 +312,8 @@ mfa(Name, {debug, {Func, Arg2}}) -> {sys, Func, [Name, Arg2]}; mfa(Name, {change_code, Mod, Vsn, Extra}) -> {sys, change_code, [Name, Mod, Vsn, Extra]}; +mfa(Name, {terminate, Reason}) -> + {sys, terminate, [Name, Reason]}; mfa(Name, Atom) -> {sys, Atom, [Name]}. @@ -313,7 +329,7 @@ mfa(Name, Req, Timeout) -> %% Returns: This function *never* returns! It calls the function %% Module:system_continue(Parent, NDebug, Misc) %% there the process continues the execution or -%% Module:system_terminate(Raeson, Parent, Debug, Misc) if +%% Module:system_terminate(Reason, Parent, Debug, Misc) if %% the process should terminate. %% The Module must export system_continue/3, system_terminate/4 %% and format_status/2 for status information. @@ -339,7 +355,10 @@ handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc, Hib) -> suspend_loop(suspended, Parent, Mod, NDebug, NMisc, Hib); {running, Reply, NDebug, NMisc} -> _ = gen:reply(From, Reply), - Mod:system_continue(Parent, NDebug, NMisc) + Mod:system_continue(Parent, NDebug, NMisc); + {{terminating, Reason}, Reply, NDebug, NMisc} -> + _ = gen:reply(From, Reply), + Mod:system_terminate(Reason, Parent, NDebug, NMisc) end. %%----------------------------------------------------------------- @@ -419,6 +438,8 @@ do_cmd(SysState, get_status, Parent, Mod, Debug, Misc) -> do_cmd(SysState, {debug, What}, _Parent, _Mod, Debug, Misc) -> {Res, NDebug} = debug_cmd(What, Debug), {SysState, Res, NDebug, Misc}; +do_cmd(_, {terminate, Reason}, _Parent, _Mod, Debug, Misc) -> + {{terminating, Reason}, ok, Debug, Misc}; do_cmd(suspended, {change_code, Module, Vsn, Extra}, _Parent, Mod, Debug, Misc) -> {Res, NMisc} = do_change_code(Mod, Module, Vsn, Extra, Misc), diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl index 32cec0db6f..f828c70b63 100644 --- a/lib/stdlib/test/binary_module_SUITE.erl +++ b/lib/stdlib/test/binary_module_SUITE.erl @@ -506,12 +506,35 @@ do_interesting(Module) -> ?line [<<1,2,3>>,<<6>>] = Module:split(<<1,2,3,4,5,6,7,8>>, [<<4,5>>,<<7>>,<<8>>], [global,trim]), + ?line [<<1,2,3>>,<<6>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<7>>,<<8>>], + [global,trim_all]), ?line [<<1,2,3,4,5,6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, [<<4,5>>,<<7>>,<<8>>], [global,trim,{scope,{0,4}}]), ?line [<<1,2,3>>,<<6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, [<<4,5>>,<<7>>,<<8>>], [global,trim,{scope,{0,5}}]), + + ?line [<<>>,<<>>,<<3>>,<<6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<1>>,<<2>>,<<4,5>>], + [global,trim]), + ?line [<<3>>,<<6,7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<1>>,<<2>>,<<4,5>>], + [global,trim_all]), + + ?line [<<1,2,3>>,<<>>,<<7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<6>>], + [global,trim]), + ?line [<<1,2,3>>,<<7,8>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<4,5>>,<<6>>], + [global,trim_all]), + ?line [<<>>,<<>>,<<3>>,<<>>,<<6>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<1>>,<<2>>,<<4>>,<<5>>,<<7>>,<<8>>], + [global,trim]), + ?line [<<3>>,<<6>>] = Module:split(<<1,2,3,4,5,6,7,8>>, + [<<1>>,<<2>>,<<4>>,<<5>>,<<7>>,<<8>>], + [global,trim_all]), ?line badarg = ?MASK_ERROR( Module:replace(<<1,2,3,4,5,6,7,8>>, [<<4,5>>,<<7>>,<<8>>],<<99>>, @@ -1247,6 +1270,8 @@ do_random_split_comp(N,NeedleRange,HaystackRange) -> true = do_split_comp(Needle,Haystack,[]), true = do_split_comp(Needle,Haystack,[global]), true = do_split_comp(Needle,Haystack,[global,trim]), + true = do_split_comp(Needle,Haystack,[global,trim_all]), + true = do_split_comp(Needle,Haystack,[global,trim,trim_all]), do_random_split_comp(N-1,NeedleRange,HaystackRange). do_random_split_comp2(0,_,_) -> ok; @@ -1257,6 +1282,9 @@ do_random_split_comp2(N,NeedleRange,HaystackRange) -> _ <- lists:duplicate(NumNeedles,a)], true = do_split_comp(Needles,Haystack,[]), true = do_split_comp(Needles,Haystack,[global]), + true = do_split_comp(Needles,Haystack,[global,trim]), + true = do_split_comp(Needles,Haystack,[global,trim_all]), + true = do_split_comp(Needles,Haystack,[global,trim,trim_all]), do_random_split_comp2(N-1,NeedleRange,HaystackRange). do_split_comp(N,H,Opts) -> diff --git a/lib/stdlib/test/binref.erl b/lib/stdlib/test/binref.erl index 6d96736ef3..a52ea98e5a 100644 --- a/lib/stdlib/test/binref.erl +++ b/lib/stdlib/test/binref.erl @@ -155,7 +155,8 @@ split(Haystack,Needles0,Options) -> true -> exit(badtype) end, - {Part,Global,Trim} = get_opts_split(Options,{nomatch,false,false}), + {Part,Global,Trim,TrimAll} = + get_opts_split(Options,{nomatch,false,false,false}), {Start,End,NewStack} = case Part of nomatch -> @@ -180,20 +181,24 @@ split(Haystack,Needles0,Options) -> [X] end end, - do_split(Haystack,MList,0,Trim) + do_split(Haystack,MList,0,Trim,TrimAll) catch _:_ -> erlang:error(badarg) end. -do_split(H,[],N,true) when N >= byte_size(H) -> +do_split(H,[],N,true,_) when N >= byte_size(H) -> []; -do_split(H,[],N,_) -> +do_split(H,[],N,_,true) when N >= byte_size(H) -> + []; +do_split(H,[],N,_,_) -> [part(H,{N,byte_size(H)-N})]; -do_split(H,[{A,B}|T],N,Trim) -> +do_split(H,[{A,B}|T],N,Trim,TrimAll) -> case part(H,{N,A-N}) of + <<>> when TrimAll == true -> + do_split(H,T,A+B,Trim,TrimAll); <<>> -> - Rest = do_split(H,T,A+B,Trim), + Rest = do_split(H,T,A+B,Trim,TrimAll), case {Trim, Rest} of {true,[]} -> []; @@ -201,7 +206,7 @@ do_split(H,[{A,B}|T],N,Trim) -> [<<>> | Rest] end; Oth -> - [Oth | do_split(H,T,A+B,Trim)] + [Oth | do_split(H,T,A+B,Trim,TrimAll)] end. @@ -565,14 +570,16 @@ get_opts_match([{scope,{A,B}} | T],_Part) -> get_opts_match(_,_) -> throw(badopt). -get_opts_split([],{Part,Global,Trim}) -> - {Part,Global,Trim}; -get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim}) -> - get_opts_split(T,{{A,B},Global,Trim}); -get_opts_split([global | T],{Part,_Global,Trim}) -> - get_opts_split(T,{Part,true,Trim}); -get_opts_split([trim | T],{Part,Global,_Trim}) -> - get_opts_split(T,{Part,Global,true}); +get_opts_split([],{Part,Global,Trim,TrimAll}) -> + {Part,Global,Trim,TrimAll}; +get_opts_split([{scope,{A,B}} | T],{_Part,Global,Trim,TrimAll}) -> + get_opts_split(T,{{A,B},Global,Trim,TrimAll}); +get_opts_split([global | T],{Part,_Global,Trim,TrimAll}) -> + get_opts_split(T,{Part,true,Trim,TrimAll}); +get_opts_split([trim | T],{Part,Global,_Trim,TrimAll}) -> + get_opts_split(T,{Part,Global,true,TrimAll}); +get_opts_split([trim_all | T],{Part,Global,Trim,_TrimAll}) -> + get_opts_split(T,{Part,Global,Trim,true}); get_opts_split(_,_) -> throw(badopt). diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index b55324161b..3427f431c5 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1458,6 +1458,30 @@ eep43(Config) when is_list(Config) -> "lists:map(fun (X) -> X#{price := 0} end, [#{hello => 0, price => nil}]).", [#{hello => 0, price => 0}]), + check(fun () -> + Map = #{ <<33:333>> => "wat" }, + #{ <<33:333>> := "wat" } = Map + end, + "begin " + " Map = #{ <<33:333>> => \"wat\" }, " + " #{ <<33:333>> := \"wat\" } = Map " + "end.", + #{ <<33:333>> => "wat" }), + check(fun () -> + K1 = 1, + K2 = <<42:301>>, + K3 = {3,K2}, + Map = #{ K1 => 1, K2 => 2, K3 => 3, {2,2} => 4}, + #{ K1 := 1, K2 := 2, K3 := 3, {2,2} := 4} = Map + end, + "begin " + " K1 = 1, " + " K2 = <<42:301>>, " + " K3 = {3,K2}, " + " Map = #{ K1 => 1, K2 => 2, K3 => 3, {2,2} => 4}, " + " #{ K1 := 1, K2 := 2, K3 := 3, {2,2} := 4} = Map " + "end.", + #{ 1 => 1, <<42:301>> => 2, {3,<<42:301>>} => 3, {2,2} => 4}), error_check("[camembert]#{}.", {badarg,[camembert]}), error_check("#{} = 1.", {badmatch,1}), ok. diff --git a/lib/stdlib/test/erl_internal_SUITE.erl b/lib/stdlib/test/erl_internal_SUITE.erl index b6b3c004ea..197a7a33eb 100644 --- a/lib/stdlib/test/erl_internal_SUITE.erl +++ b/lib/stdlib/test/erl_internal_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -51,7 +51,7 @@ end_per_group(_GroupName, Config) -> -define(default_timeout, ?t:minutes(2)). init_per_testcase(_Case, Config) -> - ?line Dog = test_server:timetrap(?default_timeout), + Dog = test_server:timetrap(?default_timeout), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -63,27 +63,50 @@ behav(suite) -> []; behav(doc) -> ["Check that the behaviour callbacks are correctly defined"]; behav(_) -> - ?line check_behav_list([{start,2}, {stop,1}], - application:behaviour_info(callbacks)), - ?line check_behav_list([{init,1}, {handle_call,3}, {handle_cast,2}, - {handle_info,2}, {terminate,2}, {code_change,3}], - gen_server:behaviour_info(callbacks)), - ?line check_behav_list([{init,1}, {handle_event,3}, {handle_sync_event,4}, - {handle_info,3}, {terminate,3}, {code_change,4}], - gen_fsm:behaviour_info(callbacks)), - ?line check_behav_list([{init,1}, {handle_event,2}, {handle_call,2}, - {handle_info,2}, {terminate,2}, {code_change,3}], - gen_event:behaviour_info(callbacks)), - ?line check_behav_list( [{init,1}, {terminate,2}], - supervisor_bridge:behaviour_info(callbacks)), - ?line check_behav_list([{init,1}], - supervisor:behaviour_info(callbacks)), - ok. + Modules = [application, gen_server, gen_fsm, gen_event, + supervisor_bridge, supervisor], + lists:foreach(fun check_behav/1, Modules). + +check_behav(Module) -> + Callbacks = callbacks(Module), + Optional = optional_callbacks(Module), + check_behav_list(Callbacks, Module:behaviour_info(callbacks)), + check_behav_list(Optional, Module:behaviour_info(optional_callbacks)). check_behav_list([], []) -> ok; check_behav_list([L | L1], L2) -> - ?line true = lists:member(L, L2), - ?line L3 = lists:delete(L, L2), + true = lists:member(L, L2), + L3 = lists:delete(L, L2), check_behav_list(L1, L3). - +callbacks(application) -> + [{start,2}, {stop,1}]; +callbacks(gen_server) -> + [{init,1}, {handle_call,3}, {handle_cast,2}, + {handle_info,2}, {terminate,2}, {code_change,3}, + {format_status,2}]; +callbacks(gen_fsm) -> + [{init,1}, {handle_event,3}, {handle_sync_event,4}, + {handle_info,3}, {terminate,3}, {code_change,4}, + {format_status,2}]; +callbacks(gen_event) -> + [{init,1}, {handle_event,2}, {handle_call,2}, + {handle_info,2}, {terminate,2}, {code_change,3}, + {format_status,2}]; +callbacks(supervisor_bridge) -> + [{init,1}, {terminate,2}]; +callbacks(supervisor) -> + [{init,1}]. + +optional_callbacks(application) -> + []; +optional_callbacks(gen_server) -> + [{format_status,2}]; +optional_callbacks(gen_fsm) -> + [{format_status,2}]; +optional_callbacks(gen_event) -> + [{format_status,2}]; +optional_callbacks(supervisor_bridge) -> + []; +optional_callbacks(supervisor) -> + []. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index ea61b2082b..f8a99f653a 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -42,6 +42,7 @@ unused_vars_warn_rec/1, unused_vars_warn_fun/1, unused_vars_OTP_4858/1, + unused_unsafe_vars_warn/1, export_vars_warn/1, shadow_vars/1, unused_import/1, @@ -55,7 +56,7 @@ otp_11772/1, otp_11771/1, otp_11872/1, export_all/1, bif_clash/1, - behaviour_basic/1, behaviour_multiple/1, + behaviour_basic/1, behaviour_multiple/1, otp_11861/1, otp_7550/1, otp_8051/1, format_warn/1, @@ -63,7 +64,7 @@ too_many_arguments/1, basic_errors/1,bin_syntax_errors/1, predef/1, - maps/1,maps_type/1 + maps/1,maps_type/1,otp_11851/1 ]). % Default timetrap timeout (set in init_per_testcase). @@ -89,16 +90,16 @@ all() -> otp_5362, otp_5371, otp_7227, otp_5494, otp_5644, otp_5878, otp_5917, otp_6585, otp_6885, otp_10436, otp_11254, otp_11772, otp_11771, otp_11872, export_all, - bif_clash, behaviour_basic, behaviour_multiple, + bif_clash, behaviour_basic, behaviour_multiple, otp_11861, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments, basic_errors, bin_syntax_errors, predef, - maps, maps_type]. + maps, maps_type, otp_11851]. groups() -> [{unused_vars_warn, [], [unused_vars_warn_basic, unused_vars_warn_lc, unused_vars_warn_rec, unused_vars_warn_fun, - unused_vars_OTP_4858]}, + unused_vars_OTP_4858, unused_unsafe_vars_warn]}, {on_load, [], [on_load_successful, on_load_failing]}]. init_per_suite(Config) -> @@ -730,6 +731,48 @@ unused_vars_OTP_4858(Config) when is_list(Config) -> ?line [] = run(Config, Ts), ok. +unused_unsafe_vars_warn(Config) when is_list(Config) -> + Ts = [{unused_unsafe1, + <<"t1() -> + UnusedVar1 = unused1, + try + UnusedVar2 = unused2 + catch + _:_ -> + ok + end, + ok. + ">>, + [warn_unused_vars], + {warnings,[{2,erl_lint,{unused_var,'UnusedVar1'}}, + {4,erl_lint,{unused_var,'UnusedVar2'}}]}}, + {unused_unsafe2, + <<"t2() -> + try + X = 1 + catch + _:_ -> ok + end. + ">>, + [warn_unused_vars], + {warnings,[{3,erl_lint,{unused_var,'X'}}]}}, + {unused_unsafe2, + <<"t3(X, Y) -> + X andalso Y. + ">>, + [warn_unused_vars], + []}, + {unused_unsafe4, + <<"t4() -> + _ = (catch X = X = 1), + _ = case ok of _ -> fun() -> ok end end, + fun (X) -> X end. + ">>, + [warn_unused_vars], + []}], + run(Config, Ts), + ok. + export_vars_warn(doc) -> "Warnings for exported variables"; export_vars_warn(suite) -> []; @@ -808,7 +851,19 @@ export_vars_warn(Config) when is_list(Config) -> [], {error,[{9,erl_lint,{unbound_var,'B'}}], [{9,erl_lint,{exported_var,'Y',{'receive',2}}}, - {10,erl_lint,{shadowed_var,'B',generate}}]}} + {10,erl_lint,{shadowed_var,'B',generate}}]}}, + + {exp4, + <<"t(X) -> + if true -> Z = X end, + case X of + 1 -> Z; + 2 -> X + end, + Z = X. + ">>, + [], + {warnings,[{7,erl_lint,{exported_var,'Z',{'if',2}}}]}} ], ?line [] = run(Config, Ts), ok. @@ -832,8 +887,15 @@ shadow_vars(Config) when is_list(Config) -> ">>, [nowarn_shadow_vars], {error,[{9,erl_lint,{unbound_var,'B'}}], - [{9,erl_lint,{exported_var,'Y',{'receive',2}}}]}}], - + [{9,erl_lint,{exported_var,'Y',{'receive',2}}}]}}, + {shadow2, + <<"t() -> + _ = (catch MS = MS = 1), % MS used unsafe + _ = case ok of _ -> fun() -> ok end end, + fun (MS) -> MS end. % MS not shadowed here + ">>, + [], + []}], ?line [] = run(Config, Ts), ok. @@ -958,6 +1020,45 @@ unsafe_vars(Config) when is_list(Config) -> [warn_unused_vars], {errors,[{3,erl_lint,{unsafe_var,'X',{'if',2}}}, {4,erl_lint,{unsafe_var,'X',{'if',2}}}], + []}}, + {unsafe8, + <<"t8(X) -> + case X of _ -> catch _Y = 1 end, + _Y." + >>, + [], + {errors,[{3,erl_lint,{unsafe_var,'_Y',{'catch',2}}}], + []}}, + {unsafe9, + <<"t9(X) -> + case X of + 1 -> + catch A = 1, % unsafe only here + B = 1, + C = 1, + D = 1; + 2 -> + A = 2, + % B not bound here + C = 2, + catch D = 2; % unsafe in two clauses + 3 -> + A = 3, + B = 3, + C = 3, + catch D = 3; % unsafe in two clauses + 4 -> + A = 4, + B = 4, + C = 4, + D = 4 + end, + {A,B,C,D}." + >>, + [], + {errors,[{24,erl_lint,{unsafe_var,'A',{'catch',4}}}, + {24,erl_lint,{unsafe_var,'B',{'case',2}}}, + {24,erl_lint,{unsafe_var,'D',{'case',2}}}], []}} ], ?line [] = run(Config, Ts), @@ -2648,8 +2749,9 @@ otp_11872(Config) when is_list(Config) -> t() -> 1. ">>, - {error,[{6,erl_lint,{undefined_type,{product,0}}}], - [{8,erl_lint,{new_var_arity_type,map}}]} = + {error,[{6,erl_lint,{undefined_type,{product,0}}}, + {8,erl_lint,{undefined_type,{dict,0}}}], + [{8,erl_lint,{new_builtin_type,{map,0}}}]} = run_test2(Config, Ts, []), ok. @@ -3080,6 +3182,193 @@ behaviour_multiple(Config) when is_list(Config) -> ?line [] = run(Config, Ts), ok. +otp_11861(doc) -> + "OTP-11861. behaviour_info() and -callback."; +otp_11861(suite) -> []; +otp_11861(Conf) when is_list(Conf) -> + CallbackFiles = [callback1, callback2, callback3, + bad_behaviour1, bad_behaviour2], + lists:foreach(fun(M) -> + F = filename:join(?datadir, M), + Opts = [{outdir,?privdir}, return], + {ok, M, []} = compile:file(F, Opts) + end, CallbackFiles), + CodePath = code:get_path(), + true = code:add_path(?privdir), + Ts = [{otp_11861_1, + <<" + -export([b1/1]). + -behaviour(callback1). + -behaviour(callback2). + + -spec b1(atom()) -> integer(). + b1(A) when is_atom(A)-> + 3. + ">>, + [], + %% b2/1 is optional in both modules + {warnings,[{4,erl_lint, + {conflicting_behaviours,{b1,1},callback2,3,callback1}}]}}, + {otp_11861_2, + <<" + -export([b2/1]). + -behaviour(callback1). + -behaviour(callback2). + + -spec b2(integer()) -> atom(). + b2(I) when is_integer(I)-> + a. + ">>, + [], + %% b2/1 is optional in callback2, but not in callback1 + {warnings,[{3,erl_lint,{undefined_behaviour_func,{b1,1},callback1}}, + {4,erl_lint, + {conflicting_behaviours,{b2,1},callback2,3,callback1}}]}}, + {otp_11861_3, + <<" + -callback b(_) -> atom(). + -optional_callbacks({b1,1}). % non-existing and ignored + ">>, + [], + []}, + {otp_11861_4, + <<" + -callback b(_) -> atom(). + -optional_callbacks([{b1,1}]). % non-existing + ">>, + [], + %% No behaviour-info(), but callback. + {errors,[{3,erl_lint,{undefined_callback,{lint_test,b1,1}}}],[]}}, + {otp_11861_5, + <<" + -optional_callbacks([{b1,1}]). % non-existing + ">>, + [], + %% No behaviour-info() and no callback: warning anyway + {errors,[{2,erl_lint,{undefined_callback,{lint_test,b1,1}}}],[]}}, + {otp_11861_6, + <<" + -optional_callbacks([b1/1]). % non-existing + behaviour_info(callbacks) -> [{b1,1}]. + ">>, + [], + %% behaviour-info() and no callback: warning anyway + {errors,[{2,erl_lint,{undefined_callback,{lint_test,b1,1}}}],[]}}, + {otp_11861_7, + <<" + -optional_callbacks([b1/1]). % non-existing + -callback b(_) -> atom(). + behaviour_info(callbacks) -> [{b1,1}]. + ">>, + [], + %% behaviour-info() callback: warning + {errors,[{2,erl_lint,{undefined_callback,{lint_test,b1,1}}}, + {3,erl_lint,{behaviour_info,{lint_test,b,1}}}], + []}}, + {otp_11861_8, + <<" + -callback b(_) -> atom(). + -optional_callbacks([b/1, {b, 1}]). + ">>, + [], + {errors,[{3,erl_lint,{redefine_optional_callback,{b,1}}}],[]}}, + {otp_11861_9, + <<" + -behaviour(gen_server). + -export([handle_call/3,handle_cast/2,handle_info/2, + code_change/3, init/1, terminate/2]). + handle_call(_, _, _) -> ok. + handle_cast(_, _) -> ok. + handle_info(_, _) -> ok. + code_change(_, _, _) -> ok. + init(_) -> ok. + terminate(_, _) -> ok. + ">>, + [], + []}, + {otp_11861_9, + <<" + -behaviour(gen_server). + -export([handle_call/3,handle_cast/2,handle_info/2, + code_change/3, init/1, terminate/2, format_status/2]). + handle_call(_, _, _) -> ok. + handle_cast(_, _) -> ok. + handle_info(_, _) -> ok. + code_change(_, _, _) -> ok. + init(_) -> ok. + terminate(_, _) -> ok. + format_status(_, _) -> ok. % optional callback + ">>, + [], + %% Nothing... + []}, + {otp_11861_10, + <<" + -optional_callbacks([{b1,1,bad}]). % badly formed and ignored + behaviour_info(callbacks) -> [{b1,1}]. + ">>, + [], + []}, + {otp_11861_11, + <<" + -behaviour(bad_behaviour1). + ">>, + [], + {warnings,[{2,erl_lint, + {ill_defined_behaviour_callbacks,bad_behaviour1}}]}}, + {otp_11861_12, + <<" + -behaviour(non_existing_behaviour). + ">>, + [], + {warnings,[{2,erl_lint, + {undefined_behaviour,non_existing_behaviour}}]}}, + {otp_11861_13, + <<" + -behaviour(bad_behaviour_none). + ">>, + [], + {warnings,[{2,erl_lint,{undefined_behaviour,bad_behaviour_none}}]}}, + {otp_11861_14, + <<" + -callback b(_) -> atom(). + ">>, + [], + []}, + {otp_11861_15, + <<" + -optional_callbacks([{b1,1,bad}]). % badly formed + -callback b(_) -> atom(). + ">>, + [], + []}, + {otp_11861_16, + <<" + -callback b(_) -> atom(). + -callback b(_) -> atom(). + ">>, + [], + {errors,[{3,erl_lint,{redefine_callback,{b,1}}}],[]}}, + {otp_11861_17, + <<" + -behaviour(bad_behaviour2). + ">>, + [], + {warnings,[{2,erl_lint,{undefined_behaviour_callbacks, + bad_behaviour2}}]}}, + {otp_11861_18, + <<" + -export([f1/1]). + -behaviour(callback3). + f1(_) -> ok. + ">>, + [], + []} + ], + ?line [] = run(Conf, Ts), + true = code:set_path(CodePath), + ok. + otp_7550(doc) -> "Test that the new utf8/utf16/utf32 types do not allow size or unit specifiers."; otp_7550(Config) when is_list(Config) -> @@ -3145,8 +3434,8 @@ format_warn(Config) when is_list(Config) -> ok. format_level(Level, Count, Config) -> - ?line W = get_compilation_warnings(Config, "format", - [{warn_format, Level}]), + ?line W = get_compilation_result(Config, "format", + [{warn_format, Level}]), %% Pick out the 'format' warnings. ?line FW = lists:filter(fun({_Line, erl_lint, {format_error, _}}) -> true; (_) -> false @@ -3330,42 +3619,22 @@ bin_syntax_errors(Config) -> ok. predef(doc) -> - "OTP-10342: Predefined types: array(), digraph(), and so on"; + "OTP-10342: No longer predefined types: array(), digraph(), and so on"; predef(suite) -> []; predef(Config) when is_list(Config) -> - W = get_compilation_warnings(Config, "predef", []), + W = get_compilation_result(Config, "predef", []), [] = W, - W2 = get_compilation_warnings(Config, "predef2", []), - Tag = deprecated_builtin_type, - [{7,erl_lint,{Tag,{array,0},{array,array,1},"OTP 18.0"}}, - {12,erl_lint,{Tag,{dict,0},{dict,dict,2},"OTP 18.0"}}, - {17,erl_lint,{Tag,{digraph,0},{digraph,graph},"OTP 18.0"}}, - {27,erl_lint,{Tag,{gb_set,0},{gb_sets,set,1},"OTP 18.0"}}, - {32,erl_lint,{Tag,{gb_tree,0},{gb_trees,tree,2},"OTP 18.0"}}, - {37,erl_lint,{Tag,{queue,0},{queue,queue,1},"OTP 18.0"}}, - {42,erl_lint,{Tag,{set,0},{sets,set,1},"OTP 18.0"}}, - {47,erl_lint,{Tag,{tid,0},{ets,tid},"OTP 18.0"}}] = W2, - Ts = [{otp_10342_1, - <<"-compile(nowarn_deprecated_type). - - -spec t(dict()) -> non_neg_integer(). - - t(D) -> - erlang:phash2(D, 3000). - ">>, - {[nowarn_unused_function]}, - []}, - {otp_10342_2, - <<"-spec t(dict()) -> non_neg_integer(). - - t(D) -> - erlang:phash2(D, 3000). - ">>, - {[nowarn_unused_function]}, - {warnings,[{1,erl_lint, - {deprecated_builtin_type,{dict,0},{dict,dict,2}, - "OTP 18.0"}}]}}], - [] = run(Config, Ts), + %% dict(), digraph() and so on were removed in Erlang/OTP 18.0. + E2 = get_compilation_result(Config, "predef2", []), + Tag = undefined_type, + {[{7,erl_lint,{Tag,{array,0}}}, + {12,erl_lint,{Tag,{dict,0}}}, + {17,erl_lint,{Tag,{digraph,0}}}, + {27,erl_lint,{Tag,{gb_set,0}}}, + {32,erl_lint,{Tag,{gb_tree,0}}}, + {37,erl_lint,{Tag,{queue,0}}}, + {42,erl_lint,{Tag,{set,0}}}, + {47,erl_lint,{Tag,{tid,0}}}],[]} = E2, ok. maps(Config) -> @@ -3398,7 +3667,8 @@ maps(Config) -> g := 1 + 1, h := _, i := (_X = _Y), - j := (x ! y) }) -> + j := (x ! y), + <<0:300>> := 33}) -> {A,F}. ">>, [], @@ -3411,9 +3681,10 @@ maps(Config) -> {errors,[{1,erl_lint,illegal_map_construction}, {1,erl_lint,{unbound_var,'X'}}], []}}, - {errors_in_map_keys, + {legal_map_construction, <<"t(V) -> #{ a => 1, #{a=>V} => 2, + #{{a,V}=>V} => 2, #{ \"hi\" => wazzup, hi => ho } => yep, [try a catch _:_ -> b end] => nope, ok => 1.0, @@ -3425,11 +3696,7 @@ maps(Config) -> }. ">>, [], - {errors,[{2,erl_lint,{illegal_map_key_variable,'V'}}, - {4,erl_lint,illegal_map_key}, - {6,erl_lint,illegal_map_key}, - {8,erl_lint,illegal_map_key}, - {10,erl_lint,illegal_map_key}],[]}}, + []}, {errors_in_map_keys_pattern, <<"t(#{ a := 2, #{} := A, @@ -3440,8 +3707,8 @@ maps(Config) -> A. ">>, [], - {errors,[{4,erl_lint,illegal_map_key}, - {6,erl_lint,{illegal_map_key_variable,'V'}}],[]}}], + {errors,[{4,erl_lint,illegal_map_construction}, + {6,erl_lint,illegal_map_key}],[]}}], [] = run(Config, Ts), ok. @@ -3470,7 +3737,94 @@ maps_type(Config) when is_list(Config) -> t(M) -> M. ">>, [], - {warnings,[{3,erl_lint,{new_var_arity_type,map}}]}}], + {warnings,[{3,erl_lint,{new_builtin_type,{map,0}}}]}}], + [] = run(Config, Ts), + ok. + +otp_11851(doc) -> + "OTP-11851: More atoms can be used as type names + bug fixes."; +otp_11851(Config) when is_list(Config) -> + Ts = [ + {otp_11851_1, + <<"-export([t/0]). + -type range(A, B) :: A | B. + + -type union(A) :: A. + + -type product() :: integer(). + + -type tuple(A) :: A. + + -type map(A) :: A. + + -type record() :: a | b. + + -type integer(A) :: A. + + -type atom(A) :: A. + + -type binary(A, B) :: A | B. + + -type 'fun'() :: integer(). + + -type 'fun'(X) :: X. + + -type 'fun'(X, Y) :: X | Y. + + -type all() :: range(atom(), integer()) | union(pid()) | product() + | tuple(reference()) | map(function()) | record() + | integer(atom()) | atom(integer()) + | binary(pid(), tuple()) | 'fun'(port()) + | 'fun'() | 'fun'(<<>>, 'none'). + + -spec t() -> all(). + + t() -> + a. + ">>, + [], + []}, + {otp_11851_2, + <<"-export([a/1, b/1, t/0]). + + -callback b(_) -> integer(). + + -callback ?MODULE:a(_) -> integer(). + + a(_) -> 3. + + b(_) -> a. + + t()-> a. + ">>, + [], + {errors,[{5,erl_lint,{bad_callback,{lint_test,a,1}}}],[]}}, + {otp_11851_3, + <<"-export([a/1]). + + -spec a(_A) -> boolean() when + _ :: atom(), + _A :: integer(). + + a(_) -> true. + ">>, + [], + {errors,[{4,erl_parse,"bad type variable"}],[]}}, + {otp_11851_4, + <<" + -spec a(_) -> ok. + -spec a(_) -> ok. + + -spec ?MODULE:a(_) -> ok. + -spec ?MODULE:a(_) -> ok. + ">>, + [], + {errors,[{3,erl_lint,{redefine_spec,{a,1}}}, + {5,erl_lint,{redefine_spec,{lint_test,a,1}}}, + {6,erl_lint,{redefine_spec,{lint_test,a,1}}}, + {6,erl_lint,{spec_fun_undefined,{a,1}}}], + []}} + ], [] = run(Config, Ts), ok. @@ -3487,9 +3841,9 @@ run(Config, Tests) -> end, lists:foldl(F, [], Tests). -%% Compiles a test file and returns the list of warnings. +%% Compiles a test file and returns the list of warnings/errors. -get_compilation_warnings(Conf, Filename, Warnings) -> +get_compilation_result(Conf, Filename, Warnings) -> ?line DataDir = ?datadir, ?line File = filename:join(DataDir, Filename), {ok,Bin} = file:read_file(File++".erl"), @@ -3498,6 +3852,7 @@ get_compilation_warnings(Conf, Filename, Warnings) -> Test = lists:nthtail(Start+Length, FileS), case run_test(Conf, Test, Warnings) of {warnings, Ws} -> Ws; + {errors,Es,Ws} -> {Es,Ws}; [] -> [] end. diff --git a/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl new file mode 100644 index 0000000000..230f4b4519 --- /dev/null +++ b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl @@ -0,0 +1,6 @@ +-module(bad_behaviour1). + +-export([behaviour_info/1]). + +behaviour_info(callbacks) -> + [{a,1,bad}]. diff --git a/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour2.erl b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour2.erl new file mode 100644 index 0000000000..bb755ce18b --- /dev/null +++ b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour2.erl @@ -0,0 +1,6 @@ +-module(bad_behaviour2). + +-export([behaviour_info/1]). + +behaviour_info(callbacks) -> + undefined. diff --git a/lib/stdlib/test/erl_lint_SUITE_data/callback1.erl b/lib/stdlib/test/erl_lint_SUITE_data/callback1.erl new file mode 100644 index 0000000000..3cc5b51879 --- /dev/null +++ b/lib/stdlib/test/erl_lint_SUITE_data/callback1.erl @@ -0,0 +1,6 @@ +-module(callback1). + +-callback b1(I :: integer()) -> atom(). +-callback b2(A :: atom()) -> integer(). + +-optional_callbacks([{b2,1}]). diff --git a/lib/stdlib/test/erl_lint_SUITE_data/callback2.erl b/lib/stdlib/test/erl_lint_SUITE_data/callback2.erl new file mode 100644 index 0000000000..211cf9f115 --- /dev/null +++ b/lib/stdlib/test/erl_lint_SUITE_data/callback2.erl @@ -0,0 +1,6 @@ +-module(callback2). + +-callback b1(I :: integer()) -> atom(). +-callback b2(A :: atom()) -> integer(). + +-optional_callbacks([b1/1, b2/1]). diff --git a/lib/stdlib/test/erl_lint_SUITE_data/callback3.erl b/lib/stdlib/test/erl_lint_SUITE_data/callback3.erl new file mode 100644 index 0000000000..97b3ecb860 --- /dev/null +++ b/lib/stdlib/test/erl_lint_SUITE_data/callback3.erl @@ -0,0 +1,8 @@ +-module(callback3). + +-export([behaviour_info/1]). + +behaviour_info(callbacks) -> + [{f1, 1}]; +behaviour_info(_) -> + undefined. diff --git a/lib/stdlib/test/erl_lint_SUITE_data/predef.erl b/lib/stdlib/test/erl_lint_SUITE_data/predef.erl index ee9073aa67..3cb7bf40f1 100644 --- a/lib/stdlib/test/erl_lint_SUITE_data/predef.erl +++ b/lib/stdlib/test/erl_lint_SUITE_data/predef.erl @@ -5,8 +5,8 @@ -export_type([array/0, digraph/0, gb_set/0]). -%% Before Erlang/OTP 17.0 local re-definitions of pre-defined opaque -%% types were ignored but did not generate any warning. +%% Since Erlang/OTP 18.0 array() and so on are no longer pre-defined, +%% so there is nothing special about them at all. -opaque array() :: atom(). -opaque digraph() :: atom(). -opaque gb_set() :: atom(). diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 927fe0b595..f71446dd64 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -42,7 +42,6 @@ -export([ func/1, call/1, recs/1, try_catch/1, if_then/1, receive_after/1, bits/1, head_tail/1, cond1/1, block/1, case1/1, ops/1, messages/1, - old_mnemosyne_syntax/1, import_export/1, misc_attrs/1, dialyzer_attrs/1, hook/1, neg_indent/1, @@ -50,7 +49,7 @@ otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1, - otp_10302/1, otp_10820/1, otp_11100/1]). + otp_10302/1, otp_10820/1, otp_11100/1, otp_11861/1]). %% Internal export. -export([ehook/6]). @@ -77,13 +76,13 @@ groups() -> [{expr, [], [func, call, recs, try_catch, if_then, receive_after, bits, head_tail, cond1, block, case1, ops, - messages, old_mnemosyne_syntax, maps_syntax + messages, maps_syntax ]}, {attributes, [], [misc_attrs, import_export, dialyzer_attrs]}, {tickets, [], [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, otp_8473, otp_8522, otp_8567, otp_8664, otp_9147, - otp_10302, otp_10820, otp_11100]}]. + otp_10302, otp_10820, otp_11100, otp_11861]}]. init_per_suite(Config) -> Config. @@ -561,27 +560,6 @@ messages(Config) when is_list(Config) -> ?line true = "\n" =:= lists:flatten(erl_pp:form({eof,0})), ok. -old_mnemosyne_syntax(Config) when is_list(Config) -> - %% Since we have kept the ':-' token, - %% better test that we can pretty print it. - R = {rule,12,sales,2, - [{clause,12, - [{var,12,'E'},{atom,12,employee}], - [], - [{generate,13, - {var,13,'E'}, - {call,13,{atom,13,table},[{atom,13,employee}]}}, - {match,14, - {record_field,14,{var,14,'E'},{atom,14,salary}}, - {atom,14,sales}}]}]}, - ?line "sales(E, employee) :-\n" - " E <- table(employee),\n" - " E.salary = sales.\n" = - lists:flatten(erl_pp:form(R)), - ok. - - - import_export(suite) -> []; import_export(Config) when is_list(Config) -> @@ -664,26 +642,6 @@ do_hook(HookFun) -> AFormChars = erl_pp:form(A, H), ?line true = AChars =:= lists:flatten(AFormChars), - R = {rule,0,sales,0, - [{clause,0,[{var,0,'E'},{atom,0,employee}],[], - [{generate,2,{var,2,'E'}, - {call,2,{atom,2,table},[{atom,2,employee}]}}, - {match,3, - {record_field,3,{var,3,'E'},{atom,3,salary}}, - {foo,Expr}}]}]}, - RChars = lists:flatten(erl_pp:rule(R, H)), - R2 = {rule,0,sales,0, - [{clause,0,[{var,0,'E'},{atom,0,employee}],[], - [{generate,2,{var,2,'E'}, - {call,2,{atom,2,table},[{atom,2,employee}]}}, - {match,3, - {record_field,3,{var,3,'E'},{atom,3,salary}}, - {call,0,{atom,0,foo},[Expr2]}}]}]}, - RChars2 = erl_pp:rule(R2), - ?line true = RChars =:= lists:flatten(RChars2), - ARChars = erl_pp:form(R, H), - ?line true = RChars =:= lists:flatten(ARChars), - ?line "INVALID-FORM:{foo,bar}:" = lists:flatten(erl_pp:expr({foo,bar})), %% A list (as before R6), not a list of lists. @@ -874,6 +832,7 @@ type_examples() -> {ex3,<<"-type paren() :: (ann2()). ">>}, {ex4,<<"-type t1() :: atom(). ">>}, {ex5,<<"-type t2() :: [t1()]. ">>}, + {ex56,<<"-type integer(A) :: A. ">>}, {ex6,<<"-type t3(Atom) :: integer(Atom). ">>}, {ex7,<<"-type '\\'t::4'() :: t3('\\'foobar'). ">>}, {ex8,<<"-type t5() :: {t1(), t3(foo)}. ">>}, @@ -1204,8 +1163,18 @@ otp_11100(Config) when is_list(Config) -> []}}), ok. +otp_11861(doc) -> + "OTP-11861. behaviour_info() and -callback."; +otp_11861(suite) -> []; +otp_11861(Config) when is_list(Config) -> + "-optional_callbacks([bar/0]).\n" = + pf({attribute,3,optional_callbacks,[{bar,0}]}), + "-optional_callbacks([{bar,1,bad}]).\n" = + pf({attribute,4,optional_callbacks,[{bar,1,bad}]}), + ok. + pf(Form) -> - lists:flatten(erl_pp:form(Form,none)). + lists:flatten(erl_pp:form(Form, none)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 9be9f641c8..6ef947f0e3 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -226,7 +226,7 @@ atoms() -> punctuations() -> L = ["<<", "<-", "<=", "<", ">>", ">=", ">", "->", "--", "-", "++", "+", "=:=", "=/=", "=<", "=>", "==", "=", "/=", - "/", "||", "|", ":=", ":-", "::", ":"], + "/", "||", "|", ":=", "::", ":"], %% One token at a time: [begin W = list_to_atom(S), diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index bd313390b3..146d810189 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -77,7 +77,8 @@ wildcard_one(Config) when is_list(Config) -> L = filelib:wildcard(Wc), L = filelib:wildcard(Wc, erl_prim_loader), L = filelib:wildcard(Wc, "."), - L = filelib:wildcard(Wc, Dir) + L = filelib:wildcard(Wc, Dir), + L = filelib:wildcard(Wc, Dir++"/.") end), ?line file:set_cwd(OldCwd), ?line ok = file:del_dir(Dir), diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index ecd9cff9f9..6f1d1a891d 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -287,38 +287,66 @@ extension(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% join(Config) when is_list(Config) -> + %% Whenever joining two elements, test the equivalence between + %% join/1 and join/2 (OTP-12158) by using help function + %% filename_join/2. ?line "/" = filename:join(["/"]), ?line "/" = filename:join(["//"]), - ?line "usr/foo.erl" = filename:join("usr","foo.erl"), - ?line "/src/foo.erl" = filename:join(usr, "/src/foo.erl"), - ?line "/src/foo.erl" = filename:join(["/src/",'foo.erl']), - ?line "/src/foo.erl" = filename:join(usr, ["/sr", 'c/foo.erl']), - ?line "/src/foo.erl" = filename:join("usr", "/src/foo.erl"), + "usr/foo.erl" = filename_join("usr","foo.erl"), + "/src/foo.erl" = filename_join(usr, "/src/foo.erl"), + "/src/foo.erl" = filename_join("/src/",'foo.erl'), + "/src/foo.erl" = filename_join(usr, ["/sr", 'c/foo.erl']), + "/src/foo.erl" = filename_join("usr", "/src/foo.erl"), %% Make sure that redundant slashes work too. ?line "a/b/c/d/e/f/g" = filename:join(["a//b/c/////d//e/f/g"]), - ?line "a/b/c/d/e/f/g" = filename:join(["a//b/c/", "d//e/f/g"]), - ?line "a/b/c/d/e/f/g" = filename:join(["a//b/c", "d//e/f/g"]), - ?line "/d/e/f/g" = filename:join(["a//b/c", "/d//e/f/g"]), - ?line "/d/e/f/g" = filename:join(["a//b/c", "//d//e/f/g"]), - - ?line "foo/bar" = filename:join([$f,$o,$o,$/,[]], "bar"), + "a/b/c/d/e/f/g" = filename_join("a//b/c/", "d//e/f/g"), + "a/b/c/d/e/f/g" = filename_join("a//b/c", "d//e/f/g"), + "/d/e/f/g" = filename_join("a//b/c", "/d//e/f/g"), + "/d/e/f/g" = filename:join("a//b/c", "//d//e/f/g"), + + "foo/bar" = filename_join([$f,$o,$o,$/,[]], "bar"), + + %% Single dots - should be removed if in the middle of the path, + %% but not at the end of the path. + "/." = filename:join(["/."]), + "/" = filename:join(["/./"]), + "/." = filename:join(["/./."]), + "./." = filename:join(["./."]), + + "/a/b" = filename_join("/a/.","b"), + "/a/b/." = filename_join("/a/.","b/."), + "/a/." = filename_join("/a/.","."), + "/a/." = filename_join("/a","."), + "/a/." = filename_join("/a/.",""), + "./." = filename_join("./.","."), + "./." = filename_join("./","."), + "./." = filename_join("./.",""), + "." = filename_join(".",""), + "./." = filename_join(".","."), + + %% Trailing slash shall be removed - except the root + "/" = filename:join(["/"]), + "/" = filename:join(["/./"]), + "/a" = filename:join(["/a/"]), + "/b" = filename_join("/a/","/b/"), + "/a/b" = filename_join("/a/","b/"), ?line case os:type() of {win32, _} -> ?line "d:/" = filename:join(["D:/"]), ?line "d:/" = filename:join(["D:\\"]), - ?line "d:/abc" = filename:join(["D:/", "abc"]), - ?line "d:abc" = filename:join(["D:", "abc"]), + "d:/abc" = filename_join("D:/", "abc"), + "d:abc" = filename_join("D:", "abc"), ?line "a/b/c/d/e/f/g" = filename:join(["a//b\\c//\\/\\d/\\e/f\\g"]), ?line "a:usr/foo.erl" = filename:join(["A:","usr","foo.erl"]), ?line "/usr/foo.erl" = filename:join(["A:","/usr","foo.erl"]), - ?line "c:usr" = filename:join("A:","C:usr"), - ?line "a:usr" = filename:join("A:","usr"), - ?line "c:/usr" = filename:join("A:", "C:/usr"), + "c:usr" = filename_join("A:","C:usr"), + "a:usr" = filename_join("A:","usr"), + "c:/usr" = filename_join("A:", "C:/usr"), ?line "c:/usr/foo.erl" = filename:join(["A:","C:/usr","foo.erl"]), ?line "c:usr/foo.erl" = @@ -329,6 +357,11 @@ join(Config) when is_list(Config) -> ok end. +%% Make sure join([A,B]) is equivalent to join(A,B) (OTP-12158) +filename_join(A,B) -> + Res = filename:join(A,B), + Res = filename:join([A,B]). + pathtype(Config) when is_list(Config) -> ?line relative = filename:pathtype(".."), ?line relative = filename:pathtype("foo"), @@ -633,6 +666,53 @@ join_bin(Config) when is_list(Config) -> ?line <<"foo/bar">> = filename:join([$f,$o,$o,$/,[]], <<"bar">>), + %% Single dots - should be removed if in the middle of the path, + %% but not at the end of the path. + %% Also test equivalence between join/1 and join/2 (OTP-12158) + <<"/.">> = filename:join([<<"/.">>]), + <<"/">> = filename:join([<<"/./">>]), + <<"/.">> = filename:join([<<"/./.">>]), + <<"./.">> = filename:join([<<"./.">>]), + + <<"/a/b">> = filename:join([<<"/a/.">>,<<"b">>]), + <<"/a/b">> = filename:join(<<"/a/.">>,<<"b">>), + + <<"/a/b/.">> = filename:join([<<"/a/.">>,<<"b/.">>]), + <<"/a/b/.">> = filename:join(<<"/a/.">>,<<"b/.">>), + + <<"/a/.">> = filename:join([<<"/a/.">>,<<".">>]), + <<"/a/.">> = filename:join(<<"/a/.">>,<<".">>), + + <<"/a/.">> = filename:join([<<"/a">>,<<".">>]), + <<"/a/.">> = filename:join(<<"/a">>,<<".">>), + + <<"/a/.">> = filename:join([<<"/a/.">>,<<"">>]), + <<"/a/.">> = filename:join(<<"/a/.">>,<<"">>), + + <<"./.">> = filename:join([<<"./.">>,<<".">>]), + <<"./.">> = filename:join(<<"./.">>,<<".">>), + + <<"./.">> = filename:join([<<"./">>,<<".">>]), + <<"./.">> = filename:join(<<"./">>,<<".">>), + + <<"./.">> = filename:join([<<"./.">>,<<"">>]), + <<"./.">> = filename:join(<<"./.">>,<<"">>), + + <<".">> = filename:join([<<".">>,<<"">>]), + <<".">> = filename:join(<<".">>,<<"">>), + + <<"./.">> = filename:join([<<".">>,<<".">>]), + <<"./.">> = filename:join(<<".">>,<<".">>), + + %% Trailing slash shall be removed - except the root + <<"/">> = filename:join([<<"/">>]), + <<"/">> = filename:join([<<"/./">>]), + <<"/a">> = filename:join([<<"/a/">>]), + <<"/b">> = filename:join([<<"/a/">>,<<"/b/">>]), + <<"/b">> = filename:join(<<"/a/">>,<<"/b/">>), + <<"/a/b">> = filename:join([<<"/a/">>,<<"b/">>]), + <<"/a/b">> = filename:join(<<"/a/">>,<<"b/">>), + ?line case os:type() of {win32, _} -> ?line <<"d:/">> = filename:join([<<"D:/">>]), diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 60a1ba8c60..576a5adfce 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -106,7 +106,7 @@ start(Config) when is_list(Config) -> ?line {error, {already_started, _}} = gen_event:start({global, my_dummy_name}), - exit(Pid6, shutdown), + ok = gen_event:stop({global, my_dummy_name}, shutdown, 10000), receive {'EXIT', Pid6, shutdown} -> ok after 10000 -> diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index 39f0442824..dabc10aec4 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -27,6 +27,9 @@ -export([start1/1, start2/1, start3/1, start4/1, start5/1, start6/1, start7/1, start8/1, start9/1, start10/1, start11/1, start12/1]). +-export([stop1/1, stop2/1, stop3/1, stop4/1, stop5/1, stop6/1, stop7/1, + stop8/1, stop9/1, stop10/1]). + -export([ abnormal1/1, abnormal2/1]). -export([shutdown/1]). @@ -66,6 +69,8 @@ groups() -> [{start, [], [start1, start2, start3, start4, start5, start6, start7, start8, start9, start10, start11, start12]}, + {stop, [], + [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]}, {abnormal, [], [abnormal1, abnormal2]}, {sys, [], [sys1, call_format_status, error_format_status, terminate_crash_format, @@ -281,6 +286,105 @@ start12(Config) when is_list(Config) -> ok. +%% Anonymous, reason 'normal' +stop1(_Config) -> + {ok, Pid} = gen_fsm:start(?MODULE, [], []), + ok = gen_fsm:stop(Pid), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_fsm:stop(Pid)), + ok. + +%% Anonymous, other reason +stop2(_Config) -> + {ok,Pid} = gen_fsm:start(?MODULE, [], []), + ok = gen_fsm:stop(Pid, other_reason, infinity), + false = erlang:is_process_alive(Pid), + ok. + +%% Anonymous, invalid timeout +stop3(_Config) -> + {ok,Pid} = gen_fsm:start(?MODULE, [], []), + {'EXIT',_} = (catch gen_fsm:stop(Pid, other_reason, invalid_timeout)), + true = erlang:is_process_alive(Pid), + ok = gen_fsm:stop(Pid), + false = erlang:is_process_alive(Pid), + ok. + +%% Registered name +stop4(_Config) -> + {ok,Pid} = gen_fsm:start({local,to_stop},?MODULE, [], []), + ok = gen_fsm:stop(to_stop), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_fsm:stop(to_stop)), + ok. + +%% Registered name and local node +stop5(_Config) -> + {ok,Pid} = gen_fsm:start({local,to_stop},?MODULE, [], []), + ok = gen_fsm:stop({to_stop,node()}), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_fsm:stop({to_stop,node()})), + ok. + +%% Globally registered name +stop6(_Config) -> + {ok, Pid} = gen_fsm:start({global, to_stop}, ?MODULE, [], []), + ok = gen_fsm:stop({global,to_stop}), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})), + ok. + +%% 'via' registered name +stop7(_Config) -> + dummy_via:reset(), + {ok, Pid} = gen_fsm:start({via, dummy_via, to_stop}, + ?MODULE, [], []), + ok = gen_fsm:stop({via, dummy_via, to_stop}), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_fsm:stop({via, dummy_via, to_stop})), + ok. + +%% Anonymous on remote node +stop8(_Config) -> + {ok,Node} = test_server:start_node(gen_fsm_SUITE_stop8,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + {ok, Pid} = rpc:call(Node,gen_fsm,start,[?MODULE,[],[]]), + ok = gen_fsm:stop(Pid), + false = rpc:call(Node,erlang,is_process_alive,[Pid]), + {'EXIT',noproc} = (catch gen_fsm:stop(Pid)), + true = test_server:stop_node(Node), + {'EXIT',{{nodedown,Node},_}} = (catch gen_fsm:stop(Pid)), + ok. + +%% Registered name on remote node +stop9(_Config) -> + {ok,Node} = test_server:start_node(gen_fsm_SUITE_stop9,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + {ok, Pid} = rpc:call(Node,gen_fsm,start,[{local,to_stop},?MODULE,[],[]]), + ok = gen_fsm:stop({to_stop,Node}), + undefined = rpc:call(Node,erlang,whereis,[to_stop]), + false = rpc:call(Node,erlang,is_process_alive,[Pid]), + {'EXIT',noproc} = (catch gen_fsm:stop({to_stop,Node})), + true = test_server:stop_node(Node), + {'EXIT',{{nodedown,Node},_}} = (catch gen_fsm:stop({to_stop,Node})), + ok. + +%% Globally registered name on remote node +stop10(_Config) -> + {ok,Node} = test_server:start_node(gen_fsm_SUITE_stop10,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + {ok, Pid} = rpc:call(Node,gen_fsm,start,[{global,to_stop},?MODULE,[],[]]), + global:sync(), + ok = gen_fsm:stop({global,to_stop}), + false = rpc:call(Node,erlang,is_process_alive,[Pid]), + {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})), + true = test_server:stop_node(Node), + {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})), + ok. + %% Check that time outs in calls work abnormal1(suite) -> []; abnormal1(Config) when is_list(Config) -> diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 0f03fda30a..30dabf63c5 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -36,6 +36,9 @@ get_state/1, replace_state/1, call_with_huge_message_queue/1 ]). +-export([stop1/1, stop2/1, stop3/1, stop4/1, stop5/1, stop6/1, stop7/1, + stop8/1, stop9/1, stop10/1]). + % spawn export -export([spec_init_local/2, spec_init_global/2, spec_init_via/2, spec_init_default_timeout/2, spec_init_global_default_timeout/2, @@ -51,7 +54,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [start, crash, call, cast, cast_fast, info, abcast, + [start, {group,stop}, crash, call, cast, cast_fast, info, abcast, multicall, multicall_down, call_remote1, call_remote2, call_remote3, call_remote_n1, call_remote_n2, call_remote_n3, spec_init, @@ -63,7 +66,8 @@ all() -> call_with_huge_message_queue]. groups() -> - []. + [{stop, [], + [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]}]. init_per_suite(Config) -> Config. @@ -237,6 +241,105 @@ start(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +%% Anonymous, reason 'normal' +stop1(_Config) -> + {ok, Pid} = gen_server:start(?MODULE, [], []), + ok = gen_server:stop(Pid), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_server:stop(Pid)), + ok. + +%% Anonymous, other reason +stop2(_Config) -> + {ok,Pid} = gen_server:start(?MODULE, [], []), + ok = gen_server:stop(Pid, other_reason, infinity), + false = erlang:is_process_alive(Pid), + ok. + +%% Anonymous, invalid timeout +stop3(_Config) -> + {ok,Pid} = gen_server:start(?MODULE, [], []), + {'EXIT',_} = (catch gen_server:stop(Pid, other_reason, invalid_timeout)), + true = erlang:is_process_alive(Pid), + ok = gen_server:stop(Pid), + false = erlang:is_process_alive(Pid), + ok. + +%% Registered name +stop4(_Config) -> + {ok,Pid} = gen_server:start({local,to_stop},?MODULE, [], []), + ok = gen_server:stop(to_stop), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_server:stop(to_stop)), + ok. + +%% Registered name and local node +stop5(_Config) -> + {ok,Pid} = gen_server:start({local,to_stop},?MODULE, [], []), + ok = gen_server:stop({to_stop,node()}), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_server:stop({to_stop,node()})), + ok. + +%% Globally registered name +stop6(_Config) -> + {ok, Pid} = gen_server:start({global, to_stop}, ?MODULE, [], []), + ok = gen_server:stop({global,to_stop}), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})), + ok. + +%% 'via' registered name +stop7(_Config) -> + dummy_via:reset(), + {ok, Pid} = gen_server:start({via, dummy_via, to_stop}, + ?MODULE, [], []), + ok = gen_server:stop({via, dummy_via, to_stop}), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_server:stop({via, dummy_via, to_stop})), + ok. + +%% Anonymous on remote node +stop8(_Config) -> + {ok,Node} = test_server:start_node(gen_server_SUITE_stop8,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + {ok, Pid} = rpc:call(Node,gen_server,start,[?MODULE,[],[]]), + ok = gen_server:stop(Pid), + false = rpc:call(Node,erlang,is_process_alive,[Pid]), + {'EXIT',noproc} = (catch gen_server:stop(Pid)), + true = test_server:stop_node(Node), + {'EXIT',{{nodedown,Node},_}} = (catch gen_server:stop(Pid)), + ok. + +%% Registered name on remote node +stop9(_Config) -> + {ok,Node} = test_server:start_node(gen_server_SUITE_stop9,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + {ok, Pid} = rpc:call(Node,gen_server,start,[{local,to_stop},?MODULE,[],[]]), + ok = gen_server:stop({to_stop,Node}), + undefined = rpc:call(Node,erlang,whereis,[to_stop]), + false = rpc:call(Node,erlang,is_process_alive,[Pid]), + {'EXIT',noproc} = (catch gen_server:stop({to_stop,Node})), + true = test_server:stop_node(Node), + {'EXIT',{{nodedown,Node},_}} = (catch gen_server:stop({to_stop,Node})), + ok. + +%% Globally registered name on remote node +stop10(_Config) -> + {ok,Node} = test_server:start_node(gen_server_SUITE_stop10,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + {ok, Pid} = rpc:call(Node,gen_server,start,[{global,to_stop},?MODULE,[],[]]), + global:sync(), + ok = gen_server:stop({global,to_stop}), + false = rpc:call(Node,erlang,is_process_alive,[Pid]), + {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})), + true = test_server:stop_node(Node), + {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})), + ok. + crash(Config) when is_list(Config) -> ?line error_logger_forwarder:register(), diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl index 8dca69bac4..b6f1973a05 100644 --- a/lib/stdlib/test/proc_lib_SUITE.erl +++ b/lib/stdlib/test/proc_lib_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -27,7 +27,7 @@ init_per_group/2,end_per_group/2, crash/1, sync_start_nolink/1, sync_start_link/1, spawn_opt/1, sp1/0, sp2/0, sp3/1, sp4/2, sp5/1, - hibernate/1]). + hibernate/1, stop/1]). -export([ otp_6345/1, init_dont_hang/1]). -export([hib_loop/1, awaken/1]). @@ -38,6 +38,7 @@ -export([otp_6345_init/1, init_dont_hang_init/1]). +-export([system_terminate/4]). -ifdef(STANDALONE). -define(line, noop, ). @@ -49,7 +50,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [crash, {group, sync_start}, spawn_opt, hibernate, - {group, tickets}]. + {group, tickets}, stop]. groups() -> [{tickets, [], [otp_6345, init_dont_hang]}, @@ -361,10 +362,94 @@ init_dont_hang(Config) when is_list(Config) -> exit(Error) end. -init_dont_hang_init(Parent) -> +init_dont_hang_init(_Parent) -> 1 = 2. +%% Test proc_lib:stop/1,3 +stop(_Config) -> + Parent = self(), + SysMsgProc = + fun() -> + receive + {system,From,Request} -> + sys:handle_system_msg(Request,From,Parent,?MODULE,[],[]) + end + end, + + %% Normal case: + %% Process handles system message and terminated with given reason + Pid1 = proc_lib:spawn(SysMsgProc), + ok = proc_lib:stop(Pid1), + false = erlang:is_process_alive(Pid1), + + %% Process does not exit + {'EXIT',noproc} = (catch proc_lib:stop(Pid1)), + + %% Badly handled system message + DieProc = + fun() -> + receive + {system,_From,_Request} -> + exit(die) + end + end, + Pid2 = proc_lib:spawn(DieProc), + {'EXIT',{die,_}} = (catch proc_lib:stop(Pid2)), + + %% Hanging process => timeout + HangProc = + fun() -> + receive + {system,_From,_Request} -> + timer:sleep(5000) + end + end, + Pid3 = proc_lib:spawn(HangProc), + {'EXIT',timeout} = (catch proc_lib:stop(Pid3,normal,1000)), + + %% Success case with other reason than 'normal' + Pid4 = proc_lib:spawn(SysMsgProc), + ok = proc_lib:stop(Pid4,other_reason,infinity), + false = erlang:is_process_alive(Pid4), + + %% System message is handled, but process dies with other reason + %% than the given (in system_terminate/4 below) + Pid5 = proc_lib:spawn(SysMsgProc), + {'EXIT',{badmatch,2}} = (catch proc_lib:stop(Pid5,crash,infinity)), + false = erlang:is_process_alive(Pid5), + + %% Local registered name + Pid6 = proc_lib:spawn(SysMsgProc), + register(to_stop,Pid6), + ok = proc_lib:stop(to_stop), + undefined = whereis(to_stop), + false = erlang:is_process_alive(Pid6), + + %% Remote registered name + {ok,Node} = test_server:start_node(proc_lib_SUITE_stop,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + Pid7 = spawn(Node,SysMsgProc), + true = rpc:call(Node,erlang,register,[to_stop,Pid7]), + Pid7 = rpc:call(Node,erlang,whereis,[to_stop]), + ok = proc_lib:stop({to_stop,Node}), + undefined = rpc:call(Node,erlang,whereis,[to_stop]), + false = rpc:call(Node,erlang,is_process_alive,[Pid7]), + + %% Local and remote registered name, but non-existing + {'EXIT',noproc} = (catch proc_lib:stop(to_stop)), + {'EXIT',noproc} = (catch proc_lib:stop({to_stop,Node})), + + true = test_server:stop_node(Node), + + %% Remote registered name, but non-existing node + {'EXIT',{{nodedown,Node},_}} = (catch proc_lib:stop({to_stop,Node})), + ok. +system_terminate(crash,_Parent,_Deb,_State) -> + 1 = 2; +system_terminate(Reason,_Parent,_Deb,_State) -> + exit(Reason). %%----------------------------------------------------------------- %% The error_logger handler used. diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 37fbb5267b..4173a40d14 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -7891,7 +7891,7 @@ run_test(Config, Extra, {cres, Body, Opts, ExpectedCompileReturn}) -> {module, _} = code:load_abs(AbsFile, Mod), Ms0 = erlang:process_info(self(),messages), - Before = {get(), pps(), ets:all(), Ms0}, + Before = {{get(), ets:all(), Ms0}, pps()}, %% Prepare the check that the qlc module does not call qlc_pt. _ = [unload_pt() || {file, Name} <- [code:is_loaded(qlc_pt)], @@ -7921,12 +7921,29 @@ run_test(Config, Extra, {cres, Body, Opts, ExpectedCompileReturn}) -> run_test(Config, Extra, Body) -> run_test(Config, Extra, {cres,Body,[]}). -wait_for_expected(R, Before, SourceFile, Wait) -> +wait_for_expected(R, {Strict0,PPS0}=Before, SourceFile, Wait) -> Ms = erlang:process_info(self(),messages), - After = {get(), pps(), ets:all(), Ms}, + After = {_,PPS1} = {{get(), ets:all(), Ms}, pps()}, case {R, After} of {ok, Before} -> ok; + {ok, {Strict0,_}} -> + {Ports0,Procs0} = PPS0, + {Ports1,Procs1} = PPS1, + case {Ports1 -- Ports0, Procs1 -- Procs0} of + {[], []} -> ok; + _ when Wait -> + timer:sleep(1000), + wait_for_expected(R, Before, SourceFile, false); + {PortsDiff,ProcsDiff} -> + io:format("failure, got ~p~n, expected ~p\n", + [PPS1, PPS0]), + show("Old port", Ports0 -- Ports1), + show("New port", PortsDiff), + show("Old proc", Procs0 -- Procs1), + show("New proc", ProcsDiff), + fail(SourceFile) + end; _ when Wait -> timer:sleep(1000), wait_for_expected(R, Before, SourceFile, false); @@ -7993,7 +8010,7 @@ compile_file(Config, Test0, Opts0) -> case compile:file(File, Opts) of {ok, _M, Ws} -> warnings(File, Ws); {error, [{File,Es}], []} -> {errors, Es, []}; - {error, [{File,Es}], [{File,Ws}]} -> {error, Es, Ws} + {error, [{File,Es}], [{File,Ws}]} -> {errors, Es, Ws} end. comp_compare(T, T) -> @@ -8058,6 +8075,17 @@ filename(Name, Config) when is_atom(Name) -> filename(Name, Config) -> filename:join(?privdir, Name). +show(_S, []) -> + ok; +show(S, [{Pid, Name, InitCall}|Pids]) when is_pid(Pid) -> + io:format("~s: ~w (~w), ~w: ~p~n", + [S, Pid, proc_reg_name(Name), InitCall, + erlang:process_info(Pid)]), + show(S, Pids); +show(S, [{Port, _}|Ports]) when is_port(Port)-> + io:format("~s: ~w: ~p~n", [S, Port, erlang:port_info(Port)]), + show(S, Ports). + pps() -> {port_list(), process_list()}. @@ -8070,6 +8098,9 @@ process_list() -> safe_second_element(process_info(P, initial_call))} || P <- processes(), is_process_alive(P)]. +proc_reg_name({registered_name, Name}) -> Name; +proc_reg_name([]) -> no_reg_name. + safe_second_element({_,Info}) -> Info; safe_second_element(Other) -> Other. diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl index 3d09bd27ff..6669a21b9c 100644 --- a/lib/stdlib/test/stdlib_SUITE.erl +++ b/lib/stdlib/test/stdlib_SUITE.erl @@ -22,14 +22,7 @@ -module(stdlib_SUITE). -include_lib("test_server/include/test_server.hrl"). - -% Test server specific exports --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). --export([init_per_testcase/2, end_per_testcase/2]). - -% Test cases must be exported. --export([app_test/1, appup_test/1]). +-compile(export_all). %% %% all/1 @@ -37,10 +30,10 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app_test, appup_test]. + [app_test, appup_test, {group,upgrade}]. groups() -> - []. + [{upgrade,[minor_upgrade,major_upgrade]}]. init_per_suite(Config) -> Config. @@ -48,9 +41,13 @@ init_per_suite(Config) -> end_per_suite(_Config) -> ok. +init_per_group(upgrade, Config) -> + ct_release_test:init(Config); init_per_group(_GroupName, Config) -> Config. +end_per_group(upgrade, Config) -> + ct_release_test:cleanup(Config); end_per_group(_GroupName, Config) -> Config. @@ -165,3 +162,19 @@ check_appup([Vsn|Vsns],Instrs,Expected) -> end; check_appup([],_,_) -> ok. + + +minor_upgrade(Config) -> + ct_release_test:upgrade(stdlib,minor,{?MODULE,[]},Config). + +major_upgrade(Config) -> + ct_release_test:upgrade(stdlib,major,{?MODULE,[]},Config). + +%% Version numbers are checked by ct_release_test, so there is nothing +%% more to check here... +upgrade_init(State) -> + State. +upgrade_upgraded(State) -> + State. +upgrade_downgraded(State) -> + State. diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index 836ea7c030..c98654aef7 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -37,9 +37,11 @@ sup_start_ignore_child/1, sup_start_ignore_temporary_child/1, sup_start_ignore_temporary_child_start_child/1, sup_start_ignore_temporary_child_start_child_simple/1, - sup_start_error_return/1, sup_start_fail/1, sup_stop_infinity/1, - sup_stop_timeout/1, sup_stop_brutal_kill/1, child_adm/1, - child_adm_simple/1, child_specs/1, extra_return/1]). + sup_start_error_return/1, sup_start_fail/1, + sup_start_map/1, sup_start_map_faulty_specs/1, + sup_stop_infinity/1, sup_stop_timeout/1, sup_stop_brutal_kill/1, + child_adm/1, child_adm_simple/1, child_specs/1, extra_return/1, + sup_flags/1]). %% Tests concept permanent, transient and temporary -export([ permanent_normal/1, transient_normal/1, @@ -65,7 +67,8 @@ do_not_save_child_specs_for_temporary_children/1, simple_one_for_one_scale_many_temporary_children/1, simple_global_supervisor/1, hanging_restart_loop/1, - hanging_restart_loop_simple/1]). + hanging_restart_loop_simple/1, code_change/1, code_change_map/1, + code_change_simple/1, code_change_simple_map/1]). %%------------------------------------------------------------------------- @@ -73,8 +76,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [{group, sup_start}, {group, sup_stop}, child_adm, - child_adm_simple, extra_return, child_specs, + [{group, sup_start}, {group, sup_start_map}, {group, sup_stop}, child_adm, + child_adm_simple, extra_return, child_specs, sup_flags, {group, restart_one_for_one}, {group, restart_one_for_all}, {group, restart_simple_one_for_one}, @@ -85,7 +88,8 @@ all() -> count_children, do_not_save_start_parameters_for_temporary_children, do_not_save_child_specs_for_temporary_children, simple_one_for_one_scale_many_temporary_children, temporary_bystander, - simple_global_supervisor, hanging_restart_loop, hanging_restart_loop_simple]. + simple_global_supervisor, hanging_restart_loop, hanging_restart_loop_simple, + code_change, code_change_map, code_change_simple, code_change_simple_map]. groups() -> [{sup_start, [], @@ -94,6 +98,8 @@ groups() -> sup_start_ignore_temporary_child_start_child, sup_start_ignore_temporary_child_start_child_simple, sup_start_error_return, sup_start_fail]}, + {sup_start_map, [], + [sup_start_map, sup_start_map_faulty_specs]}, {sup_stop, [], [sup_stop_infinity, sup_stop_timeout, sup_stop_brutal_kill]}, @@ -256,6 +262,60 @@ sup_start_fail(Config) when is_list(Config) -> check_exit_reason(Term). %%------------------------------------------------------------------------- +%% Tests that the supervisor process starts correctly with map +%% startspec, and that the full childspec can be read. +sup_start_map(Config) when is_list(Config) -> + process_flag(trap_exit, true), + Child1 = #{id=>child1, start=>{supervisor_1, start_child, []}}, + Child2 = #{id=>child2, + start=>{supervisor_1, start_child, []}, + shutdown=>brutal_kill}, + Child3 = #{id=>child3, + start=>{supervisor_1, start_child, []}, + type=>supervisor}, + {ok, Pid} = start_link({ok, {#{}, [Child1,Child2,Child3]}}), + + %% Check default values + {ok,#{id:=child1, + start:={supervisor_1,start_child,[]}, + restart:=permanent, + shutdown:=5000, + type:=worker, + modules:=[supervisor_1]}} = supervisor:get_childspec(Pid, child1), + {ok,#{id:=child2, + start:={supervisor_1,start_child,[]}, + restart:=permanent, + shutdown:=brutal_kill, + type:=worker, + modules:=[supervisor_1]}} = supervisor:get_childspec(Pid, child2), + {ok,#{id:=child3, + start:={supervisor_1,start_child,[]}, + restart:=permanent, + shutdown:=infinity, + type:=supervisor, + modules:=[supervisor_1]}} = supervisor:get_childspec(Pid, child3), + {error,not_found} = supervisor:get_childspec(Pid, child4), + terminate(Pid, shutdown). + +%%------------------------------------------------------------------------- +%% Tests that the supervisor produces good error messages when start- +%% and child specs are faulty. +sup_start_map_faulty_specs(Config) when is_list(Config) -> + process_flag(trap_exit, true), + Child1 = #{start=>{supervisor_1, start_child, []}}, + Child2 = #{id=>child2}, + Child3 = #{id=>child3, + start=>{supervisor_1, start_child, []}, + silly_flag=>true}, + Child4 = child4, + {error,{start_spec,missing_id}} = start_link({ok, {#{}, [Child1]}}), + {error,{start_spec,missing_start}} = start_link({ok, {#{}, [Child2]}}), + {ok,Pid} = start_link({ok, {#{}, [Child3]}}), + terminate(Pid,shutdown), + {error,{start_spec,{invalid_child_spec,child4}}} = + start_link({ok, {#{}, [Child4]}}). + +%%------------------------------------------------------------------------- %% See sup_stop/1 when Shutdown = infinity, this walue is allowed for %% children of type supervisor _AND_ worker. sup_stop_infinity(Config) when is_list(Config) -> @@ -479,7 +539,7 @@ child_adm_simple(Config) when is_list(Config) -> %% Tests child specs, invalid formats should be rejected. child_specs(Config) when is_list(Config) -> process_flag(trap_exit, true), - {ok, _Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), + {ok, Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), {error, _} = supervisor:start_child(sup_test, hej), %% Bad child specs @@ -509,6 +569,7 @@ child_specs(Config) when is_list(Config) -> {error, {invalid_modules,dy}} = supervisor:start_child(sup_test, B5), + {error, {badarg, _}} = supervisor:check_childspecs(B1), % should be list {error, {invalid_mfa,mfa}} = supervisor:check_childspecs([B1]), {error, {invalid_restart_type,prmanent}} = supervisor:check_childspecs([B2]), @@ -524,6 +585,54 @@ child_specs(Config) when is_list(Config) -> ok = supervisor:check_childspecs([C3]), ok = supervisor:check_childspecs([C4]), ok = supervisor:check_childspecs([C5]), + + {error,{duplicate_child_name,child}} = supervisor:check_childspecs([C1,C2]), + + terminate(Pid, shutdown), + + %% Faulty child specs in supervisor start + {error, {start_spec, {invalid_mfa, mfa}}} = + start_link({ok, {{one_for_one, 2, 3600}, [B1]}}), + {error, {start_spec, {invalid_restart_type, prmanent}}} = + start_link({ok, {{simple_one_for_one, 2, 3600}, [B2]}}), + + %% simple_one_for_one needs exactly one child + {error,{bad_start_spec,[]}} = + start_link({ok, {{simple_one_for_one, 2, 3600}, []}}), + {error,{bad_start_spec,[C1,C2]}} = + start_link({ok, {{simple_one_for_one, 2, 3600}, [C1,C2]}}), + + ok. + +%%------------------------------------------------------------------------- +%% Test error handling of supervisor flags +sup_flags(_Config) -> + process_flag(trap_exit,true), + {error,{supervisor_data,{invalid_strategy,_}}} = + start_link({ok, {{none_for_one, 2, 3600}, []}}), + {error,{supervisor_data,{invalid_strategy,_}}} = + start_link({ok, {#{strategy=>none_for_one}, []}}), + {error,{supervisor_data,{invalid_intensity,_}}} = + start_link({ok, {{one_for_one, infinity, 3600}, []}}), + {error,{supervisor_data,{invalid_intensity,_}}} = + start_link({ok, {#{intensity=>infinity}, []}}), + {error,{supervisor_data,{invalid_period,_}}} = + start_link({ok, {{one_for_one, 2, 0}, []}}), + {error,{supervisor_data,{invalid_period,_}}} = + start_link({ok, {#{period=>0}, []}}), + {error,{supervisor_data,{invalid_period,_}}} = + start_link({ok, {{one_for_one, 2, infinity}, []}}), + {error,{supervisor_data,{invalid_period,_}}} = + start_link({ok, {#{period=>infinity}, []}}), + + %% SupFlags other than a map or a 3-tuple + {error,{supervisor_data,{invalid_type,_}}} = + start_link({ok, {{one_for_one, 2}, []}}), + + %% Unexpected flags are ignored + {ok,Pid} = start_link({ok,{#{silly_flag=>true},[]}}), + terminate(Pid,shutdown), + ok. %%------------------------------------------------------------------------- @@ -1647,6 +1756,186 @@ hanging_restart_loop_simple(Config) when is_list(Config) -> ok. %%------------------------------------------------------------------------- +%% Test the code_change function +code_change(_Config) -> + process_flag(trap_exit, true), + + SupFlags = {one_for_one, 0, 1}, + {ok, Pid} = start_link({ok, {SupFlags, []}}), + [] = supervisor:which_children(Pid), + + %% Change supervisor flags + S1 = sys:get_state(Pid), + ok = fake_upgrade(Pid,{ok, {{one_for_one, 1, 3}, []}}), + S2 = sys:get_state(Pid), + true = (S1 /= S2), + + %% Faulty childspec + FaultyChild = {child1, permanent, brutal_kill, worker, []}, % missing start + {error,{error,{invalid_child_spec,FaultyChild}}} = + fake_upgrade(Pid,{ok,{SupFlags,[FaultyChild]}}), + + %% Add child1 and child2 + Child1 = {child1, {supervisor_1, start_child, []}, + permanent, 2000, worker, []}, + Child2 = {child2, {supervisor_1, start_child, []}, + permanent, brutal_kill, worker, []}, + ok = fake_upgrade(Pid,{ok,{SupFlags,[Child1,Child2]}}), + %% Children are not automatically started + {ok,_} = supervisor:restart_child(Pid,child1), + {ok,_} = supervisor:restart_child(Pid,child2), + [{child2,_,_,_},{child1,_,_,_}] = supervisor:which_children(Pid), + + %% Change child1, remove child2 and add child3 + Child11 = {child1, {supervisor_1, start_child, []}, + permanent, 1000, worker, []}, + Child3 = {child3, {supervisor_1, start_child, []}, + permanent, brutal_kill, worker, []}, + ok = fake_upgrade(Pid,{ok, {SupFlags, [Child11,Child3]}}), + %% Children are not deleted on upgrade, so it is ok that child2 is + %% still here + [{child2,_,_,_},{child3,_,_,_},{child1,_,_,_}] = + supervisor:which_children(Pid), + + %% Ignore during upgrade + ok = fake_upgrade(Pid,ignore), + + %% Error during upgrade + {error, faulty_return} = fake_upgrade(Pid,faulty_return), + + %% Faulty flags + {error,{error, {invalid_intensity,faulty_intensity}}} = + fake_upgrade(Pid,{ok, {{one_for_one,faulty_intensity,1}, []}}), + {error,{error,{bad_flags, faulty_flags}}} = + fake_upgrade(Pid,{ok, {faulty_flags, []}}), + + terminate(Pid,shutdown). + +code_change_map(_Config) -> + process_flag(trap_exit, true), + + {ok, Pid} = start_link({ok, {#{}, []}}), + [] = supervisor:which_children(Pid), + + %% Change supervisor flags + S1 = sys:get_state(Pid), + ok = fake_upgrade(Pid,{ok, {#{intensity=>1, period=>3}, []}}), + S2 = sys:get_state(Pid), + true = (S1 /= S2), + + %% Faulty childspec + FaultyChild = #{id=>faulty_child}, + {error,{error,missing_start}} = + fake_upgrade(Pid,{ok,{#{},[FaultyChild]}}), + + %% Add child1 and child2 + Child1 = #{id=>child1, + start=>{supervisor_1, start_child, []}, + shutdown=>2000}, + Child2 = #{id=>child2, + start=>{supervisor_1, start_child, []}}, + ok = fake_upgrade(Pid,{ok,{#{},[Child1,Child2]}}), + %% Children are not automatically started + {ok,_} = supervisor:restart_child(Pid,child1), + {ok,_} = supervisor:restart_child(Pid,child2), + [{child2,_,_,_},{child1,_,_,_}] = supervisor:which_children(Pid), + {ok,#{shutdown:=2000}} = supervisor:get_childspec(Pid,child1), + + %% Change child1, remove child2 and add child3 + Child11 = #{id=>child1, + start=>{supervisor_1, start_child, []}, + shutdown=>1000}, + Child3 = #{id=>child3, + start=>{supervisor_1, start_child, []}}, + ok = fake_upgrade(Pid,{ok, {#{}, [Child11,Child3]}}), + %% Children are not deleted on upgrade, so it is ok that child2 is + %% still here + [{child2,_,_,_},{child3,_,_,_},{child1,_,_,_}] = + supervisor:which_children(Pid), + {ok,#{shutdown:=1000}} = supervisor:get_childspec(Pid,child1), + + %% Ignore during upgrade + ok = fake_upgrade(Pid,ignore), + + %% Error during upgrade + {error, faulty_return} = fake_upgrade(Pid,faulty_return), + + %% Faulty flags + {error,{error, {invalid_intensity,faulty_intensity}}} = + fake_upgrade(Pid,{ok, {#{intensity=>faulty_intensity}, []}}), + + terminate(Pid,shutdown). + +code_change_simple(_Config) -> + process_flag(trap_exit, true), + + SimpleChild1 = {child1,{supervisor_1, start_child, []}, permanent, + brutal_kill, worker, []}, + SimpleFlags = {simple_one_for_one, 0, 1}, + {ok, SimplePid} = start_link({ok, {SimpleFlags,[SimpleChild1]}}), + %% Change childspec + SimpleChild11 = {child1,{supervisor_1, start_child, []}, permanent, + 1000, worker, []}, + ok = fake_upgrade(SimplePid,{ok,{SimpleFlags,[SimpleChild11]}}), + + %% Attempt to add child + SimpleChild2 = {child2,{supervisor_1, start_child, []}, permanent, + brutal_kill, worker, []}, + + {error, {error, {ok,[_,_]}}} = + fake_upgrade(SimplePid,{ok,{SimpleFlags,[SimpleChild1,SimpleChild2]}}), + + %% Attempt to remove child + {error, {error, {ok,[]}}} = fake_upgrade(SimplePid,{ok,{SimpleFlags,[]}}), + + terminate(SimplePid,shutdown), + ok. + +code_change_simple_map(_Config) -> + process_flag(trap_exit, true), + + SimpleChild1 = #{id=>child1, + start=>{supervisor_1, start_child, []}}, + SimpleFlags = #{strategy=>simple_one_for_one}, + {ok, SimplePid} = start_link({ok, {SimpleFlags,[SimpleChild1]}}), + %% Change childspec + SimpleChild11 = #{id=>child1, + start=>{supervisor_1, start_child, []}, + shutdown=>1000}, + ok = fake_upgrade(SimplePid,{ok,{SimpleFlags,[SimpleChild11]}}), + + %% Attempt to add child + SimpleChild2 = #{id=>child2, + start=>{supervisor_1, start_child, []}}, + {error, {error, {ok, [_,_]}}} = + fake_upgrade(SimplePid,{ok,{SimpleFlags,[SimpleChild1,SimpleChild2]}}), + + %% Attempt to remove child + {error, {error, {ok, []}}} = + fake_upgrade(SimplePid,{ok,{SimpleFlags,[]}}), + + terminate(SimplePid,shutdown), + ok. + +fake_upgrade(Pid,NewInitReturn) -> + ok = sys:suspend(Pid), + + %% Update state to fake code change + %% The #state record in supervisor.erl holds the arguments given + %% to the callback init function. By replacing these arguments the + %% init function will return something new and by that fake a code + %% change (see init function above in this module). + Fun = fun(State) -> + Size = size(State), % 'args' is the last field in #state. + setelement(Size,State,NewInitReturn) + end, + sys:replace_state(Pid,Fun), + + R = sys:change_code(Pid,gen_server,dummy_vsn,[]), + ok = sys:resume(Pid), + R. + +%%------------------------------------------------------------------------- terminate(Pid, Reason) when Reason =/= supervisor -> terminate(dummy, Pid, dummy, Reason). diff --git a/lib/stdlib/test/sys_SUITE.erl b/lib/stdlib/test/sys_SUITE.erl index f38bc87ae5..047ee9f1fa 100644 --- a/lib/stdlib/test/sys_SUITE.erl +++ b/lib/stdlib/test/sys_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -202,14 +202,7 @@ spec_proc(Mod) -> {Mod,system_get_state},{throw,fail}},_}} -> ok end, - Mod:stop(), - WaitForUnregister = fun W() -> - case whereis(Mod) of - undefined -> ok; - _ -> timer:sleep(10), W() - end - end, - WaitForUnregister(), + ok = sys:terminate(Mod, normal), {ok,_} = Mod:start_link(4), ok = case catch sys:replace_state(Mod, fun(_) -> {} end) of {} -> @@ -218,8 +211,7 @@ spec_proc(Mod) -> {Mod,system_replace_state},{throw,fail}},_}} -> ok end, - Mod:stop(), - WaitForUnregister(), + ok = sys:terminate(Mod, normal), {ok,_} = Mod:start_link(4), StateFun = fun(_) -> error(fail) end, ok = case catch sys:replace_state(Mod, StateFun) of @@ -231,7 +223,7 @@ spec_proc(Mod) -> {'EXIT',{{callback_failed,StateFun,{error,fail}},_}} -> ok end, - Mod:stop(). + ok = sys:terminate(Mod, normal). %%%%%%%%%%%%%%%%%%%% %% Dummy server diff --git a/lib/stdlib/test/sys_sp1.erl b/lib/stdlib/test/sys_sp1.erl index e84ffcfa12..0fb288991f 100644 --- a/lib/stdlib/test/sys_sp1.erl +++ b/lib/stdlib/test/sys_sp1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -17,7 +17,7 @@ %% %CopyrightEnd% %% -module(sys_sp1). --export([start_link/1, stop/0]). +-export([start_link/1]). -export([alloc/0, free/1]). -export([init/1]). -export([system_continue/3, system_terminate/4, @@ -31,10 +31,6 @@ start_link(NumCh) -> proc_lib:start_link(?MODULE, init, [[self(),NumCh]]). -stop() -> - ?MODULE ! stop, - ok. - alloc() -> ?MODULE ! {self(), alloc}, receive @@ -70,11 +66,7 @@ loop(Chs, Parent, Deb) -> loop(Chs2, Parent, Deb2); {system, From, Request} -> sys:handle_system_msg(Request, From, Parent, - ?MODULE, Deb, Chs); - stop -> - sys:handle_debug(Deb, fun write_debug/3, - ?MODULE, {in, stop}), - ok + ?MODULE, Deb, Chs) end. system_continue(Parent, Deb, Chs) -> diff --git a/lib/stdlib/test/sys_sp2.erl b/lib/stdlib/test/sys_sp2.erl index 56a5e4d071..a0847b5838 100644 --- a/lib/stdlib/test/sys_sp2.erl +++ b/lib/stdlib/test/sys_sp2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -17,7 +17,7 @@ %% %CopyrightEnd% %% -module(sys_sp2). --export([start_link/1, stop/0]). +-export([start_link/1]). -export([alloc/0, free/1]). -export([init/1]). -export([system_continue/3, system_terminate/4, @@ -30,10 +30,6 @@ start_link(NumCh) -> proc_lib:start_link(?MODULE, init, [[self(),NumCh]]). -stop() -> - ?MODULE ! stop, - ok. - alloc() -> ?MODULE ! {self(), alloc}, receive @@ -45,11 +41,6 @@ free(Ch) -> ?MODULE ! {free, Ch}, ok. -%% can't use 2-tuple for state here as we do in sys_sp1, since the 2-tuple -%% is not compatible with the backward compatibility handling for -%% sys:get_state in sys.erl --record(state, {alloc,free}). - init([Parent,NumCh]) -> register(?MODULE, self()), Chs = channels(NumCh), @@ -74,11 +65,7 @@ loop(Chs, Parent, Deb) -> loop(Chs2, Parent, Deb2); {system, From, Request} -> sys:handle_system_msg(Request, From, Parent, - ?MODULE, Deb, Chs); - stop -> - sys:handle_debug(Deb, fun write_debug/3, - ?MODULE, {in, stop}), - ok + ?MODULE, Deb, Chs) end. system_continue(Parent, Deb, Chs) -> @@ -91,17 +78,17 @@ write_debug(Dev, Event, Name) -> io:format(Dev, "~p event = ~p~n", [Name, Event]). channels(NumCh) -> - #state{alloc=[], free=lists:seq(1,NumCh)}. + {_Allocated=[], _Free=lists:seq(1,NumCh)}. -alloc(#state{free=[]}=Channels) -> - {{error, "no channels available"}, Channels}; -alloc(#state{alloc=Allocated, free=[H|T]}) -> - {H, #state{alloc=[H|Allocated], free=T}}. +alloc({_, []}) -> + {error, "no channels available"}; +alloc({Allocated, [H|T]}) -> + {H, {[H|Allocated], T}}. -free(Ch, #state{alloc=Alloc, free=Free}=Channels) -> +free(Ch, {Alloc, Free}=Channels) -> case lists:member(Ch, Alloc) of true -> - #state{alloc=lists:delete(Ch, Alloc), free=[Ch|Free]}; + {lists:delete(Ch, Alloc), [Ch|Free]}; false -> Channels end. diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 40372a2106..de271d7f2f 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -3323,6 +3323,11 @@ attribute_arguments(Node) -> [set_pos( list(unfold_function_names(Data, Pos)), Pos)]; + optional_callbacks -> + D = try list(unfold_function_names(Data, Pos)) + catch _:_ -> abstract(Data) + end, + [set_pos(D, Pos)]; import -> {Module, Imports} = Data, [set_pos(atom(Module), Pos), @@ -6135,6 +6140,13 @@ abstract_tail(H, T) -> %% {@link char/1} function to explicitly create an abstract %% character.) %% +%% Note: `arity_qualifier' nodes are recognized. This is to follow The +%% Erlang Parser when it comes to wild attributes: both {F, A} and F/A +%% are recognized, which makes it possible to turn wild attributes +%% into recognized attributes without at the same time making it +%% impossible to compile files using the new syntax with the old +%% version of the Erlang Compiler. +%% %% @see abstract/1 %% @see is_literal/1 %% @see char/1 @@ -6184,6 +6196,20 @@ concrete(Node) -> {value, concrete(F), []} end, [], true), B; + arity_qualifier -> + A = erl_syntax:arity_qualifier_argument(Node), + case erl_syntax:type(A) of + integer -> + F = erl_syntax:arity_qualifier_body(Node), + case erl_syntax:type(F) of + atom -> + {F, A}; + _ -> + erlang:error({badarg, Node}) + end; + _ -> + erlang:error({badarg, Node}) + end; _ -> erlang:error({badarg, Node}) end. diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el index 78929ac510..8d2c02e455 100644 --- a/lib/tools/emacs/erlang-skels.el +++ b/lib/tools/emacs/erlang-skels.el @@ -1,7 +1,7 @@ ;; ;; %CopyrightBegin% ;; -;; Copyright Ericsson AB 2010. All Rights Reserved. +;; Copyright Ericsson AB 2010-2014. All Rights Reserved. ;; ;; The contents of this file are subject to the Erlang Public License, ;; Version 1.1, (the "License"); you may not use this file except in @@ -352,26 +352,25 @@ Please see the function `tempo-define-template'.") "%% @doc" n "%% Whenever a supervisor is started using supervisor:start_link/[2,3]," n "%% this function is called by the new process to find out about" n - "%% restart strategy, maximum restart frequency and child" n + "%% restart strategy, maximum restart intensity, and child" n "%% specifications." n "%%" n "%% @spec init(Args) -> {ok, {SupFlags, [ChildSpec]}} |" n "%% ignore |" n "%% {error, Reason}" n (erlang-skel-separator-end 2) - "init([]) ->" n> - "RestartStrategy = one_for_one," n> - "MaxRestarts = 1000," n> - "MaxSecondsBetweenRestarts = 3600," n - "" n> - "SupFlags = {RestartStrategy, MaxRestarts, MaxSecondsBetweenRestarts}," n + "init([]) ->" n "" n> - "Restart = permanent," n> - "Shutdown = 2000," n> - "Type = worker," n + "SupFlags = #{strategy => one_for_one," n> + "intensity => 1," n> + "period => 5}," n "" n> - "AChild = {'AName', {'AModule', start_link, []}," n> - "Restart, Shutdown, Type, ['AModule']}," n + "AChild = #{id => 'AName'," n> + "start => {'AModule', start_link, []}," n> + "restart => permanent," n> + "shutdown => 5000," n> + "type => worker," n> + "modules => ['AModule']}," n "" n> "{ok, {SupFlags, [AChild]}}." n n @@ -379,7 +378,7 @@ Please see the function `tempo-define-template'.") "%%% Internal functions" n (erlang-skel-double-separator-end 3) ) - "*The template of an supervisor behaviour. + "*The template of a supervisor behaviour. Please see the function `tempo-define-template'.") (defvar erlang-skel-supervisor-bridge @@ -449,7 +448,7 @@ Please see the function `tempo-define-template'.") "%%% Internal functions" n (erlang-skel-double-separator-end 3) ) - "*The template of an supervisor_bridge behaviour. + "*The template of a supervisor_bridge behaviour. Please see the function `tempo-define-template'.") (defvar erlang-skel-generic-server diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl index 572bf24ca4..cbad05081e 100644 --- a/lib/typer/src/typer.erl +++ b/lib/typer/src/typer.erl @@ -405,7 +405,7 @@ get_type({{M, F, A} = MFA, Range, Arg}, CodeServer, Records) -> case dialyzer_codeserver:lookup_mfa_contract(MFA, CodeServer) of error -> {{F, A}, {Range, Arg}}; - {ok, {_FileLine, Contract}} -> + {ok, {_FileLine, Contract, _Xtra}} -> Sig = erl_types:t_fun(Arg, Range), case dialyzer_contracts:check_contract(Contract, Sig) of ok -> {{F, A}, {contract, Contract}}; diff --git a/lib/wx/src/wx_object.erl b/lib/wx/src/wx_object.erl index 80f8937656..2c016e7951 100644 --- a/lib/wx/src/wx_object.erl +++ b/lib/wx/src/wx_object.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2011. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -102,6 +102,7 @@ %% API -export([start/3, start/4, start_link/3, start_link/4, + stop/1, stop/3, call/2, call/3, cast/2, reply/2, @@ -215,6 +216,42 @@ gen_response({ok, Pid}) -> gen_response(Reply) -> Reply. +%% @spec (Ref::wxObject()|atom()|pid()) -> ok +%% @doc Stops a generic wx_object server with reason 'normal'. +%% Invokes terminate(Reason,State) in the server. The call waits until +%% the process is terminated. If the process does not exist, an +%% exception is raised. +stop(Ref = #wx_ref{state=Pid}) when is_pid(Pid) -> + try + gen:stop(Pid) + catch _:ExitReason -> + erlang:error({ExitReason, {?MODULE, stop, [Ref]}}) + end; +stop(Name) when is_atom(Name) orelse is_pid(Name) -> + try + gen:stop(Name) + catch _:ExitReason -> + erlang:error({ExitReason, {?MODULE, stop, [Name]}}) + end. + +%% @spec (Ref::wxObject()|atom()|pid(), Reason::term(), Timeout::timeout()) -> ok +%% @doc Stops a generic wx_object server with the given Reason. +%% Invokes terminate(Reason,State) in the server. The call waits until +%% the process is terminated. If the call times out, or if the process +%% does not exist, an exception is raised. +stop(Ref = #wx_ref{state=Pid}, Reason, Timeout) when is_pid(Pid) -> + try + gen:stop(Pid, Reason, Timeout) + catch _:ExitReason -> + erlang:error({ExitReason, {?MODULE, stop, [Ref, Reason, Timeout]}}) + end; +stop(Name, Reason, Timeout) when is_atom(Name) orelse is_pid(Name) -> + try + gen:stop(Name, Reason, Timeout) + catch _:ExitReason -> + erlang:error({ExitReason, {?MODULE, stop, [Name, Reason, Timeout]}}) + end. + %% @spec (Ref::wxObject()|atom()|pid(), Request::term()) -> term() %% @doc Make a call to a wx_object server. %% The call waits until it gets a result. @@ -563,22 +600,10 @@ opt(_, []) -> %% @hidden debug_options(Name, Opts) -> case opt(debug, Opts) of - {ok, Options} -> dbg_options(Name, Options); - _ -> dbg_options(Name, []) + {ok, Options} -> dbg_opts(Name, Options); + _ -> [] end. %% @hidden -dbg_options(Name, []) -> - Opts = - case init:get_argument(generic_debug) of - error -> - []; - _ -> - [log, statistics] - end, - dbg_opts(Name, Opts); -dbg_options(Name, Opts) -> - dbg_opts(Name, Opts). -%% @hidden dbg_opts(Name, Opts) -> case catch sys:debug_options(Opts) of {'EXIT',_} -> diff --git a/lib/wx/test/wx_event_SUITE.erl b/lib/wx/test/wx_event_SUITE.erl index 076f16ba16..2c6c59bb55 100644 --- a/lib/wx/test/wx_event_SUITE.erl +++ b/lib/wx/test/wx_event_SUITE.erl @@ -542,13 +542,14 @@ handler_clean(_Config) -> ?mt(wxFrame, Frame1), wxWindow:show(Frame1), ?m([_|_], lists:sort(wx_test_lib:flush())), - ?m({stop,_}, wx_obj_test:stop(Frame1, fun(_) -> normal end)), + ?m(ok, wx_obj_test:stop(Frame1)), ?m([{terminate,normal}], lists:sort(wx_test_lib:flush())), - Frame2 = wx_obj_test:start([{init, Init}]), + Terminate = fun({Frame,_}) -> wxWindow:destroy(Frame) end, + Frame2 = wx_obj_test:start([{init, Init}, {terminate, Terminate}]), wxWindow:show(Frame2), ?m([_|_], lists:sort(wx_test_lib:flush())), - ?m({stop,_}, wx_obj_test:stop(Frame2, fun(_) -> wxWindow:destroy(Frame2), normal end)), + ?m(ok, wx_obj_test:stop(Frame2)), ?m([{terminate,normal}], lists:sort(wx_test_lib:flush())), timer:sleep(104), ?m({[],[],[]}, white_box_check_event_handlers()), diff --git a/lib/wx/test/wx_obj_test.erl b/lib/wx/test/wx_obj_test.erl index f47f2fbc46..6c648c65f8 100644 --- a/lib/wx/test/wx_obj_test.erl +++ b/lib/wx/test/wx_obj_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -18,7 +18,7 @@ -module(wx_obj_test). -include_lib("wx/include/wx.hrl"). --export([start/1, stop/2]). +-export([start/1, stop/1]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, @@ -29,8 +29,8 @@ start(Opts) -> wx_object:start_link(?MODULE, [{parent, self()}| Opts], []). -stop(Object, Fun) -> - wx_object:call(Object, {stop, Fun}). +stop(Object) -> + wx_object:stop(Object). init(Opts) -> Parent = proplists:get_value(parent, Opts), @@ -61,8 +61,6 @@ handle_event(Event, State = #state{parent=Parent}) -> handle_call(What, From, State = #state{user_state=US}) when is_function(What) -> Result = What(US), {reply, {call, Result, From}, State}; -handle_call({stop, Fun}, From, State = #state{user_state=US}) -> - {stop, Fun(US), {stop, From}, State}; handle_call(What, From, State) -> {reply, {call, What, From}, State}. @@ -79,7 +77,13 @@ handle_info(What, State = #state{parent=Pid}) -> Pid ! {info, What}, {noreply, State}. -terminate(What, #state{parent=Pid}) -> +terminate(What, #state{parent=Pid, opts=Opts, user_state=US}) -> + case proplists:get_value(terminate, Opts) of + undefined -> + ok; + Terminate -> + Terminate(US) + end, Pid ! {terminate, What}, ok. diff --git a/make/run_make.mk b/make/run_make.mk index 01ab257006..9570113861 100644 --- a/make/run_make.mk +++ b/make/run_make.mk @@ -30,7 +30,7 @@ include $(ERL_TOP)/make/target.mk .PHONY: valgrind -opt debug purify quantify purecov valgrind gcov gprof lcnt frmptr: +opt debug purify quantify purecov valgrind gcov gprof lcnt frmptr icount: $(make_verbose)$(MAKE) -f $(TARGET)/Makefile TYPE=$@ plain smp frag smp_frag: diff --git a/system/doc/design_principles/appup_cookbook.xml b/system/doc/design_principles/appup_cookbook.xml index 70c34a5a06..22c48db855 100644 --- a/system/doc/design_principles/appup_cookbook.xml +++ b/system/doc/design_principles/appup_cookbook.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2013</year> + <year>2003</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -132,7 +132,7 @@ code_change(_Vsn, Chs, _Extra) -> loaded.</p> <p>Thus, <c>ch3</c> must be loaded before <c>m1</c> is, in the upgrade case, and vice versa in the downgrade case. We say - that <c>m1</c><em>is dependent on</em><c>ch3</c>. In a release + that <c>m1</c> <em>is dependent on</em> <c>ch3</c>. In a release handling instruction, this is expressed by the element <c>DepMods</c>:</p> <code type="none"> @@ -239,7 +239,7 @@ system_code_change(Chs, _Module, _OldVsn, _Extra) -> <marker id="sup"></marker> <title>Changing a Supervisor</title> <p>The supervisor behaviour supports changing the internal state, - i.e. changing restart strategy and maximum restart frequency + i.e. changing restart strategy and maximum restart intensity properties, as well as changing existing child specifications.</p> <p>Adding and deleting child processes are also possible, but not handled automatically. Instructions must be given by in @@ -267,7 +267,7 @@ system_code_change(Chs, _Module, _OldVsn, _Extra) -> ... init(_Args) -> - {ok, {{one_for_all, 1, 60}, ...}}.</code> + {ok, {#{strategy => one_for_all, ...}, ...}}.</code> <p>The file <c>ch_app.appup</c>:</p> <code type="none"> {"2", diff --git a/system/doc/design_principles/distributed_applications.xml b/system/doc/design_principles/distributed_applications.xml index 2886f06b53..4d4ba3136e 100644 --- a/system/doc/design_principles/distributed_applications.xml +++ b/system/doc/design_principles/distributed_applications.xml @@ -43,7 +43,7 @@ addressing mechanism is required to ensure that it can be addressed by other applications, regardless on which node it currently executes. This issue is not addressed here, but the - Kernel module <c>global</c> or STDLIB module <c>pg</c> can be + Kernel modules <c>global</c> or <c>pg2</c> can be used for this purpose.</p> </section> diff --git a/system/doc/design_principles/spec_proc.xml b/system/doc/design_principles/spec_proc.xml index e4fb5fdca7..e849388a38 100644 --- a/system/doc/design_principles/spec_proc.xml +++ b/system/doc/design_principles/spec_proc.xml @@ -431,43 +431,79 @@ loop(...) -> <section> <title>User-Defined Behaviours</title> - <p><marker id="behaviours"/>To implement a user-defined behaviour, write code similar to - code for a special process but calling functions in a callback - module for handling specific tasks.</p> - <p>If it is desired that the compiler should warn for missing callback - functions, as it does for the OTP behaviours, add <c>-callback</c> attributes in the - behaviour module to describe the expected callbacks:</p> + + <p><marker id="behaviours"/>To implement a user-defined behaviour, + write code similar to code for a special process but calling + functions in a callback module for handling specific tasks.</p> + <p>If it is desired that the compiler should warn for missing + callback functions, as it does for the OTP behaviours, add + <c>-callback</c> attributes in the behaviour module to describe + the expected callback functions:</p> + <code type="none"> -callback Name1(Arg1_1, Arg1_2, ..., Arg1_N1) -> Res1. -callback Name2(Arg2_1, Arg2_2, ..., Arg2_N2) -> Res2. ... -callback NameM(ArgM_1, ArgM_2, ..., ArgM_NM) -> ResM.</code> - <p>where <c>NameX</c> are the names of the expected callbacks and - <c>ArgX_Y</c>, <c>ResX</c> are types as they are described in Specifications - for functions in <seealso marker="../reference_manual/typespec">Types and - Function Specifications</seealso>. The whole syntax of <c>-spec</c> attribute is - supported by <c>-callback</c> attribute.</p> - <p>Alternatively you may directly implement and export the function:</p> + + <p>where each <c>Name</c> is the name of a callback function and + <c>Arg</c> and <c>Res</c> are types as described in + Specifications for functions in <seealso + marker="../reference_manual/typespec">Types and Function + Specifications</seealso>. The whole syntax of the + <c>-spec</c> attribute is supported by <c>-callback</c> + attribute.</p> + <p>Callback functions that are optional for the user of the + behaviour to implement are specified by use of the + <c>-optional_callbacks</c> attribute:</p> + +<code type="none"> +-optional_callbacks([OptName1/OptArity1, ..., OptNameK/OptArityK]).</code> + + <p>where each <c>OptName/OptArity</c> specifies the name and arity + of a callback function. Note that the <c>-optional_callbacks</c> + attribute is to be used together with the <c>-callback</c> + attribute; it cannot be combined with the + <c>behaviour_info()</c> function described below.</p> + <p>Tools that need to know about optional callback functions can + call <c>Behaviour:behaviour_info(optional_callbacks)</c> to get + a list of all optional callback functions.</p> + + <note><p>We recommend using the <c>-callback</c> attribute rather + than the <c>behaviour_info()</c> function. The reason is that + the extra type information can be used by tools to produce + documentation or find discrepancies.</p></note> + + <p>As an alternative to the <c>-callback</c> and + <c>-optional_callbacks</c> attributes you may directly implement + and export <c>behaviour_info()</c>:</p> + <code type="none"> behaviour_info(callbacks) -> [{Name1, Arity1},...,{NameN, ArityN}].</code> - <p>where each <c>{Name, Arity}</c> specifies the name and arity of a callback - function. This function is otherwise automatically generated by the compiler - using the <c>-callback</c> attributes.</p> + + <p>where each <c>{Name, Arity}</c> specifies the name and arity of + a callback function. This function is otherwise automatically + generated by the compiler using the <c>-callback</c> + attributes.</p> <p>When the compiler encounters the module attribute - <c>-behaviour(Behaviour).</c> in a module <c>Mod</c>, it will call - <c>Behaviour:behaviour_info(callbacks)</c> and compare the result with the - set of functions actually exported from <c>Mod</c>, and issue a warning if - any callback function is missing.</p> + <c>-behaviour(Behaviour).</c> in a module <c>Mod</c>, it will + call <c>Behaviour:behaviour_info(callbacks)</c> and compare the + result with the set of functions actually exported from + <c>Mod</c>, and issue a warning if any callback function is + missing.</p> <p>Example:</p> <code type="none"> %% User-defined behaviour module -module(simple_server). --export([start_link/2,...]). +-export([start_link/2, init/3, ...]). -callback init(State :: term()) -> 'ok'. -callback handle_req(Req :: term(), State :: term()) -> {'ok', Reply :: term()}. -callback terminate() -> 'ok'. +-callback format_state(State :: term()) -> term(). + +-optional_callbacks([format_state/1]). %% Alternatively you may define: %% diff --git a/system/doc/design_principles/sup_princ.xml b/system/doc/design_principles/sup_princ.xml index 11ef3813d6..3d7b53e339 100644 --- a/system/doc/design_principles/sup_princ.xml +++ b/system/doc/design_principles/sup_princ.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2013</year> + <year>1997</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -29,14 +29,14 @@ <file>sup_princ.xml</file> </header> <p>This section should be read in conjunction with - <c>supervisor(3)</c>, where all details about the supervisor - behaviour is given.</p> + <seealso marker="stdlib:supervisor">supervisor(3)</seealso>, where + all details about the supervisor behaviour are described.</p> <section> <title>Supervision Principles</title> - <p>A supervisor is responsible for starting, stopping and + <p>A supervisor is responsible for starting, stopping, and monitoring its child processes. The basic idea of a supervisor is - that it should keep its child processes alive by restarting them + that it shall keep its child processes alive by restarting them when necessary.</p> <p>Which child processes to start and monitor is specified by a list of <seealso marker="#spec">child specifications</seealso>. @@ -61,18 +61,59 @@ start_link() -> supervisor:start_link(ch_sup, []). init(_Args) -> - {ok, {{one_for_one, 1, 60}, - [{ch3, {ch3, start_link, []}, - permanent, brutal_kill, worker, [ch3]}]}}.</code> - <p><c>one_for_one</c> is the <seealso marker="#strategy">restart strategy</seealso>.</p> - <p>1 and 60 defines the <seealso marker="#frequency">maximum restart frequency</seealso>.</p> - <p>The tuple <c>{ch3, ...}</c> is a <seealso marker="#spec">child specification</seealso>.</p> + SupFlags = #{strategy => one_for_one, intensity => 1, period => 5}, + ChildSpecs = [#{id => ch3, + start => {ch3, start_link, []}, + restart => permanent, + shutdown => brutal_kill, + type => worker, + modules => [cg3]}], + {ok, {SupFlags, ChildSpecs}}.</code> + <p>The <c>SupFlags</c> variable in the return value + from <c>init/1</c> represents + the <seealso marker="#flags">supervisor flags</seealso>.</p> + <p>The <c>ChildSpecs</c> variable in the return value + from <c>init/1</c> is a list of <seealso marker="#spec">child + specifications</seealso>.</p> + </section> + + <section> + <title>Supervisor Flags</title> + <p>This is the type definition for the supervisor flags:</p> + <code type="none"><![CDATA[ +sup_flags() = #{strategy => strategy(), % optional + intensity => non_neg_integer(), % optional + period => pos_integer()} % optional + strategy() = one_for_all + | one_for_one + | rest_for_one + | simple_one_for_one]]></code> + <list type="bulleted"> + <item> + <p><c>strategy</c> specifies + the <seealso marker="#strategy">restart + strategy</seealso>.</p> + </item> + <item> + <p><c>intensity</c> and <c>period</c> specify + the <seealso marker="#max_intensity">maximum restart + intensity</seealso>.</p> + </item> + </list> </section> <section> <marker id="strategy"></marker> <title>Restart Strategy</title> + <p> The restart strategy is specified by + the <c>strategy</c> key in the supervisor flags map returned by + the callback function <c>init</c>:</p> + <code type="none"> +SupFlags = #{strategy => Strategy, ...}</code> + <p>The <c>strategy</c> key is optional in this map. If it is not + given, it defaults to <c>one_for_one</c>.</p> + <section> <title>one_for_one</title> <p>If a child process terminates, only that process is restarted.</p> @@ -85,7 +126,7 @@ init(_Args) -> <section> <title>one_for_all</title> <p>If a child process terminates, all other child processes are - terminated and then all child processes, including + terminated, and then all child processes, including the terminated one, are restarted.</p> <marker id="sup5"></marker> <image file="../design_principles/sup5.gif"> @@ -100,29 +141,36 @@ init(_Args) -> process in start order -- are terminated. Then the terminated child process and the rest of the child processes are restarted.</p> </section> + + <section> + <title>simple_one_for_one</title> + <p>See <seealso marker="#simple">simple-one-for-one + supervisors</seealso>.</p> + </section> </section> <section> - <marker id="frequency"></marker> - <title>Maximum Restart Frequency</title> + <marker id="max_intensity"></marker> + <title>Maximum Restart Intensity</title> <p>The supervisors have a built-in mechanism to limit the number of restarts which can occur in a given time interval. This is - determined by the values of the two parameters <c>MaxR</c> and - <c>MaxT</c> in the start specification returned by the callback - function <c>init</c>:</p> + specified by the two keys <c>intensity</c> and + <c>period</c> in the supervisor flags map returned by the + callback function <c>init</c>:</p> <code type="none"> -init(...) -> - {ok, {{RestartStrategy, MaxR, MaxT}, - [ChildSpec, ...]}}.</code> +SupFlags = #{intensity => MaxR, period => MaxT, ...}</code> <p>If more than <c>MaxR</c> number of restarts occur in the last - <c>MaxT</c> seconds, then the supervisor terminates all the child + <c>MaxT</c> seconds, the supervisor terminates all the child processes and then itself.</p> - <p>When the supervisor terminates, then the next higher level + <p>When the supervisor terminates, the next higher level supervisor takes some action. It either restarts the terminated - supervisor, or terminates itself.</p> + supervisor or terminates itself.</p> <p>The intention of the restart mechanism is to prevent a situation where a process repeatedly dies for the same reason, only to be restarted again.</p> + <p>The keys <c>intensity</c> and <c>period</c> are optional in the + supervisor flags map. If they are not given, they default + to <c>1</c> and <c>5</c>, respectively.</p> </section> <section> @@ -130,33 +178,42 @@ init(...) -> <title>Child Specification</title> <p>This is the type definition for a child specification:</p> <code type="none"><![CDATA[ -{Id, StartFunc, Restart, Shutdown, Type, Modules} - Id = term() - StartFunc = {M, F, A} - M = F = atom() - A = [term()] - Restart = permanent | transient | temporary - Shutdown = brutal_kill | integer()>0 | infinity - Type = worker | supervisor - Modules = [Module] | dynamic - Module = atom()]]></code> +child_spec() = #{id => child_id(), % mandatory + start => mfargs(), % mandatory + restart => restart(), % optional + shutdown => shutdown(), % optional + type => worker(), % optional + modules => modules()} % optional</pre> + child_id() = term() + mfargs() = {M :: module(), F :: atom(), A :: [term()]} + modules() = [module()] | dynamic + restart() = permanent | transient | temporary + shutdown() = brutal_kill | timeout() + worker() = worker | supervisor]]></code> <list type="bulleted"> <item> - <p><c>Id</c> is a name that is used to identify the child + <p><c>id</c> is used to identify the child specification internally by the supervisor.</p> + <p>The <c>id</c> key is mandatory.</p> + <p>Note that this identifier on occations has been called + "name". As far as possible, the terms "identifier" or "id" + are now used but in order to keep backwards compatibility, + some occurences of "name" can still be found, for example + in error messages.</p> </item> <item> - <p><c>StartFunc</c> defines the function call used to start + <p><c>start</c> defines the function call used to start the child process. It is a module-function-arguments tuple used as <c>apply(M, F, A)</c>.</p> <p>It should be (or result in) a call to <c>supervisor:start_link</c>, <c>gen_server:start_link</c>, - <c>gen_fsm:start_link</c> or <c>gen_event:start_link</c>. + <c>gen_fsm:start_link</c>, or <c>gen_event:start_link</c>. (Or a function compliant with these functions, see <c>supervisor(3)</c> for details.</p> + <p>The <c>start</c> key is mandatory.</p> </item> <item> - <p><c>Restart</c> defines when a terminated child process should + <p><c>restart</c> defines when a terminated child process shall be restarted.</p> <list type="bulleted"> <item>A <c>permanent</c> child process is always restarted.</item> @@ -166,12 +223,14 @@ init(...) -> death causes the temporary process to be terminated).</item> <item>A <c>transient</c> child process is restarted only if it terminates abnormally, i.e. with another exit reason than - <c>normal</c>, <c>shutdown</c> or <c>{shutdown,Term}</c>.</item> + <c>normal</c>, <c>shutdown</c>, or <c>{shutdown,Term}</c>.</item> </list> + <p>The <c>restart</c> key is optional. If it is not given, the + default value <c>permanent</c> will be used.</p> </item> <item> <marker id="shutdown"></marker> - <p><c>Shutdown</c> defines how a child process should be + <p><c>shutdown</c> defines how a child process shall be terminated.</p> <list type="bulleted"> <item><c>brutal_kill</c> means the child process is @@ -184,58 +243,78 @@ init(...) -> terminated using <c>exit(Child, kill)</c>.</item> <item>If the child process is another supervisor, it should be set to <c>infinity</c> to give the subtree enough time to - shutdown. It is also allowed to set it to <c>infinity</c>, if the - child process is a worker.</item> + shut down. It is also allowed to set it to <c>infinity</c>, + if the child process is a worker.</item> </list> <warning> - <p>Be careful by setting the <c>Shutdown</c> strategy to + <p>Be careful when setting the shutdown time to <c>infinity</c> when the child process is a worker. Because, in this situation, the termination of the supervision tree depends on the child process, it must be implemented in a safe way and its cleanup procedure must always return.</p> </warning> + <p>The <c>shutdown</c> key is optional. If it is not given, + and the child is of type <c>worker</c>, the default value + <c>5000</c> will be used; if the child is of type + <c>supervisor</c>, the default value <c>infinity</c> will be + used.</p> </item> <item> - <p><c>Type</c> specifies if the child process is a supervisor or + <p><c>type</c> specifies if the child process is a supervisor or a worker.</p> + <p>The <c>type</c> key is optional. If it is not given, the + default value <c>worker</c> will be used.</p> </item> <item> - <p><c>Modules</c> should be a list with one element + <p><c>modules</c> should 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, - <c>Modules</c> should be <c>dynamic</c>.</p> + the value shall be <c>dynamic</c>.</p> <p>This information is used by the release handler during upgrades and downgrades, see <seealso marker="release_handling">Release Handling</seealso>.</p> + <p>The <c>modules</c> key is optional. If it is not given, it + defaults to <c>[M]</c>, where <c>M</c> comes from the + child's start <c>{M,F,A}</c>.</p> </item> </list> <p>Example: The child specification to start the server <c>ch3</c> in the example above looks like:</p> <code type="none"> -{ch3, - {ch3, start_link, []}, - permanent, brutal_kill, worker, [ch3]}</code> +#{id => ch3, + start => {ch3, start_link, []}, + restart => permanent, + shutdown => brutal_kill, + type => worker, + modules => [ch3]}</code> + <p>or simplified, relying on the default values:</p> + <code type="none"> +#{id => ch3, + start => {ch3, start_link, []} + shutdown => brutal_kill}</code> <p>Example: A child specification to start the event manager from the chapter about <seealso marker="events#mgr">gen_event</seealso>:</p> <code type="none"> -{error_man, - {gen_event, start_link, [{local, error_man}]}, - permanent, 5000, worker, dynamic}</code> - <p>Both the server and event manager are registered processes which +#{id => error_man, + start => {gen_event, start_link, [{local, error_man}]}, + modules => dynamic}</code> + <p>Both server and event manager are registered processes which can be expected to be accessible at all times, thus they are specified to be <c>permanent</c>.</p> <p><c>ch3</c> does not need to do any cleaning up before termination, thus no shutdown time is needed but <c>brutal_kill</c> should be sufficient. <c>error_man</c> may need some time for the event handlers to clean up, thus - <c>Shutdown</c> is set to 5000 ms.</p> + the shutdown time is set to 5000 ms (which is the default + value).</p> <p>Example: A child specification to start another supervisor:</p> <code type="none"> -{sup, - {sup, start_link, []}, - transient, infinity, supervisor, [sup]}</code> +#{id => sup, + start => {sup, start_link, []}, + restart => transient, + type => supervisor} % will cause default shutdown=>infinity</code> </section> <section> @@ -262,16 +341,18 @@ start_link() -> <c>supervisor:start_link({local, Name}, Module, Args)</c> or <c>supervisor:start_link({global, Name}, Module, Args)</c>.</p> <p>The new supervisor process calls the callback function - <c>ch_sup:init([])</c>. <c>init</c> is expected to return - <c>{ok, StartSpec}</c>:</p> + <c>ch_sup:init([])</c>. <c>init</c> shall return + <c>{ok, {SupFlags, ChildSpecs}}</c>:</p> <code type="none"> init(_Args) -> - {ok, {{one_for_one, 1, 60}, - [{ch3, {ch3, start_link, []}, - permanent, brutal_kill, worker, [ch3]}]}}.</code> + SupFlags = #{}, + ChildSpecs = [#{id => ch3, + start => {ch3, start_link, []}, + shutdown => brutal_kill}], + {ok, {SupFlags, ChildSpecs}}.</code> <p>The supervisor then starts all its child processes according to - the child specifications in the start specification. In this case - there is one child process, <c>ch3</c>.</p> + the given child specifications. In this case there, is one child + process, <c>ch3</c>.</p> <p>Note that <c>supervisor:start_link</c> is synchronous. It does not return until all child processes have been started.</p> </section> @@ -303,17 +384,19 @@ supervisor:terminate_child(Sup, Id)</code> <code type="none"> supervisor:delete_child(Sup, Id)</code> <p><c>Sup</c> is the pid, or name, of the supervisor. - <c>Id</c> is the id specified in the <seealso marker="#spec">child specification</seealso>.</p> + <c>Id</c> is the value associated with the <c>id</c> key in + the <seealso marker="#spec">child specification</seealso>.</p> <p>As with dynamically added child processes, the effects of deleting a static child process is lost if the supervisor itself restarts.</p> </section> + <marker id="simple"/> <section> <title>Simple-One-For-One Supervisors</title> <p>A supervisor with restart strategy <c>simple_one_for_one</c> is a simplified one_for_one supervisor, where all child processes are - dynamically added instances of the same process.</p> + dynamically added instances of the same child specification.</p> <p>Example of a callback module for a simple_one_for_one supervisor:</p> <code type="none"> -module(simple_sup). @@ -326,9 +409,13 @@ start_link() -> supervisor:start_link(simple_sup, []). init(_Args) -> - {ok, {{simple_one_for_one, 0, 1}, - [{call, {call, start_link, []}, - temporary, brutal_kill, worker, [call]}]}}.</code> + SupFlags = #{strategy => simple_one_for_one, + intensity => 0, + period => 1}, + ChildSpecs = [#{id => call, + start => {call, start_link, []}, + shutdown => brutal_kill}], + {ok, {SupFlags, ChildSpecs}}.</code> <p>When started, the supervisor will not start any child processes. Instead, all child processes are added dynamically by calling:</p> <code type="none"> @@ -336,7 +423,7 @@ supervisor:start_child(Sup, List)</code> <p><c>Sup</c> is the pid, or name, of the supervisor. <c>List</c> is an arbitrary list of terms which will be added to the list of arguments specified in the child specification. If - the start function is specified as <c>{M, F, A}</c>, then + the start function is specified as <c>{M, F, A}</c>, the child process is started by calling <c>apply(M, F, A++List)</c>.</p> <p>For example, adding a child to <c>simple_sup</c> above:</p> @@ -352,10 +439,10 @@ call:start_link(id1)</code> supervisor:terminate_child(Sup, Pid)</code> <p>where <c>Sup</c> is the pid, or name, of the supervisor and <c>Pid</c> is the pid of the child.</p> - <p>Because a <c>simple_one_for_one</c> supervisor could have many children, - it shuts them all down at same time. So, order in which they are stopped is - not defined. For the same reason, it could have an overhead with regards to - the <c>Shutdown</c> strategy.</p> + <p>Because a <c>simple_one_for_one</c> supervisor could have many + children, it shuts them all down asynchronously. This means that + the children will do their cleanup in parallel and therefore the + order in which they are stopped is not defined.</p> </section> <section> diff --git a/system/doc/reference_manual/modules.xml b/system/doc/reference_manual/modules.xml index f0ec7ef165..5fc8b363f8 100644 --- a/system/doc/reference_manual/modules.xml +++ b/system/doc/reference_manual/modules.xml @@ -229,13 +229,9 @@ behaviour_info(callbacks) -> Callbacks.</pre> <p>The <c>module_info/0</c> function in each module returns a list of <c>{Key,Value}</c> tuples with information about the module. Currently, the list contain tuples with the following - <c>Key</c>s: <c>attributes</c>, <c>compile</c>, - <c>exports</c>, and <c>imports</c>. The order and number of tuples + <c>Key</c>s: <c>module</c>, <c>attributes</c>, <c>compile</c>, + <c>exports</c> and <c>md5</c>. The order and number of tuples may change without prior notice.</p> - - <warning><p>The <c>{imports,Value}</c> tuple may be removed in a future - release because <c>Value</c> is always an empty list. - Do not write code that depends on it being present.</p></warning> </section> <section> @@ -246,6 +242,11 @@ behaviour_info(callbacks) -> Callbacks.</pre> <p>The following values are allowed for <c>Key</c>:</p> <taglist> + <tag><c>module</c></tag> + <item> + <p>Return an atom representing the module name.</p> + </item> + <tag><c>attributes</c></tag> <item> <p>Return a list of <c>{AttributeName,ValueList}</c> tuples, @@ -267,10 +268,9 @@ behaviour_info(callbacks) -> Callbacks.</pre> <seealso marker="stdlib:beam_lib#strip/1">beam_lib(3)</seealso>.</p> </item> - <tag><c>imports</c></tag> + <tag><c>md5</c></tag> <item> - <p>Always return an empty list. The <c>imports</c> key may not - be supported in future release.</p> + <p>Return a binary representing the MD5 checksum of the module.</p> </item> <tag><c>exports</c></tag> diff --git a/system/doc/tutorial/distribution.xml b/system/doc/tutorial/distribution.xml index 6a0ea759c4..ced8e4a545 100644 --- a/system/doc/tutorial/distribution.xml +++ b/system/doc/tutorial/distribution.xml @@ -58,7 +58,6 @@ <item>global_group - Grouping nodes to global name registration groups.</item> <item>net_adm - Various net administration routines.</item> <item>net_kernel - Networking kernel.</item> - <item>pg - Distributed named process groups, experimental implementation.</item> <item>pg2 - Distributed named process groups.</item> <item>pool - Load distribution facility.</item> <item>slave - Functions for starting and controlling slave nodes.</item> |