diff options
352 files changed, 22044 insertions, 7684 deletions
diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam Binary files differindex 1fea28a4dc..82bd89c17a 100644 --- a/bootstrap/lib/compiler/ebin/cerl.beam +++ b/bootstrap/lib/compiler/ebin/cerl.beam diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam Binary files differindex 8f97709248..6047596cb6 100644 --- a/bootstrap/lib/compiler/ebin/core_pp.beam +++ b/bootstrap/lib/compiler/ebin/core_pp.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 9b2450089a..3b3b8f4208 100644 --- a/bootstrap/lib/compiler/ebin/v3_core.beam +++ b/bootstrap/lib/compiler/ebin/v3_core.beam diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam Binary files differindex aa1ba78550..6f99487ca7 100644 --- a/bootstrap/lib/kernel/ebin/code_server.beam +++ b/bootstrap/lib/kernel/ebin/code_server.beam diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam Binary files differindex 369871f398..eb09a06785 100644 --- a/bootstrap/lib/kernel/ebin/dist_util.beam +++ b/bootstrap/lib/kernel/ebin/dist_util.beam diff --git a/bootstrap/lib/kernel/ebin/global_group.beam b/bootstrap/lib/kernel/ebin/global_group.beam Binary files differindex 1269f7e321..03202f68eb 100644 --- a/bootstrap/lib/kernel/ebin/global_group.beam +++ b/bootstrap/lib/kernel/ebin/global_group.beam diff --git a/bootstrap/lib/kernel/ebin/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam Binary files differindex 3b77ed641a..684d95afa0 100644 --- a/bootstrap/lib/kernel/ebin/rpc.beam +++ b/bootstrap/lib/kernel/ebin/rpc.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex 5c98ffdafc..54909eeaa3 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 22d3607866..aeea1e2fcd 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 efe68730d5..9b04739d58 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex 4cc4884c92..9841362f9d 100644 --- a/bootstrap/lib/stdlib/ebin/erl_pp.beam +++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_statem.beam b/bootstrap/lib/stdlib/ebin/gen_statem.beam Binary files differindex 08cb19ca6f..5a3fd2a1a5 100644 --- a/bootstrap/lib/stdlib/ebin/gen_statem.beam +++ b/bootstrap/lib/stdlib/ebin/gen_statem.beam diff --git a/bootstrap/lib/stdlib/ebin/lists.beam b/bootstrap/lib/stdlib/ebin/lists.beam Binary files differindex 91297311b2..422a9bd214 100644 --- a/bootstrap/lib/stdlib/ebin/lists.beam +++ b/bootstrap/lib/stdlib/ebin/lists.beam diff --git a/bootstrap/lib/stdlib/ebin/maps.beam b/bootstrap/lib/stdlib/ebin/maps.beam Binary files differindex 7533b56554..5f041ab10f 100644 --- a/bootstrap/lib/stdlib/ebin/maps.beam +++ b/bootstrap/lib/stdlib/ebin/maps.beam diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml index 13756ddfdc..bfabb7f042 100644 --- a/erts/doc/src/absform.xml +++ b/erts/doc/src/absform.xml @@ -68,22 +68,12 @@ <item>If D is a module declaration consisting of the forms <c>F_1</c>, ..., <c>F_k</c>, then Rep(D) = <c>[Rep(F_1), ..., Rep(F_k)]</c>.</item> - <item>If F is an attribute <c>-behavior(Behavior)</c>, then - Rep(F) = <c>{attribute,LINE,behavior,Behavior}</c>.</item> - <item>If F is an attribute <c>-behaviour(Behaviour)</c>, then - Rep(F) = <c>{attribute,LINE,behaviour,Behaviour}</c>.</item> - <item>If F is an attribute <c>-compile(Options)</c>, then - Rep(F) = <c>{attribute,LINE,compile,Options}</c>.</item> <item>If F is an attribute <c>-export([Fun_1/A_1, ..., Fun_k/A_k])</c>, then Rep(F) = <c>{attribute,LINE,export,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}</c>.</item> - <item>If F is an attribute <c>-export_type([Type_1/A_1, ..., Type_k/A_k])</c>, then - Rep(F) = <c>{attribute,LINE,export_type,[{Type_1,A_1}, ..., {Type_k,A_k}]}</c>.</item> <item>If F is an attribute <c>-import(Mod,[Fun_1/A_1, ..., Fun_k/A_k])</c>, then Rep(F) = <c>{attribute,LINE,import,{Mod,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}}</c>.</item> <item>If F is an attribute <c>-module(Mod)</c>, then Rep(F) = <c>{attribute,LINE,module,Mod}</c>.</item> - <item>If F is an attribute <c>-optional_callbacks([Fun_1/A_1, ..., Fun_k/A_k])</c>, then - Rep(F) = <c>{attribute,LINE,optional_callbacks,[{Fun_1,A_1}, ..., {Fun_k,A_k}]}</c>.</item> <item>If F is an attribute <c>-file(File,Line)</c>, then Rep(F) = <c>{attribute,LINE,file,{File,Line}}</c>.</item> <item>If F is a function declaration @@ -636,6 +626,9 @@ <item>If A is an association type <c>K => V</c>, where <c>K</c> and <c>V</c> are types, then Rep(A) = <c>{type,LINE,map_field_assoc,[Rep(K),Rep(V)]}</c>.</item> + <item>If A is an association type <c>K := V</c>, where + <c>K</c> and <c>V</c> are types, then Rep(A) = + <c>{type,LINE,map_field_exact,[Rep(K),Rep(V)]}</c>.</item> </list> </section> diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index e13470c83c..c499fc8081 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -632,6 +632,15 @@ <p>Sets the initial process dictionary size of processes to the size <c><![CDATA[Size]]></c>.</p> </item> + <tag><marker id="+hmqd"><c>+hmqd off_heap|on_heap|mixed</c></marker></tag> + <item><p> + Sets the default value for the process flag + <c>message_queue_data</c>. If <c>+hmqd</c> is not + passed, <c>mixed</c> will be the default. For more information, + see the documentation of + <seealso marker="erlang#process_flag_message_queue_data"><c>process_flag(message_queue_data, + MQD)</c></seealso>. + </p></item> <tag><c><![CDATA[+K true | false]]></c></tag> <item> <p>Enables or disables the kernel poll functionality if @@ -1361,21 +1370,6 @@ <seealso marker="kernel:error_logger#warning_map/0">error_logger(3)</seealso> for further information.</p> </item> - <tag><c><![CDATA[+xFlag Value]]></c></tag> - <item> - <p>Default process flag settings.</p> - <taglist> - <tag><marker id="+xmqd"><c>+xmqd off_heap|on_heap|mixed</c></marker></tag> - <item><p> - Sets the default value for the process flag - <c>message_queue_data</c>. If <c>+xmqd</c> is not - passed, <c>mixed</c> will be the default. For more information, - see the documentation of - <seealso marker="erlang#process_flag_message_queue_data"><c>process_flag(message_queue_data, - MQD)</c></seealso>. - </p></item> - </taglist> - </item> <tag><c><![CDATA[+zFlag Value]]></c></tag> <item> <p>Miscellaneous flags.</p> diff --git a/erts/doc/src/erl_tracer.xml b/erts/doc/src/erl_tracer.xml index 1e8e78b25f..2075b962d8 100644 --- a/erts/doc/src/erl_tracer.xml +++ b/erts/doc/src/erl_tracer.xml @@ -54,6 +54,14 @@ </description> <datatypes> + <datatype> <name name="trace_tag_send" /> </datatype> + <datatype> <name name="trace_tag_receive" /> </datatype> + <datatype> <name name="trace_tag_call" /> </datatype> + <datatype> <name name="trace_tag_procs" /> </datatype> + <datatype> <name name="trace_tag_ports" /> </datatype> + <datatype> <name name="trace_tag_running_procs" /> </datatype> + <datatype> <name name="trace_tag_running_ports" /> </datatype> + <datatype> <name name="trace_tag_gc" /> </datatype> <datatype> <name name="trace_tag" /> <desc> @@ -105,6 +113,29 @@ <title>CALLBACK FUNCTIONS</title> <p>The following functions should be exported from a <c>erl_tracer</c> callback module.</p> + <taglist> + <tag><seealso marker="#enabled"><c>Module:enabled/3</c></seealso></tag> + <item>Mandatory</item> + <tag><seealso marker="#trace"><c>Module:trace/6</c></seealso></tag> + <item>Mandatory</item> + <tag><seealso marker="#enabled_procs"><c>Module:enabled_procs/3</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#trace_procs"><c>Module:trace_procs/6</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#enabled_ports"><c>Module:enabled_ports/3</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#trace_ports"><c>Module:trace_ports/6</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#enabled_running_ports"><c>Module:enabled_running_ports/3</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#trace_running_ports"><c>Module:trace_running_ports/6</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#enabled_running_procs"><c>Module:enabled_running_procs/3</c></seealso></tag> + <item>Optional</item> + <tag><seealso marker="#trace_running_procs"><c>Module:trace_running_procs/6</c></seealso></tag> + <item>Optional</item> + </taglist> + </section> <marker id="enabled"></marker> <funcs> @@ -114,11 +145,11 @@ <type> <v>TraceTag = <seealso marker="#type-trace_tag">trace_tag()</seealso> | trace_status</v> <v>TracerState = term()</v> - <v>Tracee = <seealso marker="#type-trace_tag">tracee()</seealso></v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> <v>Result = trace | discard | remove</v> </type> <desc> - <p>This callback will be called whenever a trace point is triggered. It + <p>This callback will be called whenever a tracepoint is triggered. It allows the tracer to decide whether a trace should be generated or not. This check is made as early as possible in order to limit the amount of overhead associated with tracing. If <c>trace</c> is returned the @@ -132,7 +163,7 @@ to check if the tracer should still be active. It is called in multiple scenarios, but most significantly it is used when tracing is started using this tracer.</p> - <p>This function may be called multiple times per trace point, so it + <p>This function may be called multiple times per tracepoint, so it is important that it is both fast and side effect free.</p> </desc> </func> @@ -143,17 +174,17 @@ <type> <v>TraceTag = <seealso marker="#type-trace_tag">trace_tag()</seealso></v> <v>TracerState = term()</v> - <v>Tracee = <seealso marker="#type-trace_tag">tracee()</seealso></v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> <v>FirstTraceTerm = term()</v> <v>SecondTraceTerm = term() | undefined</v> <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> <v>Result = ok</v> </type> <desc> - <p>This callback will be called when a trace point is triggered and + <p>This callback will be called when a tracepoint is triggered and the <seealso marker="#enabled">Module:enabled/3</seealso> callback returned <c>trace</c>. In it any side effects needed by - the tracer should be done. The trace point payload is located in + the tracer should be done. The tracepoint payload is located in the <c>FirstTraceTerm</c> and <c>SecondTraceTerm</c>. The content of the TraceTerms depends on which <c>TraceTag</c> has been triggered. The <c>FirstTraceTerm</c> and <c>SecondTraceTerm</c> correspond to the @@ -181,6 +212,319 @@ see the <seealso marker="kernel:seq_trace">seq_trace</seealso> manual.</p> </desc> </func> + + <marker id="enabled_procs"></marker> + <func> + <name>Module:enabled_procs(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_procs">trace_tag_procs()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>procs</c></seealso> + is triggered.</p> + <p>If <c>enabled_procs/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_procs"></marker> + <func> + <name>Module:trace_procs(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_procs">trace_tag()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_procs">Module:enabled_procs/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_procs/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_ports"></marker> + <func> + <name>Module:enabled_ports(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_ports">trace_tag_ports()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>ports</c></seealso> + is triggered.</p> + <p>If <c>enabled_ports/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_ports"></marker> + <func> + <name>Module:trace_ports(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_ports">trace_tag()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_ports">Module:enabled_ports/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_ports/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_running_procs"></marker> + <func> + <name>Module:enabled_running_procs(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_running_procs">trace_tag_running_procs()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>running_procs | running</c></seealso> + is triggered.</p> + <p>If <c>enabled_running_procs/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_running_procs"></marker> + <func> + <name>Module:trace_running_procs(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_running_procs">trace_tag_running_procs()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_running_procs">Module:enabled_running_procs/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_running_procs/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_running_ports"></marker> + <func> + <name>Module:enabled_running_ports(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_running_ports">trace_tag_running_ports()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>running_ports</c></seealso> + is triggered.</p> + <p>If <c>enabled_running_ports/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_running_ports"></marker> + <func> + <name>Module:trace_running_ports(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_running_ports">trace_tag_running_ports()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_running_ports">Module:enabled_running_ports/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_running_ports/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_call"></marker> + <func> + <name>Module:enabled_call(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_call">trace_tag_call()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>call | return_to</c></seealso> + is triggered.</p> + <p>If <c>enabled_call/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_call"></marker> + <func> + <name>Module:trace_call(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_call">trace_tag_call()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_call">Module:enabled_call/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_call/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_send"></marker> + <func> + <name>Module:enabled_send(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_send">trace_tag_send()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>send</c></seealso> + is triggered.</p> + <p>If <c>enabled_send/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_send"></marker> + <func> + <name>Module:trace_send(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_send">trace_tag_send()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_send">Module:enabled_send/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_send/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_receive"></marker> + <func> + <name>Module:enabled_receive(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_receive">trace_tag_receive()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>'receive'</c></seealso> + is triggered.</p> + <p>If <c>enabled_receive/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_receive"></marker> + <func> + <name>Module:trace_receive(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_receive">trace_tag_receive()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_receive">Module:enabled_receive/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_receive/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + + <marker id="enabled_garbage_collection"></marker> + <func> + <name>Module:enabled_garbage_collection(TraceTag, TracerState, Tracee) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_gc">trace_tag_gc()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>Result = trace | discard | remove</v> + </type> + <desc> + <p>This callback will be called whenever a tracepoint with trace flag + <seealso marker="erlang#trace-3"><c>garbage_collection</c></seealso> + is triggered.</p> + <p>If <c>enabled_garbage_collection/3</c> is not defined <c>enabled/3</c> will be called instead.</p> + </desc> + </func> + + <marker id="trace_garbage_collection"></marker> + <func> + <name>Module:trace_garbage_collection(TraceTag, TracerState, Tracee, FirstTraceTerm, SecondTraceTerm, Opts) -> Result</name> + <fsummary>Check if a trace event should be generated.</fsummary> + <type> + <v>TraceTag = <seealso marker="#type-trace_tag_gc">trace_tag_gc()</seealso></v> + <v>TracerState = term()</v> + <v>Tracee = <seealso marker="#type-tracee">tracee()</seealso></v> + <v>FirstTraceTerm = term()</v> + <v>SecondTraceTerm = term() | undefined</v> + <v>Opts = <seealso marker="#type-trace_opts">trace_opts()</seealso></v> + <v>Result = ok</v> + </type> + <desc> + <p>This callback will be called when a tracepoint is triggered and + the <seealso marker="#enabled_garbage_collection">Module:enabled_garbage_collection/3</seealso> + callback returned <c>trace</c>.</p> + <p>If <c>trace_garbage_collection/6</c> is not defined <c>trace/6</c> will be called instead.</p> + </desc> + </func> + </funcs> <section> <marker id="example"></marker> @@ -282,7 +626,7 @@ static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) ErlNifPid to_pid; if (enif_get_local_pid(env, argv[1], &to_pid)) if (!enif_is_process_alive(env, &to_pid)) - /* tracer is dead so we should remove this trace point */ + /* tracer is dead so we should remove this tracepoint */ return enif_make_atom(env, "remove"); /* Only generate trace for when tracer != tracee */ diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 423ccdf98f..3276bc34b0 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -4371,7 +4371,7 @@ os_prompt% </pre> </taglist> <p> The default <c>message_queue_data</c> process flag is determined - by the <seealso marker="erl#+xmqd"><c>+xmqd</c></seealso> + by the <seealso marker="erl#+hmqd"><c>+hmqd</c></seealso> <c>erl</c> command line argument. </p> <p> @@ -4702,7 +4702,7 @@ os_prompt% </pre> detailed information about garbage collection for this process. The content of <c><anno>GCInfo</anno></c> can be changed without prior notice. - See <seealso marker="#gc_start">gc_start</seealso> in + See <seealso marker="#gc_minor_start">gc_minor_start</seealso> in <seealso marker="#trace/3">erlang:trace/3</seealso> for details about what each item means. </p> @@ -4878,7 +4878,9 @@ os_prompt% </pre> <tag><c>{total_heap_size, <anno>Size</anno>}</c></tag> <item> <p><c><anno>Size</anno></c> is the total size, in words, of all heap - fragments of the process. This includes the process stack.</p> + fragments of the process. This includes the process stack and + any unreceived messages that are considered to be part of the + heap. </p> </item> <tag><c>{trace, <anno>InternalTraceFlags</anno>}</c></tag> <item> @@ -5709,7 +5711,7 @@ true</pre> flag. <c><anno>MQD</anno></c> should be either <c>off_heap</c>, <c>on_heap</c>, or <c>mixed</c>. The default <c>message_queue_data</c> process flag is determined by the - <seealso marker="erl#+xmqd"><c>+xmqd</c></seealso> <c>erl</c> + <seealso marker="erl#+hmqd"><c>+hmqd</c></seealso> <c>erl</c> command line argument. For more information, see the documentation of <seealso marker="#process_flag_message_queue_data"><c>process_flag(message_queue_data, @@ -7388,7 +7390,7 @@ ok <p>Returns the default value of the <c>message_queue_data</c> process flag which is either <c>off_heap</c>, <c>on_heap</c>, or <c>mixed</c>. This default is set by the <c>erl</c> command line argument - <seealso marker="erl#+xmqd"><c>+xmqd</c></seealso>. For more information on the + <seealso marker="erl#+hmqd"><c>+hmqd</c></seealso>. For more information on the <c>message_queue_data</c> process flag, see documentation of <seealso marker="#process_flag_message_queue_data"><c>process_flag(message_queue_data, MQD)</c></seealso>.</p> @@ -7966,7 +7968,7 @@ ok <c>stack_size</c>, <c>mbuf_size</c>, <c>old_heap_size</c>, and <c>old_heap_block_size</c>. These tuples are explained in the description of trace message - <seealso marker="#gc_start">gc_start</seealso> (see + <seealso marker="#gc_minor_start">gc_minor_start</seealso> (see <seealso marker="#trace/3">erlang:trace/3</seealso>). New tuples can be added, and the order of the tuples in the <c>Info</c> list can be changed at any time without @@ -8556,7 +8558,7 @@ timestamp() -> <tag><c>garbage_collection</c></tag> <item> <p>Traces garbage collections of processes.</p> - <p>Message tags: <c><seealso marker="#trace_3_trace_messages_gc_start">gc_start</seealso></c> and <c><seealso marker="#trace_3_trace_messages_gc_end">gc_end</seealso></c>.</p> + <p>Message tags: <c><seealso marker="#trace_3_trace_messages_gc_minor_start">gc_minor_start</seealso></c> and <c><seealso marker="#trace_3_trace_messages_gc_minor_end">gc_minor_end</seealso></c>.</p> </item> <tag><c>timestamp</c></tag> <item> @@ -8637,8 +8639,8 @@ timestamp() -> <p>Specifies that a tracer module should be called instead of sending a trace message. The tracer module can then ignore or change the trace message. For more details - on how to write a tracer module see <seealso marker="erl_tracer"> - erl_tracer</seealso> + on how to write a tracer module see + <seealso marker="erts:erl_tracer"><c>erl_tracer</c></seealso> </p> </item> </taglist> @@ -8880,12 +8882,12 @@ timestamp() -> </p> </item> <tag> - <marker id="trace_3_trace_messages_gc_start"></marker> - <c>{trace, Pid, gc_start, Info}</c> + <marker id="trace_3_trace_messages_gc_minor_start"></marker> + <c>{trace, Pid, gc_minor_start, Info}</c> </tag> <item> - <marker id="gc_start"></marker> - <p>Sent when garbage collection is about to be started. + <marker id="gc_minor_start"></marker> + <p>Sent when a young garbage collection is about to be started. <c>Info</c> is a list of two-element tuples, where the first element is a key, and the second is the value. Do not depend on any order of the tuples. @@ -8925,15 +8927,32 @@ timestamp() -> <p>All sizes are in words.</p> </item> <tag> - <marker id="trace_3_trace_messages_gc_end"></marker> - <c>{trace, Pid, gc_end, Info}</c> + <marker id="trace_3_trace_messages_gc_minor_end"></marker> + <c>{trace, Pid, gc_minor_end, Info}</c> </tag> <item> - <p>Sent when garbage collection is finished. <c>Info</c> - contains the same kind of list as in message <c>gc_start</c>, + <p>Sent when young garbage collection is finished. <c>Info</c> + contains the same kind of list as in message <c>gc_minor_start</c>, but the sizes reflect the new sizes after garbage collection.</p> </item> + <tag> + <marker id="trace_3_trace_messages_gc_major_start"></marker> + <c>{trace, Pid, gc_major_start, Info}</c> + </tag> + <item> + <p>Sent when fullsweep garbage collection is about to be started. <c>Info</c> + contains the same kind of list as in message <c>gc_minor_start</c>.</p> + </item> + <tag> + <marker id="trace_3_trace_messages_gc_major_end"></marker> + <c>{trace, Pid, gc_major_end, Info}</c> + </tag> + <item> + <p>Sent when fullsweep garbage collection is finished. <c>Info</c> + contains the same kind of list as in message <c>gc_minor_start</c> + but the sizes reflect the new sizes after a fullsweep garbage collection.</p> + </item> </taglist> <p>If the tracing process/port dies or the tracer module returns <c>remove</c>, the flags are silently removed.</p> @@ -8989,7 +9008,7 @@ timestamp() -> <c>erlang:trace_delivered(<anno>Tracee</anno>)</c> resides on. The special <c><anno>Tracee</anno></c> atom <c>all</c> denotes all processes that currently are traced in the node.</p> - <p>When used together with an <seealso marker="#erl_tracer"> + <p>When used together with an <seealso marker="erts:erl_tracer"> Tracer Module</seealso> any message sent in the trace callback is guaranteed to have reached it's recipient before the <c>trace_delivered</c> message is sent.</p> diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 8c51f788c0..3022c0a99a 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -273,6 +273,10 @@ atom garbage_collecting atom garbage_collection atom garbage_collection_info atom gc_end +atom gc_major_end +atom gc_major_start +atom gc_minor_end +atom gc_minor_start atom gc_start atom Ge='>=' atom generational diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 87508dcf5f..40d44dda4c 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -38,7 +38,7 @@ #include "erl_thr_progress.h" static void set_default_trace_pattern(Eterm module); -static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp); +static Eterm check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls); static void delete_code(Module* modp); static void decrement_refc(BeamCodeHeader*); static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size); @@ -467,7 +467,7 @@ check_old_code_1(BIF_ALIST_1) } Eterm -erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp) +erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp, int fcalls) { Module* modp; Eterm res; @@ -483,7 +483,7 @@ erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp) return am_false; erts_rlock_old_code(code_ix); res = (!modp->old.code_hdr ? am_false : - check_process_code(c_p, modp, flags, redsp)); + check_process_code(c_p, modp, flags, redsp, fcalls)); erts_runlock_old_code(code_ix); return res; @@ -506,7 +506,7 @@ BIF_RETTYPE erts_internal_check_process_code_2(BIF_ALIST_2) goto badarg; } - res = erts_check_process_code(BIF_P, BIF_ARG_1, flags, &reds); + res = erts_check_process_code(BIF_P, BIF_ARG_1, flags, &reds, BIF_P->fcalls); ASSERT(is_value(res)); @@ -625,8 +625,8 @@ BIF_RETTYPE call_on_load_function_1(BIF_ALIST_1) { Module* modp = erts_get_module(BIF_ARG_1, erts_active_code_ix()); - if (modp && modp->curr.code_hdr) { - BIF_TRAP_CODE_PTR_0(BIF_P, modp->curr.code_hdr->on_load_function_ptr); + if (modp && modp->old.code_hdr) { + BIF_TRAP_CODE_PTR_0(BIF_P, modp->old.code_hdr->on_load_function_ptr); } else { BIF_ERROR(BIF_P, BADARG); @@ -651,14 +651,14 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) code_ix = erts_active_code_ix(); modp = erts_get_module(BIF_ARG_1, code_ix); - if (!modp || !modp->curr.code_hdr) { + if (!modp || !modp->old.code_hdr) { error: erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_release_code_write_permission(); BIF_ERROR(BIF_P, BADARG); } - if (modp->curr.code_hdr->on_load_function_ptr == NULL) { + if (modp->old.code_hdr->on_load_function_ptr == NULL) { goto error; } if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) { @@ -667,44 +667,55 @@ BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) if (BIF_ARG_2 == am_true) { int i; + struct erl_module_instance t; + + /* + * Swap old and new code. + */ + t = modp->curr; + modp->curr = modp->old; + modp->old = t; /* * The on_load function succeded. Fix up export entries. */ for (i = 0; i < export_list_size(code_ix); i++) { Export *ep = export_list(i,code_ix); - if (ep != NULL && - ep->code[0] == BIF_ARG_1 && - ep->code[4] != 0) { + if (ep == NULL || ep->code[0] != BIF_ARG_1) { + continue; + } + if (ep->code[4] != 0) { ep->addressv[code_ix] = (void *) ep->code[4]; ep->code[4] = 0; + } else { + if (ep->addressv[code_ix] == ep->code+3 && + ep->code[3] == (BeamInstr) em_apply_bif) { + continue; + } + ep->addressv[code_ix] = ep->code+3; + ep->code[3] = (BeamInstr) em_call_error_handler; } } modp->curr.code_hdr->on_load_function_ptr = NULL; set_default_trace_pattern(BIF_ARG_1); } else if (BIF_ARG_2 == am_false) { - BeamInstr* code; - BeamInstr* end; + int i; /* - * The on_load function failed. Remove the loaded code. - * This is an combination of delete and purge. We purge - * the current code; the old code is not touched. + * The on_load function failed. Remove references to the + * code that is about to be purged from the export entries. */ - erts_total_code_size -= modp->curr.code_length; - code = (BeamInstr*) modp->curr.code_hdr; - end = (BeamInstr *) ((char *)code + modp->curr.code_length); - erts_cleanup_funs_on_purge(code, end); - beam_catches_delmod(modp->curr.catches, code, modp->curr.code_length, - erts_active_code_ix()); - if (modp->curr.code_hdr->literals_start) { - erts_free(ERTS_ALC_T_LITERAL, modp->curr.code_hdr->literals_start); - } - erts_free(ERTS_ALC_T_CODE, modp->curr.code_hdr); - modp->curr.code_hdr = NULL; - modp->curr.code_length = 0; - modp->curr.catches = BEAM_CATCHES_NIL; - erts_remove_from_ranges(code); + + for (i = 0; i < export_list_size(code_ix); i++) { + Export *ep = export_list(i,code_ix); + if (ep == NULL || ep->code[0] != BIF_ARG_1) { + continue; + } + if (ep->code[3] == (BeamInstr) em_apply_bif) { + continue; + } + ep->code[4] = 0; + } } erts_smp_thr_progress_unblock(); erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); @@ -753,7 +764,7 @@ check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size) static Eterm -check_process_code(Process* rp, Module* modp, Uint flags, int *redsp) +check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls) { BeamInstr* start; char* literals; @@ -955,7 +966,7 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp) if (need_gc & ERTS_ORDINARY_GC__) { FLAGS(rp) |= F_NEED_FULLSWEEP; - *redsp += erts_garbage_collect_nobump(rp, 0, rp->arg_reg, rp->arity); + *redsp += erts_garbage_collect_nobump(rp, 0, rp->arg_reg, rp->arity, fcalls); done_gc |= ERTS_ORDINARY_GC__; } if (need_gc & ERTS_LITERAL_GC__) { diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h index bb171be8a6..08641b86d6 100644 --- a/erts/emulator/beam/beam_bp.h +++ b/erts/emulator/beam/beam_bp.h @@ -173,19 +173,7 @@ void erts_clear_time_trace_bif(BeamInstr *pc); BeamInstr *erts_find_local_func(Eterm mfa[3]); -ERTS_GLB_INLINE Uint erts_bp_sched2ix(void); - #if ERTS_GLB_INLINE_INCL_FUNC_DEF -ERTS_GLB_INLINE Uint erts_bp_sched2ix(void) -{ -#ifdef ERTS_SMP - ErtsSchedulerData *esdp; - esdp = erts_get_scheduler_data(); - return esdp->no - 1; -#else - return 0; -#endif -} extern erts_smp_atomic32_t erts_active_bp_index; extern erts_smp_atomic32_t erts_staging_bp_index; diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 72526bca5e..59112e1e43 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -308,7 +308,8 @@ void** beam_ops; if (E - HTOP < (needed + (HeapNeed))) { \ SWAPOUT; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, needed + (HeapNeed), reg, (M)); \ + FCALLS -= erts_garbage_collect_nobump(c_p, needed + (HeapNeed), \ + reg, (M), FCALLS); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ SWAPIN; \ @@ -360,7 +361,7 @@ void** beam_ops; if ((E - HTOP < need) || (MSO(c_p).overhead + (VNh) >= BIN_VHEAP_SZ(c_p))) {\ SWAPOUT; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)); \ + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live), FCALLS); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ SWAPIN; \ @@ -381,7 +382,7 @@ void** beam_ops; if (E - HTOP < need) { \ SWAPOUT; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live));\ + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live), FCALLS); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ SWAPIN; \ @@ -402,7 +403,7 @@ void** beam_ops; SWAPOUT; \ reg[Live] = Extra; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ - FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)+1); \ + FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, (Live)+1, FCALLS); \ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ Extra = reg[Live]; \ @@ -1196,6 +1197,25 @@ init_emulator(void) #define DTRACE_NIF_RETURN(p, m, f, a) do {} while (0) #endif /* USE_VM_PROBES */ +#ifdef DEBUG +#define ERTS_DBG_CHK_REDS(P, FC) \ + do { \ + if (ERTS_PROC_GET_SAVED_CALLS_BUF((P))) { \ + ASSERT(FC <= 0); \ + ASSERT(ERTS_PROC_GET_SCHDATA(c_p)->virtual_reds \ + <= 0 - (FC)); \ + } \ + else { \ + ASSERT(FC <= CONTEXT_REDS); \ + ASSERT(ERTS_PROC_GET_SCHDATA(c_p)->virtual_reds \ + <= CONTEXT_REDS - (FC)); \ + } \ +} while (0) +#else +#define ERTS_DBG_CHK_REDS(P, FC) +#endif + + /* * process_main() is called twice: * The first call performs some initialisation, including exporting @@ -1290,7 +1310,12 @@ void process_main(void) goto do_schedule1; do_schedule: - reds_used = REDS_IN(c_p) - FCALLS; + ASSERT(c_p->debug_reds_in == REDS_IN(c_p)); + if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) + reds_used = REDS_IN(c_p) - FCALLS; + else + reds_used = REDS_IN(c_p) - (CONTEXT_REDS + FCALLS); + ASSERT(reds_used >= 0); do_schedule1: if (start_time != 0) { @@ -1310,6 +1335,7 @@ void process_main(void) ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); c_p = schedule(c_p, reds_used); + ASSERT(!(c_p->flags & F_HIPE_MODE)); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); start_time = 0; #ifdef DEBUG @@ -1348,16 +1374,21 @@ void process_main(void) SET_I(c_p->i); - reds = c_p->fcalls; - if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p) - && (ERTS_TRACE_FLAGS(c_p) & F_SENSITIVE) == 0) { - neg_o_reds = -reds; - FCALLS = REDS_IN(c_p) = 0; + REDS_IN(c_p) = reds = c_p->fcalls; +#ifdef DEBUG + c_p->debug_reds_in = reds; +#endif + + if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) { + neg_o_reds = -CONTEXT_REDS; + FCALLS = neg_o_reds + reds; } else { neg_o_reds = 0; - FCALLS = REDS_IN(c_p) = reds; + FCALLS = reds; } + ERTS_DBG_CHK_REDS(c_p, FCALLS); + next = (BeamInstr *) *I; SWAPIN; ASSERT(VALID_INSTR(next)); @@ -1770,7 +1801,7 @@ void process_main(void) if (E - HTOP < 3) { SWAPOUT; PROCESS_MAIN_CHK_LOCKS(c_p); - FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1); + FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1, FCALLS); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; @@ -1865,6 +1896,7 @@ void process_main(void) c_p->flags |= F_DELAY_GC; loop_rec__: + PROCESS_MAIN_CHK_LOCKS(c_p); msgp = PEEK_MESSAGE(c_p); @@ -2007,6 +2039,8 @@ void process_main(void) ERTS_VBUMP_LEAVE_REDS_INTERNAL(c_p, 5, FCALLS); } + ERTS_DBG_CHK_REDS(c_p, FCALLS); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); NextPF(0, next); @@ -2535,6 +2569,7 @@ do { \ GetArg1(2, tmp_reg[0]); bf = (BifFunction) Arg(1); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); @@ -2544,6 +2579,7 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(result)) { StoreBifResult(3, result); } @@ -2564,6 +2600,7 @@ do { \ GetArg1(1, tmp_reg[0]); bf = (BifFunction) Arg(0); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); @@ -2573,6 +2610,7 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(result)) { StoreBifResult(2, result); } @@ -2591,6 +2629,7 @@ do { \ GetArg1(2, x(live)); bf = (GcBifFunction) Arg(1); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; SWAPOUT; PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2602,6 +2641,7 @@ do { \ SWAPIN; ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(result)) { StoreBifResult(4, result); } @@ -2630,6 +2670,7 @@ do { \ */ live++; bf = (GcBifFunction) Arg(1); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; SWAPOUT; PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2641,6 +2682,7 @@ do { \ SWAPIN; ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(result)) { StoreBifResult(5, result); } @@ -2671,6 +2713,7 @@ do { \ */ live += 2; bf = (GcBifFunction) Arg(1); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; SWAPOUT; PROCESS_MAIN_CHK_LOCKS(c_p); @@ -2682,6 +2725,7 @@ do { \ SWAPIN; ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(result)) { StoreBifResult(5, result); } @@ -2708,6 +2752,7 @@ do { \ GetArg2(2, tmp_reg[0], tmp_reg[1]); bf = (BifFunction) Arg(1); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS; PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); @@ -2717,6 +2762,7 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(result)) { StoreBifResult(4, result); } @@ -2775,6 +2821,7 @@ do { \ bf = GET_BIF_ADDRESS(Arg(0)); PRE_BIF_SWAPOUT(c_p); + ERTS_DBG_CHK_REDS(c_p, FCALLS); c_p->fcalls = FCALLS - 1; if (FCALLS <= 0) { save_calls(c_p, (Export *) Arg(0)); @@ -2796,6 +2843,7 @@ do { \ PROCESS_MAIN_CHK_LOCKS(c_p); HTOP = HEAP_TOP(c_p); FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); /* We have to update the cache if we are enabled in order to make sure no book keeping is done after we disabled msacc. We don't always do this as it is quite expensive. */ @@ -3324,8 +3372,13 @@ do { \ * (beacuse the code for the Dispatch() macro becomes shorter that way). */ - reds_used = REDS_IN(c_p) - FCALLS + 1; - + ASSERT(c_p->debug_reds_in == REDS_IN(c_p)); + if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) + reds_used = REDS_IN(c_p) - FCALLS; + else + reds_used = REDS_IN(c_p) - (CONTEXT_REDS + FCALLS); + ASSERT(reds_used >= 0); + /* * Save the argument registers and everything else. */ @@ -3514,6 +3567,7 @@ do { \ DTRACE_BIF_ENTRY(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); SWAPOUT; + ERTS_DBG_CHK_REDS(c_p, FCALLS - 1); c_p->fcalls = FCALLS - 1; vbf = (BifFunction) Arg(0); PROCESS_MAIN_CHK_LOCKS(c_p); @@ -3549,6 +3603,7 @@ do { \ } SWAPIN; /* There might have been a garbage collection. */ FCALLS = c_p->fcalls; + ERTS_DBG_CHK_REDS(c_p, FCALLS); if (is_value(nif_bif_result)) { r(0) = nif_bif_result; CHECK_TERM(r(0)); @@ -4611,9 +4666,9 @@ do { \ OpCase(i_generic_breakpoint): { BeamInstr real_I; ASSERT(I[-5] == (BeamInstr) BeamOp(op_i_func_info_IaaI)); - SWAPOUT; + HEAVY_SWAPOUT; real_I = erts_generic_breakpoint(c_p, I, reg); - SWAPIN; + HEAVY_SWAPIN; ASSERT(VALID_INSTR(real_I)); Goto(real_I); } @@ -4790,6 +4845,7 @@ do { \ { #define HIPE_MODE_SWITCH(Cmd) \ SWAPOUT; \ + ERTS_DBG_CHK_REDS(c_p, FCALLS); \ c_p->fcalls = FCALLS; \ c_p->def_arg_reg[4] = -neg_o_reds; \ c_p = hipe_mode_switch(c_p, Cmd, reg); \ @@ -4828,6 +4884,9 @@ do { \ #undef HIPE_MODE_SWITCH L_post_hipe_mode_switch: +#ifdef DEBUG + pid = c_p->common.id; /* may have switched process... */ +#endif reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array; freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array; ERL_BITS_RELOAD_STATEP(c_p); @@ -4835,6 +4894,7 @@ do { \ neg_o_reds = -c_p->def_arg_reg[4]; FCALLS = c_p->fcalls; SWAPIN; + ERTS_DBG_CHK_REDS(c_p, FCALLS); switch( c_p->def_arg_reg[3] ) { case HIPE_MODE_SWITCH_RES_RETURN: ASSERT(is_value(reg[0])); @@ -6839,7 +6899,7 @@ erts_current_reductions(Process *current, Process *p) if (current != p) { return 0; } else if (current->fcalls < 0 && ERTS_PROC_GET_SAVED_CALLS_BUF(current)) { - return -current->fcalls; + return current->fcalls + CONTEXT_REDS; } else { return REDS_IN(current) - current->fcalls; } diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 2e21a553ed..95489d9a63 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -32,6 +32,7 @@ #include "bif.h" #include "external.h" #include "beam_load.h" +#include "beam_bp.h" #include "big.h" #include "erl_bits.h" #include "beam_catches.h" @@ -479,9 +480,9 @@ static void free_loader_state(Binary* magic); static ErlHeapFragment* new_literal_fragment(Uint size); static void free_literal_fragment(ErlHeapFragment*); static void loader_state_dtor(Binary* magic); -static Eterm insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, - Eterm group_leader, Eterm module, - BeamCodeHeader* code, Uint size); +static Eterm stub_insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, + Eterm group_leader, Eterm module, + BeamCodeHeader* code, Uint size); static int init_iff_file(LoaderState* stp, byte* code, Uint size); static int scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mandatory); @@ -513,7 +514,7 @@ static GenOp* gen_get_map_element(LoaderState* stp, GenOpArg Fail, GenOpArg Src, static int freeze_code(LoaderState* stp); -static void final_touch(LoaderState* stp); +static void final_touch(LoaderState* stp, struct erl_module_instance* inst_p); static void short_file(int line, LoaderState* stp, unsigned needed); static void load_printf(int line, LoaderState* context, char *fmt, ...); static int transform_engine(LoaderState* st); @@ -766,8 +767,11 @@ Eterm erts_finish_loading(Binary* magic, Process* c_p, ErtsProcLocks c_p_locks, Eterm* modp) { - Eterm retval; + Eterm retval = NIL; LoaderState* stp = ERTS_MAGIC_BIN_DATA(magic); + Module* mod_tab_p; + struct erl_module_instance* inst_p; + Uint size; /* * No other process may run since we will update the export @@ -776,27 +780,80 @@ erts_finish_loading(Binary* magic, Process* c_p, ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_has_code_write_permission() || erts_smp_thr_progress_is_blocking()); - /* * Make current code for the module old and insert the new code * as current. This will fail if there already exists old code * for the module. */ + mod_tab_p = erts_put_module(stp->module); CHKBLK(ERTS_ALC_T_CODE,stp->code); - retval = insert_new_code(c_p, c_p_locks, stp->group_leader, stp->module, - stp->hdr, stp->loaded_size); - if (retval != NIL) { - goto load_error; + if (!stp->on_load) { + /* + * Normal case -- no -on_load() function. + */ + retval = beam_make_current_old(c_p, c_p_locks, stp->module); + ASSERT(retval == NIL); + } else { + ErtsCodeIndex code_ix = erts_staging_code_ix(); + Eterm module = stp->module; + int i; + + /* + * There is an -on_load() function. We will keep the current + * code, but we must turn off any tracing. + */ + + for (i = 0; i < export_list_size(code_ix); i++) { + Export *ep = export_list(i, code_ix); + if (ep == NULL || ep->code[0] != module) { + continue; + } + if (ep->addressv[code_ix] == ep->code+3) { + if (ep->code[3] == (BeamInstr) em_apply_bif) { + continue; + } else if (ep->code[3] == + (BeamInstr) BeamOp(op_i_generic_breakpoint)) { + ERTS_SMP_LC_ASSERT(erts_smp_thr_progress_is_blocking()); + ASSERT(mod_tab_p->curr.num_traced_exports > 0); + erts_clear_export_break(mod_tab_p, ep->code+3); + ep->addressv[code_ix] = (BeamInstr *) ep->code[4]; + ep->code[4] = 0; + } + ASSERT(ep->code[4] == 0); + } + } + ASSERT(mod_tab_p->curr.num_breakpoints == 0); + ASSERT(mod_tab_p->curr.num_traced_exports == 0); } /* + * Update module table. + */ + + size = stp->loaded_size; + erts_total_code_size += size; + if (stp->on_load) { + inst_p = &mod_tab_p->old; + } else { + inst_p = &mod_tab_p->curr; + } + inst_p->code_hdr = stp->hdr; + inst_p->code_length = size; + + /* + * Update ranges (used for finding a function from a PC value). + */ + + erts_update_ranges((BeamInstr*)inst_p->code_hdr, size); + + /* * Ready for the final touch: fixing the export table entries for * exported and imported functions. This can't fail. */ CHKBLK(ERTS_ALC_T_CODE,stp->code); - final_touch(stp); + final_touch(stp, inst_p); /* * Loading succeded. @@ -820,7 +877,6 @@ erts_finish_loading(Binary* magic, Process* c_p, retval = am_on_load; } - load_error: free_loader_state(magic); return retval; } @@ -1026,9 +1082,9 @@ loader_state_dtor(Binary* magic) } static Eterm -insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, - Eterm group_leader, Eterm module, BeamCodeHeader* code_hdr, - Uint size) +stub_insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, + Eterm group_leader, Eterm module, + BeamCodeHeader* code_hdr, Uint size) { Module* modp; Eterm retval; @@ -4700,14 +4756,13 @@ freeze_code(LoaderState* stp) } static void -final_touch(LoaderState* stp) +final_touch(LoaderState* stp, struct erl_module_instance* inst_p) { int i; int on_load = stp->on_load; unsigned catches; Uint index; BeamInstr* codev = stp->codev; - Module* modp; /* * Allocate catch indices and fix up all catch_yf instructions. @@ -4722,8 +4777,7 @@ final_touch(LoaderState* stp) codev[index+2] = make_catch(catches); index = next; } - modp = erts_put_module(stp->module); - modp->curr.catches = catches; + inst_p->catches = catches; /* * Export functions. @@ -4743,10 +4797,10 @@ final_touch(LoaderState* stp) ep->addressv[erts_staging_code_ix()] = address; } else { /* - * Don't make any of the exported functions - * callable yet. + * on_load: Don't make any of the exported functions + * callable yet. Keep any function in the current + * code callable. */ - ep->addressv[erts_staging_code_ix()] = ep->code+3; ep->code[4] = (BeamInstr) address; } } @@ -6421,7 +6475,8 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) * Insert the module in the module table. */ - rval = insert_new_code(p, 0, p->group_leader, Mod, code_hdr, code_size); + rval = stub_insert_new_code(p, 0, p->group_leader, Mod, + code_hdr, code_size); if (rval != NIL) { goto error; } diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index ed5b2983dd..9d6dfefa3c 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1569,7 +1569,32 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P, scb->n = 0; } - scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, scb); +#ifdef HIPE + if (rp->flags & F_HIPE_MODE) { + ASSERT(!ERTS_PROC_GET_SAVED_CALLS_BUF(rp)); + scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(rp, scb); + } + else +#endif + { +#ifdef HIPE + ASSERT(!ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(rp)); +#endif + scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, scb); + if (rp == BIF_P && ((scb && i == 0) || (!scb && i != 0))) { + /* Adjust fcalls to match save calls setting... */ + if (i == 0) + BIF_P->fcalls += CONTEXT_REDS; /* disabled it */ + else + BIF_P->fcalls -= CONTEXT_REDS; /* enabled it */ + + /* + * Make sure we reschedule immediately so the + * change take effect at once. + */ + ERTS_VBUMP_ALL_REDS(BIF_P); + } + } if (!scb) old_value = make_small(0); @@ -1578,12 +1603,7 @@ static BIF_RETTYPE process_flag_aux(Process *BIF_P, erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb); } - /* Make sure the process in question is rescheduled - immediately, if it's us, so the call saving takes effect. */ - if (rp == BIF_P) - BIF_RET2(old_value, CONTEXT_REDS); - else - BIF_RET(old_value); + BIF_RET(old_value); } error: @@ -1736,7 +1756,9 @@ BIF_RETTYPE process_flag_2(BIF_ALIST_2) ERTS_TRACE_FLAGS(BIF_P) &= ~F_SENSITIVE; } erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR); - BIF_RET(old_value); + /* make sure to bump all reds so that we get + rescheduled immediately so setting takes effect */ + BIF_RET2(old_value, CONTEXT_REDS); } else if (BIF_ARG_1 == am_monitor_nodes) { /* @@ -1775,10 +1797,18 @@ BIF_RETTYPE process_flag_3(BIF_ALIST_3) Process *rp; Eterm res; - if ((rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, - BIF_ARG_1, ERTS_PROC_LOCK_MAIN)) == NULL) { +#ifdef ERTS_SMP + rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_1, ERTS_PROC_LOCK_MAIN); + if (rp == ERTS_PROC_LOCK_BUSY) + ERTS_BIF_YIELD3(bif_export[BIF_process_flag_3], BIF_P, + BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); +#else + rp = erts_proc_lookup(BIF_ARG_1); +#endif + + if (!rp) BIF_ERROR(BIF_P, BADARG); - } res = process_flag_aux(BIF_P, rp, BIF_ARG_2, BIF_ARG_3); diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index 546e3830b9..5d751dd67d 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -52,6 +52,7 @@ extern Export *erts_convert_time_unit_trap; (p)->fcalls = 0; \ else \ (p)->fcalls = -CONTEXT_REDS; \ + ASSERT(ERTS_BIF_REDS_LEFT((p)) == 0); \ } while(0) #define ERTS_VBUMP_ALL_REDS_INTERNAL(p, fcalls) \ diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 58cd31cee9..872f0f9b2a 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -652,6 +652,8 @@ bif erts_debug:size_shared/1 bif erts_debug:copy_shared/1 bif erlang:has_prepared_code_on_load/1 +bif maps:take/2 + # # Obsolete # diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 4f5e80f2e5..d02c6828f9 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -347,8 +347,11 @@ print_process_info(int to, void *to_arg, Process *p) static void print_garb_info(int to, void *to_arg, Process* p) { +#ifdef ERTS_SMP /* ERTS_SMP: A scheduler is probably concurrently doing gc... */ -#ifndef ERTS_SMP + if (!ERTS_IS_CRASH_DUMPING) + return; +#endif erts_print(to, to_arg, "New heap start: %bpX\n", p->heap); erts_print(to, to_arg, "New heap top: %bpX\n", p->htop); erts_print(to, to_arg, "Stack top: %bpX\n", p->stop); @@ -356,7 +359,6 @@ print_garb_info(int to, void *to_arg, Process* p) erts_print(to, to_arg, "Old heap start: %bpX\n", OLD_HEAP(p)); erts_print(to, to_arg, "Old heap top: %bpX\n", OLD_HTOP(p)); erts_print(to, to_arg, "Old heap end: %bpX\n", OLD_HEND(p)); -#endif } void diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 52fd57e101..277e0668a2 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -1967,7 +1967,7 @@ dist_port_command(Port *prt, ErtsDistOutputBuf *obuf) ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if (size > (Uint) INT_MAX) - erts_exit(ERTS_ABORT_EXIT, + erts_exit(ERTS_DUMP_EXIT, "Absurdly large distribution output data buffer " "(%beu bytes) passed.\n", size); @@ -2007,7 +2007,7 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf) ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); if (size > (Uint) INT_MAX) - erts_exit(ERTS_ABORT_EXIT, + erts_exit(ERTS_DUMP_EXIT, "Absurdly large distribution output data buffer " "(%beu bytes) passed.\n", size); diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index 4d6d699d9f..84254af0c2 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -283,10 +283,10 @@ static ERTS_INLINE void async_add(ErtsAsync *a, ErtsAsyncQ* q) erts_thr_q_enqueue(&q->thr_q, a); #ifdef USE_LTTNG_VM_TRACEPOINTS - if (LTTNG_ENABLED(aio_pool_add)) { + if (LTTNG_ENABLED(aio_pool_put)) { lttng_decl_portbuf(port_str); lttng_portid_to_str(a->port, port_str); - LTTNG2(aio_pool_add, port_str, -1); + LTTNG2(aio_pool_put, port_str, -1); } #endif #ifdef USE_VM_PROBES diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index c9741b361f..99fe847ba2 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -1359,9 +1359,10 @@ process_info_aux(Process *BIF_P, total_heap_size += rp->mbuf_sz; - for (mp = rp->msg.first; mp; mp = mp->next) - if (mp->data.attached) - total_heap_size += erts_msg_attached_data_size(mp); + if (rp->flags & F_ON_HEAP_MSGQ) + for (mp = rp->msg.first; mp; mp = mp->next) + if (mp->data.attached) + total_heap_size += erts_msg_attached_data_size(mp); (void) erts_bld_uint(NULL, &hsz, total_heap_size); hp = HAlloc(BIF_P, hsz); diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 4698458521..e21fba6bf1 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -116,7 +116,7 @@ static Eterm *full_sweep_heaps(Process *p, char *oh, Uint oh_size, Eterm *objv, int nobj); static int garbage_collect(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj); + int need, Eterm* objv, int nobj, int fcalls); static int major_collection(Process* p, ErlHeapFragment *live_hf_end, int need, Eterm* objv, int nobj, Uint *recl); static int minor_collection(Process* p, ErlHeapFragment *live_hf_end, @@ -392,15 +392,15 @@ erts_gc_after_bif_call_lhf(Process* p, ErlHeapFragment *live_hf_end, regs = ERTS_PROC_GET_SCHDATA(p)->x_reg_array; } #endif - cost = garbage_collect(p, live_hf_end, 0, regs, p->arity); + cost = garbage_collect(p, live_hf_end, 0, regs, p->arity, p->fcalls); } else { - cost = garbage_collect(p, live_hf_end, 0, regs, arity); + cost = garbage_collect(p, live_hf_end, 0, regs, arity, p->fcalls); } } else { Eterm val[1]; val[0] = result; - cost = garbage_collect(p, live_hf_end, 0, val, 1); + cost = garbage_collect(p, live_hf_end, 0, val, 1, p->fcalls); result = val[0]; } BUMP_REDS(p, cost); @@ -431,7 +431,7 @@ static ERTS_INLINE void reset_active_writer(Process *p) #define ERTS_ABANDON_HEAP_COST 10 static int -delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need) +delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need, int fcalls) { ErlHeapFragment *hfrag; Eterm *orig_heap, *orig_hend, *orig_htop, *orig_stop; @@ -506,12 +506,16 @@ delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need) /* Make sure that we do a proper GC as soon as possible... */ p->flags |= F_FORCE_GC; - reds_left = ERTS_BIF_REDS_LEFT(p); + reds_left = ERTS_REDS_LEFT(p, fcalls); + ASSERT(CONTEXT_REDS - reds_left >= ERTS_PROC_GET_SCHDATA(p)->virtual_reds); + if (reds_left > ERTS_ABANDON_HEAP_COST) { int vreds = reds_left - ERTS_ABANDON_HEAP_COST; - ERTS_VBUMP_REDS(p, vreds); + ERTS_PROC_GET_SCHDATA((p))->virtual_reds += vreds; } - return ERTS_ABANDON_HEAP_COST; + + ASSERT(CONTEXT_REDS >= ERTS_PROC_GET_SCHDATA(p)->virtual_reds); + return reds_left; } static ERTS_FORCE_INLINE Uint @@ -570,7 +574,7 @@ young_gen_usage(Process *p) */ static int garbage_collect(Process* p, ErlHeapFragment *live_hf_end, - int need, Eterm* objv, int nobj) + int need, Eterm* objv, int nobj, int fcalls) { Uint reclaimed_now = 0; int reds; @@ -581,8 +585,11 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); #endif + ASSERT(CONTEXT_REDS - ERTS_REDS_LEFT(p, fcalls) + >= ERTS_PROC_GET_SCHDATA(p)->virtual_reds); + if (p->flags & (F_DISABLE_GC|F_DELAY_GC)) - return delay_garbage_collection(p, live_hf_end, need); + return delay_garbage_collection(p, live_hf_end, need, fcalls); if (p->abandoned_heap) live_hf_end = ERTS_INVALID_HFRAG_PTR; @@ -593,10 +600,6 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, esdp = erts_get_scheduler_data(); - if (IS_TRACED_FL(p, F_TRACE_GC)) { - trace_gc(p, am_gc_start); - } - erts_smp_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); if (erts_system_monitor_long_gc != 0) start_time = erts_get_monotonic_time(esdp); @@ -619,18 +622,29 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, */ if (GEN_GCS(p) < MAX_GEN_GCS(p) && !(FLAGS(p) & F_NEED_FULLSWEEP)) { - DTRACE2(gc_minor_start, pidbuf, need); - reds = minor_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); - DTRACE2(gc_minor_end, pidbuf, reclaimed_now); - if (reds < 0) - goto do_major_collection; - } - else { - do_major_collection: + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_minor_start, need); + } + DTRACE2(gc_minor_start, pidbuf, need); + reds = minor_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); + DTRACE2(gc_minor_end, pidbuf, reclaimed_now); + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_minor_end, reclaimed_now); + } + if (reds < 0) + goto do_major_collection; + } else { +do_major_collection: ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC_FULL); - DTRACE2(gc_major_start, pidbuf, need); - reds = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); - DTRACE2(gc_major_end, pidbuf, reclaimed_now); + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_major_start, need); + } + DTRACE2(gc_major_start, pidbuf, need); + reds = major_collection(p, live_hf_end, need, objv, nobj, &reclaimed_now); + DTRACE2(gc_major_end, pidbuf, reclaimed_now); + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_major_end, reclaimed_now); + } ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_GC); } @@ -646,10 +660,6 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, erts_smp_atomic32_read_band_nob(&p->state, ~ERTS_PSFLG_GC); - if (IS_TRACED_FL(p, F_TRACE_GC)) { - trace_gc(p, am_gc_end); - } - if (erts_system_monitor_long_gc != 0) { ErtsMonotonicTime end_time; Uint gc_time; @@ -700,16 +710,23 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end, } int -erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj) +erts_garbage_collect_nobump(Process* p, int need, Eterm* objv, int nobj, int fcalls) { - return garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj); + int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, fcalls); + int reds_left = ERTS_REDS_LEFT(p, fcalls); + if (reds > reds_left) + reds = reds_left; + ASSERT(CONTEXT_REDS - (reds_left - reds) >= ERTS_PROC_GET_SCHDATA(p)->virtual_reds); + return reds; } void erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) { - int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj); + int reds = garbage_collect(p, ERTS_INVALID_HFRAG_PTR, need, objv, nobj, p->fcalls); BUMP_REDS(p, reds); + ASSERT(CONTEXT_REDS - ERTS_BIF_REDS_LEFT(p) + >= ERTS_PROC_GET_SCHDATA(p)->virtual_reds); } /* @@ -3006,10 +3023,30 @@ erts_process_gc_info(Process *p, Uint *sizep, Eterm **hpp) }; Eterm res = THE_NON_VALUE; + ErtsMessage *mp; ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == sizeof(tags)/sizeof(*tags)); ERTS_CT_ASSERT(sizeof(values)/sizeof(*values) == ERTS_PROCESS_GC_INFO_MAX_TERMS); + if (p->abandoned_heap) { + Eterm *htop, *heap; + ERTS_GET_ORIG_HEAP(p, heap, htop); + values[3] = HIGH_WATER(p) - heap; + values[6] = htop - heap; + } + + if (p->flags & F_ON_HEAP_MSGQ) { + /* If on heap messages in the internal queue are counted + as being part of the heap, so we have to add them to the + am_mbuf_size value. process_info(total_heap_size) should + be the same as adding old_heap_block_size + heap_block_size + + mbuf_size. + */ + for (mp = p->msg.first; mp; mp = mp->next) + if (mp->data.attached) + values[2] += erts_msg_attached_data_size(mp); + } + res = erts_bld_atom_uword_2tup_list(hpp, sizep, sizeof(values)/sizeof(*values), diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h index 40b7c5d12c..8a6ff99990 100644 --- a/erts/emulator/beam/erl_gc.h +++ b/erts/emulator/beam/erl_gc.h @@ -139,7 +139,7 @@ Eterm erts_process_gc_info(struct process*, Uint *, Eterm **); void erts_gc_info(ErtsGCInfo *gcip); void erts_init_gc(void); -int erts_garbage_collect_nobump(struct process*, int, Eterm*, int); +int erts_garbage_collect_nobump(struct process*, int, Eterm*, int, int); void erts_garbage_collect(struct process*, int, Eterm*, int); void erts_garbage_collect_hibernate(struct process* p); Eterm erts_gc_after_bif_call_lhf(struct process* p, ErlHeapFragment *live_hf_end, diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index dec9bdfedc..fcd2739ac3 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -206,15 +206,15 @@ int erts_no_line_info = 0; /* -L: Don't load line information */ ErtsModifiedTimings erts_modified_timings[] = { /* 0 */ {make_small(0), CONTEXT_REDS, INPUT_REDUCTIONS}, - /* 1 */ {make_small(0), 2*CONTEXT_REDS, 2*INPUT_REDUCTIONS}, + /* 1 */ {make_small(0), (3*CONTEXT_REDS)/4, 2*INPUT_REDUCTIONS}, /* 2 */ {make_small(0), CONTEXT_REDS/2, INPUT_REDUCTIONS/2}, - /* 3 */ {make_small(0), 3*CONTEXT_REDS, 3*INPUT_REDUCTIONS}, + /* 3 */ {make_small(0), (7*CONTEXT_REDS)/8, 3*INPUT_REDUCTIONS}, /* 4 */ {make_small(0), CONTEXT_REDS/3, 3*INPUT_REDUCTIONS}, - /* 5 */ {make_small(0), 4*CONTEXT_REDS, INPUT_REDUCTIONS/2}, + /* 5 */ {make_small(0), (10*CONTEXT_REDS)/11, INPUT_REDUCTIONS/2}, /* 6 */ {make_small(1), CONTEXT_REDS/4, 2*INPUT_REDUCTIONS}, - /* 7 */ {make_small(1), 5*CONTEXT_REDS, INPUT_REDUCTIONS/3}, + /* 7 */ {make_small(1), (5*CONTEXT_REDS)/7, INPUT_REDUCTIONS/3}, /* 8 */ {make_small(10), CONTEXT_REDS/5, 3*INPUT_REDUCTIONS}, - /* 9 */ {make_small(10), 6*CONTEXT_REDS, INPUT_REDUCTIONS/4} + /* 9 */ {make_small(10), (6*CONTEXT_REDS)/7, INPUT_REDUCTIONS/4} }; #define ERTS_MODIFIED_TIMING_LEVELS \ @@ -578,6 +578,8 @@ void erts_usage(void) VH_DEFAULT_SIZE); erts_fprintf(stderr, "-hpds size initial process dictionary size (default %d)\n", erts_pd_initial_size); + erts_fprintf(stderr, "-hmqd val set default message queue data flag for processes,\n"); + erts_fprintf(stderr, " valid values are: off_heap | on_heap | mixed\n"); /* erts_fprintf(stderr, "-i module set the boot module (default init)\n"); */ @@ -655,8 +657,6 @@ void erts_usage(void) erts_fprintf(stderr, "-W<i|w|e> set error logger warnings mapping,\n"); erts_fprintf(stderr, " see error_logger documentation for details\n"); - erts_fprintf(stderr, "-xmqd val set default message queue data flag for processes,\n"); - erts_fprintf(stderr, " valid values are: off_heap | on_heap | mixed\n"); erts_fprintf(stderr, "-zdbbl size set the distribution buffer busy limit in kilobytes\n"); erts_fprintf(stderr, " valid range is [1-%d]\n", INT_MAX/1024); erts_fprintf(stderr, "-zdntgc time set delayed node table gc in seconds\n"); @@ -1487,6 +1487,7 @@ erl_start(int argc, char **argv) * h|ms - min_heap_size * h|mbs - min_bin_vheap_size * h|pds - erts_pd_initial_size + * h|mqd - message_queue_data * */ if (has_prefix("mbs", sub_param)) { @@ -1512,6 +1513,23 @@ erl_start(int argc, char **argv) } VERBOSE(DEBUG_SYSTEM, ("using initial process dictionary size %d\n", erts_pd_initial_size)); + } else if (has_prefix("mqd", sub_param)) { + arg = get_arg(sub_param+3, argv[i+1], &i); + if (sys_strcmp(arg, "mixed") == 0) + erts_default_spo_flags &= ~(SPO_ON_HEAP_MSGQ|SPO_OFF_HEAP_MSGQ); + else if (sys_strcmp(arg, "on_heap") == 0) { + erts_default_spo_flags &= ~SPO_OFF_HEAP_MSGQ; + erts_default_spo_flags |= SPO_ON_HEAP_MSGQ; + } + else if (sys_strcmp(arg, "off_heap") == 0) { + erts_default_spo_flags &= ~SPO_ON_HEAP_MSGQ; + erts_default_spo_flags |= SPO_OFF_HEAP_MSGQ; + } + else { + erts_fprintf(stderr, + "Invalid message_queue_data flag: %s\n", arg); + erts_usage(); + } } else { /* backward compatibility */ arg = get_arg(argv[i]+2, argv[i+1], &i); @@ -2047,32 +2065,6 @@ erl_start(int argc, char **argv) } break; - case 'x': { - char *sub_param = argv[i]+2; - if (has_prefix("mqd", sub_param)) { - arg = get_arg(sub_param+3, argv[i+1], &i); - if (sys_strcmp(arg, "mixed") == 0) - erts_default_spo_flags &= ~(SPO_ON_HEAP_MSGQ|SPO_OFF_HEAP_MSGQ); - else if (sys_strcmp(arg, "on_heap") == 0) { - erts_default_spo_flags &= ~SPO_OFF_HEAP_MSGQ; - erts_default_spo_flags |= SPO_ON_HEAP_MSGQ; - } - else if (sys_strcmp(arg, "off_heap") == 0) { - erts_default_spo_flags &= ~SPO_ON_HEAP_MSGQ; - erts_default_spo_flags |= SPO_OFF_HEAP_MSGQ; - } - else { - erts_fprintf(stderr, - "Invalid message_queue_data flag: %s\n", arg); - erts_usage(); - } - } else { - erts_fprintf(stderr, "bad -x option %s\n", argv[i]); - erts_usage(); - } - break; - } - case 'z': { char *sub_param = argv[i]+2; diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c index 03a96cb00a..8efc983f04 100644 --- a/erts/emulator/beam/erl_map.c +++ b/erts/emulator/beam/erl_map.c @@ -54,6 +54,7 @@ * - maps:new/0 * - maps:put/3 * - maps:remove/2 + * - maps:take/2 * - maps:to_list/1 * - maps:update/3 * - maps:values/1 @@ -93,7 +94,7 @@ static Uint hashmap_subtree_size(Eterm node); static Eterm hashmap_to_list(Process *p, Eterm map); static Eterm hashmap_keys(Process *p, Eterm map); static Eterm hashmap_values(Process *p, Eterm map); -static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm node); +static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm node, Eterm *value); static Eterm flatmap_from_validated_list(Process *p, Eterm list, Uint size); static Eterm hashmap_from_validated_list(Process *p, Eterm list, Uint size); static Eterm hashmap_from_unsorted_array(ErtsHeapFactory*, hxnode_t *hxns, Uint n, int reject_dupkeys); @@ -1521,10 +1522,45 @@ BIF_RETTYPE maps_put_3(BIF_ALIST_3) { BIF_ERROR(BIF_P, BADMAP); } -/* maps:remove/3 */ +/* maps:take/2 */ -int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { +BIF_RETTYPE maps_take_2(BIF_ALIST_2) { + if (is_map(BIF_ARG_2)) { + Eterm res, map, val; + if (erts_maps_take(BIF_P, BIF_ARG_1, BIF_ARG_2, &map, &val)) { + Eterm *hp = HAlloc(BIF_P, 3); + res = make_tuple(hp); + *hp++ = make_arityval(2); + *hp++ = val; + *hp++ = map; + BIF_RET(res); + } + BIF_RET(am_error); + } + BIF_P->fvalue = BIF_ARG_2; + BIF_ERROR(BIF_P, BADMAP); +} + +/* maps:remove/2 */ + +BIF_RETTYPE maps_remove_2(BIF_ALIST_2) { + if (is_map(BIF_ARG_2)) { + Eterm res; + (void) erts_maps_take(BIF_P, BIF_ARG_1, BIF_ARG_2, &res, NULL); + BIF_RET(res); + } + BIF_P->fvalue = BIF_ARG_2; + BIF_ERROR(BIF_P, BADMAP); +} + +/* erts_maps_take + * return 1 if key is found, otherwise 0 + * If the key is not found res (output map) will be map (input map) + */ +int erts_maps_take(Process *p, Eterm key, Eterm map, + Eterm *res, Eterm *value) { Uint32 hx; + Eterm ret; if (is_flatmap(map)) { Sint n; Uint need; @@ -1537,7 +1573,7 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { if (n == 0) { *res = map; - return 1; + return 0; } ks = flatmap_get_keys(mp); @@ -1564,6 +1600,7 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { if (is_immed(key)) { while (1) { if (*ks == key) { + if (value) *value = *vs; goto found_key; } else if (--n) { *mhp++ = *vs++; @@ -1574,6 +1611,7 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { } else { while(1) { if (EQ(*ks, key)) { + if (value) *value = *vs; goto found_key; } else if (--n) { *mhp++ = *vs++; @@ -1589,7 +1627,7 @@ int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res) { HRelease(p, hp_start + need, hp_start); *res = map; - return 1; + return 0; found_key: /* Copy rest of keys and values */ @@ -1601,19 +1639,13 @@ found_key: } ASSERT(is_hashmap(map)); hx = hashmap_make_hash(key); - *res = hashmap_delete(p, hx, key, map); - return 1; -} - -BIF_RETTYPE maps_remove_2(BIF_ALIST_2) { - if (is_map(BIF_ARG_2)) { - Eterm res; - if (erts_maps_remove(BIF_P, BIF_ARG_1, BIF_ARG_2, &res)) { - BIF_RET(res); - } + ret = hashmap_delete(p, hx, key, map, value); + if (is_value(ret)) { + *res = ret; + return 1; } - BIF_P->fvalue = BIF_ARG_2; - BIF_ERROR(BIF_P, BADMAP); + *res = map; + return 0; } int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res) { @@ -2322,7 +2354,8 @@ static Eterm hashmap_values(Process* p, Eterm node) { return res; } -static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) { +static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, + Eterm map, Eterm *value) { Eterm *hp = NULL, *nhp = NULL, *hp_end = NULL; Eterm *ptr; Eterm hdr, res = map, node = map; @@ -2337,8 +2370,12 @@ static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) { switch(primary_tag(node)) { case TAG_PRIMARY_LIST: if (EQ(CAR(list_val(node)), key)) { + if (value) { + *value = CDR(list_val(node)); + } goto unroll; } + res = THE_NON_VALUE; goto not_found; case TAG_PRIMARY_BOXED: ptr = boxed_val(node); @@ -2365,6 +2402,7 @@ static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) { n = hashmap_bitcount(hval); } else { /* not occupied */ + res = THE_NON_VALUE; goto not_found; } @@ -2394,6 +2432,7 @@ static Eterm hashmap_delete(Process *p, Uint32 hx, Eterm key, Eterm map) { break; } /* not occupied */ + res = THE_NON_VALUE; goto not_found; default: erts_exit(ERTS_ERROR_EXIT, "bad header tag %ld\r\n", hdr & _HEADER_MAP_SUBTAG_MASK); diff --git a/erts/emulator/beam/erl_map.h b/erts/emulator/beam/erl_map.h index 7af9100906..8b5c9582ba 100644 --- a/erts/emulator/beam/erl_map.h +++ b/erts/emulator/beam/erl_map.h @@ -82,6 +82,7 @@ struct ErtsEStack_; Eterm erts_maps_put(Process *p, Eterm key, Eterm value, Eterm map); int erts_maps_update(Process *p, Eterm key, Eterm value, Eterm map, Eterm *res); int erts_maps_remove(Process *p, Eterm key, Eterm map, Eterm *res); +int erts_maps_take(Process *p, Eterm key, Eterm map, Eterm *res, Eterm *value); Eterm erts_hashmap_insert(Process *p, Uint32 hx, Eterm key, Eterm value, Eterm node, int is_update); diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 73c0eb8eba..dc83a780a2 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -2443,14 +2443,13 @@ int enif_make_map_remove(ErlNifEnv* env, Eterm key, Eterm *map_out) { - int res; if (!is_map(map_in)) { return 0; } flush_env(env); - res = erts_maps_remove(env->proc, key, map_in, map_out); + (void) erts_maps_take(env->proc, key, map_in, map_out, NULL); cache_env(env); - return res; + return 1; } int enif_map_iterator_create(ErlNifEnv *env, @@ -2781,7 +2780,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) ErlNifEntry* entry = NULL; ErlNifEnv env; int i, err, encoding; - Module* mod; + Module* module_p; Eterm mod_atom; const Atom* mod_atomp; Eterm f_atom; @@ -2791,6 +2790,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) int veto; struct erl_module_nif* lib = NULL; int reload_warning = 0; + struct erl_module_instance* this_mi; + struct erl_module_instance* prev_mi; encoding = erts_get_native_filename_encoding(); if (encoding == ERL_FILENAME_WIN_WCHAR) { @@ -2824,21 +2825,29 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) ASSERT(caller != NULL); mod_atom = caller[0]; ASSERT(is_atom(mod_atom)); - mod=erts_get_module(mod_atom, erts_active_code_ix()); - ASSERT(mod != NULL); + module_p = erts_get_module(mod_atom, erts_active_code_ix()); + ASSERT(module_p != NULL); mod_atomp = atom_tab(atom_val(mod_atom)); init_func = erts_static_nif_get_nif_init((char*)mod_atomp->name, mod_atomp->len); if (init_func != NULL) handle = init_func; - if (!in_area(caller, mod->curr.code_hdr, mod->curr.code_length)) { - ASSERT(in_area(caller, mod->old.code_hdr, mod->old.code_length)); + if (in_area(caller, module_p->old.code_hdr, module_p->old.code_length)) { + if (module_p->old.code_hdr->on_load_function_ptr) { + this_mi = &module_p->old; + prev_mi = &module_p->curr; + } else { + ret = load_nif_error(BIF_P, "old_code", "Calling load_nif from old " + "module '%T' not allowed", mod_atom); + goto error; + } + } else { + this_mi = &module_p->curr; + prev_mi = &module_p->old; + } - ret = load_nif_error(BIF_P, "old_code", "Calling load_nif from old " - "module '%T' not allowed", mod_atom); - } - else if (init_func == NULL && + if (init_func == NULL && (err=erts_sys_ddll_open(lib_name, &handle, &errdesc)) != ERL_DE_NO_ERROR) { const char slogan[] = "Failed to load NIF library"; if (strstr(errdesc.str, lib_name) != NULL) { @@ -2887,7 +2896,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) for (i=0; i < entry->num_of_funcs && ret==am_ok; i++) { BeamInstr** code_pp; if (!erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1) - || (code_pp = get_func_pp(mod->curr.code_hdr, f_atom, f->arity))==NULL) { + || (code_pp = get_func_pp(this_mi->code_hdr, f_atom, f->arity))==NULL) { ret = load_nif_error(BIF_P,bad_lib,"Function not found %T:%s/%u", mod_atom, f->name, f->arity); } @@ -2938,9 +2947,9 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) erts_refc_init(&lib->rt_cnt, 0); erts_refc_init(&lib->rt_dtor_cnt, 0); ASSERT(opened_rt_list == NULL); - lib->mod = mod; + lib->mod = module_p; env.mod_nif = lib; - if (mod->curr.nif != NULL) { /*************** Reload ******************/ + if (this_mi->nif != NULL) { /*************** Reload ******************/ /* * Repeated load_nif calls from same Erlang module instance ("reload") * is deprecated and was only ment as a development feature not to @@ -2948,16 +2957,16 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) */ int k, old_incr = 0; ErlNifFunc* old_func; - lib->priv_data = mod->curr.nif->priv_data; + lib->priv_data = this_mi->nif->priv_data; - ASSERT(mod->curr.nif->entry != NULL); + ASSERT(this_mi->nif->entry != NULL); if (entry->reload == NULL) { ret = load_nif_error(BIF_P,reload,"Reload not supported by this NIF library."); goto error; } /* Check that no NIF is removed */ - old_func = mod->curr.nif->entry->funcs; - for (k=0; k < mod->curr.nif->entry->num_of_funcs; k++) { + old_func = this_mi->nif->entry->funcs; + for (k=0; k < this_mi->nif->entry->num_of_funcs; k++) { int incr = 0; ErlNifFunc* f = entry->funcs; for (i=0; i < entry->num_of_funcs; i++) { @@ -2973,7 +2982,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) old_func->name, old_func->arity); goto error; } - old_func = next_func(mod->curr.nif->entry, &old_incr, old_func); + old_func = next_func(this_mi->nif->entry, &old_incr, old_func); } erts_pre_nif(&env, BIF_P, lib, NULL); veto = entry->reload(&env, &lib->priv_data, BIF_ARG_2); @@ -2983,24 +2992,24 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) } else { commit_opened_resource_types(lib); - mod->curr.nif->entry = NULL; /* to prevent 'unload' callback */ - erts_unload_nif(mod->curr.nif); + this_mi->nif->entry = NULL; /* to prevent 'unload' callback */ + erts_unload_nif(this_mi->nif); reload_warning = 1; } } else { lib->priv_data = NULL; - if (mod->old.nif != NULL) { /**************** Upgrade ***************/ - void* prev_old_data = mod->old.nif->priv_data; + if (prev_mi->nif != NULL) { /**************** Upgrade ***************/ + void* prev_old_data = prev_mi->nif->priv_data; if (entry->upgrade == NULL) { ret = load_nif_error(BIF_P, upgrade, "Upgrade not supported by this NIF library."); goto error; } - erts_pre_nif(&env, BIF_P, lib, NULL); - veto = entry->upgrade(&env, &lib->priv_data, &mod->old.nif->priv_data, BIF_ARG_2); + erts_pre_nif(&env, BIF_P, lib, NULL); + veto = entry->upgrade(&env, &lib->priv_data, &prev_mi->nif->priv_data, BIF_ARG_2); erts_post_nif(&env); if (veto) { - mod->old.nif->priv_data = prev_old_data; + prev_mi->nif->priv_data = prev_old_data; ret = load_nif_error(BIF_P, upgrade, "Library upgrade-call unsuccessful."); } else @@ -3025,12 +3034,12 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) int incr = 0; ErlNifFunc* f = entry->funcs; - mod->curr.nif = lib; + this_mi->nif = lib; for (i=0; i < entry->num_of_funcs; i++) { BeamInstr* code_ptr; erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1); - code_ptr = *get_func_pp(mod->curr.code_hdr, f_atom, f->arity); + code_ptr = *get_func_pp(this_mi->code_hdr, f_atom, f->arity); if (code_ptr[1] == 0) { code_ptr[5+0] = (BeamInstr) BeamOp(op_call_nif); @@ -3158,7 +3167,7 @@ Eterm erts_nif_call_function(Process *p, Process *tracee, /* Verify that function is part of this module */ int i; for (i = 0; i < mod->entry->num_of_funcs; i++) - if (fun == mod->entry->funcs+i) + if (fun == &(mod->entry->funcs[i])) break; ASSERT(i < mod->entry->num_of_funcs); if (p) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index d485affa3b..bc32f3f167 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -6688,10 +6688,8 @@ schedule_process_sys_task(Process *p, erts_aint32_t prio, ErtsProcSysTask *st) erts_aint32_t e; n = e = a; - if (a & ERTS_PSFLG_FREE) { - res = 0; + if (a & ERTS_PSFLG_FREE) goto cleanup; /* We don't want to schedule free processes... */ - } enqueue = ERTS_ENQUEUE_NOT; n |= ERTS_PSFLG_ACTIVE_SYS; @@ -9240,6 +9238,21 @@ erts_set_process_priority(Process *p, Eterm value) } } +static int +scheduler_gc_proc(Process *c_p, int reds_left) +{ + int fcalls, reds; + if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) + fcalls = reds_left; + else + fcalls = reds_left - CONTEXT_REDS; + reds = erts_garbage_collect_nobump(c_p, 0, c_p->arg_reg, c_p->arity, fcalls); + ASSERT(reds_left >= reds); + return reds; +} + + + /* * schedule() is called from BEAM (process_main()) or HiPE * (hipe_mode_switch()) when the current process is to be @@ -9318,6 +9331,7 @@ Process *schedule(Process *p, int calls) #endif reds = actual_reds = calls - esdp->virtual_reds; + ASSERT(actual_reds >= 0); if (reds < ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST) reds = ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST; esdp->virtual_reds = 0; @@ -9740,7 +9754,7 @@ Process *schedule(Process *p, int calls) esdp->current_process = p; - + calls = 0; reds = context_reds; #ifdef ERTS_SMP @@ -9819,9 +9833,7 @@ Process *schedule(Process *p, int calls) /* Migrate to dirty scheduler... */ sunlock_sched_out_proc: erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - p->fcalls = reds; goto sched_out_proc; - } } else { @@ -9856,8 +9868,6 @@ Process *schedule(Process *p, int calls) #endif /* ERTS_SMP */ - p->fcalls = reds; - erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); if (IS_TRACED(p)) { @@ -9890,14 +9900,15 @@ Process *schedule(Process *p, int calls) * not allowed to execute system tasks. */ if (!(p->flags & F_DELAY_GC)) { - reds -= execute_sys_tasks(p, &state, reds); + int cost = execute_sys_tasks(p, &state, reds); + calls += cost; + reds -= cost; if (reds <= 0 #ifdef ERTS_DIRTY_SCHEDULERS || ERTS_SCHEDULER_IS_DIRTY(esdp) || (state & ERTS_PSFLGS_DIRTY_WORK) #endif ) { - p->fcalls = reds; goto sched_out_proc; } } @@ -9910,8 +9921,9 @@ Process *schedule(Process *p, int calls) if (((state & (ERTS_PSFLG_SUSPENDED | ERTS_PSFLG_ACTIVE)) != ERTS_PSFLG_ACTIVE) - && !(state & ERTS_PSFLG_EXITING)) + && !(state & ERTS_PSFLG_EXITING)) { goto sched_out_proc; + } n = e = state; n &= ~ERTS_PSFLG_RUNNING_SYS; @@ -9930,11 +9942,11 @@ Process *schedule(Process *p, int calls) if (ERTS_IS_GC_DESIRED(p)) { if (!(state & ERTS_PSFLG_EXITING) && !(p->flags & (F_DELAY_GC|F_DISABLE_GC))) { - reds -= erts_garbage_collect_nobump(p, 0, p->arg_reg, p->arity); - if (reds <= 0) { - p->fcalls = reds; + int cost = scheduler_gc_proc(p, reds); + calls += cost; + reds -= cost; + if (reds <= 0) goto sched_out_proc; - } } } @@ -9942,6 +9954,8 @@ Process *schedule(Process *p, int calls) free_proxy_proc(proxy_p); proxy_p = NULL; } + + p->fcalls = reds; ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); @@ -10211,21 +10225,24 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) else { if (!garbage_collected) { FLAGS(c_p) |= F_NEED_FULLSWEEP; - reds -= erts_garbage_collect_nobump(c_p, - 0, - c_p->arg_reg, - c_p->arity); + reds -= scheduler_gc_proc(c_p, reds); garbage_collected = 1; } st_res = am_true; } break; case ERTS_PSTT_CPC: { + int fcalls; int cpc_reds = 0; + if (!ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) + fcalls = reds; + else + fcalls = reds - CONTEXT_REDS; st_res = erts_check_process_code(c_p, st->arg[0], unsigned_val(st->arg[1]), - &cpc_reds); + &cpc_reds, + fcalls); reds -= cpc_reds; if (is_non_value(st_res)) { /* Needed gc, but gc was disabled */ @@ -10257,6 +10274,9 @@ execute_sys_tasks(Process *c_p, erts_aint32_t *statep, int in_reds) *statep = state; + if (in_reds < reds) + return in_reds; + return in_reds - reds; } @@ -11482,8 +11502,10 @@ delete_process(Process* p) psd = (ErtsPSD *) erts_smp_atomic_read_nob(&p->psd); - if (psd) + if (psd) { + erts_smp_atomic_set_nob(&p->psd, (erts_aint_t) NULL); /* Reduction counting depends on this... */ erts_free(ERTS_ALC_T_PSD, psd); + } /* Clean binaries and funs */ erts_cleanup_offheap(&p->off_heap); @@ -12577,6 +12599,8 @@ erts_continue_exit_process(Process *p) dep = (p->flags & F_DISTRIBUTION) ? erts_this_dist_entry : NULL; scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL); + if (scb) + p->fcalls += CONTEXT_REDS; /* Reduction counting depends on this... */ pbt = ERTS_PROC_SET_CALL_TIME(p, NULL); nif_export = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, NULL); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 61acf5924b..59da9c1779 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -805,8 +805,15 @@ erts_smp_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi) #define ERTS_PSD_CALL_TIME_BP 3 #define ERTS_PSD_DELAYED_GC_TASK_QS 4 #define ERTS_PSD_NIF_TRAP_EXPORT 5 +#ifdef HIPE +#define ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF 6 +#endif +#ifdef HIPE +#define ERTS_PSD_SIZE 7 +#else #define ERTS_PSD_SIZE 6 +#endif typedef struct { void *data[ERTS_PSD_SIZE]; @@ -925,7 +932,6 @@ struct process { Eterm* stop; /* Stack top */ Eterm* heap; /* Heap start */ Eterm* hend; /* Heap end */ - Eterm* abandoned_heap; Uint heap_sz; /* Size of heap in words */ Uint min_heap_size; /* Minimum size of heap (in words). */ Uint min_vheap_size; /* Minimum size of virtual heap (in words). */ @@ -941,6 +947,16 @@ struct process { #endif /* + * Moved to after "struct hipe_process_state hipe", as a temporary fix for + * LLVM hard-coding offsetof(struct process, hipe.nstack) (sic!) + * (see void X86FrameLowering::adjustForHiPEPrologue(...) in + * lib/Target/X86/X86FrameLowering.cpp). + * + * Used to be below "Eterm* hend". + */ + Eterm* abandoned_heap; + + /* * Saved x registers. */ Uint arity; /* Number of live argument registers (only valid @@ -1071,6 +1087,10 @@ struct process { Uint space_verified; /* Avoid HAlloc forcing heap fragments when */ Eterm* space_verified_from; /* we rely on available heap space (TestHeap) */ #endif + +#ifdef DEBUG + Uint debug_reds_in; +#endif }; extern const Process erts_invalid_process; @@ -1342,6 +1362,7 @@ extern int erts_system_profile_ts_type; #define F_DELAY_GC (1 << 16) /* Similar to disable GC (see below) */ #define F_SCHDLR_ONLN_WAITQ (1 << 17) /* Process enqueued waiting to change schedulers online */ #define F_HAVE_BLCKD_NMSCHED (1 << 18) /* Process has blocked normal multi-scheduling */ +#define F_HIPE_MODE (1 << 19) /* * F_DISABLE_GC and F_DELAY_GC are similar. Both will prevent @@ -1999,6 +2020,13 @@ erts_psd_set(Process *p, int ix, void *data) #define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, NTE) \ erts_psd_set((P), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (NTE)) +#ifdef HIPE +#define ERTS_PROC_GET_SUSPENDED_SAVED_CALLS_BUF(P) \ + ((struct saved_calls *) erts_psd_get((P), ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF)) +#define ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(P, SCB) \ + ((struct saved_calls *) erts_psd_set((P), ERTS_PSD_SUSPENDED_SAVED_CALLS_BUF, (void *) (SCB))) +#endif + ERTS_GLB_INLINE Eterm erts_proc_get_error_handler(Process *p); ERTS_GLB_INLINE Eterm erts_proc_set_error_handler(Process *p, Eterm handler); diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index bd88769dfc..436b4aca21 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -237,6 +237,7 @@ write_timestamp(ErtsTraceTimeStamp *tsp, Eterm **hpp) } } +#ifdef ERTS_SMP #define PATCH_TS_SIZE(p) patch_ts_size(TFLGS_TS_TYPE(p)) static ERTS_INLINE Uint @@ -257,6 +258,7 @@ patch_ts_size(int ts_type) return 0; } } +#endif /* * Write a timestamp. The timestamp MUST be the last @@ -359,25 +361,50 @@ void erts_init_trace(void) { *(OHPP) = &(*(BPP))->off_heap, \ (*(BPP))->mem) +enum ErtsTracerOpt { + TRACE_FUN_DEFAULT = 0, + TRACE_FUN_ENABLED = 1, + TRACE_FUN_T_SEND = 2, + TRACE_FUN_T_RECEIVE = 3, + TRACE_FUN_T_CALL = 4, + TRACE_FUN_T_SCHED_PROC = 5, + TRACE_FUN_T_SCHED_PORT = 6, + TRACE_FUN_T_GC = 7, + TRACE_FUN_T_PROCS = 8, + TRACE_FUN_T_PORTS = 9, + TRACE_FUN_E_SEND = 10, + TRACE_FUN_E_RECEIVE = 11, + TRACE_FUN_E_CALL = 12, + TRACE_FUN_E_SCHED_PROC = 13, + TRACE_FUN_E_SCHED_PORT = 14, + TRACE_FUN_E_GC = 15, + TRACE_FUN_E_PROCS = 16, + TRACE_FUN_E_PORTS = 17 +}; + +#define NIF_TRACER_TYPES (18) + + static ERTS_INLINE int send_to_tracer_nif_raw(Process *c_p, Process *tracee, const ErtsTracer tracer, Uint trace_flags, Eterm t_p_id, ErtsTracerNif *tnif, + enum ErtsTracerOpt topt, Eterm tag, Eterm msg, Eterm extra, Eterm pam_result); static ERTS_INLINE int send_to_tracer_nif(Process *c_p, ErtsPTabElementCommon *t_p, - Eterm t_p_id, ErtsTracerNif *tnif, Eterm tag, - Eterm msg, Eterm extra); + Eterm t_p_id, ErtsTracerNif *tnif, + enum ErtsTracerOpt topt, + Eterm tag, Eterm msg, Eterm extra); static ERTS_INLINE Eterm call_enabled_tracer(Process *c_p, const ErtsTracer tracer, - ErtsTracerNif **tnif_ref, Eterm tag, Eterm t_p_id); + ErtsTracerNif **tnif_ref, + enum ErtsTracerOpt topt, + Eterm tag, Eterm t_p_id); static int -is_tracer_proc_enabled(Process* c_p, ErtsProcLocks c_p_locks, - ErtsPTabElementCommon *t_p, - ErtsTracerNif **tnif_ret, Eterm tag); - -#define SEND_TO_TRACER(c_p, tag, msg) \ - send_to_tracer_nif(c_p, &(c_p)->common, (c_p)->common.id, NULL, tag, \ - msg, THE_NON_VALUE) +is_tracer_enabled(Process* c_p, ErtsProcLocks c_p_locks, + ErtsPTabElementCommon *t_p, + ErtsTracerNif **tnif_ret, + enum ErtsTracerOpt topt, Eterm tag); static Uint active_sched; @@ -433,7 +460,7 @@ erts_set_system_seq_tracer(Process *c_p, ErtsProcLocks c_p_locks, ErtsTracer new if (!ERTS_TRACER_IS_NIL(new)) { Eterm nif_result = call_enabled_tracer( NULL, new, NULL, - am_trace_status, am_undefined); + TRACE_FUN_ENABLED, am_trace_status, am_undefined); switch (nif_result) { case am_trace: break; default: @@ -465,7 +492,8 @@ erts_get_system_seq_tracer(void) erts_smp_rwmtx_runlock(&sys_trace_rwmtx); if (st != erts_tracer_nil && - call_enabled_tracer(NULL, st, NULL, am_trace_status, am_undefined) == am_remove) { + call_enabled_tracer(NULL, st, NULL, TRACE_FUN_ENABLED, + am_trace_status, am_undefined) == am_remove) { erts_set_system_seq_tracer(NULL, 0, erts_tracer_nil); st = erts_tracer_nil; } @@ -484,10 +512,11 @@ get_default_tracing(Uint *flagsp, ErtsTracer *tracerp, if (ERTS_TRACER_IS_NIL(*default_tracer)) { *default_trace_flags &= ~TRACEE_FLAGS; } else { - Eterm nif_result = call_enabled_tracer( - NULL, *default_tracer, NULL, - am_trace_status, am_undefined); - switch (nif_result) { + Eterm nif_res; + nif_res = call_enabled_tracer(NULL, *default_tracer, + NULL, TRACE_FUN_ENABLED, + am_trace_status, am_undefined); + switch (nif_res) { case am_trace: break; default: { ErtsTracer curr_default_tracer = *default_tracer; @@ -629,6 +658,7 @@ do { \ # define GET_NOW(m, s, u) do {get_now(m, s, u);} while (0) #endif + static void write_sys_msg_to_port(Eterm unused_to, Port* trace_port, @@ -737,7 +767,7 @@ trace_sched_aux(Process *p, ErtsProcLocks locks, Eterm what) break; } - if (!is_tracer_proc_enabled(p, locks, &p->common, &tnif, what)) + if (!is_tracer_enabled(p, locks, &p->common, &tnif, TRACE_FUN_E_SCHED_PROC, what)) return; if (ERTS_PROC_IS_EXITING(p)) @@ -756,7 +786,7 @@ trace_sched_aux(Process *p, ErtsProcLocks locks, Eterm what) hp += 4; } - send_to_tracer_nif(p, &p->common, p->common.id, tnif, + send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_SCHED_PROC, what, tmp, THE_NON_VALUE); } @@ -795,8 +825,10 @@ trace_send(Process *p, Eterm to, Eterm msg) operation = am_send_to_non_existing_process; } - if (is_tracer_proc_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif, operation)) - send_to_tracer_nif(p, &p->common, p->common.id, tnif, operation, msg, to); + if (is_tracer_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif, + TRACE_FUN_E_SEND, operation)) + send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_SEND, + operation, msg, to); } /* Send {trace_ts, Pid, receive, Msg, Timestamp} @@ -806,10 +838,11 @@ void trace_receive(Process *c_p, Eterm msg) { ErtsTracerNif *tnif = NULL; - if (is_tracer_proc_enabled(NULL, 0, &c_p->common, - &tnif, am_receive)) + if (is_tracer_enabled(NULL, 0, &c_p->common, &tnif, + TRACE_FUN_E_RECEIVE, am_receive)) send_to_tracer_nif(NULL, &c_p->common, c_p->common.id, - tnif, am_receive, msg, THE_NON_VALUE); + tnif, TRACE_FUN_T_RECEIVE, + am_receive, msg, THE_NON_VALUE); } int @@ -819,8 +852,9 @@ seq_trace_update_send(Process *p) ASSERT((is_tuple(SEQ_TRACE_TOKEN(p)) || is_nil(SEQ_TRACE_TOKEN(p)))); if (have_no_seqtrace(SEQ_TRACE_TOKEN(p)) || (seq_tracer != NIL && - call_enabled_tracer( NULL, seq_tracer, NULL, am_trace_status, - p ? p->common.id : am_undefined) != am_trace) + call_enabled_tracer(NULL, seq_tracer, NULL, + TRACE_FUN_ENABLED, am_trace_status, + p ? p->common.id : am_undefined) != am_trace) #ifdef USE_VM_PROBES || (SEQ_TRACE_TOKEN(p) == am_have_dt_utag) #endif @@ -866,9 +900,10 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, ASSERT(is_tuple(token) || is_nil(token)); if (token == NIL || (process && ERTS_TRACE_FLAGS(process) & F_SENSITIVE) || ERTS_TRACER_IS_NIL(seq_tracer) || - call_enabled_tracer( - NULL, seq_tracer, NULL, am_trace_status, - process ? process->common.id : am_undefined) != am_trace) { + call_enabled_tracer(NULL, seq_tracer, + NULL, TRACE_FUN_ENABLED, + am_trace_status, + process ? process->common.id : am_undefined) != am_trace) { return; } @@ -897,14 +932,13 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, msg = TUPLE3(hp, am_EXIT, exitfrom, msg); hp += 4; } - mess = TUPLE5(hp, type_atom, lastcnt_serial, SEQ_TRACE_T_SENDER(token), - receiver, msg); + mess = TUPLE5(hp, type_atom, lastcnt_serial, SEQ_TRACE_T_SENDER(token), receiver, msg); hp += 6; seq_tracer_flags |= ERTS_SEQTFLGS2TFLGS(unsigned_val(SEQ_TRACE_T_FLAGS(token))); send_to_tracer_nif_raw(NULL, process, seq_tracer, seq_tracer_flags, - label, NULL, am_seq_trace, mess, + label, NULL, TRACE_FUN_DEFAULT, am_seq_trace, mess, THE_NON_VALUE, am_true); UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); @@ -929,7 +963,8 @@ erts_trace_return_to(Process *p, BeamInstr *pc) mfa = TUPLE3(hp, code_ptr[0], code_ptr[1], make_small(code_ptr[2])); } - SEND_TO_TRACER(p, am_return_to, mfa); + send_to_tracer_nif(p, &p->common, p->common.id, NULL, TRACE_FUN_T_CALL, + am_return_to, mfa, THE_NON_VALUE); } @@ -983,7 +1018,7 @@ erts_trace_return(Process* p, BeamInstr* fi, Eterm retval, ErtsTracer *tracer) mfa = TUPLE3(hp, mod, name, make_small(arity)); hp += 4; send_to_tracer_nif_raw(p, NULL, *tracer, *tracee_flags, p->common.id, - NULL, am_return_from, mfa, retval, am_true); + NULL, TRACE_FUN_T_CALL, am_return_from, mfa, retval, am_true); } /* Send {trace_ts, Pid, exception_from, {Mod, Name, Arity}, {Class,Value}, @@ -1038,7 +1073,7 @@ erts_trace_exception(Process* p, BeamInstr mfa[3], Eterm class, Eterm value, cv = TUPLE2(hp, class, value); hp += 3; send_to_tracer_nif_raw(p, NULL, *tracer, *tracee_flags, p->common.id, - NULL, am_exception_from, mfa_tuple, cv, am_true); + NULL, TRACE_FUN_T_CALL, am_exception_from, mfa_tuple, cv, am_true); } /* @@ -1088,7 +1123,8 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, * use process flags */ tracee_flags = &ERTS_TRACE_FLAGS(p); - if (!is_tracer_proc_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif, am_call)) { + if (!is_tracer_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif, + TRACE_FUN_E_CALL, am_call)) { return 0; } } else { @@ -1103,7 +1139,9 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, } meta_flags = F_TRACE_CALLS | F_NOW_TS; tracee_flags = &meta_flags; - switch (call_enabled_tracer(p, *tracer, &tnif, am_call, p->common.id)) { + switch (call_enabled_tracer(p, *tracer, + &tnif, TRACE_FUN_T_CALL, + am_call, p->common.id)) { default: case am_remove: *tracer = erts_tracer_nil; case am_discard: return 0; @@ -1227,7 +1265,7 @@ erts_call_trace(Process* p, BeamInstr mfa[3], Binary *match_spec, * Build the trace tuple and send it to the port. */ send_to_tracer_nif_raw(p, NULL, *tracer, *tracee_flags, p->common.id, - tnif, am_call, mfa_tuple, THE_NON_VALUE, pam_result); + tnif, TRACE_FUN_T_CALL, am_call, mfa_tuple, THE_NON_VALUE, pam_result); erts_match_set_release_result(p); if (match_spec && tracer == &pre_ms_tracer) @@ -1249,8 +1287,9 @@ trace_proc(Process *c_p, ErtsProcLocks c_p_locks, Process *t_p, Eterm what, Eterm data) { ErtsTracerNif *tnif = NULL; - if (is_tracer_proc_enabled(c_p, c_p_locks, &t_p->common, &tnif, what)) - send_to_tracer_nif(c_p, &t_p->common, t_p->common.id, tnif, + if (is_tracer_enabled(c_p, c_p_locks, &t_p->common, &tnif, + TRACE_FUN_E_PROCS, what)) + send_to_tracer_nif(c_p, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_PROCS, what, data, THE_NON_VALUE); } @@ -1267,31 +1306,34 @@ trace_proc_spawn(Process *p, Eterm what, Eterm pid, Eterm mod, Eterm func, Eterm args) { ErtsTracerNif *tnif = NULL; - if (is_tracer_proc_enabled(p, ERTS_PROC_LOCKS_ALL & + if (is_tracer_enabled(p, ERTS_PROC_LOCKS_ALL & ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE), - &p->common, &tnif, what)) { + &p->common, &tnif, TRACE_FUN_E_PROCS, what)) { Eterm mfa; Eterm* hp; hp = HAlloc(p, 4); mfa = TUPLE3(hp, mod, func, args); hp += 4; - send_to_tracer_nif(p, &p->common, p->common.id, tnif, what, pid, mfa); + send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_PROCS, + what, pid, mfa); } } void save_calls(Process *p, Export *e) { - struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p); - if (scb) { - Export **ct = &scb->ct[0]; - int len = scb->len; - - ct[scb->cur] = e; - if (++scb->cur >= len) - scb->cur = 0; - if (scb->n < len) - scb->n++; + if ((ERTS_TRACE_FLAGS(p) & F_SENSITIVE) == 0) { + struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p); + if (scb) { + Export **ct = &scb->ct[0]; + int len = scb->len; + + ct[scb->cur] = e; + if (++scb->cur >= len) + scb->cur = 0; + if (scb->n < len) + scb->n++; + } } } @@ -1308,23 +1350,25 @@ void save_calls(Process *p, Export *e) * are all small (atomic) integers. */ void -trace_gc(Process *p, Eterm what) +trace_gc(Process *p, Eterm what, Uint size) { ErtsTracerNif *tnif = NULL; Eterm* hp; Eterm msg = NIL; - Uint size = 0; + Uint sz = 0; + Eterm tup; - if (is_tracer_proc_enabled( - p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif, what)) { + if (is_tracer_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common, &tnif, TRACE_FUN_E_GC, what)) { - (void) erts_process_gc_info(p, &size, NULL); - hp = HAlloc(p, size); + (void) erts_process_gc_info(p, &sz, NULL); + hp = HAlloc(p, sz + 3 + 2); msg = erts_process_gc_info(p, NULL, &hp); + tup = TUPLE2(hp, am_wordsize, make_small(size)); hp += 3; + msg = CONS(hp, tup, msg); hp += 2; - send_to_tracer_nif(p, &p->common, p->common.id, tnif, what, - msg, THE_NON_VALUE); + send_to_tracer_nif(p, &p->common, p->common.id, tnif, TRACE_FUN_T_GC, + what, msg, am_undefined); } } @@ -1696,50 +1740,15 @@ profile_scheduler(Eterm scheduler_id, Eterm state) { } -void -profile_scheduler_q(Eterm scheduler_id, Eterm state, Eterm no_schedulers, Uint Ms, Uint s, Uint us) { - Eterm *hp, msg, timestamp; - -#ifndef ERTS_SMP -#define LOCAL_HEAP_SIZE (4 + 7) - DeclareTmpHeapNoproc(local_heap,LOCAL_HEAP_SIZE); - UseTmpHeapNoproc(LOCAL_HEAP_SIZE); - - hp = local_heap; -#else - ErlHeapFragment *bp; - Uint hsz; - - hsz = 4 + 7; - - bp = new_message_buffer(hsz); - hp = bp->mem; -#endif - - erts_smp_mtx_lock(&smq_mtx); - - timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4; - msg = TUPLE6(hp, am_profile, am_scheduler, scheduler_id, state, no_schedulers, timestamp); hp += 7; -#ifndef ERTS_SMP - profile_send(NIL, msg); - UnUseTmpHeapNoproc(LOCAL_HEAP_SIZE); -#undef LOCAL_HEAP_SIZE -#else - enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, NIL, NIL, msg, bp); -#endif - erts_smp_mtx_unlock(&smq_mtx); - -} - /* Port profiling */ void trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) { ErtsTracerNif *tnif = NULL; ERTS_SMP_CHK_NO_PROC_LOCKS; - if (is_tracer_proc_enabled(NULL, 0, &p->common, &tnif, am_open)) - send_to_tracer_nif(NULL, &p->common, p->common.id, tnif, am_open, - calling_pid, drv_name); + if (is_tracer_enabled(NULL, 0, &p->common, &tnif, TRACE_FUN_E_PORTS, am_open)) + send_to_tracer_nif(NULL, &p->common, p->common.id, tnif, TRACE_FUN_T_PORTS, + am_open, calling_pid, drv_name); } /* Sends trace message: @@ -1756,8 +1765,8 @@ trace_port(Port *t_p, Eterm what, Eterm data) { ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) || erts_thr_progress_is_blocking()); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (is_tracer_proc_enabled(NULL, 0, &t_p->common, &tnif, what)) - send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_PORTS, what)) + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_PORTS, what, data, THE_NON_VALUE); } @@ -1802,7 +1811,7 @@ trace_port_receive(Port *t_p, Eterm caller, Eterm what, ...) ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) || erts_thr_progress_is_blocking()); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (is_tracer_proc_enabled(NULL, 0, &t_p->common, &tnif, am_receive)) { + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_RECEIVE, am_receive)) { /* We can use a stack heap here, as the nif is called in the context of a port */ #define LOCAL_HEAP_SIZE (3 + 3 + heap_bin_size(ERL_ONHEAP_BIN_LIMIT) + 3) @@ -1894,7 +1903,10 @@ trace_port_receive(Port *t_p, Eterm caller, Eterm what, ...) } data = TUPLE2(hp, caller, data); + hp += 3; + ASSERT(hp <= (local_heap + LOCAL_HEAP_SIZE) || orig_hp); send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, + TRACE_FUN_T_RECEIVE, am_receive, data, THE_NON_VALUE); if (bptr && erts_refc_dectest(&bptr->refc, 1) == 0) @@ -1916,8 +1928,8 @@ trace_port_send(Port *t_p, Eterm receiver, Eterm msg, int exists) ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) || erts_thr_progress_is_blocking()); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (is_tracer_proc_enabled(NULL, 0, &t_p->common, &tnif, op)) - send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SEND, op)) + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_SEND, op, msg, receiver); } @@ -1927,7 +1939,7 @@ void trace_port_send_binary(Port *t_p, Eterm to, Eterm what, char *bin, Sint sz) ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) || erts_thr_progress_is_blocking()); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (is_tracer_proc_enabled(NULL, 0, &t_p->common, &tnif, am_send)) { + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SEND, am_send)) { Eterm msg; Binary* bptr = NULL; #define LOCAL_HEAP_SIZE (3 + 3 + heap_bin_size(ERL_ONHEAP_BIN_LIMIT)) @@ -1946,7 +1958,7 @@ void trace_port_send_binary(Port *t_p, Eterm to, Eterm what, char *bin, Sint sz) msg = TUPLE2(hp, t_p->common.id, msg); hp += 3; - send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, + send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, tnif, TRACE_FUN_T_SEND, am_send, msg, to); if (bptr && erts_refc_dectest(&bptr->refc, 1) == 0) erts_bin_free(bptr); @@ -1975,9 +1987,10 @@ trace_sched_ports_where(Port *t_p, Eterm what, Eterm where) { ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(t_p) || erts_thr_progress_is_blocking()); ERTS_SMP_CHK_NO_PROC_LOCKS; - if (is_tracer_proc_enabled(NULL, 0, &t_p->common, &tnif, what)) + if (is_tracer_enabled(NULL, 0, &t_p->common, &tnif, TRACE_FUN_E_SCHED_PORT, what)) send_to_tracer_nif(NULL, &t_p->common, t_p->common.id, - tnif, what, where, THE_NON_VALUE); + tnif, TRACE_FUN_T_SCHED_PORT, + what, where, THE_NON_VALUE); } /* Port profiling */ @@ -2523,14 +2536,97 @@ init_sys_msg_dispatcher(void) #include "erl_nif.h" +typedef struct { + char *name; + Uint arity; + ErlNifFunc *cb; +} ErtsTracerType; + struct ErtsTracerNif_ { HashBucket hb; Eterm module; struct erl_module_nif* nif_mod; - ErlNifFunc *enabled; - ErlNifFunc *trace; + ErtsTracerType tracers[NIF_TRACER_TYPES]; }; +static void init_tracer_template(ErtsTracerNif *tnif) { + + /* default tracer functions */ + tnif->tracers[TRACE_FUN_DEFAULT].name = "trace"; + tnif->tracers[TRACE_FUN_DEFAULT].arity = 6; + tnif->tracers[TRACE_FUN_DEFAULT].cb = NULL; + + tnif->tracers[TRACE_FUN_ENABLED].name = "enabled"; + tnif->tracers[TRACE_FUN_ENABLED].arity = 3; + tnif->tracers[TRACE_FUN_ENABLED].cb = NULL; + + /* specific tracer functions */ + tnif->tracers[TRACE_FUN_T_SEND].name = "trace_send"; + tnif->tracers[TRACE_FUN_T_SEND].arity = 6; + tnif->tracers[TRACE_FUN_T_SEND].cb = NULL; + + tnif->tracers[TRACE_FUN_T_RECEIVE].name = "trace_receive"; + tnif->tracers[TRACE_FUN_T_RECEIVE].arity = 6; + tnif->tracers[TRACE_FUN_T_RECEIVE].cb = NULL; + + tnif->tracers[TRACE_FUN_T_CALL].name = "trace_call"; + tnif->tracers[TRACE_FUN_T_CALL].arity = 6; + tnif->tracers[TRACE_FUN_T_CALL].cb = NULL; + + tnif->tracers[TRACE_FUN_T_SCHED_PROC].name = "trace_running_procs"; + tnif->tracers[TRACE_FUN_T_SCHED_PROC].arity = 6; + tnif->tracers[TRACE_FUN_T_SCHED_PROC].cb = NULL; + + tnif->tracers[TRACE_FUN_T_SCHED_PORT].name = "trace_running_ports"; + tnif->tracers[TRACE_FUN_T_SCHED_PORT].arity = 6; + tnif->tracers[TRACE_FUN_T_SCHED_PORT].cb = NULL; + + tnif->tracers[TRACE_FUN_T_GC].name = "trace_garbage_collection"; + tnif->tracers[TRACE_FUN_T_GC].arity = 6; + tnif->tracers[TRACE_FUN_T_GC].cb = NULL; + + tnif->tracers[TRACE_FUN_T_PROCS].name = "trace_procs"; + tnif->tracers[TRACE_FUN_T_PROCS].arity = 6; + tnif->tracers[TRACE_FUN_T_PROCS].cb = NULL; + + tnif->tracers[TRACE_FUN_T_PORTS].name = "trace_ports"; + tnif->tracers[TRACE_FUN_T_PORTS].arity = 6; + tnif->tracers[TRACE_FUN_T_PORTS].cb = NULL; + + /* specific enabled functions */ + tnif->tracers[TRACE_FUN_E_SEND].name = "enabled_send"; + tnif->tracers[TRACE_FUN_E_SEND].arity = 3; + tnif->tracers[TRACE_FUN_E_SEND].cb = NULL; + + tnif->tracers[TRACE_FUN_E_RECEIVE].name = "enabled_receive"; + tnif->tracers[TRACE_FUN_E_RECEIVE].arity = 3; + tnif->tracers[TRACE_FUN_E_RECEIVE].cb = NULL; + + tnif->tracers[TRACE_FUN_E_CALL].name = "enabled_call"; + tnif->tracers[TRACE_FUN_E_CALL].arity = 3; + tnif->tracers[TRACE_FUN_E_CALL].cb = NULL; + + tnif->tracers[TRACE_FUN_E_SCHED_PROC].name = "enabled_running_procs"; + tnif->tracers[TRACE_FUN_E_SCHED_PROC].arity = 3; + tnif->tracers[TRACE_FUN_E_SCHED_PROC].cb = NULL; + + tnif->tracers[TRACE_FUN_E_SCHED_PORT].name = "enabled_running_ports"; + tnif->tracers[TRACE_FUN_E_SCHED_PORT].arity = 3; + tnif->tracers[TRACE_FUN_E_SCHED_PORT].cb = NULL; + + tnif->tracers[TRACE_FUN_E_GC].name = "enabled_garbage_collection"; + tnif->tracers[TRACE_FUN_E_GC].arity = 3; + tnif->tracers[TRACE_FUN_E_GC].cb = NULL; + + tnif->tracers[TRACE_FUN_E_PROCS].name = "enabled_procs"; + tnif->tracers[TRACE_FUN_E_PROCS].arity = 3; + tnif->tracers[TRACE_FUN_E_PROCS].cb = NULL; + + tnif->tracers[TRACE_FUN_E_PORTS].name = "enabled_ports"; + tnif->tracers[TRACE_FUN_E_PORTS].arity = 3; + tnif->tracers[TRACE_FUN_E_PORTS].cb = NULL; +} + static Hash *tracer_hash = NULL; static erts_smp_rwmtx_t tracer_mtx; @@ -2543,31 +2639,32 @@ load_tracer_nif(const ErtsTracer tracer) ErlNifFunc *funcs; int num_of_funcs; ErtsTracerNif tnif_tmpl, *tnif; - int i; + ErtsTracerType *tracers; + int i,j; - if (mod && mod->curr.nif != NULL) { - instance = &mod->curr; - } else { + if (!mod || !mod->curr.nif) { return NULL; } - tnif_tmpl.enabled = NULL; - tnif_tmpl.trace = NULL; + instance = &mod->curr; + + init_tracer_template(&tnif_tmpl); tnif_tmpl.nif_mod = instance->nif; tnif_tmpl.module = ERTS_TRACER_MODULE(tracer); + tracers = tnif_tmpl.tracers; num_of_funcs = erts_nif_get_funcs(instance->nif, &funcs); for(i = 0; i < num_of_funcs; i++) { - if (strcmp("enabled",funcs[i].name) == 0 && funcs[i].arity == 3) { - tnif_tmpl.enabled = funcs + i; - } else if (strcmp("trace",funcs[i].name) == 0 && funcs[i].arity == 6) { - tnif_tmpl.trace = funcs + i; + for (j = 0; j < NIF_TRACER_TYPES; j++) { + if (strcmp(tracers[j].name, funcs[i].name) == 0 && tracers[j].arity == funcs[i].arity) { + tracers[j].cb = &(funcs[i]); + break; + } } } - if (tnif_tmpl.enabled == NULL || - tnif_tmpl.trace == NULL ) { + if (tracers[TRACE_FUN_DEFAULT].cb == NULL || tracers[TRACE_FUN_ENABLED].cb == NULL ) { return NULL; } @@ -2660,17 +2757,18 @@ erts_tracer_to_term(Process *p, ErtsTracer tracer) static ERTS_INLINE int send_to_tracer_nif_raw(Process *c_p, Process *tracee, const ErtsTracer tracer, Uint tracee_flags, - Eterm t_p_id, ErtsTracerNif *tnif, Eterm tag, Eterm msg, - Eterm extra, Eterm pam_result) + Eterm t_p_id, ErtsTracerNif *tnif, + enum ErtsTracerOpt topt, + Eterm tag, Eterm msg, Eterm extra, Eterm pam_result) { if (tnif || (tnif = lookup_tracer_nif(tracer)) != NULL) { #define MAP_SIZE 3 - Eterm argv[6], - local_heap[3+MAP_SIZE /* values */+(MAP_SIZE+1 /* keys */)]; + Eterm argv[6], local_heap[3+MAP_SIZE /* values */ + (MAP_SIZE+1 /* keys */)]; flatmap_t *map = (flatmap_t*)(local_heap+(MAP_SIZE+1)); Eterm *map_values = flatmap_get_values(map); - int argc = 6; + topt = (tnif->tracers[topt].cb) ? topt : TRACE_FUN_DEFAULT; + ASSERT(topt < NIF_TRACER_TYPES); argv[0] = tag; argv[1] = ERTS_TRACER_STATE(tracer); @@ -2681,8 +2779,7 @@ send_to_tracer_nif_raw(Process *c_p, Process *tracee, map->thing_word = MAP_HEADER_FLATMAP; map->size = MAP_SIZE; - map->keys = TUPLE3(local_heap, am_match_spec_result, am_scheduler_id, - am_timestamp); + map->keys = TUPLE3(local_heap, am_match_spec_result, am_scheduler_id, am_timestamp); *map_values++ = pam_result; if (tracee_flags & F_TRACE_SCHED_NO) @@ -2705,16 +2802,18 @@ send_to_tracer_nif_raw(Process *c_p, Process *tracee, #undef MAP_SIZE erts_nif_call_function(c_p, tracee ? tracee : c_p, - tnif->nif_mod, tnif->trace, argc, argv); + tnif->nif_mod, + tnif->tracers[topt].cb, + tnif->tracers[topt].arity, + argv); } return 1; } - static ERTS_INLINE int send_to_tracer_nif(Process *c_p, ErtsPTabElementCommon *t_p, - Eterm t_p_id, ErtsTracerNif *tnif, Eterm tag, - Eterm msg, Eterm extra) + Eterm t_p_id, ErtsTracerNif *tnif, enum ErtsTracerOpt topt, + Eterm tag, Eterm msg, Eterm extra) { #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) if (c_p) { @@ -2733,29 +2832,35 @@ send_to_tracer_nif(Process *c_p, ErtsPTabElementCommon *t_p, return send_to_tracer_nif_raw(c_p, is_internal_pid(t_p->id) ? (Process*)t_p : NULL, t_p->tracer, t_p->trace_flags, - t_p_id, tnif, tag, msg, extra, + t_p_id, tnif, topt, tag, msg, extra, am_true); } static ERTS_INLINE Eterm call_enabled_tracer(Process *c_p, const ErtsTracer tracer, - ErtsTracerNif **tnif_ret, Eterm tag, Eterm t_p_id) -{ + ErtsTracerNif **tnif_ret, + enum ErtsTracerOpt topt, + Eterm tag, Eterm t_p_id) { ErtsTracerNif *tnif = lookup_tracer_nif(tracer); if (tnif) { Eterm argv[] = {tag, ERTS_TRACER_STATE(tracer), t_p_id}; + topt = (tnif->tracers[topt].cb) ? topt : TRACE_FUN_ENABLED; + ASSERT(topt < NIF_TRACER_TYPES); + ASSERT(tnif->tracers[topt].cb != NULL); if (tnif_ret) *tnif_ret = tnif; - return erts_nif_call_function( - c_p, NULL, tnif->nif_mod, tnif->enabled, 3, argv); + return erts_nif_call_function(c_p, NULL, tnif->nif_mod, + tnif->tracers[topt].cb, + tnif->tracers[topt].arity, + argv); } return am_remove; } static int -is_tracer_proc_enabled(Process* c_p, ErtsProcLocks c_p_locks, - ErtsPTabElementCommon *t_p, - ErtsTracerNif **tnif_ret, Eterm tag) -{ +is_tracer_enabled(Process* c_p, ErtsProcLocks c_p_locks, + ErtsPTabElementCommon *t_p, + ErtsTracerNif **tnif_ret, + enum ErtsTracerOpt topt, Eterm tag) { Eterm nif_result; #if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) @@ -2773,7 +2878,7 @@ is_tracer_proc_enabled(Process* c_p, ErtsProcLocks c_p_locks, } #endif - nif_result = call_enabled_tracer(c_p, t_p->tracer, tnif_ret, tag, t_p->id); + nif_result = call_enabled_tracer(c_p, t_p->tracer, tnif_ret, topt, tag, t_p->id); switch (nif_result) { case am_discard: return 0; case am_trace: return 1; @@ -2806,14 +2911,13 @@ is_tracer_proc_enabled(Process* c_p, ErtsProcLocks c_p_locks, erts_smp_proc_unlock(c_p, c_p_xlocks); } - return 0; } int erts_is_tracer_proc_enabled(Process* c_p, ErtsProcLocks c_p_locks, ErtsPTabElementCommon *t_p, Eterm type) { - return is_tracer_proc_enabled(c_p, c_p_locks, t_p, NULL, am_trace_status); + return is_tracer_enabled(c_p, c_p_locks, t_p, NULL, TRACE_FUN_ENABLED, am_trace_status); } int erts_is_tracer_enabled(Process *c_p, const ErtsTracer tracer) @@ -2821,7 +2925,7 @@ int erts_is_tracer_enabled(Process *c_p, const ErtsTracer tracer) ErtsTracerNif *tnif = lookup_tracer_nif(tracer); if (tnif) { Eterm nif_result = call_enabled_tracer(c_p, tracer, &tnif, - am_trace_status, + TRACE_FUN_ENABLED, am_trace_status, c_p->common.id); switch (nif_result) { case am_discard: diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index 177fd373a6..9a007e62ec 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -103,7 +103,7 @@ void trace_sched(Process*, ErtsProcLocks, Eterm); void trace_proc(Process*, ErtsProcLocks, Process*, Eterm, Eterm); void trace_proc_spawn(Process*, Eterm what, Eterm pid, Eterm mod, Eterm func, Eterm args); void save_calls(Process *p, Export *); -void trace_gc(Process *p, Eterm what); +void trace_gc(Process *p, Eterm what, Uint size); /* port tracing */ void trace_virtual_sched(Process*, ErtsProcLocks, Eterm); void trace_sched_ports(Port *pp, Eterm); diff --git a/erts/emulator/beam/erlang_lttng.h b/erts/emulator/beam/erlang_lttng.h index 43ceeda671..12f68e477b 100644 --- a/erts/emulator/beam/erlang_lttng.h +++ b/erts/emulator/beam/erlang_lttng.h @@ -218,13 +218,13 @@ TRACEPOINT_EVENT( driver_stop, TP_ARGS( char*, pid, - char*, driver, - char*, port + char*, port, + char*, driver ), TP_FIELDS( ctf_string(pid, pid) - ctf_string(driver, driver) ctf_string(port, port) + ctf_string(driver, driver) ) ) @@ -324,7 +324,7 @@ TRACEPOINT_EVENT( TRACEPOINT_EVENT( com_ericsson_otp, - aio_pool_add, + aio_pool_put, TP_ARGS( char*, port, int, length diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 723c25ff77..3c002d43a7 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -4429,22 +4429,32 @@ init_done: SKIP(1+atom_extra_skip); atom_extra_skip = 0; break; - case PID_EXT: case NEW_PID_EXT: + atom_extra_skip = 12; + goto case_PID; + case PID_EXT: atom_extra_skip = 9; + case_PID: /* In case it is an external pid */ heap_size += EXTERNAL_THING_HEAD_SIZE + 1; terms++; break; - case PORT_EXT: case NEW_PORT_EXT: + atom_extra_skip = 8; + goto case_PORT; + case PORT_EXT: atom_extra_skip = 5; + case_PORT: /* In case it is an external port */ heap_size += EXTERNAL_THING_HEAD_SIZE + 1; terms++; break; - case NEW_REFERENCE_EXT: case NEWER_REFERENCE_EXT: + atom_extra_skip = 4; + goto case_NEW_REFERENCE; + case NEW_REFERENCE_EXT: + atom_extra_skip = 1; + case_NEW_REFERENCE: { int id_words; @@ -4455,7 +4465,7 @@ init_done: goto error; ep += 2; - atom_extra_skip = 1 + 4*id_words; + atom_extra_skip += 4*id_words; /* In case it is an external ref */ #if defined(ARCH_64) heap_size += EXTERNAL_THING_HEAD_SIZE + id_words/2 + 1; diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index a7bc990deb..49eec44053 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -997,7 +997,7 @@ Eterm erl_is_function(Process* p, Eterm arg1, Eterm arg2); #define ERTS_CPC_ALLOW_GC (1 << 0) #define ERTS_CPC_COPY_LITERALS (1 << 1) #define ERTS_CPC_ALL (ERTS_CPC_ALLOW_GC | ERTS_CPC_COPY_LITERALS) -Eterm erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp); +Eterm erts_check_process_code(Process *c_p, Eterm module, Uint flags, int *redsp, int fcalls); typedef struct { Eterm *ptr; diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index b14ca77a04..5c2595c69d 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -3861,7 +3861,7 @@ terminate_port(Port *prt) lttng_decl_procbuf(proc_str); lttng_pid_to_str(connected_id, proc_str); lttng_port_to_str(prt, port_str); - LTTNG3(driver_stop, proc_str, drv->name, port_str); + LTTNG3(driver_stop, proc_str, port_str, drv->name); } #endif diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index b280995488..68006e7ef3 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -71,41 +71,6 @@ #define HAVE_MALLOPT 0 #endif -/* profile_scheduler mini message queue */ - -typedef struct { - Uint scheduler_id; - Uint no_schedulers; - Uint Ms; - Uint s; - Uint us; - Eterm state; -} profile_sched_msg; - -typedef struct { - profile_sched_msg msg[2]; - Uint n; -} profile_sched_msg_q; - -#ifdef ERTS_SMP - -#if 0 /* Unused */ -static void -dispatch_profile_msg_q(profile_sched_msg_q *psmq) -{ - int i = 0; - profile_sched_msg *msg = NULL; - ASSERT(psmq != NULL); - for (i = 0; i < psmq->n; i++) { - msg = &(psmq->msg[i]); - profile_scheduler_q(make_small(msg->scheduler_id), msg->state, am_undefined, msg->Ms, msg->s, msg->us); - } -} -#endif - -#endif - - Eterm* erts_heap_alloc(Process* p, Uint need, Uint xtra) { diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index 43144e75ec..9ad44b25ac 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -218,15 +218,37 @@ static __inline__ void hipe_pop_beam_trap_frame(Process *p) Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) { unsigned result; -#if NR_ARG_REGS > 5 - /* When NR_ARG_REGS > 5, we need to protect the process' input - reduction count (which BEAM stores in def_arg_reg[5]) from - being clobbered by the arch glue code. */ Eterm reds_in = p->def_arg_reg[5]; -#endif -#if NR_ARG_REGS > 4 - Eterm o_reds = p->def_arg_reg[4]; -#endif + /* + * Process is in the normal case scheduled out when reduction + * count reach zero. When "save calls" is enabled reduction + * count is subtracted with CONTEXT_REDS, i.e. initial reduction + * count will be zero or less and process is scheduled out + * when -CONTEXT_REDS is reached. + * + * HiPE does not support the "save calls" feature, so we switch + * to using a positive reduction counter when executing in + * hipe mode, but need to restore the "save calls" when + * returning to beam. We also need to hide the save calls buffer + * from BIFs. We do that by moving the saved calls buf to + * suspended saved calls buf. + * + * Beam has initial reduction count in stored in p->def_arg_reg[5]. + * + * Beam expects -neg_o_reds to be found in p->def_arg_reg[4] + * on return to beam. + */ + + { + struct saved_calls *scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL); + if (scb) { + reds_in += CONTEXT_REDS; + p->fcalls += CONTEXT_REDS; + ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, scb); + } + } + + p->flags |= F_HIPE_MODE; /* inform bifs where we are comming from... */ p->i = NULL; /* Set current_function to undefined. stdlib hibernate tests rely on it. */ @@ -481,12 +503,21 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE); do_schedule: { -#if !(NR_ARG_REGS > 5) - int reds_in = p->def_arg_reg[5]; + struct saved_calls *scb; + + scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, NULL); + if (scb) + ERTS_PROC_SET_SAVED_CALLS_BUF(p, scb); + +#ifdef DEBUG + ASSERT(p->debug_reds_in == reds_in); #endif + p->flags &= ~F_HIPE_MODE; + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(p); p = schedule(p, reds_in - p->fcalls); ERTS_SMP_REQ_PROC_MAIN_LOCK(p); + ASSERT(!(p->flags & F_HIPE_MODE)); #ifdef ERTS_SMP p->hipe_smp.have_receive_locks = 0; reg = p->scheduler_data->x_reg_array; @@ -501,28 +532,32 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) reg[i] = argp[i]; } { -#if !(NR_ARG_REGS > 5) - Eterm reds_in; -#endif -#if !(NR_ARG_REGS > 4) - Eterm o_reds; -#endif + struct saved_calls *scb; reds_in = p->fcalls; - o_reds = 0; - if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) { - o_reds = reds_in; - reds_in = 0; - p->fcalls = 0; - } - p->def_arg_reg[4] = o_reds; p->def_arg_reg[5] = reds_in; +#ifdef DEBUG + p->debug_reds_in = reds_in; +#endif if (p->i == hipe_beam_pc_resume) { + p->flags |= F_HIPE_MODE; /* inform bifs where we are comming from... */ + scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, NULL); + if (scb) + ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, scb); p->i = NULL; p->arity = 0; goto do_resume; } + + scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p); + if (!scb) + p->def_arg_reg[4] = 0; + else { + p->def_arg_reg[4] = CONTEXT_REDS; + p->fcalls = -CONTEXT_REDS + reds_in; + } } + HIPE_CHECK_PCB(p); result = HIPE_MODE_SWITCH_RES_CALL_BEAM; p->def_arg_reg[3] = result; @@ -562,14 +597,29 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) default: erts_exit(ERTS_ERROR_EXIT, "hipe_mode_switch: result %#x\r\n", result); } + + { + struct saved_calls *scb = ERTS_PROC_SET_SUSPENDED_SAVED_CALLS_BUF(p, NULL); + if (!scb) + p->def_arg_reg[4] = 0; + else { + p->def_arg_reg[4] = CONTEXT_REDS; + p->fcalls -= CONTEXT_REDS; + ERTS_PROC_SET_SAVED_CALLS_BUF(p, scb); + } + } + HIPE_CHECK_PCB(p); p->def_arg_reg[3] = result; -#if NR_ARG_REGS > 4 - p->def_arg_reg[4] = o_reds; -#endif #if NR_ARG_REGS > 5 + /* + * When NR_ARG_REGS > 5, we need to protect the process' input + * reduction count (which BEAM stores in def_arg_reg[5]) from + * being clobbered by the arch glue code. + */ p->def_arg_reg[5] = reds_in; #endif + p->flags &= ~F_HIPE_MODE; return p; } diff --git a/erts/emulator/nifs/common/erl_tracer_nif.c b/erts/emulator/nifs/common/erl_tracer_nif.c index a1e0e581a4..8a9a1bf16c 100644 --- a/erts/emulator/nifs/common/erl_tracer_nif.c +++ b/erts/emulator/nifs/common/erl_tracer_nif.c @@ -72,6 +72,10 @@ ERL_NIF_INIT(erl_tracer, nif_funcs, load, NULL, upgrade, unload) ATOM_DECL(trace); \ ATOM_DECL(trace_ts); \ ATOM_DECL(true); \ + ATOM_DECL(gc_minor_start); \ + ATOM_DECL(gc_minor_end); \ + ATOM_DECL(gc_major_start); \ + ATOM_DECL(gc_major_end); \ ATOM_DECL(undefined); #define ATOM_DECL(A) static ERL_NIF_TERM atom_##A @@ -124,6 +128,9 @@ static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) if (!enif_is_port_alive(env, &to_port)) /* tracer is dead so we should remove this trace point */ return atom_remove; + } else { + /* The state was not a pid or a port */ + return atom_remove; } /* Only generate trace for when tracer != tracee */ diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c index 60661d9016..6435da086f 100644 --- a/erts/emulator/sys/unix/sys_float.c +++ b/erts/emulator/sys/unix/sys_float.c @@ -53,7 +53,7 @@ static void erts_init_fp_exception(void) void erts_thread_init_fp_exception(void) { unsigned long *fpe = erts_alloc(ERTS_ALC_T_FP_EXCEPTION, sizeof(*fpe)); - *fpe = 0L; + *fpe = 0; erts_tsd_set(fpe_key, fpe); } @@ -102,6 +102,17 @@ void erts_fp_check_init_error(volatile unsigned long *fpexnp) #define __DARWIN__ 1 #endif +/* + * Define two processor and possibly OS-specific primitives: + * + * static void unmask_fpe(void); + * -- unmask invalid, overflow, and divide-by-zero exceptions + * + * static int mask_fpe(void); + * -- mask invalid, overflow, and divide-by-zero exceptions + * -- return non-zero if the previous state was unmasked + */ + #if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) static void unmask_x87(void) @@ -113,7 +124,6 @@ static void unmask_x87(void) __asm__ __volatile__("fldcw %0" : : "m"(cw)); } -/* mask x87 FPE, return true if the previous state was unmasked */ static int mask_x87(void) { unsigned short cw; @@ -136,7 +146,6 @@ static void unmask_sse2(void) __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr)); } -/* mask SSE2 FPE, return true if the previous state was unmasked */ static int mask_sse2(void) { unsigned int mxcsr; @@ -257,21 +266,19 @@ static int cpu_has_sse2(void) } #endif /* !__x86_64__ */ -static void unmask_fpe(void) +static void unmask_fpe_internal(void) { - __asm__ __volatile__("fnclex"); unmask_x87(); if (cpu_has_sse2()) unmask_sse2(); } -static void unmask_fpe_conditional(int unmasked) +static void unmask_fpe(void) { - if (unmasked) - unmask_fpe(); + __asm__ __volatile__("fnclex"); + unmask_fpe_internal(); } -/* mask x86 FPE, return true if the previous state was unmasked */ static int mask_fpe(void) { int unmasked; @@ -285,9 +292,7 @@ static int mask_fpe(void) void erts_restore_fpu(void) { __asm__ __volatile__("fninit"); - unmask_x87(); - if (cpu_has_sse2()) - unmask_sse2(); + unmask_fpe_internal(); } #elif defined(__sparc__) && defined(__linux__) @@ -310,13 +315,6 @@ static void unmask_fpe(void) __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr)); } -static void unmask_fpe_conditional(int unmasked) -{ - if (unmasked) - unmask_fpe(); -} - -/* mask SPARC FPE, return true if the previous state was unmasked */ static int mask_fpe(void) { unsigned long fsr; @@ -431,13 +429,6 @@ static void unmask_fpe(void) set_fpscr(0x80|0x40|0x10); /* VE, OE, ZE; not UE or XE */ } -static void unmask_fpe_conditional(int unmasked) -{ - if (unmasked) - unmask_fpe(); -} - -/* mask PowerPC FPE, return true if the previous state was unmasked */ static int mask_fpe(void) { int unmasked; @@ -447,20 +438,13 @@ static int mask_fpe(void) return unmasked; } -#else +#else /* !(x86 || (sparc && linux) || (powerpc && (linux || darwin))) */ static void unmask_fpe(void) { fpsetmask(FP_X_INV | FP_X_OFL | FP_X_DZ); } -static void unmask_fpe_conditional(int unmasked) -{ - if (unmasked) - unmask_fpe(); -} - -/* mask IEEE FPE, return true if previous state was unmasked */ static int mask_fpe(void) { const fp_except unmasked_mask = FP_X_INV | FP_X_OFL | FP_X_DZ; @@ -472,6 +456,16 @@ static int mask_fpe(void) #endif +/* + * Define a processor and OS-specific SIGFPE handler. + * + * The effect of receiving a SIGFPE should be: + * 1. Update the processor context: + * a) on x86: mask FP exceptions, do not skip faulting instruction + * b) on SPARC and PowerPC: unmask FP exceptions, skip faulting instruction + * 2. call set_current_fp_exception with the PC of the faulting instruction + */ + #if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__x86_64__) || defined(__i386__))) || ((defined(__NetBSD__) || defined(__OpenBSD__)) && defined(__x86_64__)) || (defined(__sun__) && defined(__x86_64__)) #if defined(__linux__) && defined(__i386__) @@ -520,8 +514,7 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) ucontext_t *uc = puc; unsigned long pc; -#if defined(__linux__) -#if defined(__x86_64__) +#if defined(__linux__) && defined(__x86_64__) mcontext_t *mc = &uc->uc_mcontext; fpregset_t fpstate = mc->fpregs; pc = mc_pc(mc); @@ -533,26 +526,26 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) set encoding makes that a poor solution here. */ fpstate->mxcsr = 0x1F80; fpstate->swd &= ~0xFF; -#elif defined(__i386__) +#elif defined(__linux__) && defined(__i386__) mcontext_t *mc = &uc->uc_mcontext; fpregset_t fpstate = mc->fpregs; pc = mc_pc(mc); if ((fpstate->status >> 16) == X86_FXSR_MAGIC) ((struct _fpstate*)fpstate)->mxcsr = 0x1F80; fpstate->sw &= ~0xFF; -#elif defined(__sparc__) && defined(__arch64__) +#elif defined(__linux__) && defined(__sparc__) && defined(__arch64__) /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ struct sigcontext *sc = (struct sigcontext*)puc; pc = sc->sigc_regs.tpc; sc->sigc_regs.tpc = sc->sigc_regs.tnpc; sc->sigc_regs.tnpc += 4; -#elif defined(__sparc__) +#elif defined(__linux__) && defined(__sparc__) /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ struct sigcontext *sc = (struct sigcontext*)puc; pc = sc->si_regs.pc; sc->si_regs.pc = sc->si_regs.npc; sc->si_regs.npc = (unsigned long)sc->si_regs.npc + 4; -#elif defined(__powerpc__) +#elif defined(__linux__) && defined(__powerpc__) #if defined(__powerpc64__) mcontext_t *mc = &uc->uc_mcontext; unsigned long *regs = &mc->gp_regs[0]; @@ -563,7 +556,6 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) pc = regs[PT_NIP]; regs[PT_NIP] += 4; regs[PT_FPSCR] = 0x80|0x40|0x10; /* VE, OE, ZE; not UE or XE */ -#endif #elif defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__)) # error "Floating-point exceptions not supported on MacOS X" #elif defined(__DARWIN__) && defined(__ppc__) @@ -621,7 +613,7 @@ static void fpe_sig_action(int sig, siginfo_t *si, void *puc) #endif #if 0 { - char buf[64]; + char buf[128]; snprintf(buf, sizeof buf, "%s: FPE at %p\r\n", __FUNCTION__, (void*)pc); write(2, buf, strlen(buf)); } @@ -706,7 +698,8 @@ int erts_sys_block_fpe(void) void erts_sys_unblock_fpe(int unmasked) { - unmask_fpe_conditional(unmasked); + if (unmasked) + unmask_fpe(); } #endif @@ -818,11 +811,6 @@ sys_chars_to_double(char* buf, double* fp) int matherr(struct exception *exc) { -#if !defined(NO_FPE_SIGNALS) - volatile unsigned long *fpexnp = erts_get_current_fp_exception(); - if (fpexnp != NULL) - *fpexnp = (unsigned long)__builtin_return_address(0); -#endif return 1; } diff --git a/erts/emulator/sys/win32/sys_float.c b/erts/emulator/sys/win32/sys_float.c index a2b9bd1263..2b2d6ab7d3 100644 --- a/erts/emulator/sys/win32/sys_float.c +++ b/erts/emulator/sys/win32/sys_float.c @@ -139,8 +139,7 @@ sys_double_to_chars_ext(double fp, char *buffer, size_t buffer_size, size_t deci int matherr(struct _exception *exc) { - erl_fp_exception = 1; - DEBUGF(("FP exception (matherr) (0x%x) (%d)\n", exc->type, erl_fp_exception)); + DEBUGF(("FP exception (matherr) (0x%x)\n", exc->type)); return 1; } diff --git a/erts/emulator/test/lttng_SUITE.erl b/erts/emulator/test/lttng_SUITE.erl index d0f6292d5b..efc79f42ed 100644 --- a/erts/emulator/test/lttng_SUITE.erl +++ b/erts/emulator/test/lttng_SUITE.erl @@ -89,8 +89,8 @@ end_per_testcase(Case, _Config) -> %% com_ericsson_otp:carrier_pool_put %% com_ericsson_otp:carrier_destroy %% com_ericsson_otp:carrier_create -%% com_ericsson_otp:aio_pool_add -%% com_ericsson_otp:aio_pool_get +%% com_ericsson_otp:aio_pool_put +%% com_ericsson_otp:aio_pool_get %% com_ericsson_otp:driver_control %% com_ericsson_otp:driver_call %% com_ericsson_otp:driver_finish @@ -151,7 +151,7 @@ t_memory_carrier(Config) -> ok end. -%% com_ericsson_otp:aio_pool_add +%% com_ericsson_otp:aio_pool_put %% com_ericsson_otp:aio_pool_get t_async_io_pool(Config) -> case have_async_threads() of @@ -168,7 +168,7 @@ t_async_io_pool(Config) -> {ok, _} = file:list_dir(Path2), Res = lttng_stop_and_view(Config), - ok = check_tracepoint("com_ericsson_otp:aio_pool_add", Res), + ok = check_tracepoint("com_ericsson_otp:aio_pool_put", Res), ok = check_tracepoint("com_ericsson_otp:aio_pool_get", Res), ok end. @@ -416,7 +416,7 @@ txt() -> "%% com_ericsson_otp:carrier_pool_put\n" "%% com_ericsson_otp:carrier_destroy\n" "%% com_ericsson_otp:carrier_create\n" - "%% com_ericsson_otp:aio_pool_add\n" + "%% com_ericsson_otp:aio_pool_put\n" "%% com_ericsson_otp:aio_pool_get\n" "%% com_ericsson_otp:driver_control\n" "%% com_ericsson_otp:driver_call\n" diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index 956b82335c..b3870f0313 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -48,6 +48,7 @@ t_bif_map_new/1, t_bif_map_put/1, t_bif_map_remove/1, + t_bif_map_take/1, t_bif_map_take_large/1, t_bif_map_update/1, t_bif_map_values/1, t_bif_map_to_list/1, @@ -112,7 +113,9 @@ all() -> [t_build_and_match_literals, t_build_and_match_literals_large, t_bif_map_get,t_bif_map_find,t_bif_map_is_key, t_bif_map_keys, t_bif_map_merge, t_bif_map_new, t_bif_map_put, - t_bif_map_remove, t_bif_map_update, + t_bif_map_remove, + t_bif_map_take, t_bif_map_take_large, + t_bif_map_update, t_bif_map_values, t_bif_map_to_list, t_bif_map_from_list, @@ -1970,7 +1973,7 @@ t_bif_map_remove(Config) when is_list(Config) -> 0 = erlang:map_size(maps:remove(some_key, #{})), M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, - 4 => number, 18446744073709551629 => wat}, + 4 => number, 18446744073709551629 => wat}, M1 = maps:remove("hi", M0), true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)), @@ -1999,10 +2002,71 @@ t_bif_map_remove(Config) when is_list(Config) -> %% error case do_badmap(fun(T) -> - {'EXIT',{{badmap,T},[{maps,remove,_,_}|_]}} = - (catch maps:remove(a, T)) + {'EXIT',{{badmap,T},[{maps,remove,_,_}|_]}} = (catch maps:remove(a, T)) end), - ok. + ok. + +t_bif_map_take(Config) when is_list(Config) -> + error = maps:take(some_key, #{}), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + 5 = maps:size(M0), + {"hello", M1} = maps:take("hi", M0), + true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)), + true = is_members([number,wat,3,<<"value">>],maps:values(M1)), + error = maps:take("hi", M1), + 4 = maps:size(M1), + + {3, M2} = maps:take(int, M1), + true = is_members([4,18446744073709551629,<<"key">>],maps:keys(M2)), + true = is_members([number,wat,<<"value">>],maps:values(M2)), + error = maps:take(int, M2), + 3 = maps:size(M2), + + {<<"value">>,M3} = maps:take(<<"key">>, M2), + true = is_members([4,18446744073709551629],maps:keys(M3)), + true = is_members([number,wat],maps:values(M3)), + error = maps:take(<<"key">>, M3), + 2 = maps:size(M3), + + {wat,M4} = maps:take(18446744073709551629, M3), + true = is_members([4],maps:keys(M4)), + true = is_members([number],maps:values(M4)), + error = maps:take(18446744073709551629, M4), + 1 = maps:size(M4), + + {number,M5} = maps:take(4, M4), + [] = maps:keys(M5), + [] = maps:values(M5), + error = maps:take(4, M5), + 0 = maps:size(M5), + + {wat,#{ "hi" := "hello", int := 3, 4 := number, <<"key">> := <<"value">>}} = maps:take(18446744073709551629,M0), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,take,_,_}|_]}} = (catch maps:take(a, T)) + end), + ok. + +t_bif_map_take_large(Config) when is_list(Config) -> + KVs = [{{erlang:md5(<<I:64>>),I}, I}|| I <- lists:seq(1,500)], + M0 = maps:from_list(KVs), + ok = bif_map_take_all(KVs, M0), + ok. + +bif_map_take_all([], M0) -> + 0 = maps:size(M0), + ok; +bif_map_take_all([{K,V}|KVs],M0) -> + {ok,V} = maps:find(K,M0), + {V,M1} = maps:take(K,M0), + error = maps:find(K,M1), + error = maps:take(K,M1), + bif_map_take_all(KVs,M1). + t_bif_map_update(Config) when is_list(Config) -> M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index ea973276db..6733237b20 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -597,16 +597,15 @@ ms_trace3(Config) when is_list(Config) -> end), ok. -ms_trace_dead(doc) -> - ["Test that a dead tracer is removed using ms"]; -ms_trace_dead(suite) -> []; -ms_trace_dead(Config) when is_list(Config) -> +%% Test that a dead tracer is removed using ms +ms_trace_dead(_Config) -> Self = self(), TFun = fun F() -> receive M -> Self ! M, F() end end, {Tracer, MRef} = spawn_monitor(TFun), MetaTracer = spawn_link(TFun), erlang:trace_pattern({?MODULE, f1, '_'}, - [{'_',[],[{trace,[], + [{'_',[],[{message, false}, + {trace,[], [call,{const,{tracer,Tracer}}]}]}], [{meta, MetaTracer}]), erlang:trace_pattern({?MODULE, f2, '_'}, []), @@ -623,8 +622,6 @@ ms_trace_dead(Config) when is_list(Config) -> ?MODULE:f2(3,4), TRef = erlang:trace_delivered(all), receive {trace_delivered, _, TRef} -> ok end, - receive {trace_ts, Self, call, {?MODULE, f1, _}, _} -> ok end, - receive {trace_ts, Self, call, {?MODULE, f1, _}, _} -> ok end, receive M -> ct:fail({unexpected, M}) after 10 -> ok end. %% Test that destructive operations in test bif does not really happen diff --git a/erts/emulator/test/message_queue_data_SUITE.erl b/erts/emulator/test/message_queue_data_SUITE.erl index 6efca5b39e..226462676c 100644 --- a/erts/emulator/test/message_queue_data_SUITE.erl +++ b/erts/emulator/test/message_queue_data_SUITE.erl @@ -21,7 +21,7 @@ -module(message_queue_data_SUITE). -export([all/0, suite/0]). --export([basic/1, process_info_messages/1]). +-export([basic/1, process_info_messages/1, total_heap_size/1]). -export([basic_test/1]). @@ -32,7 +32,7 @@ suite() -> {timetrap, {minutes, 2}}]. all() -> - [basic, process_info_messages]. + [basic, process_info_messages, total_heap_size]. %% %% @@ -44,15 +44,15 @@ basic(Config) when is_list(Config) -> basic_test(erlang:system_info(message_queue_data)), - {ok, Node1} = start_node(Config, "+xmqd off_heap"), + {ok, Node1} = start_node(Config, "+hmqd off_heap"), ok = rpc:call(Node1, ?MODULE, basic_test, [off_heap]), stop_node(Node1), - {ok, Node2} = start_node(Config, "+xmqd on_heap"), + {ok, Node2} = start_node(Config, "+hmqd on_heap"), ok = rpc:call(Node2, ?MODULE, basic_test, [on_heap]), stop_node(Node2), - {ok, Node3} = start_node(Config, "+xmqd mixed"), + {ok, Node3} = start_node(Config, "+hmqd mixed"), ok = rpc:call(Node3, ?MODULE, basic_test, [mixed]), stop_node(Node3), @@ -190,6 +190,28 @@ process_info_messages(Config) when is_list(Config) -> ok. +total_heap_size(_Config) -> + + Fun = fun F() -> receive Pid when is_pid(Pid) -> Pid ! ok,F() end end, + + %% Test that on_heap messages grow the heap even if they are not received + OnPid = spawn_opt(Fun, [{message_queue_data, on_heap}]), + {total_heap_size, OnSize} = erlang:process_info(OnPid, total_heap_size), + [OnPid ! lists:duplicate(N,N) || N <- lists:seq(1,100)], + OnPid ! self(), receive ok -> ok end, + {total_heap_size, OnSizeAfter} = erlang:process_info(OnPid, total_heap_size), + ct:log("OnSize = ~p, OnSizeAfter = ~p",[OnSize, OnSizeAfter]), + true = OnSize < OnSizeAfter, + + %% Test that off_heap messages do not grow the heap if they are not received + OffPid = spawn_opt(Fun, [{message_queue_data, off_heap}]), + {total_heap_size, OffSize} = erlang:process_info(OffPid, total_heap_size), + [OffPid ! lists:duplicate(N,N) || N <- lists:seq(1,100)], + OffPid ! self(), receive ok -> ok end, + {total_heap_size, OffSizeAfter} = erlang:process_info(OffPid, total_heap_size), + ct:log("OffSize = ~p, OffSizeAfter = ~p",[OffSize, OffSizeAfter]), + true = OffSize == OffSizeAfter. + %% %% %% helpers diff --git a/erts/emulator/test/port_trace_SUITE.erl b/erts/emulator/test/port_trace_SUITE.erl index 41e8a316c4..bfdea0761b 100644 --- a/erts/emulator/test/port_trace_SUITE.erl +++ b/erts/emulator/test/port_trace_SUITE.erl @@ -240,19 +240,23 @@ command(Config) -> Prt ! {S, {command, <<?ECHO_DRV_NOOP:8>>}}, [{trace, Prt, 'receive', {S, {command, <<?ECHO_DRV_NOOP:8>>}}}] = flush(), + OutputMsg = <<?ECHO_DRV_NOOP:8,0:(8*512)>>, + Prt ! {S, {command, OutputMsg}}, + [{trace, Prt, 'receive', {S, {command, OutputMsg}}}] = flush(), + close(Prt, Flags), os:putenv("OUTPUTV","true"), reload_drv(Config), Prt2 = erlang:open_port({spawn, echo_drv}, [binary]), - Msg = [<<0:8>>,<<0:(8*512)>>,<<0:(8*256)>>,<<0:8>>], + OutputvMsg = [<<0:8>>,<<0:(8*512)>>,<<0:(8*256)>>,<<0:8>>], - erlang:port_command(Prt2, Msg), - [{trace, Prt2, 'receive', {S, {command, Msg}}}] = flush(), + erlang:port_command(Prt2, OutputvMsg), + [{trace, Prt2, 'receive', {S, {command, OutputvMsg}}}] = flush(), - Prt2 ! {S, {command, Msg}}, - [{trace, Prt2, 'receive', {S, {command, Msg}}}] = flush(), + Prt2 ! {S, {command, OutputvMsg}}, + [{trace, Prt2, 'receive', {S, {command, OutputvMsg}}}] = flush(), close(Prt2, Flags), @@ -274,6 +278,12 @@ control(_Config) -> [{trace, Prt, 'receive', {S, {control, {(1 bsl 32) - 1, <<?ECHO_DRV_NOOP:8, 0:8>>}}}}, {trace, Prt, send, {Prt, {control, <<0:8>>}}, S}] = flush(), + Msg = <<?ECHO_DRV_NOOP:8, 0:(8*512)>>, + Pat = lists:duplicate(512, 0), + Pat = erlang:port_control(Prt, 1, Msg), + [{trace, Prt, 'receive', {S, {control, {1, Msg}}}}, + {trace, Prt, send, {Prt, {control, <<0:(8*512)>>}}, S}] = flush(), + close(Prt, Flags), ok. @@ -331,12 +341,16 @@ call(_Config) -> Flags = [send,'receive'], {Prt, S} = trace_and_open(Flags,[binary]), - Msg = {hello, world, make_ref()}, - BinMsg = term_to_binary(Msg), + Test = fun(Msg) -> + BinMsg = term_to_binary(Msg), + + Msg = erlang:port_call(Prt, 0, Msg), + [{trace, Prt, 'receive', {S, {call, {0, BinMsg}}}}, + {trace, Prt, send, {Prt, {call, BinMsg}}, S}] = flush() + end, - Msg = erlang:port_call(Prt, 0, Msg), - [{trace, Prt, 'receive', {S, {call, {0, BinMsg}}}}, - {trace, Prt, send, {Prt, {call, BinMsg}}, S}] = flush(), + Test({hello, world, make_ref()}), + Test({hello, world, lists:seq(1,1000)}), close(Prt, Flags), diff --git a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c index b5728bc170..b5ae9389b4 100644 --- a/erts/emulator/test/port_trace_SUITE_data/echo_drv.c +++ b/erts/emulator/test/port_trace_SUITE_data/echo_drv.c @@ -217,6 +217,8 @@ static ErlDrvSSizeT echo_drv_control(ErlDrvData drv_data, char *buf, ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) { + if ((len - 1) > rlen) + *rbuf = driver_alloc(len - 1); memcpy(*rbuf, buf+1, len-1); return len-1; } @@ -232,6 +234,8 @@ static ErlDrvSSizeT echo_drv_call(ErlDrvData drv_data, char **rbuf, ErlDrvSizeT rlen, unsigned int *flags) { + if ((len - command) > rlen) + *rbuf = driver_alloc(len - command); memcpy(*rbuf, buf+command, len-command); return len-command; } diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl index af1a0d35d6..aae7651f6d 100644 --- a/erts/emulator/test/save_calls_SUITE.erl +++ b/erts/emulator/test/save_calls_SUITE.erl @@ -60,7 +60,7 @@ dont_break_reductions(Config) when is_list(Config) -> RPS1 = reds_per_sched(0), RPS2 = reds_per_sched(20), Diff = abs(RPS1 - RPS2), - true = (Diff < (0.05 * RPS1)), + true = (Diff < (0.2 * RPS1)), ok. diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl index b7ff4c109c..c3e303bbd1 100644 --- a/erts/emulator/test/sensitive_SUITE.erl +++ b/erts/emulator/test/sensitive_SUITE.erl @@ -311,7 +311,7 @@ gc_trace(Config) when is_list(Config) -> wait_trace(Self), {messages,Messages} = process_info(Tracer, messages), - [{trace,Self,gc_start,_},{trace,Self,gc_end,_}] = Messages, + [{trace,Self,gc_major_start,_},{trace,Self,gc_major_end,_}] = Messages, unlink(Tracer), exit(Tracer, kill), ok. diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index b7f312635e..29e043dd5c 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -27,11 +27,12 @@ -export([all/0, suite/0, link_receive_call_correlation/0, receive_trace/1, link_receive_call_correlation/1, self_send/1, timeout_trace/1, send_trace/1, - procs_trace/1, dist_procs_trace/1, + procs_trace/1, dist_procs_trace/1, procs_new_trace/1, suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1, suspend_system_limit/1, suspend_opts/1, suspend_waiting/1, new_clear/1, existing_clear/1, set_on_spawn/1, set_on_first_spawn/1, cpu_timestamp/1, + set_on_link/1, set_on_first_link/1, system_monitor_args/1, more_system_monitor_args/1, system_monitor_long_gc_1/1, system_monitor_long_gc_2/1, system_monitor_large_heap_1/1, system_monitor_large_heap_2/1, @@ -54,7 +55,8 @@ all() -> mutual_suspend, suspend_exit, suspender_exit, suspend_system_limit, suspend_opts, suspend_waiting, new_clear, existing_clear, set_on_spawn, - set_on_first_spawn, system_monitor_args, + set_on_first_spawn, set_on_link, set_on_first_link, + system_monitor_args, more_system_monitor_args, system_monitor_long_gc_1, system_monitor_long_gc_2, system_monitor_large_heap_1, system_monitor_long_schedule, @@ -454,6 +456,34 @@ dist_procs_trace(Config) when is_list(Config) -> true = stop_node(OtherNode), ok. +%% Test trace(new, How, [procs]). +procs_new_trace(Config) when is_list(Config) -> + Self = self(), + process_flag(trap_exit, true), + %% + Proc1 = spawn_link(?MODULE, process, [Self]), + io:format("Proc1 = ~p ~n", [Proc1]), + %% + 0 = erlang:trace(new, true, [procs]), + + MFA = {?MODULE, process, [Self]}, + %% + %% spawn, link + Proc1 ! {spawn_link_please, Self, MFA}, + Proc3 = receive {spawned, Proc1, P3} -> P3 end, + receive {trace, Proc3, spawned, Proc1, MFA} -> ok end, + receive {trace, Proc3, getting_linked, Proc1} -> ok end, + io:format("Proc3 = ~p ~n", [Proc3]), + receive_nothing(), + %% + %% + %% exit (not linked to tracing process) + Reason1 = make_ref(), + Proc1 ! {exit_please, Reason1}, + receive {'EXIT', Proc1, Reason1} -> ok end, + {trace, Proc3, exit, Reason1} = receive_first_trace(), + receive_nothing(), + ok. @@ -501,6 +531,51 @@ set_on_first_spawn(Config) when is_list(Config) -> receive_nothing(), ok. +%% Tests trace(Pid, How, [set_on_link]). + +set_on_link(Config) -> + Listener = fun_spawn(fun process/0), + + %% Create and trace a process with the set_on_link flag. + %% Make sure it is traced. + Father_SOL = fun_spawn(fun process/0), + 1 = erlang:trace(Father_SOL, true, [send, set_on_link]), + true = is_send_traced(Father_SOL, Listener, sol_father), + + %% Have the process spawn of two children and test that they + %% are traced. + [Child1, Child2] = spawn_children(Father_SOL, 2), + true = is_send_traced(Child1, Listener, child1), + true = is_send_traced(Child2, Listener, child2), + + %% Second generation. + [Child11, Child12] = spawn_children(Child1, 2), + true = is_send_traced(Child11, Listener, child11), + true = is_send_traced(Child12, Listener, child12), + ok. + +%% Tests trace(Pid, How, [set_on_first_spawn]). + +set_on_first_link(Config) -> + ct:timetrap({seconds, 10}), + Listener = fun_spawn(fun process/0), + + %% Create and trace a process with the set_on_first_spawn flag. + %% Make sure it is traced. + Parent = fun_spawn(fun process/0), + 1 = erlang:trace(Parent, true, [send, set_on_first_link]), + is_send_traced(Parent, Listener, sol_father), + + %% Have the process spawn off three children and test that the + %% first is traced. + [Child1, Child2, Child3] = spawn_children(Parent, 3), + true = is_send_traced(Child1, Listener, child1), + false = is_send_traced(Child2, Listener, child2), + false = is_send_traced(Child3, Listener, child3), + receive_nothing(), + ok. + + %% Tests arguments to erlang:system_monitor/0,1,2 system_monitor_args(Config) when is_list(Config) -> diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl index 1068c1d22d..a66563d15b 100644 --- a/erts/emulator/test/trace_port_SUITE.erl +++ b/erts/emulator/test/trace_port_SUITE.erl @@ -236,13 +236,13 @@ gc(Config) when is_list(Config) -> trace_info(Garber, flags), Garber ! hi, - expect({trace,Garber,gc_start,info}), - expect({trace,Garber,gc_end,info}), + expect({trace,Garber,gc_major_start,info}), + expect({trace,Garber,gc_major_end,info}), trac(Garber, true, [garbage_collection,timestamp]), Garber ! hi, - expect({trace_ts,Garber,gc_start,info,ts}), - expect({trace_ts,Garber,gc_end,info,ts}), + expect({trace_ts,Garber,gc_major_start,info,ts}), + expect({trace_ts,Garber,gc_major_end,info,ts}), ok. diff --git a/erts/emulator/test/tracer_SUITE.erl b/erts/emulator/test/tracer_SUITE.erl index 812e834562..de44d6656a 100644 --- a/erts/emulator/test/tracer_SUITE.erl +++ b/erts/emulator/test/tracer_SUITE.erl @@ -468,12 +468,12 @@ gc_start(_Config) -> fun(Pid, State, EOpts) -> receive Msg -> - {Pid, gc_start, State, Pid, _, undefined, Opts} = Msg, + {Pid, gc_major_start, State, Pid, _, undefined, Opts} = Msg, check_opts(EOpts, Opts) end end, - test(gc_start, garbage_collection, Tc, Expect, true). + test(gc_major_start, garbage_collection, Tc, Expect, true). gc_end(_Config) -> @@ -488,12 +488,12 @@ gc_end(_Config) -> fun(Pid, State, EOpts) -> receive Msg -> - {Pid, gc_end, State, Pid, _, undefined, Opts} = Msg, + {Pid, gc_major_end, State, Pid, _, undefined, Opts} = Msg, check_opts(EOpts, Opts) end end, - test(gc_end, garbage_collection, Tc, Expect, true). + test(gc_major_end, garbage_collection, Tc, Expect, true). test(Event, Tc, Expect) -> test(Event, Tc, Expect, true). diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 82a0303f86..5a5021b003 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -150,6 +150,7 @@ static char *plush_val_switches[] = { "ms", "mbs", "pds", + "mqd", "", NULL }; @@ -160,12 +161,6 @@ static char *plusr_val_switches[] = { NULL }; -/* +x arguments with values */ -static char *plusx_val_switches[] = { - "mqd", - NULL -}; - /* +z arguments with values */ static char *plusz_val_switches[] = { "dbbl", @@ -986,20 +981,6 @@ int main(int argc, char **argv) add_Eargs(argv[i+1]); i++; break; - case 'x': - if (!is_one_of_strings(&argv[i][2], plusx_val_switches)) { - goto the_default; - } else { - if (i+1 >= argc - || argv[i+1][0] == '-' - || argv[i+1][0] == '+') - usage(argv[i]); - argv[i][0] = '-'; - add_Eargs(argv[i]); - add_Eargs(argv[i+1]); - i++; - } - break; case 'z': if (!is_one_of_strings(&argv[i][2], plusz_val_switches)) { goto the_default; @@ -1200,7 +1181,7 @@ usage_aux(void) "[+S NO_SCHEDULERS:NO_SCHEDULERS_ONLINE] " "[+SP PERCENTAGE_SCHEDULERS:PERCENTAGE_SCHEDULERS_ONLINE] " "[+T LEVEL] [+V] [+v] " - "[+W<i|w|e>] [+x DEFAULT_PROC_FLAGS] [+z MISC_OPTION] [args ...]\n"); + "[+W<i|w|e>] [+z MISC_OPTION] [args ...]\n"); exit(1); } diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 77685013ae..3e82b8e20e 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erl_tracer.beam b/erts/preloaded/ebin/erl_tracer.beam Binary files differindex ffe5d5631c..67d96d0f0d 100644 --- a/erts/preloaded/ebin/erl_tracer.beam +++ b/erts/preloaded/ebin/erl_tracer.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 15e4ca82a7..321e4e7e1b 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam Binary files differindex 3e95b1e42e..0c667663fd 100644 --- a/erts/preloaded/ebin/erts_code_purger.beam +++ b/erts/preloaded/ebin/erts_code_purger.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex 53dd2897de..ed2e328f5b 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 ee32066f53..23ebd2cad9 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 51a412b7f7..b63fa24848 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 45bed5cf7e..7c8fdc82c0 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 c25bffb6a5..d4559bc9ed 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 85d74de065..5a0678632e 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 1f8fe6f03b..3d32dd8449 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 059585ec99..ced9f9c952 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erl_tracer.erl b/erts/preloaded/src/erl_tracer.erl index 2177e48f60..de1e9ca01e 100644 --- a/erts/preloaded/src/erl_tracer.erl +++ b/erts/preloaded/src/erl_tracer.erl @@ -3,12 +3,29 @@ -export([enabled/3, trace/6, on_load/0]). -type tracee() :: port() | pid() | undefined. --type trace_tag() :: send | send_to_non_existing_process | 'receive' | - call | return_to | return_from | exception_from | - spawn | spawned | exit | link | unlink | getting_linked | - getting_unlinked | register | unregister | in | out | - in_exiting | out_exiting | out_exited | - open | closed | gc_start | gc_end. + +-type trace_tag_running_ports() :: in | out | in_exiting | out_exiting | out_exited. +-type trace_tag_running_procs() :: in | out | in_exiting | out_exiting | out_exited. +-type trace_tag_send() :: send | send_to_non_existing_process. +-type trace_tag_receive() :: 'receive'. +-type trace_tag_call() :: call | return_to | return_from | exception_from. +-type trace_tag_procs() :: spawn | spawned | exit | link | unlink + | getting_linked | getting_unlinked + | register | unregister. +-type trace_tag_ports() :: open | closed | link | unlink + | getting_linked | getting_unlinked. +-type trace_tag_gc() :: gc_minor_start | gc_minor_end + | gc_major_start | gc_major_end. + +-type trace_tag() :: trace_tag_send() + | trace_tag_receive() + | trace_tag_call() + | trace_tag_procs() + | trace_tag_ports() + | trace_tag_running_procs() + | trace_tag_running_ports() + | trace_tag_gc(). + -type trace_opts() :: #{ match_spec_result => true | term(), scheduler_id => undefined | non_neg_integer(), timestamp => undefined | timestamp | cpu_timestamp | diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 3cc17014ff..20a64e81b4 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2257,9 +2257,9 @@ spawn_opt(_Tuple) -> Input :: non_neg_integer(), Output :: non_neg_integer(); (microstate_accounting) -> [MSAcc_Thread] | undefined when - MSAcc_Thread :: #{ type => MSAcc_Thread_Type, - id => MSAcc_Thread_Id, - counters => MSAcc_Counters}, + MSAcc_Thread :: #{ type := MSAcc_Thread_Type, + id := MSAcc_Thread_Id, + counters := MSAcc_Counters}, MSAcc_Thread_Type :: scheduler | async | aux, MSAcc_Thread_Id :: non_neg_integer(), MSAcc_Counters :: #{ MSAcc_Thread_State => non_neg_integer() }, diff --git a/lib/common_test/doc/src/ct.xml b/lib/common_test/doc/src/ct.xml index 23aeaa38ea..5231ef24a4 100644 --- a/lib/common_test/doc/src/ct.xml +++ b/lib/common_test/doc/src/ct.xml @@ -601,18 +601,21 @@ </func> <func> - <name>get_timetrap_info() -> {Time, Scale}</name> + <name>get_timetrap_info() -> {Time, {Scaling,ScaleVal}}</name> <fsummary>Reads information about the timetrap set for the current test case.</fsummary> <type> <v>Time = integer() | infinity</v> - <v>Scale = true | false</v> + <v>Scaling = true | false</v> + <v>ScaleVal = integer()</v> </type> <desc><marker id="get_timetrap_info-0"/> <p>Reads information about the timetrap set for the current test - case. <c>Scale</c> indicates if <c>Common Test</c> will attempt + case. <c>Scaling</c> indicates if <c>Common Test</c> will attempt to compensate timetraps automatically for runtime delays - introduced by, for example, tools like cover.</p> + introduced by, for example, tools like cover. <c>ScaleVal</c> is + the value of the current scaling multipler (always 1 if scaling is + disabled). Note the <c>Time</c> is not the scaled result.</p> </desc> </func> @@ -1136,7 +1139,7 @@ Opts.</fsummary> <type> <v>Opts = [OptTuples]</v> - <v>OptTuples = {dir, TestDirs} | {suite, Suites} | {group, Groups} | {testcase, Cases} | {spec, TestSpecs} | {join_specs, Bool} | {label, Label} | {config, CfgFiles} | {userconfig, UserConfig} | {allow_user_terms, Bool} | {logdir, LogDir} | {silent_connections, Conns} | {stylesheet, CSSFile} | {cover, CoverSpecFile} | {cover_stop, Bool} | {step, StepOpts} | {event_handler, EventHandlers} | {include, InclDirs} | {auto_compile, Bool} | {abort_if_missing_suites, Bool} | {create_priv_dir, CreatePrivDir} | {multiply_timetraps, M} | {scale_timetraps, Bool} | {repeat, N} | {duration, DurTime} | {until, StopTime} | {force_stop, ForceStop} | {decrypt, DecryptKeyOrFile} | {refresh_logs, LogDir} | {logopts, LogOpts} | {verbosity, VLevels} | {basic_html, Bool} | {ct_hooks, CTHs} | {enable_builtin_hooks, Bool} | {release_shell, Bool}</v> + <v>OptTuples = {dir, TestDirs} | {suite, Suites} | {group, Groups} | {testcase, Cases} | {spec, TestSpecs} | {join_specs, Bool} | {label, Label} | {config, CfgFiles} | {userconfig, UserConfig} | {allow_user_terms, Bool} | {logdir, LogDir} | {silent_connections, Conns} | {stylesheet, CSSFile} | {cover, CoverSpecFile} | {cover_stop, Bool} | {step, StepOpts} | {event_handler, EventHandlers} | {include, InclDirs} | {auto_compile, Bool} | {abort_if_missing_suites, Bool} | {create_priv_dir, CreatePrivDir} | {multiply_timetraps, M} | {scale_timetraps, Bool} | {repeat, N} | {duration, DurTime} | {until, StopTime} | {force_stop, ForceStop} | {decrypt, DecryptKeyOrFile} | {refresh_logs, LogDir} | {logopts, LogOpts} | {verbosity, VLevels} | {basic_html, Bool} | {esc_chars, Bool} | {ct_hooks, CTHs} | {enable_builtin_hooks, Bool} | {release_shell, Bool}</v> <v>TestDirs = [string()] | string()</v> <v>Suites = [string()] | [atom()] | string() | atom()</v> <v>Cases = [atom()] | atom()</v> diff --git a/lib/common_test/doc/src/ct_run.xml b/lib/common_test/doc/src/ct_run.xml index 88873ce5b2..9e6229f1dd 100644 --- a/lib/common_test/doc/src/ct_run.xml +++ b/lib/common_test/doc/src/ct_run.xml @@ -124,6 +124,7 @@ [-duration HHMMSS [-force_stop [skip_rest]]] | [-until [YYMoMoDD]HHMMSS [-force_stop [skip_rest]]] [-basic_html] + [-no_esc_chars] [-ct_hooks CTHModule1 CTHOpts1 and CTHModule2 CTHOpts2 and .. CTHModuleN CTHOptsN] [-exit_status ignore_config] @@ -162,6 +163,7 @@ [-duration HHMMSS [-force_stop [skip_rest]]] | [-until [YYMoMoDD]HHMMSS [-force_stop [skip_rest]]] [-basic_html] + [-no_esc_chars] [-ct_hooks CTHModule1 CTHOpts1 and CTHModule2 CTHOpts2 and .. CTHModuleN CTHOptsN] [-exit_status ignore_config]</pre> @@ -186,7 +188,8 @@ [-muliply_timetraps Multiplier] [-scale_timetraps] [-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc] - [-basic_html]</pre> + [-basic_html] + [-no_esc_chars]</pre> </section> <section> diff --git a/lib/common_test/doc/src/ct_telnet.xml b/lib/common_test/doc/src/ct_telnet.xml index b35e511501..e2a45e894b 100644 --- a/lib/common_test/doc/src/ct_telnet.xml +++ b/lib/common_test/doc/src/ct_telnet.xml @@ -64,6 +64,8 @@ remaining string terminated) = 0</p></item> <item><p>Polling interval (sleep time between polls) = 1 second</p> </item> + <item><p>The TCP_NODELAY option for the telnet socket + is disabled (set to <c>false</c>) per default</p></item> </list> <p>These parameters can be modified by the user with the following @@ -76,7 +78,8 @@ {reconnection_interval,Millisec}, {keep_alive,Bool}, {poll_limit,N}, - {poll_interval,Millisec}]}.</pre> + {poll_interval,Millisec}, + {tcp_nodelay,Bool}]}.</pre> <p><c>Millisec = integer(), N = integer()</c></p> diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index aba71b0d4a..ebba864606 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -33,6 +33,68 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.12.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The <c>nodelay</c> option used to be enabled + (<c>true</c>) by default for sockets opened by the Common + Test telnet client. This appeared to cause communication + problems with telnet servers on some systems, and + therefore the option is no longer used. Its value may + instead be specified in the telnet connection settings. + See the man page for <c>ct_telnet</c> for details. Please + note that the interface function <c>connect</c> in + <c>unix_telnet</c> has been updated with an extra + argument and is now <c>unix_telnet:connect/7</c>.</p> + <p> + Own Id: OTP-13462 Aux Id: seq13077 </p> + </item> + <item> + <p> + Fix bug in cth_surefire: When a pre_init_per_suite hook + fails before reaching the + cth_surefire:pre_init_per_suite, cth_surefire produced + incorrect XML.</p> + <p> + Own Id: OTP-13513</p> + </item> + <item> + <p> + The <c>ct:get_timetrap_info/0</c> function has been + updated to return more information about timetrap + scaling.</p> + <p> + Own Id: OTP-13535</p> + </item> + <item> + <p> + A problem with stylesheet HTML tags getting incorrectly + escaped by Common Test has been corrected.</p> + <p> + Own Id: OTP-13536</p> + </item> + <item> + <p> + The <c>ct_run</c> start flag <c>-no_esc_chars</c> and + <c>ct:run_test/1</c> start option <c>{esc_chars,Bool}</c> + have been introduced to make it possible to disable + automatic escaping of characters. Automatic escaping of + special HTML characters printed with <c>io:format/1,2</c> + and <c>ct:pal/1,2,3,4</c> was introduced in Common Test + 1.12. The new flag/option may be used to disable this + feature for backwards compatibility reasons. (The option + is also supported in test specifications).</p> + <p> + Own Id: OTP-13537</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.12</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/doc/src/run_test_chapter.xml b/lib/common_test/doc/src/run_test_chapter.xml index 5ae32ee230..43e36adfb6 100644 --- a/lib/common_test/doc/src/run_test_chapter.xml +++ b/lib/common_test/doc/src/run_test_chapter.xml @@ -266,6 +266,10 @@ <tag><c><![CDATA[-verbosity <levels>]]></c></tag> <item><p>Sets <seealso marker="write_test_chapter#logging">verbosity levels for printouts</seealso>.</p></item> + + <tag><c><![CDATA[-no_esc_chars]]></c></tag> + <item><p>Disables automatic escaping of special HTML characters. + See the <seealso marker="write_test_chapter#logging">Logging chapter</seealso>.</p></item> </taglist> <note><p>Directories passed to <c>Common Test</c> can have either relative or absolute paths.</p></note> @@ -802,7 +806,7 @@ program</seealso> for an overview of available start flags (as most flags have a corresponding configuration term)</item> <item><seealso marker="write_test_chapter#logging">Logging</seealso> - (for terms <c>verbosity</c>, <c>stylesheet</c> and <c>basic_html</c>)</item> + (for terms <c>verbosity</c>, <c>stylesheet</c>, <c>basic_html</c> and <c>esc_chars</c>)</item> <item><seealso marker="config_file_chapter#top">External Configuration Data</seealso> (for terms <c>config</c> and <c>userconfig</c>)</item> <item><seealso marker="event_handler_chapter#event_handling">Event @@ -887,6 +891,9 @@ {basic_html, Bool}. {basic_html, NodeRefs, Bool}. + {esc_chars, Bool}. + {esc_chars, NodeRefs, Bool}. + {release_shell, Bool}.</pre> <p><em>Test terms:</em></p> diff --git a/lib/common_test/doc/src/unix_telnet.xml b/lib/common_test/doc/src/unix_telnet.xml index 701d5ec88e..b2314a53ec 100644 --- a/lib/common_test/doc/src/unix_telnet.xml +++ b/lib/common_test/doc/src/unix_telnet.xml @@ -80,7 +80,7 @@ <funcs> <func> - <name>connect(ConnName, Ip, Port, Timeout, KeepAlive, Extra) -> {ok, Handle} | {error, Reason}</name> + <name>connect(ConnName, Ip, Port, Timeout, KeepAlive, TCPNoDelay, Extra) -> {ok, Handle} | {error, Reason}</name> <fsummary>Callback for ct_telnet.erl.</fsummary> <type> <v>ConnName = target_name()</v> @@ -88,6 +88,7 @@ <v>Port = integer()</v> <v>Timeout = integer()</v> <v>KeepAlive = bool()</v> + <v>TCPNoDelay = bool()</v> <v>Extra = target_name() | {Username, Password}</v> <v>Username = string()</v> <v>Password = string()</v> diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml index 40e02347f2..83daf771a6 100644 --- a/lib/common_test/doc/src/write_test_chapter.xml +++ b/lib/common_test/doc/src/write_test_chapter.xml @@ -1047,9 +1047,15 @@ <p>Common Test will escape special HTML characters (<, > and &) in printouts to the log file made with <c>ct:pal/4</c> and <c>io:format/2</c>. In order to print - strings with HTML tags to the log, use the <c>ct:log/5</c> function. The character escaping - feature is per default disabled for <c>ct:log/5</c>, but can be enabled with the - <c>esc_chars</c> option.</p> + strings with HTML tags to the log, use the <c>ct:log/3,4,5</c> function. The character + escaping feature is per default disabled for <c>ct:log/3,4,5</c> but can be enabled with + the <c>esc_chars</c> option in the <c>Opts</c> list, see <seealso marker="ct#log-5"> + <c>ct:log/3,4,5</c></seealso>.</p> + + <p>If the character escaping feature needs to be disabled (typically for backwards + compatibility reasons), use the <c>ct_run</c> start flag <c>-no_esc_chars</c>, or the + <c>ct:run_test/1</c> start option <c>{esc_chars,Bool}</c> (this start option is also + supported in test specifications).</p> <p>For more information about log files, see section <seealso marker="run_test_chapter#log_files">Log Files</seealso> diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 7fe90b60ff..cae7bea406 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -161,9 +161,9 @@ run(TestDirs) -> %%% {repeat,N} | {duration,DurTime} | {until,StopTime} | %%% {force_stop,ForceStop} | {decrypt,DecryptKeyOrFile} | %%% {refresh_logs,LogDir} | {logopts,LogOpts} | -%%% {verbosity,VLevels} | {basic_html,Bool} | -%%% {ct_hooks, CTHs} | {enable_builtin_hooks,Bool} | -%%% {release_shell,Bool} +%%% {verbosity,VLevels} | {basic_html,Bool} | +%%% {esc_chars,Bool} | {ct_hooks, CTHs} | +%%% {enable_builtin_hooks,Bool} | {release_shell,Bool} %%% TestDirs = [string()] | string() %%% Suites = [string()] | [atom()] | string() | atom() %%% Cases = [atom()] | atom() diff --git a/lib/common_test/src/ct_groups.erl b/lib/common_test/src/ct_groups.erl index 80f5c30c2a..dd04c5410a 100644 --- a/lib/common_test/src/ct_groups.erl +++ b/lib/common_test/src/ct_groups.erl @@ -325,7 +325,7 @@ modify_tc_list1(GrSpecTs, TSCs) -> true -> {[TC|TSCs1],lists:delete(TC,GrSpecTs2)}; false -> - case lists:keymember(TC, 2, GrSpecTs) of + case lists:keysearch(TC, 2, GrSpecTs) of {value,Test} -> {[Test|TSCs1], lists:keydelete(TC, 2, GrSpecTs2)}; diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index d8f583455b..5422d449fd 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -67,6 +67,8 @@ terminate(Hooks) -> %% tests. -spec init_tc(Mod :: atom(), FuncSpec :: atom() | + {ConfigFunc :: init_per_testcase | end_per_testcase, + TestCase :: atom()} | {ConfigFunc :: init_per_group | end_per_group, GroupName :: atom(), Properties :: list()}, @@ -103,7 +105,9 @@ init_tc(_Mod, TC = error_in_suite, Config) -> %% @doc Called as each test case is completed. This includes all configuration %% tests. -spec end_tc(Mod :: atom(), - FuncSpec :: atom() | + FuncSpec :: atom() | + {ConfigFunc :: init_per_testcase | end_per_testcase, + TestCase :: atom()} | {ConfigFunc :: init_per_group | end_per_group, GroupName :: atom(), Properties :: list()}, diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 77828a2186..29b38e9748 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -609,7 +609,8 @@ log_timestamp({MS,S,US}) -> ct_log_fd, tc_groupleaders, stylesheet, - async_print_jobs}). + async_print_jobs, + tc_esc_chars}). logger(Parent, Mode, Verbosity) -> register(?MODULE,self()), @@ -728,14 +729,18 @@ logger(Parent, Mode, Verbosity) -> end end || {Cat,VLvl} <- Verbosity], io:nl(CtLogFd), - + TcEscChars = case application:get_env(common_test, esc_chars) of + {ok,ECBool} -> ECBool; + _ -> true + end, logger_loop(#logger_state{parent=Parent, log_dir=AbsDir, start_time=Time, orig_GL=group_leader(), ct_log_fd=CtLogFd, tc_groupleaders=[], - async_print_jobs=[]}). + async_print_jobs=[], + tc_esc_chars=TcEscChars}). copy_priv_files([SrcF | SrcFs], [DestF | DestFs]) -> case file:copy(SrcF, DestF) of @@ -761,20 +766,21 @@ logger_loop(State) -> end, if Importance >= (100-VLvl) -> CtLogFd = State#logger_state.ct_log_fd, + DoEscChars = State#logger_state.tc_esc_chars and EscChars, case get_groupleader(Pid, GL, State) of {tc_log,TCGL,TCGLs} -> case erlang:is_process_alive(TCGL) of true -> State1 = print_to_log(SyncOrAsync, Pid, Category, TCGL, Content, - EscChars, State), + DoEscChars, State), logger_loop(State1#logger_state{ tc_groupleaders = TCGLs}); false -> %% Group leader is dead, so write to the %% CtLog or unexpected_io log instead unexpected_io(Pid, Category, Importance, - Content, CtLogFd, EscChars), + Content, CtLogFd, DoEscChars), logger_loop(State) end; @@ -783,7 +789,7 @@ logger_loop(State) -> %% to ct_log, else write to unexpected_io %% log unexpected_io(Pid, Category, Importance, Content, - CtLogFd, EscChars), + CtLogFd, DoEscChars), logger_loop(State#logger_state{ tc_groupleaders = TCGLs}) end; @@ -794,7 +800,7 @@ logger_loop(State) -> %% make sure no IO for this test case from the %% CT logger gets rejected test_server:permit_io(GL, self()), - print_style(GL, State#logger_state.stylesheet), + print_style(GL,GL,State#logger_state.stylesheet), set_evmgr_gl(GL), TCGLs = add_tc_gl(TCPid,GL,State), if not RefreshLog -> @@ -882,7 +888,7 @@ create_io_fun(FromPid, CtLogFd, EscChars) -> {_HdOrFt,S,A} -> {false,S,A}; {S,A} -> {true,S,A} end, - try io_lib:format(Str,Args) of + try io_lib:format(Str, Args) of IoStr when Escapable, EscChars, IoList == [] -> escape_chars(IoStr); IoStr when Escapable, EscChars -> @@ -925,7 +931,12 @@ print_to_log(sync, FromPid, Category, TCGL, Content, EscChars, State) -> if FromPid /= TCGL -> IoFun = create_io_fun(FromPid, CtLogFd, EscChars), IoList = lists:foldl(IoFun, [], Content), - io:format(TCGL,["$tc_html","~ts"], [IoList]); + try io:format(TCGL,["$tc_html","~ts"], [IoList]) of + ok -> ok + catch + _:_ -> + io:format(TCGL,"~ts", [IoList]) + end; true -> unexpected_io(FromPid, Category, ?MAX_IMPORTANCE, Content, CtLogFd, EscChars) @@ -958,7 +969,10 @@ print_to_log(async, FromPid, Category, TCGL, Content, EscChars, State) -> _:terminated -> unexpected_io(FromPid, Category, ?MAX_IMPORTANCE, - Content, CtLogFd, EscChars) + Content, CtLogFd, EscChars); + _:_ -> + io:format(TCGL, "~ts", + [lists:foldl(IoFun,[],Content)]) end; false -> unexpected_io(FromPid, Category, @@ -1099,26 +1113,27 @@ open_ctlog(MiscIoName) -> "View I/O logged after the test run</a></li>\n</ul>\n", [MiscIoName,MiscIoName]), - print_style(Fd,undefined), + print_style(Fd,group_leader(),undefined), io:format(Fd, xhtml("<br><h2>Progress Log</h2>\n<pre>\n", "<br />\n<h4>PROGRESS LOG</h4>\n<pre>\n"), []), Fd. -print_style(Fd,undefined) -> +print_style(Fd,GL,undefined) -> case basic_html() of true -> - io:format(Fd, - "<style>\n" - "div.ct_internal { background:lightgrey; color:black; }\n" - "div.default { background:lightgreen; color:black; }\n" - "</style>\n", - []); + Style = "<style>\n + div.ct_internal { background:lightgrey; color:black; }\n + div.default { background:lightgreen; color:black; }\n + </style>\n", + if Fd == GL -> io:format(["$tc_html",Style], []); + true -> io:format(Fd, Style, []) + end; _ -> ok end; -print_style(Fd,StyleSheet) -> +print_style(Fd,GL,StyleSheet) -> case file:read_file(StyleSheet) of {ok,Bin} -> Str = b2s(Bin,encoding(StyleSheet)), @@ -1131,23 +1146,30 @@ print_style(Fd,StyleSheet) -> N1 -> N1 end, if (Pos0 == 0) and (Pos1 /= 0) -> - print_style_error(Fd,StyleSheet,missing_style_start_tag); + print_style_error(Fd,GL,StyleSheet,missing_style_start_tag); (Pos0 /= 0) and (Pos1 == 0) -> - print_style_error(Fd,StyleSheet,missing_style_end_tag); + print_style_error(Fd,GL,StyleSheet,missing_style_end_tag); Pos0 /= 0 -> Style = string:sub_string(Str,Pos0,Pos1+7), - io:format(Fd,"~ts\n",[Style]); + if Fd == GL -> io:format(Fd,["$tc_html","~ts\n"],[Style]); + true -> io:format(Fd,"~ts\n",[Style]) + end; Pos0 == 0 -> - io:format(Fd,"<style>~ts</style>\n",[Str]) + if Fd == GL -> io:format(Fd,["$tc_html","<style>\n~ts</style>\n"],[Str]); + true -> io:format(Fd,"<style>\n~ts</style>\n",[Str]) + end end; {error,Reason} -> - print_style_error(Fd,StyleSheet,Reason) + print_style_error(Fd,GL,StyleSheet,Reason) end. -print_style_error(Fd,StyleSheet,Reason) -> - io:format(Fd,"\n<!-- Failed to load stylesheet ~ts: ~p -->\n", - [StyleSheet,Reason]), - print_style(Fd,undefined). +print_style_error(Fd,GL,StyleSheet,Reason) -> + IO = io_lib:format("\n<!-- Failed to load stylesheet ~ts: ~p -->\n", + [StyleSheet,Reason]), + if Fd == GL -> io:format(Fd,["$tc_html",IO],[]); + true -> io:format(Fd,IO,[]) + end, + print_style(Fd,GL,undefined). close_ctlog(Fd) -> io:format(Fd, "\n</pre>\n", []), diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 32c8ab96ec..c4905b316f 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -27,7 +27,7 @@ -export([run_on_node/2,run_on_node/3]). -export([run_test/1,run_test/2]). -export([get_event_mgr_ref/0]). --export([basic_html/1]). +-export([basic_html/1,esc_chars/1]). -export([abort/0,abort/1,progress/0]). @@ -317,6 +317,16 @@ basic_html(Bool) -> ok. %%%----------------------------------------------------------------- +%%% @spec esc_chars(Bool) -> ok +%%% Bool = true | false +%%% +%%% @doc If set to false, the ct_master logs will be written without +%%% special characters being escaped in the HTML logs. +esc_chars(Bool) -> + application:set_env(common_test_master, esc_chars, Bool), + ok. + +%%%----------------------------------------------------------------- %%% MASTER, runs on central controlling node. %%%----------------------------------------------------------------- start_master(NodeOptsList) -> diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index e156c9b773..1e5f935198 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -65,6 +65,7 @@ logdir, logopts = [], basic_html, + esc_chars = true, verbosity = [], config = [], event_handlers = [], @@ -346,6 +347,15 @@ script_start1(Parent, Args) -> application:set_env(common_test, basic_html, true), true end, + %% esc_chars - used by ct_logs + EscChars = case proplists:get_value(no_esc_chars, Args) of + undefined -> + application:set_env(common_test, esc_chars, true), + undefined; + _ -> + application:set_env(common_test, esc_chars, false), + false + end, %% disable_log_cache - used by ct_logs case proplists:get_value(disable_log_cache, Args) of undefined -> @@ -359,6 +369,7 @@ script_start1(Parent, Args) -> cover = Cover, cover_stop = CoverStop, logdir = LogDir, logopts = LogOpts, basic_html = BasicHtml, + esc_chars = EscChars, verbosity = Verbosity, event_handlers = EvHandlers, ct_hooks = CTHooks, @@ -587,6 +598,17 @@ combine_test_opts(TS, Specs, Opts) -> BHBool end, + EscChars = + case choose_val(Opts#opts.esc_chars, + TSOpts#opts.esc_chars) of + undefined -> + true; + ECBool -> + application:set_env(common_test, esc_chars, + ECBool), + ECBool + end, + Opts#opts{label = Label, profile = Profile, testspec_files = Specs, @@ -595,6 +617,7 @@ combine_test_opts(TS, Specs, Opts) -> logdir = which(logdir, LogDir), logopts = AllLogOpts, basic_html = BasicHtml, + esc_chars = EscChars, verbosity = AllVerbosity, silent_connections = AllSilentConns, config = TSOpts#opts.config, @@ -795,6 +818,7 @@ script_usage() -> "\n\t [-scale_timetraps]" "\n\t [-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" "\n\t [-basic_html]" + "\n\t [-no_esc_chars]" "\n\t [-repeat N] |" "\n\t [-duration HHMMSS [-force_stop [skip_rest]]] |" "\n\t [-until [YYMoMoDD]HHMMSS [-force_stop [skip_rest]]]" @@ -822,6 +846,7 @@ script_usage() -> "\n\t [-scale_timetraps]" "\n\t [-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" "\n\t [-basic_html]" + "\n\t [-no_esc_chars]" "\n\t [-repeat N] |" "\n\t [-duration HHMMSS [-force_stop [skip_rest]]] |" "\n\t [-until [YYMoMoDD]HHMMSS [-force_stop [skip_rest]]]\n\n"), @@ -847,7 +872,8 @@ script_usage() -> "\n\t [-multiply_timetraps N]" "\n\t [-scale_timetraps]" "\n\t [-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]" - "\n\t [-basic_html]\n\n"). + "\n\t [-basic_html]" + "\n\t [-no_esc_chars]\n\n"). %%%----------------------------------------------------------------- %%% @hidden @@ -1089,7 +1115,17 @@ run_test2(StartOpts) -> application:set_env(common_test, basic_html, BasicHtmlBool), BasicHtmlBool end, - + %% esc_chars - used by ct_logs + EscChars = + case proplists:get_value(esc_chars, StartOpts) of + undefined -> + application:set_env(common_test, esc_chars, true), + undefined; + EscCharsBool -> + application:set_env(common_test, esc_chars, EscCharsBool), + EscCharsBool + end, + %% disable_log_cache - used by ct_logs case proplists:get_value(disable_log_cache, StartOpts) of undefined -> application:set_env(common_test, disable_log_cache, false); @@ -1104,6 +1140,7 @@ run_test2(StartOpts) -> cover = Cover, cover_stop = CoverStop, step = Step, logdir = LogDir, logopts = LogOpts, basic_html = BasicHtml, + esc_chars = EscChars, config = CfgFiles, verbosity = Verbosity, event_handlers = EvHandlers, @@ -1445,6 +1482,7 @@ get_data_for_node(#testspec{label = Labels, logdir = LogDirs, logopts = LogOptsList, basic_html = BHs, + esc_chars = EscChs, stylesheet = SSs, verbosity = VLvls, silent_connections = SilentConnsList, @@ -1472,6 +1510,7 @@ get_data_for_node(#testspec{label = Labels, LOs -> LOs end, BasicHtml = proplists:get_value(Node, BHs), + EscChars = proplists:get_value(Node, EscChs), Stylesheet = proplists:get_value(Node, SSs), Verbosity = case proplists:get_value(Node, VLvls) of undefined -> []; @@ -1498,6 +1537,7 @@ get_data_for_node(#testspec{label = Labels, logdir = LogDir, logopts = LogOpts, basic_html = BasicHtml, + esc_chars = EscChars, stylesheet = Stylesheet, verbosity = Verbosity, silent_connections = SilentConns, @@ -2182,10 +2222,18 @@ do_run_test(Tests, Skip, Opts0) -> %% test_server needs to know the include path too InclPath = case application:get_env(common_test, include) of {ok,Incls} -> Incls; - _ -> [] + _ -> [] end, application:set_env(test_server, include, InclPath), + %% copy the escape characters setting to test_server + EscChars = + case application:get_env(common_test, esc_chars) of + {ok,ECBool} -> ECBool; + _ -> true + end, + application:set_env(test_server, esc_chars, EscChars), + test_server_ctrl:start_link(local), %% let test_server expand the test tuples and count no of cases @@ -3069,6 +3117,10 @@ opts2args(EnvStartOpts) -> [{basic_html,[]}]; ({basic_html,false}) -> []; + ({esc_chars,false}) -> + [{no_esc_chars,[]}]; + ({esc_chars,true}) -> + []; ({event_handler,EH}) when is_atom(EH) -> [{event_handler,[atom_to_list(EH)]}]; ({event_handler,EHs}) when is_list(EHs) -> diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index 4d3fd2d094..f5f4f648f4 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -42,7 +42,8 @@ %% {reconnection_interval,Millisec}, %% {keep_alive,Bool}, %% {poll_limit,N}, -%% {poll_interval,Millisec}]}.</pre> +%% {poll_interval,Millisec}, +%% {tcp_nodelay,Bool}]}.</pre> %% <p><code>Millisec = integer(), N = integer()</code></p> %% <p>Enter the <code>telnet_settings</code> term in a configuration %% file included in the test and ct_telnet will retrieve the information @@ -182,7 +183,8 @@ conn_to=?DEFAULT_TIMEOUT, com_to=?DEFAULT_TIMEOUT, reconns=?RECONNS, - reconn_int=?RECONN_TIMEOUT}). + reconn_int=?RECONN_TIMEOUT, + tcp_nodelay=false}). %%%----------------------------------------------------------------- %%% @spec open(Name) -> {ok,Handle} | {error,Reason} @@ -602,8 +604,18 @@ init(Name,{Ip,Port,Type},{TargetMod,KeepAlive,Extra}) -> Settings -> set_telnet_defaults(Settings,#state{}) end, - case catch TargetMod:connect(Name,Ip,Port,S0#state.conn_to, - KeepAlive,Extra) of + %% Handle old user versions of TargetMod + code:ensure_loaded(TargetMod), + try + case erlang:function_exported(TargetMod,connect,7) of + true -> + TargetMod:connect(Name,Ip,Port,S0#state.conn_to, + KeepAlive,S0#state.tcp_nodelay,Extra); + false -> + TargetMod:connect(Name,Ip,Port,S0#state.conn_to, + KeepAlive,Extra) + end + of {ok,TelnPid} -> put({ct_telnet_pid2name,TelnPid},Name), S1 = S0#state{host=Ip, @@ -625,15 +637,18 @@ init(Name,{Ip,Port,Type},{TargetMod,KeepAlive,Extra}) -> "Connection timeout: ~p\n" "Keep alive: ~w\n" "Poll limit: ~w\n" - "Poll interval: ~w", + "Poll interval: ~w\n" + "TCP nodelay: ~w", [Ip,Port,S1#state.com_to,S1#state.reconns, S1#state.reconn_int,S1#state.conn_to,KeepAlive, - S1#state.poll_limit,S1#state.poll_interval]), + S1#state.poll_limit,S1#state.poll_interval, + S1#state.tcp_nodelay]), {ok,TelnPid,S1}; - {'EXIT',Reason} -> - {error,Reason}; Error -> Error + catch + _:Reason -> + {error,Reason} end. type(telnet) -> ip; @@ -653,6 +668,8 @@ set_telnet_defaults([{poll_limit,PL}|Ss],S) -> set_telnet_defaults(Ss,S#state{poll_limit=PL}); set_telnet_defaults([{poll_interval,PI}|Ss],S) -> set_telnet_defaults(Ss,S#state{poll_interval=PI}); +set_telnet_defaults([{tcp_nodelay,NoDelay}|Ss],S) -> + set_telnet_defaults(Ss,S#state{tcp_nodelay=NoDelay}); set_telnet_defaults([Unknown|Ss],S) -> force_log(S,error, "Bad element in telnet_settings: ~p",[Unknown]), @@ -794,8 +811,17 @@ reconnect(Ip,Port,N,State=#state{name=Name, keep_alive=KeepAlive, extra=Extra, conn_to=ConnTo, - reconn_int=ReconnInt}) -> - case TargetMod:connect(Name,Ip,Port,ConnTo,KeepAlive,Extra) of + reconn_int=ReconnInt, + tcp_nodelay=NoDelay}) -> + %% Handle old user versions of TargetMod + ConnResult = + case erlang:function_exported(TargetMod,connect,7) of + true -> + TargetMod:connect(Name,Ip,Port,ConnTo,KeepAlive,NoDelay,Extra); + false -> + TargetMod:connect(Name,Ip,Port,ConnTo,KeepAlive,Extra) + end, + case ConnResult of {ok,NewPid} -> put({ct_telnet_pid2name,NewPid},Name), {ok, NewPid, State#state{teln_pid=NewPid}}; diff --git a/lib/common_test/src/ct_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl index f1dee1f3bb..1f1311776f 100644 --- a/lib/common_test/src/ct_telnet_client.erl +++ b/lib/common_test/src/ct_telnet_client.erl @@ -35,7 +35,7 @@ %%-define(debug, true). --export([open/2, open/3, open/4, open/5, close/1]). +-export([open/2, open/3, open/4, open/5, open/6, close/1]). -export([send_data/2, send_data/3, get_data/1]). -define(TELNET_PORT, 23). @@ -70,19 +70,22 @@ -record(state,{conn_name, get_data, keep_alive=true, log_pos=1}). open(Server, ConnName) -> - open(Server, ?TELNET_PORT, ?OPEN_TIMEOUT, true, ConnName). + open(Server, ?TELNET_PORT, ?OPEN_TIMEOUT, true, false, ConnName). open(Server, Port, ConnName) -> - open(Server, Port, ?OPEN_TIMEOUT, true, ConnName). + open(Server, Port, ?OPEN_TIMEOUT, true, false, ConnName). open(Server, Port, Timeout, ConnName) -> - open(Server, Port, Timeout, true, ConnName). + open(Server, Port, Timeout, true, false, ConnName). open(Server, Port, Timeout, KeepAlive, ConnName) -> + open(Server, Port, Timeout, KeepAlive, false, ConnName). + +open(Server, Port, Timeout, KeepAlive, NoDelay, ConnName) -> Self = self(), Pid = spawn(fun() -> init(Self, Server, Port, Timeout, - KeepAlive, ConnName) + KeepAlive, NoDelay, ConnName) end), receive {open,Pid} -> @@ -114,8 +117,8 @@ get_data(Pid) -> %%%----------------------------------------------------------------- %%% Internal functions -init(Parent, Server, Port, Timeout, KeepAlive, ConnName) -> - case gen_tcp:connect(Server, Port, [list,{packet,0},{nodelay,true}], Timeout) of +init(Parent, Server, Port, Timeout, KeepAlive, NoDelay, ConnName) -> + case gen_tcp:connect(Server, Port, [list,{packet,0},{nodelay,NoDelay}], Timeout) of {ok,Sock} -> dbg("~p connected to: ~p (port: ~w, keep_alive: ~w)\n", [ConnName,Server,Port,KeepAlive]), diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index df5587b069..991abb0666 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -1146,8 +1146,9 @@ should_be_added(Tag,Node,_Data,Spec) -> if %% list terms *without* possible duplicates here Tag == logdir; Tag == logopts; - Tag == basic_html; Tag == label; - Tag == auto_compile; Tag == abort_if_missing_suites; + Tag == basic_html; Tag == esc_chars; + Tag == label; Tag == auto_compile; + Tag == abort_if_missing_suites; Tag == stylesheet; Tag == verbosity; Tag == silent_connections -> lists:keymember(ref2node(Node,Spec#testspec.nodes),1, @@ -1544,6 +1545,8 @@ valid_terms() -> {logopts,3}, {basic_html,2}, {basic_html,3}, + {esc_chars,2}, + {esc_chars,3}, {verbosity,2}, {verbosity,3}, {silent_connections,2}, diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index c372763ae9..d5a8e3fbc0 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -459,6 +459,7 @@ loop(Mode,TestData,StartDir) -> error:badarg -> [] end, ct_hooks:terminate(Callbacks), + close_connections(ets:tab2list(?conn_table)), ets:delete(?conn_table), ets:delete(?board_table), diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index c1cc1eafbd..d7efa26863 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -37,6 +37,7 @@ logdir=["."], logopts=[], basic_html=[], + esc_chars=[], verbosity=[], silent_connections=[], cover=[], diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl index e762d5060f..33a3813a16 100644 --- a/lib/common_test/src/cth_log_redirect.erl +++ b/lib/common_test/src/cth_log_redirect.erl @@ -130,7 +130,14 @@ handle_event(Event, #eh_state{log_func = LogFunc} = State) -> tag_event(Event)), if is_list(SReport) -> SaslHeader = format_header(State), - ct_logs:LogFunc(sasl, ?STD_IMPORTANCE, SaslHeader, SReport, []); + case LogFunc of + tc_log -> + ct_logs:tc_log(sasl, ?STD_IMPORTANCE, + SaslHeader, SReport, [], []); + tc_log_async -> + ct_logs:tc_log_async(sasl, ?STD_IMPORTANCE, + SaslHeader, SReport, []) + end; true -> %% Report is an atom if no logging is to be done ignore end @@ -139,7 +146,14 @@ handle_event(Event, #eh_state{log_func = LogFunc} = State) -> tag_event(Event),io_lib), if is_list(EReport) -> ErrHeader = format_header(State), - ct_logs:LogFunc(error_logger, ?STD_IMPORTANCE, ErrHeader, EReport, []); + case LogFunc of + tc_log -> + ct_logs:tc_log(error_logger, ?STD_IMPORTANCE, + ErrHeader, EReport, [], []); + tc_log_async -> + ct_logs:tc_log_async(error_logger, ?STD_IMPORTANCE, + ErrHeader, EReport, []) + end; true -> %% Report is an atom if no logging is to be done ignore end, diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl index 74a97fe2e2..59b916851e 100644 --- a/lib/common_test/src/cth_surefire.erl +++ b/lib/common_test/src/cth_surefire.erl @@ -82,7 +82,8 @@ init(Path, Opts) -> url_base = proplists:get_value(url_base,Opts), timer = ?now }. -pre_init_per_suite(Suite,SkipOrFail,State) when is_tuple(SkipOrFail) -> +pre_init_per_suite(Suite,SkipOrFail,#state{ test_cases = [] } = State) + when is_tuple(SkipOrFail) -> {SkipOrFail, init_tc(State#state{curr_suite = Suite, curr_suite_ts = ?now}, SkipOrFail) }; diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl index 34acad6fd1..919526c5d7 100644 --- a/lib/common_test/src/test_server.erl +++ b/lib/common_test/src/test_server.erl @@ -2165,10 +2165,19 @@ get_timetrap_info(TCPid, SendToServer) -> Timers -> case [Info || {Handle,Pid,Info} <- Timers, Pid == TCPid, Handle /= infinity] of - [I|_] -> - I; + [{TVal,true}|_] -> + {TVal,{true,test_server:timetrap_scale_factor()}}; + [{TVal,false}|_] -> + {TVal,{false,1}}; [] when SendToServer == true -> - tc_supervisor_req({get_timetrap_info,TCPid}); + case tc_supervisor_req({get_timetrap_info,TCPid}) of + {TVal,true} -> + {TVal,{true,test_server:timetrap_scale_factor()}}; + {TVal,false} -> + {TVal,{false,1}}; + Error -> + Error + end; [] -> undefined end diff --git a/lib/common_test/src/test_server_gl.erl b/lib/common_test/src/test_server_gl.erl index c150570604..333c8fc06e 100644 --- a/lib/common_test/src/test_server_gl.erl +++ b/lib/common_test/src/test_server_gl.erl @@ -131,6 +131,10 @@ set_props(GL, PropList) -> %%% Internal functions. init([]) -> + EscChars = case application:get_env(test_server, esc_chars) of + {ok,ECBool} -> ECBool; + _ -> true + end, {ok,#st{tc_supervisor=none, minor=none, minor_monitor=none, @@ -139,7 +143,7 @@ init([]) -> permit_io=gb_sets:empty(), auto_nl=true, levels={1,19,10}, - escape_chars=true + escape_chars=EscChars }}. req(GL, Req) -> diff --git a/lib/common_test/src/unix_telnet.erl b/lib/common_test/src/unix_telnet.erl index cd493d293f..4897ddb2f8 100644 --- a/lib/common_test/src/unix_telnet.erl +++ b/lib/common_test/src/unix_telnet.erl @@ -27,7 +27,8 @@ %%% {port,PortNum}, % optional %%% {username,UserName}, %%% {password,Password}, -%%% {keep_alive,Bool}]}. % optional</pre> +%%% {keep_alive,Bool}, % optional +%%% {tcp_nodely,Bool}]} % optional</pre> %%% %%% <p>To communicate via telnet to the host specified by %%% <code>HostNameOrIpAddress</code>, use the interface functions in @@ -55,7 +56,7 @@ -compile(export_all). %% Callbacks for ct_telnet.erl --export([connect/6,get_prompt_regexp/0]). +-export([connect/7,get_prompt_regexp/0]). -import(ct_telnet,[start_gen_log/1,log/4,end_gen_log/0]). -define(username,"login: "). @@ -82,6 +83,7 @@ get_prompt_regexp() -> %%% Port = integer() %%% Timeout = integer() %%% KeepAlive = bool() +%%% TCPNoDelay = bool() %%% Extra = ct:target_name() | {Username,Password} %%% Username = string() %%% Password = string() @@ -91,25 +93,25 @@ get_prompt_regexp() -> %%% @doc Callback for ct_telnet.erl. %%% %%% <p>Setup telnet connection to a unix host.</p> -connect(ConnName,Ip,Port,Timeout,KeepAlive,Extra) -> +connect(ConnName,Ip,Port,Timeout,KeepAlive,TCPNoDelay,Extra) -> case Extra of {Username,Password} -> - connect1(ConnName,Ip,Port,Timeout,KeepAlive, + connect1(ConnName,Ip,Port,Timeout,KeepAlive,TCPNoDelay, Username,Password); KeyOrName -> case get_username_and_password(KeyOrName) of {ok,{Username,Password}} -> - connect1(ConnName,Ip,Port,Timeout,KeepAlive, + connect1(ConnName,Ip,Port,Timeout,KeepAlive,TCPNoDelay, Username,Password); Error -> Error end end. -connect1(Name,Ip,Port,Timeout,KeepAlive,Username,Password) -> +connect1(Name,Ip,Port,Timeout,KeepAlive,TCPNoDelay,Username,Password) -> start_gen_log("unix_telnet connect"), Result = - case ct_telnet_client:open(Ip,Port,Timeout,KeepAlive,Name) of + case ct_telnet_client:open(Ip,Port,Timeout,KeepAlive,TCPNoDelay,Name) of {ok,Pid} -> case ct_telnet:silent_teln_expect(Name,Pid,[], [prompt],?prx,[]) of diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl index a281ddc938..20f139bcc8 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_update_config_SUITE.erl @@ -1,8 +1,8 @@ -%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
-%%
+%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,46 +14,46 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%%
-%% %CopyrightEnd%
-%%
-
--module(ct_update_config_SUITE).
-
--suite_defaults([{timetrap, {minutes, 10}}]).
-
-%% Note: This directive should only be used in test suites.
--compile(export_all).
-
--include("ct.hrl").
-
--define(now, os:timestamp()).
-
-%% Test server callback functions
-init_per_suite(Config) ->
- [{init_per_suite,?now}|Config].
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_testcase(_TestCase, Config) ->
- [{init_per_testcase,?now}|Config].
-
-end_per_testcase(_TestCase, _Config) ->
- ok.
-
-init_per_group(GroupName, Config) ->
- [{init_per_group,?now}|Config].
-
-end_per_group(GroupName, Config) ->
- ok.
-
-all() ->
- [{group,group1}].
-
-groups() ->
- [{group1,[],[test_case]}].
-
-%% Test cases starts here.
-test_case(Config) when is_list(Config) ->
- ok.
+%% +%% %CopyrightEnd% +%% + +-module(ct_update_config_SUITE). + +-suite_defaults([{timetrap, {minutes, 10}}]). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include("ct.hrl"). + +-define(now, ct_test_support:unique_timestamp()). + +%% Test server callback functions +init_per_suite(Config) -> + [{init_per_suite,?now}|Config]. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + [{init_per_testcase,?now}|Config]. + +end_per_testcase(_TestCase, _Config) -> + ok. + +init_per_group(GroupName, Config) -> + [{init_per_group,?now}|Config]. + +end_per_group(GroupName, Config) -> + ok. + +all() -> + [{group,group1}]. + +groups() -> + [{group1,[],[test_case]}]. + +%% Test cases starts here. +test_case(Config) when is_list(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl index dc0056b61b..c00eb5cf93 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl @@ -90,7 +90,7 @@ id(Opts) -> gen_event:notify(?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, id, [Opts]}}), ct:log("~w:id called", [?MODULE]), - os:timestamp(). + ct_test_support:unique_timestamp(). %% @doc Called before init_per_suite is called. Note that this callback is %% only called if the CTH is added before init_per_suite is run (eg. in a test diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl index 02f7fa7564..d48981f667 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_config_cth.erl @@ -25,7 +25,7 @@ -include_lib("common_test/src/ct_util.hrl"). -include_lib("common_test/include/ct_event.hrl"). --define(now, os:timestamp()). +-define(now, ct_test_support:unique_timestamp()). %% CT Hooks -compile(export_all). diff --git a/lib/common_test/test/ct_netconfc_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE.erl index 72c1de4023..03fbc17bd2 100644 --- a/lib/common_test/test/ct_netconfc_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE.erl @@ -48,7 +48,12 @@ init_per_suite(Config) -> {error,Reason} when Reason=/={already_loaded,crypto} -> {skip, Reason}; _ -> - ct_test_support:init_per_suite(Config) + case application:load(ssh) of + {error,Reason} when Reason=/={already_loaded,ssh} -> + {skip, Reason}; + _ -> + ct_test_support:init_per_suite(Config) + end end. end_per_suite(Config) -> 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 e4062a7d62..065639dd36 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 @@ -123,15 +123,21 @@ init_per_testcase(_Case, Config) -> end_per_testcase(_Case, _Config) -> ok. +init_per_suite() -> + [{timetrap,2*?default_timeout}]. % making dsa files can be slow init_per_suite(Config) -> - case catch {crypto:start(), ssh:start()} of - {ok, ok} -> + case catch ssh:start() of + Ok when Ok==ok; Ok=={error,{already_started,ssh}} -> + ct:log("ssh started",[]), {ok, _} = netconfc_test_lib:get_id_keys(Config), netconfc_test_lib:make_dsa_files(Config), + ct:log("dsa files created",[]), Server = ?NS:start(?config(data_dir,Config)), + ct:log("netconf server started",[]), [{server,Server}|Config]; - _ -> - {skip, "Crypto and/or SSH could not be started!"} + Other -> + ct:log("could not start ssh: ~p",[Other]), + {skip, "SSH could not be started!"} end. end_per_suite(Config) -> @@ -806,7 +812,7 @@ close_while_waiting_for_chunked_data(Config) -> %% Order server to expect a get - then the process above will make %% sure the rpc-reply is sent - but only a part of it - then close. ?NS:expect('get'), - {error,closed} = ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]},2000), + {error,closed} = ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]},4000), ok. connection_crash(Config) -> 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 index ae9087ce45..04bfe75187 100644 --- 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 @@ -26,7 +26,8 @@ -compile(export_all). suite() -> - [{ct_hooks, [{cth_conn_log,[{ct_netconfc,[{log_type,html}]}]}]}]. + [{timetrap,?default_timeout}, + {ct_hooks, [{cth_conn_log,[{ct_netconfc,[{log_type,html}]}]}]}]. all() -> case os:find_executable("ssh") of @@ -48,13 +49,10 @@ end_per_group(_GroupName, Config) -> init_per_testcase(Case, Config) -> stop_node(Case), - Dog = test_server:timetrap(?default_timeout), - [{watchdog, Dog}|Config]. + Config. end_per_testcase(Case, Config) -> stop_node(Case), - Dog=?config(watchdog, Config), - test_server:timetrap_cancel(Dog), ok. stop_node(Case) -> @@ -63,14 +61,19 @@ stop_node(Case) -> rpc:call(Node,erlang,halt,[]). +init_per_suite() -> + [{timetrap,2*?default_timeout}]. % making dsa files can be slow init_per_suite(Config) -> - case {crypto:start(),ssh:start()} of - {ok,ok} -> + case ssh:start() of + Ok when Ok==ok; Ok=={error,{already_started,ssh}} -> + ct:log("SSH started locally",[]), {ok, _} = netconfc_test_lib:get_id_keys(Config), netconfc_test_lib:make_dsa_files(Config), + ct:log("dsa files created",[]), Config; - _ -> - {skip, "Crypto and/or SSH could not be started locally!"} + Other -> + ct:log("could not start ssh locally: ~p",[Other]), + {skip, "SSH could not be started locally!"} end. end_per_suite(Config) -> @@ -87,12 +90,15 @@ remote_crash(Config) -> 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} -> + case rpc:call(Node,ssh,start,[]) of + Ok when Ok==ok; Ok=={error,{already_started,ssh}} -> + ct:log("SSH started remote",[]), Server = rpc:call(Node,?NS,start,[?config(data_dir,Config)]), + ct:log("netconf server started remote",[]), remote_crash(Node,Config); - _ -> - {skip, "Crypto and/or SSH could not be started remote!"} + Other -> + ct:log("could not start ssh remote: ~p",[Other]), + {skip, "SSH could not be started remote!"} end. remote_crash(Node,Config) -> diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl index 74ef3a26ce..7ffe6f045b 100644 --- a/lib/common_test/test/ct_pre_post_test_io_SUITE.erl +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE.erl @@ -44,13 +44,29 @@ %% instance, the tests need to be performed on a separate node (or %% there will be clashes with logging processes etc). %%-------------------------------------------------------------------- +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{seconds,120}}]. + +all() -> + [ + pre_post_io + ]. + init_per_suite(Config) -> - DataDir = ?config(data_dir, Config), - CTH = filename:join(DataDir, "cth_ctrl.erl"), - ct:pal("Compiling ~p: ~p", - [CTH,compile:file(CTH,[{outdir,DataDir},debug_info])]), - ct_test_support:init_per_suite([{path_dirs,[DataDir]}, - {start_sasl,true} | Config]). + TTInfo = {_T,{_Scaled,ScaleVal}} = ct:get_timetrap_info(), + ct:pal("Timetrap info = ~w", [TTInfo]), + if ScaleVal > 1 -> + {skip,"Skip on systems running e.g. cover or debug!"}; + ScaleVal =< 1 -> + DataDir = ?config(data_dir, Config), + CTH = filename:join(DataDir, "cth_ctrl.erl"), + ct:pal("Compiling ~p: ~p", + [CTH,compile:file(CTH,[{outdir,DataDir}, + debug_info])]), + ct_test_support:init_per_suite([{path_dirs,[DataDir]}, + {start_sasl,true} | Config]) + end. end_per_suite(Config) -> ct_test_support:end_per_suite(Config). @@ -61,13 +77,6 @@ init_per_testcase(TestCase, Config) -> end_per_testcase(TestCase, Config) -> ct_test_support:end_per_testcase(TestCase, Config). -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [ - pre_post_io - ]. - %%-------------------------------------------------------------------- %% TEST CASES %%-------------------------------------------------------------------- @@ -90,31 +99,50 @@ pre_post_io(Config) -> %%!-------------------------------------------------------------------- spawn(fun() -> - ct:pal("CONTROLLER: Started!", []), + ct:pal("CONTROLLER: Starting test run #1...", []), %% --- test run 1 --- - ct:sleep(3000), - ct:pal("CONTROLLER: Handle remote events = true", []), - ok = ct_test_support:ct_rpc({cth_log_redirect, - handle_remote_events, - [true]}, Config), - ct:sleep(2000), - ct:pal("CONTROLLER: Proceeding with test run #1!", []), + try_loop(ct_test_support, ct_rpc, [{cth_log_redirect, + handle_remote_events, + [true]}, Config], 3000), + CTLoggerPid1 = ct_test_support:ct_rpc({erlang,whereis, + [ct_logs]}, Config), + ct:pal("CONTROLLER: Logger = ~w~nHandle remote events = true", + [CTLoggerPid1]), + ct:sleep(5000), + ct:pal("CONTROLLER: Proceeding with test run #1...", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), ct:sleep(6000), - ct:pal("CONTROLLER: Proceeding with shutdown #1!", []), + ct:pal("CONTROLLER: Proceeding with shutdown #1...", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + try_loop(fun() -> + false = ct_test_support:ct_rpc({erlang, + is_process_alive, + [CTLoggerPid1]}, + Config) + end, 3000), + ct:pal("CONTROLLER: Shutdown #1 complete!", []), + ct:pal("CONTROLLER: Starting test run #2...", []), %% --- test run 2 --- - ct:sleep(3000), - ct:pal("CONTROLLER: Handle remote events = true", []), - ok = ct_test_support:ct_rpc({cth_log_redirect, - handle_remote_events, - [true]}, Config), - ct:sleep(2000), - ct:pal("CONTROLLER: Proceeding with test run #2!", []), + try_loop(ct_test_support, ct_rpc, [{cth_log_redirect, + handle_remote_events, + [true]}, Config], 3000), + CTLoggerPid2 = ct_test_support:ct_rpc({erlang,whereis, + [ct_logs]}, Config), + ct:pal("CONTROLLER: Logger = ~w~nHandle remote events = true", + [CTLoggerPid2]), + ct:sleep(5000), + ct:pal("CONTROLLER: Proceeding with test run #2...", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), ct:sleep(6000), - ct:pal("CONTROLLER: Proceeding with shutdown #2!", []), - ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config) + ct:pal("CONTROLLER: Proceeding with shutdown #2...", []), + ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), + try_loop(fun() -> + false = ct_test_support:ct_rpc({erlang, + is_process_alive, + [CTLoggerPid2]}, + Config) + end, 3000), + ct:pal("CONTROLLER: Shutdown #2 complete!", []) end), ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), @@ -157,7 +185,7 @@ pre_post_io(Config) -> Counters end, {pre,0,0,0,0}, Ts), [_|Counters] = tuple_to_list(PrePostIOEntries), - ct:log("Entries in the Pre/Post Test IO Log: ~p", [Counters]), + ct:pal("Entries in the Pre/Post Test IO Log: ~w", [Counters]), case [C || C <- Counters, C < 2] of [] -> ok; @@ -183,7 +211,7 @@ pre_post_io(Config) -> [LogN,ErrN+1]; (_, Counters) -> Counters end, [0,0], Ts), - ct:log("Entries in the Unexpected IO Log: ~p", [UnexpIOEntries]), + ct:log("Entries in the Unexpected IO Log: ~w", [UnexpIOEntries]), case [N || N <- UnexpIOEntries, N < 2] of [] -> ok; @@ -208,6 +236,38 @@ setup(Test, Config) -> reformat(Events, EH) -> ct_test_support:reformat(Events, EH). +try_loop(_Fun, 0) -> + ct:pal("WARNING! Fun never succeeded!", []), + gave_up; +try_loop(Fun, N) -> + try Fun() of + {error,_} -> + timer:sleep(10), + try_loop(Fun, N-1); + Result -> + Result + catch + _:_What -> + timer:sleep(10), + try_loop(Fun, N-1) + end. + +try_loop(M, F, _A, 0) -> + ct:pal("WARNING! ~w:~w never succeeded!", [M,F]), + gave_up; +try_loop(M, F, A, N) -> + try apply(M, F, A) of + {error,_} -> + timer:sleep(10), + try_loop(M, F, A, N-1); + Result -> + Result + catch + _:_ -> + timer:sleep(10), + try_loop(M, F, A, N-1) + end. + %%%----------------------------------------------------------------- %%% TEST EVENTS %%%----------------------------------------------------------------- diff --git a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl index cb0c5ed14e..347b507c78 100644 --- a/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl +++ b/lib/common_test/test/ct_pre_post_test_io_SUITE_data/cth_ctrl.erl @@ -53,8 +53,7 @@ init(_Id, _Opts) -> receive {?MODULE,proceed} -> ok after - 10000 -> - ok + 10000 -> ok end, {ok,[],ct_last}. @@ -66,8 +65,7 @@ terminate(_State) -> receive {?MODULE,proceed} -> ok after - 10000 -> - ok + 10000 -> ok end, stop_external_logger(cth_logger), stop_dispatcher(), @@ -94,7 +92,7 @@ init_logger(Name) -> logger_loop(N) -> ct:log("Logger iteration: ~p", [N]), error_logger:error_report(N), - timer:sleep(250), + timer:sleep(100), logger_loop(N+1). %%%----------------------------------------------------------------- diff --git a/lib/common_test/test/ct_surefire_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE.erl index a39a3887f7..42ec685c16 100644 --- a/lib/common_test/test/ct_surefire_SUITE.erl +++ b/lib/common_test/test/ct_surefire_SUITE.erl @@ -49,8 +49,11 @@ %% there will be clashes with logging processes etc). %%-------------------------------------------------------------------- init_per_suite(Config) -> - Config1 = ct_test_support:init_per_suite(Config), - Config1. + DataDir = ?config(data_dir,Config), + Hook = "fail_pre_init_per_suite.erl", + io:format("Compiling ~p: ~p~n", + [Hook, compile:file(Hook,[{outdir,DataDir},debug_info])]), + ct_test_support:init_per_suite([{path_dirs,[DataDir]}|Config]). end_per_suite(Config) -> ct_test_support:end_per_suite(Config). @@ -69,7 +72,8 @@ all() -> absolute_path, relative_path, url, - logdir + logdir, + fail_pre_init_per_suite ]. %%-------------------------------------------------------------------- @@ -107,6 +111,14 @@ logdir(Config) when is_list(Config) -> Path = "logdir.xml", run(logdir,[{cth_surefire,[{path,Path}]}],Path,Config,[{logdir,MyLogDir}]). +fail_pre_init_per_suite(Config) when is_list(Config) -> + DataDir = ?config(data_dir,Config), + Suites = [filename:join(DataDir,"pass_SUITE"), + filename:join(DataDir,"fail_SUITE")], + Path = "fail_pre_init_per_suite.xml", + run(fail_pre_init_per_suite,[fail_pre_init_per_suite, + {cth_surefire,[{path,Path}]}],Path,Config,[],Suites). + %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -115,6 +127,8 @@ run(Case,CTHs,Report,Config) -> run(Case,CTHs,Report,Config,ExtraOpts) -> DataDir = ?config(data_dir, Config), Suite = filename:join(DataDir, "surefire_SUITE"), + run(Case,CTHs,Report,Config,ExtraOpts,Suite). +run(Case,CTHs,Report,Config,ExtraOpts,Suite) -> {Opts,ERPid} = setup([{suite,Suite},{ct_hooks,CTHs},{label,Case}|ExtraOpts], Config), ok = execute(Case, Opts, ERPid, Config), @@ -142,7 +156,6 @@ setup(Test, Config) -> execute(Name, Opts, ERPid, Config) -> ok = ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), - ct_test_support:log_events(Name, reformat(Events, ?eh), ?config(priv_dir, Config), @@ -166,10 +179,30 @@ events_to_check(_, 0) -> events_to_check(Test, N) -> test_events(Test) ++ events_to_check(Test, N-1). -test_events(_) -> - [{?eh,start_logging,'_'}, - {?eh,start_info,{1,1,9}}, - {?eh,tc_start,{surefire_SUITE,init_per_suite}}, +test_suite_events(fail_SUITE, TestStat) -> + [{?eh,tc_start,{ct_framework,init_per_suite}}, + {?eh,tc_done,{ct_framework,init_per_suite, + {failed,{error,pre_init_per_suite}}}}, + {?eh,tc_auto_skip, + {fail_SUITE,test_case, + {failed,{ct_framework,init_per_suite,{failed,pre_init_per_suite}}}}}, + {?eh,test_stats,TestStat}, + {?eh,tc_auto_skip, + {ct_framework,end_per_suite, + {failed,{ct_framework,init_per_suite,{failed,pre_init_per_suite}}}}}]. + +test_suite_events(fail_SUITE) -> + test_suite_events(fail_SUITE, {0,0,{0,1}}); +test_suite_events(pass_SUITE) -> + [{?eh,tc_start,{ct_framework,init_per_suite}}, + {?eh,tc_done,{ct_framework,init_per_suite,ok}}, + {?eh,tc_start,{pass_SUITE,test_case}}, + {?eh,tc_done,{pass_SUITE,test_case,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{ct_framework,end_per_suite}}, + {?eh,tc_done,{ct_framework,end_per_suite,ok}}]; +test_suite_events(_) -> + [{?eh,tc_start,{surefire_SUITE,init_per_suite}}, {?eh,tc_done,{surefire_SUITE,init_per_suite,ok}}, {?eh,tc_start,{surefire_SUITE,tc_ok}}, {?eh,tc_done,{surefire_SUITE,tc_ok,ok}}, @@ -216,9 +249,18 @@ test_events(_) -> {surefire_SUITE,init_per_group, {'EXIT',all_cases_should_be_skipped}}}}}], {?eh,tc_start,{surefire_SUITE,end_per_suite}}, - {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}, - {?eh,stop_logging,[]}]. - + {?eh,tc_done,{surefire_SUITE,end_per_suite,ok}}]. + +test_events(fail_pre_init_per_suite) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,start_info,{2,2,2}}] ++ + test_suite_events(pass_SUITE) ++ + test_suite_events(fail_SUITE, {1,0,{0,1}}) ++ + [{?eh,stop_logging,[]}]; +test_events(Test) -> + [{?eh,start_logging,'_'}, {?eh,start_info,{1,1,9}}] ++ + test_suite_events(Test) ++ + [{?eh,stop_logging,[]}]. %%%----------------------------------------------------------------- %%% Check generated xml log files @@ -251,9 +293,9 @@ do_check_xml(Case,[Xml|Xmls]) -> {E,_} = xmerl_scan:file(Xml), Expected = events_to_result(lists:flatten(test_events(Case))), ParseResult = testsuites(Case,E), - ct:log("Expecting: ~p~n",[[Expected]]), + ct:log("Expecting: ~p~n",[Expected]), ct:log("Actual : ~p~n",[ParseResult]), - [Expected] = ParseResult, + Expected = ParseResult, do_check_xml(Case,Xmls); do_check_xml(_,[]) -> ok. @@ -265,7 +307,8 @@ testsuites(Case,#xmlElement{name=testsuites,content=TS}) -> testsuite(Case,TS). testsuite(Case,[#xmlElement{name=testsuite,content=TC,attributes=A}|TS]) -> - {ET,EF,ES} = events_to_numbers(lists:flatten(test_events(Case))), + TestSuiteEvents = test_suite_events(get_ts_name(A)), + {ET,EF,ES} = events_to_numbers(lists:flatten(TestSuiteEvents)), {T,E,F,S} = get_numbers_from_attrs(A,false,false,false,false), ct:log("Expecting total:~p, error:~p, failure:~p, skipped:~p~n",[ET,0,EF,ES]), ct:log("Actual total:~p, error:~p, failure:~p, skipped:~p~n",[T,E,F,S]), @@ -318,14 +361,32 @@ failed_or_skipped([]) -> %% Testsuites = [Testsuite] %% Testsuite = [Testcase] %% Testcase = [] | [f] | [s], indicating ok, failed and skipped respectively -events_to_result([{?eh,tc_done,{_Suite,_Case,R}}|E]) -> - [result(R)|events_to_result(E)]; -events_to_result([{?eh,tc_auto_skip,_}|E]) -> - [[s]|events_to_result(E)]; -events_to_result([_|E]) -> - events_to_result(E); -events_to_result([]) -> - []. +events_to_result(E) -> + events_to_result(E, []). + +events_to_result([{?eh,tc_auto_skip,{_Suite,init_per_suite,_}}|E], Result) -> + {Suite,Rest} = events_to_result1(E), + events_to_result(Rest, [[[s]|Suite]|Result]); +events_to_result([{?eh,tc_done,{_Suite,init_per_suite,R}}|E], Result) -> + {Suite,Rest} = events_to_result1(E), + events_to_result(Rest, [[result(R)|Suite]|Result]); +events_to_result([_|E], Result) -> + events_to_result(E, Result); +events_to_result([], Result) -> + Result. + +events_to_result1([{?eh,tc_auto_skip,{_Suite, end_per_suite,_}}|E]) -> + {[[s]],E}; +events_to_result1([{?eh,tc_done,{_Suite, end_per_suite,R}}|E]) -> + {[result(R)],E}; +events_to_result1([{?eh,tc_done,{_Suite,_Case,R}}|E]) -> + {Suite,Rest} = events_to_result1(E), + {[result(R)|Suite],Rest}; +events_to_result1([{?eh,tc_auto_skip,_}|E]) -> + {Suite,Rest} = events_to_result1(E), + {[[s]|Suite],Rest}; +events_to_result1([_|E]) -> + events_to_result1(E). result(ok) ->[]; result({skipped,_}) -> [s]; @@ -374,3 +435,7 @@ del_files(Dir,[F0|Fs] ) -> end; del_files(_,[]) -> ok. + +get_ts_name(Attributes) -> + {_,name,_,_,_,_,_,_,Name,_} = lists:keyfind(name, 2, Attributes), + list_to_atom(Name). diff --git a/lib/compiler/test/compilation_SUITE_data/bin_syntax_1.erl b/lib/common_test/test/ct_surefire_SUITE_data/fail_SUITE.erl index 72f6a0cee6..3f5f42c054 100644 --- a/lib/compiler/test/compilation_SUITE_data/bin_syntax_1.erl +++ b/lib/common_test/test/ct_surefire_SUITE_data/fail_SUITE.erl @@ -1,8 +1,7 @@ -%% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,19 +13,16 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% --module(bin_syntax_1). +-module(fail_SUITE). +-include_lib("common_test/include/ct.hrl"). --export([f/2,?MODULE/0]). +-export([all/0, test_case/1]). -?MODULE() -> - ok. +all() -> + [test_case]. -f(X, Y) -> - case X of - a -> - Y2 = 8 - end, - <<5:Y2>> = Y. +test_case(_Config) -> + ok. diff --git a/lib/common_test/test/ct_surefire_SUITE_data/fail_pre_init_per_suite.erl b/lib/common_test/test/ct_surefire_SUITE_data/fail_pre_init_per_suite.erl new file mode 100644 index 0000000000..ff278db378 --- /dev/null +++ b/lib/common_test/test/ct_surefire_SUITE_data/fail_pre_init_per_suite.erl @@ -0,0 +1,47 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%%% This tests that the correct XML is produced when pre_init_per_suite +%%% fails in a hook +-module(fail_pre_init_per_suite). + +%% CT Hooks +-export([init/2, pre_init_per_suite/3]). + +-type config() :: proplists:proplist(). +-type reason() :: term(). +-type skip_or_fail() :: skip | auto_skip | fail | 'EXIT'. + +-record(state, {}). + +-spec init(Id :: term(), Opts :: proplists:proplist()) -> + {ok, proplists:proplist()}. +init(_Id, Opts) -> + {ok, Opts}. + +-spec pre_init_per_suite(Suite :: atom(), + Config :: config(), + State :: #state{}) -> + {config() | {skip_or_fail(), reason()}, NewState :: #state{}}. +pre_init_per_suite(fail_SUITE, _Config, State) -> + {{fail, pre_init_per_suite}, State}; +pre_init_per_suite(_Suite, Config, State) -> + {Config, State}. + diff --git a/lib/compiler/test/compilation_SUITE_data/beam_compiler_5.erl b/lib/common_test/test/ct_surefire_SUITE_data/pass_SUITE.erl index 7289d2b553..74ed5b730e 100644 --- a/lib/compiler/test/compilation_SUITE_data/beam_compiler_5.erl +++ b/lib/common_test/test/ct_surefire_SUITE_data/pass_SUITE.erl @@ -1,8 +1,7 @@ -%% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,16 +13,16 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% --module(beam_compiler_5). --export([beam_compiler_5/0]). +-module(pass_SUITE). +-include_lib("common_test/include/ct.hrl"). --compile(export_all). +-export([all/0, test_case/1]). -beam_compiler_5() -> - ok. +all() -> + [test_case]. -t() -> - [_|_] = x. +test_case(_Config) -> + ok. diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 51ca691d69..477fcb8a26 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -43,6 +43,8 @@ -export([random_error/1]). +-export([unique_timestamp/0]). + -include_lib("kernel/include/file.hrl"). %%%----------------------------------------------------------------- @@ -110,7 +112,8 @@ start_slave(NodeName, Config, Level) -> undefined -> []; Ds -> Ds end, - PathDirs = [PrivDir,TSDir | AddPathDirs], + TestSupDir = filename:dirname(code:which(?MODULE)), + PathDirs = [PrivDir,TSDir,TestSupDir | AddPathDirs], [true = rpc:call(CTNode, code, add_patha, [D]) || D <- PathDirs], test_server:format(Level, "Dirs added to code path (on ~w):~n", [CTNode]), @@ -1430,7 +1433,21 @@ rm_files([F | Fs]) -> end; rm_files([]) -> ok. - + +unique_timestamp() -> + unique_timestamp(os:timestamp(), 100000). + +unique_timestamp(TS, 0) -> + TS; +unique_timestamp(TS0, N) -> + case os:timestamp() of + TS0 -> + timer:sleep(1), + unique_timestamp(TS0, N-1); + TS1 -> + TS1 + end. + %%%----------------------------------------------------------------- %%% slave_stop(Node) -> diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 37ec4e97c9..6dc162db40 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -135,7 +135,7 @@ ann_c_map_pattern/2, map_pair_op/1,map_pair_key/1,map_pair_val/1, update_c_map_pair/4, - c_map_pair/2, + c_map_pair/2, c_map_pair_exact/2, ann_c_map_pair/4 ]). @@ -1694,6 +1694,11 @@ map_pair_op(#c_map_pair{op=Op}) -> Op. c_map_pair(Key,Val) -> #c_map_pair{op=#c_literal{val=assoc},key=Key,val=Val}. +-spec c_map_pair_exact(cerl(), cerl()) -> c_map_pair(). + +c_map_pair_exact(Key,Val) -> + #c_map_pair{op=#c_literal{val=exact},key=Key,val=Val}. + -spec ann_c_map_pair([term()], cerl(), cerl(), cerl()) -> c_map_pair(). diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index 88275998be..f34a5c034f 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -37,10 +37,11 @@ indent = 0 :: integer(), item_indent = 2 :: integer(), body_indent = 4 :: integer(), - tab_width = 8 :: non_neg_integer(), line = 0 :: integer(), clean = true :: boolean()}). +-define(TAB_WIDTH, 8). + -spec format(cerl:cerl()) -> iolist(). format(Node) -> @@ -470,37 +471,46 @@ format_map_pair(Op, K, V, Ctxt0) -> Ctxt2 = add_indent(Ctxt0, width(Txt, Ctxt1)), [Txt,Op,format(V, Ctxt2)]. -indent(Ctxt) -> indent(Ctxt#ctxt.indent, Ctxt). - -indent(N, _) when N =< 0 -> ""; -indent(N, Ctxt) -> - T = Ctxt#ctxt.tab_width, - string:chars($\t, N div T, string:chars($\s, N rem T)). +indent(#ctxt{indent=N}) -> + if + N =< 0 -> + ""; + true -> + string:chars($\t, N div ?TAB_WIDTH, spaces(N rem ?TAB_WIDTH)) + end. nl_indent(Ctxt) -> [$\n|indent(Ctxt)]. +spaces(0) -> ""; +spaces(1) -> " "; +spaces(2) -> " "; +spaces(3) -> " "; +spaces(4) -> " "; +spaces(5) -> " "; +spaces(6) -> " "; +spaces(7) -> " ". unindent(T, Ctxt) -> - unindent(T, Ctxt#ctxt.indent, Ctxt, []). + unindent(T, Ctxt#ctxt.indent, []). -unindent(T, N, _, C) when N =< 0 -> +unindent(T, N, C) when N =< 0 -> [T|C]; -unindent([$\s|T], N, Ctxt, C) -> - unindent(T, N - 1, Ctxt, C); -unindent([$\t|T], N, Ctxt, C) -> - Tab = Ctxt#ctxt.tab_width, +unindent([$\s|T], N, C) -> + unindent(T, N - 1, C); +unindent([$\t|T], N, C) -> + Tab = ?TAB_WIDTH, if N >= Tab -> - unindent(T, N - Tab, Ctxt, C); + unindent(T, N - Tab, C); true -> - unindent([string:chars($\s, Tab - N)|T], 0, Ctxt, C) + unindent([spaces(Tab - N)|T], 0, C) end; -unindent([L|T], N, Ctxt, C) when is_list(L) -> - unindent(L, N, Ctxt, [T|C]); -unindent([H|T], _, _, C) -> +unindent([L|T], N, C) when is_list(L) -> + unindent(L, N, [T|C]); +unindent([H|T], _, C) -> [H|[T|C]]; -unindent([], N, Ctxt, [H|T]) -> - unindent(H, N, Ctxt, T); -unindent([], _, _, []) -> []. +unindent([], N, [H|T]) -> + unindent(H, N, T); +unindent([], _, []) -> []. width(Txt, Ctxt) -> @@ -509,7 +519,7 @@ width(Txt, Ctxt) -> end. width([$\t|T], A, Ctxt, C) -> - width(T, A + Ctxt#ctxt.tab_width, Ctxt, C); + width(T, A + ?TAB_WIDTH, Ctxt, C); width([$\n|T], _, Ctxt, C) -> width(unindent([T|C], Ctxt), Ctxt); width([H|T], A, Ctxt, C) when is_list(H) -> diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 3299149457..83b3650180 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -510,8 +510,16 @@ unforce(_, Vs) -> Vs. exprs([E0|Es0], St0) -> {E1,Eps,St1} = expr(E0, St0), - {Es1,St2} = exprs(Es0, St1), - {Eps ++ [E1] ++ Es1,St2}; + case E1 of + #iprimop{name=#c_literal{val=match_fail}} -> + %% Must discard the rest of the body, because it + %% may refer to variables that have not been bound. + %% Example: {ok={error,E}} = foo(), E. + {Eps ++ [E1],St1}; + _ -> + {Es1,St2} = exprs(Es0, St1), + {Eps ++ [E1] ++ Es1,St2} + end; exprs([], St) -> {[],St}. %% expr(Expr, State) -> {Cexpr,[PreExp],State}. @@ -681,9 +689,14 @@ expr({match,L,P0,E0}, St0) -> Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])), case P2 of nomatch -> - St = add_warning(L, nomatch, St5), - {#icase{anno=#a{anno=Lanno}, - args=[E2],clauses=[],fc=Fc},Eps1++Eps2,St}; + St6 = add_warning(L, nomatch, St5), + {Expr,Eps3,St} = safe(E1, St6), + Eps = Eps1 ++ Eps2 ++ Eps3, + Badmatch = c_tuple([#c_literal{val=badmatch},Expr]), + Fail = #iprimop{anno=#a{anno=Lanno}, + name=#c_literal{val=match_fail}, + args=[Badmatch]}, + {Fail,Eps,St}; Other when not is_atom(Other) -> {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5} end; diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 4a6330fce4..402e3c4912 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -147,6 +147,7 @@ include_attribute(callback) -> false; include_attribute(opaque) -> false; include_attribute(export_type) -> false; include_attribute(record) -> false; +include_attribute(optional_callbacks) -> false; include_attribute(_) -> true. function({#c_var{name={F,Arity}=FA},Body}, St0) -> diff --git a/lib/compiler/test/beam_block_SUITE.erl b/lib/compiler/test/beam_block_SUITE.erl index a9bbe31b59..81f8d10687 100644 --- a/lib/compiler/test/beam_block_SUITE.erl +++ b/lib/compiler/test/beam_block_SUITE.erl @@ -21,7 +21,11 @@ -export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, init_per_group/2,end_per_group/2, - get_map_elements/1]). + get_map_elements/1,otp_7345/1]). + +%% The only test for the following functions is that +%% the code compiles and is accepted by beam_validator. +-export([encode_wildcards3/4,find_operands/4]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -64,3 +68,114 @@ get_map_elements([{Pred,Var}|Left], Map, Acc) -> end; get_map_elements([], _Map, Acc) -> Acc. + +%% The following code +%% +%% {get_list,{x,2},{x,0},{x,1}}. +%% {gc_bif,length,{f,0},1,[{x,0}],{x,0}}. +%% {move,{x,0},{x,1}}. +%% +%% was incorrectly optimized to +%% +%% {get_list,{x,2},{x,0},{y,0}}. +%% {gc_bif,length,{f,0},3,[{x,0}],{x,1}}. +%% +%% because beam_block:is_transparent({x,1}, +%% {gc_bif,length,{f,0},3,[{x,0}],{x,1}} +%% incorrectly returned true. + +-record(contextId,{cid,device_type,contextRef}). +-record(dpRef,{cid,tlli,ms_device_context_id}). +-record(qosProfileBssgp,{peak_bit_rate_msb, + peak_bit_rate_lsb, + t_a_precedence}). +-record(llUnitdataReq,{sapi, + l3_pdu_length, + pdu_life}). +-record(ptmsi,{value}). + +otp_7345(_Config) -> + #llUnitdataReq{l3_pdu_length=3,pdu_life=4} = + otp_7345(#contextId{}, 0, [[1,2,3],4,5]). + + +otp_7345(ObjRef, _RdEnv, Args) -> + Cid = ObjRef#contextId.cid, + _ = #dpRef{cid = Cid, + ms_device_context_id = cid_id, + tlli = #ptmsi{value = 0}}, + _ = #qosProfileBssgp{peak_bit_rate_msb = 0, + peak_bit_rate_lsb = 80, + t_a_precedence = 49}, + [Cpdu|_] = Args, + LlUnitdataReq = + #llUnitdataReq{sapi = 7, + l3_pdu_length = length(Cpdu), + pdu_life = + id(42) + div + 10}, + id(LlUnitdataReq). + +%%% +%%% The only test of the following code is that it compiles. +%%% + +%% Slightly simplifed from megaco_binary_term_id_gen. +%% beam_block failed to note that the {gc_bif,'-'...} instruction could +%% fail, and that therefore {y,0} need to be initialized. +%% {allocate,8,6}. +%% %% {init,{y,0}} needed here. +%% {get_list,{x,1},{x,6},{x,7}}. +%% {'catch',{y,7},{f,3}}. +%% {move,{x,4},{y,1}}. +%% {move,{x,3},{y,2}}. +%% {move,{x,2},{y,3}}. +%% {move,{x,5},{y,4}}. +%% {move,{x,7},{y,5}}. +%% {move,{x,6},{y,6}}. +%% {gc_bif,'-',{f,0},8,[{x,3},{x,6}],{x,0}}. +%% {move,{x,0},{y,0}}. + +encode_wildcards3([],[],_,_) -> []; +encode_wildcards3([Level|Levels],[BitsInLevel|BitsRest],LevelNo,TotSize) -> + case (catch ?MODULE:encode_wildcard(Level,BitsInLevel,TotSize-BitsInLevel, + length(Levels))) of + {'EXIT',{Reason,Info}} -> + exit({Reason,{LevelNo,Info}}); + + no_wildcard -> + encode_wildcards3(Levels,BitsRest,LevelNo+1,TotSize-BitsInLevel); + + {level,Wl} -> + [Wl| + encode_wildcards3(Levels,BitsRest,LevelNo+1,TotSize-BitsInLevel)]; + + {recursive,Wr} -> + [Wr] + end. + +%% Slightly simplified code from hipe_rtl_ssapre. +%% beam_block used to do the following incorrect optimization: +%% +%% {gc_bif,length,{f,0},1,[{x,0}],{x,3}}. +%% ^^^^^ Was {x,0} - changing to {x,3} is not safe. +%% {gc_bif,'+',{f,0},0,[{y,2},{integer,1}],{x,0}}. +%% ^^^ Only one register live +%% . . . +%% {call_last,4,{f,2},4}. %% beam_validator noted that {x,3} wasn't live. + +find_operands(Cfg,XsiGraph,[],_Count) -> + {Cfg,XsiGraph}; +find_operands(Cfg,XsiGraph,ActiveList,Count) -> + {NewCfg,TempActiveList}=?MODULE:find_operands_for_active_list(Cfg,XsiGraph, + ActiveList,[]), + NewActiveList=lists:reverse(TempActiveList), + [Count+1, length(NewActiveList), length(digraph:vertices(XsiGraph))], + find_operands(NewCfg,XsiGraph,NewActiveList,Count+1). + +%%% +%%% Common functions. +%%% + +id(I) -> I. diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl index 70c00f163c..6353ed3242 100644 --- a/lib/compiler/test/beam_utils_SUITE.erl +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -23,7 +23,7 @@ init_per_group/2,end_per_group/2, apply_fun/1,apply_mf/1,bs_init/1,bs_save/1, is_not_killed/1,is_not_used_at/1, - select/1,y_catch/1]). + select/1,y_catch/1,otp_8949_b/1,liveopt/1]). -export([id/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -41,7 +41,9 @@ groups() -> is_not_killed, is_not_used_at, select, - y_catch + y_catch, + otp_8949_b, + liveopt ]}]. init_per_suite(Config) -> @@ -232,6 +234,40 @@ do_y_catch_1(<<_,_/binary>>, _) -> do_y_catch_2(_) -> {a,b,c}. +otp_8949_b(_Config) -> + self() ! something, + value = otp_8949_b([], false), + {'EXIT',_} = (catch otp_8949_b([], true)), + ok. + +%% Would cause an endless loop in beam_utils. +otp_8949_b(A, B) -> + Var = id(value), + if + A == [], B == false -> + ok + end, + receive + something -> + id(Var) + end. + +-record(alarmInfo, {type,cause,origin}). + +liveopt(_Config) -> + F = liveopt_fun(42, pebkac, user), + void = F(42, #alarmInfo{type=sctp,cause=pebkac,origin=user}), + ok. + +liveopt_fun(Peer, Cause, Origin) -> + fun(PeerNo, AlarmInfo) + when PeerNo == Peer andalso + AlarmInfo == #alarmInfo{type=sctp, + cause=Cause, + origin=Origin} -> + void + end. + %% The identity function. id(I) -> I. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index c2d146a0b1..224abf6c29 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -24,11 +24,11 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, - fun_shadow/1,int_float/1,otp_5269/1,null_fields/1,wiger/1, + size_shadow/1,int_float/1,otp_5269/1,null_fields/1,wiger/1, bin_tail/1,save_restore/1, partitioned_bs_match/1,function_clause/1, unit/1,shared_sub_bins/1,bin_and_float/1, - dec_subidentifiers/1,skip_optional_tag/1, + dec_subidentifiers/1,skip_optional_tag/1,decode_integer/1, wfbm/1,degenerated_match/1,bs_sum/1,coverage/1, multiple_uses/1,zero_label/1,followed_by_catch/1, matching_meets_construction/1,simon/1,matching_and_andalso/1, @@ -38,7 +38,7 @@ no_partition/1,calling_a_binary/1,binary_in_map/1, match_string_opt/1,select_on_integer/1, map_and_binary/1,unsafe_branch_caching/1, - bad_literals/1,good_literals/1]). + bad_literals/1,good_literals/1,constant_propagation/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -56,11 +56,11 @@ all() -> groups() -> [{p,[parallel], - [fun_shadow,int_float,otp_5269,null_fields,wiger, + [size_shadow,int_float,otp_5269,null_fields,wiger, bin_tail,save_restore, partitioned_bs_match,function_clause,unit, shared_sub_bins,bin_and_float,dec_subidentifiers, - skip_optional_tag,wfbm,degenerated_match,bs_sum, + skip_optional_tag,decode_integer,wfbm,degenerated_match,bs_sum, coverage,multiple_uses,zero_label,followed_by_catch, matching_meets_construction,simon, matching_and_andalso,otp_7188,otp_7233,otp_7240, @@ -69,7 +69,7 @@ groups() -> no_partition,calling_a_binary,binary_in_map, match_string_opt,select_on_integer, map_and_binary,unsafe_branch_caching, - bad_literals,good_literals]}]. + bad_literals,good_literals,constant_propagation]}]. init_per_suite(Config) -> @@ -91,33 +91,54 @@ init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> ok. -fun_shadow(Config) when is_list(Config) -> - %% OTP-5270 - 7 = fun_shadow_1(), - 7 = fun_shadow_2(8), - 7 = fun_shadow_3(), - no = fun_shadow_4(8), +size_shadow(Config) when is_list(Config) -> + %% Originally OTP-5270. + 7 = size_shadow_1(), + 7 = size_shadow_2(8), + 7 = size_shadow_3(), + no = size_shadow_4(8), + Any = {any,term,goes}, + {2577,Any,-175,whatever} = + (size_shadow_5(Any, 12))(<<2577:12>>, -175, whatever), + {7777,Any,42,whatever} = + (size_shadow_6(Any, 13))(42, <<7777:13>>, whatever), + {<<45>>,<<>>} = size_shadow_7({int,1}, <<1:16,45>>), + {'EXIT',{function_clause,_}} = + (catch size_shadow_7({int,42}, <<1:16,45>>)), ok. -fun_shadow_1() -> +size_shadow_1() -> L = 8, F = fun(<<L:L,B:L>>) -> B end, F(<<16:8, 7:16>>). -fun_shadow_2(L) -> +size_shadow_2(L) -> F = fun(<<L:L,B:L>>) -> B end, F(<<16:8, 7:16>>). -fun_shadow_3() -> +size_shadow_3() -> L = 8, F = fun(<<L:L,B:L,L:L>>) -> B end, F(<<16:8, 7:16,16:16>>). -fun_shadow_4(L) -> +size_shadow_4(L) -> F = fun(<<L:L,B:L,L:L>>) -> B; (_) -> no end, F(<<16:8, 7:16,15:16>>). +size_shadow_5(X, Y) -> + fun (<< A:Y >>, Y, B) -> fum(A, X, Y, B) end. + +size_shadow_6(X, Y) -> + fun (Y, << A:Y >>, B) -> fum(A, X, Y, B) end. + +fum(A, B, C, D) -> + {A,B,C,D}. + +size_shadow_7({int,N}, <<N:16,B:N/binary,T/binary>>) -> + {B,T}. + + int_float(Config) when is_list(Config) -> %% OTP-5323 <<103133.0:64/float>> = <<103133:64/float>>, @@ -504,6 +525,23 @@ skip_optional_tag(<<Tag,RestTag/binary>>, <<Tag,Rest/binary>>) -> skip_optional_tag(RestTag, Rest); skip_optional_tag(_, _) -> missing. +decode_integer(_Config) -> + {10795,<<43>>,whatever} = decode_integer(1, <<42,43>>, whatever), + {-28909,<<19>>,whatever} = decode_integer(1, <<143,19>>, whatever), + ok. + +decode_integer(Len, <<B1:1,B2:7,Bs/binary>>, RemovedBytes) when B1 == 0 -> + Bin = <<_Skip:Len/unit:8, Buffer2/binary>> = <<B1:1,B2:7,Bs/binary>>, + Size = byte_size(Bin), + <<Int:Size/unit:8>> = Bin, + {Int,Buffer2,RemovedBytes}; +decode_integer(Len, <<B1:1,B2:7,Bs/binary>>, RemovedBytes) -> + Bin = <<_Skip:Len/unit:8,Buffer2/binary>> = <<B1:1,B2:7,Bs/binary>>, + Size = byte_size(Bin), + <<N:Size/unit:8>> = <<B2,Bs/binary>>, + Int = N - (1 bsl (8 * size(Bin) -1)), + {Int,Buffer2,RemovedBytes}. + -define(DATELEN, 16). wfbm(Config) when is_list(Config) -> @@ -1387,6 +1425,32 @@ good_literals(_Config) -> <<16#cafebeef:4/unit:8>> = id(<<16#cafebeef:32>>), ok. +constant_propagation(_Config) -> + <<5>> = constant_propagation_a(a, <<5>>), + {'EXIT',{{case_clause,b},_}} = (catch constant_propagation_a(b, <<5>>)), + 258 = constant_propagation_b(<<1,2>>), + F = constant_propagation_c(), + 259 = F(<<1,3>>), + ok. + +constant_propagation_a(X, Y) -> + case X of + a -> Y2 = 8 + end, + <<5:Y2>> = Y. + +constant_propagation_b(B) -> + Sz = 16, + <<X:Sz/integer>> = B, + X. + +constant_propagation_c() -> + Size = 16, + fun(Bin) -> + <<X:Size/integer>> = Bin, + X + end. + check(F, R) -> R = F(). diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 6961e625fd..cd1bc099e9 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -19,11 +19,48 @@ %%% Purpose : Compiles various modules with tough code -module(compilation_SUITE). +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + beam_compiler_4/1, + beam_compiler_6/1, + beam_compiler_7/1, + beam_compiler_8/1, + beam_compiler_9/1, + beam_compiler_10/1, + beam_compiler_11/1, + compiler_1/1, + const_list_256/1, + convopts/1, + live_var/1, + on_load/1, + on_load_inline/1, + opt_crash/1, + otp_2330/1, + otp_2380/1, + otp_4790/1, + otp_5151/1, + otp_5235/1, + otp_5404/1, + otp_5436/1, + otp_5481/1, + otp_5553/1, + otp_5632/1, + otp_5714/1, + otp_5872/1, + otp_6121/1, + otp_7202/1, + otp_8949_a/1, + redundant_case/1, + self_compile/1, + self_compile_old_inliner/1, + split_cases/1, + string_table/1, + vsn_1/1, + vsn_2/1, + vsn_3/1]). -include_lib("common_test/include/ct.hrl"). --compile(export_all). - suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,10}}]. @@ -37,23 +74,18 @@ groups() -> [{vsn,[parallel],[vsn_1,vsn_2,vsn_3]}, {p,test_lib:parallel(), [compiler_1, - compiler_3,compiler_5,beam_compiler_1, - beam_compiler_2,beam_compiler_3,beam_compiler_4, - beam_compiler_5,beam_compiler_6,beam_compiler_7, + beam_compiler_4,beam_compiler_6,beam_compiler_7, beam_compiler_8,beam_compiler_9,beam_compiler_10, - beam_compiler_11,beam_compiler_12, - nested_tuples_in_case_expr,otp_2330,guards, - {group,vsn},otp_2380,otp_2141,otp_2173,otp_4790, - const_list_256,bin_syntax_1,bin_syntax_2, - bin_syntax_3,bin_syntax_4,bin_syntax_5,bin_syntax_6, - live_var,convopts, - catch_in_catch,redundant_case,long_string,otp_5076, - complex_guard,otp_5092,otp_5151,otp_5235,otp_5244, - trycatch_4,opt_crash,otp_5404,otp_5436,otp_5481, + beam_compiler_11, + otp_2330, + {group,vsn},otp_2380,otp_4790, + const_list_256,live_var,convopts, + redundant_case, + otp_5151,otp_5235, + opt_crash,otp_5404,otp_5436,otp_5481, otp_5553,otp_5632,otp_5714,otp_5872,otp_6121, - otp_6121a,otp_6121b,otp_7202,otp_7345,on_load, - string_table,otp_8949_a,otp_8949_b,split_cases, - beam_utils_liveopt]}]. + otp_7202,on_load,on_load_inline, + string_table,otp_8949_a,split_cases]}]. init_per_suite(Config) -> Config. @@ -70,85 +102,25 @@ end_per_group(_GroupName, Config) -> -define(comp(N), N(Config) when is_list(Config) -> try_it(N, Config)). --define(comp_fail(N), - N(Config) when is_list(Config) -> failure(N, Config)). - ?comp(compiler_1). -?comp(compiler_3). -?comp(compiler_4). -?comp(compiler_5). -?comp(beam_compiler_1). -?comp(beam_compiler_2). -?comp(beam_compiler_3). ?comp(beam_compiler_4). -?comp(beam_compiler_5). ?comp(beam_compiler_6). ?comp(beam_compiler_8). ?comp(beam_compiler_9). ?comp(beam_compiler_10). ?comp(beam_compiler_11). -?comp(beam_compiler_12). -?comp(beam_compiler_13). - -?comp(nested_tuples_in_case_expr). ?comp(otp_2330). ?comp(otp_2380). -?comp(otp_2141). -?comp(otp_2173). ?comp(otp_4790). ?comp(otp_5235). -?comp(otp_5244). - -?comp(guards). - -?comp(pattern_expr). - ?comp(const_list_256). -?comp(bin_syntax_1). -?comp(bin_syntax_2). -?comp(bin_syntax_3). -?comp(bin_syntax_4). - -?comp(bin_syntax_6). - -?comp(otp_5076). - -?comp(complex_guard). - -?comp(otp_5092). ?comp(otp_5151). -%%% By Per Gustafsson <[email protected]> - -bin_syntax_5(Config) when is_list(Config) -> - {<<45>>,<<>>} = split({int, 1}, <<1:16,45>>). - -split({int, N}, <<N:16,B:N/binary,T/binary>>) -> - {B,T}. - -%% This program works with the old version of the compiler -%% but, the core erlang that it produces have the same variable appearing -%% looks like this: -%% -%% split({int, N}, <<_core1:16, B:N/binary, T/binary>>) when _core1==N -%% -%% with my change it will look like this: -%% -%% split({int, N}, <<_core1:16, B:_core1/binary, T/binary>>) when _core1==N -%% -%% This means that everything worked fine as long as the pattern -%% matching order was left-to-right but on core erlang any order should be possible - ?comp(live_var). - -?comp(trycatch_4). - -?comp(catch_in_catch). - ?comp(opt_crash). ?comp(otp_5404). @@ -159,8 +131,6 @@ split({int, N}, <<N:16,B:N/binary,T/binary>>) -> ?comp(otp_5714). ?comp(otp_5872). ?comp(otp_6121). -?comp(otp_6121a). -?comp(otp_6121b). ?comp(convopts). ?comp(otp_7202). ?comp(on_load). @@ -193,91 +163,38 @@ redundant_case_1(3) -> d; redundant_case_1(4) -> d; redundant_case_1(_) -> d. -failure(Module, Conf) -> - Src = filename:join(proplists:get_value(data_dir, Conf), - atom_to_list(Module)), - Out = proplists:get_value(priv_dir, Conf), - io:format("Compiling: ~ts\n", [Src]), - CompRc = compile:file(Src, [{outdir,Out},return,time]), - io:format("Result: ~p\n",[CompRc]), - case CompRc of - error -> ok; - {error,Errors,_} -> check_errors(Errors); - _ -> ct:fail({no_error, CompRc}) - end, - ok. - -check_errors([{_,Eds}|T]) -> - check_error(Eds), - check_errors(T); -check_errors([]) -> ok. - -check_error([{_,Mod,Error}|T]) -> - check_error_1(Mod:format_error(Error)), - check_error(T); -check_error([{Mod,Error}|T]) -> - check_error_1(Mod:format_error(Error)), - check_error(T); -check_error([]) -> ok. - -check_error_1(Str0) -> - Str = lists:flatten(Str0), - io:format("~s\n", [Str]), - case Str of - "internal"++_=Str -> - ct:fail(internal_compiler_error); - _ -> - ok - end. - --define(TC(Body), tc(fun() -> Body end, ?LINE)). - try_it(Module, Conf) -> - %% Change 'false' to 'true' to start a new node for every module. - try_it(false, Module, Conf). - -try_it(StartNode, Module, Conf) -> - try_it(StartNode, Module, {minutes,10}, Conf). - -try_it(StartNode, Module, Timetrap, Conf) -> + Timetrap = {minutes,10}, OtherOpts = [], %Can be changed to [time] if needed Src = filename:join(proplists:get_value(data_dir, Conf), atom_to_list(Module)), Out = proplists:get_value(priv_dir,Conf), io:format("Compiling: ~s\n", [Src]), - CompRc0 = compile:file(Src, [clint,{outdir,Out},report, - bin_opt_info|OtherOpts]), + CompRc0 = compile:file(Src, [clint0,clint,{outdir,Out},report, + bin_opt_info|OtherOpts]), io:format("Result: ~p\n",[CompRc0]), {ok,_Mod} = CompRc0, - Node = case StartNode of - false -> - node(); - true -> - Pa = "-pa " ++ filename:dirname(code:which(?MODULE)), - {ok,Node0} = start_node(compiler, Pa), - Node0 - end, - - ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), load_and_call(Out, Module), ct:timetrap(Timetrap), io:format("Compiling (without optimization): ~s\n", [Src]), CompRc1 = compile:file(Src, - [no_copt,no_postopt,{outdir,Out},report|OtherOpts]), + [no_copt,no_postopt, + {outdir,Out},report|OtherOpts]), io:format("Result: ~p\n",[CompRc1]), {ok,_Mod} = CompRc1, - ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), + load_and_call(Out, Module), ct:timetrap(Timetrap), io:format("Compiling (with old inliner): ~s\n", [Src]), - CompRc2 = compile:file(Src, [{outdir,Out},report,bin_opt_info, - {inline,1000}|OtherOpts]), + CompRc2 = compile:file(Src, [clint, + {outdir,Out},report,bin_opt_info, + {inline,1000}|OtherOpts]), io:format("Result: ~p\n",[CompRc2]), {ok,_Mod} = CompRc2, - ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), + load_and_call(Out, Module), ct:timetrap(Timetrap), io:format("Compiling (from assembly): ~s\n", [Src]), @@ -286,12 +203,8 @@ try_it(StartNode, Module, Timetrap, Conf) -> CompRc3 = compile:file(Asm, [from_asm,{outdir,Out},report|OtherOpts]), io:format("Result: ~p\n",[CompRc3]), {ok,_} = CompRc3, - ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), + load_and_call(Out, Module), - case StartNode of - false -> ok; - true -> test_server:stop_node(Node) - end, ok. load_and_call(Out, Module) -> @@ -319,24 +232,6 @@ load_and_call(Out, Module) -> ok. -tc(F, Line) -> - {Diff,Value} = timer:tc(erlang, apply, [F,[]]), - io:format("~p: ~p\n", [Line,Diff]), - Value. - -start_node(Name, Args) -> - case test_server:start_node(Name, slave, [{args, Args}]) of - {ok, Node} -> - {ok, Node}; - Error -> - ct:fail(Error) - end. - -from(H, [H | T]) -> T; -from(H, [_ | T]) -> from(H, T); -from(_, []) -> []. - - %% Test generation of 'vsn' attribute. vsn_1(Conf) when is_list(Conf) -> M = vsn_1, @@ -397,11 +292,6 @@ get_vsn(M) -> {vsn,V} = lists:keyfind(vsn, 1, M:module_info(attributes)), V. -long_string(Config) when is_list(Config) -> - %% The test must complete in one minute - it should be plenty of time. - try_it(false, long_string, {minutes,1}, Config), - ok. - compile_load(Module, Dir, Conf) -> Src = filename:join(Dir, atom_to_list(Module)), Out = proplists:get_value(priv_dir,Conf), @@ -465,6 +355,7 @@ compile_compiler(Files, OutDir, Version, InlineOpts) -> io:format("~ts", [code:which(compile)]), io:format("Compiling ~s into ~ts", [Version,OutDir]), Opts = [report, + clint0,clint, bin_opt_info, {outdir,OutDir}, {d,'COMPILER_VSN',"\""++Version++"\""}, @@ -480,10 +371,6 @@ compile_compiler(Files, OutDir, Version, InlineOpts) -> compiler_src() -> filelib:wildcard(filename:join([code:lib_dir(compiler), "src", "*.erl"])). -compiler_modules(Dir) -> - Files = filelib:wildcard(filename:join(Dir, "*.beam")), - [list_to_atom(filename:rootname(filename:basename(F))) || F <- Files]. - make_compiler_dir(Priv, Dir0) -> Dir = filename:join(Priv, Dir0), ok = file:make_dir(Dir), @@ -502,112 +389,6 @@ compare_compilers(ADir, BDir) -> ["beam_asm.beam"] = [filename:basename(A) || {A,_} <- D], ok. -%%% -%%% The only test of the following code is that it compiles. -%%% - -%% Slightly simplifed from megaco_binary_term_id_gen. -%% beam_block failed to note that the {gc_bif,'-'...} instruction could -%% fail, and that therefore {y,0} need to be initialized. -%% {allocate,8,6}. -%% %% {init,{y,0}} needed here. -%% {get_list,{x,1},{x,6},{x,7}}. -%% {'catch',{y,7},{f,3}}. -%% {move,{x,4},{y,1}}. -%% {move,{x,3},{y,2}}. -%% {move,{x,2},{y,3}}. -%% {move,{x,5},{y,4}}. -%% {move,{x,7},{y,5}}. -%% {move,{x,6},{y,6}}. -%% {gc_bif,'-',{f,0},8,[{x,3},{x,6}],{x,0}}. -%% {move,{x,0},{y,0}}. - -encode_wildcards3([],[],_,_) -> []; -encode_wildcards3([Level|Levels],[BitsInLevel|BitsRest],LevelNo,TotSize) -> - case (catch ?MODULE:encode_wildcard(Level,BitsInLevel,TotSize-BitsInLevel, - length(Levels))) of - {'EXIT',{Reason,Info}} -> - exit({Reason,{LevelNo,Info}}); - - no_wildcard -> - encode_wildcards3(Levels,BitsRest,LevelNo+1,TotSize-BitsInLevel); - - {level,Wl} -> - [Wl| - encode_wildcards3(Levels,BitsRest,LevelNo+1,TotSize-BitsInLevel)]; - - {recursive,Wr} -> - [Wr] - end. - -%% Slightly simplified code from hipe_rtl_ssapre. -%% beam_block used to do the following incorrect optimization: -%% -%% {gc_bif,length,{f,0},1,[{x,0}],{x,3}}. -%% ^^^^^ Was {x,0} - changing to {x,3} is not safe. -%% {gc_bif,'+',{f,0},0,[{y,2},{integer,1}],{x,0}}. -%% ^^^ Only one register live -%% . . . -%% {call_last,4,{f,2},4}. %% beam_validator noted that {x,3} wasn't live. - -find_operands(Cfg,XsiGraph,[],_Count) -> - {Cfg,XsiGraph}; -find_operands(Cfg,XsiGraph,ActiveList,Count) -> - {NewCfg,TempActiveList}=?MODULE:find_operands_for_active_list(Cfg,XsiGraph, - ActiveList,[]), - NewActiveList=lists:reverse(TempActiveList), - [Count+1, length(NewActiveList), length(digraph:vertices(XsiGraph))], - find_operands(NewCfg,XsiGraph,NewActiveList,Count+1). - - -%% The following code -%% -%% {get_list,{x,2},{x,0},{x,1}}. -%% {gc_bif,length,{f,0},1,[{x,0}],{x,0}}. -%% {move,{x,0},{x,1}}. -%% -%% was incorrectly optimized to -%% -%% {get_list,{x,2},{x,0},{y,0}}. -%% {gc_bif,length,{f,0},3,[{x,0}],{x,1}}. -%% -%% because beam_block:is_transparent({x,1}, -%% {gc_bif,length,{f,0},3,[{x,0}],{x,1}} -%% incorrectly returned true. - --record(contextId,{cid,device_type,contextRef}). --record(dpRef,{cid,tlli,ms_device_context_id}). --record(qosProfileBssgp,{peak_bit_rate_msb, - peak_bit_rate_lsb, - t_a_precedence}). --record(llUnitdataReq,{sapi, - l3_pdu_length, - pdu_life}). --record(ptmsi,{value}). - -otp_7345(Config) when is_list(Config) -> - #llUnitdataReq{l3_pdu_length=3,pdu_life=4} = - otp_7345(#contextId{}, 0, [[1,2,3],4,5]). - - -otp_7345(ObjRef, _RdEnv, Args) -> - Cid = ObjRef#contextId.cid, - _ = #dpRef{cid = Cid, - ms_device_context_id = cid_id, - tlli = #ptmsi{value = 0}}, - _ = #qosProfileBssgp{peak_bit_rate_msb = 0, - peak_bit_rate_lsb = 80, - t_a_precedence = 49}, - [Cpdu|_] = Args, - LlUnitdataReq = - #llUnitdataReq{sapi = 7, - l3_pdu_length = length(Cpdu), - pdu_life = - id(42) - div - 10}, - id(LlUnitdataReq). - %% Check the generation of the string table. string_table(Config) when is_list(Config) -> @@ -640,24 +421,6 @@ do_otp_8949_a() -> end end. -otp_8949_b(Config) when is_list(Config) -> - self() ! something, - value = otp_8949_b([], false), - {'EXIT',_} = (catch otp_8949_b([], true)), - ok. - -%% Would cause an endless loop in beam_utils. -otp_8949_b(A, B) -> - Var = id(value), - if - A == [], B == false -> - ok - end, - receive - something -> - id(Var) - end. - split_cases(_) -> dummy1 = do_split_cases(x), {'EXIT',{{badmatch,b},_}} = (catch do_split_cases(y)), @@ -673,21 +436,5 @@ do_split_cases(A) -> end, Z. --record(alarmInfo, {type,cause,origin}). - -beam_utils_liveopt(Config) -> - F = beam_utils_liveopt_fun(42, pebkac, user), - void = F(42, #alarmInfo{type=sctp,cause=pebkac,origin=user}), - ok. - -beam_utils_liveopt_fun(Peer, Cause, Origin) -> - fun(PeerNo, AlarmInfo) - when PeerNo == Peer andalso - AlarmInfo == #alarmInfo{type=sctp, - cause=Cause, - origin=Origin} -> - void - end. - id(I) -> I. diff --git a/lib/compiler/test/compilation_SUITE_data/beam_compiler_1.erl b/lib/compiler/test/compilation_SUITE_data/beam_compiler_1.erl deleted file mode 100644 index 3e2891a28d..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/beam_compiler_1.erl +++ /dev/null @@ -1,32 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(beam_compiler_1). --export([beam_compiler_1/0]). - -beam_compiler_1() -> - ok. - --record(foo,{a,b}). - -try_me() -> - X = #foo{}, - Y = #foo{}, - {X#foo.a == Y#foo.a,X#foo.b}. - diff --git a/lib/compiler/test/compilation_SUITE_data/beam_compiler_12.erl b/lib/compiler/test/compilation_SUITE_data/beam_compiler_12.erl deleted file mode 100644 index d34291159a..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/beam_compiler_12.erl +++ /dev/null @@ -1,30 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(beam_compiler_12). - --export([?MODULE/0,t/1]). - -?MODULE() -> - ok. - -t(Name) -> - {ok = {file_info,_,regular,_,AccTime1,ModTime1,_,_,_,_,_,_,_,_}} = - prim_file:read_file_info(Name). - diff --git a/lib/compiler/test/compilation_SUITE_data/beam_compiler_2.erl b/lib/compiler/test/compilation_SUITE_data/beam_compiler_2.erl deleted file mode 100644 index 473529bb58..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/beam_compiler_2.erl +++ /dev/null @@ -1,36 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(beam_compiler_2). --export([beam_compiler_2/0]). - -beam_compiler_2() -> - ok. - --record(foo,{a,b}). - -try_me() -> - try_me({foo,x,z},{foo,y,z}). - -try_me(X,Y) -> - f(X#foo.a =/= Y#foo.a,X#foo.b =/= X#foo.b). - -f(A,B) -> - A. - diff --git a/lib/compiler/test/compilation_SUITE_data/beam_compiler_3.erl b/lib/compiler/test/compilation_SUITE_data/beam_compiler_3.erl deleted file mode 100644 index bdc4ec06e5..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/beam_compiler_3.erl +++ /dev/null @@ -1,30 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(beam_compiler_3). --export([beam_compiler_3/0, f/0]). - -%% From Ulf Wiger. - -beam_compiler_3() -> - ok. - -f() -> - [_|T] = lists:reverse("xxx"), - T. diff --git a/lib/compiler/test/compilation_SUITE_data/bin_syntax_2.erl b/lib/compiler/test/compilation_SUITE_data/bin_syntax_2.erl deleted file mode 100644 index cd0c2a4b0e..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/bin_syntax_2.erl +++ /dev/null @@ -1,42 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(bin_syntax_2). - --export([?MODULE/0]). - -%% This module tests that constant propagation is done properly. - -?MODULE() -> - 258 = b(<<1,2>>), - F = c(), - 259 = F(<<1,3>>), - ok. - -b(B) -> - Sz = 16, - <<X:Sz/integer>> = B, - X. - -c() -> - Size = 16, - fun(Bin) -> - <<X:Size/integer>> = Bin, - X - end. diff --git a/lib/compiler/test/compilation_SUITE_data/bin_syntax_3.erl b/lib/compiler/test/compilation_SUITE_data/bin_syntax_3.erl deleted file mode 100644 index b3118e0adc..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/bin_syntax_3.erl +++ /dev/null @@ -1,36 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(bin_syntax_3). --export([?MODULE/0,decode_integer/3]). - -?MODULE() -> - ok. - -decode_integer(Len, <<B1:1,B2:7,Bs/binary>>, RemovedBytes) when B1 == 0 -> - Bin = <<Skip:Len/unit:8, Buffer2/binary>> = <<B1:1,B2:7,Bs/binary>>, - Size = size(Bin), - <<Int:Size/unit:8>> = Bin, - {Int,Buffer2,RemovedBytes}; -decode_integer(Len,<<B1:1,B2:7,Bs/binary>>,RemovedBytes) -> - Bin = <<Skip:Len/unit:8,Buffer2/binary>> = <<B1:1,B2:7,Bs/binary>>, - Size = size(Bin), - <<N:Size/unit:8>> = <<B2,Bs/binary>>, - Int = N - (1 bsl (8 * size(Bin) -1)), - {Int,Buffer2,RemovedBytes}. diff --git a/lib/compiler/test/compilation_SUITE_data/bin_syntax_4.erl b/lib/compiler/test/compilation_SUITE_data/bin_syntax_4.erl deleted file mode 100644 index 185d6ec3b0..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/bin_syntax_4.erl +++ /dev/null @@ -1,33 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(bin_syntax_4). --export([?MODULE/0,f4b/2,f4c/2]). - -?MODULE() -> - ok. - -f4b(X, Y) -> - fun (<< A:Y >>, Y, B) -> fum(A, X, Y, B) end. - -f4c(X, Y) -> - fun (Y, << A:Y >>, B) -> fum(A, X, Y, B) end. - -fum(A, B, C, D) -> - {A,B,C,D}. diff --git a/lib/compiler/test/compilation_SUITE_data/bin_syntax_6.erl b/lib/compiler/test/compilation_SUITE_data/bin_syntax_6.erl deleted file mode 100644 index 1841a2ee0a..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/bin_syntax_6.erl +++ /dev/null @@ -1,40 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(bin_syntax_6). --export([?MODULE/0,x/1,y/1]). - -?MODULE() -> - ok. - -x(X) -> - blurf(), - B = {X,"OK",<<>>}, - catch b({a,B}). - -y(X) -> - blurf(), - B = {X,"OK",<<42>>}, - catch b({a,B}). - -blurf() -> - ok. - -b(_) -> - ok. diff --git a/lib/compiler/test/compilation_SUITE_data/catch_in_catch.erl b/lib/compiler/test/compilation_SUITE_data/catch_in_catch.erl deleted file mode 100644 index 05ef45f105..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/catch_in_catch.erl +++ /dev/null @@ -1,52 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(catch_in_catch). - --export([?MODULE/0,do_start/1]). - -?MODULE() -> - process_flag(trap_exit, true), - Pid = spawn_link(?MODULE, do_start, [x]), - receive - {'EXIT',Pid,good_exit} -> ok; - Other -> - io:format("Unexpected: ~p\n", [Other]), - error - after 32000 -> - io:format("No message received\n"), - error - end. - -do_start(Param) -> - init(Param), - exit(good_exit). - -init(Param) -> - process_flag(trap_exit, true), - %% The catches were improperly nested, causing a "No catch found" crash. - (catch begin - foo(Param), - (catch exit(bar)) - end - ), - ignore. - -foo(_) -> - ok. diff --git a/lib/compiler/test/compilation_SUITE_data/compiler_3.erl b/lib/compiler/test/compilation_SUITE_data/compiler_3.erl deleted file mode 100644 index 698a0f26f3..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/compiler_3.erl +++ /dev/null @@ -1,34 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(compiler_3). --export([compiler_3/0]). --record(rec,{a}). - -compiler_3() -> - guard_record(). - -guard_record() -> - 1=func(#rec{}), - {'EXIT',_} = (catch func({rec})), - ok. - -func(X) when record(X, -rec) -> - 1. diff --git a/lib/compiler/test/compilation_SUITE_data/compiler_5.erl b/lib/compiler/test/compilation_SUITE_data/compiler_5.erl deleted file mode 100644 index de3c2ec4ce..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/compiler_5.erl +++ /dev/null @@ -1,50 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(compiler_5). --export([compiler_5/0]). - -compiler_5() -> - f0(), - f1(), - f2(), - ok. - -%% compiler treats records with 1 and 2 fields differently... --record(nil, {}). --record(foo, {hello=1}). --record(bar, {hello=2,there=3}). - -f0() -> - R1 = #nil{}, - R2 = R1#nil{}, %% stupid code, but compiler shouldn't crash - R1 = R2, - ok. - -f1() -> - R1 = #foo{}, - R2 = R1#foo{}, %% stupid code, but compiler shouldn't crash - R1 = R2, - ok. - -f2() -> - R1 = #bar{}, - R2 = R1#bar{}, %% stupid code, but compiler shouldn't crash - R1 = R2, - ok. diff --git a/lib/compiler/test/compilation_SUITE_data/complex_guard.erl b/lib/compiler/test/compilation_SUITE_data/complex_guard.erl deleted file mode 100644 index f1b88c2bd2..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/complex_guard.erl +++ /dev/null @@ -1,32 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(complex_guard). - --compile(export_all). - -?MODULE() -> - ok. - -f(X1,Y1,Z1) -> - if - ((X1 =:= 4) or (X1 =:= 5)) and ((Y1 =:= 4) or (Y1 =:= 5)) and ((Z1 =:= 4) or (Z1 =:= 5)) or ((X1 =:= 1) or (X1 =:= 2) or (X1 =:= 3)) and ((Y1 =:= 1) or (Y1 =:= 2) or (Y1 =:= 3)) and ((Z1 =:= 1) or (Z1 =:= 2) or (Z1 =:= 3)) -> - true - end. - diff --git a/lib/compiler/test/compilation_SUITE_data/guards.erl b/lib/compiler/test/compilation_SUITE_data/guards.erl deleted file mode 100644 index a507add790..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/guards.erl +++ /dev/null @@ -1,107 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(guards). - --export([guards/0]). - -guards() -> - ok = t(), - ok = f(), - ok = ct(1), - ok = multi(1), - ok = multi(2), - ok = multi(3). - -%% The following tests are always true. -t() when integer(42) -> - ok; -t() when float(2.0) -> - ok; -t() when number(7) -> - ok; -t() when number(3.14) -> - ok; -t() when atom(error) -> - ok; -t() when list([a]) -> - ok; -t() when tuple({}) -> - ok; -t() when tuple({1, 2}) -> - ok. - -%% The following tests are always false. -f() when integer(a) -> - ok; -f() when float(b) -> - ok; -f() when number(c) -> - ok; -f() when atom(42) -> - ok; -f() when list(33) -> - ok; -f() when list({}) -> - ok; -f() when list({1, 2}) -> - ok; -f() when tuple(33) -> - ok; -f() when tuple([a]) -> - ok; -f() when tuple([]) -> - ok; -f() when tuple(35) -> - ok; -f() -> - ok. - -%% The following tests are always true. -ct(X) -> - case X of - Y when integer(42) -> - ok; - Y when float(2.0) -> - ok; - Y when number(7) -> - ok; - Y when number(3.14) -> - ok; - Y when atom(error) -> - ok; - Y when list([a]) -> - ok; - Y when tuple({}) -> - ok; - Y when tuple({1, 2}) -> - ok - end. - -multi(X) -> - case X of - Y when float(Y) ; integer(Y) -> - ok; - Y when Y > 1, Y < 10 ; atom(Y) -> - ok; - Y when Y == 4, number(Y) ; list(Y) -> - pannkaka; - Y when Y==3 ; Y==5 ; Y==6 -> - ok - end. diff --git a/lib/compiler/test/compilation_SUITE_data/long_string.erl b/lib/compiler/test/compilation_SUITE_data/long_string.erl deleted file mode 100644 index fe109c8e4f..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/long_string.erl +++ /dev/null @@ -1,671 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(long_string). - --export([?MODULE/0]). - -?MODULE() -> - Options = "some stupid long string", - 49252 = length(generate(Options, "348927432097sfkjfkljf329")), - ok. - -generate(Options, Glurf) -> - "asdhfaslfdjhhwleirsk e4kjhr430usduy fdk;///s llsjkf;laskjfsdfkjasdfkj -sdkljflasdfkjasldkfjasd" ++ Options ++ -"CSAgICAgICBWZXJzaW9uIDIsIEp1bmUgMTk5MQoKIENvcHlyaWdodCAoQykgMTk4OSwgMTk5MSBG -cmVlIFNvZnR3YXJlIEZvdW5kYXRpb24sIEluYy4KICAgICAgICAgICAgICAgICAgICAgICA1OSBU -ZW1wbGUgUGxhY2UsIFN1aXRlIDMzMCwgQm9zdG9uLCBNQSAgMDIxMTEtMTMwNyAgVVNBCiBFdmVy -eW9uZSBpcyBwZXJtaXR0ZWQgdG8gY29weSBhbmQgZGlzdHJpYnV0ZSB2ZXJiYXRpbSBjb3BpZXMK -IG9mIHRoaXMgbGljZW5zZSBkb2N1bWVudCwgYnV0IGNoYW5naW5nIGl0IGlzIG5vdCBhbGxvd2Vk -LgoKCQkJICAgIFByZWFtYmxlCgogIFRoZSBsaWNlbnNlcyBmb3IgbW9zdCBzb2Z0d2FyZSBhcmUg -ZGVzaWduZWQgdG8gdGFrZSBhd2F5IHlvdXIKZnJlZWRvbSB0byBzaGFyZSBhbmQgY2hhbmdlIGl0 -LiAgQnkgY29udHJhc3QsIHRoZSBHTlUgR2VuZXJhbCBQdWJsaWMKTGljZW5zZSBpcyBpbnRlbmRl -ZCB0byBndWFyYW50ZWUgeW91ciBmcmVlZG9tIHRvIHNoYXJlIGFuZCBjaGFuZ2UgZnJlZQpzb2Z0 -d2FyZS0tdG8gbWFrZSBzdXJlIHRoZSBzb2Z0d2FyZSBpcyBmcmVlIGZvciBhbGwgaXRzIHVzZXJz -LiAgVGhpcwpHZW5lcmFsIFB1YmxpYyBMaWNlbnNlIGFwcGxpZXMgdG8gbW9zdCBvZiB0aGUgRnJl -ZSBTb2Z0d2FyZQpGb3VuZGF0aW9uJ3Mgc29mdHdhcmUgYW5kIHRvIGFueSBvdGhlciBwcm9ncmFt -IHdob3NlIGF1dGhvcnMgY29tbWl0IHRvCnVzaW5nIGl0LiAgKFNvbWUgb3RoZXIgRnJlZSBTb2Z0 -d2FyZSBGb3VuZGF0aW9uIHNvZnR3YXJlIGlzIGNvdmVyZWQgYnkKdGhlIEdOVSBMaWJyYXJ5IEdl -bmVyYWwgUHVibGljIExpY2Vuc2UgaW5zdGVhZC4pICBZb3UgY2FuIGFwcGx5IGl0IHRvCnlvdXIg -cHJvZ3JhbXMsIHRvby4KCiAgV2hlbiB3ZSBzcGVhayBvZiBmcmVlIHNvZnR3YXJlLCB3ZSBhcmUg -cmVmZXJyaW5nIHRvIGZyZWVkb20sIG5vdApwcmljZS4gIE91ciBHZW5lcmFsIFB1YmxpYyBMaWNl -bnNlcyBhcmUgZGVzaWduZWQgdG8gbWFrZSBzdXJlIHRoYXQgeW91CmhhdmUgdGhlIGZyZWVkb20g -dG8gZGlzdHJpYnV0ZSBjb3BpZXMgb2YgZnJlZSBzb2Z0d2FyZSAoYW5kIGNoYXJnZSBmb3IKdGhp -cyBzZXJ2aWNlIGlmIHlvdSB3aXNoKSwgdGhhdCB5b3UgcmVjZWl2ZSBzb3VyY2UgY29kZSBvciBj -YW4gZ2V0IGl0CmlmIHlvdSB3YW50IGl0LCB0aGF0IHlvdSBjYW4gY2hhbmdlIHRoZSBzb2Z0d2Fy -ZSBvciB1c2UgcGllY2VzIG9mIGl0CmluIG5ldyBmcmVlIHByb2dyYW1zOyBhbmQgdGhhdCB5b3Ug -a25vdyB5b3UgY2FuIGRvIHRoZXNlIHRoaW5ncy4KCiAgVG8gcHJvdGVjdCB5b3VyIHJpZ2h0cywg -d2UgbmVlZCB0byBtYWtlIHJlc3RyaWN0aW9ucyB0aGF0IGZvcmJpZAphbnlvbmUgdG8gZGVueSB5 -b3UgdGhlc2UgcmlnaHRzIG9yIHRvIGFzayB5b3UgdG8gc3VycmVuZGVyIHRoZSByaWdodHMuClRo -ZXNlIHJlc3RyaWN0aW9ucyB0cmFuc2xhdGUgdG8gY2VydGFpbiByZXNwb25zaWJpbGl0aWVzIGZv -ciB5b3UgaWYgeW91CmRpc3RyaWJ1dGUgY29waWVzIG9mIHRoZSBzb2Z0d2FyZSwgb3IgaWYgeW91 -IG1vZGlmeSBpdC4KCiAgRm9yIGV4YW1wbGUsIGlmIHlvdSBkaXN0cmlidXRlIGNvcGllcyBvZiBz -dWNoIGEgcHJvZ3JhbSwgd2hldGhlcgpncmF0aXMgb3IgZm9yIGEgZmVlLCB5b3UgbXVzdCBnaXZl -IHRoZSByZWNpcGllbnRzIGFsbCB0aGUgcmlnaHRzIHRoYXQKeW91IGhhdmUuICBZb3UgbXVzdCBt -YWtlIHN1cmUgdGhhdCB0aGV5LCB0b28sIHJlY2VpdmUgb3IgY2FuIGdldCB0aGUKc291cmNlIGNv -ZGUuICBBbmQgeW91IG11c3Qgc2hvdyB0aGVtIHRoZXNlIHRlcm1zIHNvIHRoZXkga25vdyB0aGVp -cgpyaWdodHMuCgogIFdlIHByb3RlY3QgeW91ciByaWdodHMgd2l0aCB0d28gc3RlcHM6ICgxKSBj -b3B5cmlnaHQgdGhlIHNvZnR3YXJlLCBhbmQKKDIpIG9mZmVyIHlvdSB0aGlzIGxpY2Vuc2Ugd2hp -Y2ggZ2l2ZXMgeW91IGxlZ2FsIHBlcm1pc3Npb24gdG8gY29weSwKZGlzdHJpYnV0ZSBhbmQvb3Ig -bW9kaWZ5IHRoZSBzb2Z0d2FyZS4KCiAgQWxzbywgZm9yIGVhY2ggYXV0aG9yJ3MgcHJvdGVjdGlv -biBhbmQgb3Vycywgd2Ugd2FudCB0byBtYWtlIGNlcnRhaW4KdGhhdCBldmVyeW9uZSB1bmRlcnN0 -YW5kcyB0aGF0IHRoZXJlIGlzIG5vIHdhcnJhbnR5IGZvciB0aGlzIGZyZWUKc29mdHdhcmUuICBJ -ZiB0aGUgc29mdHdhcmUgaXMgbW9kaWZpZWQgYnkgc29tZW9uZSBlbHNlIGFuZCBwYXNzZWQgb24s -IHdlCndhbnQgaXRzIHJlY2lwaWVudHMgdG8ga25vdyB0aGF0IHdoYXQgdGhleSBoYXZlIGlzIG5v -dCB0aGUgb3JpZ2luYWwsIHNvCnRoYXQgYW55IHByb2JsZW1zIGludHJvZHVjZWQgYnkgb3RoZXJz -IHdpbGwgbm90IHJlZmxlY3Qgb24gdGhlIG9yaWdpbmFsCmF1dGhvcnMnIHJlcHV0YXRpb25zLgoK -ICBGaW5hbGx5LCBhbnkgZnJlZSBwcm9ncmFtIGlzIHRocmVhdGVuZWQgY29uc3RhbnRseSBieSBz -b2Z0d2FyZQpwYXRlbnRzLiAgV2Ugd2lzaCB0byBhdm9pZCB0aGUgZGFuZ2VyIHRoYXQgcmVkaXN0 -cmlidXRvcnMgb2YgYSBmcmVlCnByb2dyYW0gd2lsbCBpbmRpdmlkdWFsbHkgb2J0YWluIHBhdGVu -dCBsaWNlbnNlcywgaW4gZWZmZWN0IG1ha2luZyB0aGUKcHJvZ3JhbSBwcm9wcmlldGFyeS4gIFRv -IHByZXZlbnQgdGhpcywgd2UgaGF2ZSBtYWRlIGl0IGNsZWFyIHRoYXQgYW55CnBhdGVudCBtdXN0 -IGJlIGxpY2Vuc2VkIGZvciBldmVyeW9uZSdzIGZyZWUgdXNlIG9yIG5vdCBsaWNlbnNlZCBhdCBh -bGwuCgogIFRoZSBwcmVjaXNlIHRlcm1zIGFuZCBjb25kaXRpb25zIGZvciBjb3B5aW5nLCBkaXN0 -cmlidXRpb24gYW5kCm1vZGlmaWNhdGlvbiBmb2xsb3cuCgwKCQkgICAgR05VIEdFTkVSQUwgUFVC -TElDIExJQ0VOU0UKICAgVEVSTVMgQU5EIENPTkRJVElPTlMgRk9SIENPUFlJTkcsIERJU1RSSUJV -VElPTiBBTkQgTU9ESUZJQ0FUSU9OCgogIDAuIFRoaXMgTGljZW5zZSBhcHBsaWVzIHRvIGFueSBw -cm9ncmFtIG9yIG90aGVyIHdvcmsgd2hpY2ggY29udGFpbnMKYSBub3RpY2UgcGxhY2VkIGJ5IHRo -ZSBjb3B5cmlnaHQgaG9sZGVyIHNheWluZyBpdCBtYXkgYmUgZGlzdHJpYnV0ZWQKdW5kZXIgdGhl -IHRlcm1zIG9mIHRoaXMgR2VuZXJhbCBQdWJsaWMgTGljZW5zZS4gIFRoZSAiUHJvZ3JhbSIsIGJl -bG93LApyZWZlcnMgdG8gYW55IHN1Y2ggcHJvZ3JhbSBvciB3b3JrLCBhbmQgYSAid29yayBiYXNl -ZCBvbiB0aGUgUHJvZ3JhbSIKbWVhbnMgZWl0aGVyIHRoZSBQcm9ncmFtIG9yIGFueSBkZXJpdmF0 -aXZlIHdvcmsgdW5kZXIgY29weXJpZ2h0IGxhdzoKdGhhdCBpcyB0byBzYXksIGEgd29yayBjb250 -YWluaW5nIHRoZSBQcm9ncmFtIG9yIGEgcG9ydGlvbiBvZiBpdCwKZWl0aGVyIHZlcmJhdGltIG9y -IHdpdGggbW9kaWZpY2F0aW9ucyBhbmQvb3IgdHJhbnNsYXRlZCBpbnRvIGFub3RoZXIKbGFuZ3Vh -Z2UuICAoSGVyZWluYWZ0ZXIsIHRyYW5zbGF0aW9uIGlzIGluY2x1ZGVkIHdpdGhvdXQgbGltaXRh -dGlvbiBpbgp0aGUgdGVybSAibW9kaWZpY2F0aW9uIi4pICBFYWNoIGxpY2Vuc2VlIGlzIGFkZHJl -c3NlZCBhcyAieW91Ii4KCkFjdGl2aXRpZXMgb3RoZXIgdGhhbiBjb3B5aW5nLCBkaXN0cmlidXRp -b24gYW5kIG1vZGlmaWNhdGlvbiBhcmUgbm90CmNvdmVyZWQgYnkgdGhpcyBMaWNlbnNlOyB0aGV5 -IGFyZSBvdXRzaWRlIGl0cyBzY29wZS4gIFRoZSBhY3Qgb2YKcnVubmluZyB0aGUgUHJvZ3JhbSBp -cyBub3QgcmVzdHJpY3RlZCwgYW5kIHRoZSBvdXRwdXQgZnJvbSB0aGUgUHJvZ3JhbQppcyBjb3Zl -cmVkIG9ubHkgaWYgaXRzIGNvbnRlbnRzIGNvbnN0aXR1dGUgYSB3b3JrIGJhc2VkIG9uIHRoZQpQ -cm9ncmFtIChpbmRlcGVuZGVudCBvZiBoYXZpbmcgYmVlbiBtYWRlIGJ5IHJ1bm5pbmcgdGhlIFBy -b2dyYW0pLgpXaGV0aGVyIHRoYXQgaXMgdHJ1ZSBkZXBlbmRzIG9uIHdoYXQgdGhlIFByb2dyYW0g -ZG9lcy4KCiAgMS4gWW91IG1heSBjb3B5IGFuZCBkaXN0cmlidXRlIHZlcmJhdGltIGNvcGllcyBv -ZiB0aGUgUHJvZ3JhbSdzCnNvdXJjZSBjb2RlIGFzIHlvdSByZWNlaXZlIGl0LCBpbiBhbnkgbWVk -aXVtLCBwcm92aWRlZCB0aGF0IHlvdQpjb25zcGljdW91c2x5IGFuZCBhcHByb3ByaWF0ZWx5IHB1 -Ymxpc2ggb24gZWFjaCBjb3B5IGFuIGFwcHJvcHJpYXRlCmNvcHlyaWdodCBub3RpY2UgYW5kIGRp -c2NsYWltZXIgb2Ygd2FycmFudHk7IGtlZXAgaW50YWN0IGFsbCB0aGUKbm90aWNlcyB0aGF0IHJl -ZmVyIHRvIHRoaXMgTGljZW5zZSBhbmQgdG8gdGhlIGFic2VuY2Ugb2YgYW55IHdhcnJhbnR5Owph -bmQgZ2l2ZSBhbnkgb3RoZXIgcmVjaXBpZW50cyBvZiB0aGUgUHJvZ3JhbSBhIGNvcHkgb2YgdGhp -cyBMaWNlbnNlCmFsb25nIHdpdGggdGhlIFByb2dyYW0uCgpZb3UgbWF5IGNoYXJnZSBhIGZlZSBm -b3IgdGhlIHBoeXNpY2FsIGFjdCBvZiB0cmFuc2ZlcnJpbmcgYSBjb3B5LCBhbmQKeW91IG1heSBh -dCB5b3VyIG9wdGlvbiBvZmZlciB3YXJyYW50eSBwcm90ZWN0aW9uIGluIGV4Y2hhbmdlIGZvciBh -IGZlZS4KCiAgMi4gWW91IG1heSBtb2RpZnkgeW91ciBjb3B5IG9yIGNvcGllcyBvZiB0aGUgUHJv -Z3JhbSBvciBhbnkgcG9ydGlvbgpvZiBpdCwgdGh1cyBmb3JtaW5nIGEgd29yayBiYXNlZCBvbiB0 -aGUgUHJvZ3JhbSwgYW5kIGNvcHkgYW5kCmRpc3RyaWJ1dGUgc3VjaCBtb2RpZmljYXRpb25zIG9y -IHdvcmsgdW5kZXIgdGhlIHRlcm1zIG9mIFNlY3Rpb24gMQphYm92ZSwgcHJvdmlkZWQgdGhhdCB5 -b3UgYWxzbyBtZWV0IGFsbCBvZiB0aGVzZSBjb25kaXRpb25zOgoKICAgIGEpIFlvdSBtdXN0IGNh -dXNlIHRoZSBtb2RpZmllZCBmaWxlcyB0byBjYXJyeSBwcm9taW5lbnQgbm90aWNlcwogICAgc3Rh -dGluZyB0aGF0IHlvdSBjaGFuZ2VkIHRoZSBmaWxlcyBhbmQgdGhlIGRhdGUgb2YgYW55IGNoYW5n -ZS4KCiAgICBiKSBZb3UgbXVzdCBjYXVzZSBhbnkgd29yayB0aGF0IHlvdSBkaXN0cmlidXRlIG9y -IHB1Ymxpc2gsIHRoYXQgaW4KICAgIHdob2xlIG9yIGluIHBhcnQgY29udGFpbnMgb3IgaXMgZGVy -aXZlZCBmcm9tIHRoZSBQcm9ncmFtIG9yIGFueQogICAgcGFydCB0aGVyZW9mLCB0byBiZSBsaWNl -bnNlZCBhcyBhIHdob2xlIGF0IG5vIGNoYXJnZSB0byBhbGwgdGhpcmQKICAgIHBhcnRpZXMgdW5k -ZXIgdGhlIHRlcm1zIG9mIHRoaXMgTGljZW5zZS4KCiAgICBjKSBJZiB0aGUgbW9kaWZpZWQgcHJv -Z3JhbSBub3JtYWxseSByZWFkcyBjb21tYW5kcyBpbnRlcmFjdGl2ZWx5CiAgICB3aGVuIHJ1biwg -eW91IG11c3QgY2F1c2UgaXQsIHdoZW4gc3RhcnRlZCBydW5uaW5nIGZvciBzdWNoCiAgICBpbnRl -cmFjdGl2ZSB1c2UgaW4gdGhlIG1vc3Qgb3JkaW5hcnkgd2F5LCB0byBwcmludCBvciBkaXNwbGF5 -IGFuCiAgICBhbm5vdW5jZW1lbnQgaW5jbHVkaW5nIGFuIGFwcHJvcHJpYXRlIGNvcHlyaWdodCBu -b3RpY2UgYW5kIGEKICAgIG5vdGljZSB0aGF0IHRoZXJlIGlzIG5vIHdhcnJhbnR5IChvciBlbHNl -LCBzYXlpbmcgdGhhdCB5b3UgcHJvdmlkZQogICAgYSB3YXJyYW50eSkgYW5kIHRoYXQgdXNlcnMg -bWF5IHJlZGlzdHJpYnV0ZSB0aGUgcHJvZ3JhbSB1bmRlcgogICAgdGhlc2UgY29uZGl0aW9ucywg -YW5kIHRlbGxpbmcgdGhlIHVzZXIgaG93IHRvIHZpZXcgYSBjb3B5IG9mIHRoaXMKICAgIExpY2Vu -c2UuICAoRXhjZXB0aW9uOiBpZiB0aGUgUHJvZ3JhbSBpdHNlbGYgaXMgaW50ZXJhY3RpdmUgYnV0 -CiAgICBkb2VzIG5vdCBub3JtYWxseSBwcmludCBzdWNoIGFuIGFubm91bmNlbWVudCwgeW91ciB3 -b3JrIGJhc2VkIG9uCiAgICB0aGUgUHJvZ3JhbSBpcyBub3QgcmVxdWlyZWQgdG8gcHJpbnQgYW4g -YW5ub3VuY2VtZW50LikKDApUaGVzZSByZXF1aXJlbWVudHMgYXBwbHkgdG8gdGhlIG1vZGlmaWVk -IHdvcmsgYXMgYSB3aG9sZS4gIElmCmlkZW50aWZpYWJsZSBzZWN0aW9ucyBvZiB0aGF0IHdvcmsg -YXJlIG5vdCBkZXJpdmVkIGZyb20gdGhlIFByb2dyYW0sCmFuZCBjYW4gYmUgcmVhc29uYWJseSBj -b25zaWRlcmVkIGluZGVwZW5kZW50IGFuZCBzZXBhcmF0ZSB3b3JrcyBpbgp0aGVtc2VsdmVzLCB0 -aGVuIHRoaXMgTGljZW5zZSwgYW5kIGl0cyB0ZXJtcywgZG8gbm90IGFwcGx5IHRvIHRob3NlCnNl -Y3Rpb25zIHdoZW4geW91IGRpc3RyaWJ1dGUgdGhlbSBhcyBzZXBhcmF0ZSB3b3Jrcy4gIEJ1dCB3 -aGVuIHlvdQpkaXN0cmlidXRlIHRoZSBzYW1lIHNlY3Rpb25zIGFzIHBhcnQgb2YgYSB3aG9sZSB3 -aGljaCBpcyBhIHdvcmsgYmFzZWQKb24gdGhlIFByb2dyYW0sIHRoZSBkaXN0cmlidXRpb24gb2Yg -dGhlIHdob2xlIG11c3QgYmUgb24gdGhlIHRlcm1zIG9mCnRoaXMgTGljZW5zZSwgd2hvc2UgcGVy -bWlzc2lvbnMgZm9yIG90aGVyIGxpY2Vuc2VlcyBleHRlbmQgdG8gdGhlCmVudGlyZSB3aG9sZSwg -YW5kIHRodXMgdG8gZWFjaCBhbmQgZXZlcnkgcGFydCByZWdhcmRsZXNzIG9mIHdobyB3cm90ZSBp -dC4KClRodXMsIGl0IGlzIG5vdCB0aGUgaW50ZW50IG9mIHRoaXMgc2VjdGlvbiB0byBjbGFpbSBy -aWdodHMgb3IgY29udGVzdAp5b3VyIHJpZ2h0cyB0byB3b3JrIHdyaXR0ZW4gZW50aXJlbHkgYnkg -eW91OyByYXRoZXIsIHRoZSBpbnRlbnQgaXMgdG8KZXhlcmNpc2UgdGhlIHJpZ2h0IHRvIGNvbnRy -b2wgdGhlIGRpc3RyaWJ1dGlvbiBvZiBkZXJpdmF0aXZlIG9yCmNvbGxlY3RpdmUgd29ya3MgYmFz -ZWQgb24gdGhlIFByb2dyYW0uCgpJbiBhZGRpdGlvbiwgbWVyZSBhZ2dyZWdhdGlvbiBvZiBhbm90 -aGVyIHdvcmsgbm90IGJhc2VkIG9uIHRoZSBQcm9ncmFtCndpdGggdGhlIFByb2dyYW0gKG9yIHdp -dGggYSB3b3JrIGJhc2VkIG9uIHRoZSBQcm9ncmFtKSBvbiBhIHZvbHVtZSBvZgphIHN0b3JhZ2Ug -b3IgZGlzdHJpYnV0aW9uIG1lZGl1bSBkb2VzIG5vdCBicmluZyB0aGUgb3RoZXIgd29yayB1bmRl -cgp0aGUgc2NvcGUgb2YgdGhpcyBMaWNlbnNlLgoKICAzLiBZb3UgbWF5IGNvcHkgYW5kIGRpc3Ry -aWJ1dGUgdGhlIFByb2dyYW0gKG9yIGEgd29yayBiYXNlZCBvbiBpdCwKdW5kZXIgU2VjdGlvbiAy -KSBpbiBvYmplY3QgY29kZSBvciBleGVjdXRhYmxlIGZvcm0gdW5kZXIgdGhlIHRlcm1zIG9mClNl -Y3Rpb25zIDEgYW5kIDIgYWJvdmUgcHJvdmlkZWQgdGhhdCB5b3UgYWxzbyBkbyBvbmUgb2YgdGhl -IGZvbGxvd2luZzoKCiAgICBhKSBBY2NvbXBhbnkgaXQgd2l0aCB0aGUgY29tcGxldGUgY29ycmVz -cG9uZGluZyBtYWNoaW5lLXJlYWRhYmxlCiAgICBzb3VyY2UgY29kZSwgd2hpY2ggbXVzdCBiZSBk -aXN0cmlidXRlZCB1bmRlciB0aGUgdGVybXMgb2YgU2VjdGlvbnMKICAgIDEgYW5kIDIgYWJvdmUg -b24gYSBtZWRpdW0gY3VzdG9tYXJpbHkgdXNlZCBmb3Igc29mdHdhcmUgaW50ZXJjaGFuZ2U7IG9y -LAoKICAgIGIpIEFjY29tcGFueSBpdCB3aXRoIGEgd3JpdHRlbiBvZmZlciwgdmFsaWQgZm9yIGF0 -IGxlYXN0IHRocmVlCiAgICB5ZWFycywgdG8gZ2l2ZSBhbnkgdGhpcmQgcGFydHksIGZvciBhIGNo -YXJnZSBubyBtb3JlIHRoYW4geW91cgogICAgY29zdCBvZiBwaHlzaWNhbGx5IHBlcmZvcm1pbmcg -c291cmNlIGRpc3RyaWJ1dGlvbiwgYSBjb21wbGV0ZQogICAgbWFjaGluZS1yZWFkYWJsZSBjb3B5 -IG9mIHRoZSBjb3JyZXNwb25kaW5nIHNvdXJjZSBjb2RlLCB0byBiZQogICAgZGlzdHJpYnV0ZWQg -dW5kZXIgdGhlIHRlcm1zIG9mIFNlY3Rpb25zIDEgYW5kIDIgYWJvdmUgb24gYSBtZWRpdW0KICAg -IGN1c3RvbWFyaWx5IHVzZWQgZm9yIHNvZnR3YXJlIGludGVyY2hhbmdlOyBvciwKCiAgICBjKSBB -Y2NvbXBhbnkgaXQgd2l0aCB0aGUgaW5mb3JtYXRpb24geW91IHJlY2VpdmVkIGFzIHRvIHRoZSBv -ZmZlcgogICAgdG8gZGlzdHJpYnV0ZSBjb3JyZXNwb25kaW5nIHNvdXJjZSBjb2RlLiAgKFRoaXMg -YWx0ZXJuYXRpdmUgaXMKICAgIGFsbG93ZWQgb25seSBmb3Igbm9uY29tbWVyY2lhbCBkaXN0cmli -dXRpb24gYW5kIG9ubHkgaWYgeW91CiAgICByZWNlaXZlZCB0aGUgcHJvZ3JhbSBpbiBvYmplY3Qg -Y29kZSBvciBleGVjdXRhYmxlIGZvcm0gd2l0aCBzdWNoCiAgICBhbiBvZmZlciwgaW4gYWNjb3Jk -IHdpdGggU3Vic2VjdGlvbiBiIGFib3ZlLikKClRoZSBzb3VyY2UgY29kZSBmb3IgYSB3b3JrIG1l -YW5zIHRoZSBwcmVmZXJyZWQgZm9ybSBvZiB0aGUgd29yayBmb3IKbWFraW5nIG1vZGlmaWNhdGlv -bnMgdG8gaXQuICBGb3IgYW4gZXhlY3V0YWJsZSB3b3JrLCBjb21wbGV0ZSBzb3VyY2UKY29kZSBt -ZWFucyBhbGwgdGhlIHNvdXJjZSBjb2RlIGZvciBhbGwgbW9kdWxlcyBpdCBjb250YWlucywgcGx1 -cyBhbnkKYXNzb2NpYXRlZCBpbnRlcmZhY2UgZGVmaW5pdGlvbiBmaWxlcywgcGx1cyB0aGUgc2Ny -aXB0cyB1c2VkIHRvCmNvbnRyb2wgY29tcGlsYXRpb24gYW5kIGluc3RhbGxhdGlvbiBvZiB0aGUg -ZXhlY3V0YWJsZS4gIEhvd2V2ZXIsIGFzIGEKc3BlY2lhbCBleGNlcHRpb24sIHRoZSBzb3VyY2Ug -Y29kZSBkaXN0cmlidXRlZCBuZWVkIG5vdCBpbmNsdWRlCmFueXRoaW5nIHRoYXQgaXMgbm9ybWFs -bHkgZGlzdHJpYnV0ZWQgKGluIGVpdGhlciBzb3VyY2Ugb3IgYmluYXJ5CmZvcm0pIHdpdGggdGhl -IG1ham9yIGNvbXBvbmVudHMgKGNvbXBpbGVyLCBrZXJuZWwsIGFuZCBzbyBvbikgb2YgdGhlCm9w -ZXJhdGluZyBzeXN0ZW0gb24gd2hpY2ggdGhlIGV4ZWN1dGFibGUgcnVucywgdW5sZXNzIHRoYXQg -Y29tcG9uZW50Cml0c2VsZiBhY2NvbXBhbmllcyB0aGUgZXhlY3V0YWJsZS4KCklmIGRpc3RyaWJ1 -dGlvbiBvZiBleGVjdXRhYmxlIG9yIG9iamVjdCBjb2RlIGlzIG1hZGUgYnkgb2ZmZXJpbmcKYWNj -ZXNzIHRvIGNvcHkgZnJvbSBhIGRlc2lnbmF0ZWQgcGxhY2UsIHRoZW4gb2ZmZXJpbmcgZXF1aXZh -bGVudAphY2Nlc3MgdG8gY29weSB0aGUgc291cmNlIGNvZGUgZnJvbSB0aGUgc2FtZSBwbGFjZSBj -b3VudHMgYXMKZGlzdHJpYnV0aW9uIG9mIHRoZSBzb3VyY2UgY29kZSwgZXZlbiB0aG91Z2ggdGhp -cmQgcGFydGllcyBhcmUgbm90CmNvbXBlbGxlZCB0byBjb3B5IHRoZSBzb3VyY2UgYWxvbmcgd2l0 -aCB0aGUgb2JqZWN0IGNvZGUuCgwKICA0LiBZb3UgbWF5IG5vdCBjb3B5LCBtb2RpZnksIHN1Ymxp -Y2Vuc2UsIG9yIGRpc3RyaWJ1dGUgdGhlIFByb2dyYW0KZXhjZXB0IGFzIGV4cHJlc3NseSBwcm92 -aWRlZCB1bmRlciB0aGlzIExpY2Vuc2UuICBBbnkgYXR0ZW1wdApvdGhlcndpc2UgdG8gY29weSwg -bW9kaWZ5LCBzdWJsaWNlbnNlIG9yIGRpc3RyaWJ1dGUgdGhlIFByb2dyYW0gaXMKdm9pZCwgYW5k -IHdpbGwgYXV0b21hdGljYWxseSB0ZXJtaW5hdGUgeW91ciByaWdodHMgdW5kZXIgdGhpcyBMaWNl -bnNlLgpIb3dldmVyLCBwYXJ0aWVzIHdobyBoYXZlIHJlY2VpdmVkIGNvcGllcywgb3IgcmlnaHRz -LCBmcm9tIHlvdSB1bmRlcgp0aGlzIExpY2Vuc2Ugd2lsbCBub3QgaGF2ZSB0aGVpciBsaWNlbnNl -cyB0ZXJtaW5hdGVkIHNvIGxvbmcgYXMgc3VjaApwYXJ0aWVzIHJlbWFpbiBpbiBmdWxsIGNvbXBs -aWFuY2UuCgogIDUuIFlvdSBhcmUgbm90IHJlcXVpcmVkIHRvIGFjY2VwdCB0aGlzIExpY2Vuc2Us -IHNpbmNlIHlvdSBoYXZlIG5vdApzaWduZWQgaXQuICBIb3dldmVyLCBub3RoaW5nIGVsc2UgZ3Jh -bnRzIHlvdSBwZXJtaXNzaW9uIHRvIG1vZGlmeSBvcgpkaXN0cmlidXRlIHRoZSBQcm9ncmFtIG9y -IGl0cyBkZXJpdmF0aXZlIHdvcmtzLiAgVGhlc2UgYWN0aW9ucyBhcmUKcHJvaGliaXRlZCBieSBs -YXcgaWYgeW91IGRvIG5vdCBhY2NlcHQgdGhpcyBMaWNlbnNlLiAgVGhlcmVmb3JlLCBieQptb2Rp -Znlpbmcgb3IgZGlzdHJpYnV0aW5nIHRoZSBQcm9ncmFtIChvciBhbnkgd29yayBiYXNlZCBvbiB0 -aGUKUHJvZ3JhbSksIHlvdSBpbmRpY2F0ZSB5b3VyIGFjY2VwdGFuY2Ugb2YgdGhpcyBMaWNlbnNl -IHRvIGRvIHNvLCBhbmQKYWxsIGl0cyB0ZXJtcyBhbmQgY29uZGl0aW9ucyBmb3IgY29weWluZywg -ZGlzdHJpYnV0aW5nIG9yIG1vZGlmeWluZwp0aGUgUHJvZ3JhbSBvciB3b3JrcyBiYXNlZCBvbiBp -dC4KCiAgNi4gRWFjaCB0aW1lIHlvdSByZWRpc3RyaWJ1dGUgdGhlIFByb2dyYW0gKG9yIGFueSB3 -b3JrIGJhc2VkIG9uIHRoZQpQcm9ncmFtKSwgdGhlIHJlY2lwaWVudCBhdXRvbWF0aWNhbGx5IHJl -Y2VpdmVzIGEgbGljZW5zZSBmcm9tIHRoZQpvcmlnaW5hbCBsaWNlbnNvciB0byBjb3B5LCBkaXN0 -cmlidXRlIG9yIG1vZGlmeSB0aGUgUHJvZ3JhbSBzdWJqZWN0IHRvCnRoZXNlIHRlcm1zIGFuZCBj -b25kaXRpb25zLiAgWW91IG1heSBub3QgaW1wb3NlIGFueSBmdXJ0aGVyCnJlc3RyaWN0aW9ucyBv -biB0aGUgcmVjaXBpZW50cycgZXhlcmNpc2Ugb2YgdGhlIHJpZ2h0cyBncmFudGVkIGhlcmVpbi4K -WW91IGFyZSBub3QgcmVzcG9uc2libGUgZm9yIGVuZm9yY2luZyBjb21wbGlhbmNlIGJ5IHRoaXJk -IHBhcnRpZXMgdG8KdGhpcyBMaWNlbnNlLgoKICA3LiBJZiwgYXMgYSBjb25zZXF1ZW5jZSBvZiBh -IGNvdXJ0IGp1ZGdtZW50IG9yIGFsbGVnYXRpb24gb2YgcGF0ZW50CmluZnJpbmdlbWVudCBvciBm -b3IgYW55IG90aGVyIHJlYXNvbiAobm90IGxpbWl0ZWQgdG8gcGF0ZW50IGlzc3VlcyksCmNvbmRp -dGlvbnMgYXJlIGltcG9zZWQgb24geW91ICh3aGV0aGVyIGJ5IGNvdXJ0IG9yZGVyLCBhZ3JlZW1l -bnQgb3IKb3RoZXJ3aXNlKSB0aGF0IGNvbnRyYWRpY3QgdGhlIGNvbmRpdGlvbnMgb2YgdGhpcyBM -aWNlbnNlLCB0aGV5IGRvIG5vdApleGN1c2UgeW91IGZyb20gdGhlIGNvbmRpdGlvbnMgb2YgdGhp -cyBMaWNlbnNlLiAgSWYgeW91IGNhbm5vdApkaXN0cmlidXRlIHNvIGFzIHRvIHNhdGlzZnkgc2lt -dWx0YW5lb3VzbHkgeW91ciBvYmxpZ2F0aW9ucyB1bmRlciB0aGlzCkxpY2Vuc2UgYW5kIGFueSBv -dGhlciBwZXJ0aW5lbnQgb2JsaWdhdGlvbnMsIHRoZW4gYXMgYSBjb25zZXF1ZW5jZSB5b3UKbWF5 -IG5vdCBkaXN0cmlidXRlIHRoZSBQcm9ncmFtIGF0IGFsbC4gIEZvciBleGFtcGxlLCBpZiBhIHBh -dGVudApsaWNlbnNlIHdvdWxkIG5vdCBwZXJtaXQgcm95YWx0eS1mcmVlIHJlZGlzdHJpYnV0aW9u -IG9mIHRoZSBQcm9ncmFtIGJ5CmFsbCB0aG9zZSB3aG8gcmVjZWl2ZSBjb3BpZXMgZGlyZWN0bHkg -b3IgaW5kaXJlY3RseSB0aHJvdWdoIHlvdSwgdGhlbgp0aGUgb25seSB3YXkgeW91IGNvdWxkIHNh -dGlzZnkgYm90aCBpdCBhbmQgdGhpcyBMaWNlbnNlIHdvdWxkIGJlIHRvCnJlZnJhaW4gZW50aXJl -bHkgZnJvbSBkaXN0cmlidXRpb24gb2YgdGhlIFByb2dyYW0uCgpJZiBhbnkgcG9ydGlvbiBvZiB0 -aGlzIHNlY3Rpb24gaXMgaGVsZCBpbnZhbGlkIG9yIHVuZW5mb3JjZWFibGUgdW5kZXIKYW55IHBh -cnRpY3VsYXIgY2lyY3Vtc3RhbmNlLCB0aGUgYmFsYW5jZSBvZiB0aGUgc2VjdGlvbiBpcyBpbnRl -bmRlZCB0bwphcHBseSBhbmQgdGhlIHNlY3Rpb24gYXMgYSB3aG9sZSBpcyBpbnRlbmRlZCB0byBh -cHBseSBpbiBvdGhlcgpjaXJjdW1zdGFuY2VzLgoKSXQgaXMgbm90IHRoZSBwdXJwb3NlIG9mIHRo -aXMgc2VjdGlvbiB0byBpbmR1Y2UgeW91IHRvIGluZnJpbmdlIGFueQpwYXRlbnRzIG9yIG90aGVy -IHByb3BlcnR5IHJpZ2h0IGNsYWltcyBvciB0byBjb250ZXN0IHZhbGlkaXR5IG9mIGFueQpzdWNo -IGNsYWltczsgdGhpcyBzZWN0aW9uIGhhcyB0aGUgc29sZSBwdXJwb3NlIG9mIHByb3RlY3Rpbmcg -dGhlCmludGVncml0eSBvZiB0aGUgZnJlZSBzb2Z0d2FyZSBkaXN0cmlidXRpb24gc3lzdGVtLCB3 -aGljaCBpcwppbXBsZW1lbnRlZCBieSBwdWJsaWMgbGljZW5zZSBwcmFjdGljZXMuICBNYW55IHBl -b3BsZSBoYXZlIG1hZGUKZ2VuZXJvdXMgY29udHJpYnV0aW9ucyB0byB0aGUgd2lkZSByYW5nZSBv -ZiBzb2Z0d2FyZSBkaXN0cmlidXRlZAp0aHJvdWdoIHRoYXQgc3lzdGVtIGluIHJlbGlhbmNlIG9u -IGNvbnNpc3RlbnQgYXBwbGljYXRpb24gb2YgdGhhdApzeXN0ZW07IGl0IGlzIHVwIHRvIHRoZSBh -dXRob3IvZG9ub3IgdG8gZGVjaWRlIGlmIGhlIG9yIHNoZSBpcyB3aWxsaW5nCnRvIGRpc3RyaWJ1 -dGUgc29mdHdhcmUgdGhyb3VnaCBhbnkgb3RoZXIgc3lzdGVtIGFuZCBhIGxpY2Vuc2VlIGNhbm5v -dAppbXBvc2UgdGhhdCBjaG9pY2UuCgpUaGlzIHNlY3Rpb24gaXMgaW50ZW5kZWQgdG8gbWFrZSB0 -aG9yb3VnaGx5IGNsZWFyIHdoYXQgaXMgYmVsaWV2ZWQgdG8KYmUgYSBjb25zZXF1ZW5jZSBvZiB0 -aGUgcmVzdCBvZiB0aGlzIExpY2Vuc2UuCgwKICA4LiBJZiB0aGUgZGlzdHJpYnV0aW9uIGFuZC9v -ciB1c2Ugb2YgdGhlIFByb2dyYW0gaXMgcmVzdHJpY3RlZCBpbgpjZXJ0YWluIGNvdW50cmllcyBl -aXRoZXIgYnkgcGF0ZW50cyBvciBieSBjb3B5cmlnaHRlZCBpbnRlcmZhY2VzLCB0aGUKb3JpZ2lu -YWwgY29weXJpZ2h0IGhvbGRlciB3aG8gcGxhY2VzIHRoZSBQcm9ncmFtIHVuZGVyIHRoaXMgTGlj -ZW5zZQptYXkgYWRkIGFuIGV4cGxpY2l0IGdlb2dyYXBoaWNhbCBkaXN0cmlidXRpb24gbGltaXRh -dGlvbiBleGNsdWRpbmcKdGhvc2UgY291bnRyaWVzLCBzbyB0aGF0IGRpc3RyaWJ1dGlvbiBpcyBw -ZXJtaXR0ZWQgb25seSBpbiBvciBhbW9uZwpjb3VudHJpZXMgbm90IHRodXMgZXhjbHVkZWQuICBJ -biBzdWNoIGNhc2UsIHRoaXMgTGljZW5zZSBpbmNvcnBvcmF0ZXMKdGhlIGxpbWl0YXRpb24gYXMg -aWYgd3JpdHRlbiBpbiB0aGUgYm9keSBvZiB0aGlzIExpY2Vuc2UuCgogIDkuIFRoZSBGcmVlIFNv -ZnR3YXJlIEZvdW5kYXRpb24gbWF5IHB1Ymxpc2ggcmV2aXNlZCBhbmQvb3IgbmV3IHZlcnNpb25z -Cm9mIHRoZSBHZW5lcmFsIFB1YmxpYyBMaWNlbnNlIGZyb20gdGltZSB0byB0aW1lLiAgU3VjaCBu -ZXcgdmVyc2lvbnMgd2lsbApiZSBzaW1pbGFyIGluIHNwaXJpdCB0byB0aGUgcHJlc2VudCB2ZXJz -aW9uLCBidXQgbWF5IGRpZmZlciBpbiBkZXRhaWwgdG8KYWRkcmVzcyBuZXcgcHJvYmxlbXMgb3Ig -Y29uY2VybnMuCgpFYWNoIHZlcnNpb24gaXMgZ2l2ZW4gYSBkaXN0aW5ndWlzaGluZyB2ZXJzaW9u -IG51bWJlci4gIElmIHRoZSBQcm9ncmFtCnNwZWNpZmllcyBhIHZlcnNpb24gbnVtYmVyIG9mIHRo -aXMgTGljZW5zZSB3aGljaCBhcHBsaWVzIHRvIGl0IGFuZCAiYW55CmxhdGVyIHZlcnNpb24iLCB5 -b3UgaGF2ZSB0aGUgb3B0aW9uIG9mIGZvbGxvd2luZyB0aGUgdGVybXMgYW5kIGNvbmRpdGlvbnMK -ZWl0aGVyIG9mIHRoYXQgdmVyc2lvbiBvciBvZiBhbnkgbGF0ZXIgdmVyc2lvbiBwdWJsaXNoZWQg -YnkgdGhlIEZyZWUKU29mdHdhcmUgRm91bmRhdGlvbi4gIElmIHRoZSBQcm9ncmFtIGRvZXMgbm90 -IHNwZWNpZnkgYSB2ZXJzaW9uIG51bWJlciBvZgp0aGlzIExpY2Vuc2UsIHlvdSBtYXkgY2hvb3Nl -IGFueSB2ZXJzaW9uIGV2ZXIgcHVibGlzaGVkIGJ5IHRoZSBGcmVlIFNvZnR3YXJlCkZvdW5kYXRp -b24uCgogIDEwLiBJZiB5b3Ugd2lzaCB0byBpbmNvcnBvcmF0ZSBwYXJ0cyBvZiB0aGUgUHJvZ3Jh -bSBpbnRvIG90aGVyIGZyZWUKcHJvZ3JhbXMgd2hvc2UgZGlzdHJpYnV0aW9uIGNvbmRpdGlvbnMg -YXJlIGRpZmZlcmVudCwgd3JpdGUgdG8gdGhlIGF1dGhvcgp0byBhc2sgZm9yIHBlcm1pc3Npb24u -ICBGb3Igc29mdHdhcmUgd2hpY2ggaXMgY29weXJpZ2h0ZWQgYnkgdGhlIEZyZWUKU29mdHdhcmUg -Rm91bmRhdGlvbiwgd3JpdGUgdG8gdGhlIEZyZWUgU29mdHdhcmUgRm91bmRhdGlvbjsgd2Ugc29t -ZXRpbWVzCm1ha2UgZXhjZXB0aW9ucyBmb3IgdGhpcy4gIE91ciBkZWNpc2lvbiB3aWxsIGJlIGd1 -aWRlZCBieSB0aGUgdHdvIGdvYWxzCm9mIHByZXNlcnZpbmcgdGhlIGZyZWUgc3RhdHVzIG9mIGFs -bCBkZXJpdmF0aXZlcyBvZiBvdXIgZnJlZSBzb2Z0d2FyZSBhbmQKb2YgcHJvbW90aW5nIHRoZSBz -aGFyaW5nIGFuZCByZXVzZSBvZiBzb2Z0d2FyZSBnZW5lcmFsbHkuCgoJCQkgICAgTk8gV0FSUkFO -VFkKCiAgMTEuIEJFQ0FVU0UgVEhFIFBST0dSQU0gSVMgTElDRU5TRUQgRlJFRSBPRiBDSEFSR0Us -IFRIRVJFIElTIE5PIFdBUlJBTlRZCkZPUiBUSEUgUFJPR1JBTSwgVE8gVEhFIEVYVEVOVCBQRVJN -SVRURUQgQlkgQVBQTElDQUJMRSBMQVcuICBFWENFUFQgV0hFTgpPVEhFUldJU0UgU1RBVEVEIElO -IFdSSVRJTkcgVEhFIENPUFlSSUdIVCBIT0xERVJTIEFORC9PUiBPVEhFUiBQQVJUSUVTClBST1ZJ -REUgVEhFIFBST0dSQU0gIkFTIElTIiBXSVRIT1VUIFdBUlJBTlRZIE9GIEFOWSBLSU5ELCBFSVRI -RVIgRVhQUkVTU0VECk9SIElNUExJRUQsIElOQ0xVRElORywgQlVUIE5PVCBMSU1JVEVEIFRPLCBU -SEUgSU1QTElFRCBXQVJSQU5USUVTIE9GCk1FUkNIQU5UQUJJTElUWSBBTkQgRklUTkVTUyBGT1Ig -QSBQQVJUSUNVTEFSIFBVUlBPU0UuICBUSEUgRU5USVJFIFJJU0sgQVMKVE8gVEhFIFFVQUxJVFkg -QU5EIFBFUkZPUk1BTkNFIE9GIFRIRSBQUk9HUkFNIElTIFdJVEggWU9VLiAgU0hPVUxEIFRIRQpQ -Uk9HUkFNIFBST1ZFIERFRkVDVElWRSwgWU9VIEFTU1VNRSBUSEUgQ09TVCBPRiBBTEwgTkVDRVNT -QVJZIFNFUlZJQ0lORywKUkVQQUlSIE9SIENPUlJFQ1RJT04uCgogIDEyLiBJTiBOTyBFVkVOVCBV -TkxFU1MgUkVRVUlSRUQgQlkgQVBQTElDQUJMRSBMQVcgT1IgQUdSRUVEIFRPIElOIFdSSVRJTkcK -V0lMTCBBTlkgQ09QWVJJR0hUIEhPTERFUiwgT1IgQU5ZIE9USEVSIFBBUlRZIFdITyBNQVkgTU9E -SUZZIEFORC9PUgpSRURJU1RSSUJVVEUgVEhFIFBST0dSQU0gQVMgUEVSTUlUVEVEIEFCT1ZFLCBC -RSBMSUFCTEUgVE8gWU9VIEZPUiBEQU1BR0VTLApJTkNMVURJTkcgQU5ZIEdFTkVSQUwsIFNQRUNJ -QUwsIElOQ0lERU5UQUwgT1IgQ09OU0VRVUVOVElBTCBEQU1BR0VTIEFSSVNJTkcKT1VUIE9GIFRI -RSBVU0UgT1IgSU5BQklMSVRZIFRPIFVTRSBUSEUgUFJPR1JBTSAoSU5DTFVESU5HIEJVVCBOT1Qg -TElNSVRFRApUTyBMT1NTIE9GIERBVEEgT1IgREFUQSBCRUlORyBSRU5ERVJFRCBJTkFDQ1VSQVRF -IE9SIExPU1NFUyBTVVNUQUlORUQgQlkKWU9VIE9SIFRISVJEIFBBUlRJRVMgT1IgQSBGQUlMVVJF -IE9GIFRIRSBQUk9HUkFNIFRPIE9QRVJBVEUgV0lUSCBBTlkgT1RIRVIKUFJPR1JBTVMpLCBFVkVO -IElGIFNVQ0ggSE9MREVSIE9SIE9USEVSIFBBUlRZIEhBUyBCRUVOIEFEVklTRUQgT0YgVEhFClBP -U1NJQklMSVRZIE9GIFNVQ0ggREFNQUdFUy4KCgkJICAgICBFTkQgT0YgVEVSTVMgQU5EIENPTkRJ -VElPTlMKDAoJICAgIEhvdyB0byBBcHBseSBUaGVzZSBUZXJtcyB0byBZb3VyIE5ldyBQcm9ncmFt -cwoKICBJZiB5b3UgZGV2ZWxvcCBhIG5ldyBwcm9ncmFtLCBhbmQgeW91IHdhbnQgaXQgdG8gYmUg -b2YgdGhlIGdyZWF0ZXN0CnBvc3NpYmxlIHVzZSB0byB0aGUgcHVibGljLCB0aGUgYmVzdCB3YXkg -dG8gYWNoaWV2ZSB0aGlzIGlzIHRvIG1ha2UgaXQKZnJlZSBzb2Z0d2FyZSB3aGljaCBldmVyeW9u -ZSBjYW4gcmVkaXN0cmlidXRlIGFuZCBjaGFuZ2UgdW5kZXIgdGhlc2UgdGVybXMuCgogIFRvIGRv -IHNvLCBhdHRhY2ggdGhlIGZvbGxvd2luZyBub3RpY2VzIHRvIHRoZSBwcm9ncmFtLiAgSXQgaXMg -c2FmZXN0CnRvIGF0dGFjaCB0aGVtIHRvIHRoZSBzdGFydCBvZiBlYWNoIHNvdXJjZSBmaWxlIHRv -IG1vc3QgZWZmZWN0aXZlbHkKY29udmV5IHRoZSBleGNsdXNpb24gb2Ygd2FycmFudHk7IGFuZCBl -YWNoIGZpbGUgc2hvdWxkIGhhdmUgYXQgbGVhc3QKdGhlICJjb3B5cmlnaHQiIGxpbmUgYW5kIGEg -cG9pbnRlciB0byB3aGVyZSB0aGUgZnVsbCBub3RpY2UgaXMgZm91bmQuCgogICAgPG9uZSBsaW5l -IHRvIGdpdmUgdGhlIHByb2dyYW0ncyBuYW1lIGFuZCBhIGJyaWVmIGlkZWEgb2Ygd2hhdCBpdCBk -b2VzLj4KICAgIENvcHlyaWdodCAoQykgPHllYXI+ICA8bmFtZSBvZiBhdXRob3I+CgogICAgVGhp -cyBwcm9ncmFtIGlzIGZyZWUgc29mdHdhcmU7IHlvdSBjYW4gcmVkaXN0cmlidXRlIGl0IGFuZC9v -ciBtb2RpZnkKICAgIGl0IHVuZGVyIHRoZSB0ZXJtcyBvZiB0aGUgR05VIEdlbmVyYWwgUHVibGlj -IExpY2Vuc2UgYXMgcHVibGlzaGVkIGJ5CiAgICB0aGUgRnJlZSBTb2Z0d2FyZSBGb3VuZGF0aW9u -OyBlaXRoZXIgdmVyc2lvbiAyIG9mIHRoZSBMaWNlbnNlLCBvcgogICAgKGF0IHlvdXIgb3B0aW9u -KSBhbnkgbGF0ZXIgdmVyc2lvbi4KCiAgICBUaGlzIHByb2dyYW0gaXMgZGlzdHJpYnV0ZWQgaW4g -dGhlIGhvcGUgdGhhdCBpdCB3aWxsIGJlIHVzZWZ1bCwKICAgIGJ1dCBXSVRIT1VUIEFOWSBXQVJS -QU5UWTsgd2l0aG91dCBldmVuIHRoZSBpbXBsaWVkIHdhcnJhbnR5IG9mCiAgICBNRVJDSEFOVEFC -SUxJVFkgb3IgRklUTkVTUyBGT1IgQSBQQVJUSUNVTEFSIFBVUlBPU0UuICBTZWUgdGhlCiAgICBH -TlUgR2VuZXJhbCBQdWJsaWMgTGljZW5zZSBmb3IgbW9yZSBkZXRhaWxzLgoKICAgIFlvdSBzaG91 -bGQgaGF2ZSByZWNlaXZlZCBhIGNvcHkgb2YgdGhlIEdOVSBHZW5lcmFsIFB1YmxpYyBMaWNlbnNl -CiAgICBhbG9uZyB3aXRoIHRoaXMgcHJvZ3JhbTsgaWYgbm90LCB3cml0ZSB0byB0aGUgRnJlZSBT -b2Z0d2FyZQogICAgRm91bmRhdGlvbiwgSW5jLiwgNTkgVGVtcGxlIFBsYWNlLCBTdWl0ZSAzMzAs -IEJvc3RvbiwgTUEgIDAyMTExLTEzMDcgIFVTQQoKCkFsc28gYWRkIGluZm9ybWF0aW9uIG9uIGhv -dyB0byBjb250YWN0IHlvdSBieSBlbGVjdHJvbmljIGFuZCBwYXBlciBtYWlsLgoKSWYgdGhlIHBy -b2dyYW0gaXMgaW50ZXJhY3RpdmUsIG1ha2UgaXQgb3V0cHV0IGEgc2hvcnQgbm90aWNlIGxpa2Ug -dGhpcwp3aGVuIGl0IHN0YXJ0cyBpbiBhbiBpbnRlcmFjdGl2ZSBtb2RlOgoKICAgIEdub21vdmlz -aW9uIHZlcnNpb24gNjksIENvcHlyaWdodCAoQykgeWVhciBuYW1lIG9mIGF1dGhvcgogICAgR25v -bW92aXNpb24gY29tZXMgd2l0aCBBQlNPTFVURUxZIE5PIFdBUlJBTlRZOyBmb3IgZGV0YWlscyB0 -eXBlIGBzaG93IHcnLgogICAgVGhpcyBpcyBmcmVlIHNvZnR3YXJlLCBhbmQgeW91IGFyZSB3ZWxj -b21lIHRvIHJlZGlzdHJpYnV0ZSBpdAogICAgdW5kZXIgY2VydGFpbiBjb25kaXRpb25zOyB0eXBl -IGBzaG93IGMnIGZvciBkZXRhaWxzLgoKVGhlIGh5cG90aGV0aWNhbCBjb21tYW5kcyBgc2hvdyB3 -JyBhbmQgYHNob3cgYycgc2hvdWxkIHNob3cgdGhlIGFwcHJvcHJpYXRlCnBhcnRzIG9mIHRoZSBH -ZW5lcmFsIFB1YmxpYyBMaWNlbnNlLiAgT2YgY291cnNlLCB0aGUgY29tbWFuZHMgeW91IHVzZSBt -YXkKYmUgY2FsbGVkIHNvbWV0aGluZyBvdGhlciB0aGFuIGBzaG93IHcnIGFuZCBgc2hvdyBjJzsg -dGhleSBjb3VsZCBldmVuIGJlCm1vdXNlLWNsaWNrcyBvciBtZW51IGl0ZW1zLS13aGF0ZXZlciBz -dWl0cyB5b3VyIHByb2dyYW0uCgpZb3Ugc2hvdWxkIGFsc28gZ2V0IHlvdXIgZW1wbG95ZXIgKGlm -IHlvdSB3b3JrIGFzIGEgcHJvZ3JhbW1lcikgb3IgeW91cgpzY2hvb2wsIGlmIGFueSwgdG8gc2ln -biBhICJjb3B5cmlnaHQgZGlzY2xhaW1lciIgZm9yIHRoZSBwcm9ncmFtLCBpZgpuZWNlc3Nhcnku -ICBIZXJlIGlzIGEgc2FtcGxlOyBhbHRlciB0aGUgbmFtZXM6CgogIFlveW9keW5lLCBJbmMuLCBo -ZXJlYnkgZGlzY2xhaW1zIGFsbCBjb3B5cmlnaHQgaW50ZXJlc3QgaW4gdGhlIHByb2dyYW0KICBg -R25vbW92aXNpb24nICh3aGljaCBtYWtlcyBwYXNzZXMgYXQgY29tcGlsZXJzKSB3cml0dGVuIGJ5 -IEphbWVzIEhhY2tlci4KCiAgPHNpZ25hdHVyZSBvZiBUeSBDb29uPiwgMSBBcHJpbCAxOTg5CiAg -VHkgQ29vbiwgUHJlc2lkZW50IG9mIFZpY2UKClRoaXMgR2VuZXJhbCBQdWJsaWMgTGljZW5zZSBk -b2VzIG5vdCBwZXJtaXQgaW5jb3Jwb3JhdGluZyB5b3VyIHByb2dyYW0gaW50bwpwcm9wcmlldGFy -eSBwcm9ncmFtcy4gIElmIHlvdXIgcHJvZ3JhbSBpcyBhIHN1YnJvdXRpbmUgbGlicmFyeSwgeW91 -IG1heQpjb25zaWRlciBpdCBtb3JlIHVzZWZ1bCB0byBwZXJtaXQgbGlua2luZyBwcm9wcmlldGFy -eSBhcHBsaWNhdGlvbnMgd2l0aCB0aGUKbGlicmFyeS4gIElmIHRoaXMgaXMgd2hhdCB5b3Ugd2Fu -dCB0byBkbywgdXNlIHRoZSBHTlUgTGlicmFyeSBHZW5lcmFsClB1YmxpYyBMaWNlbnNlIGluc3Rl -YWQgb2YgdGhpcyBMaWNlbnNlLgo= -ClxjaGFwdGVye1RoZSBHTlUgR2VuZXJhbCBQdWJsaWMgTGljZW5zZX0KClxiZWdpbntjZW50ZXJ9 -CntccGFyaW5kZW50IDBpbgoKVmVyc2lvbiAyLCBKdW5lIDE5OTEKCkNvcHlyaWdodCBcY29weXJp -Z2h0XCAxOTg5LCAxOTkxIEZyZWUgU29mdHdhcmUgRm91bmRhdGlvbiwgSW5jLgoKXGJpZ3NraXAK -CjU5IFRlbXBsZSBQbGFjZSAtIFN1aXRlIDMzMCwgQm9zdG9uLCBNQSAgMDIxMTEtMTMwNywgVVNB -CgpcYmlnc2tpcAoKRXZlcnlvbmUgaXMgcGVybWl0dGVkIHRvIGNvcHkgYW5kIGRpc3RyaWJ1dGUg -dmVyYmF0aW0gY29waWVzCm9mIHRoaXMgbGljZW5zZSBkb2N1bWVudCwgYnV0IGNoYW5naW5nIGl0 -IGlzIG5vdCBhbGxvd2VkLgp9ClxlbmR7Y2VudGVyfQoKXGJlZ2lue2NlbnRlcn0Ke1xiZlxsYXJn -ZSBQcmVhbWJsZX0KXGVuZHtjZW50ZXJ9CgoKVGhlIGxpY2Vuc2VzIGZvciBtb3N0IHNvZnR3YXJl -IGFyZSBkZXNpZ25lZCB0byB0YWtlIGF3YXkgeW91ciBmcmVlZG9tIHRvCnNoYXJlIGFuZCBjaGFu -Z2UgaXQuICBCeSBjb250cmFzdCwgdGhlIEdOVSBHZW5lcmFsIFB1YmxpYyBMaWNlbnNlIGlzCmlu -dGVuZGVkIHRvIGd1YXJhbnRlZSB5b3VyIGZyZWVkb20gdG8gc2hhcmUgYW5kIGNoYW5nZSBmcmVl -IHNvZnR3YXJlLS0tdG8KbWFrZSBzdXJlIHRoZSBzb2Z0d2FyZSBpcyBmcmVlIGZvciBhbGwgaXRz -IHVzZXJzLiAgVGhpcyBHZW5lcmFsIFB1YmxpYwpMaWNlbnNlIGFwcGxpZXMgdG8gbW9zdCBvZiB0 -aGUgRnJlZSBTb2Z0d2FyZSBGb3VuZGF0aW9uJ3Mgc29mdHdhcmUgYW5kIHRvCmFueSBvdGhlciBw -cm9ncmFtIHdob3NlIGF1dGhvcnMgY29tbWl0IHRvIHVzaW5nIGl0LiAgKFNvbWUgb3RoZXIgRnJl -ZQpTb2Z0d2FyZSBGb3VuZGF0aW9uIHNvZnR3YXJlIGlzIGNvdmVyZWQgYnkgdGhlIEdOVSBMaWJy -YXJ5IEdlbmVyYWwgUHVibGljCkxpY2Vuc2UgaW5zdGVhZC4pICBZb3UgY2FuIGFwcGx5IGl0IHRv -IHlvdXIgcHJvZ3JhbXMsIHRvby4KCldoZW4gd2Ugc3BlYWsgb2YgZnJlZSBzb2Z0d2FyZSwgd2Ug -YXJlIHJlZmVycmluZyB0byBmcmVlZG9tLCBub3QgcHJpY2UuCk91ciBHZW5lcmFsIFB1YmxpYyBM -aWNlbnNlcyBhcmUgZGVzaWduZWQgdG8gbWFrZSBzdXJlIHRoYXQgeW91IGhhdmUgdGhlCmZyZWVk -b20gdG8gZGlzdHJpYnV0ZSBjb3BpZXMgb2YgZnJlZSBzb2Z0d2FyZSAoYW5kIGNoYXJnZSBmb3Ig -dGhpcyBzZXJ2aWNlCmlmIHlvdSB3aXNoKSwgdGhhdCB5b3UgcmVjZWl2ZSBzb3VyY2UgY29kZSBv -ciBjYW4gZ2V0IGl0IGlmIHlvdSB3YW50IGl0LAp0aGF0IHlvdSBjYW4gY2hhbmdlIHRoZSBzb2Z0 -d2FyZSBvciB1c2UgcGllY2VzIG9mIGl0IGluIG5ldyBmcmVlIHByb2dyYW1zOwphbmQgdGhhdCB5 -b3Uga25vdyB5b3UgY2FuIGRvIHRoZXNlIHRoaW5ncy4KClRvIHByb3RlY3QgeW91ciByaWdodHMs -IHdlIG5lZWQgdG8gbWFrZSByZXN0cmljdGlvbnMgdGhhdCBmb3JiaWQgYW55b25lIHRvCmRlbnkg -eW91IHRoZXNlIHJpZ2h0cyBvciB0byBhc2sgeW91IHRvIHN1cnJlbmRlciB0aGUgcmlnaHRzLiAg -VGhlc2UKcmVzdHJpY3Rpb25zIHRyYW5zbGF0ZSB0byBjZXJ0YWluIHJlc3BvbnNpYmlsaXRpZXMg -Zm9yIHlvdSBpZiB5b3UKZGlzdHJpYnV0ZSBjb3BpZXMgb2YgdGhlIHNvZnR3YXJlLCBvciBpZiB5 -b3UgbW9kaWZ5IGl0LgoKRm9yIGV4YW1wbGUsIGlmIHlvdSBkaXN0cmlidXRlIGNvcGllcyBvZiBz -dWNoIGEgcHJvZ3JhbSwgd2hldGhlciBncmF0aXMgb3IKZm9yIGEgZmVlLCB5b3UgbXVzdCBnaXZl -IHRoZSByZWNpcGllbnRzIGFsbCB0aGUgcmlnaHRzIHRoYXQgeW91IGhhdmUuICBZb3UKbXVzdCBt -YWtlIHN1cmUgdGhhdCB0aGV5LCB0b28sIHJlY2VpdmUgb3IgY2FuIGdldCB0aGUgc291cmNlIGNv -ZGUuICBBbmQKeW91IG11c3Qgc2hvdyB0aGVtIHRoZXNlIHRlcm1zIHNvIHRoZXkga25vdyB0aGVp -ciByaWdodHMuCgpXZSBwcm90ZWN0IHlvdXIgcmlnaHRzIHdpdGggdHdvIHN0ZXBzOiAoMSkgY29w -eXJpZ2h0IHRoZSBzb2Z0d2FyZSwgYW5kICgyKQpvZmZlciB5b3UgdGhpcyBsaWNlbnNlIHdoaWNo -IGdpdmVzIHlvdSBsZWdhbCBwZXJtaXNzaW9uIHRvIGNvcHksCmRpc3RyaWJ1dGUgYW5kL29yIG1v -ZGlmeSB0aGUgc29mdHdhcmUuCgpBbHNvLCBmb3IgZWFjaCBhdXRob3IncyBwcm90ZWN0aW9uIGFu -ZCBvdXJzLCB3ZSB3YW50IHRvIG1ha2UgY2VydGFpbiB0aGF0CmV2ZXJ5b25lIHVuZGVyc3RhbmRz -IHRoYXQgdGhlcmUgaXMgbm8gd2FycmFudHkgZm9yIHRoaXMgZnJlZSBzb2Z0d2FyZS4gIElmCnRo -ZSBzb2Z0d2FyZSBpcyBtb2RpZmllZCBieSBzb21lb25lIGVsc2UgYW5kIHBhc3NlZCBvbiwgd2Ug -d2FudCBpdHMKcmVjaXBpZW50cyB0byBrbm93IHRoYXQgd2hhdCB0aGV5IGhhdmUgaXMgbm90IHRo -ZSBvcmlnaW5hbCwgc28gdGhhdCBhbnkKcHJvYmxlbXMgaW50cm9kdWNlZCBieSBvdGhlcnMgd2ls -bCBub3QgcmVmbGVjdCBvbiB0aGUgb3JpZ2luYWwgYXV0aG9ycycKcmVwdXRhdGlvbnMuCgpGaW5h -bGx5LCBhbnkgZnJlZSBwcm9ncmFtIGlzIHRocmVhdGVuZWQgY29uc3RhbnRseSBieSBzb2Z0d2Fy -ZSBwYXRlbnRzLgpXZSB3aXNoIHRvIGF2b2lkIHRoZSBkYW5nZXIgdGhhdCByZWRpc3RyaWJ1dG9y -cyBvZiBhIGZyZWUgcHJvZ3JhbSB3aWxsCmluZGl2aWR1YWxseSBvYnRhaW4gcGF0ZW50IGxpY2Vu -c2VzLCBpbiBlZmZlY3QgbWFraW5nIHRoZSBwcm9ncmFtCnByb3ByaWV0YXJ5LiAgVG8gcHJldmVu -dCB0aGlzLCB3ZSBoYXZlIG1hZGUgaXQgY2xlYXIgdGhhdCBhbnkgcGF0ZW50IG11c3QKYmUgbGlj -ZW5zZWQgZm9yIGV2ZXJ5b25lJ3MgZnJlZSB1c2Ugb3Igbm90IGxpY2Vuc2VkIGF0IGFsbC4KClRo -ZSBwcmVjaXNlIHRlcm1zIGFuZCBjb25kaXRpb25zIGZvciBjb3B5aW5nLCBkaXN0cmlidXRpb24g -YW5kCm1vZGlmaWNhdGlvbiBmb2xsb3cuCgpcYmVnaW57Y2VudGVyfQp7XExhcmdlIFxzYyBUZXJt -cyBhbmQgQ29uZGl0aW9ucyBGb3IgQ29weWluZywgRGlzdHJpYnV0aW9uIGFuZAogIE1vZGlmaWNh -dGlvbn0KXGVuZHtjZW50ZXJ9CgoKJVxyZW5ld2NvbW1hbmR7XHRoZWVudW1pfXtcYWxwaGF7ZW51 -bWl9fQpcYmVnaW57ZW51bWVyYXRlfQoKXGFkZHRvY291bnRlcntlbnVtaX17LTF9CgpcaXRlbSAK -ClRoaXMgTGljZW5zZSBhcHBsaWVzIHRvIGFueSBwcm9ncmFtIG9yIG90aGVyIHdvcmsgd2hpY2gg -Y29udGFpbnMgYSBub3RpY2UKcGxhY2VkIGJ5IHRoZSBjb3B5cmlnaHQgaG9sZGVyIHNheWluZyBp -dCBtYXkgYmUgZGlzdHJpYnV0ZWQgdW5kZXIgdGhlCnRlcm1zIG9mIHRoaXMgR2VuZXJhbCBQdWJs -aWMgTGljZW5zZS4gIFRoZSBgYFByb2dyYW0nJywgYmVsb3csIHJlZmVycyB0bwphbnkgc3VjaCBw -cm9ncmFtIG9yIHdvcmssIGFuZCBhIGBgd29yayBiYXNlZCBvbiB0aGUgUHJvZ3JhbScnIG1lYW5z -IGVpdGhlcgp0aGUgUHJvZ3JhbSBvciBhbnkgZGVyaXZhdGl2ZSB3b3JrIHVuZGVyIGNvcHlyaWdo -dCBsYXc6IHRoYXQgaXMgdG8gc2F5LCBhCndvcmsgY29udGFpbmluZyB0aGUgUHJvZ3JhbSBvciBh -IHBvcnRpb24gb2YgaXQsIGVpdGhlciB2ZXJiYXRpbSBvciB3aXRoCm1vZGlmaWNhdGlvbnMgYW5k -L29yIHRyYW5zbGF0ZWQgaW50byBhbm90aGVyIGxhbmd1YWdlLiAgKEhlcmVpbmFmdGVyLAp0cmFu -c2xhdGlvbiBpcyBpbmNsdWRlZCB3aXRob3V0IGxpbWl0YXRpb24gaW4gdGhlIHRlcm0gYGBtb2Rp -ZmljYXRpb24nJy4pCkVhY2ggbGljZW5zZWUgaXMgYWRkcmVzc2VkIGFzIGBgeW91JycuCgpBY3Rp -dml0aWVzIG90aGVyIHRoYW4gY29weWluZywgZGlzdHJpYnV0aW9uIGFuZCBtb2RpZmljYXRpb24g -YXJlIG5vdApjb3ZlcmVkIGJ5IHRoaXMgTGljZW5zZTsgdGhleSBhcmUgb3V0c2lkZSBpdHMgc2Nv -cGUuICBUaGUgYWN0IG9mCnJ1bm5pbmcgdGhlIFByb2dyYW0gaXMgbm90IHJlc3RyaWN0ZWQsIGFu -ZCB0aGUgb3V0cHV0IGZyb20gdGhlIFByb2dyYW0KaXMgY292ZXJlZCBvbmx5IGlmIGl0cyBjb250 -ZW50cyBjb25zdGl0dXRlIGEgd29yayBiYXNlZCBvbiB0aGUKUHJvZ3JhbSAoaW5kZXBlbmRlbnQg -b2YgaGF2aW5nIGJlZW4gbWFkZSBieSBydW5uaW5nIHRoZSBQcm9ncmFtKS4KV2hldGhlciB0aGF0 -IGlzIHRydWUgZGVwZW5kcyBvbiB3aGF0IHRoZSBQcm9ncmFtIGRvZXMuCgpcaXRlbSBZb3UgbWF5 -IGNvcHkgYW5kIGRpc3RyaWJ1dGUgdmVyYmF0aW0gY29waWVzIG9mIHRoZSBQcm9ncmFtJ3Mgc291 -cmNlCiAgY29kZSBhcyB5b3UgcmVjZWl2ZSBpdCwgaW4gYW55IG1lZGl1bSwgcHJvdmlkZWQgdGhh -dCB5b3UgY29uc3BpY3VvdXNseQogIGFuZCBhcHByb3ByaWF0ZWx5IHB1Ymxpc2ggb24gZWFjaCBj -b3B5IGFuIGFwcHJvcHJpYXRlIGNvcHlyaWdodCBub3RpY2UKICBhbmQgZGlzY2xhaW1lciBvZiB3 -YXJyYW50eTsga2VlcCBpbnRhY3QgYWxsIHRoZSBub3RpY2VzIHRoYXQgcmVmZXIgdG8KICB0aGlz -IExpY2Vuc2UgYW5kIHRvIHRoZSBhYnNlbmNlIG9mIGFueSB3YXJyYW50eTsgYW5kIGdpdmUgYW55 -IG90aGVyCiAgcmVjaXBpZW50cyBvZiB0aGUgUHJvZ3JhbSBhIGNvcHkgb2YgdGhpcyBMaWNlbnNl -IGFsb25nIHdpdGggdGhlIFByb2dyYW0uCgpZb3UgbWF5IGNoYXJnZSBhIGZlZSBmb3IgdGhlIHBo -eXNpY2FsIGFjdCBvZiB0cmFuc2ZlcnJpbmcgYSBjb3B5LCBhbmQgeW91Cm1heSBhdCB5b3VyIG9w -dGlvbiBvZmZlciB3YXJyYW50eSBwcm90ZWN0aW9uIGluIGV4Y2hhbmdlIGZvciBhIGZlZS4KClxp -dGVtCgpZb3UgbWF5IG1vZGlmeSB5b3VyIGNvcHkgb3IgY29waWVzIG9mIHRoZSBQcm9ncmFtIG9y -IGFueSBwb3J0aW9uCm9mIGl0LCB0aHVzIGZvcm1pbmcgYSB3b3JrIGJhc2VkIG9uIHRoZSBQcm9n -cmFtLCBhbmQgY29weSBhbmQKZGlzdHJpYnV0ZSBzdWNoIG1vZGlmaWNhdGlvbnMgb3Igd29yayB1 -bmRlciB0aGUgdGVybXMgb2YgU2VjdGlvbiAxCmFib3ZlLCBwcm92aWRlZCB0aGF0IHlvdSBhbHNv -IG1lZXQgYWxsIG9mIHRoZXNlIGNvbmRpdGlvbnM6CgpcYmVnaW57ZW51bWVyYXRlfQoKXGl0ZW0g -CgpZb3UgbXVzdCBjYXVzZSB0aGUgbW9kaWZpZWQgZmlsZXMgdG8gY2FycnkgcHJvbWluZW50IG5v -dGljZXMgc3RhdGluZyB0aGF0CnlvdSBjaGFuZ2VkIHRoZSBmaWxlcyBhbmQgdGhlIGRhdGUgb2Yg -YW55IGNoYW5nZS4KClxpdGVtCgpZb3UgbXVzdCBjYXVzZSBhbnkgd29yayB0aGF0IHlvdSBkaXN0 -cmlidXRlIG9yIHB1Ymxpc2gsIHRoYXQgaW4Kd2hvbGUgb3IgaW4gcGFydCBjb250YWlucyBvciBp -cyBkZXJpdmVkIGZyb20gdGhlIFByb2dyYW0gb3IgYW55CnBhcnQgdGhlcmVvZiwgdG8gYmUgbGlj -ZW5zZWQgYXMgYSB3aG9sZSBhdCBubyBjaGFyZ2UgdG8gYWxsIHRoaXJkCnBhcnRpZXMgdW5kZXIg -dGhlIHRlcm1zIG9mIHRoaXMgTGljZW5zZS4KClxpdGVtCklmIHRoZSBtb2RpZmllZCBwcm9ncmFt -IG5vcm1hbGx5IHJlYWRzIGNvbW1hbmRzIGludGVyYWN0aXZlbHkKd2hlbiBydW4sIHlvdSBtdXN0 -IGNhdXNlIGl0LCB3aGVuIHN0YXJ0ZWQgcnVubmluZyBmb3Igc3VjaAppbnRlcmFjdGl2ZSB1c2Ug -aW4gdGhlIG1vc3Qgb3JkaW5hcnkgd2F5LCB0byBwcmludCBvciBkaXNwbGF5IGFuCmFubm91bmNl -bWVudCBpbmNsdWRpbmcgYW4gYXBwcm9wcmlhdGUgY29weXJpZ2h0IG5vdGljZSBhbmQgYQpub3Rp -Y2UgdGhhdCB0aGVyZSBpcyBubyB3YXJyYW50eSAob3IgZWxzZSwgc2F5aW5nIHRoYXQgeW91IHBy -b3ZpZGUKYSB3YXJyYW50eSkgYW5kIHRoYXQgdXNlcnMgbWF5IHJlZGlzdHJpYnV0ZSB0aGUgcHJv -Z3JhbSB1bmRlcgp0aGVzZSBjb25kaXRpb25zLCBhbmQgdGVsbGluZyB0aGUgdXNlciBob3cgdG8g -dmlldyBhIGNvcHkgb2YgdGhpcwpMaWNlbnNlLiAgKEV4Y2VwdGlvbjogaWYgdGhlIFByb2dyYW0g -aXRzZWxmIGlzIGludGVyYWN0aXZlIGJ1dApkb2VzIG5vdCBub3JtYWxseSBwcmludCBzdWNoIGFu -IGFubm91bmNlbWVudCwgeW91ciB3b3JrIGJhc2VkIG9uCnRoZSBQcm9ncmFtIGlzIG5vdCByZXF1 -aXJlZCB0byBwcmludCBhbiBhbm5vdW5jZW1lbnQuKQoKXGVuZHtlbnVtZXJhdGV9CgoKVGhlc2Ug -cmVxdWlyZW1lbnRzIGFwcGx5IHRvIHRoZSBtb2RpZmllZCB3b3JrIGFzIGEgd2hvbGUuICBJZgpp -ZGVudGlmaWFibGUgc2VjdGlvbnMgb2YgdGhhdCB3b3JrIGFyZSBub3QgZGVyaXZlZCBmcm9tIHRo -ZSBQcm9ncmFtLAphbmQgY2FuIGJlIHJlYXNvbmFibHkgY29uc2lkZXJlZCBpbmRlcGVuZGVudCBh -bmQgc2VwYXJhdGUgd29ya3MgaW4KdGhlbXNlbHZlcywgdGhlbiB0aGlzIExpY2Vuc2UsIGFuZCBp -dHMgdGVybXMsIGRvIG5vdCBhcHBseSB0byB0aG9zZQpzZWN0aW9ucyB3aGVuIHlvdSBkaXN0cmli -dXRlIHRoZW0gYXMgc2VwYXJhdGUgd29ya3MuICBCdXQgd2hlbiB5b3UKZGlzdHJpYnV0ZSB0aGUg -c2FtZSBzZWN0aW9ucyBhcyBwYXJ0IG9mIGEgd2hvbGUgd2hpY2ggaXMgYSB3b3JrIGJhc2VkCm9u -IHRoZSBQcm9ncmFtLCB0aGUgZGlzdHJpYnV0aW9uIG9mIHRoZSB3aG9sZSBtdXN0IGJlIG9uIHRo -ZSB0ZXJtcyBvZgp0aGlzIExpY2Vuc2UsIHdob3NlIHBlcm1pc3Npb25zIGZvciBvdGhlciBsaWNl -bnNlZXMgZXh0ZW5kIHRvIHRoZQplbnRpcmUgd2hvbGUsIGFuZCB0aHVzIHRvIGVhY2ggYW5kIGV2 -ZXJ5IHBhcnQgcmVnYXJkbGVzcyBvZiB3aG8gd3JvdGUgaXQuCgpUaHVzLCBpdCBpcyBub3QgdGhl -IGludGVudCBvZiB0aGlzIHNlY3Rpb24gdG8gY2xhaW0gcmlnaHRzIG9yIGNvbnRlc3QKeW91ciBy -aWdodHMgdG8gd29yayB3cml0dGVuIGVudGlyZWx5IGJ5IHlvdTsgcmF0aGVyLCB0aGUgaW50ZW50 -IGlzIHRvCmV4ZXJjaXNlIHRoZSByaWdodCB0byBjb250cm9sIHRoZSBkaXN0cmlidXRpb24gb2Yg -ZGVyaXZhdGl2ZSBvcgpjb2xsZWN0aXZlIHdvcmtzIGJhc2VkIG9uIHRoZSBQcm9ncmFtLgoKSW4g -YWRkaXRpb24sIG1lcmUgYWdncmVnYXRpb24gb2YgYW5vdGhlciB3b3JrIG5vdCBiYXNlZCBvbiB0 -aGUgUHJvZ3JhbQp3aXRoIHRoZSBQcm9ncmFtIChvciB3aXRoIGEgd29yayBiYXNlZCBvbiB0aGUg -UHJvZ3JhbSkgb24gYSB2b2x1bWUgb2YKYSBzdG9yYWdlIG9yIGRpc3RyaWJ1dGlvbiBtZWRpdW0g -ZG9lcyBub3QgYnJpbmcgdGhlIG90aGVyIHdvcmsgdW5kZXIKdGhlIHNjb3BlIG9mIHRoaXMgTGlj -ZW5zZS4KClxpdGVtCllvdSBtYXkgY29weSBhbmQgZGlzdHJpYnV0ZSB0aGUgUHJvZ3JhbSAob3Ig -YSB3b3JrIGJhc2VkIG9uIGl0LAp1bmRlciBTZWN0aW9uIDIpIGluIG9iamVjdCBjb2RlIG9yIGV4 -ZWN1dGFibGUgZm9ybSB1bmRlciB0aGUgdGVybXMgb2YKU2VjdGlvbnMgMSBhbmQgMiBhYm92ZSBw -cm92aWRlZCB0aGF0IHlvdSBhbHNvIGRvIG9uZSBvZiB0aGUgZm9sbG93aW5nOgoKXGJlZ2lue2Vu -dW1lcmF0ZX0KClxpdGVtCgpBY2NvbXBhbnkgaXQgd2l0aCB0aGUgY29tcGxldGUgY29ycmVzcG9u -ZGluZyBtYWNoaW5lLXJlYWRhYmxlCnNvdXJjZSBjb2RlLCB3aGljaCBtdXN0IGJlIGRpc3RyaWJ1 -dGVkIHVuZGVyIHRoZSB0ZXJtcyBvZiBTZWN0aW9ucwoxIGFuZCAyIGFib3ZlIG9uIGEgbWVkaXVt -IGN1c3RvbWFyaWx5IHVzZWQgZm9yIHNvZnR3YXJlIGludGVyY2hhbmdlOyBvciwKClxpdGVtCgpB -Y2NvbXBhbnkgaXQgd2l0aCBhIHdyaXR0ZW4gb2ZmZXIsIHZhbGlkIGZvciBhdCBsZWFzdCB0aHJl -ZQp5ZWFycywgdG8gZ2l2ZSBhbnkgdGhpcmQgcGFydHksIGZvciBhIGNoYXJnZSBubyBtb3JlIHRo -YW4geW91cgpjb3N0IG9mIHBoeXNpY2FsbHkgcGVyZm9ybWluZyBzb3VyY2UgZGlzdHJpYnV0aW9u -LCBhIGNvbXBsZXRlCm1hY2hpbmUtcmVhZGFibGUgY29weSBvZiB0aGUgY29ycmVzcG9uZGluZyBz -b3VyY2UgY29kZSwgdG8gYmUKZGlzdHJpYnV0ZWQgdW5kZXIgdGhlIHRlcm1zIG9mIFNlY3Rpb25z -IDEgYW5kIDIgYWJvdmUgb24gYSBtZWRpdW0KY3VzdG9tYXJpbHkgdXNlZCBmb3Igc29mdHdhcmUg -aW50ZXJjaGFuZ2U7IG9yLAoKXGl0ZW0KCkFjY29tcGFueSBpdCB3aXRoIHRoZSBpbmZvcm1hdGlv -biB5b3UgcmVjZWl2ZWQgYXMgdG8gdGhlIG9mZmVyCnRvIGRpc3RyaWJ1dGUgY29ycmVzcG9uZGlu -ZyBzb3VyY2UgY29kZS4gIChUaGlzIGFsdGVybmF0aXZlIGlzCmFsbG93ZWQgb25seSBmb3Igbm9u -Y29tbWVyY2lhbCBkaXN0cmlidXRpb24gYW5kIG9ubHkgaWYgeW91CnJlY2VpdmVkIHRoZSBwcm9n -cmFtIGluIG9iamVjdCBjb2RlIG9yIGV4ZWN1dGFibGUgZm9ybSB3aXRoIHN1Y2gKYW4gb2ZmZXIs -IGluIGFjY29yZCB3aXRoIFN1YnNlY3Rpb24gYiBhYm92ZS4pCgpcZW5ke2VudW1lcmF0ZX0KCgpU -aGUgc291cmNlIGNvZGUgZm9yIGEgd29yayBtZWFucyB0aGUgcHJlZmVycmVkIGZvcm0gb2YgdGhl -IHdvcmsgZm9yCm1ha2luZyBtb2RpZmljYXRpb25zIHRvIGl0LiAgRm9yIGFuIGV4ZWN1dGFibGUg -d29yaywgY29tcGxldGUgc291cmNlCmNvZGUgbWVhbnMgYWxsIHRoZSBzb3VyY2UgY29kZSBmb3Ig -YWxsIG1vZHVsZXMgaXQgY29udGFpbnMsIHBsdXMgYW55CmFzc29jaWF0ZWQgaW50ZXJmYWNlIGRl -ZmluaXRpb24gZmlsZXMsIHBsdXMgdGhlIHNjcmlwdHMgdXNlZCB0bwpjb250cm9sIGNvbXBpbGF0 -aW9uIGFuZCBpbnN0YWxsYXRpb24gb2YgdGhlIGV4ZWN1dGFibGUuICBIb3dldmVyLCBhcyBhCnNw -ZWNpYWwgZXhjZXB0aW9uLCB0aGUgc291cmNlIGNvZGUgZGlzdHJpYnV0ZWQgbmVlZCBub3QgaW5j -bHVkZQphbnl0aGluZyB0aGF0IGlzIG5vcm1hbGx5IGRpc3RyaWJ1dGVkIChpbiBlaXRoZXIgc291 -cmNlIG9yIGJpbmFyeQpmb3JtKSB3aXRoIHRoZSBtYWpvciBjb21wb25lbnRzIChjb21waWxlciwg -a2VybmVsLCBhbmQgc28gb24pIG9mIHRoZQpvcGVyYXRpbmcgc3lzdGVtIG9uIHdoaWNoIHRoZSBl -eGVjdXRhYmxlIHJ1bnMsIHVubGVzcyB0aGF0IGNvbXBvbmVudAppdHNlbGYgYWNjb21wYW5pZXMg -dGhlIGV4ZWN1dGFibGUuCgpJZiBkaXN0cmlidXRpb24gb2YgZXhlY3V0YWJsZSBvciBvYmplY3Qg -Y29kZSBpcyBtYWRlIGJ5IG9mZmVyaW5nCmFjY2VzcyB0byBjb3B5IGZyb20gYSBkZXNpZ25hdGVk -IHBsYWNlLCB0aGVuIG9mZmVyaW5nIGVxdWl2YWxlbnQKYWNjZXNzIHRvIGNvcHkgdGhlIHNvdXJj -ZSBjb2RlIGZyb20gdGhlIHNhbWUgcGxhY2UgY291bnRzIGFzCmRpc3RyaWJ1dGlvbiBvZiB0aGUg -c291cmNlIGNvZGUsIGV2ZW4gdGhvdWdoIHRoaXJkIHBhcnRpZXMgYXJlIG5vdApjb21wZWxsZWQg -dG8gY29weSB0aGUgc291cmNlIGFsb25nIHdpdGggdGhlIG9iamVjdCBjb2RlLgoKXGl0ZW0KWW91 -IG1heSBub3QgY29weSwgbW9kaWZ5LCBzdWJsaWNlbnNlLCBvciBkaXN0cmlidXRlIHRoZSBQcm9n -cmFtCmV4Y2VwdCBhcyBleHByZXNzbHkgcHJvdmlkZWQgdW5kZXIgdGhpcyBMaWNlbnNlLiAgQW55 -IGF0dGVtcHQKb3RoZXJ3aXNlIHRvIGNvcHksIG1vZGlmeSwgc3VibGljZW5zZSBvciBkaXN0cmli -dXRlIHRoZSBQcm9ncmFtIGlzCnZvaWQsIGFuZCB3aWxsIGF1dG9tYXRpY2FsbHkgdGVybWluYXRl -IHlvdXIgcmlnaHRzIHVuZGVyIHRoaXMgTGljZW5zZS4KSG93ZXZlciwgcGFydGllcyB3aG8gaGF2 -ZSByZWNlaXZlZCBjb3BpZXMsIG9yIHJpZ2h0cywgZnJvbSB5b3UgdW5kZXIKdGhpcyBMaWNlbnNl -IHdpbGwgbm90IGhhdmUgdGhlaXIgbGljZW5zZXMgdGVybWluYXRlZCBzbyBsb25nIGFzIHN1Y2gK -cGFydGllcyByZW1haW4gaW4gZnVsbCBjb21wbGlhbmNlLgoKXGl0ZW0KWW91IGFyZSBub3QgcmVx -dWlyZWQgdG8gYWNjZXB0IHRoaXMgTGljZW5zZSwgc2luY2UgeW91IGhhdmUgbm90CnNpZ25lZCBp -dC4gIEhvd2V2ZXIsIG5vdGhpbmcgZWxzZSBncmFudHMgeW91IHBlcm1pc3Npb24gdG8gbW9kaWZ5 -IG9yCmRpc3RyaWJ1dGUgdGhlIFByb2dyYW0gb3IgaXRzIGRlcml2YXRpdmUgd29ya3MuICBUaGVz -ZSBhY3Rpb25zIGFyZQpwcm9oaWJpdGVkIGJ5IGxhdyBpZiB5b3UgZG8gbm90IGFjY2VwdCB0aGlz -IExpY2Vuc2UuICBUaGVyZWZvcmUsIGJ5Cm1vZGlmeWluZyBvciBkaXN0cmlidXRpbmcgdGhlIFBy -b2dyYW0gKG9yIGFueSB3b3JrIGJhc2VkIG9uIHRoZQpQcm9ncmFtKSwgeW91IGluZGljYXRlIHlv -dXIgYWNjZXB0YW5jZSBvZiB0aGlzIExpY2Vuc2UgdG8gZG8gc28sIGFuZAphbGwgaXRzIHRlcm1z -IGFuZCBjb25kaXRpb25zIGZvciBjb3B5aW5nLCBkaXN0cmlidXRpbmcgb3IgbW9kaWZ5aW5nCnRo -ZSBQcm9ncmFtIG9yIHdvcmtzIGJhc2VkIG9uIGl0LgoKXGl0ZW0KRWFjaCB0aW1lIHlvdSByZWRp -c3RyaWJ1dGUgdGhlIFByb2dyYW0gKG9yIGFueSB3b3JrIGJhc2VkIG9uIHRoZQpQcm9ncmFtKSwg -dGhlIHJlY2lwaWVudCBhdXRvbWF0aWNhbGx5IHJlY2VpdmVzIGEgbGljZW5zZSBmcm9tIHRoZQpv -cmlnaW5hbCBsaWNlbnNvciB0byBjb3B5LCBkaXN0cmlidXRlIG9yIG1vZGlmeSB0aGUgUHJvZ3Jh -bSBzdWJqZWN0IHRvCnRoZXNlIHRlcm1zIGFuZCBjb25kaXRpb25zLiAgWW91IG1heSBub3QgaW1w -b3NlIGFueSBmdXJ0aGVyCnJlc3RyaWN0aW9ucyBvbiB0aGUgcmVjaXBpZW50cycgZXhlcmNpc2Ug -b2YgdGhlIHJpZ2h0cyBncmFudGVkIGhlcmVpbi4KWW91IGFyZSBub3QgcmVzcG9uc2libGUgZm9y -IGVuZm9yY2luZyBjb21wbGlhbmNlIGJ5IHRoaXJkIHBhcnRpZXMgdG8KdGhpcyBMaWNlbnNlLgoK -XGl0ZW0KSWYsIGFzIGEgY29uc2VxdWVuY2Ugb2YgYSBjb3VydCBqdWRnbWVudCBvciBhbGxlZ2F0 -aW9uIG9mIHBhdGVudAppbmZyaW5nZW1lbnQgb3IgZm9yIGFueSBvdGhlciByZWFzb24gKG5vdCBs -aW1pdGVkIHRvIHBhdGVudCBpc3N1ZXMpLApjb25kaXRpb25zIGFyZSBpbXBvc2VkIG9uIHlvdSAo -d2hldGhlciBieSBjb3VydCBvcmRlciwgYWdyZWVtZW50IG9yCm90aGVyd2lzZSkgdGhhdCBjb250 -cmFkaWN0IHRoZSBjb25kaXRpb25zIG9mIHRoaXMgTGljZW5zZSwgdGhleSBkbyBub3QKZXhjdXNl -IHlvdSBmcm9tIHRoZSBjb25kaXRpb25zIG9mIHRoaXMgTGljZW5zZS4gIElmIHlvdSBjYW5ub3QK -ZGlzdHJpYnV0ZSBzbyBhcyB0byBzYXRpc2Z5IHNpbXVsdGFuZW91c2x5IHlvdXIgb2JsaWdhdGlv -bnMgdW5kZXIgdGhpcwpMaWNlbnNlIGFuZCBhbnkgb3RoZXIgcGVydGluZW50IG9ibGlnYXRpb25z -LCB0aGVuIGFzIGEgY29uc2VxdWVuY2UgeW91Cm1heSBub3QgZGlzdHJpYnV0ZSB0aGUgUHJvZ3Jh -bSBhdCBhbGwuICBGb3IgZXhhbXBsZSwgaWYgYSBwYXRlbnQKbGljZW5zZSB3b3VsZCBub3QgcGVy -bWl0IHJveWFsdHktZnJlZSByZWRpc3RyaWJ1dGlvbiBvZiB0aGUgUHJvZ3JhbSBieQphbGwgdGhv -c2Ugd2hvIHJlY2VpdmUgY29waWVzIGRpcmVjdGx5IG9yIGluZGlyZWN0bHkgdGhyb3VnaCB5b3Us -IHRoZW4KdGhlIG9ubHkgd2F5IHlvdSBjb3VsZCBzYXRpc2Z5IGJvdGggaXQgYW5kIHRoaXMgTGlj -ZW5zZSB3b3VsZCBiZSB0bwpyZWZyYWluIGVudGlyZWx5IGZyb20gZGlzdHJpYnV0aW9uIG9mIHRo -ZSBQcm9ncmFtLgoKSWYgYW55IHBvcnRpb24gb2YgdGhpcyBzZWN0aW9uIGlzIGhlbGQgaW52YWxp -ZCBvciB1bmVuZm9yY2VhYmxlIHVuZGVyCmFueSBwYXJ0aWN1bGFyIGNpcmN1bXN0YW5jZSwgdGhl -IGJhbGFuY2Ugb2YgdGhlIHNlY3Rpb24gaXMgaW50ZW5kZWQgdG8KYXBwbHkgYW5kIHRoZSBzZWN0 -aW9uIGFzIGEgd2hvbGUgaXMgaW50ZW5kZWQgdG8gYXBwbHkgaW4gb3RoZXIKY2lyY3Vtc3RhbmNl -cy4KCkl0IGlzIG5vdCB0aGUgcHVycG9zZSBvZiB0aGlzIHNlY3Rpb24gdG8gaW5kdWNlIHlvdSB0 -byBpbmZyaW5nZSBhbnkKcGF0ZW50cyBvciBvdGhlciBwcm9wZXJ0eSByaWdodCBjbGFpbXMgb3Ig -dG8gY29udGVzdCB2YWxpZGl0eSBvZiBhbnkKc3VjaCBjbGFpbXM7IHRoaXMgc2VjdGlvbiBoYXMg -dGhlIHNvbGUgcHVycG9zZSBvZiBwcm90ZWN0aW5nIHRoZQppbnRlZ3JpdHkgb2YgdGhlIGZyZWUg -c29mdHdhcmUgZGlzdHJpYnV0aW9uIHN5c3RlbSwgd2hpY2ggaXMKaW1wbGVtZW50ZWQgYnkgcHVi -bGljIGxpY2Vuc2UgcHJhY3RpY2VzLiAgTWFueSBwZW9wbGUgaGF2ZSBtYWRlCmdlbmVyb3VzIGNv -bnRyaWJ1dGlvbnMgdG8gdGhlIHdpZGUgcmFuZ2Ugb2Ygc29mdHdhcmUgZGlzdHJpYnV0ZWQKdGhy -b3VnaCB0aGF0IHN5c3RlbSBpbiByZWxpYW5jZSBvbiBjb25zaXN0ZW50IGFwcGxpY2F0aW9uIG9m -IHRoYXQKc3lzdGVtOyBpdCBpcyB1cCB0byB0aGUgYXV0aG9yL2Rvbm9yIHRvIGRlY2lkZSBpZiBo -ZSBvciBzaGUgaXMgd2lsbGluZwp0byBkaXN0cmlidXRlIHNvZnR3YXJlIHRocm91Z2ggYW55IG90 -aGVyIHN5c3RlbSBhbmQgYSBsaWNlbnNlZSBjYW5ub3QKaW1wb3NlIHRoYXQgY2hvaWNlLgoKVGhp -cyBzZWN0aW9uIGlzIGludGVuZGVkIHRvIG1ha2UgdGhvcm91Z2hseSBjbGVhciB3aGF0IGlzIGJl -bGlldmVkIHRvCmJlIGEgY29uc2VxdWVuY2Ugb2YgdGhlIHJlc3Qgb2YgdGhpcyBMaWNlbnNlLgoK -XGl0ZW0KSWYgdGhlIGRpc3RyaWJ1dGlvbiBhbmQvb3IgdXNlIG9mIHRoZSBQcm9ncmFtIGlzIHJl -c3RyaWN0ZWQgaW4KY2VydGFpbiBjb3VudHJpZXMgZWl0aGVyIGJ5IHBhdGVudHMgb3IgYnkgY29w -eXJpZ2h0ZWQgaW50ZXJmYWNlcywgdGhlCm9yaWdpbmFsIGNvcHlyaWdodCBob2xkZXIgd2hvIHBs -YWNlcyB0aGUgUHJvZ3JhbSB1bmRlciB0aGlzIExpY2Vuc2UKbWF5IGFkZCBhbiBleHBsaWNpdCBn -ZW9ncmFwaGljYWwgZGlzdHJpYnV0aW9uIGxpbWl0YXRpb24gZXhjbHVkaW5nCnRob3NlIGNvdW50 -cmllcywgc28gdGhhdCBkaXN0cmlidXRpb24gaXMgcGVybWl0dGVkIG9ubHkgaW4gb3IgYW1vbmcK -Y291bnRyaWVzIG5vdCB0aHVzIGV4Y2x1ZGVkLiAgSW4gc3VjaCBjYXNlLCB0aGlzIExpY2Vuc2Ug -aW5jb3Jwb3JhdGVzCnRoZSBsaW1pdGF0aW9uIGFzIGlmIHdyaXR0ZW4gaW4gdGhlIGJvZHkgb2Yg -dGhpcyBMaWNlbnNlLgoKXGl0ZW0KVGhlIEZyZWUgU29mdHdhcmUgRm91bmRhdGlvbiBtYXkgcHVi -bGlzaCByZXZpc2VkIGFuZC9vciBuZXcgdmVyc2lvbnMKb2YgdGhlIEdlbmVyYWwgUHVibGljIExp -Y2Vuc2UgZnJvbSB0aW1lIHRvIHRpbWUuICBTdWNoIG5ldyB2ZXJzaW9ucyB3aWxsCmJlIHNpbWls -YXIgaW4gc3Bpcml0IHRvIHRoZSBwcmVzZW50IHZlcnNpb24sIGJ1dCBtYXkgZGlmZmVyIGluIGRl -dGFpbCB0bwphZGRyZXNzIG5ldyBwcm9ibGVtcyBvciBjb25jZXJucy4KCkVhY2ggdmVyc2lvbiBp -cyBnaXZlbiBhIGRpc3Rpbmd1aXNoaW5nIHZlcnNpb24gbnVtYmVyLiAgSWYgdGhlIFByb2dyYW0K -c3BlY2lmaWVzIGEgdmVyc2lvbiBudW1iZXIgb2YgdGhpcyBMaWNlbnNlIHdoaWNoIGFwcGxpZXMg -dG8gaXQgYW5kIGBgYW55CmxhdGVyIHZlcnNpb24nJywgeW91IGhhdmUgdGhlIG9wdGlvbiBvZiBm -b2xsb3dpbmcgdGhlIHRlcm1zIGFuZCBjb25kaXRpb25zCmVpdGhlciBvZiB0aGF0IHZlcnNpb24g -b3Igb2YgYW55IGxhdGVyIHZlcnNpb24gcHVibGlzaGVkIGJ5IHRoZSBGcmVlClNvZnR3YXJlIEZv -dW5kYXRpb24uICBJZiB0aGUgUHJvZ3JhbSBkb2VzIG5vdCBzcGVjaWZ5IGEgdmVyc2lvbiBudW1i -ZXIgb2YKdGhpcyBMaWNlbnNlLCB5b3UgbWF5IGNob29zZSBhbnkgdmVyc2lvbiBldmVyIHB1Ymxp -c2hlZCBieSB0aGUgRnJlZSBTb2Z0d2FyZQpGb3VuZGF0aW9uLgoKXGl0ZW0KSWYgeW91IHdpc2gg -dG8gaW5jb3Jwb3JhdGUgcGFydHMgb2YgdGhlIFByb2dyYW0gaW50byBvdGhlciBmcmVlCnByb2dy -YW1zIHdob3NlIGRpc3RyaWJ1dGlvbiBjb25kaXRpb25zIGFyZSBkaWZmZXJlbnQsIHdyaXRlIHRv -IHRoZSBhdXRob3IKdG8gYXNrIGZvciBwZXJtaXNzaW9uLiAgRm9yIHNvZnR3YXJlIHdoaWNoIGlz -IGNvcHlyaWdodGVkIGJ5IHRoZSBGcmVlClNvZnR3YXJlIEZvdW5kYXRpb24sIHdyaXRlIHRvIHRo -ZSBGcmVlIFNvZnR3YXJlIEZvdW5kYXRpb247IHdlIHNvbWV0aW1lcwptYWtlIGV4Y2VwdGlvbnMg -Zm9yIHRoaXMuICBPdXIgZGVjaXNpb24gd2lsbCBiZSBndWlkZWQgYnkgdGhlIHR3byBnb2Fscwpv -ZiBwcmVzZXJ2aW5nIHRoZSBmcmVlIHN0YXR1cyBvZiBhbGwgZGVyaXZhdGl2ZXMgb2Ygb3VyIGZy -ZWUgc29mdHdhcmUgYW5kCm9mIHByb21vdGluZyB0aGUgc2hhcmluZyBhbmQgcmV1c2Ugb2Ygc29m -dHdhcmUgZ2VuZXJhbGx5LgoKXGJlZ2lue2NlbnRlcn0Ke1xMYXJnZVxzYwpObyBXYXJyYW50eQp9 -ClxlbmR7Y2VudGVyfQoKXGl0ZW0Ke1xzYyBCZWNhdXNlIHRoZSBwcm9ncmFtIGlzIGxpY2Vuc2Vk -IGZyZWUgb2YgY2hhcmdlLCB0aGVyZSBpcyBubyB3YXJyYW50eQpmb3IgdGhlIHByb2dyYW0sIHRv -IHRoZSBleHRlbnQgcGVybWl0dGVkIGJ5IGFwcGxpY2FibGUgbGF3LiAgRXhjZXB0IHdoZW4Kb3Ro -ZXJ3aXNlIHN0YXRlZCBpbiB3cml0aW5nIHRoZSBjb3B5cmlnaHQgaG9sZGVycyBhbmQvb3Igb3Ro -ZXIgcGFydGllcwpwcm92aWRlIHRoZSBwcm9ncmFtIGBgYXMgaXMnJyB3aXRob3V0IHdhcnJhbnR5 -IG9mIGFueSBraW5kLCBlaXRoZXIgZXhwcmVzc2VkCm9yIGltcGxpZWQsIGluY2x1ZGluZywgYnV0 -IG5vdCBsaW1pdGVkIHRvLCB0aGUgaW1wbGllZCB3YXJyYW50aWVzIG9mCm1lcmNoYW50YWJpbGl0 -eSBhbmQgZml0bmVzcyBmb3IgYSBwYXJ0aWN1bGFyIHB1cnBvc2UuICBUaGUgZW50aXJlIHJpc2sg -YXMKdG8gdGhlIHF1YWxpdHkgYW5kIHBlcmZvcm1hbmNlIG9mIHRoZSBwcm9ncmFtIGlzIHdpdGgg -eW91LiAgU2hvdWxkIHRoZQpwcm9ncmFtIHByb3ZlIGRlZmVjdGl2ZSwgeW91IGFzc3VtZSB0aGUg -Y29zdCBvZiBhbGwgbmVjZXNzYXJ5IHNlcnZpY2luZywKcmVwYWlyIG9yIGNvcnJlY3Rpb24ufQoK -XGl0ZW0Ke1xzYyBJbiBubyBldmVudCB1bmxlc3MgcmVxdWlyZWQgYnkgYXBwbGljYWJsZSBsYXcg -b3IgYWdyZWVkIHRvIGluIHdyaXRpbmcKd2lsbCBhbnkgY29weXJpZ2h0IGhvbGRlciwgb3IgYW55 -IG90aGVyIHBhcnR5IHdobyBtYXkgbW9kaWZ5IGFuZC9vcgpyZWRpc3RyaWJ1dGUgdGhlIHByb2dy -YW0gYXMgcGVybWl0dGVkIGFib3ZlLCBiZSBsaWFibGUgdG8geW91IGZvciBkYW1hZ2VzLAppbmNs -dWRpbmcgYW55IGdlbmVyYWwsIHNwZWNpYWwsIGluY2lkZW50YWwgb3IgY29uc2VxdWVudGlhbCBk -YW1hZ2VzIGFyaXNpbmcKb3V0IG9mIHRoZSB1c2Ugb3IgaW5hYmlsaXR5IHRvIHVzZSB0aGUgcHJv -Z3JhbSAoaW5jbHVkaW5nIGJ1dCBub3QgbGltaXRlZAp0byBsb3NzIG9mIGRhdGEgb3IgZGF0YSBi -ZWluZyByZW5kZXJlZCBpbmFjY3VyYXRlIG9yIGxvc3NlcyBzdXN0YWluZWQgYnkKeW91IG9yIHRo -aXJkIHBhcnRpZXMgb3IgYSBmYWlsdXJlIG9mIHRoZSBwcm9ncmFtIHRvIG9wZXJhdGUgd2l0aCBh -bnkgb3RoZXIKcHJvZ3JhbXMpLCBldmVuIGlmIHN1Y2ggaG9sZGVyIG9yIG90aGVyIHBhcnR5IGhh -cyBiZWVuIGFkdmlzZWQgb2YgdGhlCnBvc3NpYmlsaXR5IG9mIHN1Y2ggZGFtYWdlcy59CgpcZW5k -e2VudW1lcmF0ZX0KCgpcYmVnaW57Y2VudGVyfQp7XExhcmdlXHNjIEVuZCBvZiBUZXJtcyBhbmQg -Q29uZGl0aW9uc30KXGVuZHtjZW50ZXJ9CgoKXHBhZ2VicmVha1syXQoKXHNlY3Rpb24qe0FwcGVu -ZGl4OiBIb3cgdG8gQXBwbHkgVGhlc2UgVGVybXMgdG8gWW91ciBOZXcgUHJvZ3JhbXN9CgpJZiB5 -b3UgZGV2ZWxvcCBhIG5ldyBwcm9ncmFtLCBhbmQgeW91IHdhbnQgaXQgdG8gYmUgb2YgdGhlIGdy -ZWF0ZXN0CnBvc3NpYmxlIHVzZSB0byB0aGUgcHVibGljLCB0aGUgYmVzdCB3YXkgdG8gYWNoaWV2 -ZSB0aGlzIGlzIHRvIG1ha2UgaXQKZnJlZSBzb2Z0d2FyZSB3aGljaCBldmVyeW9uZSBjYW4gcmVk -aXN0cmlidXRlIGFuZCBjaGFuZ2UgdW5kZXIgdGhlc2UKdGVybXMuCgogIFRvIGRvIHNvLCBhdHRh -Y2ggdGhlIGZvbGxvd2luZyBub3RpY2VzIHRvIHRoZSBwcm9ncmFtLiAgSXQgaXMgc2FmZXN0IHRv -CiAgYXR0YWNoIHRoZW0gdG8gdGhlIHN0YXJ0IG9mIGVhY2ggc291cmNlIGZpbGUgdG8gbW9zdCBl -ZmZlY3RpdmVseSBjb252ZXkKICB0aGUgZXhjbHVzaW9uIG9mIHdhcnJhbnR5OyBhbmQgZWFjaCBm -aWxlIHNob3VsZCBoYXZlIGF0IGxlYXN0IHRoZQogIGBgY29weXJpZ2h0JycgbGluZSBhbmQgYSBw -b2ludGVyIHRvIHdoZXJlIHRoZSBmdWxsIG5vdGljZSBpcyBmb3VuZC4KClxiZWdpbntxdW90ZX0K -b25lIGxpbmUgdG8gZ2l2ZSB0aGUgcHJvZ3JhbSdzIG5hbWUgYW5kIGEgYnJpZWYgaWRlYSBvZiB3 -aGF0IGl0IGRvZXMuIFxcCkNvcHlyaWdodCAoQykgeXl5eSAgbmFtZSBvZiBhdXRob3IgXFwKClRo -aXMgcHJvZ3JhbSBpcyBmcmVlIHNvZnR3YXJlOyB5b3UgY2FuIHJlZGlzdHJpYnV0ZSBpdCBhbmQv -b3IgbW9kaWZ5Cml0IHVuZGVyIHRoZSB0ZXJtcyBvZiB0aGUgR05VIEdlbmVyYWwgUHVibGljIExp -Y2Vuc2UgYXMgcHVibGlzaGVkIGJ5CnRoZSBGcmVlIFNvZnR3YXJlIEZvdW5kYXRpb247IGVpdGhl -ciB2ZXJzaW9uIDIgb2YgdGhlIExpY2Vuc2UsIG9yCihhdCB5b3VyIG9wdGlvbikgYW55IGxhdGVy -IHZlcnNpb24uCgpUaGlzIHByb2dyYW0gaXMgZGlzdHJpYnV0ZWQgaW4gdGhlIGhvcGUgdGhhdCBp -dCB3aWxsIGJlIHVzZWZ1bCwKYnV0IFdJVEhPVVQgQU5ZIFdBUlJBTlRZOyB3aXRob3V0IGV2ZW4g -dGhlIGltcGxpZWQgd2FycmFudHkgb2YKTUVSQ0hBTlRBQklMSVRZIG9yIEZJVE5FU1MgRk9SIEEg -UEFSVElDVUxBUiBQVVJQT1NFLiAgU2VlIHRoZQpHTlUgR2VuZXJhbCBQdWJsaWMgTGljZW5zZSBm -b3IgbW9yZSBkZXRhaWxzLgoKWW91IHNob3VsZCBoYXZlIHJlY2VpdmVkIGEgY29weSBvZiB0aGUg -R05VIEdlbmVyYWwgUHVibGljIExpY2Vuc2UKYWxvbmcgd2l0aCB0aGlzIHByb2dyYW07IGlmIG5v -dCwgd3JpdGUgdG8gdGhlIEZyZWUgU29mdHdhcmUKRm91bmRhdGlvbiwgSW5jLiwgNTkgVGVtcGxl -IFBsYWNlIC0gU3VpdGUgMzMwLCBCb3N0b24sIE1BICAwMjExMS0xMzA3LCBVU0EuClxlbmR7cXVv -dGV9CgpBbHNvIGFkZCBpbmZvcm1hdGlvbiBvbiBob3cgdG8gY29udGFjdCB5b3UgYnkgZWxlY3Ry -b25pYyBhbmQgcGFwZXIgbWFpbC4KCklmIHRoZSBwcm9ncmFtIGlzIGludGVyYWN0aXZlLCBtYWtl -IGl0IG91dHB1dCBhIHNob3J0IG5vdGljZSBsaWtlIHRoaXMKd2hlbiBpdCBzdGFydHMgaW4gYW4g -aW50ZXJhY3RpdmUgbW9kZToKClxiZWdpbntxdW90ZX0KR25vbW92aXNpb24gdmVyc2lvbiA2OSwg -Q29weXJpZ2h0IChDKSB5eXl5ICBuYW1lIG9mIGF1dGhvciBcXApHbm9tb3Zpc2lvbiBjb21lcyB3 -aXRoIEFCU09MVVRFTFkgTk8gV0FSUkFOVFk7IGZvciBkZXRhaWxzIHR5cGUgYHNob3cgdycuIFxc -ClRoaXMgaXMgZnJlZSBzb2Z0d2FyZSwgYW5kIHlvdSBhcmUgd2VsY29tZSB0byByZWRpc3RyaWJ1 -dGUgaXQKdW5kZXIgY2VydGFpbiBjb25kaXRpb25zOyB0eXBlIGBzaG93IGMnIGZvciBkZXRhaWxz -LgpcZW5ke3F1b3RlfQoKClRoZSBoeXBvdGhldGljYWwgY29tbWFuZHMge1x0dCBzaG93IHd9IGFu -ZCB7XHR0IHNob3cgY30gc2hvdWxkIHNob3cgdGhlCmFwcHJvcHJpYXRlIHBhcnRzIG9mIHRoZSBH -ZW5lcmFsIFB1YmxpYyBMaWNlbnNlLiAgT2YgY291cnNlLCB0aGUgY29tbWFuZHMKeW91IHVzZSBt -YXkgYmUgY2FsbGVkIHNvbWV0aGluZyBvdGhlciB0aGFuIHtcdHQgc2hvdyB3fSBhbmQge1x0dCBz -aG93IGN9Owp0aGV5IGNvdWxkIGV2ZW4gYmUgbW91c2UtY2xpY2tzIG9yIG1lbnUgaXRlbXMtLS13 -aGF0ZXZlciBzdWl0cyB5b3VyCnByb2dyYW0uCgpZb3Ugc2hvdWxkIGFsc28gZ2V0IHlvdXIgZW1w -bG95ZXIgKGlmIHlvdSB3b3JrIGFzIGEgcHJvZ3JhbW1lcikgb3IgeW91cgpzY2hvb2wsIGlmIGFu -eSwgdG8gc2lnbiBhIGBgY29weXJpZ2h0IGRpc2NsYWltZXInJyBmb3IgdGhlIHByb2dyYW0sIGlm -Cm5lY2Vzc2FyeS4gIEhlcmUgaXMgYSBzYW1wbGU7IGFsdGVyIHRoZSBuYW1lczoKClxiZWdpbntx -dW90ZX0KWW95b2R5bmUsIEluYy4sIGhlcmVieSBkaXNjbGFpbXMgYWxsIGNvcHlyaWdodCBpbnRl -cmVzdCBpbiB0aGUgcHJvZ3JhbSBcXApgR25vbW92aXNpb24nICh3aGljaCBtYWtlcyBwYXNzZXMg -YXQgY29tcGlsZXJzKSB3cml0dGVuIGJ5IEphbWVzIEhhY2tlci4gXFwKCnNpZ25hdHVyZSBvZiBU -eSBDb29uLCAxIEFwcmlsIDE5ODkgXFwKVHkgQ29vbiwgUHJlc2lkZW50IG9mIFZpY2UKXGVuZHtx -dW90ZX0KCgpUaGlzIEdlbmVyYWwgUHVibGljIExpY2Vuc2UgZG9lcyBub3QgcGVybWl0IGluY29y -cG9yYXRpbmcgeW91ciBwcm9ncmFtCmludG8gcHJvcHJpZXRhcnkgcHJvZ3JhbXMuICBJZiB5b3Vy -IHByb2dyYW0gaXMgYSBzdWJyb3V0aW5lIGxpYnJhcnksIHlvdQptYXkgY29uc2lkZXIgaXQgbW9y -ZSB1c2VmdWwgdG8gcGVybWl0IGxpbmtpbmcgcHJvcHJpZXRhcnkgYXBwbGljYXRpb25zCndpdGgg -dGhlIGxpYnJhcnkuICBJZiB0aGlzIGlzIHdoYXQgeW91IHdhbnQgdG8gZG8sIHVzZSB0aGUgR05V -IExpYnJhcnkKR2VuZXJhbCBQdWJsaWMgTGljZW5zZSBpbnN0ZWFkIG9mIHRoaXMgTGljZW5zZS4K -Cgo= -" ++ Glurf ++ lists:reverse(Glurf++"kalle"). diff --git a/lib/compiler/test/compilation_SUITE_data/nested_tuples_in_case_expr.erl b/lib/compiler/test/compilation_SUITE_data/nested_tuples_in_case_expr.erl deleted file mode 100644 index bbacb7cf14..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/nested_tuples_in_case_expr.erl +++ /dev/null @@ -1,37 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(nested_tuples_in_case_expr). --export([nested_tuples_in_case_expr/0,t/2]). - -nested_tuples_in_case_expr() -> - ok. - -t(A, B) -> - case {{element(1, A),element(2, B)},{element(2, A),element(2, B)}} of - {Same,Same} -> ok; - {{0,1},{up,X}} -> bar(X); - {_,{X,_}} -> bar(X) - end. - -bar(X) -> X. - - - - diff --git a/lib/compiler/test/compilation_SUITE_data/otp_2141.erl b/lib/compiler/test/compilation_SUITE_data/otp_2141.erl deleted file mode 100644 index 4737d0972e..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_2141.erl +++ /dev/null @@ -1,25 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_2141). --export([otp_2141/0]). - - -otp_2141() -> - ok. diff --git a/lib/compiler/test/compilation_SUITE_data/otp_2173.erl b/lib/compiler/test/compilation_SUITE_data/otp_2173.erl deleted file mode 100644 index 5479700d1d..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_2173.erl +++ /dev/null @@ -1,32 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_2173). --compile(export_all). - --record(t, {a = fun(X) -> X*X end}). - -otp_2173() -> - ok. - -t() -> - #t{}. - - - diff --git a/lib/compiler/test/compilation_SUITE_data/otp_5076.erl b/lib/compiler/test/compilation_SUITE_data/otp_5076.erl deleted file mode 100644 index 19f974bb5b..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_5076.erl +++ /dev/null @@ -1,28 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_5076). --export([?MODULE/0]). - -?MODULE() -> - [] = t(), - ok. - -t() -> - [3 || {3=4} <- []]. diff --git a/lib/compiler/test/compilation_SUITE_data/otp_5092.erl b/lib/compiler/test/compilation_SUITE_data/otp_5092.erl deleted file mode 100644 index 88c4519cc6..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_5092.erl +++ /dev/null @@ -1,40 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_5092). --export([?MODULE/0]). - -?MODULE() -> - [] = t(), - [] = t2(), - [t] = t4(), - [] = t5(), - ok. - -t() -> - [t || {C=D}={_,_} <- []]. - -t2() -> - [X || {X,{Y}={X,X}} <- []]. - -t4() -> - [t || "a"++"b" = "ab" <- ["ab"]]. - -t5() -> - [{X,Y} || {X} <- [], begin Y = X, Y =:= X end]. diff --git a/lib/compiler/test/compilation_SUITE_data/otp_5244.erl b/lib/compiler/test/compilation_SUITE_data/otp_5244.erl deleted file mode 100644 index 8144e5a225..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_5244.erl +++ /dev/null @@ -1,48 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_5244). --export([?MODULE/0]). - -?MODULE() -> - L = [{stretch,0,0}, - {bad,[]}, - {bad,atom}, - {bad,0}, - {bad,16#AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA}, - {bad,16#555555555555555555555555555555555555555555555555555}], - remove_failure(L, unit, 0). - -remove_failure([], _Unit, _MaxFailure) -> - ok; -remove_failure([{bad,Bad}|_], _Unit, _MaxFailure) -> - Bad; -remove_failure([{stretch,_,Mi}=Stretch | Specs], Unit, _MaxFailure) -> - {MinMax,NewMaxFailure} = max_failure(), - case {MinMax,remove_failure(Specs, Unit, NewMaxFailure)} of - {min,{NewMaxFailure,Rest}} -> - {done,[{fixed,Mi} | Rest]}; - {min,_} when Specs =/= [] -> - remove_failure([Stretch|tl(Specs)], Unit, NewMaxFailure); - {min,_} -> - ok - end. - -max_failure() -> - {min,1}. diff --git a/lib/compiler/test/compilation_SUITE_data/otp_6121a.erl b/lib/compiler/test/compilation_SUITE_data/otp_6121a.erl deleted file mode 100644 index a8fc5f3bb5..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_6121a.erl +++ /dev/null @@ -1,33 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_6121a). --export([?MODULE/0]). - -%% Thanks to Martin Bjorklund. - -?MODULE() -> - G = fun() -> ok end, - try - fun() -> ok end - after - fun({A, B}) -> A + B end - end, - ok. - diff --git a/lib/compiler/test/compilation_SUITE_data/otp_6121b.erl b/lib/compiler/test/compilation_SUITE_data/otp_6121b.erl deleted file mode 100644 index df2e60deb5..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/otp_6121b.erl +++ /dev/null @@ -1,34 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2006-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_6121b). --export([?MODULE/0]). - -%% Thanks to Tim Rath. - -?MODULE() -> - A = {6}, - try - io:fwrite("") - after - fun () -> - fun () -> {B} = A end - end - end. - diff --git a/lib/compiler/test/compilation_SUITE_data/pattern_expr.erl b/lib/compiler/test/compilation_SUITE_data/pattern_expr.erl deleted file mode 100644 index a78b3501d1..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/pattern_expr.erl +++ /dev/null @@ -1,31 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(pattern_expr). - --export(pattern_expr/0). - -pattern_expr() -> - f(). - -f() -> - case 4 of - 2+2 -> - ok - end. diff --git a/lib/compiler/test/compilation_SUITE_data/trycatch_4.erl b/lib/compiler/test/compilation_SUITE_data/trycatch_4.erl deleted file mode 100644 index f465376bdc..0000000000 --- a/lib/compiler/test/compilation_SUITE_data/trycatch_4.erl +++ /dev/null @@ -1,51 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2005-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(trycatch_4). --export([trycatch_4/0]). --record(state, {foo}). - -trycatch_4() -> - handle_info({foo}, #state{}), - ok. - -handle_info({_}, State) -> - foo(), - State#state{foo = bar}, - case ok of - _ -> - case catch foo() of - ok -> - {stop, State} - end - end; -handle_info(_, State) -> - (catch begin - foo(), - State#state{foo = bar} - end), - case ok of - _ -> - case catch foo() of - ok -> - {stop, State} - end - end. - -foo() -> ok. diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index f55ea9a3a6..e634f0fcc2 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -31,14 +31,12 @@ binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1, other_output/1, encrypted_abstr/1, strict_record/1, - missing_testheap/1, cover/1, env/1, core/1, + cover/1, env/1, core/1, core_roundtrip/1, asm/1, sys_pre_attributes/1, dialyzer/1, warnings/1, pre_load_check/1 ]). --export([init/3]). - suite() -> [{ct_hooks,[ts_install_cth]}]. %% To cover the stripping of 'type' and 'spec' in beam_asm. @@ -51,7 +49,7 @@ all() -> binary, makedep, cond_and_ifdef, listings, listings_big, other_output, encrypted_abstr, strict_record, - missing_testheap, cover, env, core, core_roundtrip, asm, + cover, env, core, core_roundtrip, asm, sys_pre_attributes, dialyzer, warnings, pre_load_check]. groups() -> @@ -649,46 +647,6 @@ test_sloppy() -> {1,2} = record_access:test(Turtle), Turtle. -missing_testheap(Config) when is_list(Config) -> - DataDir = proplists:get_value(data_dir, Config), - PrivDir = proplists:get_value(priv_dir, Config), - Opts = [{outdir,PrivDir}], - OldPath = code:get_path(), - try - code:add_patha(PrivDir), - c:c(filename:join(DataDir, "missing_testheap1"), Opts), - c:c(filename:join(DataDir, "missing_testheap2"), Opts), - ok = test(fun() -> - missing_testheap1:f({a,self()},{state,true,b}) - end, {a,b}), - ok = test(fun() -> - missing_testheap2:f({a,self()},16#80000000) end, - bigger) - after - code:set_path(OldPath), - file:delete(filename:join(PrivDir, "missing_testheap1.beam")), - file:delete(filename:join(PrivDir, "missing_testheap2.beam")) - end, - ok. - -test(Fun, Result) -> - test(500, Fun, Result, []). - -test(0, _, _, _) -> - ok; -test(Iter, Fun, Result, Filler) -> - spawn(?MODULE, init, [self(), Fun, list_to_tuple(Filler)]), - receive - {result, Result} -> - test(Iter-1, Fun, Result, [0|Filler]); - {result, Other} -> - io:format("Expected ~p; got ~p~n", [Result, Other]), - ct:fail(failed) - end. - -init(ReplyTo, Fun, _Filler) -> - ReplyTo ! {result, Fun()}. - env(Config) when is_list(Config) -> {Simple,Target} = get_files(Config, simple, env), {ok,Cwd} = file:get_cwd(), diff --git a/lib/compiler/test/compile_SUITE_data/missing_testheap1.erl b/lib/compiler/test/compile_SUITE_data/missing_testheap1.erl deleted file mode 100644 index 2c1eb8a3ae..0000000000 --- a/lib/compiler/test/compile_SUITE_data/missing_testheap1.erl +++ /dev/null @@ -1,36 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(missing_testheap1). - --compile(export_all). -%%-export([Function/Arity, ...]). --record(state,{e1,e2}). - -f({a,DpId},State) when State == -#state{e1=true, - e2=a} -> - {a,a}; - -f({a,DpId},State) when State == -#state{e1=true, - e2=b} -> - {a,b}. - - diff --git a/lib/compiler/test/compile_SUITE_data/missing_testheap2.erl b/lib/compiler/test/compile_SUITE_data/missing_testheap2.erl deleted file mode 100644 index b2aa9b5a5a..0000000000 --- a/lib/compiler/test/compile_SUITE_data/missing_testheap2.erl +++ /dev/null @@ -1,30 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(missing_testheap2). - --compile(export_all). - -f({a,DpId},16#7fffffff) -> - big; - -f({a,DpId},16#80000000) -> - bigger. - - diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index ffbf59f0ee..13d274d98a 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -28,7 +28,7 @@ or_guard/1,more_or_guards/1, complex_or_guards/1,and_guard/1, xor_guard/1,more_xor_guards/1, - old_guard_tests/1, + old_guard_tests/1,complex_guard/1, build_in_guard/1,gbif/1, t_is_boolean/1,is_function_2/1, tricky/1,rel_ops/1,rel_op_combinations/1,literal_type_tests/1, @@ -48,7 +48,8 @@ groups() -> [misc,const_cond,basic_not,complex_not,nested_nots, semicolon,complex_semicolon,comma,or_guard, more_or_guards,complex_or_guards,and_guard,xor_guard, - more_xor_guards,build_in_guard,old_guard_tests,gbif, + more_xor_guards,build_in_guard, + old_guard_tests,complex_guard,gbif, t_is_boolean,is_function_2,tricky, rel_ops,rel_op_combinations, literal_type_tests,basic_andalso_orelse,traverse_dcd, @@ -947,6 +948,26 @@ og(_) -> what. on(V) when number(V) -> number; on(_) -> not_number. +complex_guard(_Config) -> + _ = [true = do_complex_guard(X, Y, Z) || + X <- [4,5], Y <- [4,5], Z <- [4,5]], + _ = [true = do_complex_guard(X, Y, Z) || + X <- [1,2,3], Y <- [1,2,3], Z <- [1,2,3]], + _ = [catch do_complex_guard(X, Y, Z) || + X <- [1,2,3,4,5], Y <- [0,6], Z <- [1,2,3,4,5]], + ok. + +do_complex_guard(X1, Y1, Z1) -> + if + ((X1 =:= 4) or (X1 =:= 5)) and + ((Y1 =:= 4) or (Y1 =:= 5)) and + ((Z1 =:= 4) or (Z1 =:= 5)) or + ((X1 =:= 1) or (X1 =:= 2) or (X1 =:= 3)) and + ((Y1 =:= 1) or (Y1 =:= 2) or (Y1 =:= 3)) and + ((Z1 =:= 1) or (Z1 =:= 2) or (Z1 =:= 3)) -> + true + end. + gbif(Config) when is_list(Config) -> error = gbif_1(1, {false,true}), ok = gbif_1(2, {false,true}), diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index dd0bcb4245..3cb49433ce 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -89,6 +89,18 @@ basic(Config) when is_list(Config) -> %% Filter expressions with andalso/orelse. "abc123" = alphanum("?abc123.;"), + %% Aliased patterns. + [] = [t || {C=D}={_,_} <- []], + [] = [X || {X,{Y}={X,X}} <- []], + [t] = [t || "a"++"b" = "ab" <- ["ab"]], + + %% Strange filter block. + [] = [{X,Y} || {X} <- [], begin Y = X, Y =:= X end], + [{a,a}] = [{X,Y} || {X} <- [{a}], begin Y = X, Y =:= X end], + + %% Not matching. + [] = [3 || {3=4} <- []], + %% Error cases. [] = [{xx,X} || X <- L0, element(2, X) == no_no_no], {'EXIT',_} = (catch [X || X <- L1, list_to_atom(X) == dum]), diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index f6a24b3211..92a9802cad 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -24,7 +24,7 @@ pmatch/1,mixed/1,aliases/1,match_in_call/1, untuplify/1,shortcut_boolean/1,letify_guard/1, selectify/1,underscore/1,match_map/1,map_vars_used/1, - coverage/1]). + coverage/1,grab_bag/1]). -include_lib("common_test/include/ct.hrl"). @@ -38,7 +38,8 @@ groups() -> [{p,[parallel], [pmatch,mixed,aliases,match_in_call,untuplify, shortcut_boolean,letify_guard,selectify, - underscore,match_map,map_vars_used,coverage]}]. + underscore,match_map,map_vars_used,coverage, + grab_bag]}]. init_per_suite(Config) -> @@ -93,9 +94,9 @@ mixit(X) -> 2 -> b; 3 -> 42; 4 -> 77; - 5 -> blurf; - 6 -> 87987987; - 7 -> {a,b,c} + 4+1 -> blurf; + 5+1 -> 87987987; + 6+1 -> {a,b,c} end of a -> glufs; b -> klafs; @@ -149,6 +150,9 @@ aliases(Config) when is_list(Config) -> none = mixed_aliases({a,42}), none = mixed_aliases(42), + %% Non-matching aliases. + {'EXIT',{{badmatch,42},_}} = (catch nomatch_alias(42)), + ok. str_alias(V) -> @@ -258,6 +262,10 @@ mixed_aliases(<<X:8>> = {a,X}) -> {c,X}; mixed_aliases([X] = <<X:8>>) -> {d,X}; mixed_aliases(_) -> none. +nomatch_alias(I) -> + {ok={A,B}} = id(I), + {A,B}. + %% OTP-7018. match_in_call(Config) when is_list(Config) -> @@ -465,4 +473,53 @@ coverage_2(2, b, x) -> ok. coverage_3([$a]++[]++"bc") -> ok. +grab_bag(_Config) -> + [_|T] = id([a,b,c]), + [b,c] = id(T), + + T1 = fun() -> + [_|_] = x + end, + {'EXIT',_} = (catch T1()), + + T2 = fun(A, B) -> + case {{element(1, A),element(2, B)}, + {element(2, A),element(2, B)}} of + {Same,Same} -> ok; + {{0,1},{up,X}} -> id(X); + {_,{X,_}} -> id(X) + end + end, + ok = T2({a,a,z,z}, {z,a,z}), + 1 = T2({0,up}, {zzz,1}), + y = T2({x,y}, {a,z,z}), + + %% OTP-5244. + L = [{stretch,0,0}, + {bad,[]}, + {bad,atom}, + {bad,0}, + {bad,16#AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA}, + {bad,16#555555555555555555555555555555555555555555555555555}], + ok = grab_bag_remove_failure(L, unit, 0), + + ok. + +grab_bag_remove_failure([], _Unit, _MaxFailure) -> + ok; +grab_bag_remove_failure([{bad,Bad}|_], _Unit, _MaxFailure) -> + Bad; +grab_bag_remove_failure([{stretch,_,Mi}=Stretch | Specs], Unit, _MaxFailure) -> + {MinMax,NewMaxFailure} = id({min,1}), + case {MinMax,grab_bag_remove_failure(Specs, Unit, NewMaxFailure)} of + {min,{NewMaxFailure,Rest}} -> + {done,[{fixed,Mi} | Rest]}; + {min,_} when Specs =/= [] -> + grab_bag_remove_failure([Stretch|tl(Specs)], Unit, NewMaxFailure); + {min,_} -> + ok + end. + + + id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 8f9ed685bf..f05fe6c943 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -23,7 +23,8 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, tobias/1,empty_string/1,md5/1,silly_coverage/1, - confused_literals/1,integer_encoding/1,override_bif/1]). + confused_literals/1,integer_encoding/0,integer_encoding/1, + override_bif/1]). -include_lib("common_test/include/ct.hrl"). diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl index 4f048f5080..5546765f26 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -28,7 +28,7 @@ init_per_testcase/2,end_per_testcase/2, errors/1,record_test_2/1,record_test_3/1,record_access_in_guards/1, guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1, - nested_access/1,coverage/1]). + nested_access/1,coverage/1,grab_bag/1]). init_per_testcase(_Case, Config) -> Config. @@ -48,7 +48,7 @@ groups() -> [{p,test_lib:parallel(), [errors,record_test_2,record_test_3, record_access_in_guards,guard_opt,eval_once,foobar, - missing_test_heap,nested_access,coverage]}]. + missing_test_heap,nested_access,coverage,grab_bag]}]. init_per_suite(Config) -> @@ -601,4 +601,60 @@ coverage(Config) when is_list(Config) -> #rr{a=1,b=2,c=42} = id(R), %Test for correctness. ok. + +-record(default_fun, {a = fun(X) -> X*X end}). + +%% compiler treats records with 1 and 2 fields differently... +-record(gb_nil, {}). +-record(gb_foo, {hello=1}). +-record(gb_bar, {hello=2,there=3}). + +%% Taken from compilation_SUITE. +grab_bag(_Config) -> + T1 = fun() -> + X = #foo{}, + Y = #foo{}, + {X#foo.a == Y#foo.a,X#foo.b} + end, + {true,undefined} = T1(), + + T2 = fun(X, Y) -> + first_arg(X#foo.a =/= Y#foo.a, X#foo.b =/= X#foo.b) + end, + true = T2(#foo{a=x,b=z}, #foo{a=y,b=z}), + + T3 = fun() -> + #default_fun{a=Fun} = id(#default_fun{}), + 9 = Fun(3) + end, + T3(), + + %% Stupid code, but the compiler used to crash. + T4 = fun() -> + F0 = fun() -> + R1 = #gb_nil{}, + R2 = R1#gb_nil{}, + R1 = R2 + end, + F1 = fun() -> + R1 = #gb_foo{}, + R2 = R1#gb_foo{}, + R1 = R2 + end, + + F2 = fun() -> + R1 = #gb_bar{}, + R2 = R1#gb_bar{}, + R1 = R2 + end, + F0(), + F1(), + F2() + end, + T4(), + + ok. + +first_arg(First, _) -> First. + id(I) -> I. diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 5e0bb6d00a..f7ad78cb8d 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -26,7 +26,7 @@ nested_of/1,nested_catch/1,nested_after/1, nested_horrid/1,last_call_optimization/1,bool/1, plain_catch_coverage/1,andalso_orelse/1,get_in_try/1, - hockey/1]). + hockey/1,handle_info/1,catch_in_catch/1,grab_bag/1]). -include_lib("common_test/include/ct.hrl"). @@ -42,7 +42,7 @@ groups() -> after_oops,eclectic,rethrow,nested_of,nested_catch, nested_after,nested_horrid,last_call_optimization, bool,plain_catch_coverage,andalso_orelse,get_in_try, - hockey]}]. + hockey,handle_info,catch_in_catch,grab_bag]}]. init_per_suite(Config) -> @@ -919,8 +919,6 @@ andalso_orelse_1(A, B) -> catched end,B}. -id(I) -> I. - andalso_orelse_2({Type,Keyval}) -> try if is_atom(Type) andalso length(Keyval) > 0 -> ok; @@ -957,3 +955,86 @@ hockey() -> receive _ -> (b = fun() -> ok end) + hockey, +x after 0 -> ok end, try (a = fun() -> ok end) + hockey, + y catch _ -> ok end. + + +-record(state, {foo}). + +handle_info(_Config) -> + do_handle_info({foo}, #state{}), + ok. + +do_handle_info({_}, State) -> + handle_info_ok(), + State#state{foo = bar}, + case ok of + _ -> + case catch handle_info_ok() of + ok -> + {stop, State} + end + end; +do_handle_info(_, State) -> + (catch begin + handle_info_ok(), + State#state{foo = bar} + end), + case ok of + _ -> + case catch handle_info_ok() of + ok -> + {stop, State} + end + end. + +handle_info_ok() -> ok. + +'catch_in_catch'(_Config) -> + process_flag(trap_exit, true), + Pid = spawn_link(fun() -> + catch_in_catch_init(x), + exit(good_exit) + end), + receive + {'EXIT',Pid,good_exit} -> + ok; + Other -> + io:format("Unexpected: ~p\n", [Other]), + error + after 32000 -> + io:format("No message received\n"), + error + end. + +'catch_in_catch_init'(Param) -> + process_flag(trap_exit, true), + %% The catches were improperly nested, causing a "No catch found" crash. + (catch begin + id(Param), + (catch exit(bar)) + end + ), + ignore. + +grab_bag(_Config) -> + %% Thanks to Martin Bjorklund. + _ = fun() -> ok end, + try + fun() -> ok end + after + fun({A, B}) -> A + B end + end, + + %% Thanks to Tim Rath. + A = {6}, + try + io:fwrite("") + after + fun () -> + fun () -> {_} = A end + end + end, + + ok. + + +id(I) -> I. diff --git a/lib/dialyzer/README b/lib/dialyzer/README index 82d0f5ec48..951a92469b 100644 --- a/lib/dialyzer/README +++ b/lib/dialyzer/README @@ -6,7 +6,7 @@ ## Copyright: Held by the authors; all rights reserved (2004 - 2010). ##---------------------------------------------------------------------------- -The DIALYZER, a DIscrepany AnaLYZer for ERlang programs. +The DIALYZER, a DIscrepancy AnaLYZer for ERlang programs. ----------------------------------------------- diff --git a/lib/dialyzer/doc/about.txt b/lib/dialyzer/doc/about.txt index 7d9d819731..1318d9a65e 100644 --- a/lib/dialyzer/doc/about.txt +++ b/lib/dialyzer/doc/about.txt @@ -1,5 +1,5 @@ This is DIALYZER version 2.1.0 - DIALYZER is a DIscrepany AnaLYZer for ERlang programs. + DIALYZER is a DIscrepancy AnaLYZer for ERlang programs. Copyright (C) Tobias Lindahl <[email protected]> Kostis Sagonas <[email protected]> diff --git a/lib/dialyzer/doc/manual.txt b/lib/dialyzer/doc/manual.txt index 29c9518d84..be1fd2f8bc 100644 --- a/lib/dialyzer/doc/manual.txt +++ b/lib/dialyzer/doc/manual.txt @@ -4,7 +4,7 @@ ## Kostis Sagonas <[email protected]> ##---------------------------------------------------------------------------- -The DIALYZER, a DIscrepany AnaLYZer for ERlang programs. +The DIALYZER, a DIscrepancy AnaLYZer for ERlang programs. ----------------------------------------------- diff --git a/lib/dialyzer/info b/lib/dialyzer/info index 9fba4b54ad..b9ea26b712 100644 --- a/lib/dialyzer/info +++ b/lib/dialyzer/info @@ -1,2 +1,2 @@ group: tools -short: The DIALYZER, a DIscrepany AnaLYZer for ERlang programs. +short: The DIALYZER, a DIscrepancy AnaLYZer for ERlang programs. diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index 003d7f2ba4..5b28f7ae86 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -47,6 +47,6 @@ {registered, []}, {applications, [compiler, hipe, kernel, stdlib, wx]}, {env, []}, - {runtime_dependencies, ["wx-1.2","syntax_tools-1.6.14","stdlib-2.5", - "kernel-3.0","hipe-3.13","erts-7.0", - "compiler-5.0"]}]}. + {runtime_dependencies, ["wx-1.2","syntax_tools-2.0","stdlib-3.0", + "kernel-5.0","hipe-3.15.1","erts-8.0", + "compiler-7.0"]}]}. diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index 9f51dfe356..bcac8afe64 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -336,6 +336,9 @@ message_to_string({guard_fail, []}) -> "Clause guard cannot succeed.\n"; message_to_string({guard_fail, [Arg1, Infix, Arg2]}) -> io_lib:format("Guard test ~s ~s ~s can never succeed\n", [Arg1, Infix, Arg2]); +message_to_string({map_update, [Type, Key]}) -> + io_lib:format("A key of type ~s cannot exist " + "in a map of type ~s\n", [Key, Type]); message_to_string({neg_guard_fail, [Arg1, Infix, Arg2]}) -> io_lib:format("Guard test not(~s ~s ~s) can never succeed\n", [Arg1, Infix, Arg2]); diff --git a/lib/dialyzer/src/dialyzer.hrl b/lib/dialyzer/src/dialyzer.hrl index 601e2e954b..ea6a71217c 100644 --- a/lib/dialyzer/src/dialyzer.hrl +++ b/lib/dialyzer/src/dialyzer.hrl @@ -60,6 +60,7 @@ -define(WARN_BEHAVIOUR, warn_behaviour). -define(WARN_UNDEFINED_CALLBACK, warn_undefined_callbacks). -define(WARN_UNKNOWN, warn_unknown). +-define(WARN_MAP_CONSTRUCTION, warn_map_construction). %% %% The following type has double role: @@ -75,7 +76,8 @@ | ?WARN_CONTRACT_SUPERTYPE | ?WARN_CALLGRAPH | ?WARN_UNMATCHED_RETURN | ?WARN_RACE_CONDITION | ?WARN_BEHAVIOUR | ?WARN_CONTRACT_RANGE - | ?WARN_UNDEFINED_CALLBACK | ?WARN_UNKNOWN. + | ?WARN_UNDEFINED_CALLBACK | ?WARN_UNKNOWN + | ?WARN_MAP_CONSTRUCTION. %% %% This is the representation of each warning as they will be returned diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index e03e4d5bb4..116260778c 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -210,10 +210,10 @@ check_contract(Contract, SuccType) -> check_contract(#contract{contracts = Contracts}, SuccType, Opaques) -> try - Contracts1 = [{Contract, insert_constraints(Constraints, dict:new())} + Contracts1 = [{Contract, insert_constraints(Constraints)} || {Contract, Constraints} <- Contracts], - Contracts2 = [erl_types:t_subst(Contract, Dict) - || {Contract, Dict} <- Contracts1], + Contracts2 = [erl_types:t_subst(Contract, Map) + || {Contract, Map} <- Contracts1], GenDomains = [erl_types:t_fun_args(C) || C <- Contracts2], case check_domains(GenDomains) of error -> @@ -277,28 +277,45 @@ check_extraneous_1(Contract, SuccType) -> case [CR || CR <- CRngs, erl_types:t_is_none(erl_types:t_inf(CR, STRng))] of [] -> - CRngList = list_part(CRng), - STRngList = list_part(STRng), - case is_not_nil_list(CRngList) andalso is_not_nil_list(STRngList) of - false -> ok; - true -> - CRngElements = erl_types:t_list_elements(CRngList), - STRngElements = erl_types:t_list_elements(STRngList), - Inf = erl_types:t_inf(CRngElements, STRngElements), - case erl_types:t_is_none(Inf) of - true -> {error, invalid_contract}; - false -> ok - end + case bad_extraneous_list(CRng, STRng) + orelse bad_extraneous_map(CRng, STRng) + of + true -> {error, invalid_contract}; + false -> ok end; CRs -> {error, {extra_range, erl_types:t_sup(CRs), STRng}} end. +bad_extraneous_list(CRng, STRng) -> + CRngList = list_part(CRng), + STRngList = list_part(STRng), + case is_not_nil_list(CRngList) andalso is_not_nil_list(STRngList) of + false -> false; + true -> + CRngElements = erl_types:t_list_elements(CRngList), + STRngElements = erl_types:t_list_elements(STRngList), + Inf = erl_types:t_inf(CRngElements, STRngElements), + erl_types:t_is_none(Inf) + end. + list_part(Type) -> erl_types:t_inf(erl_types:t_list(), Type). is_not_nil_list(Type) -> erl_types:t_is_list(Type) andalso not erl_types:t_is_nil(Type). +bad_extraneous_map(CRng, STRng) -> + CRngMap = map_part(CRng), + STRngMap = map_part(STRng), + (not is_empty_map(CRngMap)) andalso (not is_empty_map(STRngMap)) + andalso is_empty_map(erl_types:t_inf(CRngMap, STRngMap)). + +map_part(Type) -> + erl_types:t_inf(erl_types:t_map(), Type). + +is_empty_map(Type) -> + erl_types:t_is_equal(Type, erl_types:t_from_term(#{})). + %% This is the heart of the "range function" -spec process_contracts([contract_pair()], [erl_types:erl_type()]) -> erl_types:erl_type(). @@ -327,15 +344,15 @@ process_contract({Contract, Constraints}, CallTypes0) -> [erl_types:t_to_string(ContArgsFun), erl_types:t_to_string(CallTypesFun)]), case solve_constraints(ContArgsFun, CallTypesFun, Constraints) of - {ok, VarDict} -> - {ok, erl_types:t_subst(erl_types:t_fun_range(Contract), VarDict)}; + {ok, VarMap} -> + {ok, erl_types:t_subst(erl_types:t_fun_range(Contract), VarMap)}; error -> error end. solve_constraints(Contract, Call, Constraints) -> %% First make sure the call follows the constraints - CDict = insert_constraints(Constraints, dict:new()), - Contract1 = erl_types:t_subst(Contract, CDict), + CMap = insert_constraints(Constraints), + Contract1 = erl_types:t_subst(Contract, CMap), %% Just a safe over-approximation. %% TODO: Find the types for type variables properly ContrArgs = erl_types:t_fun_args(Contract1), @@ -343,7 +360,7 @@ solve_constraints(Contract, Call, Constraints) -> InfList = erl_types:t_inf_lists(ContrArgs, CallArgs), case erl_types:any_none_or_unit(InfList) of true -> error; - false -> {ok, CDict} + false -> {ok, CMap} end. %%Inf = erl_types:t_inf(Contract1, Call), %% Then unify with the constrained call type. @@ -373,23 +390,26 @@ warn_spec_missing_fun({M, F, A} = MFA, Contracts) -> {?WARN_CONTRACT_SYNTAX, WarningInfo, {spec_missing_fun, [M, F, A]}}. %% This treats the "when" constraints. It will be extended, we hope. -insert_constraints([{subtype, Type1, Type2}|Left], Dict) -> +insert_constraints(Constraints) -> + insert_constraints(Constraints, maps:new()). + +insert_constraints([{subtype, Type1, Type2}|Left], Map) -> case erl_types:t_is_var(Type1) of true -> Name = erl_types:t_var_name(Type1), - Dict1 = case dict:find(Name, Dict) of - error -> - dict:store(Name, Type2, Dict); - {ok, VarType} -> - dict:store(Name, erl_types:t_inf(VarType, Type2), Dict) - end, - insert_constraints(Left, Dict1); + Map1 = case maps:find(Name, Map) of + error -> + maps:put(Name, Type2, Map); + {ok, VarType} -> + maps:put(Name, erl_types:t_inf(VarType, Type2), Map) + end, + insert_constraints(Left, Map1); false -> %% A lot of things should change to add supertypes throw({error, io_lib:format("First argument of is_subtype constraint " "must be a type variable: ~p\n", [Type1])}) end; -insert_constraints([], Dict) -> Dict. +insert_constraints([], Map) -> Map. -type types() :: erl_types:type_table(). @@ -459,7 +479,7 @@ initialize_constraints([], _MFA, _RecDict, _ExpTypes, _AllRecords, Acc) -> initialize_constraints([Constr|Rest], MFA, RecDict, ExpTypes, AllRecords, Acc) -> case Constr of {type, _, constraint, [{atom, _, is_subtype}, [Type1, Type2]]} -> - T1 = final_form(Type1, ExpTypes, MFA, AllRecords, dict:new()), + T1 = final_form(Type1, ExpTypes, MFA, AllRecords, maps:new()), Entry = {T1, Type2}, initialize_constraints(Rest, MFA, RecDict, ExpTypes, AllRecords, [Entry|Acc]); {type, _, constraint, [{atom,_,Name}, List]} -> @@ -470,7 +490,7 @@ initialize_constraints([Constr|Rest], MFA, RecDict, ExpTypes, AllRecords, Acc) - constraints_fixpoint(Constrs, MFA, RecDict, ExpTypes, AllRecords) -> VarDict = - constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, dict:new()), + constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, maps:new()), constraints_fixpoint(VarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords). constraints_fixpoint(OldVarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords) -> @@ -482,7 +502,7 @@ constraints_fixpoint(OldVarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords) -> fun(Key, Value, Acc) -> [{subtype, erl_types:t_var(Key), Value}|Acc] end, - FinalConstrs = dict:fold(DictFold, [], NewVarDict), + FinalConstrs = maps:fold(DictFold, [], NewVarDict), {FinalConstrs, NewVarDict}; _Other -> constraints_fixpoint(NewVarDict, MFA, Constrs, RecDict, ExpTypes, AllRecords) @@ -492,7 +512,7 @@ final_form(Form, ExpTypes, MFA, AllRecords, VarDict) -> from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarDict). from_form_with_check(Form, ExpTypes, MFA, AllRecords) -> - from_form_with_check(Form, ExpTypes, MFA, AllRecords, dict:new()). + from_form_with_check(Form, ExpTypes, MFA, AllRecords, maps:new()). from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarDict) -> Site = {spec, MFA}, @@ -503,7 +523,7 @@ from_form_with_check(Form, ExpTypes, MFA, AllRecords, VarDict) -> constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, AllRecords, VarDict) -> Subtypes = constraints_to_subs(Constrs, MFA, RecDict, ExpTypes, AllRecords, VarDict, []), - insert_constraints(Subtypes, dict:new()). + insert_constraints(Subtypes). constraints_to_subs([], _MFA, _RecDict, _ExpTypes, _AllRecords, _VarDict, Acc) -> Acc; @@ -588,8 +608,8 @@ general_domain(List) -> general_domain(List, erl_types:t_none()). general_domain([{Sig, Constraints}|Left], AccSig) -> - Dict = insert_constraints(Constraints, dict:new()), - Sig1 = erl_types:t_subst(Sig, Dict), + Map = insert_constraints(Constraints), + Sig1 = erl_types:t_subst(Sig, Map), general_domain(Left, erl_types:t_sup(AccSig, Sig1)); general_domain([], AccSig) -> %% Get rid of all variables in the domain. diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 6e49043551..5ab0c39c04 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -43,7 +43,6 @@ -include("dialyzer.hrl"). -%%-import(helper, %% 'helper' could be any module doing sanity checks... -import(erl_types, [t_inf/2, t_inf/3, t_inf_lists/2, t_inf_lists/3, t_inf_lists/3, t_is_equal/2, t_is_subtype/2, t_subtract/2, @@ -72,7 +71,7 @@ t_tuple/0, t_tuple/1, t_tuple_args/1, t_tuple_args/2, t_tuple_subtypes/2, t_unit/0, t_unopaque/2, - t_map/1 + t_map/0, t_map/1, t_is_singleton/2 ]). %%-define(DEBUG, true). @@ -126,8 +125,8 @@ curr_fun :: curr_fun() }). --record(map, {dict = dict:new() :: type_tab(), - subst = dict:new() :: subst_tab(), +-record(map, {map = maps:new() :: type_tab(), + subst = maps:new() :: subst_tab(), modified = [] :: [Key :: term()], modified_stack = [] :: [{[Key :: term()],reference()}], ref = undefined :: reference() | undefined}). @@ -135,10 +134,10 @@ -type env_tab() :: dict:dict(label(), #map{}). -type fun_entry() :: {Args :: [type()], RetType :: type()}. -type fun_tab() :: dict:dict('top' | label(), - {'not_handled', fun_entry()} | fun_entry()). + {'not_handled', fun_entry()} | fun_entry()). -type key() :: label() | cerl:cerl(). --type type_tab() :: dict:dict(key(), type()). --type subst_tab() :: dict:dict(key(), cerl:cerl()). +-type type_tab() :: #{key() => type()}. +-type subst_tab() :: #{key() => cerl:cerl()}. %% Exported Types @@ -342,8 +341,6 @@ traverse(Tree, Map, State) -> handle_tuple(Tree, Map, State); map -> handle_map(Tree, Map, State); - map_pair -> - handle_map_pair(Tree, Map, State); values -> Elements = cerl:values_es(Tree), {State1, Map1, EsType} = traverse_list(Elements, Map, State), @@ -1102,15 +1099,54 @@ handle_try(Tree, Map, State) -> %%---------------------------------------- handle_map(Tree,Map,State) -> - Pairs = cerl:map_es(Tree), - {State1, Map1, TypePairs} = traverse_list(Pairs,Map,State), - {State1, Map1, t_map(TypePairs)}. + Pairs = cerl:map_es(Tree), + Arg = cerl:map_arg(Tree), + {State1, Map1, ArgType} = traverse(Arg, Map, State), + ArgType1 = t_inf(t_map(), ArgType), + case t_is_none_or_unit(ArgType1) of + true -> + {State1, Map1, ArgType1}; + false -> + {State2, Map2, TypePairs, ExactKeys} = + traverse_map_pairs(Pairs, Map1, State1, t_none(), [], []), + InsertPair = fun({KV,assoc,_},Acc) -> erl_types:t_map_put(KV,Acc); + ({KV,exact,KVTree},Acc) -> + case t_is_none(T=erl_types:t_map_update(KV,Acc)) of + true -> throw({none, Acc, KV, KVTree}); + false -> T + end + end, + try lists:foldl(InsertPair, ArgType1, TypePairs) + of ResT -> + BindT = t_map([{K, t_any()} || K <- ExactKeys]), + case bind_pat_vars_reverse([Arg], [BindT], [], Map2, State2) of + {error, _, _, _, _} -> {State2, Map2, ResT}; + {Map3, _} -> {State2, Map3, ResT} + end + catch {none, MapType, {K,_}, KVTree} -> + Msg2 = {map_update, [format_type(MapType, State2), + format_type(K, State2)]}, + {state__add_warning(State2, ?WARN_MAP_CONSTRUCTION, KVTree, Msg2), + Map2, t_none()} + end + end. -handle_map_pair(Tree,Map,State) -> - Key = cerl:map_pair_key(Tree), - Val = cerl:map_pair_val(Tree), +traverse_map_pairs([], Map, State, _ShadowKeys, PairAcc, KeyAcc) -> + {State, Map, lists:reverse(PairAcc), KeyAcc}; +traverse_map_pairs([Pair|Pairs], Map, State, ShadowKeys, PairAcc, KeyAcc) -> + Key = cerl:map_pair_key(Pair), + Val = cerl:map_pair_val(Pair), + Op = cerl:map_pair_op(Pair), {State1, Map1, [K,V]} = traverse_list([Key,Val],Map,State), - {State1, Map1, {K,V}}. + KeyAcc1 = + case cerl:is_literal(Op) andalso cerl:concrete(Op) =:= exact andalso + t_is_singleton(K, State#state.opaques) andalso + t_is_none(t_inf(ShadowKeys, K)) of + true -> [K|KeyAcc]; + false -> KeyAcc + end, + traverse_map_pairs(Pairs, Map1, State1, t_sup(K, ShadowKeys), + [{{K,V},cerl:concrete(Op),Pair}|PairAcc], KeyAcc1). %%---------------------------------------- @@ -1445,7 +1481,9 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> {NewMap, TypeOut} = case cerl:type(Pat) of alias -> - AliasPat = cerl:alias_pat(Pat), + %% Map patterns are more allowing than the type of their literal. We + %% must unfold AliasPat if it is a literal. + AliasPat = dialyzer_utils:refold_pattern(cerl:alias_pat(Pat)), Var = cerl:alias_var(Pat), Map1 = enter_subst(Var, AliasPat, Map), {Map2, [PatType]} = bind_pat_vars([AliasPat], [Type], [], @@ -1486,14 +1524,59 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> {Map1, t_cons(HdType, TlType)} end; literal -> - Literal = literal_type(Pat), - case t_is_none(t_inf(Literal, Type, Opaques)) of + Pat0 = dialyzer_utils:refold_pattern(Pat), + case cerl:is_literal(Pat0) of true -> - bind_opaque_pats(Literal, Type, Pat, State); - false -> {Map, Literal} + Literal = literal_type(Pat), + case t_is_none(t_inf(Literal, Type, Opaques)) of + true -> + bind_opaque_pats(Literal, Type, Pat, State); + false -> {Map, Literal} + end; + false -> + %% Retry with the unfolded pattern + {Map1, [PatType]} + = bind_pat_vars([Pat0], [Type], [], Map, State, Rev), + {Map1, PatType} end; map -> - {Map, t_map([])}; + MapT = t_inf(Type, t_map(), Opaques), + case t_is_none(MapT) of + true -> + bind_opaque_pats(t_map(), Type, Pat, State); + false -> + case Rev of + %% TODO: Reverse matching (propagating a matched subset back to a value) + true -> {Map, MapT}; + false -> + FoldFun = + fun(Pair, {MapAcc, ListAcc}) -> + %% Only exact (:=) can appear in patterns + exact = cerl:concrete(cerl:map_pair_op(Pair)), + Key = cerl:map_pair_key(Pair), + KeyType = + case cerl:type(Key) of + var -> + case state__lookup_type_for_letrec(Key, State) of + error -> lookup_type(Key, MapAcc); + {ok, RecType} -> RecType + end; + literal -> + literal_type(Key) + end, + Bind = erl_types:t_map_get(KeyType, MapT), + {MapAcc1, [ValType]} = + bind_pat_vars([cerl:map_pair_val(Pair)], + [Bind], [], MapAcc, State, Rev), + case t_is_singleton(KeyType, Opaques) of + true -> {MapAcc1, [{KeyType, ValType}|ListAcc]}; + false -> {MapAcc1, ListAcc} + end + end, + {Map1, Pairs} = lists:foldl(FoldFun, {Map, []}, cerl:map_es(Pat)), + {Map1, t_inf(MapT, t_map(Pairs))} + end + end; tuple -> Es = cerl:tuple_es(Pat), {TypedRecord, Prototype} = @@ -1682,7 +1765,7 @@ bind_opaque_pats(GenType, Type, Pat, State) -> %% bind_guard(Guard, Map, State) -> - try bind_guard(Guard, Map, dict:new(), pos, State) of + try bind_guard(Guard, Map, maps:new(), pos, State) of {Map1, _Type} -> Map1 catch throw:{fail, Warning} -> {error, Warning}; @@ -1710,20 +1793,63 @@ bind_guard(Guard, Map, Env, Eval, State) -> 'try' -> Arg = cerl:try_arg(Guard), [Var] = cerl:try_vars(Guard), + EVars = cerl:try_evars(Guard), %%?debug("Storing: ~w\n", [Var]), - NewEnv = dict:store(get_label(Var), Arg, Env), - bind_guard(cerl:try_body(Guard), Map, NewEnv, Eval, State); + Map1 = join_maps_begin(Map), + Map2 = mark_as_fresh(EVars, Map1), + %% Visit handler first so we know if it should be ignored + {{HandlerMap, HandlerType}, HandlerE} = + try {bind_guard(cerl:try_handler(Guard), Map2, Env, Eval, State), none} + catch throw:HE -> + {{Map2, t_none()}, HE} + end, + BodyEnv = maps:put(get_label(Var), Arg, Env), + Wanted = case Eval of pos -> t_atom(true); neg -> t_atom(false); + dont_know -> t_any() end, + case t_is_none(t_inf(HandlerType, Wanted)) of + %% Handler won't save us; pretend it does not exist + true -> bind_guard(cerl:try_body(Guard), Map, BodyEnv, Eval, State); + false -> + {{BodyMap, BodyType}, BodyE} = + try {bind_guard(cerl:try_body(Guard), Map1, BodyEnv, + Eval, State), none} + catch throw:BE -> + {{Map1, t_none()}, BE} + end, + Map3 = join_maps_end([BodyMap, HandlerMap], Map1), + case t_is_none(Sup = t_sup(BodyType, HandlerType)) of + true -> + %% Pick a reason. N.B. We assume that the handler is always + %% compiler-generated if the body is; that way, we won't need to + %% check. + Fatality = case {BodyE, HandlerE} of + {{fatal_fail, _}, _} -> fatal_fail; + {_, {fatal_fail, _}} -> fatal_fail; + _ -> fail + end, + throw({Fatality, + case {BodyE, HandlerE} of + {{_, Rsn}, _} when Rsn =/= none -> Rsn; + {_, {_,Rsn}} -> Rsn; + _ -> none + end}); + false -> {Map3, Sup} + end + end; tuple -> Es0 = cerl:tuple_es(Guard), {Map1, Es} = bind_guard_list(Es0, Map, Env, dont_know, State), {Map1, t_tuple(Es)}; map -> - {Map, t_map([])}; + case Eval of + dont_know -> handle_guard_map(Guard, Map, Env, State); + _PosOrNeg -> {Map, t_none()} %% Map exprs do not produce bools + end; 'let' -> Arg = cerl:let_arg(Guard), [Var] = cerl:let_vars(Guard), %%?debug("Storing: ~w\n", [Var]), - NewEnv = dict:store(get_label(Var), Arg, Env), + NewEnv = maps:put(get_label(Var), Arg, Env), bind_guard(cerl:let_body(Guard), Map, NewEnv, Eval, State); values -> Es = cerl:values_es(Guard), @@ -1732,7 +1858,7 @@ bind_guard(Guard, Map, Env, Eval, State) -> {Map, Type}; var -> ?debug("Looking for var(~w)...", [cerl_trees:get_label(Guard)]), - case dict:find(get_label(Guard), Env) of + case maps:find(get_label(Guard), Env) of error -> ?debug("Did not find it\n", []), Type = lookup_type(Guard, Map), @@ -1761,7 +1887,7 @@ handle_guard_call(Guard, Map, Env, Eval, State) -> {erlang, F, 1} when F =:= is_atom; F =:= is_boolean; F =:= is_binary; F =:= is_bitstring; F =:= is_float; F =:= is_function; - F =:= is_integer; F =:= is_list; + F =:= is_integer; F =:= is_list; F =:= is_map; F =:= is_number; F =:= is_pid; F =:= is_port; F =:= is_reference; F =:= is_tuple -> handle_guard_type_test(Guard, F, Map, Env, Eval, State); @@ -1841,6 +1967,7 @@ bind_type_test(Eval, TypeTest, ArgType, State) -> is_function -> t_fun(); is_integer -> t_integer(); is_list -> t_maybe_improper_list(); + is_map -> t_map(); is_number -> t_number(); is_pid -> t_pid(); is_port -> t_port(); @@ -2349,6 +2476,30 @@ bind_guard_list([G|Gs], Map, Env, Eval, State, Acc) -> bind_guard_list([], Map, _Env, _Eval, _State, Acc) -> {Map, lists:reverse(Acc)}. +handle_guard_map(Guard, Map, Env, State) -> + Pairs = cerl:map_es(Guard), + Arg = cerl:map_arg(Guard), + {Map1, ArgType0} = bind_guard(Arg, Map, Env, dont_know, State), + ArgType1 = t_inf(t_map(), ArgType0), + case t_is_none_or_unit(ArgType1) of + true -> {Map1, t_none()}; + false -> + {Map2, TypePairs} = bind_guard_map_pairs(Pairs, Map1, Env, State, []), + {Map2, lists:foldl(fun({KV,assoc},Acc) -> erl_types:t_map_put(KV,Acc); + ({KV,exact},Acc) -> erl_types:t_map_update(KV,Acc) + end, ArgType1, TypePairs)} + end. + +bind_guard_map_pairs([], Map, _Env, _State, PairAcc) -> + {Map, lists:reverse(PairAcc)}; +bind_guard_map_pairs([Pair|Pairs], Map, Env, State, PairAcc) -> + Key = cerl:map_pair_key(Pair), + Val = cerl:map_pair_val(Pair), + Op = cerl:map_pair_op(Pair), + {Map1, [K,V]} = bind_guard_list([Key,Val],Map,Env,dont_know,State), + bind_guard_map_pairs(Pairs, Map1, Env, State, + [{{K,V},cerl:concrete(Op)}|PairAcc]). + -type eval() :: 'pos' | 'neg' | 'dont_know'. -spec signal_guard_fail(eval(), cerl:c_call(), [type()], @@ -2421,7 +2572,9 @@ filter_fail_clauses([Clause|Left]) -> case (cerl:clause_pats(Clause) =:= []) of true -> Body = cerl:clause_body(Clause), - case cerl:is_literal(Body) andalso (cerl:concrete(Body) =:= fail) of + case cerl:is_literal(Body) andalso (cerl:concrete(Body) =:= fail) orelse + cerl:is_c_primop(Body) andalso + (cerl:atom_val(cerl:primop_name(Body)) =:= match_fail) of true -> filter_fail_clauses(Left); false -> [Clause|filter_fail_clauses(Left)] end; @@ -2535,10 +2688,10 @@ join_maps_end(Maps, MapOut) -> #map{ref = Ref, modified_stack = [{M1,R1} | S]} = MapOut, true = lists:all(fun(M) -> M#map.ref =:= Ref end, Maps), % sanity Keys0 = lists:usort(lists:append([M#map.modified || M <- Maps])), - #map{dict = Dict, subst = Subst} = MapOut, + #map{map = Map, subst = Subst} = MapOut, Keys = [Key || Key <- Keys0, - dict:is_key(Key, Dict) orelse dict:is_key(Key, Subst)], + maps:is_key(Key, Map) orelse maps:is_key(Key, Subst)], Out = case Maps of [] -> join_maps(Maps, MapOut); _ -> join_maps(Keys, Maps, MapOut) @@ -2549,8 +2702,8 @@ join_maps_end(Maps, MapOut) -> modified_stack = S}. join_maps(Maps, MapOut) -> - #map{dict = Dict, subst = Subst} = MapOut, - Keys = ordsets:from_list(dict:fetch_keys(Dict) ++ dict:fetch_keys(Subst)), + #map{map = Map, subst = Subst} = MapOut, + Keys = ordsets:from_list(maps:keys(Map) ++ maps:keys(Subst)), join_maps(Keys, Maps, MapOut). join_maps(Keys, Maps, MapOut) -> @@ -2579,11 +2732,11 @@ join_maps_one_key([], _Key, AccType) -> -ifdef(DEBUG). debug_join_check(Maps, MapOut, Out) -> - #map{dict = Dict, subst = Subst} = Out, - #map{dict = Dict2, subst = Subst2} = join_maps(Maps, MapOut), - F = fun(D) -> lists:keysort(1, dict:to_list(D)) end, + #map{map = Map, subst = Subst} = Out, + #map{map = Map2, subst = Subst2} = join_maps(Maps, MapOut), + F = fun(D) -> lists:keysort(1, maps:to_list(D)) end, [throw({bug, join_maps}) || - F(Dict) =/= F(Dict2) orelse F(Subst) =/= F(Subst2)]. + F(Map) =/= F(Map2) orelse F(Subst) =/= F(Subst2)]. -else. debug_join_check(_Maps, _MapOut, _Out) -> ok. -endif. @@ -2614,15 +2767,15 @@ enter_type(Key, Val, MS) -> enter_type_lists(Keys, t_to_tlist(Val), MS) end; false -> - #map{dict = Dict, subst = Subst} = MS, + #map{map = Map, subst = Subst} = MS, KeyLabel = get_label(Key), - case dict:find(KeyLabel, Subst) of + case maps:find(KeyLabel, Subst) of {ok, NewKey} -> ?debug("Binding ~p to ~p\n", [KeyLabel, NewKey]), enter_type(NewKey, Val, MS); error -> ?debug("Entering ~p :: ~s\n", [KeyLabel, t_to_string(Val)]), - case dict:find(KeyLabel, Dict) of + case maps:find(KeyLabel, Map) of {ok, Value} -> case erl_types:t_is_equal(Val, Value) of true -> MS; @@ -2634,13 +2787,14 @@ enter_type(Key, Val, MS) -> end end. -store_map(Key, Val, #map{dict = Dict, ref = undefined} = Map) -> - Map#map{dict = dict:store(Key, Val, Dict)}; -store_map(Key, Val, #map{dict = Dict, modified = Mod} = Map) -> - Map#map{dict = dict:store(Key, Val, Dict), modified = [Key | Mod]}. +store_map(Key, Val, #map{map = Map, ref = undefined} = MapRec) -> + MapRec#map{map = maps:put(Key, Val, Map)}; +store_map(Key, Val, #map{map = Map, modified = Mod} = MapRec) -> + MapRec#map{map = maps:put(Key, Val, Map), modified = [Key | Mod]}. -enter_subst(Key, Val, #map{subst = Subst} = MS) -> +enter_subst(Key, Val0, #map{subst = Subst} = MS) -> KeyLabel = get_label(Key), + Val = dialyzer_utils:refold_pattern(Val0), case cerl:is_literal(Val) of true -> store_map(KeyLabel, literal_type(Val), MS); @@ -2649,7 +2803,7 @@ enter_subst(Key, Val, #map{subst = Subst} = MS) -> false -> MS; true -> ValLabel = get_label(Val), - case dict:find(ValLabel, Subst) of + case maps:find(ValLabel, Subst) of {ok, NewVal} -> enter_subst(Key, NewVal, MS); error -> @@ -2663,22 +2817,22 @@ enter_subst(Key, Val, #map{subst = Subst} = MS) -> end. store_subst(Key, Val, #map{subst = S, ref = undefined} = Map) -> - Map#map{subst = dict:store(Key, Val, S)}; + Map#map{subst = maps:put(Key, Val, S)}; store_subst(Key, Val, #map{subst = S, modified = Mod} = Map) -> - Map#map{subst = dict:store(Key, Val, S), modified = [Key | Mod]}. + Map#map{subst = maps:put(Key, Val, S), modified = [Key | Mod]}. -lookup_type(Key, #map{dict = Dict, subst = Subst}) -> - lookup(Key, Dict, Subst, t_none()). +lookup_type(Key, #map{map = Map, subst = Subst}) -> + lookup(Key, Map, Subst, t_none()). -lookup(Key, Dict, Subst, AnyNone) -> +lookup(Key, Map, Subst, AnyNone) -> case cerl:is_literal(Key) of true -> literal_type(Key); false -> Label = get_label(Key), - case dict:find(Label, Subst) of - {ok, NewKey} -> lookup(NewKey, Dict, Subst, AnyNone); + case maps:find(Label, Subst) of + {ok, NewKey} -> lookup(NewKey, Map, Subst, AnyNone); error -> - case dict:find(Label, Dict) of + case maps:find(Label, Map) of {ok, Val} -> Val; error -> AnyNone end @@ -2703,6 +2857,9 @@ mark_as_fresh([Tree|Left], Map) -> bitstr -> %% The Size field is not fresh. {SubTrees1 -- [cerl:bitstr_size(Tree)], Map}; + map_pair -> + %% The keys are not fresh + {SubTrees1 -- [cerl:map_pair_key(Tree)], Map}; var -> {SubTrees1, enter_type(Tree, t_any(), Map)}; _ -> @@ -2713,12 +2870,12 @@ mark_as_fresh([], Map) -> Map. -ifdef(DEBUG). -debug_pp_map(#map{dict = Dict}=Map) -> - Keys = dict:fetch_keys(Dict), +debug_pp_map(#map{map = Map}=MapRec) -> + Keys = maps:keys(Map), io:format("Map:\n", []), lists:foreach(fun (Key) -> io:format("\t~w :: ~s\n", - [Key, t_to_string(lookup_type(Key, Map))]) + [Key, t_to_string(lookup_type(Key, MapRec))]) end, Keys), ok. -else. diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl index 9f344d87ff..30d2bdeca4 100644 --- a/lib/dialyzer/src/dialyzer_gui_wx.erl +++ b/lib/dialyzer/src/dialyzer_gui_wx.erl @@ -422,7 +422,7 @@ gui_loop(#gui_state{backend_pid = BackendPid, doc_plt = DocPlt, #wx{id=?menuID_HELP_ABOUT, obj=Frame, event=#wxCommand{type=command_menu_selected}} -> Message = " This is DIALYZER version " ++ ?VSN ++ " \n"++ - "DIALYZER is a DIscrepany AnaLYZer for ERlang programs.\n\n"++ + "DIALYZER is a DIscrepancy AnaLYZer for ERlang programs.\n\n"++ " Copyright (C) Tobias Lindahl <[email protected]>\n"++ " Kostis Sagonas <[email protected]>\n\n", output_sms(State, "About Dialyzer", Message, info), diff --git a/lib/dialyzer/src/dialyzer_options.erl b/lib/dialyzer/src/dialyzer_options.erl index dd81dd01ed..add660eae9 100644 --- a/lib/dialyzer/src/dialyzer_options.erl +++ b/lib/dialyzer/src/dialyzer_options.erl @@ -47,6 +47,7 @@ build(Opts) -> ?WARN_CALLGRAPH, ?WARN_FAILING_CALL, ?WARN_BIN_CONSTRUCTION, + ?WARN_MAP_CONSTRUCTION, ?WARN_CONTRACT_RANGE, ?WARN_CONTRACT_TYPES, ?WARN_CONTRACT_SYNTAX, diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 5f0881bbcd..1787b66192 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -48,6 +48,7 @@ t_is_float/1, t_is_fun/1, t_is_integer/1, t_non_neg_integer/0, t_is_list/1, t_is_nil/1, t_is_none/1, t_is_number/1, + t_is_singleton/1, t_limit/2, t_list/0, t_list/1, t_list_elements/1, t_nonempty_list/1, t_maybe_improper_list/0, @@ -57,7 +58,7 @@ t_timeout/0, t_tuple/0, t_tuple/1, t_var/1, t_var_name/1, t_none/0, t_unit/0, - t_map/1 + t_map/0, t_map/1, t_map_get/2, t_map_put/2 ]). -include("dialyzer.hrl"). @@ -65,9 +66,11 @@ %%----------------------------------------------------------------------------- -type dep() :: integer(). %% type variable names used as constraint ids +-type deps() :: ordsets:ordset(dep()). + -type type_var() :: erl_types:erl_type(). %% actually: {'c','var',_,_} --record(fun_var, {'fun' :: fun((_) -> erl_types:erl_type()), deps :: [dep()], +-record(fun_var, {'fun' :: fun((_) -> erl_types:erl_type()), deps :: deps(), origin :: integer() | 'undefined'}). -type constr_op() :: 'eq' | 'sub'. @@ -76,20 +79,21 @@ -record(constraint, {lhs :: erl_types:erl_type(), op :: constr_op(), rhs :: fvar_or_type(), - deps :: [dep()]}). + deps :: deps()}). -type constraint() :: #constraint{}. +-type mask() :: ordsets:ordset(non_neg_integer()). + -record(constraint_list, {type :: 'conj' | 'disj', list :: [constr()], - deps :: [dep()], - masks = [] :: [{dep(),[non_neg_integer()]}] | - {'d',dict:dict(dep(), [non_neg_integer()])}, + deps :: deps(), + masks = maps:new() :: #{dep() => mask()}, id :: {'list', dep()} | 'undefined'}). -type constraint_list() :: #constraint_list{}. --record(constraint_ref, {id :: type_var(), deps :: [dep()]}). +-record(constraint_ref, {id :: type_var(), deps :: deps()}). -type constraint_ref() :: #constraint_ref{}. @@ -98,34 +102,33 @@ -type types() :: erl_types:type_table(). -type typesig_scc() :: [{mfa(), {cerl:c_var(), cerl:c_fun()}, types()}]. --type typesig_funmap() :: [{type_var(), type_var()}]. %% Orddict +-type typesig_funmap() :: #{type_var() => type_var()}. -type prop_types() :: dict:dict(label(), types()). --type dict_or_ets() :: {'d', prop_types()} | {'e', ets:tid()}. - --record(state, {callgraph :: dialyzer_callgraph:callgraph() - | 'undefined', - cs = [] :: [constr()], - cmap = {'d', dict:new()} :: dict_or_ets(), - fun_map = [] :: typesig_funmap(), - fun_arities = dict:new() :: dict:dict(type_var(), arity()), - in_match = false :: boolean(), - in_guard = false :: boolean(), - module :: module(), - name_map = dict:new() :: dict:dict(mfa(), - cerl:c_fun()), - next_label = 0 :: label(), - self_rec :: 'false' | erl_types:erl_type(), - plt :: dialyzer_plt:plt() - | 'undefined', - prop_types = {'d', dict:new()} :: dict_or_ets(), - records = dict:new() :: types(), - scc = [] :: [type_var()], - mfas :: [tuple()], - solvers = [] :: [solver()] +-record(state, {callgraph :: dialyzer_callgraph:callgraph() + | 'undefined', + cs = [] :: [constr()], + cmap = maps:new() :: #{type_var() => constr()}, + fun_map = maps:new() :: typesig_funmap(), + fun_arities = maps:new() :: #{type_var() => arity()}, + in_match = false :: boolean(), + in_guard = false :: boolean(), + module :: module(), + name_map = maps:new() :: #{mfa() => cerl:c_fun()}, + next_label = 0 :: label(), + self_rec :: 'false' | erl_types:erl_type(), + plt :: dialyzer_plt:plt() + | 'undefined', + prop_types = dict:new() :: prop_types(), + records = dict:new() :: types(), + scc = [] :: ordsets:ordset(type_var()), + mfas :: [mfa()], + solvers = [] :: [solver()] }). +-type state() :: #state{}. + %%----------------------------------------------------------------------------- -define(TYPE_LIMIT, 4). @@ -187,7 +190,8 @@ analyze_scc(SCC, NextLabel, CallGraph, Plt, PropTypes, Solvers0) -> Funs = state__scc(State3), pp_constrs_scc(Funs, State3), constraints_to_dot_scc(Funs, State3), - solve(Funs, State3). + T = solve(Funs, State3), + dict:from_list(maps:to_list(T)). assert_format_of_scc([{_MFA, {_Var, _Fun}, _Records}|Left]) -> assert_format_of_scc(Left); @@ -311,7 +315,7 @@ traverse(Tree, DefinedVars, State) -> Hd = cerl:cons_hd(Tree), Tl = cerl:cons_tl(Tree), {State1, [HdVar, TlVar]} = traverse_list([Hd, Tl], DefinedVars, State), - case cerl:is_literal(cerl:fold_literal(Tree)) of + case cerl:is_literal(fold_literal_maybe_match(Tree, State)) of true -> %% We do not need to do anything more here. {State, t_cons(HdVar, TlVar)}; @@ -392,8 +396,18 @@ traverse(Tree, DefinedVars, State) -> {State2, _} = traverse_list(Funs, DefinedVars1, State1), traverse(Body, DefinedVars1, State2); literal -> - Type = t_from_term(cerl:concrete(Tree)), - {State, Type}; + %% Maps are special; a literal pattern matches more than just the value + %% constructed by the literal. For example #{} constructs the empty map, + %% but matches every map. + case state__is_in_match(State) of + true -> + Tree1 = dialyzer_utils:refold_pattern(Tree), + case cerl:is_literal(Tree1) of + false -> traverse(Tree1, DefinedVars, State); + true -> {State, t_from_term(cerl:concrete(Tree))} + end; + _ -> {State, t_from_term(cerl:concrete(Tree))} + end; module -> Defs = cerl:module_defs(Tree), Funs = [Fun || {_Var, Fun} <- Defs], @@ -437,7 +451,7 @@ traverse(Tree, DefinedVars, State) -> Elements = cerl:tuple_es(Tree), {State1, EVars} = traverse_list(Elements, DefinedVars, State), {State2, TupleType} = - case cerl:is_literal(cerl:fold_literal(Tree)) of + case cerl:is_literal(fold_literal_maybe_match(Tree, State1)) of true -> %% We do not need to do anything more here. {State, t_tuple(EVars)}; @@ -476,7 +490,111 @@ traverse(Tree, DefinedVars, State) -> [] -> {State2, TupleType} end; map -> - {State, t_map([])}; + Entries = cerl:map_es(Tree), + MapFoldFun = fun(Entry, AccState) -> + AccState1 = state__set_in_match(AccState, false), + {AccState2, KeyVar} = traverse(cerl:map_pair_key(Entry), + DefinedVars, AccState1), + AccState3 = state__set_in_match( + AccState2, state__is_in_match(AccState)), + {AccState4, ValVar} = traverse(cerl:map_pair_val(Entry), + DefinedVars, AccState3), + {{KeyVar, ValVar}, AccState4} + end, + {Pairs, State1} = lists:mapfoldl(MapFoldFun, State, Entries), + %% We mustn't recurse into map arguments to matches. Not only are they + %% syntactically only allowed to be the literal #{}, but that would also + %% cause an infinite recursion, since traverse/3 unfolds literals with + %% maps in them using dialyzer_utils:reflow_pattern/1. + {State2, ArgVar} = + case state__is_in_match(State) of + false -> traverse(cerl:map_arg(Tree), DefinedVars, State1); + true -> {State1, t_map()} + end, + MapVar = mk_var(Tree), + MapType = ?mk_fun_var( + fun(Map) -> + lists:foldl( + fun({K,V}, TypeAcc) -> + t_map_put({lookup_type(K, Map), + lookup_type(V, Map)}, + TypeAcc) + end, t_inf(t_map(), lookup_type(ArgVar, Map)), + Pairs) + end, [ArgVar | lists:append([[K,V] || {K,V} <- Pairs])]), + %% TODO: does the "same element appearing several times" problem apply + %% here too? + Fun = + fun({KeyVar, ValVar}, {AccState, ShadowKeys}) -> + %% If Val is known to be the last association of Key (i.e. Key + %% is not in ShadowKeys), Val must be a subtype of what is + %% associated to Key in Tree + TypeFun = + fun(Map) -> + KeyType = lookup_type(KeyVar, Map), + case t_is_singleton(KeyType) of + false -> t_any(); + true -> + MT = t_inf(lookup_type(MapVar, Map), t_map()), + case t_is_none(MT) of + true -> t_none(); + false -> + DisjointFromKeyType = + fun(ShadowKey) -> + t_is_none(t_inf(lookup_type(ShadowKey, Map), + KeyType)) + end, + case lists:all(DisjointFromKeyType, ShadowKeys) of + true -> t_map_get(KeyType, MT); + %% A later association might shadow this one + false -> t_any() + end + end + end + end, + ValType = ?mk_fun_var(TypeFun, [KeyVar, MapVar | ShadowKeys]), + {state__store_conj(ValVar, sub, ValType, AccState), + [KeyVar | ShadowKeys]} + end, + %% Accumulate shadowing keys right-to-left + {State3, _} = lists:foldr(Fun, {State2, []}, Pairs), + %% In a map expression, Arg must contain all keys that are inserted with + %% the exact (:=) operator, and are known (i.e. are not in ShadowedKeys) + %% to not have been introduced by a previous association + State4 = + case state__is_in_match(State) of + true -> State3; + false -> + ArgFun = + fun(Map) -> + FoldFun = + fun({{KeyVar, _}, Entry}, {AccType, ShadowedKeys}) -> + OpTree = cerl:map_pair_op(Entry), + KeyType = lookup_type(KeyVar, Map), + AccType1 = + case cerl:is_literal(OpTree) andalso + cerl:concrete(OpTree) =:= exact of + true -> + case t_is_none(t_inf(ShadowedKeys, KeyType)) of + true -> + t_map_put({KeyType, t_any()}, AccType); + false -> + AccType + end; + false -> + AccType + end, + {AccType1, t_sup(KeyType, ShadowedKeys)} + end, + %% Accumulate shadowed keys left-to-right + {ResType, _} = lists:foldl(FoldFun, {t_map(), t_none()}, + lists:zip(Pairs, Entries)), + ResType + end, + ArgType = ?mk_fun_var(ArgFun, [KeyVar || {KeyVar, _} <- Pairs]), + state__store_conj(ArgVar, sub, ArgType, State3) + end, + {state__store_conj(MapVar, sub, MapType, State4), MapVar}; values -> %% We can get into trouble when unifying products that have the %% same element appearing several times. Handle these cases by @@ -827,11 +945,11 @@ get_safe_underapprox(Pats, Guard) -> Map1 = cerl_trees:fold(fun(X, Acc) -> case cerl:is_c_var(X) of true -> - dict:store(cerl_trees:get_label(X), t_any(), - Acc); + maps:put(cerl_trees:get_label(X), t_any(), + Acc); false -> Acc end - end, dict:new(), cerl:c_values(Pats)), + end, maps:new(), cerl:c_values(Pats)), {Type, Map2} = get_underapprox_from_guard(Guard, Map1), Map3 = case t_is_none(t_inf(t_from_term(true), Type)) of true -> throw(dont_know); @@ -839,8 +957,8 @@ get_safe_underapprox(Pats, Guard) -> case cerl:is_c_var(Guard) of false -> Map2; true -> - dict:store(cerl_trees:get_label(Guard), - t_from_term(true), Map2) + maps:put(cerl_trees:get_label(Guard), + t_from_term(true), Map2) end end, {Ts, _Map4} = get_safe_underapprox_1(Pats, [], Map3), @@ -866,7 +984,7 @@ get_underapprox_from_guard(Tree, Map) -> case t_is_none(Inf) of true -> throw(dont_know); false -> - {True, dict:store(cerl_trees:get_label(Fun), Inf, Map1)} + {True, maps:put(cerl_trees:get_label(Fun), Inf, Map1)} end end; MFA -> @@ -882,7 +1000,7 @@ get_underapprox_from_guard(Tree, Map) -> case cerl:is_literal(Arg) of true -> {True, Map1}; false -> - {True, dict:store(cerl_trees:get_label(Arg), Inf, Map1)} + {True, maps:put(cerl_trees:get_label(Arg), Inf, Map1)} end end; error -> @@ -914,7 +1032,7 @@ get_underapprox_from_guard(Tree, Map) -> end; var -> Type = - case dict:find(cerl_trees:get_label(Tree), Map) of + case maps:find(cerl_trees:get_label(Tree), Map) of error -> throw(dont_know); {ok, T} -> T end, @@ -948,6 +1066,7 @@ get_type_test({erlang, is_float, 1}) -> {ok, t_float()}; get_type_test({erlang, is_function, 1}) -> {ok, t_fun()}; get_type_test({erlang, is_integer, 1}) -> {ok, t_integer()}; get_type_test({erlang, is_list, 1}) -> {ok, t_list()}; +get_type_test({erlang, is_map, 1}) -> {ok, t_map()}; get_type_test({erlang, is_number, 1}) -> {ok, t_number()}; get_type_test({erlang, is_pid, 1}) -> {ok, t_pid()}; get_type_test({erlang, is_port, 1}) -> {ok, t_port()}; @@ -1004,7 +1123,9 @@ bitstr_val_constr(SizeType, UnitVal, Flags) -> end end. -get_safe_underapprox_1([Pat|Left], Acc, Map) -> +get_safe_underapprox_1([Pat0|Left], Acc, Map) -> + %% Maps should be treated as patterns, not as literals + Pat = dialyzer_utils:refold_pattern(Pat0), case cerl:type(Pat) of alias -> APat = cerl:alias_pat(Pat), @@ -1015,7 +1136,7 @@ get_safe_underapprox_1([Pat|Left], Acc, Map) -> case t_is_none(Inf) of true -> throw(dont_know); false -> - Map3 = dict:store(cerl_trees:get_label(AVar), Inf, Map2), + Map3 = maps:put(cerl_trees:get_label(AVar), Inf, Map2), get_safe_underapprox_1(Left, [Inf|Acc], Map3) end; binary -> @@ -1048,15 +1169,42 @@ get_safe_underapprox_1([Pat|Left], Acc, Map) -> Type = t_tuple(Ts), get_safe_underapprox_1(Left, [Type|Acc], Map1); map -> - %% TODO: Can maybe do something here - throw(dont_know); + %% Some assertions in case the syntax gets more premissive in the future + true = #{} =:= cerl:concrete(cerl:map_arg(Pat)), + true = lists:all(fun(P) -> + cerl:is_literal(Op = cerl:map_pair_op(P)) andalso + exact =:= cerl:concrete(Op) + end, cerl:map_es(Pat)), + KeyTrees = lists:map(fun cerl:map_pair_key/1, cerl:map_es(Pat)), + ValTrees = lists:map(fun cerl:map_pair_val/1, cerl:map_es(Pat)), + %% Keys must not be underapproximated. Overapproximations are safe. + Keys = get_safe_overapprox(KeyTrees), + {Vals, Map1} = get_safe_underapprox_1(ValTrees, [], Map), + case lists:all(fun erl_types:t_is_singleton/1, Keys) of + false -> throw(dont_know); + true -> ok + end, + SortedPairs = lists:sort(lists:zip(Keys, Vals)), + %% We need to deal with duplicates ourselves + SquashDuplicates = + fun SquashDuplicates([{K,First},{K,Second}|List]) -> + case t_is_none(Inf = t_inf(First, Second)) of + true -> throw(dont_know); + false -> [{K, Inf}|SquashDuplicates(List)] + end; + SquashDuplicates([Good|Rest]) -> + [Good|SquashDuplicates(Rest)]; + SquashDuplicates([]) -> [] + end, + Type = t_map(SquashDuplicates(SortedPairs)), + get_safe_underapprox_1(Left, [Type|Acc], Map1); values -> Es = cerl:values_es(Pat), {Ts, Map1} = get_safe_underapprox_1(Es, [], Map), Type = t_product(Ts), get_safe_underapprox_1(Left, [Type|Acc], Map1); var -> - case dict:find(cerl_trees:get_label(Pat), Map) of + case maps:find(cerl_trees:get_label(Pat), Map) of error -> throw(dont_know); {ok, VarType} -> get_safe_underapprox_1(Left, [VarType|Acc], Map) end @@ -1064,6 +1212,15 @@ get_safe_underapprox_1([Pat|Left], Acc, Map) -> get_safe_underapprox_1([], Acc, Map) -> {lists:reverse(Acc), Map}. +get_safe_overapprox(Pats) -> + lists:map(fun get_safe_overapprox_1/1, Pats). + +get_safe_overapprox_1(Pat) -> + case cerl:is_literal(Lit = cerl:fold_literal(Pat)) of + true -> t_from_term(cerl:concrete(Lit)); + false -> t_any() + end. + %%---------------------------------------- %% Guards %% @@ -1263,6 +1420,8 @@ get_bif_constr({erlang, is_integer, 1}, Dst, [Arg], State) -> get_bif_test_constr(Dst, Arg, t_integer(), State); get_bif_constr({erlang, is_list, 1}, Dst, [Arg], State) -> get_bif_test_constr(Dst, Arg, t_maybe_improper_list(), State); +get_bif_constr({erlang, is_map, 1}, Dst, [Arg], State) -> + get_bif_test_constr(Dst, Arg, t_map(), State); get_bif_constr({erlang, is_number, 1}, Dst, [Arg], State) -> get_bif_test_constr(Dst, Arg, t_number(), State); get_bif_constr({erlang, is_pid, 1}, Dst, [Arg], State) -> @@ -1644,12 +1803,16 @@ solve([Fun], State) -> solve([_|_] = SCC, State) -> ?debug("============ Analyzing SCC: ~w ===========\n", [[debug_lookup_name(F) || F <- SCC]]), - {Parallel, NewState} = - case parallel_split(SCC) of - false -> {false, State}; - SplitSCC -> {SplitSCC, minimize_state(State)} - end, - solve_scc(SCC, Parallel, map_new(), NewState, false). + Users = comp_users(SCC, State), + solve_scc(SCC, map_new(), State, Users, _ToSolve=SCC, false). + +comp_users(SCC, State) -> + Vars0 = [{Fun, state__get_rec_var(Fun, State)} || Fun <- SCC], + Vars = lists:sort([t_var_name(Var) || {_, {ok, Var}} <- Vars0]), + family([{t_var(V), F} || + F <- SCC, + V <- ordsets:intersection(get_deps(state__get_cs(F, State)), + Vars)]). solve_fun(Fun, FunMap, State) -> Cs = state__get_cs(Fun, State), @@ -1664,7 +1827,7 @@ solve_fun(Fun, FunMap, State) -> end, enter_type(Fun, NewType, NewFunMap1). -solve_scc(SCC, Parallel, Map, State, TryingUnit) -> +solve_scc(SCC, Map, State, Users, ToSolve, TryingUnit) -> Vars0 = [{Fun, state__get_rec_var(Fun, State)} || Fun <- SCC], Vars = [Var || {_, {ok, Var}} <- Vars0], Funs = [Fun || {Fun, {ok, _}} <- Vars0], @@ -1672,16 +1835,13 @@ solve_scc(SCC, Parallel, Map, State, TryingUnit) -> RecTypes = [t_limit(Type, ?TYPE_LIMIT) || Type <- Types], CleanMap = lists:foldl(fun(Fun, AccFunMap) -> erase_type(t_var_name(Fun), AccFunMap) - end, Map, SCC), + end, Map, ToSolve), Map1 = enter_type_lists(Vars, RecTypes, CleanMap), ?debug("Checking SCC: ~w\n", [[debug_lookup_name(F) || F <- SCC]]), - FunSet = ordsets:from_list([t_var_name(F) || F <- SCC]), - Map2 = - case Parallel of - false -> solve_whole_scc(SCC, Map1, State); - SplitSCC -> solve_whole_scc_parallel(SplitSCC, Map1, State) - end, - case maps_are_equal(Map2, Map, FunSet) of + SolveFun = fun(X, Y) -> scc_fold_fun(X, Y, State) end, + Map2 = lists:foldl(SolveFun, Map1, ToSolve), + Updated = updated_vars_only(Vars, Map, Map2), + case Updated =:= [] of true -> ?debug("SCC ~w reached fixpoint\n", [SCC]), NewTypes = unsafe_lookup_type_list(Funs, Map2), @@ -1694,130 +1854,21 @@ solve_scc(SCC, Parallel, Map, State, TryingUnit) -> true -> t_fun(t_fun_args(T), t_unit()) end || T <- NewTypes], Map3 = enter_type_lists(Funs, UnitTypes, Map2), - solve_scc(SCC, Parallel, Map3, State, true); + solve_scc(SCC, Map3, State, Users, SCC, true); false -> - case Parallel of - false -> true; - _ -> dispose_state(State) - end, Map2 end; false -> ?debug("SCC ~w did not reach fixpoint\n", [SCC]), - solve_scc(SCC, Parallel, Map2, State, TryingUnit) - end. - -solve_whole_scc(SCC, Map, State) -> - SolveFun = fun(X, Y) -> scc_fold_fun(X, Y, State) end, - lists:foldl(SolveFun, Map, SCC). - -%%------------------------------------------------------------------------------ - --define(worth_it, 42). - -parallel_split(SCC) -> - Length = length(SCC), - case Length > 2*?worth_it of - false -> false; - true -> - case min(dialyzer_utils:parallelism(), 8) of - 1 -> false; - CPUs -> - FullShare = Length div CPUs + 1, - Unit = max(FullShare, ?worth_it), - split(SCC, Unit, []) - end - end. - -minimize_state(#state{ - cmap = {d, CMap}, - fun_map = FunMap, - fun_arities = FunArities, - self_rec = SelfRec, - prop_types = {d, PropTypes}, - solvers = Solvers - }) -> - Opts = [{read_concurrency, true}], - ETSCMap = ets:new(cmap, Opts), - ETSPropTypes = ets:new(prop_types, Opts), - true = ets:insert(ETSCMap, dict:to_list(CMap)), - true = ets:insert(ETSPropTypes, dict:to_list(PropTypes)), - #state - {cmap = {e, ETSCMap}, - fun_map = FunMap, - fun_arities = FunArities, - self_rec = SelfRec, - prop_types = {e, ETSPropTypes}, - solvers = Solvers, - callgraph = undefined, - plt = undefined, - mfas = [] - }. - -dispose_state(#state{cmap = {e, ETSCMap}, - prop_types = {e, ETSPropTypes}}) -> - true = ets:delete(ETSCMap), - true = ets:delete(ETSPropTypes). - -solve_whole_scc_parallel(SplitSCC, Map, State) -> - Workers = spawn_workers(SplitSCC, Map, State), - wait_results(Workers, Map, fold_res_fun(State)). - -spawn_workers(SplitSCC, Map, State) -> - Spawner = solve_scc_spawner(self(), Map, State), - lists:foreach(Spawner, SplitSCC), - length(SplitSCC). - -wait_results(0, Map, _FoldResFun) -> - Map; -wait_results(Pending, Map, FoldResFun) -> - Res = receive_scc_result(), - NewMap = lists:foldl(FoldResFun, Map, Res), - wait_results(Pending-1, NewMap, FoldResFun). - -solve_scc_spawner(Parent, Map, State) -> - fun(SCCPart) -> - spawn_link(fun() -> solve_scc_worker(Parent, SCCPart, Map, State) end) - end. - -split([], _Unit, Acc) -> - Acc; -split(List, Unit, Acc) -> - {Taken, Rest} = - try - lists:split(Unit, List) - catch - _:_ -> {List, []} - end, - split(Rest, Unit, [Taken|Acc]). - -solve_scc_worker(Parent, SCCPart, Map, State) -> - SolveFun = fun(X, Y) -> scc_fold_fun(X, Y, State) end, - FinalMap = lists:foldl(SolveFun, Map, SCCPart), - Res = - [{F, t_limit(unsafe_lookup_type(F, FinalMap), ?TYPE_LIMIT)} || - F <- SCCPart], - send_scc_result(Parent, Res). - -fold_res_fun(State) -> - fun({F, Type}, Map) -> - case state__get_rec_var(F, State) of - {ok, R} -> - enter_type(R, Type, enter_type(F, Type, Map)); - error -> - enter_type(F, Type, Map) - end + ToSolve1 = affected(Updated, Users), + solve_scc(SCC, Map2, State, Users, ToSolve1, TryingUnit) end. -receive_scc_result() -> - receive - {scc_fun, Res} -> Res - end. - -send_scc_result(Parent, Res) -> - Parent ! {scc_fun, Res}. - -%%------------------------------------------------------------------------------ +affected(Updated, Users) -> + lists:umerge([case lists:keyfind(V, 1, Users) of + {V, Vs} -> Vs; + false -> [] + end || V <- Updated]). scc_fold_fun(F, FunMap, State) -> Deps = get_deps(state__get_cs(F, State)), @@ -1859,7 +1910,7 @@ solver(Solver, SolveFun) -> solve_fun(v1, _Fun, Cs, FunMap, State) -> fun() -> - {ok, _MapDict, NewMap} = solve_ref_or_list(Cs, FunMap, dict:new(), State), + {ok, _MapDict, NewMap} = solve_ref_or_list(Cs, FunMap, map_new(), State), {ok, NewMap} end; solve_fun(v2, Fun, _Cs, FunMap, State) -> @@ -1899,8 +1950,8 @@ sane_maps(Map1, Map2, Keys, _S1, _S2) -> %% Solver v2 --record(v2_state, {constr_data = dict:new() :: dict:dict(), - state :: #state{}}). +-record(v2_state, {constr_data = maps:new() :: map(), + state :: state()}). v2_solve_ref(Fun, Map, State) -> V2State = #v2_state{state = State}, @@ -2061,30 +2112,30 @@ v2_solve_disj(Is, [C|Cs], I, Map, V2State, UL, MapL, Eval, Uneval0, Failed) -> v2_solve_disj(Is, Cs, I+1, Map, V2State, UL, MapL, Eval, Uneval, Failed). save_local_map(#v2_state{constr_data = ConData}=V2State, Id, U, Map) -> - Part0 = [{V,dict:fetch(V, Map)} || V <- U], + Part0 = [{V,maps:get(V, Map)} || V <- U], Part1 = - case dict:find(Id, ConData) of + case maps:find(Id, ConData) of error -> []; % cannot happen {ok, {Part2,[]}} -> Part2 end, ?debug("save local map Id=~w:\n", [Id]), Part = lists:ukeymerge(1, lists:keysort(1, Part0), Part1), - pp_map("New Part", dict:from_list(Part0)), - pp_map("Old Part", dict:from_list(Part1)), - pp_map(" => Part", dict:from_list(Part)), - V2State#v2_state{constr_data = dict:store(Id, {Part,[]}, ConData)}. + pp_map("New Part", maps:from_list(Part0)), + pp_map("Old Part", maps:from_list(Part1)), + pp_map(" => Part", maps:from_list(Part)), + V2State#v2_state{constr_data = maps:put(Id, {Part,[]}, ConData)}. restore_local_map(#v2_state{constr_data = ConData}, Id, Map0) -> - case dict:find(Id, ConData) of + case maps:find(Id, ConData) of error -> Map0; {ok, failed} -> Map0; {ok, {[],_}} -> Map0; {ok, {Part0,U}} -> Part = [KV || {K,_V} = KV <- Part0, not lists:member(K, U)], ?debug("restore local map Id=~w U=~w\n", [Id, U]), - pp_map("Part", dict:from_list(Part)), + pp_map("Part", maps:from_list(Part)), pp_map("Map0", Map0), - Map = lists:foldl(fun({K,V}, D) -> dict:store(K, V, D) end, Map0, Part), + Map = lists:foldl(fun({K,V}, D) -> maps:put(K, V, D) end, Map0, Part), pp_map("Map", Map), Map end. @@ -2164,31 +2215,26 @@ report_detected_loop(_) -> add_mask_to_flags(Flags, [Im|M], I, L) when I > Im -> add_mask_to_flags(Flags, M, I, [Im|L]); add_mask_to_flags(Flags, [_|M], _I, L) -> - {lists:umerge(Flags, M), lists:reverse(L)}. + {lists:umerge(M, Flags), lists:reverse(L)}. -get_mask(V, {d, Masks}) -> - case dict:find(V, Masks) of +get_mask(V, Masks) -> + case maps:find(V, Masks) of error -> []; {ok, M} -> M - end; -get_mask(V, Masks) -> - case lists:keyfind(V, 1, Masks) of - false -> []; - {V, M} -> M end. get_flags(#v2_state{constr_data = ConData}=V2State0, C) -> #constraint_list{id = Id, list = Cs, masks = Masks} = C, - case dict:find(Id, ConData) of + case maps:find(Id, ConData) of error -> ?debug("get_flags Id=~w Flags=all ~w\n", [Id, length(Cs)]), - V2State = V2State0#v2_state{constr_data = dict:store(Id, {[],[]}, ConData)}, + V2State = V2State0#v2_state{constr_data = maps:put(Id, {[],[]}, ConData)}, {V2State, lists:seq(1, length(Cs))}; {ok, failed} -> {V2State0, failed_list}; {ok, {Part,U}} when U =/= [] -> ?debug("get_flags Id=~w U=~w\n", [Id, U]), - V2State = V2State0#v2_state{constr_data = dict:store(Id, {Part,[]}, ConData)}, + V2State = V2State0#v2_state{constr_data = maps:put(Id, {Part,[]}, ConData)}, save_updated_vars_list(Cs, vars_per_child(U, Masks), V2State) end. @@ -2217,13 +2263,13 @@ save_updated_vars(#constraint_ref{id = Id}, U, V2State) -> save_updated_vars1(V2State, C, U) -> #v2_state{constr_data = ConData} = V2State, #constraint_list{id = Id} = C, - case dict:find(Id, ConData) of + case maps:find(Id, ConData) of error -> V2State; % error means everything is flagged {ok, failed} -> V2State; {ok, {Part,U0}} -> %% Duplicates are not so common; let masks/2 remove them. U1 = U ++ U0, - V2State#v2_state{constr_data = dict:store(Id, {Part,U1}, ConData)} + V2State#v2_state{constr_data = maps:put(Id, {Part,U1}, ConData)} end. -ifdef(DEBUG). @@ -2233,12 +2279,12 @@ pp_constr_data(_Tag, #v2_state{constr_data = D}) -> case _PartU of {_Part, _U} -> io:format("Id: ~w Vars: ~w\n", [_Id, _U]), - [pp_map("Part", dict:from_list(_Part)) || _Part =/= []]; + [pp_map("Part", maps:from_list(_Part)) || _Part =/= []]; failed -> io:format("Id: ~w failed list\n", [_Id]) end end || - {_Id, _PartU} <- lists:keysort(1, dict:to_list(D))], + {_Id, _PartU} <- lists:keysort(1, maps:to_list(D))], ok. -else. @@ -2248,17 +2294,17 @@ pp_constr_data(_Tag, _V2State) -> failed_list(#constraint_list{id = Id}, #v2_state{constr_data = D}=V2State) -> ?debug("error list ~w~n", [Id]), - V2State#v2_state{constr_data = dict:store(Id, failed, D)}. + V2State#v2_state{constr_data = maps:put(Id, failed, D)}. is_failed_list(#constraint_list{id = Id}, #v2_state{constr_data = D}) -> - dict:find(Id, D) =:= {ok, failed}. + maps:find(Id, D) =:= {ok, failed}. %% Solver v1 solve_ref_or_list(#constraint_ref{id = Id, deps = Deps}, Map, MapDict, State) -> {OldLocalMap, Check} = - case dict:find(Id, MapDict) of + case maps:find(Id, MapDict) of error -> {map_new(), false}; {ok, M} -> {M, true} end, @@ -2304,12 +2350,12 @@ solve_ref_or_list(#constraint_ref{id = Id, deps = Deps}, {ok, Var} -> enter_type(Var, FunType, NewMap1); error -> NewMap1 end, - {ok, dict:store(Id, NewMap2, NewMapDict), NewMap2} + {ok, maps:put(Id, NewMap2, NewMapDict), NewMap2} end; solve_ref_or_list(#constraint_list{type=Type, list = Cs, deps = Deps, id = Id}, Map, MapDict, State) -> {OldLocalMap, Check} = - case dict:find(Id, MapDict) of + case maps:find(Id, MapDict) of error -> {map_new(), false}; {ok, M} -> {M, true} end, @@ -2359,7 +2405,7 @@ solve_self_recursive(Cs, Map, MapDict, Id, RecType0, State) -> solve_clist(Cs, conj, Id, Deps, MapDict, Map, State) -> case solve_cs(Cs, Map, MapDict, State) of {error, NewMapDict} -> - {error, dict:store(Id, error, NewMapDict)}; + {error, maps:put(Id, error, NewMapDict)}; {ok, NewMapDict, NewMap} = Ret -> case Cs of [_] -> @@ -2367,7 +2413,7 @@ solve_clist(Cs, conj, Id, Deps, MapDict, Map, State) -> Ret; _ -> case maps_are_equal(Map, NewMap, Deps) of - true -> {ok, dict:store(Id, NewMap, NewMapDict), NewMap}; + true -> {ok, maps:put(Id, NewMap, NewMapDict), NewMap}; false -> solve_clist(Cs, conj, Id, Deps, NewMapDict, NewMap, State) end end @@ -2381,10 +2427,10 @@ solve_clist(Cs, disj, Id, _Deps, MapDict, Map, State) -> end, {Maps, NewMapDict} = lists:mapfoldl(Fun, MapDict, Cs), case [X || {ok, X} <- Maps] of - [] -> {error, dict:store(Id, error, NewMapDict)}; + [] -> {error, maps:put(Id, error, NewMapDict)}; MapList -> NewMap = join_maps(MapList), - {ok, dict:store(Id, NewMap, NewMapDict), NewMap} + {ok, maps:put(Id, NewMap, NewMapDict), NewMap} end. solve_cs([#constraint_ref{} = C|Tail], Map, MapDict, State) -> @@ -2465,7 +2511,7 @@ report_failed_constraint(_C, _Map) -> %% ============================================================================ map_new() -> - dict:new(). + maps:new(). join_maps([Map]) -> Map; @@ -2475,9 +2521,9 @@ join_maps(Maps) -> constrained_keys(Maps) -> lists:foldl(fun(TmpMap, AccKeys) -> - [Key || Key <- AccKeys, dict:is_key(Key, TmpMap)] + [Key || Key <- AccKeys, maps:is_key(Key, TmpMap)] end, - dict:fetch_keys(hd(Maps)), tl(Maps)). + maps:keys(hd(Maps)), tl(Maps)). join_maps([Key|Left], Maps = [Map|MapsLeft], AccMap) -> NewType = join_one_key(Key, MapsLeft, lookup_type(Key, Map)), @@ -2523,11 +2569,11 @@ prune_keys(Map1, Map2, Deps) -> NofDeps = length(Deps), case NofDeps > ?PRUNE_LIMIT of true -> - Keys1 = dict:fetch_keys(Map1), + Keys1 = maps:keys(Map1), case length(Keys1) > NofDeps of true -> Set1 = lists:sort(Keys1), - Set2 = lists:sort(dict:fetch_keys(Map2)), + Set2 = lists:sort(maps:keys(Map2)), ordsets:intersection(ordsets:union(Set1, Set2), Deps); false -> Deps @@ -2548,7 +2594,7 @@ enter_type(Key, Val, Map) when is_integer(Key) -> true -> ok; false -> ?debug("LimitedVal ~s\n", [format_type(LimitedVal)]) end, - case dict:find(Key, Map) of + case maps:find(Key, Map) of {ok, Value} -> case is_equal(Value, LimitedVal) of true -> Map; @@ -2582,16 +2628,16 @@ enter_type2(Key, Val, Map) -> map_store(Key, Val, Map) -> ?debug("Storing ~w :: ~s\n", [Key, format_type(Val)]), - dict:store(Key, Val, Map). + maps:put(Key, Val, Map). erase_type(Key, Map) -> - dict:erase(Key, Map). + maps:remove(Key, Map). lookup_type_list(List, Map) -> [lookup_type(X, Map) || X <- List]. unsafe_lookup_type(Key, Map) -> - case dict:find(t_var_name(Key), Map) of + case maps:find(t_var_name(Key), Map) of {ok, Type} -> Type; error -> t_none() end. @@ -2600,7 +2646,7 @@ unsafe_lookup_type_list(List, Map) -> [unsafe_lookup_type(X, Map) || X <- List]. lookup_type(Key, Map) when is_integer(Key) -> - case dict:find(Key, Map) of + case maps:find(Key, Map) of error -> t_any(); {ok, Val} -> Val end; @@ -2648,7 +2694,7 @@ is_equal(Type1, Type2) -> pp_map(_S, _Map) -> ?debug("\t~s: ~p\n", [_S, [{X, lists:flatten(format_type(Y))} || - {X, Y} <- lists:keysort(1, dict:to_list(_Map))]]). + {X, Y} <- lists:keysort(1, maps:to_list(_Map))]]). %% ============================================================================ %% @@ -2658,7 +2704,7 @@ pp_map(_S, _Map) -> new_state(SCC0, NextLabel, CallGraph, Plt, PropTypes, Solvers) -> List = [{MFA, Var} || {MFA, {Var, _Fun}, _Rec} <- SCC0], - NameMap = dict:from_list(List), + NameMap = maps:from_list(List), MFAs = [MFA || {MFA, _Var} <- List], SCC = [mk_var(Fun) || {_MFA, {_Var, Fun}, _Rec} <- SCC0], SelfRec = @@ -2672,7 +2718,7 @@ new_state(SCC0, NextLabel, CallGraph, Plt, PropTypes, Solvers) -> _Many -> false end, #state{callgraph = CallGraph, name_map = NameMap, next_label = NextLabel, - prop_types = {d, PropTypes}, plt = Plt, scc = ordsets:from_list(SCC), + prop_types = PropTypes, plt = Plt, scc = ordsets:from_list(SCC), mfas = MFAs, self_rec = SelfRec, solvers = Solvers}. state__set_rec_dict(State, RecDict) -> @@ -2700,15 +2746,15 @@ state__get_fun_prototype(Op, Arity, State) -> end. state__lookup_rec_var_in_scope(MFA, #state{name_map = NameMap}) -> - dict:find(MFA, NameMap). + maps:find(MFA, NameMap). state__store_fun_arity(Tree, #state{fun_arities = Map} = State) -> Arity = length(cerl:fun_vars(Tree)), Id = mk_var(Tree), - State#state{fun_arities = dict:store(Id, Arity, Map)}. + State#state{fun_arities = maps:put(Id, Arity, Map)}. state__fun_arity(Id, #state{fun_arities = Map}) -> - dict:fetch(Id, Map). + maps:get(Id, Map). state__lookup_undef_var(Tree, #state{callgraph = CG, plt = Plt}) -> Label = cerl_trees:get_label(Tree), @@ -2768,21 +2814,14 @@ state__plt(#state{plt = PLT}) -> state__new_constraint_context(State) -> State#state{cs = []}. -state__prop_domain(FunLabel, #state{prop_types = {e, ETSPropTypes}}) -> - try ets:lookup_element(ETSPropTypes, FunLabel, 2) of - {_Range_Fun, Dom} -> {ok, Dom}; - FunType -> {ok, t_fun_args(FunType)} - catch - _:_ -> error - end; -state__prop_domain(FunLabel, #state{prop_types = {d, PropTypes}}) -> +state__prop_domain(FunLabel, #state{prop_types = PropTypes}) -> case dict:find(FunLabel, PropTypes) of error -> error; {ok, {_Range_Fun, Dom}} -> {ok, Dom}; {ok, FunType} -> {ok, t_fun_args(FunType)} end. -state__add_prop_constrs(Tree, #state{prop_types = {d, PropTypes}} = State) -> +state__add_prop_constrs(Tree, #state{prop_types = PropTypes} = State) -> Label = cerl_trees:get_label(Tree), case dict:find(Label, PropTypes) of error -> State; @@ -2845,14 +2884,12 @@ state__mk_vars(N, #state{next_label = NL} = State) -> Vars = [t_var(X) || X <- lists:seq(NL, NewLabel-1)], {State#state{next_label = NewLabel}, Vars}. -state__store_constrs(Id, Cs, #state{cmap = {d, Dict}} = State) -> - NewDict = dict:store(Id, Cs, Dict), - State#state{cmap = {d, NewDict}}. +state__store_constrs(Id, Cs, #state{cmap = Map} = State) -> + NewMap = maps:put(Id, Cs, Map), + State#state{cmap = NewMap}. -state__get_cs(Var, #state{cmap = {e, ETSDict}}) -> - ets:lookup_element(ETSDict, Var, 2); -state__get_cs(Var, #state{cmap = {d, Dict}}) -> - dict:fetch(Var, Dict). +state__get_cs(Var, #state{cmap = Map}) -> + maps:get(Var, Map). state__is_self_rec(Fun, #state{self_rec = SelfRec}) -> not (SelfRec =:= 'false') andalso is_equal(Fun, SelfRec). @@ -2861,15 +2898,12 @@ state__store_funs(Vars0, Funs0, #state{fun_map = Map} = State) -> debug_make_name_map(Vars0, Funs0), Vars = mk_var_list(Vars0), Funs = mk_var_list(Funs0), - NewMap = lists:foldl(fun({Var, Fun}, MP) -> orddict:store(Var, Fun, MP) end, + NewMap = lists:foldl(fun({Var, Fun}, MP) -> maps:put(Fun, Var, MP) end, Map, lists:zip(Vars, Funs)), State#state{fun_map = NewMap}. state__get_rec_var(Fun, #state{fun_map = Map}) -> - case [V || {V, FV} <- Map, FV =:= Fun] of - [Var] -> {ok, Var}; - [] -> error - end. + maps:find(Fun, Map). state__finalize(State) -> State1 = enumerate_constraints(State), @@ -2936,13 +2970,13 @@ mk_fun_var(Fun, Types) -> -endif. --spec get_deps(constr()) -> [dep()]. +-spec get_deps(constr()) -> deps(). get_deps(#constraint{deps = D}) -> D; get_deps(#constraint_list{deps = D}) -> D; get_deps(#constraint_ref{deps = D}) -> D. --spec find_constraint_deps([fvar_or_type()]) -> [dep()]. +-spec find_constraint_deps([fvar_or_type()]) -> deps(). find_constraint_deps(List) -> ordsets:from_list(find_constraint_deps(List, [])). @@ -2975,13 +3009,24 @@ mk_constraint_ref(Id, Deps) -> mk_constraint_list(Type, List) -> List1 = ordsets:from_list(lift_lists(Type, List)), - List2 = ordsets:filter(fun(X) -> get_deps(X) =/= [] end, List1), - Deps = calculate_deps(List2), + case Type of + conj -> + List2 = ordsets:filter(fun(X) -> get_deps(X) =/= [] end, List1), + mk_constraint_list_cont(Type, List2); + disj -> + case lists:any(fun(X) -> get_deps(X) =:= [] end, List1) of + true -> mk_constraint_list_cont(Type, [mk_constraint_any(eq)]); + false -> mk_constraint_list_cont(Type, List1) + end + end. + +mk_constraint_list_cont(Type, List) -> + Deps = calculate_deps(List), case Deps =:= [] of true -> #constraint_list{type = conj, list = [mk_constraint_any(eq)], deps = []}; - false -> #constraint_list{type = Type, list = List2, deps = Deps} + false -> #constraint_list{type = Type, list = List, deps = Deps} end. lift_lists(Type, List) -> @@ -3179,18 +3224,11 @@ order_fun_constraints([], Funs, Acc, State) -> update_masks(C, Masks) -> C#constraint_list{masks = Masks}. --define(VARS_LIMIT, 50). - calculate_masks([C|Cs], I, L0) -> calculate_masks(Cs, I+1, [{V, I} || V <- get_deps(C)] ++ L0); calculate_masks([], _I, L) -> M = family(L), - case length(M) > ?VARS_LIMIT of - true -> - {d, dict:from_list(M)}; - false -> - M - end. + maps:from_list(M). %% ============================================================================ %% @@ -3263,6 +3301,15 @@ find_constraint(Tuple, [#constraint_list{list = List}|Cs]) -> find_constraint(Tuple, [_|Cs]) -> find_constraint(Tuple, Cs). +-spec fold_literal_maybe_match(cerl:cerl(), state()) -> cerl:cerl(). + +fold_literal_maybe_match(Tree0, State) -> + Tree1 = cerl:fold_literal(Tree0), + case state__is_in_match(State) of + false -> Tree1; + true -> dialyzer_utils:refold_pattern(Tree1) + end. + lookup_record(Records, Tag, Arity) -> case erl_types:lookup_record(Tag, Arity, Records) of {ok, Fields} -> @@ -3309,7 +3356,7 @@ join_chars([H|T], Sep) -> [H|[[Sep,X] || X <- T]]. debug_lookup_name(Var) -> - case dict:find(t_var_name(Var), get(dialyzer_typesig_map)) of + case maps:find(t_var_name(Var), get(dialyzer_typesig_map)) of error -> Var; {ok, Name} -> Name end. @@ -3319,7 +3366,7 @@ debug_lookup_name(Var) -> debug_make_name_map(Vars, Funs) -> Map = get(dialyzer_typesig_map), NewMap = - if Map =:= undefined -> debug_make_name_map(Vars, Funs, dict:new()); + if Map =:= undefined -> debug_make_name_map(Vars, Funs, maps:new()); true -> debug_make_name_map(Vars, Funs, Map) end, put(dialyzer_typesig_map, NewMap). @@ -3327,7 +3374,7 @@ debug_make_name_map(Vars, Funs) -> debug_make_name_map([Var|VarLeft], [Fun|FunLeft], Map) -> Name = {cerl:fname_id(Var), cerl:fname_arity(Var)}, FunLabel = cerl_trees:get_label(Fun), - debug_make_name_map(VarLeft, FunLeft, dict:store(FunLabel, Name, Map)); + debug_make_name_map(VarLeft, FunLeft, maps:put(FunLabel, Name, Map)); debug_make_name_map([], [], Map) -> Map. diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 5fc1c0e691..d37701f03b 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -49,6 +49,7 @@ process_record_remote_types/1, sets_filter/2, src_compiler_opts/0, + refold_pattern/1, parallelism/0, family/1 ]). @@ -752,6 +753,13 @@ pp_hook(Node, Ctxt, Cont) -> pp_binary(Node, Ctxt, Cont); bitstr -> pp_segment(Node, Ctxt, Cont); + map -> + pp_map(Node, Ctxt, Cont); + literal -> + case is_map(cerl:concrete(Node)) of + true -> pp_map(Node, Ctxt, Cont); + false -> Cont(Node, Ctxt) + end; _ -> Cont(Node, Ctxt) end. @@ -832,6 +840,87 @@ pp_atom(Atom) -> String = atom_to_list(cerl:atom_val(Atom)), prettypr:text(String). +pp_map(Node, Ctxt, Cont) -> + Arg = cerl:map_arg(Node), + Before = case cerl:is_c_map_empty(Arg) of + true -> prettypr:floating(prettypr:text("#{")); + false -> + prettypr:beside(Cont(Arg,Ctxt), + prettypr:floating(prettypr:text("#{"))) + end, + prettypr:beside( + Before, prettypr:beside( + prettypr:par(seq(cerl:map_es(Node), + prettypr:floating(prettypr:text(",")), + Ctxt, Cont)), + prettypr:floating(prettypr:text("}")))). + +seq([H | T], Separator, Ctxt, Fun) -> + case T of + [] -> [Fun(H, Ctxt)]; + _ -> [prettypr:beside(Fun(H, Ctxt), Separator) + | seq(T, Separator, Ctxt, Fun)] + end; +seq([], _, _, _) -> + [prettypr:empty()]. + +%%------------------------------------------------------------------------------ + +-spec refold_pattern(cerl:cerl()) -> cerl:cerl(). + +refold_pattern(Pat) -> + %% Avoid the churn of unfolding and refolding + case cerl:is_literal(Pat) andalso find_map(cerl:concrete(Pat)) of + true -> + Tree = refold_concrete_pat(cerl:concrete(Pat)), + PatAnn = cerl:get_ann(Pat), + case proplists:is_defined(label, PatAnn) of + %% Literals are not normally annotated with a label, but can be if, for + %% example, they were created by cerl:fold_literal/1. + true -> cerl:set_ann(Tree, PatAnn); + false -> + [{label, Label}] = cerl:get_ann(Tree), + cerl:set_ann(Tree, [{label, Label}|PatAnn]) + end; + false -> Pat + end. + +find_map(#{}) -> true; +find_map(Tuple) when is_tuple(Tuple) -> find_map(tuple_to_list(Tuple)); +find_map([H|T]) -> find_map(H) orelse find_map(T); +find_map(_) -> false. + +refold_concrete_pat(Val) -> + case Val of + _ when is_tuple(Val) -> + Els = lists:map(fun refold_concrete_pat/1, tuple_to_list(Val)), + case lists:all(fun cerl:is_literal/1, Els) of + true -> cerl:abstract(Val); + false -> label(cerl:c_tuple_skel(Els)) + end; + [H|T] -> + case cerl:is_literal(HP=refold_concrete_pat(H)) + and cerl:is_literal(TP=refold_concrete_pat(T)) + of + true -> cerl:abstract(Val); + false -> label(cerl:c_cons_skel(HP, TP)) + end; + M when is_map(M) -> + %% Map patterns are not generated by the parser(!), but they have a + %% property we want, namely that they are never folded into literals. + %% N.B.: The key in a map pattern is an expression, *not* a pattern. + label(cerl:c_map_pattern([cerl:c_map_pair_exact(cerl:abstract(K), + refold_concrete_pat(V)) + || {K, V} <- maps:to_list(M)])); + _ -> + cerl:abstract(Val) + end. + +label(Tree) -> + %% Sigh + Label = -erlang:unique_integer([positive]), + cerl:set_ann(Tree, [{label, Label}]). + %%------------------------------------------------------------------------------ -spec parallelism() -> integer(). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return index 89eb295604..638d031923 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return +++ b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return @@ -1,2 +1,2 @@ -supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{},[{_,{atom(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom()]} | #{}]}}, which is the expected return type for the callback of supervisor behaviour +supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{'intensity'=>non_neg_integer(), 'period'=>pos_integer(), 'strategy'=>'one_for_all' | 'one_for_one' | 'rest_for_one' | 'simple_one_for_one'},[{_,{atom(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom()]} | #{'id':=_, 'start':={atom(),atom(),'undefined' | [any()]}, 'modules'=>'dynamic' | [atom()], 'restart'=>'permanent' | 'temporary' | 'transient', 'shutdown'=>'brutal_kill' | 'infinity' | non_neg_integer(), 'type'=>'supervisor' | 'worker'}]}}, which is the expected return type for the callback of supervisor behaviour diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/compile_flags.hrl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/compile_flags.hrl new file mode 100644 index 0000000000..e5ee44ace1 --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/compile_flags.hrl @@ -0,0 +1,2 @@ +-define(AT_LEAST_19, 1). +-define(AT_LEAST_17, 1). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_common.hrl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_common.hrl new file mode 100644 index 0000000000..c10626c5cc --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_common.hrl @@ -0,0 +1,55 @@ +%%% Copyright 2010-2013 Manolis Papadakis <[email protected]>, +%%% Eirini Arvaniti <[email protected]> +%%% and Kostis Sagonas <[email protected]> +%%% +%%% This file is part of PropEr. +%%% +%%% PropEr is free software: you can redistribute it and/or modify +%%% it under the terms of the GNU General Public License as published by +%%% the Free Software Foundation, either version 3 of the License, or +%%% (at your option) any later version. +%%% +%%% PropEr is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%%% GNU General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public License +%%% along with PropEr. If not, see <http://www.gnu.org/licenses/>. + +%%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas +%%% @version {@version} +%%% @author Manolis Papadakis +%%% @doc Common parts of user and internal header files + + +%%------------------------------------------------------------------------------ +%% Test generation macros +%%------------------------------------------------------------------------------ + +-define(FORALL(X,RawType,Prop), proper:forall(RawType,fun(X) -> Prop end)). +-define(IMPLIES(Pre,Prop), proper:implies(Pre,?DELAY(Prop))). +-define(WHENFAIL(Action,Prop), proper:whenfail(?DELAY(Action),?DELAY(Prop))). +-define(TRAPEXIT(Prop), proper:trapexit(?DELAY(Prop))). +-define(TIMEOUT(Limit,Prop), proper:timeout(Limit,?DELAY(Prop))). +%% TODO: -define(ALWAYS(Tests,Prop), proper:always(Tests,?DELAY(Prop))). +%% TODO: -define(SOMETIMES(Tests,Prop), proper:sometimes(Tests,?DELAY(Prop))). + + +%%------------------------------------------------------------------------------ +%% Generator macros +%%------------------------------------------------------------------------------ + +-define(FORCE(X), (X)()). +-define(DELAY(X), fun() -> X end). +-define(LAZY(X), proper_types:lazy(?DELAY(X))). +-define(SIZED(SizeArg,Gen), proper_types:sized(fun(SizeArg) -> Gen end)). +-define(LET(X,RawType,Gen), proper_types:bind(RawType,fun(X) -> Gen end,false)). +-define(SHRINK(Gen,AltGens), + proper_types:shrinkwith(?DELAY(Gen),?DELAY(AltGens))). +-define(LETSHRINK(Xs,RawType,Gen), + proper_types:bind(RawType,fun(Xs) -> Gen end,true)). +-define(SUCHTHAT(X,RawType,Condition), + proper_types:add_constraint(RawType,fun(X) -> Condition end,true)). +-define(SUCHTHATMAYBE(X,RawType,Condition), + proper_types:add_constraint(RawType,fun(X) -> Condition end,false)). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_gen.erl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_gen.erl new file mode 100644 index 0000000000..b64a139e4d --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_gen.erl @@ -0,0 +1,611 @@ +%%% Copyright 2010-2015 Manolis Papadakis <[email protected]>, +%%% Eirini Arvaniti <[email protected]> +%%% and Kostis Sagonas <[email protected]> +%%% +%%% This file is part of PropEr. +%%% +%%% PropEr is free software: you can redistribute it and/or modify +%%% it under the terms of the GNU General Public License as published by +%%% the Free Software Foundation, either version 3 of the License, or +%%% (at your option) any later version. +%%% +%%% PropEr is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%%% GNU General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public License +%%% along with PropEr. If not, see <http://www.gnu.org/licenses/>. + +%%% @copyright 2010-2015 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas +%%% @version {@version} +%%% @author Manolis Papadakis + +%%% @doc Generator subsystem and generators for basic types. +%%% +%%% You can use <a href="#index">these</a> functions to try out the random +%%% instance generation and shrinking subsystems. +%%% +%%% CAUTION: These functions should never be used inside properties. They are +%%% meant for demonstration purposes only. + +-module(proper_gen). +-export([pick/1, pick/2, pick/3, + sample/1, sample/3, sampleshrink/1, sampleshrink/2]). + +-export([safe_generate/1]). +-export([generate/1, normal_gen/1, alt_gens/1, clean_instance/1, + get_ret_type/1]). +-export([integer_gen/3, float_gen/3, atom_gen/1, atom_rev/1, binary_gen/1, + binary_rev/1, binary_len_gen/1, bitstring_gen/1, bitstring_rev/1, + bitstring_len_gen/1, list_gen/2, distlist_gen/3, vector_gen/2, + union_gen/1, weighted_union_gen/1, tuple_gen/1, loose_tuple_gen/2, + loose_tuple_rev/2, exactly_gen/1, fixed_list_gen/1, function_gen/2, + any_gen/1, native_type_gen/2, safe_weighted_union_gen/1, + safe_union_gen/1]). + +-export_type([instance/0, imm_instance/0, sized_generator/0, nosize_generator/0, + generator/0, reverse_gen/0, combine_fun/0, alt_gens/0]). + +-include("proper_internal.hrl"). + +%%----------------------------------------------------------------------------- +%% Types +%%----------------------------------------------------------------------------- + +%% TODO: update imm_instance() when adding more types: be careful when reading +%% anything that returns it +%% @private_type +-type imm_instance() :: proper_types:raw_type() + | instance() + | {'$used', imm_instance(), imm_instance()} + | {'$to_part', imm_instance()}. +-type instance() :: term(). +%% A value produced by the random instance generator. +-type error_reason() :: 'arity_limit' | 'cant_generate' | {'typeserver',term()}. + +%% @private_type +-type sized_generator() :: fun((size()) -> imm_instance()). +%% @private_type +-type typed_sized_generator() :: {'typed', + fun((proper_types:type(),size()) -> + imm_instance())}. +%% @private_type +-type nosize_generator() :: fun(() -> imm_instance()). +%% @private_type +-type typed_nosize_generator() :: {'typed', + fun((proper_types:type()) -> + imm_instance())}. +%% @private_type +-type generator() :: sized_generator() + | typed_sized_generator() + | nosize_generator() + | typed_nosize_generator(). +%% @private_type +-type plain_reverse_gen() :: fun((instance()) -> imm_instance()). +%% @private_type +-type typed_reverse_gen() :: {'typed', + fun((proper_types:type(),instance()) -> + imm_instance())}. +%% @private_type +-type reverse_gen() :: plain_reverse_gen() | typed_reverse_gen(). +%% @private_type +-type combine_fun() :: fun((instance()) -> imm_instance()). +%% @private_type +-type alt_gens() :: fun(() -> [imm_instance()]). +%% @private_type +-type fun_seed() :: {non_neg_integer(),non_neg_integer()}. + + +%%----------------------------------------------------------------------------- +%% Instance generation functions +%%----------------------------------------------------------------------------- + +%% @private +-spec safe_generate(proper_types:raw_type()) -> + {'ok',imm_instance()} | {'error',error_reason()}. +safe_generate(RawType) -> + try generate(RawType) of + ImmInstance -> {ok, ImmInstance} + catch + throw:'$arity_limit' -> {error, arity_limit}; + throw:'$cant_generate' -> {error, cant_generate}; + throw:{'$typeserver',SubReason} -> {error, {typeserver,SubReason}} + end. + +%% @private +-spec generate(proper_types:raw_type()) -> imm_instance(). +generate(RawType) -> + Type = proper_types:cook_outer(RawType), + ok = add_parameters(Type), + Instance = generate(Type, get('$constraint_tries'), none), + ok = remove_parameters(Type), + Instance. + +-spec add_parameters(proper_types:type()) -> 'ok'. +add_parameters(Type) -> + case proper_types:find_prop(parameters, Type) of + {ok, Params} -> + OldParams = erlang:get('$parameters'), + case OldParams of + undefined -> + erlang:put('$parameters', Params); + _ -> + erlang:put('$parameters', Params ++ OldParams) + end, + ok; + _ -> + ok + end. + +-spec remove_parameters(proper_types:type()) -> 'ok'. +remove_parameters(Type) -> + case proper_types:find_prop(parameters, Type) of + {ok, Params} -> + AllParams = erlang:get('$parameters'), + case AllParams of + Params-> + erlang:erase('$parameters'); + _ -> + erlang:put('$parameters', AllParams -- Params) + end, + ok; + _ -> + ok + end. + +-spec generate(proper_types:type(), non_neg_integer(), + 'none' | {'ok',imm_instance()}) -> imm_instance(). +generate(_Type, 0, none) -> + throw('$cant_generate'); +generate(_Type, 0, {ok,Fallback}) -> + Fallback; +generate(Type, TriesLeft, Fallback) -> + ImmInstance = + case proper_types:get_prop(kind, Type) of + constructed -> + PartsType = proper_types:get_prop(parts_type, Type), + Combine = proper_types:get_prop(combine, Type), + ImmParts = generate(PartsType), + Parts = clean_instance(ImmParts), + ImmInstance1 = Combine(Parts), + %% TODO: We can just generate the internal type: if it's not + %% a type, it will turn into an exactly. + ImmInstance2 = + case proper_types:is_raw_type(ImmInstance1) of + true -> generate(ImmInstance1); + false -> ImmInstance1 + end, + {'$used',ImmParts,ImmInstance2}; + _ -> + ImmInstance1 = normal_gen(Type), + case proper_types:is_raw_type(ImmInstance1) of + true -> generate(ImmInstance1); + false -> ImmInstance1 + end + end, + case proper_types:satisfies_all(clean_instance(ImmInstance), Type) of + {_,true} -> ImmInstance; + {true,false} -> generate(Type, TriesLeft - 1, {ok,ImmInstance}); + {false,false} -> generate(Type, TriesLeft - 1, Fallback) + end. + +%% @equiv pick(Type, 10) +-spec pick(Type::proper_types:raw_type()) -> {'ok',instance()} | 'error'. +pick(RawType) -> + pick(RawType, 10). + +%% @equiv pick(Type, Size, os:timestamp()) +-spec pick(Type::proper_types:raw_type(), size()) -> {'ok',instance()} | 'error'. +pick(RawType, Size) -> + pick(RawType, Size, os:timestamp()). + +%% @doc Generates a random instance of `Type', of size `Size' with seed `Seed'. +-spec pick(Type::proper_types:raw_type(), size(), seed()) -> + {'ok',instance()} | 'error'. +pick(RawType, Size, Seed) -> + proper:global_state_init_size_seed(Size, Seed), + case clean_instance(safe_generate(RawType)) of + {ok,Instance} = Result -> + Msg = "WARNING: Some garbage has been left in the process registry " + "and the code server~n" + "to allow for the returned function(s) to run normally.~n" + "Please run proper:global_state_erase() when done.~n", + case contains_fun(Instance) of + true -> io:format(Msg, []); + false -> proper:global_state_erase() + end, + Result; + {error,Reason} -> + proper:report_error(Reason, fun io:format/2), + proper:global_state_erase(), + error + end. + +%% @equiv sample(Type, 10, 20) +-spec sample(Type::proper_types:raw_type()) -> 'ok'. +sample(RawType) -> + sample(RawType, 10, 20). + +%% @doc Generates and prints one random instance of `Type' for each size from +%% `StartSize' up to `EndSize'. +-spec sample(Type::proper_types:raw_type(), size(), size()) -> 'ok'. +sample(RawType, StartSize, EndSize) when StartSize =< EndSize -> + Tests = EndSize - StartSize + 1, + Prop = ?FORALL(X, RawType, begin io:format("~p~n",[X]), true end), + Opts = [quiet,{start_size,StartSize},{max_size,EndSize},{numtests,Tests}], + _ = proper:quickcheck(Prop, Opts), + ok. + +%% @equiv sampleshrink(Type, 10) +-spec sampleshrink(Type::proper_types:raw_type()) -> 'ok'. +sampleshrink(RawType) -> + sampleshrink(RawType, 10). + +%% @doc Generates a random instance of `Type', of size `Size', then shrinks it +%% as far as it goes. The value produced on each step of the shrinking process +%% is printed on the screen. +-spec sampleshrink(Type::proper_types:raw_type(), size()) -> 'ok'. +sampleshrink(RawType, Size) -> + proper:global_state_init_size(Size), + Type = proper_types:cook_outer(RawType), + case safe_generate(Type) of + {ok,ImmInstance} -> + Shrunk = keep_shrinking(ImmInstance, [], Type), + PrintInst = fun(I) -> io:format("~p~n",[clean_instance(I)]) end, + lists:foreach(PrintInst, Shrunk); + {error,Reason} -> + proper:report_error(Reason, fun io:format/2) + end, + proper:global_state_erase(), + ok. + +-spec keep_shrinking(imm_instance(), [imm_instance()], proper_types:type()) -> + [imm_instance(),...]. +keep_shrinking(ImmInstance, Acc, Type) -> + keep_shrinking(ImmInstance, Acc, Type, init). + +keep_shrinking(ImmInstance, Acc, Type, State) -> + case proper_shrink:shrink(ImmInstance, Type, State) of + {[], done} -> %% no more shrinkers + lists:reverse([ImmInstance|Acc]); + {[], NewState} -> + %% try next shrinker + keep_shrinking(ImmInstance, Acc, Type, NewState); + {[Shrunk|_Rest], _NewState} -> + Acc2 = [ImmInstance|Acc], + case lists:member(Shrunk, Acc2) of + true -> + %% Avoid infinite loops + lists:reverse(Acc2); + false -> + keep_shrinking(Shrunk, Acc2, Type) + end + end. + +-spec contains_fun(term()) -> boolean(). +contains_fun(List) when is_list(List) -> + proper_arith:safe_any(fun contains_fun/1, List); +contains_fun(Tuple) when is_tuple(Tuple) -> + contains_fun(tuple_to_list(Tuple)); +contains_fun(Fun) when is_function(Fun) -> + true; +contains_fun(_Term) -> + false. + + +%%----------------------------------------------------------------------------- +%% Utility functions +%%----------------------------------------------------------------------------- + +%% @private +-spec normal_gen(proper_types:type()) -> imm_instance(). +normal_gen(Type) -> + case proper_types:get_prop(generator, Type) of + {typed, Gen} -> + if + is_function(Gen, 1) -> Gen(Type); + is_function(Gen, 2) -> Gen(Type, proper:get_size(Type)) + end; + Gen -> + if + is_function(Gen, 0) -> Gen(); + is_function(Gen, 1) -> Gen(proper:get_size(Type)) + end + end. + +%% @private +-spec alt_gens(proper_types:type()) -> [imm_instance()]. +alt_gens(Type) -> + case proper_types:find_prop(alt_gens, Type) of + {ok, AltGens} -> ?FORCE(AltGens); + error -> [] + end. + +%% @private +-spec clean_instance(imm_instance()) -> instance(). +clean_instance({'$used',_ImmParts,ImmInstance}) -> + clean_instance(ImmInstance); +clean_instance({'$to_part',ImmInstance}) -> + clean_instance(ImmInstance); +clean_instance(ImmInstance) -> + if + is_list(ImmInstance) -> + %% CAUTION: this must handle improper lists + proper_arith:safe_map(fun clean_instance/1, ImmInstance); + is_tuple(ImmInstance) -> + proper_arith:tuple_map(fun clean_instance/1, ImmInstance); + true -> + ImmInstance + end. + + +%%----------------------------------------------------------------------------- +%% Basic type generators +%%----------------------------------------------------------------------------- + +%% @private +-spec integer_gen(size(), proper_types:extint(), proper_types:extint()) -> + integer(). +integer_gen(Size, inf, inf) -> + proper_arith:rand_int(Size); +integer_gen(Size, inf, High) -> + High - proper_arith:rand_non_neg_int(Size); +integer_gen(Size, Low, inf) -> + Low + proper_arith:rand_non_neg_int(Size); +integer_gen(Size, Low, High) -> + proper_arith:smart_rand_int(Size, Low, High). + +%% @private +-spec float_gen(size(), proper_types:extnum(), proper_types:extnum()) -> + float(). +float_gen(Size, inf, inf) -> + proper_arith:rand_float(Size); +float_gen(Size, inf, High) -> + High - proper_arith:rand_non_neg_float(Size); +float_gen(Size, Low, inf) -> + Low + proper_arith:rand_non_neg_float(Size); +float_gen(_Size, Low, High) -> + proper_arith:rand_float(Low, High). + +%% @private +-spec atom_gen(size()) -> proper_types:type(). +%% We make sure we never clash with internal atoms by checking that the first +%% character is not '$'. +atom_gen(Size) -> + ?LET(Str, + ?SUCHTHAT(X, + proper_types:resize(Size, + proper_types:list(proper_types:byte())), + X =:= [] orelse hd(X) =/= $$), + list_to_atom(Str)). + +%% @private +-spec atom_rev(atom()) -> imm_instance(). +atom_rev(Atom) -> + {'$used', atom_to_list(Atom), Atom}. + +%% @private +-spec binary_gen(size()) -> proper_types:type(). +binary_gen(Size) -> + ?LET(Bytes, + proper_types:resize(Size, + proper_types:list(proper_types:byte())), + list_to_binary(Bytes)). + +%% @private +-spec binary_rev(binary()) -> imm_instance(). +binary_rev(Binary) -> + {'$used', binary_to_list(Binary), Binary}. + +%% @private +-spec binary_len_gen(length()) -> proper_types:type(). +binary_len_gen(Len) -> + ?LET(Bytes, + proper_types:vector(Len, proper_types:byte()), + list_to_binary(Bytes)). + +%% @private +-spec bitstring_gen(size()) -> proper_types:type(). +bitstring_gen(Size) -> + ?LET({BytesHead, NumBits, TailByte}, + {proper_types:resize(Size,proper_types:binary()), + proper_types:range(0,7), proper_types:range(0,127)}, + <<BytesHead/binary, TailByte:NumBits>>). + +%% @private +-spec bitstring_rev(bitstring()) -> imm_instance(). +bitstring_rev(BitString) -> + List = bitstring_to_list(BitString), + {BytesList, BitsTail} = lists:splitwith(fun erlang:is_integer/1, List), + {NumBits, TailByte} = case BitsTail of + [] -> {0, 0}; + [Bits] -> N = bit_size(Bits), + <<Byte:N>> = Bits, + {N, Byte} + end, + {'$used', + {{'$used',BytesList,list_to_binary(BytesList)}, NumBits, TailByte}, + BitString}. + +%% @private +-spec bitstring_len_gen(length()) -> proper_types:type(). +bitstring_len_gen(Len) -> + BytesLen = Len div 8, + BitsLen = Len rem 8, + ?LET({BytesHead, NumBits, TailByte}, + {proper_types:binary(BytesLen), BitsLen, + proper_types:range(0, 1 bsl BitsLen - 1)}, + <<BytesHead/binary, TailByte:NumBits>>). + +%% @private +-spec list_gen(size(), proper_types:type()) -> [imm_instance()]. +list_gen(Size, ElemType) -> + Len = proper_arith:rand_int(0, Size), + vector_gen(Len, ElemType). + +%% @private +-spec distlist_gen(size(), sized_generator(), boolean()) -> [imm_instance()]. +distlist_gen(RawSize, Gen, NonEmpty) -> + Len = case NonEmpty of + true -> proper_arith:rand_int(1, erlang:max(1,RawSize)); + false -> proper_arith:rand_int(0, RawSize) + end, + Size = case Len of + 1 -> RawSize - 1; + _ -> RawSize + end, + %% TODO: this produces a lot of types: maybe a simple 'div' is sufficient? + Sizes = proper_arith:distribute(Size, Len), + InnerTypes = [Gen(S) || S <- Sizes], + fixed_list_gen(InnerTypes). + +%% @private +-spec vector_gen(length(), proper_types:type()) -> [imm_instance()]. +vector_gen(Len, ElemType) -> + vector_gen_tr(Len, ElemType, []). + +-spec vector_gen_tr(length(), proper_types:type(), [imm_instance()]) -> + [imm_instance()]. +vector_gen_tr(0, _ElemType, AccList) -> + AccList; +vector_gen_tr(Left, ElemType, AccList) -> + vector_gen_tr(Left - 1, ElemType, [generate(ElemType) | AccList]). + +%% @private +-spec union_gen([proper_types:type(),...]) -> imm_instance(). +union_gen(Choices) -> + {_Choice,Type} = proper_arith:rand_choose(Choices), + generate(Type). + +%% @private +-spec weighted_union_gen([{frequency(),proper_types:type()},...]) -> + imm_instance(). +weighted_union_gen(FreqChoices) -> + {_Choice,Type} = proper_arith:freq_choose(FreqChoices), + generate(Type). + +%% @private +-spec safe_union_gen([proper_types:type(),...]) -> imm_instance(). +safe_union_gen(Choices) -> + {Choice,Type} = proper_arith:rand_choose(Choices), + try generate(Type) + catch + error:_ -> + safe_union_gen(proper_arith:list_remove(Choice, Choices)) + end. + +%% @private +-spec safe_weighted_union_gen([{frequency(),proper_types:type()},...]) -> + imm_instance(). +safe_weighted_union_gen(FreqChoices) -> + {Choice,Type} = proper_arith:freq_choose(FreqChoices), + try generate(Type) + catch + error:_ -> + safe_weighted_union_gen(proper_arith:list_remove(Choice, + FreqChoices)) + end. + +%% @private +-spec tuple_gen([proper_types:type()]) -> tuple(). +tuple_gen(Fields) -> + list_to_tuple(fixed_list_gen(Fields)). + +%% @private +-spec loose_tuple_gen(size(), proper_types:type()) -> proper_types:type(). +loose_tuple_gen(Size, ElemType) -> + ?LET(L, + proper_types:resize(Size, proper_types:list(ElemType)), + list_to_tuple(L)). + +%% @private +-spec loose_tuple_rev(tuple(), proper_types:type()) -> imm_instance(). +loose_tuple_rev(Tuple, ElemType) -> + CleanList = tuple_to_list(Tuple), + List = case proper_types:find_prop(reverse_gen, ElemType) of + {ok,{typed, ReverseGen}} -> + [ReverseGen(ElemType,X) || X <- CleanList]; + {ok,ReverseGen} -> [ReverseGen(X) || X <- CleanList]; + error -> CleanList + end, + {'$used', List, Tuple}. + +%% @private +-spec exactly_gen(T) -> T. +exactly_gen(X) -> + X. + +%% @private +-spec fixed_list_gen([proper_types:type()]) -> imm_instance() + ; ({[proper_types:type()],proper_types:type()}) -> + maybe_improper_list(imm_instance(), imm_instance() | []). +fixed_list_gen({ProperHead,ImproperTail}) -> + [generate(F) || F <- ProperHead] ++ generate(ImproperTail); +fixed_list_gen(ProperFields) -> + [generate(F) || F <- ProperFields]. + +%% @private +-spec function_gen(arity(), proper_types:type()) -> function(). +function_gen(Arity, RetType) -> + FunSeed = {proper_arith:rand_int(0, ?SEED_RANGE - 1), + proper_arith:rand_int(0, ?SEED_RANGE - 1)}, + create_fun(Arity, RetType, FunSeed). + +%% @private +-spec any_gen(size()) -> imm_instance(). +any_gen(Size) -> + case get('$any_type') of + undefined -> real_any_gen(Size); + {type,AnyType} -> generate(proper_types:resize(Size, AnyType)) + end. + +-spec real_any_gen(size()) -> imm_instance(). +real_any_gen(0) -> + SimpleTypes = [proper_types:integer(), proper_types:float(), + proper_types:atom()], + union_gen(SimpleTypes); +real_any_gen(Size) -> + FreqChoices = [{?ANY_SIMPLE_PROB,simple}, {?ANY_BINARY_PROB,binary}, + {?ANY_EXPAND_PROB,expand}], + case proper_arith:freq_choose(FreqChoices) of + {_,simple} -> + real_any_gen(0); + {_,binary} -> + generate(proper_types:resize(Size, proper_types:bitstring())); + {_,expand} -> + %% TODO: statistics of produced terms? + NumElems = proper_arith:rand_int(0, Size - 1), + ElemSizes = proper_arith:distribute(Size - 1, NumElems), + ElemTypes = [?LAZY(real_any_gen(S)) || S <- ElemSizes], + case proper_arith:rand_int(1,2) of + 1 -> fixed_list_gen(ElemTypes); + 2 -> tuple_gen(ElemTypes) + end + end. + +%% @private +-spec native_type_gen(mod_name(), string()) -> proper_types:type(). +native_type_gen(Mod, TypeStr) -> + case proper_typeserver:translate_type({Mod,TypeStr}) of + {ok,Type} -> Type; + {error,Reason} -> throw({'$typeserver',Reason}) + end. + + +%%------------------------------------------------------------------------------ +%% Function-generation functions +%%------------------------------------------------------------------------------ + +-spec create_fun(arity(), proper_types:type(), fun_seed()) -> function(). +create_fun(_Arity, _RetType, _FunSeed) -> + fun() -> throw('$arity_limit') end. + +%% @private +-spec get_ret_type(function()) -> proper_types:type(). +get_ret_type(Fun) -> + {arity,Arity} = erlang:fun_info(Fun, arity), + put('$get_ret_type', true), + RetType = apply(Fun, lists:duplicate(Arity,dummy)), + erase('$get_ret_type'), + RetType. diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_internal.hrl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_internal.hrl new file mode 100644 index 0000000000..89e6b34296 --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_internal.hrl @@ -0,0 +1,98 @@ +%%% Copyright 2010-2013 Manolis Papadakis <[email protected]>, +%%% Eirini Arvaniti <[email protected]> +%%% and Kostis Sagonas <[email protected]> +%%% +%%% This file is part of PropEr. +%%% +%%% PropEr is free software: you can redistribute it and/or modify +%%% it under the terms of the GNU General Public License as published by +%%% the Free Software Foundation, either version 3 of the License, or +%%% (at your option) any later version. +%%% +%%% PropEr is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%%% GNU General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public License +%%% along with PropEr. If not, see <http://www.gnu.org/licenses/>. + +%%% @copyright 2010-2016 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas +%%% @version {@version} +%%% @author Manolis Papadakis +%%% @doc Internal header file: This header is included in all PropEr source +%%% files. + +-include("compile_flags.hrl"). +-include("proper_common.hrl"). + + +%%------------------------------------------------------------------------------ +%% Activate strip_types parse transform +%%------------------------------------------------------------------------------ + +-ifdef(NO_TYPES). +-compile({parse_transform, strip_types}). +-endif. + +%%------------------------------------------------------------------------------ +%% Random generator selection +%%------------------------------------------------------------------------------ + +-ifdef(USE_SFMT). +-define(RANDOM_MOD, sfmt). +-define(SEED_NAME, sfmt_seed). +-else. +-define(RANDOM_MOD, random). +-define(SEED_NAME, random_seed). +-endif. + +%%------------------------------------------------------------------------------ +%% Macros +%%------------------------------------------------------------------------------ + +-define(PROPERTY_PREFIX, "prop_"). + + +%%------------------------------------------------------------------------------ +%% Constants +%%------------------------------------------------------------------------------ + +-define(SEED_RANGE, 4294967296). +-define(MAX_ARITY, 20). +-define(MAX_TRIES_FACTOR, 5). +-define(ANY_SIMPLE_PROB, 3). +-define(ANY_BINARY_PROB, 1). +-define(ANY_EXPAND_PROB, 8). +-define(SMALL_RANGE_THRESHOLD, 16#FFFF). + + +%%------------------------------------------------------------------------------ +%% Common type aliases +%%------------------------------------------------------------------------------ + +%% TODO: Perhaps these should be moved inside modules. +-type mod_name() :: atom(). +-type fun_name() :: atom(). +-type size() :: non_neg_integer(). +-type length() :: non_neg_integer(). +-type position() :: pos_integer(). +-type frequency() :: pos_integer(). +-type seed() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}. + +-type abs_form() :: erl_parse:abstract_form(). +-type abs_expr() :: erl_parse:abstract_expr(). +-type abs_clause() :: erl_parse:abstract_clause(). + +%% TODO: Replace these with the appropriate types from stdlib. +-ifdef(AT_LEAST_19). +-type abs_type() :: erl_parse:abstract_type(). +-type abs_rec_field() :: term(). % erl_parse:af_field_decl(). +-else. +-type abs_type() :: term(). +-type abs_rec_field() :: term(). +-endif. + +-type loose_tuple(T) :: {} | {T} | {T,T} | {T,T,T} | {T,T,T,T} | {T,T,T,T,T} + | {T,T,T,T,T,T} | {T,T,T,T,T,T,T} | {T,T,T,T,T,T,T,T} + | {T,T,T,T,T,T,T,T,T} | {T,T,T,T,T,T,T,T,T,T} | tuple(). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_types.erl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_types.erl new file mode 100644 index 0000000000..6b154b813b --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_types.erl @@ -0,0 +1,1353 @@ +%%% Copyright 2010-2013 Manolis Papadakis <[email protected]>, +%%% Eirini Arvaniti <[email protected]> +%%% and Kostis Sagonas <[email protected]> +%%% +%%% This file is part of PropEr. +%%% +%%% PropEr is free software: you can redistribute it and/or modify +%%% it under the terms of the GNU General Public License as published by +%%% the Free Software Foundation, either version 3 of the License, or +%%% (at your option) any later version. +%%% +%%% PropEr is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%%% GNU General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public License +%%% along with PropEr. If not, see <http://www.gnu.org/licenses/>. + +%%% @copyright 2010-2013 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas +%%% @version {@version} +%%% @author Manolis Papadakis + +%%% @doc Type manipulation functions and predefined types. +%%% +%%% == Basic types == +%%% This module defines all the basic types of the PropEr type system as +%%% functions. See the <a href="#index">function index</a> for an overview. +%%% +%%% Types can be combined in tuples or lists to produce other types. Exact +%%% values (such as exact numbers, atoms, binaries and strings) can be combined +%%% with types inside such structures, like in this example of the type of a +%%% tagged tuple: ``{'result', integer()}''. +%%% +%%% When including the PropEr header file, all +%%% <a href="#index">API functions</a> of this module are automatically +%%% imported, unless `PROPER_NO_IMPORTS' is defined. +%%% +%%% == Customized types == +%%% The following operators can be applied to basic types in order to produce +%%% new ones: +%%% +%%% <dl> +%%% <dt>`?LET(<Xs>, <Xs_type>, <In>)'</dt> +%%% <dd>To produce an instance of this type, all appearances of the variables +%%% in `<Xs>' are replaced inside `<In>' by their corresponding values in a +%%% randomly generated instance of `<Xs_type>'. It's OK for the `<In>' part to +%%% evaluate to a type - in that case, an instance of the inner type is +%%% generated recursively.</dd> +%%% <dt>`?SUCHTHAT(<X>, <Type>, <Condition>)'</dt> +%%% <dd>This produces a specialization of `<Type>', which only includes those +%%% members of `<Type>' that satisfy the constraint `<Condition>' - that is, +%%% those members for which the function `fun(<X>) -> <Condition> end' returns +%%% `true'. If the constraint is very strict - that is, only a small +%%% percentage of instances of `<Type>' pass the test - it will take a lot of +%%% tries for the instance generation subsystem to randomly produce a valid +%%% instance. This will result in slower testing, and testing may even be +%%% stopped short, in case the `constraint_tries' limit is reached (see the +%%% "Options" section in the documentation of the {@link proper} module). If +%%% this is the case, it would be more appropriate to generate valid instances +%%% of the specialized type using the `?LET' macro. Also make sure that even +%%% small instances can satisfy the constraint, since PropEr will only try +%%% small instances at the start of testing. If this is not possible, you can +%%% instruct PropEr to start at a larger size, by supplying a suitable value +%%% for the `start_size' option (see the "Options" section in the +%%% documentation of the {@link proper} module).</dd> +%%% <dt>`?SUCHTHATMAYBE(<X>, <Type>, <Condition>)'</dt> +%%% <dd>Equivalent to the `?SUCHTHAT' macro, but the constraint `<Condition>' +%%% is considered non-strict: if the `constraint_tries' limit is reached, the +%%% generator will just return an instance of `<Type>' instead of failing, +%%% even if that instance doesn't satisfy the constraint.</dd> +%%% <dt>`?SHRINK(<Generator>, <List_of_alt_gens>)'</dt> +%%% <dd>This creates a type whose instances are generated by evaluating the +%%% statement block `<Generator>' (this may evaluate to a type, which will +%%% then be generated recursively). If an instance of such a type is to be +%%% shrunk, the generators in `<List_of_alt_gens>' are first run to produce +%%% hopefully simpler instances of the type. Thus, the generators in the +%%% second argument should be simpler than the default. The simplest ones +%%% should be at the front of the list, since those are the generators +%%% preferred by the shrinking subsystem. Like the main `<Generator>', the +%%% alternatives may also evaluate to a type, which is generated recursively. +%%% </dd> +%%% <dt>`?LETSHRINK(<List_of_variables>, <List_of_types>, <Generator>)'</dt> +%%% <dd>This is created by combining a `?LET' and a `?SHRINK' macro. Instances +%%% are generated by applying a randomly generated list of values inside +%%% `<Generator>' (just like a `?LET', with the added constraint that the +%%% variables and types must be provided in a list - alternatively, +%%% `<List_of_types>' may be a list or vector type). When shrinking instances +%%% of such a type, the sub-instances that were combined to produce it are +%%% first tried in place of the failing instance.</dd> +%%% <dt>`?LAZY(<Generator>)'</dt> +%%% <dd>This construct returns a type whose only purpose is to delay the +%%% evaluation of `<Generator>' (`<Generator>' can return a type, which will +%%% be generated recursively). Using this, you can simulate the lazy +%%% generation of instances: +%%% ``` stream() -> ?LAZY(frequency([ {1,[]}, {3,[0|stream()]} ])). ''' +%%% The above type produces lists of zeroes with an average length of 3. Note +%%% that, had we not enclosed the generator with a `?LAZY' macro, the +%%% evaluation would continue indefinitely, due to the eager evaluation of +%%% the Erlang language.</dd> +%%% <dt>`non_empty(<List_or_binary_type>)'</dt> +%%% <dd>See the documentation for {@link non_empty/1}.</dd> +%%% <dt>`noshrink(<Type>)'</dt> +%%% <dd>See the documentation for {@link noshrink/1}.</dd> +%%% <dt>`default(<Default_value>, <Type>)'</dt> +%%% <dd>See the documentation for {@link default/2}.</dd> +%%% <dt>`with_parameter(<Parameter>, <Value>, <Type>)'</dt> +%%% <dd>See the documentation for {@link with_parameter/3}.</dd> +%%% <dt>`with_parameters(<Param_value_pairs>, <Type>)'</dt> +%%% <dd>See the documentation for {@link with_parameters/2}.</dd> +%%% </dl> +%%% +%%% == Size manipulation == +%%% The following operators are related to the `size' parameter, which controls +%%% the maximum size of produced instances. The actual size of a produced +%%% instance is chosen randomly, but can never exceed the value of the `size' +%%% parameter at the moment of generation. A more accurate definition is the +%%% following: the maximum instance of `size S' can never be smaller than the +%%% maximum instance of `size S-1'. The actual size of an instance is measured +%%% differently for each type: the actual size of a list is its length, while +%%% the actual size of a tree may be the number of its internal nodes. Some +%%% types, e.g. unions, have no notion of size, thus their generation is not +%%% influenced by the value of `size'. The `size' parameter starts at 1 and +%%% grows automatically during testing. +%%% +%%% <dl> +%%% <dt>`?SIZED(<S>, <Generator>)'</dt> +%%% <dd>Creates a new type, whose instances are produced by replacing all +%%% appearances of the `<S>' parameter inside the statement block +%%% `<Generator>' with the value of the `size' parameter. It's OK for the +%%% `<Generator>' to return a type - in that case, an instance of the inner +%%% type is generated recursively.</dd> +%%% <dt>`resize(<New_size>, <Type>)'</dt> +%%% <dd>See the documentation for {@link resize/2}.</dd> +%%% </dl> + +-module(proper_types). +-export([is_inst/2, is_inst/3]). + +-export([integer/2, float/2, atom/0, binary/0, binary/1, bitstring/0, + bitstring/1, list/1, vector/2, union/1, weighted_union/1, tuple/1, + loose_tuple/1, exactly/1, fixed_list/1, function/2, any/0, + shrink_list/1, safe_union/1, safe_weighted_union/1]). +-export([integer/0, non_neg_integer/0, pos_integer/0, neg_integer/0, range/2, + float/0, non_neg_float/0, number/0, boolean/0, byte/0, char/0, + list/0, tuple/0, string/0, wunion/1, term/0, timeout/0, arity/0]). +-export([int/0, nat/0, largeint/0, real/0, bool/0, choose/2, elements/1, + oneof/1, frequency/1, return/1, default/2, orderedlist/1, function0/1, + function1/1, function2/1, function3/1, function4/1, + weighted_default/2]). +-export([resize/2, non_empty/1, noshrink/1]). + +-export([cook_outer/1, is_type/1, equal_types/2, is_raw_type/1, to_binary/1, + from_binary/1, get_prop/2, find_prop/2, safe_is_instance/2, + is_instance/2, unwrap/1, weakly/1, strongly/1, satisfies_all/2, + new_type/2, subtype/2]). +-export([lazy/1, sized/1, bind/3, shrinkwith/2, add_constraint/3, + native_type/2, distlist/3, with_parameter/3, with_parameters/2, + parameter/1, parameter/2]). +-export([le/2]). + +-export_type([type/0, raw_type/0, extint/0, extnum/0]). + +-include("proper_internal.hrl"). + + +%%------------------------------------------------------------------------------ +%% Comparison with erl_types +%%------------------------------------------------------------------------------ + +%% Missing types +%% ------------------- +%% will do: +%% records, maybe_improper_list(T,S), nonempty_improper_list(T,S) +%% maybe_improper_list(), maybe_improper_list(T), iolist, iodata +%% don't need: +%% nonempty_{list,string,maybe_improper_list} +%% won't do: +%% pid, port, ref, identifier, none, no_return, module, mfa, node +%% array, dict, digraph, set, gb_tree, gb_set, queue, tid + +%% Missing type information +%% ------------------------ +%% bin types: +%% other unit sizes? what about size info? +%% functions: +%% generally some fun, unspecified number of arguments but specified +%% return type +%% any: +%% doesn't cover functions and improper lists + + +%%------------------------------------------------------------------------------ +%% Type declaration macros +%%------------------------------------------------------------------------------ + +-define(BASIC(PropList), new_type(PropList,basic)). +-define(WRAPPER(PropList), new_type(PropList,wrapper)). +-define(CONSTRUCTED(PropList), new_type(PropList,constructed)). +-define(CONTAINER(PropList), new_type(PropList,container)). +-define(SUBTYPE(Type,PropList), subtype(PropList,Type)). + + +%%------------------------------------------------------------------------------ +%% Types +%%------------------------------------------------------------------------------ + +-type type_kind() :: 'basic' | 'wrapper' | 'constructed' | 'container' | atom(). +-type instance_test() :: fun((proper_gen:imm_instance()) -> boolean()) + | {'typed', + fun((proper_types:type(), + proper_gen:imm_instance()) -> boolean())}. +-type index() :: pos_integer(). +%% @alias +-type value() :: term(). +%% @private_type +%% @alias +-type extint() :: integer() | 'inf'. +%% @private_type +%% @alias +-type extnum() :: number() | 'inf'. +-type constraint_fun() :: fun((proper_gen:instance()) -> boolean()). + +-opaque type() :: {'$type', [type_prop()]}. +%% A type of the PropEr type system +%% @type raw_type(). You can consider this as an equivalent of {@type type()}. +-type raw_type() :: type() | [raw_type()] | loose_tuple(raw_type()) | term(). +-type type_prop_name() :: 'kind' | 'generator' | 'reverse_gen' | 'parts_type' + | 'combine' | 'alt_gens' | 'shrink_to_parts' + | 'size_transform' | 'is_instance' | 'shrinkers' + | 'noshrink' | 'internal_type' | 'internal_types' + | 'get_length' | 'split' | 'join' | 'get_indices' + | 'remove' | 'retrieve' | 'update' | 'constraints' + | 'parameters' | 'env' | 'subenv'. + +-type type_prop_value() :: term(). +-type type_prop() :: + {'kind', type_kind()} + | {'generator', proper_gen:generator()} + | {'reverse_gen', proper_gen:reverse_gen()} + | {'parts_type', type()} + | {'combine', proper_gen:combine_fun()} + | {'alt_gens', proper_gen:alt_gens()} + | {'shrink_to_parts', boolean()} + | {'size_transform', fun((size()) -> size())} + | {'is_instance', instance_test()} + | {'shrinkers', [proper_shrink:shrinker()]} + | {'noshrink', boolean()} + | {'internal_type', raw_type()} + | {'internal_types', tuple() | maybe_improper_list(type(),type() | [])} + %% The items returned by 'remove' must be of this type. + | {'get_length', fun((proper_gen:imm_instance()) -> length())} + %% If this is a container type, this should return the number of elements + %% it contains. + | {'split', fun((proper_gen:imm_instance()) -> [proper_gen:imm_instance()]) + | fun((length(),proper_gen:imm_instance()) -> + {proper_gen:imm_instance(),proper_gen:imm_instance()})} + %% If present, the appropriate form depends on whether get_length is + %% defined: if get_length is undefined, this must be in the one-argument + %% form (e.g. a tree should be split into its subtrees), else it must be + %% in the two-argument form (e.g. a list should be split in two at the + %% index provided). + | {'join', fun((proper_gen:imm_instance(),proper_gen:imm_instance()) -> + proper_gen:imm_instance())} + | {'get_indices', fun((proper_types:type(), + proper_gen:imm_instance()) -> [index()])} + %% If this is a container type, this should return a list of indices we + %% can use to remove or insert elements from the given instance. + | {'remove', fun((index(),proper_gen:imm_instance()) -> + proper_gen:imm_instance())} + | {'retrieve', fun((index(), proper_gen:imm_instance() | tuple() + | maybe_improper_list(type(),type() | [])) -> + value() | type())} + | {'update', fun((index(),value(),proper_gen:imm_instance()) -> + proper_gen:imm_instance())} + | {'constraints', [{constraint_fun(), boolean()}]} + %% A list of constraints on instances of this type: each constraint is a + %% tuple of a fun that must return 'true' for each valid instance and a + %% boolean field that specifies whether the condition is strict. + | {'parameters', [{atom(),value()}]} + | {'env', term()} + | {'subenv', term()}. + + +%%------------------------------------------------------------------------------ +%% Type manipulation functions +%%------------------------------------------------------------------------------ + +%% TODO: We shouldn't need the fully qualified type name in the range of these +%% functions. + +%% @private +%% TODO: just cook/1 ? +-spec cook_outer(raw_type()) -> proper_types:type(). +cook_outer(Type = {'$type',_Props}) -> + Type; +cook_outer(RawType) -> + if + is_tuple(RawType) -> tuple(tuple_to_list(RawType)); + %% CAUTION: this must handle improper lists + is_list(RawType) -> fixed_list(RawType); + %% default case (covers integers, floats, atoms, binaries, ...): + true -> exactly(RawType) + end. + +%% @private +-spec is_type(term()) -> boolean(). +is_type({'$type',_Props}) -> + true; +is_type(_) -> + false. + +%% @private +-spec equal_types(proper_types:type(), proper_types:type()) -> boolean(). +equal_types(SameType, SameType) -> + true; +equal_types(_, _) -> + false. + +%% @private +-spec is_raw_type(term()) -> boolean(). +is_raw_type({'$type',_TypeProps}) -> + true; +is_raw_type(X) -> + if + is_tuple(X) -> is_raw_type_list(tuple_to_list(X)); + is_list(X) -> is_raw_type_list(X); + true -> false + end. + +-spec is_raw_type_list(maybe_improper_list()) -> boolean(). +%% CAUTION: this must handle improper lists +is_raw_type_list(List) -> + proper_arith:safe_any(fun is_raw_type/1, List). + +%% @private +-spec to_binary(proper_types:type()) -> binary(). +to_binary(Type) -> + term_to_binary(Type). + +%% @private +-ifdef(AT_LEAST_17). +-spec from_binary(binary()) -> proper_types:type(). +-endif. +from_binary(Binary) -> + binary_to_term(Binary). + +-spec type_from_list([type_prop()]) -> proper_types:type(). +type_from_list(KeyValueList) -> + {'$type',KeyValueList}. + +-spec add_prop(type_prop_name(), type_prop_value(), proper_types:type()) -> + proper_types:type(). +add_prop(PropName, Value, {'$type',Props}) -> + {'$type',lists:keystore(PropName, 1, Props, {PropName, Value})}. + +-spec add_props([type_prop()], proper_types:type()) -> proper_types:type(). +add_props(PropList, {'$type',OldProps}) -> + {'$type', lists:foldl(fun({N,_}=NV,Acc) -> + lists:keystore(N, 1, Acc, NV) + end, OldProps, PropList)}. + +-spec append_to_prop(type_prop_name(), type_prop_value(), + proper_types:type()) -> proper_types:type(). +append_to_prop(PropName, Value, {'$type',Props}) -> + Val = case lists:keyfind(PropName, 1, Props) of + {PropName, V} -> + V; + _ -> + [] + end, + {'$type', lists:keystore(PropName, 1, Props, + {PropName, lists:reverse([Value|Val])})}. + +-spec append_list_to_prop(type_prop_name(), [type_prop_value()], + proper_types:type()) -> proper_types:type(). +append_list_to_prop(PropName, List, {'$type',Props}) -> + {PropName, Val} = lists:keyfind(PropName, 1, Props), + {'$type', lists:keystore(PropName, 1, Props, {PropName, Val++List})}. + +%% @private +-spec get_prop(type_prop_name(), proper_types:type()) -> type_prop_value(). +get_prop(PropName, {'$type',Props}) -> + {_PropName, Val} = lists:keyfind(PropName, 1, Props), + Val. + +%% @private +-spec find_prop(type_prop_name(), proper_types:type()) -> + {'ok',type_prop_value()} | 'error'. +find_prop(PropName, {'$type',Props}) -> + case lists:keyfind(PropName, 1, Props) of + {PropName, Value} -> + {ok, Value}; + _ -> + error + end. + +%% @private +-spec new_type([type_prop()], type_kind()) -> proper_types:type(). +new_type(PropList, Kind) -> + Type = type_from_list(PropList), + add_prop(kind, Kind, Type). + +%% @private +-spec subtype([type_prop()], proper_types:type()) -> proper_types:type(). +%% TODO: should the 'is_instance' function etc. be reset for subtypes? +subtype(PropList, Type) -> + add_props(PropList, Type). + +%% @private +-spec is_inst(proper_gen:instance(), raw_type()) -> + boolean() | {'error',{'typeserver',term()}}. +is_inst(Instance, RawType) -> + is_inst(Instance, RawType, 10). + +%% @private +-spec is_inst(proper_gen:instance(), raw_type(), size()) -> + boolean() | {'error',{'typeserver',term()}}. +is_inst(Instance, RawType, Size) -> + proper:global_state_init_size(Size), + Result = safe_is_instance(Instance, RawType), + proper:global_state_erase(), + Result. + +%% @private +-spec safe_is_instance(proper_gen:imm_instance(), raw_type()) -> + boolean() | {'error',{'typeserver',term()}}. +safe_is_instance(ImmInstance, RawType) -> + try is_instance(ImmInstance, RawType) catch + throw:{'$typeserver',SubReason} -> {error, {typeserver,SubReason}} + end. + +%% @private +-spec is_instance(proper_gen:imm_instance(), raw_type()) -> boolean(). +%% TODO: If the second argument is not a type, let it pass (don't even check for +%% term equality?) - if it's a raw type, don't cook it, instead recurse +%% into it. +is_instance(ImmInstance, RawType) -> + CleanInstance = proper_gen:clean_instance(ImmInstance), + Type = cook_outer(RawType), + (case get_prop(kind, Type) of + wrapper -> wrapper_test(ImmInstance, Type); + constructed -> constructed_test(ImmInstance, Type); + _ -> false + end + orelse + case find_prop(is_instance, Type) of + {ok,{typed, IsInstance}} -> IsInstance(Type, ImmInstance); + {ok,IsInstance} -> IsInstance(ImmInstance); + error -> false + end) + andalso weakly(satisfies_all(CleanInstance, Type)). + +-spec wrapper_test(proper_gen:imm_instance(), proper_types:type()) -> boolean(). +wrapper_test(ImmInstance, Type) -> + %% TODO: check if it's actually a raw type that's returned? + lists:any(fun(T) -> is_instance(ImmInstance, T) end, unwrap(Type)). + +%% @private +-ifdef(AT_LEAST_17). +-spec unwrap(proper_types:type()) -> [proper_types:type(),...]. +-endif. +%% TODO: check if it's actually a raw type that's returned? +unwrap(Type) -> + RawInnerTypes = proper_gen:alt_gens(Type) ++ [proper_gen:normal_gen(Type)], + [cook_outer(T) || T <- RawInnerTypes]. + +-spec constructed_test(proper_gen:imm_instance(), proper_types:type()) -> + boolean(). +constructed_test({'$used',ImmParts,ImmInstance}, Type) -> + PartsType = get_prop(parts_type, Type), + Combine = get_prop(combine, Type), + is_instance(ImmParts, PartsType) andalso + begin + %% TODO: check if it's actually a raw type that's returned? + %% TODO: move construction code to proper_gen + %% TODO: non-type => should we check for strict term equality? + RawInnerType = Combine(proper_gen:clean_instance(ImmParts)), + is_instance(ImmInstance, RawInnerType) + end; +constructed_test({'$to_part',ImmInstance}, Type) -> + PartsType = get_prop(parts_type, Type), + get_prop(shrink_to_parts, Type) =:= true andalso + %% TODO: we reject non-container types + get_prop(kind, PartsType) =:= container andalso + case {find_prop(internal_type,PartsType), + find_prop(internal_types,PartsType)} of + {{ok,EachPartType},error} -> + %% The parts are in a list or a vector. + is_instance(ImmInstance, EachPartType); + {error,{ok,PartTypesList}} -> + %% The parts are in a fixed list. + %% TODO: It should always be a proper list. + lists:any(fun(T) -> is_instance(ImmInstance,T) end, PartTypesList) + end; +constructed_test(_CleanInstance, _Type) -> + %% TODO: can we do anything better? + false. + +%% @private +-spec weakly({boolean(),boolean()}) -> boolean(). +weakly({B1,_B2}) -> B1. + +%% @private +-spec strongly({boolean(),boolean()}) -> boolean(). +strongly({_B1,B2}) -> B2. + +-spec satisfies(proper_gen:instance(), {constraint_fun(),boolean()}) + -> {boolean(),boolean()}. +satisfies(Instance, {Test,false}) -> + {true,Test(Instance)}; +satisfies(Instance, {Test,true}) -> + Result = Test(Instance), + {Result,Result}. + +%% @private +-spec satisfies_all(proper_gen:instance(), proper_types:type()) -> + {boolean(),boolean()}. +satisfies_all(Instance, Type) -> + case find_prop(constraints, Type) of + {ok, Constraints} -> + L = [satisfies(Instance, C) || C <- Constraints], + {L1,L2} = lists:unzip(L), + {lists:all(fun(B) -> B end, L1), lists:all(fun(B) -> B end, L2)}; + error -> + {true,true} + end. + + +%%------------------------------------------------------------------------------ +%% Type definition functions +%%------------------------------------------------------------------------------ + +%% @private +-spec lazy(proper_gen:nosize_generator()) -> proper_types:type(). +lazy(Gen) -> + ?WRAPPER([ + {generator, Gen} + ]). + +%% @private +-spec sized(proper_gen:sized_generator()) -> proper_types:type(). +sized(Gen) -> + ?WRAPPER([ + {generator, Gen} + ]). + +%% @private +-spec bind(raw_type(), proper_gen:combine_fun(), boolean()) -> + proper_types:type(). +bind(RawPartsType, Combine, ShrinkToParts) -> + PartsType = cook_outer(RawPartsType), + ?CONSTRUCTED([ + {parts_type, PartsType}, + {combine, Combine}, + {shrink_to_parts, ShrinkToParts} + ]). + +%% @private +-spec shrinkwith(proper_gen:nosize_generator(), proper_gen:alt_gens()) -> + proper_types:type(). +shrinkwith(Gen, DelaydAltGens) -> + ?WRAPPER([ + {generator, Gen}, + {alt_gens, DelaydAltGens} + ]). + +%% @private +-spec add_constraint(raw_type(), constraint_fun(), boolean()) -> + proper_types:type(). +add_constraint(RawType, Condition, IsStrict) -> + Type = cook_outer(RawType), + append_to_prop(constraints, {Condition,IsStrict}, Type). + +%% @private +-spec native_type(mod_name(), string()) -> proper_types:type(). +native_type(Mod, TypeStr) -> + ?WRAPPER([ + {generator, fun() -> proper_gen:native_type_gen(Mod,TypeStr) end} + ]). + + +%%------------------------------------------------------------------------------ +%% Basic types +%%------------------------------------------------------------------------------ + +%% @doc All integers between `Low' and `High', bounds included. +%% `Low' and `High' must be Erlang expressions that evaluate to integers, with +%% `Low =< High'. Additionally, `Low' and `High' may have the value `inf', in +%% which case they represent minus infinity and plus infinity respectively. +%% Instances shrink towards 0 if `Low =< 0 =< High', or towards the bound with +%% the smallest absolute value otherwise. +-spec integer(extint(), extint()) -> proper_types:type(). +integer(Low, High) -> + ?BASIC([ + {env, {Low, High}}, + {generator, {typed, fun integer_gen/2}}, + {is_instance, {typed, fun integer_is_instance/2}}, + {shrinkers, [fun number_shrinker/3]} + ]). + +integer_gen(Type, Size) -> + {Low, High} = get_prop(env, Type), + proper_gen:integer_gen(Size, Low, High). + +integer_is_instance(Type, X) -> + {Low, High} = get_prop(env, Type), + is_integer(X) andalso le(Low, X) andalso le(X, High). + +number_shrinker(X, Type, S) -> + {Low, High} = get_prop(env, Type), + proper_shrink:number_shrinker(X, Low, High, S). + +%% @doc All floats between `Low' and `High', bounds included. +%% `Low' and `High' must be Erlang expressions that evaluate to floats, with +%% `Low =< High'. Additionally, `Low' and `High' may have the value `inf', in +%% which case they represent minus infinity and plus infinity respectively. +%% Instances shrink towards 0.0 if `Low =< 0.0 =< High', or towards the bound +%% with the smallest absolute value otherwise. +-spec float(extnum(), extnum()) -> proper_types:type(). +float(Low, High) -> + ?BASIC([ + {env, {Low, High}}, + {generator, {typed, fun float_gen/2}}, + {is_instance, {typed, fun float_is_instance/2}}, + {shrinkers, [fun number_shrinker/3]} + ]). + +float_gen(Type, Size) -> + {Low, High} = get_prop(env, Type), + proper_gen:float_gen(Size, Low, High). + +float_is_instance(Type, X) -> + {Low, High} = get_prop(env, Type), + is_float(X) andalso le(Low, X) andalso le(X, High). + +%% @private +-spec le(extnum(), extnum()) -> boolean(). +le(inf, _B) -> true; +le(_A, inf) -> true; +le(A, B) -> A =< B. + +%% @doc All atoms. All atoms used internally by PropEr start with a '`$'', so +%% such atoms will never be produced as instances of this type. You should also +%% refrain from using such atoms in your code, to avoid a potential clash. +%% Instances shrink towards the empty atom, ''. +-spec atom() -> proper_types:type(). +atom() -> + ?WRAPPER([ + {generator, fun proper_gen:atom_gen/1}, + {reverse_gen, fun proper_gen:atom_rev/1}, + {size_transform, fun(Size) -> erlang:min(Size,255) end}, + {is_instance, fun atom_is_instance/1} + ]). + +atom_is_instance(X) -> + is_atom(X) + %% We return false for atoms starting with '$', since these are + %% atoms used internally and never produced by the atom generator. + andalso (X =:= '' orelse hd(atom_to_list(X)) =/= $$). + +%% @doc All binaries. Instances shrink towards the empty binary, `<<>>'. +-spec binary() -> proper_types:type(). +binary() -> + ?WRAPPER([ + {generator, fun proper_gen:binary_gen/1}, + {reverse_gen, fun proper_gen:binary_rev/1}, + {is_instance, fun erlang:is_binary/1} + ]). + +%% @doc All binaries with a byte size of `Len'. +%% `Len' must be an Erlang expression that evaluates to a non-negative integer. +%% Instances shrink towards binaries of zeroes. +-spec binary(length()) -> proper_types:type(). +binary(Len) -> + ?WRAPPER([ + {env, Len}, + {generator, {typed, fun binary_len_gen/1}}, + {reverse_gen, fun proper_gen:binary_rev/1}, + {is_instance, {typed, fun binary_len_is_instance/2}} + ]). + +binary_len_gen(Type) -> + Len = get_prop(env, Type), + proper_gen:binary_len_gen(Len). + +binary_len_is_instance(Type, X) -> + Len = get_prop(env, Type), + is_binary(X) andalso byte_size(X) =:= Len. + +%% @doc All bitstrings. Instances shrink towards the empty bitstring, `<<>>'. +-spec bitstring() -> proper_types:type(). +bitstring() -> + ?WRAPPER([ + {generator, fun proper_gen:bitstring_gen/1}, + {reverse_gen, fun proper_gen:bitstring_rev/1}, + {is_instance, fun erlang:is_bitstring/1} + ]). + +%% @doc All bitstrings with a bit size of `Len'. +%% `Len' must be an Erlang expression that evaluates to a non-negative integer. +%% Instances shrink towards bitstrings of zeroes +-spec bitstring(length()) -> proper_types:type(). +bitstring(Len) -> + ?WRAPPER([ + {env, Len}, + {generator, {typed, fun bitstring_len_gen/1}}, + {reverse_gen, fun proper_gen:bitstring_rev/1}, + {is_instance, {typed, fun bitstring_len_is_instance/2}} + ]). + +bitstring_len_gen(Type) -> + Len = get_prop(env, Type), + proper_gen:bitstring_len_gen(Len). + +bitstring_len_is_instance(Type, X) -> + Len = get_prop(env, Type), + is_bitstring(X) andalso bit_size(X) =:= Len. + +%% @doc All lists containing elements of type `ElemType'. +%% Instances shrink towards the empty list, `[]'. +-spec list(ElemType::raw_type()) -> proper_types:type(). +% TODO: subtyping would be useful here (list, vector, fixed_list) +list(RawElemType) -> + ElemType = cook_outer(RawElemType), + ?CONTAINER([ + {generator, {typed, fun list_gen/2}}, + {is_instance, {typed, fun list_is_instance/2}}, + {internal_type, ElemType}, + {get_length, fun erlang:length/1}, + {split, fun lists:split/2}, + {join, fun lists:append/2}, + {get_indices, fun list_get_indices/2}, + {remove, fun proper_arith:list_remove/2}, + {retrieve, fun lists:nth/2}, + {update, fun proper_arith:list_update/3} + ]). + +list_gen(Type, Size) -> + ElemType = get_prop(internal_type, Type), + proper_gen:list_gen(Size, ElemType). + +list_is_instance(Type, X) -> + ElemType = get_prop(internal_type, Type), + list_test(X, ElemType). + +%% @doc A type that generates exactly the list `List'. Instances shrink towards +%% shorter sublists of the original list. +-spec shrink_list([term()]) -> proper_types:type(). +shrink_list(List) -> + ?CONTAINER([ + {env, List}, + {generator, {typed, fun shrink_list_gen/1}}, + {is_instance, {typed, fun shrink_list_is_instance/2}}, + {get_length, fun erlang:length/1}, + {split, fun lists:split/2}, + {join, fun lists:append/2}, + {get_indices, fun list_get_indices/2}, + {remove, fun proper_arith:list_remove/2} + ]). + +shrink_list_gen(Type) -> + get_prop(env, Type). + +shrink_list_is_instance(Type, X) -> + List = get_prop(env, Type), + is_sublist(X, List). + +-spec is_sublist([term()], [term()]) -> boolean(). +is_sublist([], _) -> true; +is_sublist(_, []) -> false; +is_sublist([H|T1], [H|T2]) -> is_sublist(T1, T2); +is_sublist(Slice, [_|T2]) -> is_sublist(Slice, T2). + +-spec list_test(proper_gen:imm_instance(), proper_types:type()) -> boolean(). +list_test(X, ElemType) -> + is_list(X) andalso lists:all(fun(E) -> is_instance(E, ElemType) end, X). + +%% @private +-spec list_get_indices(proper_gen:generator(), list()) -> [position()]. +list_get_indices(_, List) -> + lists:seq(1, length(List)). + +%% @private +%% This assumes that: +%% - instances of size S are always valid instances of size >S +%% - any recursive calls inside Gen are lazy +-spec distlist(size(), proper_gen:sized_generator(), boolean()) -> + proper_types:type(). +distlist(Size, Gen, NonEmpty) -> + ParentType = case NonEmpty of + true -> non_empty(list(Gen(Size))); + false -> list(Gen(Size)) + end, + ?SUBTYPE(ParentType, [ + {subenv, {Size, Gen, NonEmpty}}, + {generator, {typed, fun distlist_gen/1}} + ]). + +distlist_gen(Type) -> + {Size, Gen, NonEmpty} = get_prop(subenv, Type), + proper_gen:distlist_gen(Size, Gen, NonEmpty). + +%% @doc All lists of length `Len' containing elements of type `ElemType'. +%% `Len' must be an Erlang expression that evaluates to a non-negative integer. +-spec vector(length(), ElemType::raw_type()) -> proper_types:type(). +vector(Len, RawElemType) -> + ElemType = cook_outer(RawElemType), + ?CONTAINER([ + {env, Len}, + {generator, {typed, fun vector_gen/1}}, + {is_instance, {typed, fun vector_is_instance/2}}, + {internal_type, ElemType}, + {get_indices, fun vector_get_indices/2}, + {retrieve, fun lists:nth/2}, + {update, fun proper_arith:list_update/3} + ]). + +vector_gen(Type) -> + Len = get_prop(env, Type), + ElemType = get_prop(internal_type, Type), + proper_gen:vector_gen(Len, ElemType). + +vector_is_instance(Type, X) -> + Len = get_prop(env, Type), + ElemType = get_prop(internal_type, Type), + is_list(X) + andalso length(X) =:= Len + andalso lists:all(fun(E) -> is_instance(E, ElemType) end, X). + +vector_get_indices(Type, _X) -> + lists:seq(1, get_prop(env, Type)). + +%% @doc The union of all types in `ListOfTypes'. `ListOfTypes' can't be empty. +%% The random instance generator is equally likely to choose any one of the +%% types in `ListOfTypes'. The shrinking subsystem will always try to shrink an +%% instance of a type union to an instance of the first type in `ListOfTypes', +%% thus you should write the simplest case first. +-spec union(ListOfTypes::[raw_type(),...]) -> proper_types:type(). +union(RawChoices) -> + Choices = [cook_outer(C) || C <- RawChoices], + ?BASIC([ + {env, Choices}, + {generator, {typed, fun union_gen/1}}, + {is_instance, {typed, fun union_is_instance/2}}, + {shrinkers, [fun union_shrinker_1/3, fun union_shrinker_2/3]} + ]). + +union_gen(Type) -> + Choices = get_prop(env,Type), + proper_gen:union_gen(Choices). + +union_is_instance(Type, X) -> + Choices = get_prop(env, Type), + lists:any(fun(C) -> is_instance(X, C) end, Choices). + +union_shrinker_1(X, Type, S) -> + Choices = get_prop(env, Type), + proper_shrink:union_first_choice_shrinker(X, Choices, S). + +union_shrinker_2(X, Type, S) -> + Choices = get_prop(env, Type), + proper_shrink:union_recursive_shrinker(X, Choices, S). + +%% @doc A specialization of {@link union/1}, where each type in `ListOfTypes' is +%% assigned a frequency. Frequencies must be Erlang expressions that evaluate to +%% positive integers. Types with larger frequencies are more likely to be chosen +%% by the random instance generator. The shrinking subsystem will ignore the +%% frequencies and try to shrink towards the first type in the list. +-spec weighted_union(ListOfTypes::[{frequency(),raw_type()},...]) -> + proper_types:type(). +weighted_union(RawFreqChoices) -> + CookFreqType = fun({Freq,RawType}) -> {Freq,cook_outer(RawType)} end, + FreqChoices = lists:map(CookFreqType, RawFreqChoices), + Choices = [T || {_F,T} <- FreqChoices], + ?SUBTYPE(union(Choices), [ + {subenv, FreqChoices}, + {generator, {typed, fun weighted_union_gen/1}} + ]). + +weighted_union_gen(Gen) -> + FreqChoices = get_prop(subenv, Gen), + proper_gen:weighted_union_gen(FreqChoices). + +%% @private +-spec safe_union([raw_type(),...]) -> proper_types:type(). +safe_union(RawChoices) -> + Choices = [cook_outer(C) || C <- RawChoices], + subtype( + [{subenv, Choices}, + {generator, {typed, fun safe_union_gen/1}}], + union(Choices)). + +safe_union_gen(Type) -> + Choices = get_prop(subenv, Type), + proper_gen:safe_union_gen(Choices). + +%% @private +-spec safe_weighted_union([{frequency(),raw_type()},...]) -> + proper_types:type(). +safe_weighted_union(RawFreqChoices) -> + CookFreqType = fun({Freq,RawType}) -> + {Freq,cook_outer(RawType)} end, + FreqChoices = lists:map(CookFreqType, RawFreqChoices), + Choices = [T || {_F,T} <- FreqChoices], + subtype([{subenv, FreqChoices}, + {generator, {typed, fun safe_weighted_union_gen/1}}], + union(Choices)). + +safe_weighted_union_gen(Type) -> + FreqChoices = get_prop(subenv, Type), + proper_gen:safe_weighted_union_gen(FreqChoices). + +%% @doc All tuples whose i-th element is an instance of the type at index i of +%% `ListOfTypes'. Also written simply as a tuple of types. +-spec tuple(ListOfTypes::[raw_type()]) -> proper_types:type(). +tuple(RawFields) -> + Fields = [cook_outer(F) || F <- RawFields], + ?CONTAINER([ + {env, Fields}, + {generator, {typed, fun tuple_gen/1}}, + {is_instance, {typed, fun tuple_is_instance/2}}, + {internal_types, list_to_tuple(Fields)}, + {get_indices, fun tuple_get_indices/2}, + {retrieve, fun erlang:element/2}, + {update, fun tuple_update/3} + ]). + +tuple_gen(Type) -> + Fields = get_prop(env, Type), + proper_gen:tuple_gen(Fields). + +tuple_is_instance(Type, X) -> + Fields = get_prop(env, Type), + is_tuple(X) andalso fixed_list_test(tuple_to_list(X), Fields). + +tuple_get_indices(Type, _X) -> + lists:seq(1, length(get_prop(env, Type))). + +-spec tuple_update(index(), value(), tuple()) -> tuple(). +tuple_update(Index, NewElem, Tuple) -> + setelement(Index, Tuple, NewElem). + +%% @doc Tuples whose elements are all of type `ElemType'. +%% Instances shrink towards the 0-size tuple, `{}'. +-spec loose_tuple(ElemType::raw_type()) -> proper_types:type(). +loose_tuple(RawElemType) -> + ElemType = cook_outer(RawElemType), + ?WRAPPER([ + {env, ElemType}, + {generator, {typed, fun loose_tuple_gen/2}}, + {reverse_gen, {typed, fun loose_tuple_rev/2}}, + {is_instance, {typed, fun loose_tuple_is_instance/2}} + ]). + +loose_tuple_gen(Type, Size) -> + ElemType = get_prop(env, Type), + proper_gen:loose_tuple_gen(Size, ElemType). + +loose_tuple_rev(Type, X) -> + ElemType = get_prop(env, Type), + proper_gen:loose_tuple_rev(X, ElemType). + +loose_tuple_is_instance(Type, X) -> + ElemType = get_prop(env, Type), + is_tuple(X) andalso list_test(tuple_to_list(X), ElemType). + +%% @doc Singleton type consisting only of `E'. `E' must be an evaluated term. +%% Also written simply as `E'. +-spec exactly(term()) -> proper_types:type(). +exactly(E) -> + ?BASIC([ + {env, E}, + {generator, {typed, fun exactly_gen/1}}, + {is_instance, {typed, fun exactly_is_instance/2}} + ]). + +exactly_gen(Type) -> + E = get_prop(env, Type), + proper_gen:exactly_gen(E). + +exactly_is_instance(Type, X) -> + E = get_prop(env, Type), + X =:= E. + +%% @doc All lists whose i-th element is an instance of the type at index i of +%% `ListOfTypes'. Also written simply as a list of types. +-spec fixed_list(ListOfTypes::maybe_improper_list(raw_type(),raw_type()|[])) -> + proper_types:type(). +fixed_list(MaybeImproperRawFields) -> + %% CAUTION: must handle improper lists + {Fields, Internal, Len, Retrieve, Update} = + case proper_arith:cut_improper_tail(MaybeImproperRawFields) of + % TODO: have cut_improper_tail return the length and use it in test? + {ProperRawHead, ImproperRawTail} -> + HeadLen = length(ProperRawHead), + CookedHead = [cook_outer(F) || F <- ProperRawHead], + CookedTail = cook_outer(ImproperRawTail), + {{CookedHead,CookedTail}, + CookedHead ++ CookedTail, + HeadLen + 1, + fun(I,L) -> improper_list_retrieve(I, L, HeadLen) end, + fun(I,V,L) -> improper_list_update(I, V, L, HeadLen) end}; + ProperRawFields -> + LocalFields = [cook_outer(F) || F <- ProperRawFields], + {LocalFields, + LocalFields, + length(ProperRawFields), + fun lists:nth/2, + fun proper_arith:list_update/3} + end, + ?CONTAINER([ + {env, {Fields, Len}}, + {generator, {typed, fun fixed_list_gen/1}}, + {is_instance, {typed, fun fixed_list_is_instance/2}}, + {internal_types, Internal}, + {get_indices, fun fixed_list_get_indices/2}, + {retrieve, Retrieve}, + {update, Update} + ]). + +fixed_list_gen(Type) -> + {Fields, _} = get_prop(env, Type), + proper_gen:fixed_list_gen(Fields). + +fixed_list_is_instance(Type, X) -> + {Fields, _} = get_prop(env, Type), + fixed_list_test(X, Fields). + +fixed_list_get_indices(Type, _X) -> + {_, Len} = get_prop(env, Type), + lists:seq(1, Len). + +-spec fixed_list_test(proper_gen:imm_instance(), + [proper_types:type()] | {[proper_types:type()], + proper_types:type()}) -> + boolean(). +fixed_list_test(X, {ProperHead,ImproperTail}) -> + is_list(X) andalso + begin + ProperHeadLen = length(ProperHead), + proper_arith:head_length(X) >= ProperHeadLen andalso + begin + {XHead,XTail} = lists:split(ProperHeadLen, X), + fixed_list_test(XHead, ProperHead) + andalso is_instance(XTail, ImproperTail) + end + end; +fixed_list_test(X, ProperFields) -> + is_list(X) + andalso length(X) =:= length(ProperFields) + andalso lists:all(fun({E,T}) -> is_instance(E, T) end, + lists:zip(X, ProperFields)). + +%% TODO: Move these 2 functions to proper_arith? +-spec improper_list_retrieve(index(), nonempty_improper_list(value(),value()), + pos_integer()) -> value(). +improper_list_retrieve(Index, List, HeadLen) -> + case Index =< HeadLen of + true -> lists:nth(Index, List); + false -> lists:nthtail(HeadLen, List) + end. + +-spec improper_list_update(index(), value(), + nonempty_improper_list(value(),value()), + pos_integer()) -> + nonempty_improper_list(value(),value()). +improper_list_update(Index, Value, List, HeadLen) -> + case Index =< HeadLen of + %% TODO: This happens to work, but is not implied by list_update's spec. + true -> proper_arith:list_update(Index, Value, List); + false -> lists:sublist(List, HeadLen) ++ Value + end. + +%% @doc All pure functions that map instances of `ArgTypes' to instances of +%% `RetType'. The syntax `function(Arity, RetType)' is also acceptable. +-spec function(ArgTypes::[raw_type()] | arity(), RetType::raw_type()) -> + proper_types:type(). +function(Arity, RawRetType) when is_integer(Arity), Arity >= 0, Arity =< 255 -> + RetType = cook_outer(RawRetType), + ?BASIC([ + {env, {Arity, RetType}}, + {generator, {typed, fun function_gen/1}}, + {is_instance, {typed, fun function_is_instance/2}} + ]); +function(RawArgTypes, RawRetType) -> + function(length(RawArgTypes), RawRetType). + +function_gen(Type) -> + {Arity, RetType} = get_prop(env, Type), + proper_gen:function_gen(Arity, RetType). + +function_is_instance(Type, X) -> + {Arity, RetType} = get_prop(env, Type), + is_function(X, Arity) + %% TODO: what if it's not a function we produced? + andalso equal_types(RetType, proper_gen:get_ret_type(X)). + +%% @doc All Erlang terms (that PropEr can produce). For reasons of efficiency, +%% functions are never produced as instances of this type.<br /> +%% CAUTION: Instances of this type are expensive to produce, shrink and instance- +%% check, both in terms of processing time and consumed memory. Only use this +%% type if you are certain that you need it. +-spec any() -> proper_types:type(). +any() -> + AllTypes = [integer(),float(),atom(),bitstring(),?LAZY(loose_tuple(any())), + ?LAZY(list(any()))], + ?SUBTYPE(union(AllTypes), [ + {generator, fun proper_gen:any_gen/1} + ]). + + +%%------------------------------------------------------------------------------ +%% Type aliases +%%------------------------------------------------------------------------------ + +%% @equiv integer(inf, inf) +-spec integer() -> proper_types:type(). +integer() -> integer(inf, inf). + +%% @equiv integer(0, inf) +-spec non_neg_integer() -> proper_types:type(). +non_neg_integer() -> integer(0, inf). + +%% @equiv integer(1, inf) +-spec pos_integer() -> proper_types:type(). +pos_integer() -> integer(1, inf). + +%% @equiv integer(inf, -1) +-spec neg_integer() -> proper_types:type(). +neg_integer() -> integer(inf, -1). + +%% @equiv integer(Low, High) +-spec range(extint(), extint()) -> proper_types:type(). +range(Low, High) -> integer(Low, High). + +%% @equiv float(inf, inf) +-spec float() -> proper_types:type(). +float() -> float(inf, inf). + +%% @equiv float(0.0, inf) +-spec non_neg_float() -> proper_types:type(). +non_neg_float() -> float(0.0, inf). + +%% @equiv union([integer(), float()]) +-spec number() -> proper_types:type(). +number() -> union([integer(), float()]). + +%% @doc The atoms `true' and `false'. Instances shrink towards `false'. +-spec boolean() -> proper_types:type(). +boolean() -> union(['false', 'true']). + +%% @equiv integer(0, 255) +-spec byte() -> proper_types:type(). +byte() -> integer(0, 255). + +%% @equiv integer(0, 16#10ffff) +-spec char() -> proper_types:type(). +char() -> integer(0, 16#10ffff). + +%% @equiv list(any()) +-spec list() -> proper_types:type(). +list() -> list(any()). + +%% @equiv loose_tuple(any()) +-spec tuple() -> proper_types:type(). +tuple() -> loose_tuple(any()). + +%% @equiv list(char()) +-spec string() -> proper_types:type(). +string() -> list(char()). + +%% @equiv weighted_union(FreqChoices) +-spec wunion([{frequency(),raw_type()},...]) -> proper_types:type(). +wunion(FreqChoices) -> weighted_union(FreqChoices). + +%% @equiv any() +-spec term() -> proper_types:type(). +term() -> any(). + +%% @equiv union([non_neg_integer() | infinity]) +-spec timeout() -> proper_types:type(). +timeout() -> union([non_neg_integer(), 'infinity']). + +%% @equiv integer(0, 255) +-spec arity() -> proper_types:type(). +arity() -> integer(0, 255). + + +%%------------------------------------------------------------------------------ +%% QuickCheck compatibility types +%%------------------------------------------------------------------------------ + +%% @doc Small integers (bound by the current value of the `size' parameter). +%% Instances shrink towards `0'. +-spec int() -> proper_types:type(). +int() -> ?SIZED(Size, integer(-Size,Size)). + +%% @doc Small non-negative integers (bound by the current value of the `size' +%% parameter). Instances shrink towards `0'. +-spec nat() -> proper_types:type(). +nat() -> ?SIZED(Size, integer(0,Size)). + +%% @equiv integer() +-spec largeint() -> proper_types:type(). +largeint() -> integer(). + +%% @equiv float() +-spec real() -> proper_types:type(). +real() -> float(). + +%% @equiv boolean() +-spec bool() -> proper_types:type(). +bool() -> boolean(). + +%% @equiv integer(Low, High) +-spec choose(extint(), extint()) -> proper_types:type(). +choose(Low, High) -> integer(Low, High). + +%% @equiv union(Choices) +-spec elements([raw_type(),...]) -> proper_types:type(). +elements(Choices) -> union(Choices). + +%% @equiv union(Choices) +-spec oneof([raw_type(),...]) -> proper_types:type(). +oneof(Choices) -> union(Choices). + +%% @equiv weighted_union(Choices) +-spec frequency([{frequency(),raw_type()},...]) -> proper_types:type(). +frequency(FreqChoices) -> weighted_union(FreqChoices). + +%% @equiv exactly(E) +-spec return(term()) -> proper_types:type(). +return(E) -> exactly(E). + +%% @doc Adds a default value, `Default', to `Type'. +%% The default serves as a primary shrinking target for instances, while it +%% is also chosen by the random instance generation subsystem half the time. +-spec default(raw_type(), raw_type()) -> proper_types:type(). +default(Default, Type) -> + union([Default, Type]). + +%% @doc All sorted lists containing elements of type `ElemType'. +%% Instances shrink towards the empty list, `[]'. +-spec orderedlist(ElemType::raw_type()) -> proper_types:type(). +orderedlist(RawElemType) -> + ?LET(L, list(RawElemType), lists:sort(L)). + +%% @equiv function(0, RetType) +-spec function0(raw_type()) -> proper_types:type(). +function0(RetType) -> + function(0, RetType). + +%% @equiv function(1, RetType) +-spec function1(raw_type()) -> proper_types:type(). +function1(RetType) -> + function(1, RetType). + +%% @equiv function(2, RetType) +-spec function2(raw_type()) -> proper_types:type(). +function2(RetType) -> + function(2, RetType). + +%% @equiv function(3, RetType) +-spec function3(raw_type()) -> proper_types:type(). +function3(RetType) -> + function(3, RetType). + +%% @equiv function(4, RetType) +-spec function4(raw_type()) -> proper_types:type(). +function4(RetType) -> + function(4, RetType). + +%% @doc A specialization of {@link default/2}, where `Default' and `Type' are +%% assigned weights to be considered by the random instance generator. The +%% shrinking subsystem will ignore the weights and try to shrink using the +%% default value. +-spec weighted_default({frequency(),raw_type()}, {frequency(),raw_type()}) -> + proper_types:type(). +weighted_default(Default, Type) -> + weighted_union([Default, Type]). + + +%%------------------------------------------------------------------------------ +%% Additional type specification functions +%%------------------------------------------------------------------------------ + +%% @doc Overrides the `size' parameter used when generating instances of +%% `Type' with `NewSize'. Has no effect on size-less types, such as unions. +%% Also, this will not affect the generation of any internal types contained in +%% `Type', such as the elements of a list - those will still be generated +%% using the test-wide value of `size'. One use of this function is to modify +%% types to produce instances that grow faster or slower, like so: +%% ```?SIZED(Size, resize(Size * 2, list(integer()))''' +%% The above specifies a list type that grows twice as fast as normal lists. +-spec resize(size(), Type::raw_type()) -> proper_types:type(). +resize(NewSize, RawType) -> + Type = cook_outer(RawType), + case find_prop(size_transform, Type) of + {ok,Transform} -> + add_prop(size_transform, fun(_S) -> Transform(NewSize) end, Type); + error -> + add_prop(size_transform, fun(_S) -> NewSize end, Type) + end. + +%% @doc This is a predefined constraint that can be applied to random-length +%% list and binary types to ensure that the produced values are never empty. +%% +%% e.g. {@link list/0}, {@link string/0}, {@link binary/0}) +-spec non_empty(ListType::raw_type()) -> proper_types:type(). +non_empty(RawListType) -> + ?SUCHTHAT(L, RawListType, L =/= [] andalso L =/= <<>>). + +%% @doc Creates a new type which is equivalent to `Type', but whose instances +%% are never shrunk by the shrinking subsystem. +-spec noshrink(Type::raw_type()) -> proper_types:type(). +noshrink(RawType) -> + add_prop(noshrink, true, cook_outer(RawType)). + +%% @doc Associates the atom key `Parameter' with the value `Value' while +%% generating instances of `Type'. +-spec with_parameter(atom(), value(), Type::raw_type()) -> proper_types:type(). +with_parameter(Parameter, Value, RawType) -> + with_parameters([{Parameter,Value}], RawType). + +%% @doc Similar to {@link with_parameter/3}, but accepts a list of +%% `{Parameter, Value}' pairs. +-spec with_parameters([{atom(),value()}], Type::raw_type()) -> + proper_types:type(). +with_parameters(PVlist, RawType) -> + Type = cook_outer(RawType), + case find_prop(parameters, Type) of + {ok,Params} when is_list(Params) -> + append_list_to_prop(parameters, PVlist, Type); + error -> + add_prop(parameters, PVlist, Type) + end. + +%% @doc Returns the value associated with `Parameter', or `Default' in case +%% `Parameter' is not associated with any value. +-spec parameter(atom(), value()) -> value(). +parameter(Parameter, Default) -> + Parameters = + case erlang:get('$parameters') of + undefined -> []; + List -> List + end, + proplists:get_value(Parameter, Parameters, Default). + +%% @equiv parameter(Parameter, undefined) +-spec parameter(atom()) -> value(). +parameter(Parameter) -> + parameter(Parameter, undefined). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl new file mode 100644 index 0000000000..b16075763f --- /dev/null +++ b/lib/dialyzer/test/behaviour_SUITE_data/src/proper/proper_typeserver.erl @@ -0,0 +1,2411 @@ +%%% Copyright 2010-2016 Manolis Papadakis <[email protected]>, +%%% Eirini Arvaniti <[email protected]> +%%% and Kostis Sagonas <[email protected]> +%%% +%%% This file is part of PropEr. +%%% +%%% PropEr is free software: you can redistribute it and/or modify +%%% it under the terms of the GNU General Public License as published by +%%% the Free Software Foundation, either version 3 of the License, or +%%% (at your option) any later version. +%%% +%%% PropEr is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%%% GNU General Public License for more details. +%%% +%%% You should have received a copy of the GNU General Public License +%%% along with PropEr. If not, see <http://www.gnu.org/licenses/>. + +%%% @copyright 2010-2016 Manolis Papadakis, Eirini Arvaniti and Kostis Sagonas +%%% @version {@version} +%%% @author Manolis Papadakis + +%%% @doc Erlang type system - PropEr type system integration module. +%%% +%%% PropEr can parse types expressed in Erlang's type language and convert them +%%% to its own type format. Such expressions can be used instead of regular type +%%% constructors in the second argument of `?FORALL's. No extra notation is +%%% required; PropEr will detect which calls correspond to native types by +%%% applying a parse transform during compilation. This parse transform is +%%% automatically applied to any module that includes the `proper.hrl' header +%%% file. You can disable this feature by compiling your modules with +%%% `-DPROPER_NO_TRANS'. Note that this will currently also disable the +%%% automatic exporting of properties. +%%% +%%% The use of native types in properties is subject to the following usage +%%% rules: +%%% <ul> +%%% <li>Native types cannot be used outside of `?FORALL's.</li> +%%% <li>Inside `?FORALL's, native types can be combined with other native +%%% types, and even with PropEr types, inside tuples and lists (the constructs +%%% `[...]', `{...}' and `++' are all allowed).</li> +%%% <li>All other constructs of Erlang's built-in type system (e.g. `|' for +%%% union, `_' as an alias of `any()', `<<_:_>>' binary type syntax and +%%% `fun((...) -> ...)' function type syntax) are not allowed in `?FORALL's, +%%% because they are rejected by the Erlang parser.</li> +%%% <li>Anything other than a tuple constructor, list constructor, `++' +%%% application, local or remote call will automatically be considered a +%%% PropEr type constructor and not be processed further by the parse +%%% transform.</li> +%%% <li>Parametric native types are fully supported; of course, they can only +%%% appear instantiated in a `?FORALL'. The arguments of parametric native +%%% types are always interpreted as native types.</li> +%%% <li>Parametric PropEr types, on the other hand, can take any kind of +%%% argument. You can even mix native and PropEr types in the arguments of a +%%% PropEr type. For example, assuming that the following declarations are +%%% present: +%%% ``` my_proper_type() -> ?LET(...). +%%% -type my_native_type() :: ... .''' +%%% Then the following expressions are all legal: +%%% ``` vector(2, my_native_type()) +%%% function(0, my_native_type()) +%%% union([my_proper_type(), my_native_type()])''' </li> +%%% <li>Some type constructors can take native types as arguments (but only +%%% inside `?FORALL's): +%%% <ul> +%%% <li>`?SUCHTHAT', `?SUCHTHATMAYBE', `non_empty', `noshrink': these work +%%% with native types too</li> +%%% <li>`?LAZY', `?SHRINK', `resize', `?SIZED': these don't work with native +%%% types</li> +%%% <li>`?LET', `?LETSHRINK': only the top-level base type can be a native +%%% type</li> +%%% </ul></li> +%%% <li>Native type declarations in the `?FORALL's of a module can reference any +%%% custom type declared in a `-type' or `-opaque' attribute of the same +%%% module, as long as no module identifier is used.</li> +%%% <li>Typed records cannot be referenced inside `?FORALL's using the +%%% `#rec_name{}' syntax. To use a typed record in a `?FORALL', enclose the +%%% record in a custom type like so: +%%% ``` -type rec_name() :: #rec_name{}. ''' +%%% and use the custom type instead.</li> +%%% <li>`?FORALL's may contain references to self-recursive or mutually +%%% recursive native types, so long as each type in the hierarchy has a clear +%%% base case. +%%% Currently, PropEr requires that the toplevel of any recursive type +%%% declaration is either a (maybe empty) list or a union containing at least +%%% one choice that doesn't reference the type directly (it may, however, +%%% reference any of the types that are mutually recursive with it). This +%%% means, for example, that some valid recursive type declarations, such as +%%% this one: +%%% ``` ?FORALL(..., a(), ...) ''' +%%% where: +%%% ``` -type a() :: {'a','none' | a()}. ''' +%%% are not accepted by PropEr. However, such types can be rewritten in a way +%%% that allows PropEr to parse them: +%%% ``` ?FORALL(..., a(), ...) ''' +%%% where: +%%% ``` -type a() :: {'a','none'} | {'a',a()}. ''' +%%% This also means that recursive record declarations are not allowed: +%%% ``` ?FORALL(..., rec(), ...) ''' +%%% where: +%%% ``` -type rec() :: #rec{}. +%%% -record(rec, {a = 0 :: integer(), b = 'nil' :: 'nil' | #rec{}}). ''' +%%% A little rewritting can usually remedy this problem as well: +%%% ``` ?FORALL(..., rec(), ...) ''' +%%% where: +%%% ``` -type rec() :: #rec{b :: 'nil'} | #rec{b :: rec()}. +%%% -record(rec, {a = 0 :: integer(), b = 'nil' :: 'nil' | #rec{}}). ''' +%%% </li> +%%% <li>Remote types may be referenced in a `?FORALL', so long as they are +%%% exported from the remote module. Currently, PropEr requires that any +%%% remote modules whose types are directly referenced from within properties +%%% are present in the code path at compile time, either compiled with +%%% `debug_info' enabled or in source form. If PropEr cannot find a remote +%%% module at all, finds only a compiled object file with no debug +%%% information or fails to compile the source file, all calls to that module +%%% will automatically be considered calls to PropEr type constructors.</li> +%%% <li>For native types to be translated correctly, both the module that +%%% contains the `?FORALL' declaration as well as any module that contains +%%% the declaration of a type referenced (directly or indirectly) from inside +%%% a `?FORALL' must be present in the code path at runtime, either compiled +%%% with `debug_info' enabled or in source form.</li> +%%% <li>Local types with the same name as an auto-imported BIF are not accepted +%%% by PropEr, unless the BIF in question has been declared in a +%%% `no_auto_import' option.</li> +%%% <li>When an expression can be interpreted both as a PropEr type and as a +%%% native type, the former takes precedence. This means that a function +%%% `foo()' will shadow a type `foo()' if they are both present in the module. +%%% The same rule applies to remote functions and types as well.</li> +%%% <li>The above may cause some confusion when list syntax is used: +%%% <ul> +%%% <li>The expression `[integer()]' can be interpreted both ways, so the +%%% PropEr way applies. Therefore, instances of this type will always be +%%% lists of length 1, not arbitrary integer lists, as would be expected +%%% when interpreting the expression as a native type.</li> +%%% <li>Assuming that a custom type foo/1 has been declared, the expression +%%% `foo([integer()])' can only be interpreted as a native type declaration, +%%% which means that the generic type of integer lists will be passed to +%%% `foo/1'.</li> +%%% </ul></li> +%%% <li>Currently, PropEr does not detect the following mistakes: +%%% <ul> +%%% <li>inline record-field specializations that reference non-existent +%%% fields</li> +%%% <li>type parameters that are not present in the RHS of a `-type' +%%% declaration</li> +%%% <li>using `_' as a type variable in the LHS of a `-type' declaration</li> +%%% <li>using the same variable in more than one position in the LHS of a +%%% `-type' declaration</li> +%%% </ul> +%%% </li> +%%% </ul> +%%% +%%% You can use <a href="#index">these</a> functions to try out the type +%%% translation subsystem. +%%% +%%% CAUTION: These functions should never be used inside properties. They are +%%% meant for demonstration purposes only. + +-module(proper_typeserver). +-behaviour(gen_server). +-export([demo_translate_type/2, demo_is_instance/3]). + +-export([start/0, restart/0, stop/0, create_spec_test/3, get_exp_specced/1, + is_instance/3, translate_type/1]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, + code_change/3]). +-export([get_exp_info/1, match/2]). + +-export_type([imm_type/0, mod_exp_types/0, mod_exp_funs/0]). + +-include("proper_internal.hrl"). + + +%%------------------------------------------------------------------------------ +%% Macros +%%------------------------------------------------------------------------------ + +-define(SRC_FILE_EXT, ".erl"). + +-ifdef(AT_LEAST_19). +-define(anno(L), erl_anno:new(L)). +-else. +-define(anno(L), L). +-endif. + +%% Starting with 18.0 we need to handle both 'type' and 'user_type' tags; +%% prior Erlang/OTP releases had only 'type' as a tag. +-define(IS_TYPE_TAG(T), (T =:= type orelse T =:= user_type)). + +%% CAUTION: all these must be sorted +-define(STD_TYPES_0, + [any,arity,atom,binary,bitstring,bool,boolean,byte,char,float,integer, + list,neg_integer,non_neg_integer,number,pos_integer,string,term, + timeout]). +-define(HARD_ADTS, + %% gb_trees:iterator and gb_sets:iterator are NOT hardcoded + [{{array,0},array}, {{array,1},proper_array}, + {{dict,0},dict}, {{dict,2},proper_dict}, + {{gb_set,0},gb_sets}, {{gb_set,1},proper_gb_sets}, + {{gb_tree,0},gb_trees}, {{gb_tree,2},proper_gb_trees}, + {{orddict,2},proper_orddict}, + {{ordset,1},proper_ordsets}, + {{queue,0},queue}, {{queue,1},proper_queue}, + {{set,0},sets}, {{set,1},proper_sets}]). +-define(HARD_ADT_MODS, + [{array, [{{array,0}, + {{type,0,record,[{atom,0,array}]},[]}}]}, + {dict, [{{dict,0}, + {{type,0,record,[{atom,0,dict}]},[]}}]}, + {gb_sets, [{{gb_set,0}, + {{type,0,tuple,[{type,0,non_neg_integer,[]}, + {type,0,gb_set_node,[]}]},[]}}]}, + {gb_trees, [{{gb_tree,0}, + {{type,0,tuple,[{type,0,non_neg_integer,[]}, + {type,0,gb_tree_node,[]}]},[]}}]}, + %% Our parametric ADTs are already declared as normal types, we just + %% need to change them to opaques. + {proper_array, [{{array,1},already_declared}]}, + {proper_dict, [{{dict,2},already_declared}]}, + {proper_gb_sets, [{{gb_set,1},already_declared}, + {{iterator,1},already_declared}]}, + {proper_gb_trees, [{{gb_tree,2},already_declared}, + {{iterator,2},already_declared}]}, + {proper_orddict, [{{orddict,2},already_declared}]}, + {proper_ordsets, [{{ordset,1},already_declared}]}, + {proper_queue, [{{queue,1},already_declared}]}, + {proper_sets, [{{set,1},already_declared}]}, + {queue, [{{queue,0}, + {{type,0,tuple,[{type,0,list,[]},{type,0,list,[]}]},[]}}]}, + {sets, [{{set,0}, + {{type,0,record,[{atom,0,set}]},[]}}]}]). + + +%%------------------------------------------------------------------------------ +%% Types +%%------------------------------------------------------------------------------ + +-type type_name() :: atom(). +-type var_name() :: atom(). %% TODO: also integers? +-type field_name() :: atom(). + +-type type_kind() :: 'type' | 'record'. +-type type_ref() :: {type_kind(),type_name(),arity()}. +-ifdef(NO_MODULES_IN_OPAQUES). +-type substs_dict() :: dict(). %% dict(field_name(),ret_type()) +-else. +-type substs_dict() :: dict:dict(field_name(),ret_type()). +-endif. +-type full_type_ref() :: {mod_name(),type_kind(),type_name(), + [ret_type()] | substs_dict()}. +-type symb_info() :: 'not_symb' | {'orig_abs',abs_type()}. +-type type_repr() :: {'abs_type',abs_type(),[var_name()],symb_info()} + | {'cached',fin_type(),abs_type(),symb_info()} + | {'abs_record',[{field_name(),abs_type()}]}. +-type gen_fun() :: fun((size()) -> fin_type()). +-type rec_fun() :: fun(([gen_fun()],size()) -> fin_type()). +-type rec_arg() :: {boolean() | {'list',boolean(),rec_fun()},full_type_ref()}. +-type rec_args() :: [rec_arg()]. +-type ret_type() :: {'simple',fin_type()} | {'rec',rec_fun(),rec_args()}. +-type rec_fun_info() :: {pos_integer(),pos_integer(),[arity(),...], + [rec_fun(),...]}. + +-type imm_type_ref() :: {type_name(),arity()}. +-type hard_adt_repr() :: {abs_type(),[var_name()]} | 'already_declared'. +-type fun_ref() :: {fun_name(),arity()}. +-type fun_repr() :: fun_clause_repr(). +-type fun_clause_repr() :: {[abs_type()],abs_type()}. +-type proc_fun_ref() :: {fun_name(),[abs_type()],abs_type()}. +-type full_imm_type_ref() :: {mod_name(),type_name(),arity()}. +-type imm_stack() :: [full_imm_type_ref()]. +-type pat_field() :: 0 | 1 | atom(). +-type pattern() :: loose_tuple(pat_field()). +-type next_step() :: 'none' | 'take_head' | {'match_with',pattern()}. + +-ifdef(NO_MODULES_IN_OPAQUES). +%% @private_type +-type mod_exp_types() :: set(). %% set(imm_type_ref()) +-type mod_types() :: dict(). %% dict(type_ref(),type_repr()) +%% @private_type +-type mod_exp_funs() :: set(). %% set(fun_ref()) +-type mod_specs() :: dict(). %% dict(fun_ref(),fun_repr()) +-else. +%% @private_type +-type mod_exp_types() :: sets:set(imm_type_ref()). +-type mod_types() :: dict:dict(type_ref(),type_repr()). +%% @private_type +-type mod_exp_funs() :: sets:set(fun_ref()). +-type mod_specs() :: dict:dict(fun_ref(),fun_repr()). +-endif. + +-ifdef(NO_MODULES_IN_OPAQUES). +-record(state, + {cached = dict:new() :: dict(), %% dict(imm_type(),fin_type()) + exp_types = dict:new() :: dict(), %% dict(mod_name(),mod_exp_types()) + types = dict:new() :: dict(), %% dict(mod_name(),mod_types()) + exp_specs = dict:new() :: dict()}). %% dict(mod_name(),mod_specs()) +-else. +-record(state, + {cached = dict:new() :: dict:dict(imm_type(),fin_type()), + exp_types = dict:new() :: dict:dict(mod_name(),mod_exp_types()), + types = dict:new() :: dict:dict(mod_name(),mod_types()), + exp_specs = dict:new() :: dict:dict(mod_name(),mod_specs())}). +-endif. +-type state() :: #state{}. + +-record(mod_info, + {mod_exp_types = sets:new() :: mod_exp_types(), + mod_types = dict:new() :: mod_types(), + mod_opaques = sets:new() :: mod_exp_types(), + mod_exp_funs = sets:new() :: mod_exp_funs(), + mod_specs = dict:new() :: mod_specs()}). +-type mod_info() :: #mod_info{}. + +-type stack() :: [full_type_ref() | 'tuple' | 'list' | 'union' | 'fun']. +-ifdef(NO_MODULES_IN_OPAQUES). +-type var_dict() :: dict(). %% dict(var_name(),ret_type()) +-else. +-type var_dict() :: dict:dict(var_name(),ret_type()). +-endif. +%% @private_type +-type imm_type() :: {mod_name(),string()}. +%% @alias +-type fin_type() :: proper_types:type(). +-type tagged_result(T) :: {'ok',T} | 'error'. +-type tagged_result2(T,S) :: {'ok',T,S} | 'error'. +%% @alias +-type rich_result(T) :: {'ok',T} | {'error',term()}. +-type rich_result2(T,S) :: {'ok',T,S} | {'error',term()}. +-type false_positive_mfas() :: proper:false_positive_mfas(). + +-type server_call() :: {'create_spec_test',mfa(),timeout(),false_positive_mfas()} + | {'get_exp_specced',mod_name()} + | {'get_type_repr',mod_name(),type_ref(),boolean()} + | {'translate_type',imm_type()}. +-type server_response() :: rich_result(proper:test()) + | rich_result([mfa()]) + | rich_result(type_repr()) + | rich_result(fin_type()). + + +%%------------------------------------------------------------------------------ +%% Server interface functions +%%------------------------------------------------------------------------------ + +%% @private +-spec start() -> 'ok'. +start() -> + {ok,TypeserverPid} = gen_server:start_link(?MODULE, dummy, []), + put('$typeserver_pid', TypeserverPid), + ok. + +%% @private +-spec restart() -> 'ok'. +restart() -> + TypeserverPid = get('$typeserver_pid'), + case (TypeserverPid =:= undefined orelse not is_process_alive(TypeserverPid)) of + true -> start(); + false -> ok + end. + +%% @private +-spec stop() -> 'ok'. +stop() -> + TypeserverPid = get('$typeserver_pid'), + erase('$typeserver_pid'), + gen_server:cast(TypeserverPid, stop). + +%% @private +-spec create_spec_test(mfa(), timeout(), false_positive_mfas()) -> rich_result(proper:test()). +create_spec_test(MFA, SpecTimeout, FalsePositiveMFAs) -> + TypeserverPid = get('$typeserver_pid'), + gen_server:call(TypeserverPid, {create_spec_test,MFA,SpecTimeout,FalsePositiveMFAs}). + +%% @private +-spec get_exp_specced(mod_name()) -> rich_result([mfa()]). +get_exp_specced(Mod) -> + TypeserverPid = get('$typeserver_pid'), + gen_server:call(TypeserverPid, {get_exp_specced,Mod}). + +-spec get_type_repr(mod_name(), type_ref(), boolean()) -> + rich_result(type_repr()). +get_type_repr(Mod, TypeRef, IsRemote) -> + TypeserverPid = get('$typeserver_pid'), + gen_server:call(TypeserverPid, {get_type_repr,Mod,TypeRef,IsRemote}). + +%% @private +-spec translate_type(imm_type()) -> rich_result(fin_type()). +translate_type(ImmType) -> + TypeserverPid = get('$typeserver_pid'), + gen_server:call(TypeserverPid, {translate_type,ImmType}). + +%% @doc Translates the native type expression `TypeExpr' (which should be +%% provided inside a string) into a PropEr type, which can then be passed to any +%% of the demo functions defined in the {@link proper_gen} module. PropEr acts +%% as if it found this type expression inside the code of module `Mod'. +-spec demo_translate_type(mod_name(), string()) -> rich_result(fin_type()). +demo_translate_type(Mod, TypeExpr) -> + start(), + Result = translate_type({Mod,TypeExpr}), + stop(), + Result. + +%% @doc Checks if `Term' is a valid instance of native type `TypeExpr' (which +%% should be provided inside a string). PropEr acts as if it found this type +%% expression inside the code of module `Mod'. +-spec demo_is_instance(term(), mod_name(), string()) -> + boolean() | {'error',term()}. +demo_is_instance(Term, Mod, TypeExpr) -> + case parse_type(TypeExpr) of + {ok,TypeForm} -> + start(), + Result = + %% Force the typeserver to load the module. + case translate_type({Mod,"integer()"}) of + {ok,_FinType} -> + try is_instance(Term, Mod, TypeForm) + catch + throw:{'$typeserver',Reason} -> {error, Reason} + end; + {error,_Reason} = Error -> + Error + end, + stop(), + Result; + {error,_Reason} = Error -> + Error + end. + + +%%------------------------------------------------------------------------------ +%% Implementation of gen_server interface +%%------------------------------------------------------------------------------ + +%% @private +-spec init(_) -> {'ok',state()}. +init(_) -> + {ok, #state{}}. + +%% @private +-spec handle_call(server_call(), _, state()) -> + {'reply',server_response(),state()}. +handle_call({create_spec_test,MFA,SpecTimeout,FalsePositiveMFAs}, _From, State) -> + case create_spec_test(MFA, SpecTimeout, FalsePositiveMFAs, State) of + {ok,Test,NewState} -> + {reply, {ok,Test}, NewState}; + {error,_Reason} = Error -> + {reply, Error, State} + end; +handle_call({get_exp_specced,Mod}, _From, State) -> + case get_exp_specced(Mod, State) of + {ok,MFAs,NewState} -> + {reply, {ok,MFAs}, NewState}; + {error,_Reason} = Error -> + {reply, Error, State} + end; +handle_call({get_type_repr,Mod,TypeRef,IsRemote}, _From, State) -> + case get_type_repr(Mod, TypeRef, IsRemote, State) of + {ok,TypeRepr,NewState} -> + {reply, {ok,TypeRepr}, NewState}; + {error,_Reason} = Error -> + {reply, Error, State} + end; +handle_call({translate_type,ImmType}, _From, State) -> + case translate_type(ImmType, State) of + {ok,FinType,NewState} -> + {reply, {ok,FinType}, NewState}; + {error,_Reason} = Error -> + {reply, Error, State} + end. + +%% @private +-spec handle_cast('stop', state()) -> {'stop','normal',state()}. +handle_cast(stop, State) -> + {stop, normal, State}. + +%% @private +-spec handle_info(term(), state()) -> {'stop',{'received_info',term()},state()}. +handle_info(Info, State) -> + {stop, {received_info,Info}, State}. + +%% @private +-spec terminate(term(), state()) -> 'ok'. +terminate(_Reason, _State) -> + ok. + +%% @private +-spec code_change(term(), state(), _) -> {'ok',state()}. +code_change(_OldVsn, State, _) -> + {ok, State}. + + +%%------------------------------------------------------------------------------ +%% Top-level interface +%%------------------------------------------------------------------------------ + +-spec create_spec_test(mfa(), timeout(), false_positive_mfas(), state()) -> + rich_result2(proper:test(),state()). +create_spec_test(MFA, SpecTimeout, FalsePositiveMFAs, State) -> + case get_exp_spec(MFA, State) of + {ok,FunRepr,NewState} -> + make_spec_test(MFA, FunRepr, SpecTimeout, FalsePositiveMFAs, NewState); + {error,_Reason} = Error -> + Error + end. + +-spec get_exp_spec(mfa(), state()) -> rich_result2(fun_repr(),state()). +get_exp_spec({Mod,Fun,Arity} = MFA, State) -> + case add_module(Mod, State) of + {ok,#state{exp_specs = ExpSpecs} = NewState} -> + ModExpSpecs = dict:fetch(Mod, ExpSpecs), + case dict:find({Fun,Arity}, ModExpSpecs) of + {ok,FunRepr} -> + {ok, FunRepr, NewState}; + error -> + {error, {function_not_exported_or_specced,MFA}} + end; + {error,_Reason} = Error -> + Error + end. + +-spec make_spec_test(mfa(), fun_repr(), timeout(), false_positive_mfas(), state()) -> + rich_result2(proper:test(),state()). +make_spec_test({Mod,_Fun,_Arity}=MFA, {Domain,_Range}=FunRepr, SpecTimeout, FalsePositiveMFAs, State) -> + case convert(Mod, {type,?anno(0),'$fixed_list',Domain}, State) of + {ok,FinType,NewState} -> + Test = ?FORALL(Args, FinType, apply_spec_test(MFA, FunRepr, SpecTimeout, FalsePositiveMFAs, Args)), + {ok, Test, NewState}; + {error,_Reason} = Error -> + Error + end. + +-spec apply_spec_test(mfa(), fun_repr(), timeout(), false_positive_mfas(), term()) -> proper:test(). +apply_spec_test({Mod,Fun,_Arity}=MFA, {_Domain,Range}, SpecTimeout, FalsePositiveMFAs, Args) -> + ?TIMEOUT(SpecTimeout, + begin + %% NOTE: only call apply/3 inside try/catch (do not trust ?MODULE:is_instance/3) + Result = + try apply(Mod, Fun, Args) of + X -> {ok, X} + catch + X:Y -> {X, Y} + end, + case Result of + {ok, Z} -> + case ?MODULE:is_instance(Z, Mod, Range) of + true -> + true; + false when is_function(FalsePositiveMFAs) -> + FalsePositiveMFAs(MFA, Args, {fail, Z}); + false -> + false + end; + Exception when is_function(FalsePositiveMFAs) -> + case FalsePositiveMFAs(MFA, Args, Exception) of + true -> + true; + false -> + error(Exception, erlang:get_stacktrace()) + end; + Exception -> + error(Exception, erlang:get_stacktrace()) + end + end). + +-spec get_exp_specced(mod_name(), state()) -> rich_result2([mfa()],state()). +get_exp_specced(Mod, State) -> + case add_module(Mod, State) of + {ok,#state{exp_specs = ExpSpecs} = NewState} -> + ModExpSpecs = dict:fetch(Mod, ExpSpecs), + ExpSpecced = [{Mod,F,A} || {F,A} <- dict:fetch_keys(ModExpSpecs)], + {ok, ExpSpecced, NewState}; + {error,_Reason} = Error -> + Error + end. + +-spec get_type_repr(mod_name(), type_ref(), boolean(), state()) -> + rich_result2(type_repr(),state()). +get_type_repr(Mod, {type,Name,Arity} = TypeRef, true, State) -> + case prepare_for_remote(Mod, Name, Arity, State) of + {ok,NewState} -> + get_type_repr(Mod, TypeRef, false, NewState); + {error,_Reason} = Error -> + Error + end; +get_type_repr(Mod, TypeRef, false, #state{types = Types} = State) -> + ModTypes = dict:fetch(Mod, Types), + case dict:find(TypeRef, ModTypes) of + {ok,TypeRepr} -> + {ok, TypeRepr, State}; + error -> + {error, {missing_type,Mod,TypeRef}} + end. + +-spec prepare_for_remote(mod_name(), type_name(), arity(), state()) -> + rich_result(state()). +prepare_for_remote(RemMod, Name, Arity, State) -> + case add_module(RemMod, State) of + {ok,#state{exp_types = ExpTypes} = NewState} -> + RemModExpTypes = dict:fetch(RemMod, ExpTypes), + case sets:is_element({Name,Arity}, RemModExpTypes) of + true -> {ok, NewState}; + false -> {error, {type_not_exported,{RemMod,Name,Arity}}} + end; + {error,_Reason} = Error -> + Error + end. + +-spec translate_type(imm_type(), state()) -> rich_result2(fin_type(),state()). +translate_type({Mod,Str} = ImmType, #state{cached = Cached} = State) -> + case dict:find(ImmType, Cached) of + {ok,Type} -> + {ok, Type, State}; + error -> + case parse_type(Str) of + {ok,TypeForm} -> + case add_module(Mod, State) of + {ok,NewState} -> + case convert(Mod, TypeForm, NewState) of + {ok,FinType, + #state{cached = Cached} = FinalState} -> + NewCached = dict:store(ImmType, FinType, + Cached), + {ok, FinType, + FinalState#state{cached = NewCached}}; + {error,_Reason} = Error -> + Error + end; + {error,_Reason} = Error -> + Error + end; + {error,Reason} -> + {error, {parse_error,Str,Reason}} + end + end. + +-spec parse_type(string()) -> rich_result(abs_type()). +parse_type(Str) -> + TypeStr = "-type mytype() :: " ++ Str ++ ".", + case erl_scan:string(TypeStr) of + {ok,Tokens,_EndLocation} -> + case erl_parse:parse_form(Tokens) of + {ok,{attribute,_Line,type,{mytype,TypeExpr,[]}}} -> + {ok, TypeExpr}; + {error,_ErrorInfo} = Error -> + Error + end; + {error,ErrorInfo,_EndLocation} -> + {error, ErrorInfo} + end. + +-spec add_module(mod_name(), state()) -> rich_result(state()). +add_module(Mod, #state{exp_types = ExpTypes} = State) -> + case dict:is_key(Mod, ExpTypes) of + true -> + {ok, State}; + false -> + case get_code_and_exports(Mod) of + {ok,AbsCode,ModExpFuns} -> + RawModInfo = get_mod_info(Mod, AbsCode, ModExpFuns), + ModInfo = process_adts(Mod, RawModInfo), + {ok, store_mod_info(Mod, ModInfo, State)}; + {error,Reason} -> + {error, {cant_load_code,Mod,Reason}} + end + end. + +%% @private +-spec get_exp_info(mod_name()) -> rich_result2(mod_exp_types(),mod_exp_funs()). +get_exp_info(Mod) -> + case get_code_and_exports(Mod) of + {ok,AbsCode,ModExpFuns} -> + RawModInfo = get_mod_info(Mod, AbsCode, ModExpFuns), + {ok, RawModInfo#mod_info.mod_exp_types, ModExpFuns}; + {error,_Reason} = Error -> + Error + end. + +-spec get_code_and_exports(mod_name()) -> + rich_result2([abs_form()],mod_exp_funs()). +get_code_and_exports(Mod) -> + case code:get_object_code(Mod) of + {Mod, ObjBin, _ObjFileName} -> + case get_chunks(ObjBin) of + {ok,_AbsCode,_ModExpFuns} = Result -> + Result; + {error,Reason} -> + get_code_and_exports_from_source(Mod, Reason) + end; + error -> + get_code_and_exports_from_source(Mod, cant_find_object_file) + end. + +-spec get_code_and_exports_from_source(mod_name(), term()) -> + rich_result2([abs_form()],mod_exp_funs()). +get_code_and_exports_from_source(Mod, ObjError) -> + SrcFileName = atom_to_list(Mod) ++ ?SRC_FILE_EXT, + case code:where_is_file(SrcFileName) of + FullSrcFileName when is_list(FullSrcFileName) -> + Opts = [binary,debug_info,return_errors,{d,'PROPER_REMOVE_PROPS'}], + case compile:file(FullSrcFileName, Opts) of + {ok,Mod,Binary} -> + get_chunks(Binary); + {error,Errors,_Warnings} -> + {error, {ObjError,{cant_compile_source_file,Errors}}} + end; + non_existing -> + {error, {ObjError,cant_find_source_file}} + end. + +-spec get_chunks(string() | binary()) -> + rich_result2([abs_form()],mod_exp_funs()). +get_chunks(ObjFile) -> + case beam_lib:chunks(ObjFile, [abstract_code,exports]) of + {ok,{_Mod,[{abstract_code,AbsCodeChunk},{exports,ExpFunsList}]}} -> + case AbsCodeChunk of + {raw_abstract_v1,AbsCode} -> + %% HACK: Add a declaration for iolist() to every module + {ok, add_iolist(AbsCode), sets:from_list(ExpFunsList)}; + no_abstract_code -> + {error, no_abstract_code}; + _ -> + {error, unsupported_abstract_code_format} + end; + {error,beam_lib,Reason} -> + {error, Reason} + end. + +-spec add_iolist([abs_form()]) -> [abs_form()]. +add_iolist(Forms) -> + IOListDef = + {type,0,maybe_improper_list, + [{type,0,union,[{type,0,byte,[]},{type,0,binary,[]}, + {type,0,iolist,[]}]}, + {type,0,binary,[]}]}, + IOListDecl = {attribute,0,type,{iolist,IOListDef,[]}}, + [IOListDecl | Forms]. + +-spec get_mod_info(mod_name(), [abs_form()], mod_exp_funs()) -> mod_info(). +get_mod_info(Mod, AbsCode, ModExpFuns) -> + StartModInfo = #mod_info{mod_exp_funs = ModExpFuns}, + ImmModInfo = lists:foldl(fun add_mod_info/2, StartModInfo, AbsCode), + #mod_info{mod_specs = AllModSpecs} = ImmModInfo, + IsExported = fun(FunRef,_FunRepr) -> sets:is_element(FunRef,ModExpFuns) end, + ModExpSpecs = dict:filter(IsExported, AllModSpecs), + ModInfo = ImmModInfo#mod_info{mod_specs = ModExpSpecs}, + case orddict:find(Mod, ?HARD_ADT_MODS) of + {ok,ModADTs} -> + #mod_info{mod_exp_types = ModExpTypes, mod_types = ModTypes, + mod_opaques = ModOpaques} = ModInfo, + ModADTsSet = + sets:from_list([ImmTypeRef + || {ImmTypeRef,_HardADTRepr} <- ModADTs]), + NewModExpTypes = sets:union(ModExpTypes, ModADTsSet), + NewModTypes = lists:foldl(fun store_hard_adt/2, ModTypes, ModADTs), + NewModOpaques = sets:union(ModOpaques, ModADTsSet), + ModInfo#mod_info{mod_exp_types = NewModExpTypes, + mod_types = NewModTypes, + mod_opaques = NewModOpaques}; + error -> + ModInfo + end. + +-spec store_hard_adt({imm_type_ref(),hard_adt_repr()}, mod_types()) -> + mod_types(). +store_hard_adt({_ImmTypeRef,already_declared}, ModTypes) -> + ModTypes; +store_hard_adt({{Name,Arity},{TypeForm,VarNames}}, ModTypes) -> + TypeRef = {type,Name,Arity}, + TypeRepr = {abs_type,TypeForm,VarNames,not_symb}, + dict:store(TypeRef, TypeRepr, ModTypes). + +-spec add_mod_info(abs_form(), mod_info()) -> mod_info(). +add_mod_info({attribute,_Line,export_type,TypesList}, + #mod_info{mod_exp_types = ModExpTypes} = ModInfo) -> + NewModExpTypes = sets:union(sets:from_list(TypesList), ModExpTypes), + ModInfo#mod_info{mod_exp_types = NewModExpTypes}; +add_mod_info({attribute,_Line,type,{{record,RecName},Fields,[]}}, + #mod_info{mod_types = ModTypes} = ModInfo) -> + FieldInfo = [process_rec_field(F) || F <- Fields], + NewModTypes = dict:store({record,RecName,0}, {abs_record,FieldInfo}, + ModTypes), + ModInfo#mod_info{mod_types = NewModTypes}; +add_mod_info({attribute,Line,record,{RecName,Fields}}, + #mod_info{mod_types = ModTypes} = ModInfo) -> + case dict:is_key(RecName, ModTypes) of + true -> + ModInfo; + false -> % fake an opaque term by using the same Line as annotation + TypedRecord = {attribute,Line,type,{{record,RecName},Fields,[]}}, + add_mod_info(TypedRecord, ModInfo) + end; +add_mod_info({attribute,_Line,Kind,{Name,TypeForm,VarForms}}, + #mod_info{mod_types = ModTypes, + mod_opaques = ModOpaques} = ModInfo) + when Kind =:= type; Kind =:= opaque -> + Arity = length(VarForms), + VarNames = [V || {var,_,V} <- VarForms], + %% TODO: No check whether variables are different, or non-'_'. + NewModTypes = dict:store({type,Name,Arity}, + {abs_type,TypeForm,VarNames,not_symb}, ModTypes), + NewModOpaques = + case Kind of + type -> ModOpaques; + opaque -> sets:add_element({Name,Arity}, ModOpaques) + end, + ModInfo#mod_info{mod_types = NewModTypes, mod_opaques = NewModOpaques}; +add_mod_info({attribute,_Line,spec,{RawFunRef,[RawFirstClause | _Rest]}}, + #mod_info{mod_specs = ModSpecs} = ModInfo) -> + FunRef = case RawFunRef of + {_Mod,Name,Arity} -> {Name,Arity}; + {_Name,_Arity} = F -> F + end, + %% TODO: We just take the first function clause. + FirstClause = process_fun_clause(RawFirstClause), + NewModSpecs = dict:store(FunRef, FirstClause, ModSpecs), + ModInfo#mod_info{mod_specs = NewModSpecs}; +add_mod_info(_Form, ModInfo) -> + ModInfo. + +-spec process_rec_field(abs_rec_field()) -> {field_name(),abs_type()}. +process_rec_field({record_field,_,{atom,_,FieldName}}) -> + {FieldName, {type,0,any,[]}}; +process_rec_field({record_field,_,{atom,_,FieldName},_Initialization}) -> + {FieldName, {type,0,any,[]}}; +process_rec_field({typed_record_field,RecField,FieldType}) -> + {FieldName,_} = process_rec_field(RecField), + {FieldName, FieldType}. + +-spec process_fun_clause(abs_type()) -> fun_clause_repr(). +process_fun_clause({type,_,'fun',[{type,_,product,Domain},Range]}) -> + {Domain, Range}; +process_fun_clause({type,_,bounded_fun,[MainClause,Constraints]}) -> + {RawDomain,RawRange} = process_fun_clause(MainClause), + VarSubsts = [{V,T} || {type,_,constraint, + [{atom,_,is_subtype},[{var,_,V},T]]} <- Constraints, + V =/= '_'], + VarSubstsDict = dict:from_list(VarSubsts), + Domain = [update_vars(A, VarSubstsDict, false) || A <- RawDomain], + Range = update_vars(RawRange, VarSubstsDict, false), + {Domain, Range}. + +-spec store_mod_info(mod_name(), mod_info(), state()) -> state(). +store_mod_info(Mod, #mod_info{mod_exp_types = ModExpTypes, mod_types = ModTypes, + mod_specs = ImmModExpSpecs}, + #state{exp_types = ExpTypes, types = Types, + exp_specs = ExpSpecs} = State) -> + NewExpTypes = dict:store(Mod, ModExpTypes, ExpTypes), + NewTypes = dict:store(Mod, ModTypes, Types), + ModExpSpecs = dict:map(fun unbound_to_any/2, ImmModExpSpecs), + NewExpSpecs = dict:store(Mod, ModExpSpecs, ExpSpecs), + State#state{exp_types = NewExpTypes, types = NewTypes, + exp_specs = NewExpSpecs}. + +-spec unbound_to_any(fun_ref(), fun_repr()) -> fun_repr(). +unbound_to_any(_FunRef, {Domain,Range}) -> + EmptySubstsDict = dict:new(), + NewDomain = [update_vars(A,EmptySubstsDict,true) || A <- Domain], + NewRange = update_vars(Range, EmptySubstsDict, true), + {NewDomain, NewRange}. + + +%%------------------------------------------------------------------------------ +%% ADT translation functions +%%------------------------------------------------------------------------------ + +-spec process_adts(mod_name(), mod_info()) -> mod_info(). +process_adts(Mod, + #mod_info{mod_exp_types = ModExpTypes, mod_opaques = ModOpaques, + mod_specs = ModExpSpecs} = ModInfo) -> + %% TODO: No warning on unexported opaques. + case sets:to_list(sets:intersection(ModExpTypes,ModOpaques)) of + [] -> + ModInfo; + ModADTs -> + %% TODO: No warning on unexported API functions. + ModExpSpecsList = [{Name,Domain,Range} + || {{Name,_Arity},{Domain,Range}} + <- dict:to_list(ModExpSpecs)], + AddADT = fun(ADT,Acc) -> add_adt(Mod,ADT,Acc,ModExpSpecsList) end, + lists:foldl(AddADT, ModInfo, ModADTs) + end. + +-spec add_adt(mod_name(), imm_type_ref(), mod_info(), [proc_fun_ref()]) -> + mod_info(). +add_adt(Mod, {Name,Arity}, #mod_info{mod_types = ModTypes} = ModInfo, + ModExpFunSpecs) -> + ADTRef = {type,Name,Arity}, + {abs_type,InternalRepr,VarNames,not_symb} = dict:fetch(ADTRef, ModTypes), + FullADTRef = {Mod,Name,Arity}, + %% TODO: No warning on unsuitable range. + SymbCalls1 = [get_symb_call(FullADTRef,Spec) || Spec <- ModExpFunSpecs], + %% TODO: No warning on bad use of variables. + SymbCalls2 = [fix_vars(FullADTRef,Call,RangeVars,VarNames) + || {ok,Call,RangeVars} <- SymbCalls1], + case [Call || {ok,Call} <- SymbCalls2] of + [] -> + %% TODO: No warning on no acceptable spec. + ModInfo; + SymbCalls3 -> + NewADTRepr = {abs_type,{type,0,union,SymbCalls3},VarNames, + {orig_abs,InternalRepr}}, + NewModTypes = dict:store(ADTRef, NewADTRepr, ModTypes), + ModInfo#mod_info{mod_types = NewModTypes} + end. + +-spec get_symb_call(full_imm_type_ref(), proc_fun_ref()) -> + tagged_result2(abs_type(),[var_name()]). +get_symb_call({Mod,_TypeName,_Arity} = FullADTRef, {FunName,Domain,Range}) -> + A = ?anno(0), + BaseCall = {type,A,tuple,[{atom,A,'$call'},{atom,A,Mod},{atom,A,FunName}, + {type,A,'$fixed_list',Domain}]}, + unwrap_range(FullADTRef, BaseCall, Range, false). + +-spec unwrap_range(full_imm_type_ref(), abs_type() | next_step(), abs_type(), + boolean()) -> + tagged_result2(abs_type() | next_step(),[var_name()]). +unwrap_range(FullADTRef, Call, {paren_type,_,[Type]}, TestRun) -> + unwrap_range(FullADTRef, Call, Type, TestRun); +unwrap_range(FullADTRef, Call, {ann_type,_,[_Var,Type]}, TestRun) -> + unwrap_range(FullADTRef, Call, Type, TestRun); +unwrap_range(FullADTRef, Call, {type,_,list,[ElemType]}, TestRun) -> + unwrap_list(FullADTRef, Call, ElemType, TestRun); +unwrap_range(FullADTRef, Call, {type,_,maybe_improper_list,[Cont,_Term]}, + TestRun) -> + unwrap_list(FullADTRef, Call, Cont, TestRun); +unwrap_range(FullADTRef, Call, {type,_,nonempty_list,[ElemType]}, TestRun) -> + unwrap_list(FullADTRef, Call, ElemType, TestRun); +unwrap_range(FullADTRef, Call, {type,_,nonempty_improper_list,[Cont,_Term]}, + TestRun) -> + unwrap_list(FullADTRef, Call, Cont, TestRun); +unwrap_range(FullADTRef, Call, + {type,_,nonempty_maybe_improper_list,[Cont,_Term]}, TestRun) -> + unwrap_list(FullADTRef, Call, Cont, TestRun); +unwrap_range(_FullADTRef, _Call, {type,_,tuple,any}, _TestRun) -> + error; +unwrap_range(FullADTRef, Call, {type,_,tuple,FieldForms}, TestRun) -> + Translates = fun(T) -> unwrap_range(FullADTRef,none,T,true) =/= error end, + case proper_arith:find_first(Translates, FieldForms) of + none -> + error; + {TargetPos,TargetElem} -> + Pattern = get_pattern(TargetPos, FieldForms), + case TestRun of + true -> + NewCall = + case Call of + none -> {match_with,Pattern}; + _ -> Call + end, + {ok, NewCall, []}; + false -> + AbsPattern = term_to_singleton_type(Pattern), + A = ?anno(0), + NewCall = + {type,A,tuple, + [{atom,A,'$call'},{atom,A,?MODULE},{atom,A,match}, + {type,A,'$fixed_list',[AbsPattern,Call]}]}, + unwrap_range(FullADTRef, NewCall, TargetElem, TestRun) + end + end; +unwrap_range(FullADTRef, Call, {type,_,union,Choices}, TestRun) -> + TestedChoices = [unwrap_range(FullADTRef,none,C,true) || C <- Choices], + NotError = fun(error) -> false; (_) -> true end, + case proper_arith:find_first(NotError, TestedChoices) of + none -> + error; + {_ChoicePos,{ok,none,_RangeVars}} -> + error; + {ChoicePos,{ok,NextStep,_RangeVars}} -> + {A, [ChoiceElem|B]} = lists:split(ChoicePos-1, Choices), + OtherChoices = A ++ B, + DistinctChoice = + case NextStep of + take_head -> + fun cant_have_head/1; + {match_with,Pattern} -> + fun(C) -> cant_match(Pattern, C) end + end, + case {lists:all(DistinctChoice,OtherChoices), TestRun} of + {true,true} -> + {ok, NextStep, []}; + {true,false} -> + unwrap_range(FullADTRef, Call, ChoiceElem, TestRun); + {false,_} -> + error + end + end; +unwrap_range({_Mod,SameName,Arity}, Call, {type,_,SameName,ArgForms}, + _TestRun) -> + RangeVars = [V || {var,_,V} <- ArgForms, V =/= '_'], + case length(ArgForms) =:= Arity andalso length(RangeVars) =:= Arity of + true -> {ok, Call, RangeVars}; + false -> error + end; +unwrap_range({SameMod,SameName,_Arity} = FullADTRef, Call, + {remote_type,_,[{atom,_,SameMod},{atom,_,SameName},ArgForms]}, + TestRun) -> + unwrap_range(FullADTRef, Call, {type,?anno(0),SameName,ArgForms}, TestRun); +unwrap_range(_FullADTRef, _Call, _Range, _TestRun) -> + error. + +-spec unwrap_list(full_imm_type_ref(), abs_type() | next_step(), abs_type(), + boolean()) -> + tagged_result2(abs_type() | next_step(),[var_name()]). +unwrap_list(FullADTRef, Call, HeadType, TestRun) -> + NewCall = + case TestRun of + true -> + case Call of + none -> take_head; + _ -> Call + end; + false -> + {type,0,tuple,[{atom,0,'$call'},{atom,0,erlang},{atom,0,hd}, + {type,0,'$fixed_list',[Call]}]} + end, + unwrap_range(FullADTRef, NewCall, HeadType, TestRun). + +-spec fix_vars(full_imm_type_ref(), abs_type(), [var_name()], [var_name()]) -> + tagged_result(abs_type()). +fix_vars(FullADTRef, Call, RangeVars, VarNames) -> + NotAnyVar = fun(V) -> V =/= '_' end, + case no_duplicates(VarNames) andalso lists:all(NotAnyVar,VarNames) of + true -> + RawUsedVars = + collect_vars(FullADTRef, Call, [[V] || V <- RangeVars]), + UsedVars = [lists:usort(L) || L <- RawUsedVars], + case correct_var_use(UsedVars) of + true -> + PairAll = fun(L,Y) -> [{X,{var,0,Y}} || X <- L] end, + VarSubsts = + lists:flatten(lists:zipwith(PairAll,UsedVars,VarNames)), + VarSubstsDict = dict:from_list(VarSubsts), + {ok, update_vars(Call,VarSubstsDict,true)}; + false -> + error + end; + false -> + error + end. + +-spec no_duplicates(list()) -> boolean(). +no_duplicates(L) -> + length(lists:usort(L)) =:= length(L). + +-spec correct_var_use([[var_name() | 0]]) -> boolean(). +correct_var_use(UsedVars) -> + NoNonVarArgs = fun([0|_]) -> false; (_) -> true end, + lists:all(NoNonVarArgs, UsedVars) + andalso no_duplicates(lists:flatten(UsedVars)). + +-spec collect_vars(full_imm_type_ref(), abs_type(), [[var_name() | 0]]) -> + [[var_name() | 0]]. +collect_vars(FullADTRef, {paren_type,_,[Type]}, UsedVars) -> + collect_vars(FullADTRef, Type, UsedVars); +collect_vars(FullADTRef, {ann_type,_,[_Var,Type]}, UsedVars) -> + collect_vars(FullADTRef, Type, UsedVars); +collect_vars(_FullADTRef, {type,_,tuple,any}, UsedVars) -> + UsedVars; +collect_vars({_Mod,SameName,Arity} = FullADTRef, {type,_,SameName,ArgForms}, + UsedVars) -> + case length(ArgForms) =:= Arity of + true -> + VarArgs = [V || {var,_,V} <- ArgForms, V =/= '_'], + case length(VarArgs) =:= Arity of + true -> + AddToList = fun(X,L) -> [X | L] end, + lists:zipwith(AddToList, VarArgs, UsedVars); + false -> + [[0|L] || L <- UsedVars] + end; + false -> + multi_collect_vars(FullADTRef, ArgForms, UsedVars) + end; +collect_vars(FullADTRef, {type,_,_Name,ArgForms}, UsedVars) -> + multi_collect_vars(FullADTRef, ArgForms, UsedVars); +collect_vars({SameMod,SameName,_Arity} = FullADTRef, + {remote_type,_,[{atom,_,SameMod},{atom,_,SameName},ArgForms]}, + UsedVars) -> + collect_vars(FullADTRef, {type,?anno(0),SameName,ArgForms}, UsedVars); +collect_vars(FullADTRef, {remote_type,_,[_RemModForm,_NameForm,ArgForms]}, + UsedVars) -> + multi_collect_vars(FullADTRef, ArgForms, UsedVars); +collect_vars(_FullADTRef, _Call, UsedVars) -> + UsedVars. + +-spec multi_collect_vars(full_imm_type_ref(), [abs_type()], + [[var_name() | 0]]) -> [[var_name() | 0]]. +multi_collect_vars({_Mod,_Name,Arity} = FullADTRef, Forms, UsedVars) -> + NoUsedVars = lists:duplicate(Arity, []), + MoreUsedVars = [collect_vars(FullADTRef,T,NoUsedVars) || T <- Forms], + CombineVars = fun(L1,L2) -> lists:zipwith(fun erlang:'++'/2, L1, L2) end, + lists:foldl(CombineVars, UsedVars, MoreUsedVars). + +-ifdef(NO_MODULES_IN_OPAQUES). +-type var_substs_dict() :: dict(). +-else. +-type var_substs_dict() :: dict:dict(var_name(),abs_type()). +-endif. +-spec update_vars(abs_type(), var_substs_dict(), boolean()) -> abs_type(). +update_vars({paren_type,Line,[Type]}, VarSubstsDict, UnboundToAny) -> + {paren_type, Line, [update_vars(Type,VarSubstsDict,UnboundToAny)]}; +update_vars({ann_type,Line,[Var,Type]}, VarSubstsDict, UnboundToAny) -> + {ann_type, Line, [Var,update_vars(Type,VarSubstsDict,UnboundToAny)]}; +update_vars({var,Line,VarName} = Call, VarSubstsDict, UnboundToAny) -> + case dict:find(VarName, VarSubstsDict) of + {ok,SubstType} -> + SubstType; + error when UnboundToAny =:= false -> + Call; + error when UnboundToAny =:= true -> + {type,Line,any,[]} + end; +update_vars({remote_type,Line,[RemModForm,NameForm,ArgForms]}, VarSubstsDict, + UnboundToAny) -> + NewArgForms = [update_vars(A,VarSubstsDict,UnboundToAny) || A <- ArgForms], + {remote_type, Line, [RemModForm,NameForm,NewArgForms]}; +update_vars({T,_,tuple,any} = Call, _VarSubstsDict, _UnboundToAny) when ?IS_TYPE_TAG(T) -> + Call; +update_vars({T,Line,Name,ArgForms}, VarSubstsDict, UnboundToAny) when ?IS_TYPE_TAG(T) -> + NewArgForms = [update_vars(A,VarSubstsDict,UnboundToAny) || A <- ArgForms], + {T, Line, Name, NewArgForms}; +update_vars(Call, _VarSubstsDict, _UnboundToAny) -> + Call. + + +%%------------------------------------------------------------------------------ +%% Match-related functions +%%------------------------------------------------------------------------------ + +-spec get_pattern(position(), [abs_type()]) -> pattern(). +get_pattern(TargetPos, FieldForms) -> + {0,RevPattern} = lists:foldl(fun add_field/2, {TargetPos,[]}, FieldForms), + list_to_tuple(lists:reverse(RevPattern)). + +-spec add_field(abs_type(), {non_neg_integer(),[pat_field()]}) -> + {non_neg_integer(),[pat_field(),...]}. +add_field(_Type, {1,Acc}) -> + {0, [1|Acc]}; +add_field({atom,_,Tag}, {Left,Acc}) -> + {erlang:max(0,Left-1), [Tag|Acc]}; +add_field(_Type, {Left,Acc}) -> + {erlang:max(0,Left-1), [0|Acc]}. + +%% @private +-spec match(pattern(), tuple()) -> term(). +match(Pattern, Term) when tuple_size(Pattern) =:= tuple_size(Term) -> + match(tuple_to_list(Pattern), tuple_to_list(Term), none, false); +match(_Pattern, _Term) -> + throw(no_match). + +-spec match([pat_field()], [term()], 'none' | {'ok',T}, boolean()) -> T. +match([], [], {ok,Target}, _TypeMode) -> + Target; +match([0|PatRest], [_|ToMatchRest], Acc, TypeMode) -> + match(PatRest, ToMatchRest, Acc, TypeMode); +match([1|PatRest], [Target|ToMatchRest], none, TypeMode) -> + match(PatRest, ToMatchRest, {ok,Target}, TypeMode); +match([Tag|PatRest], [X|ToMatchRest], Acc, TypeMode) when is_atom(Tag) -> + MatchesTag = + case TypeMode of + true -> can_be_tag(Tag, X); + false -> Tag =:= X + end, + case MatchesTag of + true -> match(PatRest, ToMatchRest, Acc, TypeMode); + false -> throw(no_match) + end. + +%% CAUTION: these must be sorted +-define(NON_ATOM_TYPES, + [arity,binary,bitstring,byte,char,float,'fun',function,integer,iodata, + iolist,list,maybe_improper_list,mfa,neg_integer,nil,no_return, + non_neg_integer,none,nonempty_improper_list,nonempty_list, + nonempty_maybe_improper_list,nonempty_string,number,pid,port, + pos_integer,range,record,reference,string,tuple]). +-define(NON_TUPLE_TYPES, + [arity,atom,binary,bitstring,bool,boolean,byte,char,float,'fun', + function,identifier,integer,iodata,iolist,list,maybe_improper_list, + neg_integer,nil,no_return,node,non_neg_integer,none, + nonempty_improper_list,nonempty_list,nonempty_maybe_improper_list, + nonempty_string,number,pid,port,pos_integer,range,reference,string, + timeout]). +-define(NO_HEAD_TYPES, + [arity,atom,binary,bitstring,bool,boolean,byte,char,float,'fun', + function,identifier,integer,mfa,module,neg_integer,nil,no_return,node, + non_neg_integer,none,number,pid,port,pos_integer,range,record, + reference,timeout,tuple]). + +-spec can_be_tag(atom(), abs_type()) -> boolean(). +can_be_tag(Tag, {ann_type,_,[_Var,Type]}) -> + can_be_tag(Tag, Type); +can_be_tag(Tag, {paren_type,_,[Type]}) -> + can_be_tag(Tag, Type); +can_be_tag(Tag, {atom,_,Atom}) -> + Tag =:= Atom; +can_be_tag(_Tag, {integer,_,_Int}) -> + false; +can_be_tag(_Tag, {op,_,_Op,_Arg}) -> + false; +can_be_tag(_Tag, {op,_,_Op,_Arg1,_Arg2}) -> + false; +can_be_tag(Tag, {type,_,BName,[]}) when BName =:= bool; BName =:= boolean -> + is_boolean(Tag); +can_be_tag(Tag, {type,_,timeout,[]}) -> + Tag =:= infinity; +can_be_tag(Tag, {type,_,union,Choices}) -> + lists:any(fun(C) -> can_be_tag(Tag,C) end, Choices); +can_be_tag(_Tag, {type,_,Name,_Args}) -> + not ordsets:is_element(Name, ?NON_ATOM_TYPES); +can_be_tag(_Tag, _Type) -> + true. + +-spec cant_match(pattern(), abs_type()) -> boolean(). +cant_match(Pattern, {ann_type,_,[_Var,Type]}) -> + cant_match(Pattern, Type); +cant_match(Pattern, {paren_type,_,[Type]}) -> + cant_match(Pattern, Type); +cant_match(_Pattern, {atom,_,_Atom}) -> + true; +cant_match(_Pattern, {integer,_,_Int}) -> + true; +cant_match(_Pattern, {op,_,_Op,_Arg}) -> + true; +cant_match(_Pattern, {op,_,_Op,_Arg1,_Arg2}) -> + true; +cant_match(Pattern, {type,Anno,mfa,[]}) -> + MFA_Ts = [{type,Anno,atom,[]}, {type,Anno,atom,[]}, {type,Anno,arity,[]}], + cant_match(Pattern, {type,Anno,tuple,MFA_Ts}); +cant_match(Pattern, {type,_,union,Choices}) -> + lists:all(fun(C) -> cant_match(Pattern,C) end, Choices); +cant_match(_Pattern, {type,_,tuple,any}) -> + false; +cant_match(Pattern, {type,_,tuple,Fields}) -> + tuple_size(Pattern) =/= length(Fields) orelse + try match(tuple_to_list(Pattern), Fields, none, true) of + _ -> false + catch + throw:no_match -> true + end; +cant_match(_Pattern, {type,_,Name,_Args}) -> + ordsets:is_element(Name, ?NON_TUPLE_TYPES); +cant_match(_Pattern, _Type) -> + false. + +-spec cant_have_head(abs_type()) -> boolean(). +cant_have_head({ann_type,_,[_Var,Type]}) -> + cant_have_head(Type); +cant_have_head({paren_type,_,[Type]}) -> + cant_have_head(Type); +cant_have_head({atom,_,_Atom}) -> + true; +cant_have_head({integer,_,_Int}) -> + true; +cant_have_head({op,_,_Op,_Arg}) -> + true; +cant_have_head({op,_,_Op,_Arg1,_Arg2}) -> + true; +cant_have_head({type,_,union,Choices}) -> + lists:all(fun cant_have_head/1, Choices); +cant_have_head({type,_,Name,_Args}) -> + ordsets:is_element(Name, ?NO_HEAD_TYPES); +cant_have_head(_Type) -> + false. + +%% Only covers atoms, integers and tuples, i.e. those that can be specified +%% through singleton types. +-spec term_to_singleton_type(atom() | integer() + | loose_tuple(atom() | integer())) -> abs_type(). +term_to_singleton_type(Atom) when is_atom(Atom) -> + {atom,?anno(0),Atom}; +term_to_singleton_type(Int) when is_integer(Int), Int >= 0 -> + {integer,?anno(0),Int}; +term_to_singleton_type(Int) when is_integer(Int), Int < 0 -> + A = ?anno(0), + {op,A,'-',{integer,A,-Int}}; +term_to_singleton_type(Tuple) when is_tuple(Tuple) -> + Fields = tuple_to_list(Tuple), + {type,?anno(0),tuple,[term_to_singleton_type(F) || F <- Fields]}. + + +%%------------------------------------------------------------------------------ +%% Instance testing functions +%%------------------------------------------------------------------------------ + +%% CAUTION: this must be sorted +-define(EQUIV_TYPES, + [{arity, {type,0,range,[{integer,0,0},{integer,0,255}]}}, + {bool, {type,0,boolean,[]}}, + {byte, {type,0,range,[{integer,0,0},{integer,0,255}]}}, + {char, {type,0,range,[{integer,0,0},{integer,0,16#10ffff}]}}, + {function, {type,0,'fun',[]}}, + {identifier, {type,0,union,[{type,0,pid,[]},{type,0,port,[]}, + {type,0,reference,[]}]}}, + {iodata, {type,0,union,[{type,0,binary,[]},{type,0,iolist,[]}]}}, + {iolist, {type,0,maybe_improper_list, + [{type,0,union,[{type,0,byte,[]},{type,0,binary,[]}, + {type,0,iolist,[]}]}, + {type,0,binary,[]}]}}, + {list, {type,0,list,[{type,0,any,[]}]}}, + {maybe_improper_list, {type,0,maybe_improper_list,[{type,0,any,[]}, + {type,0,any,[]}]}}, + {mfa, {type,0,tuple,[{type,0,atom,[]},{type,0,atom,[]}, + {type,0,arity,[]}]}}, + {node, {type,0,atom,[]}}, + {nonempty_list, {type,0,nonempty_list,[{type,0,any,[]}]}}, + {nonempty_maybe_improper_list, {type,0,nonempty_maybe_improper_list, + [{type,0,any,[]},{type,0,any,[]}]}}, + {nonempty_string, {type,0,nonempty_list,[{type,0,char,[]}]}}, + {string, {type,0,list,[{type,0,char,[]}]}}, + {term, {type,0,any,[]}}, + {timeout, {type,0,union,[{atom,0,infinity}, + {type,0,non_neg_integer,[]}]}}]). + +%% @private +%% TODO: Most of these functions accept an extended form of abs_type(), namely +%% the addition of a custom wrapper: {'from_mod',mod_name(),...} +-spec is_instance(term(), mod_name(), abs_type()) -> boolean(). +is_instance(X, Mod, TypeForm) -> + is_instance(X, Mod, TypeForm, []). + +-spec is_instance(term(), mod_name(), abs_type(), imm_stack()) -> boolean(). +is_instance(X, _Mod, {from_mod,OrigMod,Type}, Stack) -> + is_instance(X, OrigMod, Type, Stack); +is_instance(_X, _Mod, {var,_,'_'}, _Stack) -> + true; +is_instance(_X, _Mod, {var,_,Name}, _Stack) -> + %% All unconstrained spec vars have been replaced by 'any()' and we always + %% replace the variables on the RHS of types before recursing into them. + %% Provided that '-type' declarations contain no unbound variables, we + %% don't expect to find any non-'_' variables while recursing. + throw({'$typeserver',{unbound_var_in_type_declaration,Name}}); +is_instance(X, Mod, {ann_type,_,[_Var,Type]}, Stack) -> + is_instance(X, Mod, Type, Stack); +is_instance(X, Mod, {paren_type,_,[Type]}, Stack) -> + is_instance(X, Mod, Type, Stack); +is_instance(X, Mod, {remote_type,_,[{atom,_,RemMod},{atom,_,Name},ArgForms]}, + Stack) -> + is_custom_instance(X, Mod, RemMod, Name, ArgForms, true, Stack); +is_instance(SameAtom, _Mod, {atom,_,SameAtom}, _Stack) -> + true; +is_instance(SameInt, _Mod, {integer,_,SameInt}, _Stack) -> + true; +is_instance(X, _Mod, {op,_,_Op,_Arg} = Expr, _Stack) -> + is_int_const(X, Expr); +is_instance(X, _Mod, {op,_,_Op,_Arg1,_Arg2} = Expr, _Stack) -> + is_int_const(X, Expr); +is_instance(_X, _Mod, {type,_,any,[]}, _Stack) -> + true; +is_instance(X, _Mod, {type,_,atom,[]}, _Stack) -> + is_atom(X); +is_instance(X, _Mod, {type,_,binary,[]}, _Stack) -> + is_binary(X); +is_instance(X, _Mod, {type,_,binary,[BaseExpr,UnitExpr]}, _Stack) -> + %% <<_:X,_:_*Y>> means "bitstrings of X + k*Y bits, k >= 0" + case eval_int(BaseExpr) of + {ok,Base} when Base >= 0 -> + case eval_int(UnitExpr) of + {ok,Unit} when Unit >= 0 -> + case is_bitstring(X) of + true -> + BitSizeX = bit_size(X), + case Unit =:= 0 of + true -> + BitSizeX =:= Base; + false -> + BitSizeX >= Base + andalso + (BitSizeX - Base) rem Unit =:= 0 + end; + false -> false + end; + _ -> + abs_expr_error(invalid_unit, UnitExpr) + end; + _ -> + abs_expr_error(invalid_base, BaseExpr) + end; +is_instance(X, _Mod, {type,_,bitstring,[]}, _Stack) -> + is_bitstring(X); +is_instance(X, _Mod, {type,_,boolean,[]}, _Stack) -> + is_boolean(X); +is_instance(X, _Mod, {type,_,float,[]}, _Stack) -> + is_float(X); +is_instance(X, _Mod, {type,_,'fun',[]}, _Stack) -> + is_function(X); +%% TODO: how to check range type? random inputs? special case for 0-arity? +is_instance(X, _Mod, {type,_,'fun',[{type,_,any,[]},_Range]}, _Stack) -> + is_function(X); +is_instance(X, _Mod, {type,_,'fun',[{type,_,product,Domain},_Range]}, _Stack) -> + is_function(X, length(Domain)); +is_instance(X, _Mod, {type,_,integer,[]}, _Stack) -> + is_integer(X); +is_instance(X, Mod, {type,_,list,[Type]}, _Stack) -> + list_test(X, Mod, Type, dummy, true, true, false); +is_instance(X, Mod, {type,_,maybe_improper_list,[Cont,Term]}, _Stack) -> + list_test(X, Mod, Cont, Term, true, true, true); +is_instance(X, _Mod, {type,_,module,[]}, _Stack) -> + is_atom(X) orelse + is_tuple(X) andalso X =/= {} andalso is_atom(element(1,X)); +is_instance([], _Mod, {type,_,nil,[]}, _Stack) -> + true; +is_instance(X, _Mod, {type,_,neg_integer,[]}, _Stack) -> + is_integer(X) andalso X < 0; +is_instance(X, _Mod, {type,_,non_neg_integer,[]}, _Stack) -> + is_integer(X) andalso X >= 0; +is_instance(X, Mod, {type,_,nonempty_list,[Type]}, _Stack) -> + list_test(X, Mod, Type, dummy, false, true, false); +is_instance(X, Mod, {type,_,nonempty_improper_list,[Cont,Term]}, _Stack) -> + list_test(X, Mod, Cont, Term, false, false, true); +is_instance(X, Mod, {type,_,nonempty_maybe_improper_list,[Cont,Term]}, + _Stack) -> + list_test(X, Mod, Cont, Term, false, true, true); +is_instance(X, _Mod, {type,_,number,[]}, _Stack) -> + is_number(X); +is_instance(X, _Mod, {type,_,pid,[]}, _Stack) -> + is_pid(X); +is_instance(X, _Mod, {type,_,port,[]}, _Stack) -> + is_port(X); +is_instance(X, _Mod, {type,_,pos_integer,[]}, _Stack) -> + is_integer(X) andalso X > 0; +is_instance(_X, _Mod, {type,_,product,_Elements}, _Stack) -> + throw({'$typeserver',{internal,product_in_is_instance}}); +is_instance(X, _Mod, {type,_,range,[LowExpr,HighExpr]}, _Stack) -> + case {eval_int(LowExpr),eval_int(HighExpr)} of + {{ok,Low},{ok,High}} when Low =< High -> + X >= Low andalso X =< High; + _ -> + abs_expr_error(invalid_range, LowExpr, HighExpr) + end; +is_instance(X, Mod, {type,_,record,[{atom,_,Name} = NameForm | RawSubsts]}, + Stack) -> + Substs = [{N,T} || {type,_,field_type,[{atom,_,N},T]} <- RawSubsts], + SubstsDict = dict:from_list(Substs), + case get_type_repr(Mod, {record,Name,0}, false) of + {ok,{abs_record,OrigFields}} -> + Fields = [case dict:find(FieldName, SubstsDict) of + {ok,NewFieldType} -> NewFieldType; + error -> OrigFieldType + end + || {FieldName,OrigFieldType} <- OrigFields], + is_instance(X, Mod, {type,?anno(0),tuple,[NameForm|Fields]}, Stack); + {error,Reason} -> + throw({'$typeserver',Reason}) + end; +is_instance(X, _Mod, {type,_,reference,[]}, _Stack) -> + is_reference(X); +is_instance(X, _Mod, {type,_,tuple,any}, _Stack) -> + is_tuple(X); +is_instance(X, Mod, {type,_,tuple,Fields}, _Stack) -> + is_tuple(X) andalso tuple_test(tuple_to_list(X), Mod, Fields); +is_instance(X, Mod, {type,_,union,Choices}, Stack) -> + IsInstance = fun(Choice) -> is_instance(X,Mod,Choice,Stack) end, + lists:any(IsInstance, Choices); +is_instance(X, Mod, {T,_,Name,[]}, Stack) when ?IS_TYPE_TAG(T) -> + case orddict:find(Name, ?EQUIV_TYPES) of + {ok,EquivType} -> + is_instance(X, Mod, EquivType, Stack); + error -> + is_maybe_hard_adt(X, Mod, Name, [], Stack) + end; +is_instance(X, Mod, {T,_,Name,ArgForms}, Stack) when ?IS_TYPE_TAG(T) -> + is_maybe_hard_adt(X, Mod, Name, ArgForms, Stack); +is_instance(_X, _Mod, _Type, _Stack) -> + false. + +-spec is_int_const(term(), abs_expr()) -> boolean(). +is_int_const(X, Expr) -> + case eval_int(Expr) of + {ok,Int} -> + X =:= Int; + error -> + abs_expr_error(invalid_int_const, Expr) + end. + +%% TODO: We implicitly add the '| []' at the termination of maybe_improper_list. +%% TODO: We ignore a '[]' termination in improper_list. +-spec list_test(term(), mod_name(), abs_type(), 'dummy' | abs_type(), boolean(), + boolean(), boolean()) -> boolean(). +list_test(X, Mod, Content, Termination, CanEmpty, CanProper, CanImproper) -> + is_list(X) andalso + list_rec(X, Mod, Content, Termination, CanEmpty, CanProper, CanImproper). + +-spec list_rec(term(), mod_name(), abs_type(), 'dummy' | abs_type(), boolean(), + boolean(), boolean()) -> boolean(). +list_rec([], _Mod, _Content, _Termination, CanEmpty, CanProper, _CanImproper) -> + CanEmpty andalso CanProper; +list_rec([X | Rest], Mod, Content, Termination, _CanEmpty, CanProper, + CanImproper) -> + is_instance(X, Mod, Content, []) andalso + list_rec(Rest, Mod, Content, Termination, true, CanProper, CanImproper); +list_rec(X, Mod, _Content, Termination, _CanEmpty, _CanProper, CanImproper) -> + CanImproper andalso is_instance(X, Mod, Termination, []). + +-spec tuple_test([term()], mod_name(), [abs_type()]) -> boolean(). +tuple_test([], _Mod, []) -> + true; +tuple_test([X | XTail], Mod, [T | TTail]) -> + is_instance(X, Mod, T, []) andalso tuple_test(XTail, Mod, TTail); +tuple_test(_, _Mod, _) -> + false. + +-spec is_maybe_hard_adt(term(), mod_name(), type_name(), [abs_type()], + imm_stack()) -> boolean(). +is_maybe_hard_adt(X, Mod, Name, ArgForms, Stack) -> + case orddict:find({Name,length(ArgForms)}, ?HARD_ADTS) of + {ok,ADTMod} -> + is_custom_instance(X, Mod, ADTMod, Name, ArgForms, true, Stack); + error -> + is_custom_instance(X, Mod, Mod, Name, ArgForms, false, Stack) + end. + +-spec is_custom_instance(term(), mod_name(), mod_name(), type_name(), + [abs_type()], boolean(), imm_stack()) -> boolean(). +is_custom_instance(X, Mod, RemMod, Name, RawArgForms, IsRemote, Stack) -> + ArgForms = case Mod =/= RemMod of + true -> [{from_mod,Mod,A} || A <- RawArgForms]; + false -> RawArgForms + end, + Arity = length(ArgForms), + FullTypeRef = {RemMod,Name,Arity}, + case lists:member(FullTypeRef, Stack) of + true -> + throw({'$typeserver',{self_reference,FullTypeRef}}); + false -> + TypeRef = {type,Name,Arity}, + AbsType = get_abs_type(RemMod, TypeRef, ArgForms, IsRemote), + is_instance(X, RemMod, AbsType, [FullTypeRef|Stack]) + end. + +-spec get_abs_type(mod_name(), type_ref(), [abs_type()], boolean()) -> + abs_type(). +get_abs_type(RemMod, TypeRef, ArgForms, IsRemote) -> + case get_type_repr(RemMod, TypeRef, IsRemote) of + {ok,TypeRepr} -> + {FinalAbsType,SymbInfo,VarNames} = + case TypeRepr of + {cached,_FinType,FAT,SI} -> {FAT,SI,[]}; + {abs_type,FAT,VN,SI} -> {FAT,SI,VN} + end, + AbsType = + case SymbInfo of + not_symb -> FinalAbsType; + {orig_abs,OrigAbsType} -> OrigAbsType + end, + VarSubstsDict = dict:from_list(lists:zip(VarNames,ArgForms)), + update_vars(AbsType, VarSubstsDict, false); + {error,Reason} -> + throw({'$typeserver',Reason}) + end. + +-spec abs_expr_error(atom(), abs_expr()) -> no_return(). +abs_expr_error(ImmReason, Expr) -> + {error,Reason} = expr_error(ImmReason, Expr), + throw({'$typeserver',Reason}). + +-spec abs_expr_error(atom(), abs_expr(), abs_expr()) -> no_return(). +abs_expr_error(ImmReason, Expr1, Expr2) -> + {error,Reason} = expr_error(ImmReason, Expr1, Expr2), + throw({'$typeserver',Reason}). + + +%%------------------------------------------------------------------------------ +%% Type translation functions +%%------------------------------------------------------------------------------ + +-spec convert(mod_name(), abs_type(), state()) -> + rich_result2(fin_type(),state()). +convert(Mod, TypeForm, State) -> + case convert(Mod, TypeForm, State, [], dict:new()) of + {ok,{simple,Type},NewState} -> + {ok, Type, NewState}; + {ok,{rec,_RecFun,_RecArgs},_NewState} -> + {error, {internal,rec_returned_to_toplevel}}; + {error,_Reason} = Error -> + Error + end. + +-spec convert(mod_name(), abs_type(), state(), stack(), var_dict()) -> + rich_result2(ret_type(),state()). +convert(Mod, {paren_type,_,[Type]}, State, Stack, VarDict) -> + convert(Mod, Type, State, Stack, VarDict); +convert(Mod, {ann_type,_,[_Var,Type]}, State, Stack, VarDict) -> + convert(Mod, Type, State, Stack, VarDict); +convert(_Mod, {var,_,'_'}, State, _Stack, _VarDict) -> + {ok, {simple,proper_types:any()}, State}; +convert(_Mod, {var,_,VarName}, State, _Stack, VarDict) -> + case dict:find(VarName, VarDict) of + %% TODO: do we need to check if we are at toplevel of a recursive? + {ok,RetType} -> {ok, RetType, State}; + error -> {error, {unbound_var,VarName}} + end; +convert(Mod, {remote_type,_,[{atom,_,RemMod},{atom,_,Name},ArgForms]}, State, + Stack, VarDict) -> + case prepare_for_remote(RemMod, Name, length(ArgForms), State) of + {ok,NewState} -> + convert_custom(Mod,RemMod,Name,ArgForms,NewState,Stack,VarDict); + {error,_Reason} = Error -> + Error + end; +convert(_Mod, {atom,_,Atom}, State, _Stack, _VarDict) -> + {ok, {simple,proper_types:exactly(Atom)}, State}; +convert(_Mod, {integer,_,_Int} = IntExpr, State, _Stack, _VarDict) -> + convert_integer(IntExpr, State); +convert(_Mod, {op,_,_Op,_Arg} = OpExpr, State, _Stack, _VarDict) -> + convert_integer(OpExpr, State); +convert(_Mod, {op,_,_Op,_Arg1,_Arg2} = OpExpr, State, _Stack, _VarDict) -> + convert_integer(OpExpr, State); +convert(_Mod, {type,_,binary,[BaseExpr,UnitExpr]}, State, _Stack, _VarDict) -> + %% <<_:X,_:_*Y>> means "bitstrings of X + k*Y bits, k >= 0" + case eval_int(BaseExpr) of + {ok,0} -> + case eval_int(UnitExpr) of + {ok,0} -> {ok, {simple,proper_types:exactly(<<>>)}, State}; + {ok,1} -> {ok, {simple,proper_types:bitstring()}, State}; + {ok,8} -> {ok, {simple,proper_types:binary()}, State}; + {ok,N} when N > 0 -> + Gen = ?LET(L, proper_types:list(proper_types:bitstring(N)), + concat_bitstrings(L)), + {ok, {simple,Gen}, State}; + _ -> expr_error(invalid_unit, UnitExpr) + end; + {ok,Base} when Base > 0 -> + Head = proper_types:bitstring(Base), + case eval_int(UnitExpr) of + {ok,0} -> {ok, {simple,Head}, State}; + {ok,1} -> + Tail = proper_types:bitstring(), + {ok, {simple,concat_binary_gens(Head, Tail)}, State}; + {ok,8} -> + Tail = proper_types:binary(), + {ok, {simple,concat_binary_gens(Head, Tail)}, State}; + {ok,N} when N > 0 -> + Tail = + ?LET(L, proper_types:list(proper_types:bitstring(N)), + concat_bitstrings(L)), + {ok, {simple,concat_binary_gens(Head, Tail)}, State}; + _ -> expr_error(invalid_unit, UnitExpr) + end; + _ -> + expr_error(invalid_base, BaseExpr) + end; +convert(_Mod, {type,_,range,[LowExpr,HighExpr]}, State, _Stack, _VarDict) -> + case {eval_int(LowExpr),eval_int(HighExpr)} of + {{ok,Low},{ok,High}} when Low =< High -> + {ok, {simple,proper_types:integer(Low,High)}, State}; + _ -> + expr_error(invalid_range, LowExpr, HighExpr) + end; +convert(_Mod, {type,_,nil,[]}, State, _Stack, _VarDict) -> + {ok, {simple,proper_types:exactly([])}, State}; +convert(Mod, {type,_,list,[ElemForm]}, State, Stack, VarDict) -> + convert_list(Mod, false, ElemForm, State, Stack, VarDict); +convert(Mod, {type,_,nonempty_list,[ElemForm]}, State, Stack, VarDict) -> + convert_list(Mod, true, ElemForm, State, Stack, VarDict); +convert(_Mod, {type,_,nonempty_list,[]}, State, _Stack, _VarDict) -> + {ok, {simple,proper_types:non_empty(proper_types:list())}, State}; +convert(_Mod, {type,_,nonempty_string,[]}, State, _Stack, _VarDict) -> + {ok, {simple,proper_types:non_empty(proper_types:string())}, State}; +convert(_Mod, {type,_,tuple,any}, State, _Stack, _VarDict) -> + {ok, {simple,proper_types:tuple()}, State}; +convert(Mod, {type,_,tuple,ElemForms}, State, Stack, VarDict) -> + convert_tuple(Mod, ElemForms, false, State, Stack, VarDict); +convert(Mod, {type,_,'$fixed_list',ElemForms}, State, Stack, VarDict) -> + convert_tuple(Mod, ElemForms, true, State, Stack, VarDict); +convert(Mod, {type,_,record,[{atom,_,Name}|FieldForms]}, State, Stack, + VarDict) -> + convert_record(Mod, Name, FieldForms, State, Stack, VarDict); +convert(Mod, {type,_,union,ChoiceForms}, State, Stack, VarDict) -> + convert_union(Mod, ChoiceForms, State, Stack, VarDict); +convert(Mod, {type,_,'fun',[{type,_,product,Domain},Range]}, State, Stack, + VarDict) -> + convert_fun(Mod, length(Domain), Range, State, Stack, VarDict); +%% TODO: These types should be replaced with accurate types. +%% TODO: Add support for nonempty_improper_list/2. +convert(Mod, {type,Anno,maybe_improper_list,[]}, State, Stack, VarDict) -> + convert(Mod, {type,Anno,list,[]}, State, Stack, VarDict); +convert(Mod, {type,A,maybe_improper_list,[Cont,_Ter]}, State, Stack, VarDict) -> + convert(Mod, {type,A,list,[Cont]}, State, Stack, VarDict); +convert(Mod, {type,A,nonempty_maybe_improper_list,[]}, State, Stack, VarDict) -> + convert(Mod, {type,A,nonempty_list,[]}, State, Stack, VarDict); +convert(Mod, {type,A,nonempty_maybe_improper_list,[Cont,_Term]}, State, Stack, + VarDict) -> + convert(Mod, {type,A,nonempty_list,[Cont]}, State, Stack, VarDict); +convert(Mod, {type,A,iodata,[]}, State, Stack, VarDict) -> + RealType = {type,A,union,[{type,A,binary,[]},{type,A,iolist,[]}]}, + convert(Mod, RealType, State, Stack, VarDict); +convert(Mod, {T,_,Name,[]}, State, Stack, VarDict) when ?IS_TYPE_TAG(T) -> + case ordsets:is_element(Name, ?STD_TYPES_0) of + true -> + {ok, {simple,proper_types:Name()}, State}; + false -> + convert_maybe_hard_adt(Mod, Name, [], State, Stack, VarDict) + end; +convert(Mod, {T,_,Name,ArgForms}, State, Stack, VarDict) when ?IS_TYPE_TAG(T) -> + convert_maybe_hard_adt(Mod, Name, ArgForms, State, Stack, VarDict); +convert(_Mod, TypeForm, _State, _Stack, _VarDict) -> + {error, {unsupported_type,TypeForm}}. + +-spec concat_bitstrings([bitstring()]) -> bitstring(). +concat_bitstrings(BitStrings) -> + concat_bitstrings_tr(BitStrings, <<>>). + +-spec concat_bitstrings_tr([bitstring()], bitstring()) -> bitstring(). +concat_bitstrings_tr([], Acc) -> + Acc; +concat_bitstrings_tr([BitString | Rest], Acc) -> + concat_bitstrings_tr(Rest, <<Acc/bits,BitString/bits>>). + +-spec concat_binary_gens(fin_type(), fin_type()) -> fin_type(). +concat_binary_gens(HeadType, TailType) -> + ?LET({H,T}, {HeadType,TailType}, <<H/bits,T/bits>>). + +-spec convert_fun(mod_name(), arity(), abs_type(), state(), stack(), + var_dict()) -> rich_result2(ret_type(),state()). +convert_fun(Mod, Arity, Range, State, Stack, VarDict) -> + case convert(Mod, Range, State, ['fun' | Stack], VarDict) of + {ok,{simple,RangeType},NewState} -> + {ok, {simple,proper_types:function(Arity,RangeType)}, NewState}; + {ok,{rec,RecFun,RecArgs},NewState} -> + case at_toplevel(RecArgs, Stack) of + true -> base_case_error(Stack); + false -> convert_rec_fun(Arity, RecFun, RecArgs, NewState) + end; + {error,_Reason} = Error -> + Error + end. + +-spec convert_rec_fun(arity(), rec_fun(), rec_args(), state()) -> + {'ok',ret_type(),state()}. +convert_rec_fun(Arity, RecFun, RecArgs, State) -> + %% We bind the generated value by size. + NewRecFun = + fun(GenFuns,Size) -> + proper_types:function(Arity, RecFun(GenFuns,Size)) + end, + NewRecArgs = clean_rec_args(RecArgs), + {ok, {rec,NewRecFun,NewRecArgs}, State}. + +-spec convert_list(mod_name(), boolean(), abs_type(), state(), stack(), + var_dict()) -> rich_result2(ret_type(),state()). +convert_list(Mod, NonEmpty, ElemForm, State, Stack, VarDict) -> + case convert(Mod, ElemForm, State, [list | Stack], VarDict) of + {ok,{simple,ElemType},NewState} -> + InnerType = proper_types:list(ElemType), + FinType = case NonEmpty of + true -> proper_types:non_empty(InnerType); + false -> InnerType + end, + {ok, {simple,FinType}, NewState}; + {ok,{rec,RecFun,RecArgs},NewState} -> + case {at_toplevel(RecArgs,Stack), NonEmpty} of + {true,true} -> + base_case_error(Stack); + {true,false} -> + NewRecFun = + fun(GenFuns,Size) -> + ElemGen = fun(S) -> ?LAZY(RecFun(GenFuns,S)) end, + proper_types:distlist(Size, ElemGen, false) + end, + NewRecArgs = clean_rec_args(RecArgs), + {ok, {rec,NewRecFun,NewRecArgs}, NewState}; + {false,_} -> + {NewRecFun,NewRecArgs} = + convert_rec_list(RecFun, RecArgs, NonEmpty), + {ok, {rec,NewRecFun,NewRecArgs}, NewState} + end; + {error,_Reason} = Error -> + Error + end. + +-spec convert_rec_list(rec_fun(), rec_args(), boolean()) -> + {rec_fun(),rec_args()}. +convert_rec_list(RecFun, [{true,FullTypeRef}] = RecArgs, NonEmpty) -> + {NewRecFun,_NormalRecArgs} = + convert_normal_rec_list(RecFun, RecArgs, NonEmpty), + AltRecFun = + fun([InstListGen],Size) -> + InstTypesList = + proper_types:get_prop(internal_types, InstListGen(Size)), + proper_types:fixed_list([RecFun([fun(_Size) -> I end],0) + || I <- InstTypesList]) + end, + NewRecArgs = [{{list,NonEmpty,AltRecFun},FullTypeRef}], + {NewRecFun, NewRecArgs}; +convert_rec_list(RecFun, RecArgs, NonEmpty) -> + convert_normal_rec_list(RecFun, RecArgs, NonEmpty). + +-spec convert_normal_rec_list(rec_fun(), rec_args(), boolean()) -> + {rec_fun(),rec_args()}. +convert_normal_rec_list(RecFun, RecArgs, NonEmpty) -> + NewRecFun = fun(GenFuns,Size) -> + ElemGen = fun(S) -> RecFun(GenFuns, S) end, + proper_types:distlist(Size, ElemGen, NonEmpty) + end, + NewRecArgs = clean_rec_args(RecArgs), + {NewRecFun, NewRecArgs}. + +-spec convert_tuple(mod_name(), [abs_type()], boolean(), state(), stack(), + var_dict()) -> rich_result2(ret_type(),state()). +convert_tuple(Mod, ElemForms, ToList, State, Stack, VarDict) -> + case process_list(Mod, ElemForms, State, [tuple | Stack], VarDict) of + {ok,RetTypes,NewState} -> + case combine_ret_types(RetTypes, {tuple,ToList}) of + {simple,_FinType} = RetType -> + {ok, RetType, NewState}; + {rec,_RecFun,RecArgs} = RetType -> + case at_toplevel(RecArgs, Stack) of + true -> base_case_error(Stack); + false -> {ok, RetType, NewState} + end + end; + {error,_Reason} = Error -> + Error + end. + +-spec convert_union(mod_name(), [abs_type()], state(), stack(), var_dict()) -> + rich_result2(ret_type(),state()). +convert_union(Mod, ChoiceForms, State, Stack, VarDict) -> + case process_list(Mod, ChoiceForms, State, [union | Stack], VarDict) of + {ok,RawChoices,NewState} -> + ProcessChoice = fun(T,A) -> process_choice(T,A,Stack) end, + {RevSelfRecs,RevNonSelfRecs,RevNonRecs} = + lists:foldl(ProcessChoice, {[],[],[]}, RawChoices), + case {lists:reverse(RevSelfRecs),lists:reverse(RevNonSelfRecs), + lists:reverse(RevNonRecs)} of + {_SelfRecs,[],[]} -> + base_case_error(Stack); + {[],NonSelfRecs,NonRecs} -> + {ok, combine_ret_types(NonRecs ++ NonSelfRecs, union), + NewState}; + {SelfRecs,NonSelfRecs,NonRecs} -> + {BCaseRecFun,BCaseRecArgs} = + case combine_ret_types(NonRecs ++ NonSelfRecs, union) of + {simple,BCaseType} -> + {fun([],_Size) -> BCaseType end,[]}; + {rec,BCRecFun,BCRecArgs} -> + {BCRecFun,BCRecArgs} + end, + NumBCaseGens = length(BCaseRecArgs), + [ParentRef | _Upper] = Stack, + FallbackRecFun = fun([SelfGen],_Size) -> SelfGen(0) end, + FallbackRecArgs = [{false,ParentRef}], + FallbackRetType = {rec,FallbackRecFun,FallbackRecArgs}, + {rec,RCaseRecFun,RCaseRecArgs} = + combine_ret_types([FallbackRetType] ++ SelfRecs + ++ NonSelfRecs, wunion), + NewRecFun = + fun(AllGens,Size) -> + {BCaseGens,RCaseGens} = + lists:split(NumBCaseGens, AllGens), + case Size of + 0 -> BCaseRecFun(BCaseGens,0); + _ -> RCaseRecFun(RCaseGens,Size) + end + end, + NewRecArgs = BCaseRecArgs ++ RCaseRecArgs, + {ok, {rec,NewRecFun,NewRecArgs}, NewState} + end; + {error,_Reason} = Error -> + Error + end. + +-spec process_choice(ret_type(), {[ret_type()],[ret_type()],[ret_type()]}, + stack()) -> {[ret_type()],[ret_type()],[ret_type()]}. +process_choice({simple,_} = RetType, {SelfRecs,NonSelfRecs,NonRecs}, _Stack) -> + {SelfRecs, NonSelfRecs, [RetType | NonRecs]}; +process_choice({rec,RecFun,RecArgs}, {SelfRecs,NonSelfRecs,NonRecs}, Stack) -> + case at_toplevel(RecArgs, Stack) of + true -> + case partition_by_toplevel(RecArgs, Stack, true) of + {[],[],_,_} -> + NewRecArgs = clean_rec_args(RecArgs), + {[{rec,RecFun,NewRecArgs} | SelfRecs], NonSelfRecs, + NonRecs}; + {SelfRecArgs,SelfPos,OtherRecArgs,_OtherPos} -> + NumInstances = length(SelfRecArgs), + IsListInst = fun({true,_FTRef}) -> false + ; ({{list,_NE,_AltRecFun},_FTRef}) -> true + end, + NewRecFun = + case proper_arith:filter(IsListInst,SelfRecArgs) of + {[],[]} -> + no_list_inst_rec_fun(RecFun,NumInstances, + SelfPos); + {[{{list,NonEmpty,AltRecFun},_}],[ListInstPos]} -> + list_inst_rec_fun(AltRecFun,NumInstances, + SelfPos,NonEmpty,ListInstPos) + end, + [{_B,SelfRef} | _] = SelfRecArgs, + NewRecArgs = + [{false,SelfRef} | clean_rec_args(OtherRecArgs)], + {[{rec,NewRecFun,NewRecArgs} | SelfRecs], NonSelfRecs, + NonRecs} + end; + false -> + NewRecArgs = clean_rec_args(RecArgs), + {SelfRecs, [{rec,RecFun,NewRecArgs} | NonSelfRecs], NonRecs} + end. + +-spec no_list_inst_rec_fun(rec_fun(), pos_integer(), [position()]) -> rec_fun(). +no_list_inst_rec_fun(RecFun, NumInstances, SelfPos) -> + fun([SelfGen|OtherGens], Size) -> + ?LETSHRINK( + Instances, + %% Size distribution will be a little off if both normal and + %% instance-accepting generators are present. + lists:duplicate(NumInstances, SelfGen(Size div NumInstances)), + begin + InstGens = [fun(_Size) -> proper_types:exactly(I) end + || I <- Instances], + AllGens = proper_arith:insert(InstGens, SelfPos, OtherGens), + RecFun(AllGens, Size) + end) + end. + +-spec list_inst_rec_fun(rec_fun(), pos_integer(), [position()], boolean(), + position()) -> rec_fun(). +list_inst_rec_fun(AltRecFun, NumInstances, SelfPos, NonEmpty, ListInstPos) -> + fun([SelfGen|OtherGens], Size) -> + ?LETSHRINK( + AllInsts, + lists:duplicate(NumInstances - 1, SelfGen(Size div NumInstances)) + ++ proper_types:distlist(Size div NumInstances, SelfGen, NonEmpty), + begin + {Instances,InstList} = lists:split(NumInstances - 1, AllInsts), + InstGens = [fun(_Size) -> proper_types:exactly(I) end + || I <- Instances], + InstTypesList = [proper_types:exactly(I) || I <- InstList], + InstListGen = + fun(_Size) -> proper_types:fixed_list(InstTypesList) end, + AllInstGens = proper_arith:list_insert(ListInstPos, InstListGen, + InstGens), + AllGens = proper_arith:insert(AllInstGens, SelfPos, OtherGens), + AltRecFun(AllGens, Size) + end) + end. + +-spec convert_maybe_hard_adt(mod_name(), type_name(), [abs_type()], state(), + stack(), var_dict()) -> + rich_result2(ret_type(),state()). +convert_maybe_hard_adt(Mod, Name, ArgForms, State, Stack, VarDict) -> + Arity = length(ArgForms), + case orddict:find({Name,Arity}, ?HARD_ADTS) of + {ok,Mod} -> + convert_custom(Mod, Mod, Name, ArgForms, State, Stack, VarDict); + {ok,ADTMod} -> + A = ?anno(0), + ADT = {remote_type,A,[{atom,A,ADTMod},{atom,A,Name},ArgForms]}, + convert(Mod, ADT, State, Stack, VarDict); + error -> + convert_custom(Mod, Mod, Name, ArgForms, State, Stack, VarDict) + end. + +-spec convert_custom(mod_name(), mod_name(), type_name(), [abs_type()], state(), + stack(), var_dict()) -> rich_result2(ret_type(),state()). +convert_custom(Mod, RemMod, Name, ArgForms, State, Stack, VarDict) -> + case process_list(Mod, ArgForms, State, Stack, VarDict) of + {ok,Args,NewState} -> + Arity = length(Args), + TypeRef = {type,Name,Arity}, + FullTypeRef = {RemMod,type,Name,Args}, + convert_type(TypeRef, FullTypeRef, NewState, Stack); + {error,_Reason} = Error -> + Error + end. + +-spec convert_record(mod_name(), type_name(), [abs_type()], state(), stack(), + var_dict()) -> rich_result2(ret_type(),state()). +convert_record(Mod, Name, RawSubsts, State, Stack, VarDict) -> + Substs = [{N,T} || {type,_,field_type,[{atom,_,N},T]} <- RawSubsts], + {SubstFields,SubstTypeForms} = lists:unzip(Substs), + case process_list(Mod, SubstTypeForms, State, Stack, VarDict) of + {ok,SubstTypes,NewState} -> + SubstsDict = dict:from_list(lists:zip(SubstFields, SubstTypes)), + TypeRef = {record,Name,0}, + FullTypeRef = {Mod,record,Name,SubstsDict}, + convert_type(TypeRef, FullTypeRef, NewState, Stack); + {error,_Reason} = Error -> + Error + end. + +-spec convert_type(type_ref(), full_type_ref(), state(), stack()) -> + rich_result2(ret_type(),state()). +convert_type(TypeRef, {Mod,_Kind,_Name,_Spec} = FullTypeRef, State, Stack) -> + case stack_position(FullTypeRef, Stack) of + none -> + case get_type_repr(Mod, TypeRef, false, State) of + {ok,TypeRepr,NewState} -> + convert_new_type(TypeRef, FullTypeRef, TypeRepr, NewState, + Stack); + {error,_Reason} = Error -> + Error + end; + 1 -> + base_case_error(Stack); + _Pos -> + {ok, {rec,fun([Gen],Size) -> Gen(Size) end,[{true,FullTypeRef}]}, + State} + end. + +-spec convert_new_type(type_ref(), full_type_ref(), type_repr(), state(), + stack()) -> rich_result2(ret_type(),state()). +convert_new_type(_TypeRef, {_Mod,type,_Name,[]}, + {cached,FinType,_TypeForm,_SymbInfo}, State, _Stack) -> + {ok, {simple,FinType}, State}; +convert_new_type(TypeRef, {Mod,type,_Name,Args} = FullTypeRef, + {abs_type,TypeForm,Vars,SymbInfo}, State, Stack) -> + VarDict = dict:from_list(lists:zip(Vars, Args)), + case convert(Mod, TypeForm, State, [FullTypeRef | Stack], VarDict) of + {ok, {simple,ImmFinType}, NewState} -> + FinType = case SymbInfo of + not_symb -> + ImmFinType; + {orig_abs,_OrigAbsType} -> + proper_symb:internal_well_defined(ImmFinType) + end, + FinalState = case Vars of + [] -> cache_type(Mod, TypeRef, FinType, TypeForm, + SymbInfo, NewState); + _ -> NewState + end, + {ok, {simple,FinType}, FinalState}; + {ok, {rec,RecFun,RecArgs}, NewState} -> + convert_maybe_rec(FullTypeRef, SymbInfo, RecFun, RecArgs, NewState, + Stack); + {error,_Reason} = Error -> + Error + end; +convert_new_type(_TypeRef, {Mod,record,Name,SubstsDict} = FullTypeRef, + {abs_record,OrigFields}, State, Stack) -> + Fields = [case dict:find(FieldName, SubstsDict) of + {ok,NewFieldType} -> NewFieldType; + error -> OrigFieldType + end + || {FieldName,OrigFieldType} <- OrigFields], + case convert_tuple(Mod, [{atom,0,Name} | Fields], false, State, + [FullTypeRef | Stack], dict:new()) of + {ok, {simple,_FinType}, _NewState} = Result -> + Result; + {ok, {rec,RecFun,RecArgs}, NewState} -> + convert_maybe_rec(FullTypeRef, not_symb, RecFun, RecArgs, NewState, + Stack); + {error,_Reason} = Error -> + Error + end. + +-spec cache_type(mod_name(), type_ref(), fin_type(), abs_type(), symb_info(), + state()) -> state(). +cache_type(Mod, TypeRef, FinType, TypeForm, SymbInfo, + #state{types = Types} = State) -> + TypeRepr = {cached,FinType,TypeForm,SymbInfo}, + ModTypes = dict:fetch(Mod, Types), + NewModTypes = dict:store(TypeRef, TypeRepr, ModTypes), + NewTypes = dict:store(Mod, NewModTypes, Types), + State#state{types = NewTypes}. + +-spec convert_maybe_rec(full_type_ref(), symb_info(), rec_fun(), rec_args(), + state(), stack()) -> rich_result2(ret_type(),state()). +convert_maybe_rec(FullTypeRef, SymbInfo, RecFun, RecArgs, State, Stack) -> + case at_toplevel(RecArgs, Stack) of + true -> base_case_error(Stack); + false -> safe_convert_maybe_rec(FullTypeRef, SymbInfo, RecFun, RecArgs, + State) + end. + +-spec safe_convert_maybe_rec(full_type_ref(),symb_info(),rec_fun(),rec_args(), + state()) -> rich_result2(ret_type(),state()). +safe_convert_maybe_rec(FullTypeRef, SymbInfo, RecFun, RecArgs, State) -> + case partition_rec_args(FullTypeRef, RecArgs, false) of + {[],[],_,_} -> + {ok, {rec,RecFun,RecArgs}, State}; + {MyRecArgs,MyPos,OtherRecArgs,_OtherPos} -> + case lists:all(fun({B,_T}) -> B =:= false end, MyRecArgs) of + true -> convert_rec_type(SymbInfo, RecFun, MyPos, OtherRecArgs, + State); + false -> {error, {internal,true_rec_arg_reached_type}} + end + end. + +-spec convert_rec_type(symb_info(), rec_fun(), [position()], rec_args(), + state()) -> {ok, ret_type(), state()}. +convert_rec_type(SymbInfo, RecFun, MyPos, [], State) -> + NumRecArgs = length(MyPos), + M = fun(GenFun) -> + fun(Size) -> + GenFuns = lists:duplicate(NumRecArgs, GenFun), + RecFun(GenFuns, erlang:max(0,Size - 1)) + end + end, + SizedGen = y(M), + ImmFinType = ?SIZED(Size,SizedGen(Size + 1)), + FinType = case SymbInfo of + not_symb -> + ImmFinType; + {orig_abs,_OrigAbsType} -> + proper_symb:internal_well_defined(ImmFinType) + end, + {ok, {simple,FinType}, State}; +convert_rec_type(_SymbInfo, RecFun, MyPos, OtherRecArgs, State) -> + NumRecArgs = length(MyPos), + NewRecFun = + fun(OtherGens,TopSize) -> + M = fun(GenFun) -> + fun(Size) -> + GenFuns = lists:duplicate(NumRecArgs, GenFun), + AllGens = + proper_arith:insert(GenFuns, MyPos, OtherGens), + RecFun(AllGens, erlang:max(0,Size - 1)) + end + end, + (y(M))(TopSize) + end, + NewRecArgs = clean_rec_args(OtherRecArgs), + {ok, {rec,NewRecFun,NewRecArgs}, State}. + +%% Y Combinator: Read more at http://bc.tech.coop/blog/070611.html. +-spec y(fun((fun((T) -> S)) -> fun((T) -> S))) -> fun((T) -> S). +y(M) -> + G = fun(F) -> + M(fun(A) -> (F(F))(A) end) + end, + G(G). + +-spec process_list(mod_name(), [abs_type() | ret_type()], state(), stack(), + var_dict()) -> rich_result2([ret_type()],state()). +process_list(Mod, RawTypes, State, Stack, VarDict) -> + Process = fun({simple,_FinType} = Type, {ok,Types,State1}) -> + {ok, [Type|Types], State1}; + ({rec,_RecFun,_RecArgs} = Type, {ok,Types,State1}) -> + {ok, [Type|Types], State1}; + (TypeForm, {ok,Types,State1}) -> + case convert(Mod, TypeForm, State1, Stack, VarDict) of + {ok,Type,State2} -> {ok,[Type|Types],State2}; + {error,_} = Err -> Err + end; + (_RawType, {error,_} = Err) -> + Err + end, + case lists:foldl(Process, {ok,[],State}, RawTypes) of + {ok,RevTypes,NewState} -> + {ok, lists:reverse(RevTypes), NewState}; + {error,_Reason} = Error -> + Error + end. + +-spec convert_integer(abs_expr(), state()) -> rich_result2(ret_type(),state()). +convert_integer(Expr, State) -> + case eval_int(Expr) of + {ok,Int} -> {ok, {simple,proper_types:exactly(Int)}, State}; + error -> expr_error(invalid_int_const, Expr) + end. + +-spec eval_int(abs_expr()) -> tagged_result(integer()). +eval_int(Expr) -> + NoBindings = erl_eval:new_bindings(), + try erl_eval:expr(Expr, NoBindings) of + {value,Value,_NewBindings} when is_integer(Value) -> + {ok, Value}; + _ -> + error + catch + error:_ -> + error + end. + +-spec expr_error(atom(), abs_expr()) -> {'error',term()}. +expr_error(Reason, Expr) -> + {error, {Reason,lists:flatten(erl_pp:expr(Expr))}}. + +-spec expr_error(atom(), abs_expr(), abs_expr()) -> {'error',term()}. +expr_error(Reason, Expr1, Expr2) -> + Str1 = lists:flatten(erl_pp:expr(Expr1)), + Str2 = lists:flatten(erl_pp:expr(Expr2)), + {error, {Reason,Str1,Str2}}. + +-spec base_case_error(stack()) -> {'error',term()}. +%% TODO: This might confuse, since it doesn't record the arguments to parametric +%% types or the type subsitutions of a record. +base_case_error([{Mod,type,Name,Args} | _Upper]) -> + Arity = length(Args), + {error, {no_base_case,{Mod,type,Name,Arity}}}; +base_case_error([{Mod,record,Name,_SubstsDict} | _Upper]) -> + {error, {no_base_case,{Mod,record,Name}}}. + + +%%------------------------------------------------------------------------------ +%% Helper datatypes handling functions +%%------------------------------------------------------------------------------ + +-spec stack_position(full_type_ref(), stack()) -> 'none' | pos_integer(). +stack_position(FullTypeRef, Stack) -> + SameType = fun(A) -> same_full_type_ref(A,FullTypeRef) end, + case proper_arith:find_first(SameType, Stack) of + {Pos,_} -> Pos; + none -> none + end. + +-spec partition_by_toplevel(rec_args(), stack(), boolean()) -> + {rec_args(),[position()],rec_args(),[position()]}. +partition_by_toplevel(RecArgs, [], _OnlyInstanceAccepting) -> + {[],[],RecArgs,lists:seq(1,length(RecArgs))}; +partition_by_toplevel(RecArgs, [_Parent | _Upper], _OnlyInstanceAccepting) + when is_atom(_Parent) -> + {[],[],RecArgs,lists:seq(1,length(RecArgs))}; +partition_by_toplevel(RecArgs, [Parent | _Upper], OnlyInstanceAccepting) -> + partition_rec_args(Parent, RecArgs, OnlyInstanceAccepting). + +-spec at_toplevel(rec_args(), stack()) -> boolean(). +at_toplevel(RecArgs, Stack) -> + case partition_by_toplevel(RecArgs, Stack, false) of + {[],[],_,_} -> false; + _ -> true + end. + +-spec partition_rec_args(full_type_ref(), rec_args(), boolean()) -> + {rec_args(),[position()],rec_args(),[position()]}. +partition_rec_args(FullTypeRef, RecArgs, OnlyInstanceAccepting) -> + SameType = + case OnlyInstanceAccepting of + true -> fun({false,_T}) -> false + ; ({_B,T}) -> same_full_type_ref(T,FullTypeRef) end; + false -> fun({_B,T}) -> same_full_type_ref(T,FullTypeRef) end + end, + proper_arith:partition(SameType, RecArgs). + +%% Tuples can be of 0 arity, unions of 1 and wunions at least of 2. +-spec combine_ret_types([ret_type()], {'tuple',boolean()} | 'union' + | 'wunion') -> ret_type(). +combine_ret_types(RetTypes, EnclosingType) -> + case lists:all(fun is_simple_ret_type/1, RetTypes) of + true -> + %% This should never happen for wunion. + Combine = case EnclosingType of + {tuple,false} -> fun proper_types:tuple/1; + {tuple,true} -> fun proper_types:fixed_list/1; + union -> fun proper_types:union/1 + end, + FinTypes = [T || {simple,T} <- RetTypes], + {simple, Combine(FinTypes)}; + false -> + NumTypes = length(RetTypes), + {RevRecFuns,RevRecArgsList,NumRecs} = + lists:foldl(fun add_ret_type/2, {[],[],0}, RetTypes), + RecFuns = lists:reverse(RevRecFuns), + RecArgsList = lists:reverse(RevRecArgsList), + RecArgLens = [length(RecArgs) || RecArgs <- RecArgsList], + RecFunInfo = {NumTypes,NumRecs,RecArgLens,RecFuns}, + FlatRecArgs = lists:flatten(RecArgsList), + {NewRecFun,NewRecArgs} = + case EnclosingType of + {tuple,ToList} -> + {tuple_rec_fun(RecFunInfo,ToList), + soft_clean_rec_args(FlatRecArgs,RecFunInfo,ToList)}; + union -> + {union_rec_fun(RecFunInfo),clean_rec_args(FlatRecArgs)}; + wunion -> + {wunion_rec_fun(RecFunInfo), + clean_rec_args(FlatRecArgs)} + end, + {rec, NewRecFun, NewRecArgs} + end. + +-spec tuple_rec_fun(rec_fun_info(), boolean()) -> rec_fun(). +tuple_rec_fun({_NumTypes,NumRecs,RecArgLens,RecFuns}, ToList) -> + Combine = case ToList of + true -> fun proper_types:fixed_list/1; + false -> fun proper_types:tuple/1 + end, + fun(AllGFs,TopSize) -> + Size = TopSize div NumRecs, + GFsList = proper_arith:unflatten(AllGFs, RecArgLens), + ArgsList = [[GenFuns,Size] || GenFuns <- GFsList], + ZipFun = fun erlang:apply/2, + Combine(lists:zipwith(ZipFun, RecFuns, ArgsList)) + end. + +-spec union_rec_fun(rec_fun_info()) -> rec_fun(). +union_rec_fun({_NumTypes,_NumRecs,RecArgLens,RecFuns}) -> + fun(AllGFs,Size) -> + GFsList = proper_arith:unflatten(AllGFs, RecArgLens), + ArgsList = [[GenFuns,Size] || GenFuns <- GFsList], + ZipFun = fun(F,A) -> ?LAZY(apply(F,A)) end, + proper_types:union(lists:zipwith(ZipFun, RecFuns, ArgsList)) + end. + +-spec wunion_rec_fun(rec_fun_info()) -> rec_fun(). +wunion_rec_fun({NumTypes,_NumRecs,RecArgLens,RecFuns}) -> + fun(AllGFs,Size) -> + GFsList = proper_arith:unflatten(AllGFs, RecArgLens), + ArgsList = [[GenFuns,Size] || GenFuns <- GFsList], + ZipFun = fun(W,F,A) -> {W,?LAZY(apply(F,A))} end, + RecWeight = erlang:max(1, Size div (NumTypes - 1)), + Weights = [1 | lists:duplicate(NumTypes - 1, RecWeight)], + WeightedChoices = lists:zipwith3(ZipFun, Weights, RecFuns, ArgsList), + proper_types:wunion(WeightedChoices) + end. + +-spec add_ret_type(ret_type(), {[rec_fun()],[rec_args()],non_neg_integer()}) -> + {[rec_fun()],[rec_args()],non_neg_integer()}. +add_ret_type({simple,FinType}, {RecFuns,RecArgsList,NumRecs}) -> + {[fun([],_) -> FinType end | RecFuns], [[] | RecArgsList], NumRecs}; +add_ret_type({rec,RecFun,RecArgs}, {RecFuns,RecArgsList,NumRecs}) -> + {[RecFun | RecFuns], [RecArgs | RecArgsList], NumRecs + 1}. + +-spec is_simple_ret_type(ret_type()) -> boolean(). +is_simple_ret_type({simple,_FinType}) -> + true; +is_simple_ret_type({rec,_RecFun,_RecArgs}) -> + false. + +-spec clean_rec_args(rec_args()) -> rec_args(). +clean_rec_args(RecArgs) -> + [{false,F} || {_B,F} <- RecArgs]. + +-spec soft_clean_rec_args(rec_args(), rec_fun_info(), boolean()) -> rec_args(). +soft_clean_rec_args(RecArgs, RecFunInfo, ToList) -> + soft_clean_rec_args_tr(RecArgs, [], RecFunInfo, ToList, false, 1). + +-spec soft_clean_rec_args_tr(rec_args(), rec_args(), rec_fun_info(), boolean(), + boolean(), position()) -> rec_args(). +soft_clean_rec_args_tr([], Acc, _RecFunInfo, _ToList, _FoundListInst, _Pos) -> + lists:reverse(Acc); +soft_clean_rec_args_tr([{{list,_NonEmpty,_AltRecFun},FTRef} | Rest], Acc, + RecFunInfo, ToList, true, Pos) -> + NewArg = {false,FTRef}, + soft_clean_rec_args_tr(Rest, [NewArg|Acc], RecFunInfo, ToList, true, Pos+1); +soft_clean_rec_args_tr([{{list,NonEmpty,AltRecFun},FTRef} | Rest], Acc, + RecFunInfo, ToList, false, Pos) -> + {NumTypes,NumRecs,RecArgLens,RecFuns} = RecFunInfo, + AltRecFunPos = get_group(Pos, RecArgLens), + AltRecFuns = proper_arith:list_update(AltRecFunPos, AltRecFun, RecFuns), + AltRecFunInfo = {NumTypes,NumRecs,RecArgLens,AltRecFuns}, + NewArg = {{list,NonEmpty,tuple_rec_fun(AltRecFunInfo,ToList)},FTRef}, + soft_clean_rec_args_tr(Rest, [NewArg|Acc], RecFunInfo, ToList, true, Pos+1); +soft_clean_rec_args_tr([Arg | Rest], Acc, RecFunInfo, ToList, FoundListInst, + Pos) -> + soft_clean_rec_args_tr(Rest, [Arg | Acc], RecFunInfo, ToList, FoundListInst, + Pos+1). + +-spec get_group(pos_integer(), [non_neg_integer()]) -> pos_integer(). +get_group(Pos, AllMembers) -> + get_group_tr(Pos, AllMembers, 1). + +-spec get_group_tr(pos_integer(), [non_neg_integer()], pos_integer()) -> + pos_integer(). +get_group_tr(Pos, [Members | Rest], GroupNum) -> + case Pos =< Members of + true -> GroupNum; + false -> get_group_tr(Pos - Members, Rest, GroupNum + 1) + end. + +-spec same_full_type_ref(full_type_ref(), term()) -> boolean(). +same_full_type_ref({SameMod,type,SameName,Args1}, + {SameMod,type,SameName,Args2}) -> + length(Args1) =:= length(Args2) + andalso lists:all(fun({A,B}) -> same_ret_type(A,B) end, + lists:zip(Args1, Args2)); +same_full_type_ref({SameMod,record,SameName,SubstsDict1}, + {SameMod,record,SameName,SubstsDict2}) -> + same_substs_dict(SubstsDict1, SubstsDict2); +same_full_type_ref(_, _) -> + false. + +-spec same_ret_type(ret_type(), ret_type()) -> boolean(). +same_ret_type({simple,FinType1}, {simple,FinType2}) -> + same_fin_type(FinType1, FinType2); +same_ret_type({rec,RecFun1,RecArgs1}, {rec,RecFun2,RecArgs2}) -> + NumRecArgs = length(RecArgs1), + length(RecArgs2) =:= NumRecArgs + andalso lists:all(fun({A1,A2}) -> same_rec_arg(A1,A2,NumRecArgs) end, + lists:zip(RecArgs1,RecArgs2)) + andalso same_rec_fun(RecFun1, RecFun2, NumRecArgs); +same_ret_type(_, _) -> + false. + +%% TODO: Is this too strict? +-spec same_rec_arg(rec_arg(), rec_arg(), arity()) -> boolean(). +same_rec_arg({{list,SameBool,AltRecFun1},FTRef1}, + {{list,SameBool,AltRecFun2},FTRef2}, NumRecArgs) -> + same_rec_fun(AltRecFun1, AltRecFun2, NumRecArgs) + andalso same_full_type_ref(FTRef1, FTRef2); +same_rec_arg({true,FTRef1}, {true,FTRef2}, _NumRecArgs) -> + same_full_type_ref(FTRef1, FTRef2); +same_rec_arg({false,FTRef1}, {false,FTRef2}, _NumRecArgs) -> + same_full_type_ref(FTRef1, FTRef2); +same_rec_arg(_, _, _NumRecArgs) -> + false. + +-spec same_substs_dict(substs_dict(), substs_dict()) -> boolean(). +same_substs_dict(SubstsDict1, SubstsDict2) -> + SameKVPair = fun({{_K,V1},{_K,V2}}) -> same_ret_type(V1,V2); + (_) -> false + end, + SubstsKVList1 = lists:sort(dict:to_list(SubstsDict1)), + SubstsKVList2 = lists:sort(dict:to_list(SubstsDict2)), + length(SubstsKVList1) =:= length(SubstsKVList2) + andalso lists:all(SameKVPair, lists:zip(SubstsKVList1,SubstsKVList2)). + +-spec same_fin_type(fin_type(), fin_type()) -> boolean(). +same_fin_type(Type1, Type2) -> + proper_types:equal_types(Type1, Type2). + +-spec same_rec_fun(rec_fun(), rec_fun(), arity()) -> boolean(). +same_rec_fun(RecFun1, RecFun2, NumRecArgs) -> + %% It's ok that we return a type, even if there's a 'true' for use of + %% an instance. + GenFun = fun(_Size) -> proper_types:exactly('$dummy') end, + GenFuns = lists:duplicate(NumRecArgs,GenFun), + same_fin_type(RecFun1(GenFuns,0), RecFun2(GenFuns,0)). diff --git a/lib/dialyzer/test/map_SUITE_data/dialyzer_options b/lib/dialyzer/test/map_SUITE_data/dialyzer_options new file mode 100644 index 0000000000..50991c9bc5 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/dialyzer_options @@ -0,0 +1 @@ +{dialyzer_options, []}. diff --git a/lib/dialyzer/test/map_SUITE_data/results/bad_argument b/lib/dialyzer/test/map_SUITE_data/results/bad_argument new file mode 100644 index 0000000000..af61a89638 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/bad_argument @@ -0,0 +1,5 @@ + +bad_argument.erl:14: Function t3/0 has no local return +bad_argument.erl:15: Guard test is_map('not_a_map') can never succeed +bad_argument.erl:5: Function t/0 has no local return +bad_argument.erl:6: A key of type 'b' cannot exist in a map of type #{'a':='q'} diff --git a/lib/dialyzer/test/map_SUITE_data/results/contract b/lib/dialyzer/test/map_SUITE_data/results/contract new file mode 100644 index 0000000000..0f6e1d0c65 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/contract @@ -0,0 +1,7 @@ + +contract.erl:10: Function t2/0 has no local return +contract.erl:10: The call missing:f(#{'a':=1, 'c':=4}) breaks the contract (#{'a':=1,'b'=>2,'c'=>3}) -> 'ok' +contract.erl:12: Function t3/0 has no local return +contract.erl:12: The call missing:f(#{'a':=1, 'b':=2, 'e':=3}) breaks the contract (#{'a':=1,'b'=>2,'c'=>3}) -> 'ok' +contract.erl:8: Function t1/0 has no local return +contract.erl:8: The call missing:f(#{'b':=2}) breaks the contract (#{'a':=1,'b'=>2,'c'=>3}) -> 'ok' diff --git a/lib/dialyzer/test/map_SUITE_data/results/contract_violation b/lib/dialyzer/test/map_SUITE_data/results/contract_violation new file mode 100644 index 0000000000..958321618f --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/contract_violation @@ -0,0 +1,3 @@ + +contract_violation.erl:12: The pattern #{I:=Loc} can never match the type #{} +contract_violation.erl:16: Invalid type specification for function contract_violation:beam_disasm_lines/2. The success typing is ('none' | <<_:32,_:_*8>>,_) -> #{pos_integer()=>{'location',_,_}} diff --git a/lib/dialyzer/test/map_SUITE_data/results/exact b/lib/dialyzer/test/map_SUITE_data/results/exact new file mode 100644 index 0000000000..374ada8869 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/exact @@ -0,0 +1,3 @@ + +exact.erl:15: Function t2/1 has no local return +exact.erl:19: The variable _ can never match since previous clauses completely covered the type #{'a':=_, ...} diff --git a/lib/dialyzer/test/map_SUITE_data/results/guard_update b/lib/dialyzer/test/map_SUITE_data/results/guard_update new file mode 100644 index 0000000000..e4bc892195 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/guard_update @@ -0,0 +1,5 @@ + +guard_update.erl:5: Function t/0 has no local return +guard_update.erl:6: The call guard_update:f(#{'a':=2}) will never return since it differs in the 1st argument from the success typing arguments: (#{'b':=_, ...}) +guard_update.erl:8: Clause guard cannot succeed. The variable M was matched against the type #{'a':=2} +guard_update.erl:8: Function f/1 has no local return diff --git a/lib/dialyzer/test/map_SUITE_data/results/initial_dataflow b/lib/dialyzer/test/map_SUITE_data/results/initial_dataflow new file mode 100644 index 0000000000..69144f9208 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/initial_dataflow @@ -0,0 +1,4 @@ + +initial_dataflow.erl:11: The variable Q can never match since previous clauses completely covered the type #{} +initial_dataflow.erl:5: Function test/0 has no local return +initial_dataflow.erl:6: The pattern 'false' can never match the type 'true' diff --git a/lib/dialyzer/test/map_SUITE_data/results/is_map_guard b/lib/dialyzer/test/map_SUITE_data/results/is_map_guard new file mode 100644 index 0000000000..6ab464d865 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/is_map_guard @@ -0,0 +1,5 @@ + +is_map_guard.erl:13: Function t2/0 has no local return +is_map_guard.erl:15: The call is_map_guard:explicit('still_not_map') will never return since it differs in the 1st argument from the success typing arguments: (map()) +is_map_guard.erl:6: Function t1/0 has no local return +is_map_guard.erl:8: The call is_map_guard:implicit('not_a_map') will never return since it differs in the 1st argument from the success typing arguments: (map()) diff --git a/lib/dialyzer/test/map_SUITE_data/results/map_galore b/lib/dialyzer/test/map_SUITE_data/results/map_galore new file mode 100644 index 0000000000..6ea88f01f8 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/map_galore @@ -0,0 +1,28 @@ + +map_galore.erl:1000: A key of type 42 cannot exist in a map of type #{1:='a', 2:='b', 4:='d', 5:='e', float()=>'c' | 'v'} +map_galore.erl:1080: A key of type 'nonexisting' cannot exist in a map of type #{#{'map':='key', 'one':='small'}:=[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}:=[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}:=[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 16:='a6', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 26:='b6', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 36:=[54 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[54 | 99,...], 16=>'a6', 26=>'b6', 36=>[54 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]}=>[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 100 | 101,...]}=>atom() | [1..255,...]} +map_galore.erl:1082: A key of type 42 cannot exist in a map of type #{#{'map':='key', 'one':='small'}:=[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}:=[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}:=[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 16:='a6', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 26:='b6', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 36:=[54 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[54 | 99,...], 16=>'a6', 26=>'b6', 36=>[54 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]}=>[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 100 | 101,...]}=>atom() | [1..255,...]} +map_galore.erl:1140: The call map_galore:map_guard_sequence_1(#{'seq':=6, 'val':=[101,...]}) will never return since it differs in the 1st argument from the success typing arguments: (#{'seq':=1 | 2 | 3 | 4 | 5, 'val':=[97 | 98 | 99 | 100 | 101,...], #{'map':='key', 'one':='small'}=>[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}=>[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}=>[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[any(),...], 31:=[any(),...], 32:=[any(),...], 33:=[any(),...], 34:=[any(),...], 35:=[any(),...], 37:=[any(),...], 38:=[any(),...], 39:=[any(),...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 16=>'a6', 26=>'b6', 36=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) +map_galore.erl:1141: The call map_galore:map_guard_sequence_2(#{'b':=5}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':='gg' | 'kk' | 'sc' | 3 | 4, 'b'=>'other' | 3 | 4 | 5, 'c'=>'sc2', #{'map':='key', 'one':='small'}=>[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}=>[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}=>[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[any(),...], 31:=[any(),...], 32:=[any(),...], 33:=[any(),...], 34:=[any(),...], 35:=[any(),...], 37:=[any(),...], 38:=[any(),...], 39:=[any(),...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 16=>'a6', 26=>'b6', 36=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) +map_galore.erl:1209: The call map_galore:map_guard_sequence_1(#{'seq':=6, 'val':=[101,...], #{'map':='key', 'one':='small'}:=[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}:=[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}:=[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 16:='a6', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 26:='b6', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 36:=[54 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | 3,...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[54 | 99,...], 16=>'a6', 26=>'b6', 36=>[54 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]}=>[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 100 | 101,...]}=>atom() | [1..255,...]}) will never return since it differs in the 1st argument from the success typing arguments: (#{'seq':=1 | 2 | 3 | 4 | 5, 'val':=[97 | 98 | 99 | 100 | 101,...], #{'map':='key', 'one':='small'}=>[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}=>[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}=>[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[any(),...], 31:=[any(),...], 32:=[any(),...], 33:=[any(),...], 34:=[any(),...], 35:=[any(),...], 37:=[any(),...], 38:=[any(),...], 39:=[any(),...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 16=>'a6', 26=>'b6', 36=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) +map_galore.erl:1210: The call map_galore:map_guard_sequence_2(#{'b':=5, #{'map':='key', 'one':='small'}:=[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}:=[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}:=[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 16:='a6', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 26:='b6', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 36:=[54 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | 3,...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[48 | 99,...], 31:=[49 | 99,...], 32:=[50 | 99,...], 33:=[51 | 99,...], 34:=[52 | 99,...], 35:=[53 | 99,...], 37:=[55 | 99,...], 38:=[56 | 99,...], 39:=[57 | 99,...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[54 | 99,...], 16=>'a6', 26=>'b6', 36=>[54 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | {[[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...],...]}=>[48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 100 | 101,...]}=>atom() | [1..255,...]}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':='gg' | 'kk' | 'sc' | 3 | 4, 'b'=>'other' | 3 | 4 | 5, 'c'=>'sc2', #{'map':='key', 'one':='small'}=>[32 | 49 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'second':='small'}=>[32 | 50 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], #{'map':='key', 'third':='small'}=>[32 | 51 | 97 | 101 | 107 | 108 | 109 | 112 | 115 | 121,...], 10=>'a0', 11=>'a1', 12=>'a2', 13=>'a3', 14=>'a4', 15=>'a5', 16=>'a6', 17=>'a7', 18=>'a8', 19=>'a9', 20=>'b0', 21=>'b1', 22=>'b2', 23=>'b3', 24=>'b4', 25=>'b5', 26=>'b6', 27=>'b7', 28=>'b8', 29=>'b9', 30=>[48 | 99,...], 31=>[49 | 99,...], 32=>[50 | 99,...], 33=>[51 | 99,...], 34=>[52 | 99,...], 35=>[53 | 99,...], 36=>[54 | 99,...], 37=>[55 | 99,...], 38=>[56 | 99,...], 39=>[57 | 99,...], <<_:16>> | [48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57,...] | float() | {[any(),...]} | #{10:='a0', 11:='a1', 12:='a2', 13:='a3', 14:='a4', 15:='a5', 17:='a7', 18:='a8', 19:='a9', 20:='b0', 21:='b1', 22:='b2', 23:='b3', 24:='b4', 25:='b5', 27:='b7', 28:='b8', 29:='b9', 30:=[any(),...], 31:=[any(),...], 32:=[any(),...], 33:=[any(),...], 34:=[any(),...], 35:=[any(),...], 37:=[any(),...], 38:=[any(),...], 39:=[any(),...], 'k16'=>'a6', 'k26'=>'b6', 'k36'=>[any(),...], 16=>'a6', 26=>'b6', 36=>[any(),...], <<_:16>> | [any(),...] | {_}=>[any(),...]}=>atom() | [1..255,...]}) +map_galore.erl:1418: Fun application with arguments (#{'s':='none', 'v':='none'}) will never return since it differs in the 1st argument from the success typing arguments: (#{'s':='l' | 't' | 'v', 'v':='none' | <<_:16>> | [<<_:16>>,...] | {<<_:16>>,<<_:16>>}}) +map_galore.erl:1491: The test #{} =:= #{'a':=1} can never evaluate to 'true' +map_galore.erl:1492: The test #{'a':=1} =:= #{} can never evaluate to 'true' +map_galore.erl:1495: The test #{'a':=1} =:= #{'a':=2} can never evaluate to 'true' +map_galore.erl:1496: The test #{'a':=2} =:= #{'a':=1} can never evaluate to 'true' +map_galore.erl:1497: The test #{'a':=2, 'b':=1} =:= #{'a':=1, 'b':=3} can never evaluate to 'true' +map_galore.erl:1498: The test #{'a':=1, 'b':=1} =:= #{'a':=1, 'b':=3} can never evaluate to 'true' +map_galore.erl:1762: The call maps:get({1, 1},#{{1,float()}=>[101 | 108 | 112 | 116 | 117,...]}) will never return since the success typing arguments are (any(),map()) +map_galore.erl:1763: The call maps:get('a',#{}) will never return since the success typing arguments are (any(),map()) +map_galore.erl:1765: The call maps:get('a',#{'b':=1, 'c':=2}) will never return since the success typing arguments are (any(),map()) +map_galore.erl:186: The pattern #{'x':=2} can never match the type #{'x':=3} +map_galore.erl:187: The pattern #{'x':=3} can never match the type {'a','b','c'} +map_galore.erl:188: The pattern #{'x':=3} can never match the type #{'y':=3} +map_galore.erl:189: The pattern #{'x':=3} can never match the type #{'x':=[101 | 104 | 114 | 116,...]} +map_galore.erl:2304: Cons will produce an improper list since its 2nd argument is {'b','a'} +map_galore.erl:2304: The call maps:from_list(nonempty_improper_list({'a','b'},{'b','a'})) will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) +map_galore.erl:2305: The call maps:from_list('a') will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) +map_galore.erl:2306: The call maps:from_list(42) will never return since it differs in the 1st argument from the success typing arguments: ([{_,_}]) +map_galore.erl:997: A key of type 'nonexisting' cannot exist in a map of type #{} +map_galore.erl:998: A key of type 'nonexisting' cannot exist in a map of type #{1:='a', 2:='b', 4:='d', 5:='e', float()=>'c'} diff --git a/lib/dialyzer/test/map_SUITE_data/results/map_in_guard b/lib/dialyzer/test/map_SUITE_data/results/map_in_guard new file mode 100644 index 0000000000..1015f76128 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/map_in_guard @@ -0,0 +1,4 @@ + +map_in_guard.erl:10: The call map_in_guard:assoc_update('not_a_map') will never return since it differs in the 1st argument from the success typing arguments: (#{}) +map_in_guard.erl:13: The call map_in_guard:assoc_guard_clause('not_a_map') will never return since it differs in the 1st argument from the success typing arguments: (#{}) +map_in_guard.erl:20: The call map_in_guard:exact_guard_clause(#{}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':='q'}) diff --git a/lib/dialyzer/test/map_SUITE_data/results/map_in_guard2 b/lib/dialyzer/test/map_SUITE_data/results/map_in_guard2 new file mode 100644 index 0000000000..6bc0c010d7 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/map_in_guard2 @@ -0,0 +1,13 @@ + +map_in_guard2.erl:10: The call map_in_guard2:assoc_guard_clause('not_a_map') will never return since it differs in the 1st argument from the success typing arguments: (map()) +map_in_guard2.erl:12: The pattern 'true' can never match the type 'false' +map_in_guard2.erl:14: The call map_in_guard2:exact_guard_clause(#{}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':=_, ...}) +map_in_guard2.erl:17: Clause guard cannot succeed. The variable M was matched against the type 'not_a_map' +map_in_guard2.erl:20: Function assoc_update/1 has no local return +map_in_guard2.erl:20: Guard test is_map(M::'not_a_map') can never succeed +map_in_guard2.erl:22: Clause guard cannot succeed. The variable M was matched against the type 'not_a_map' +map_in_guard2.erl:22: Function assoc_guard_clause/1 has no local return +map_in_guard2.erl:24: Clause guard cannot succeed. The variable M was matched against the type #{} +map_in_guard2.erl:27: Clause guard cannot succeed. The variable M was matched against the type #{} +map_in_guard2.erl:27: Function exact_guard_clause/1 has no local return +map_in_guard2.erl:8: The call map_in_guard2:assoc_update('not_a_map') will never return since it differs in the 1st argument from the success typing arguments: (map()) diff --git a/lib/dialyzer/test/map_SUITE_data/results/map_size b/lib/dialyzer/test/map_SUITE_data/results/map_size new file mode 100644 index 0000000000..fc6c1f028c --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/map_size @@ -0,0 +1,13 @@ + +map_size.erl:11: The pattern 1 can never match the type 0 +map_size.erl:13: Function t2/0 has no local return +map_size.erl:15: Function p/1 has no local return +map_size.erl:15: Guard test 1 =:= 0 can never succeed +map_size.erl:17: Function t3/0 has no local return +map_size.erl:21: The pattern 4 can never match the type 1 | 2 | 3 +map_size.erl:23: Function t4/0 has no local return +map_size.erl:24: The pattern 0 can never match the type 1 | 2 | 3 +map_size.erl:26: Function t5/1 has no local return +map_size.erl:5: Function t1/0 has no local return +map_size.erl:7: The pattern 1 can never match the type 0 +map_size.erl:9: Function e1/0 has no local return diff --git a/lib/dialyzer/test/map_SUITE_data/results/maps_merge b/lib/dialyzer/test/map_SUITE_data/results/maps_merge new file mode 100644 index 0000000000..0c347b4cdb --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/maps_merge @@ -0,0 +1,11 @@ + +maps_merge.erl:10: The pattern #{_:=_} can never match the type #{'a':=1, 3:='ok', 'q'=>none(), 7=>none(), atom() | integer()=>_} +maps_merge.erl:12: Function t3/0 has no local return +maps_merge.erl:14: The pattern #{7:='q'} can never match the type #{'a':=1, 3:='ok', 'q'=>none(), 7=>none(), atom() | integer()=>_} +maps_merge.erl:16: Function t4/0 has no local return +maps_merge.erl:18: The pattern #{7:='q'} can never match the type #{'a':=1, 3:='ok', 'q'=>none(), 7=>none(), atom() | integer()=>_} +maps_merge.erl:20: Function t5/0 has no local return +maps_merge.erl:21: The pattern #{'a':=2} can never match the type #{'a':=1, 'q'=>none(), 11=>_, atom()=>_} +maps_merge.erl:5: Function t1/0 has no local return +maps_merge.erl:6: The pattern #{'a':=1} can never match the type #{} +maps_merge.erl:8: Function t2/0 has no local return diff --git a/lib/dialyzer/test/map_SUITE_data/results/opaque_key b/lib/dialyzer/test/map_SUITE_data/results/opaque_key new file mode 100644 index 0000000000..fb7080cdc5 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/opaque_key @@ -0,0 +1,15 @@ + +opaque_key_adt.erl:41: Invalid type specification for function opaque_key_adt:s4/0. The success typing is () -> #{1:='a'} +opaque_key_adt.erl:44: Invalid type specification for function opaque_key_adt:s5/0. The success typing is () -> #{2:=3} +opaque_key_adt.erl:56: Invalid type specification for function opaque_key_adt:smt1/0. The success typing is () -> #{3:='a'} +opaque_key_adt.erl:59: Invalid type specification for function opaque_key_adt:smt2/0. The success typing is () -> #{1:='a'} +opaque_key_use.erl:13: The test opaque_key_use:t() =:= opaque_key_use:t(integer()) can never evaluate to 'true' +opaque_key_use.erl:24: Attempt to test for equality between a term of type opaque_key_adt:t(integer()) and a term of opaque type opaque_key_adt:t() +opaque_key_use.erl:37: Function adt_mm1/0 has no local return +opaque_key_use.erl:40: The attempt to match a term of type opaque_key_adt:m() against the pattern #{A:=R} breaks the opaqueness of the term +opaque_key_use.erl:48: Function adt_mu1/0 has no local return +opaque_key_use.erl:51: Guard test is_map(M::opaque_key_adt:m()) breaks the opaqueness of its argument +opaque_key_use.erl:53: Function adt_mu2/0 has no local return +opaque_key_use.erl:56: Guard test is_map(M::opaque_key_adt:m()) breaks the opaqueness of its argument +opaque_key_use.erl:58: Function adt_mu3/0 has no local return +opaque_key_use.erl:60: Guard test is_map(M::opaque_key_adt:m()) breaks the opaqueness of its argument diff --git a/lib/dialyzer/test/map_SUITE_data/results/order b/lib/dialyzer/test/map_SUITE_data/results/order new file mode 100644 index 0000000000..7be789a11a --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/order @@ -0,0 +1,17 @@ + +order.erl:12: Function t2/0 has no local return +order.erl:14: Guard test is_integer(Int::'b') can never succeed +order.erl:16: The variable _Else can never match since previous clauses completely covered the type 'b' +order.erl:19: Function t3/0 has no local return +order.erl:21: Guard test is_integer(Int::'b') can never succeed +order.erl:23: The variable _Else can never match since previous clauses completely covered the type 'b' +order.erl:30: The variable _Else can never match since previous clauses completely covered the type 'b' | 1 +order.erl:33: Function t5/0 has no local return +order.erl:36: The variable Atom can never match since previous clauses completely covered the type 1 +order.erl:37: The variable _Else can never match since previous clauses completely covered the type 1 +order.erl:40: Function t6/0 has no local return +order.erl:42: Guard test is_integer(Int::'b') can never succeed +order.erl:44: The variable _Else can never match since previous clauses completely covered the type 'b' +order.erl:5: Function t1/0 has no local return +order.erl:7: Guard test is_integer(Int::'b') can never succeed +order.erl:9: The variable _Else can never match since previous clauses completely covered the type 'b' diff --git a/lib/dialyzer/test/map_SUITE_data/results/subtract_value_flip b/lib/dialyzer/test/map_SUITE_data/results/subtract_value_flip new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/subtract_value_flip diff --git a/lib/dialyzer/test/map_SUITE_data/results/typeflow b/lib/dialyzer/test/map_SUITE_data/results/typeflow new file mode 100644 index 0000000000..e3378a24bb --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/typeflow @@ -0,0 +1,4 @@ + +typeflow.erl:14: Function t2/1 has no local return +typeflow.erl:16: The call lists:sort(integer()) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) +typeflow.erl:9: The variable _ can never match since previous clauses completely covered the type #{'a':=integer(), ...} diff --git a/lib/dialyzer/test/map_SUITE_data/results/typeflow2 b/lib/dialyzer/test/map_SUITE_data/results/typeflow2 new file mode 100644 index 0000000000..3adf638978 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/typeflow2 @@ -0,0 +1,13 @@ + +typeflow2.erl:10: The pattern #{'a':=X} can never match the type #{'a'=>none(), _=>maybe_improper_list() | integer()} +typeflow2.erl:11: The pattern #{'a':=X} can never match the type #{'a'=>none(), _=>maybe_improper_list() | integer()} +typeflow2.erl:26: Function t2/1 has no local return +typeflow2.erl:29: The call lists:sort(integer()) will never return since it differs in the 1st argument from the success typing arguments: ([any()]) +typeflow2.erl:42: The pattern #{'a':=X} can never match since previous clauses completely covered the type #{'a':=integer()} +typeflow2.erl:43: The variable _ can never match since previous clauses completely covered the type #{'a':=integer()} +typeflow2.erl:48: The pattern #{} can never match since previous clauses completely covered the type #{'a':=atom() | maybe_improper_list() | integer()} +typeflow2.erl:58: The pattern #{'a':=X} can never match the type #{'a'=>none(), _=>maybe_improper_list() | integer()} +typeflow2.erl:59: The pattern #{'a':=X} can never match the type #{'a'=>none(), _=>maybe_improper_list() | integer()} +typeflow2.erl:60: The pattern #{'a':=X} can never match the type #{'a'=>none(), _=>maybe_improper_list() | integer()} +typeflow2.erl:82: The pattern #{'a':=X} can never match the type #{} +typeflow2.erl:83: The pattern #{'a':=X} can never match the type #{} diff --git a/lib/dialyzer/test/map_SUITE_data/results/typesig b/lib/dialyzer/test/map_SUITE_data/results/typesig new file mode 100644 index 0000000000..3049402860 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/results/typesig @@ -0,0 +1,5 @@ + +typesig.erl:5: Function t1/0 has no local return +typesig.erl:5: The call typesig:test(#{'a':=1}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':={number()}, ...}) +typesig.erl:6: Function t2/0 has no local return +typesig.erl:6: The call typesig:test(#{'a':={'b'}}) will never return since it differs in the 1st argument from the success typing arguments: (#{'a':={number()}, ...}) diff --git a/lib/dialyzer/test/map_SUITE_data/src/bad_argument.erl b/lib/dialyzer/test/map_SUITE_data/src/bad_argument.erl new file mode 100644 index 0000000000..95e2b32ddc --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/bad_argument.erl @@ -0,0 +1,19 @@ +-module(bad_argument). + +-export([t/0, t2/0, t3/0]). + +t() -> + _=(id1(#{a=>q}))#{b:=9}. + +t2() -> + _ = id2(4), + X = id2(3), + _ = (#{ X => q})#{3 := p}, + X. + +t3() -> + (id3(not_a_map))#{a => b}. + +id1(X) -> X. +id2(X) -> X. +id3(X) -> X. diff --git a/lib/dialyzer/test/map_SUITE_data/src/bug.erl b/lib/dialyzer/test/map_SUITE_data/src/bug.erl new file mode 100644 index 0000000000..fc32f5641a --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/bug.erl @@ -0,0 +1,63 @@ +-module(bug). + +-export([t1/0, f1/1 + ,t2/0, f2/1 + ,t3/0, f3/1 + ,t4/0, f4/1 + ,t5/0, f5/1 + ]). + +t1() -> + V = f1(#{a=>b}), + case V of + #{a := Q} -> Q; %% Must not warn here + _ -> ok + end, + ok. + +f1(M) -> %% Should get map() succ typing + #{} = M. + +t2() -> + V = f2([#{a=>b}]), + case V of + [#{a := P}] -> P; %% Must not warn here + _ -> ok + end, + ok. + +f2(M) -> %% Should get [map(),...] succ typing + [#{}] = M. + +t3() -> + V = f3([#{a=>b},a]), + case V of + [#{a := P}, _Q] -> P; %% Must not warn here + _ -> ok + end, + ok. + +f3(M) -> %% Should get [map()|a,...] succ typing + [#{},a] = M. + +t4() -> + V = f4({#{a=>b},{}}), + case V of + {#{a := P},{}} -> P; %% Must not warn here + _ -> ok + end, + ok. + +f4(M) -> %% Should get {map(),{}} succ typing + {#{},{}} = M. + +t5() -> + V = f5(#{k=>q,a=>b}), + case V of + #{k := q, a := P} -> P; %% Must not warn here + _ -> ok + end, + ok. + +f5(M) -> %% Should get #{k:=q, ...} succ typing + #{k:=q} = M. diff --git a/lib/dialyzer/test/map_SUITE_data/src/contract.erl b/lib/dialyzer/test/map_SUITE_data/src/contract.erl new file mode 100644 index 0000000000..2b31be0d58 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/contract.erl @@ -0,0 +1,14 @@ +-module(missing). + +-export([t1/0, t2/0, t3/0, t4/0]). + +-spec f(#{a := 1, b => 2, c => 3}) -> ok. +f(_) -> ok. + +t1() -> f(#{b => 2}). + +t2() -> f(#{a => 1, c => 4}). + +t3() -> f(#{a => 1, b => 2, e => 3}). + +t4() -> f(#{a => 1, b => 2}). diff --git a/lib/dialyzer/test/map_SUITE_data/src/contract_violation.erl b/lib/dialyzer/test/map_SUITE_data/src/contract_violation.erl new file mode 100644 index 0000000000..850f2cad34 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/contract_violation.erl @@ -0,0 +1,29 @@ +-module(contract_violation). + +-export([entry/1, beam_disasm_lines/2]). + +%%----------------------------------------------------------------------- + +-type lines() :: #{non_neg_integer() => {string(), non_neg_integer()}}. + +entry(Bin) -> + I = 42, + case beam_disasm_lines(Bin, ':-)') of + #{I := Loc} -> {good, Loc}; + _ -> bad + end. + +-spec beam_disasm_lines(binary() | none, module()) -> lines(). + +beam_disasm_lines(none, _) -> #{}; +beam_disasm_lines(<<NumLines:32, LineBin:NumLines/binary, FileBin/binary>>, + _Module) -> + Lines = binary_to_term(LineBin), + Files = binary_to_term(FileBin), + lines_collect_items(Lines, Files, #{}). + +lines_collect_items([], _, Acc) -> Acc; +lines_collect_items([{FileNo, LineNo}|Rest], Files, Acc) -> + #{FileNo := File} = Files, + lines_collect_items( + Rest, Files, Acc#{map_size(Acc)+1 => {location, File, LineNo}}). diff --git a/lib/dialyzer/test/map_SUITE_data/src/exact.erl b/lib/dialyzer/test/map_SUITE_data/src/exact.erl new file mode 100644 index 0000000000..e5ad02ec54 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/exact.erl @@ -0,0 +1,23 @@ +-module(exact). + +-export([t1/1, t2/1]). + +t1(M = #{}) -> + any_map(M), + case M of + #{a := _} -> error(fail); + _ -> ok + end. + +any_map(X) -> + X#{a => 1, a := 2}. + +t2(M = #{}) -> + has_a(M), + case M of + #{a := _} -> error(ok); + _ -> unreachable + end. + +has_a(M) -> + M#{a := 1, a => 2}. diff --git a/lib/dialyzer/test/map_SUITE_data/src/guard_update.erl b/lib/dialyzer/test/map_SUITE_data/src/guard_update.erl new file mode 100644 index 0000000000..19d0089401 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/guard_update.erl @@ -0,0 +1,18 @@ +-module(guard_update). + +-export([t/0, t2/0]). + +t() -> + f(#{a=>2}). %% Illegal + +f(M) + when M#{b := 7} =/= q + -> ok. + +t2() -> + f2(#{a=>2}). %% Legal! + +f2(M) + when M#{b := 7} =/= q; + M =/= p + -> ok. diff --git a/lib/dialyzer/test/map_SUITE_data/src/initial_dataflow.erl b/lib/dialyzer/test/map_SUITE_data/src/initial_dataflow.erl new file mode 100644 index 0000000000..bbc0d5682a --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/initial_dataflow.erl @@ -0,0 +1,11 @@ +-module(initial_dataflow). + +-export([test/0]). + +test() -> + false = assoc_guard(#{}), + true = assoc_guard(not_a_map), + ok. + +assoc_guard(#{}) -> true; +assoc_guard(Q) -> false. diff --git a/lib/dialyzer/test/map_SUITE_data/src/is_map_guard.erl b/lib/dialyzer/test/map_SUITE_data/src/is_map_guard.erl new file mode 100644 index 0000000000..ceb4a8763a --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/is_map_guard.erl @@ -0,0 +1,17 @@ +-module(is_map_guard). + +-export([t1/0, t2/0, implicit/1, explicit/1 + ]). + +t1() -> + _ = implicit(#{}), + implicit(not_a_map). + +implicit(M) -> + M#{}. + +t2() -> + explicit(#{q=>d}), + explicit(still_not_map). + +explicit(M) when is_map(M) -> ok. diff --git a/lib/dialyzer/test/map_SUITE_data/src/map_galore.erl b/lib/dialyzer/test/map_SUITE_data/src/map_galore.erl new file mode 100644 index 0000000000..2611241379 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/map_galore.erl @@ -0,0 +1,2824 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(map_galore). +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2 + ]). + +-export([ + t_build_and_match_literals/1, t_build_and_match_literals_large/1, + t_update_literals/1, t_update_literals_large/1, + t_match_and_update_literals/1, t_match_and_update_literals_large/1, + t_update_map_expressions/1, + t_update_assoc/1, t_update_assoc_large/1, + t_update_exact/1, t_update_exact_large/1, + t_guard_bifs/1, + t_guard_sequence/1, t_guard_sequence_large/1, + t_guard_update/1, t_guard_update_large/1, + t_guard_receive/1, t_guard_receive_large/1, + t_guard_fun/1, + t_update_deep/1, + t_list_comprehension/1, + t_map_sort_literals/1, + t_map_equal/1, + t_map_compare/1, + t_map_size/1, + t_is_map/1, + + %% Specific Map BIFs + t_bif_map_get/1, + t_bif_map_find/1, + t_bif_map_is_key/1, + t_bif_map_keys/1, + t_bif_map_merge/1, + t_bif_map_new/1, + t_bif_map_put/1, + t_bif_map_remove/1, + t_bif_map_update/1, + t_bif_map_values/1, + t_bif_map_to_list/1, + t_bif_map_from_list/1, + + %% erlang + t_erlang_hash/1, + t_map_encode_decode/1, + + %% non specific BIF related + t_bif_build_and_check/1, + t_bif_merge_and_check/1, + + %% maps module not bifs + t_maps_fold/1, + t_maps_map/1, + t_maps_size/1, + t_maps_without/1, + + %% misc + t_erts_internal_order/1, + t_erts_internal_hash/1, + t_pdict/1, + t_ets/1, + t_dets/1, + t_tracing/1, + + %% instruction-level tests + t_has_map_fields/1, + y_regs/1 + ]). + +-include_lib("stdlib/include/ms_transform.hrl"). + +-define(CHECK(Cond,Term), + case (catch (Cond)) of + true -> true; + _ -> io:format("###### CHECK FAILED ######~nINPUT: ~p~n", [Term]), + exit(Term) + end). + +suite() -> []. + +all() -> [ + t_build_and_match_literals, t_build_and_match_literals_large, + t_update_literals, t_update_literals_large, + t_match_and_update_literals, t_match_and_update_literals_large, + t_update_map_expressions, + t_update_assoc, t_update_assoc_large, + t_update_exact, t_update_exact_large, + t_guard_bifs, + t_guard_sequence, t_guard_sequence_large, + t_guard_update, t_guard_update_large, + t_guard_receive, t_guard_receive_large, + t_guard_fun, t_list_comprehension, + t_update_deep, + t_map_equal, t_map_compare, + t_map_sort_literals, + + %% Specific Map BIFs + t_bif_map_get,t_bif_map_find,t_bif_map_is_key, + t_bif_map_keys, t_bif_map_merge, t_bif_map_new, + t_bif_map_put, + t_bif_map_remove, t_bif_map_update, + t_bif_map_values, + t_bif_map_to_list, t_bif_map_from_list, + + %% erlang + t_erlang_hash, t_map_encode_decode, + t_map_size, t_is_map, + + %% non specific BIF related + t_bif_build_and_check, + t_bif_merge_and_check, + + %% maps module + t_maps_fold, t_maps_map, + t_maps_size, t_maps_without, + + + %% Other functions + t_erts_internal_order, + t_erts_internal_hash, + t_pdict, + t_ets, + t_tracing, + + %% instruction-level tests + t_has_map_fields, + y_regs + ]. + +groups() -> []. + +init_per_suite(Config) -> Config. +end_per_suite(_Config) -> ok. + +init_per_group(_GroupName, Config) -> Config. +end_per_group(_GroupName, Config) -> Config. + +%% tests + +t_build_and_match_literals(Config) when is_list(Config) -> + #{} = #{}, + #{1:=a} = #{1=>a}, + #{1:=a,2:=b} = #{1=>a,2=>b}, + #{1:=a,2:=b,3:="c"} = #{1=>a,2=>b,3=>"c"}, + #{1:=a,2:=b,3:="c","4":="d"} = #{1=>a,2=>b,3=>"c","4"=>"d"}, + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>} = + #{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>}, + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f"} = + #{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f"}, + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} = + #{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}, + + #{[]:=a,42.0:=b,x:={x,y},[a,b]:=list} = + #{[]=>a,42.0=>b,x=>{x,y},[a,b]=>list}, + + #{<<"hi all">> := 1} = #{<<"hi",32,"all">> => 1}, + + #{a:=X,a:=X=3,b:=4} = #{a=>3,b=>4}, % weird but ok =) + + #{ a:=#{ b:=#{c := third, b:=second}}, b:=first} = + #{ b=>first, a=>#{ b=>#{c => third, b=> second}}}, + + M = #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}, + M = #{ map_1:=#{ map_2:=#{value_3 := third}, value_2:= second}, value_1:=first} = + #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}, + + %% error case + %V = 32, + %{'EXIT',{{badmatch,_},_}} = (catch (#{<<"hi all">> => 1} = #{<<"hi",V,"all">> => 1})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = #{x=>3})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = #{x=>3})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = {a,b,c})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = #{y=>3})), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = #{x=>"three"})), + ok. + +t_build_and_match_literals_large(Config) when is_list(Config) -> + % normal non-repeating + M0 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" }, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M0, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M0, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M0, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M0, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M0, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M0, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M0, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M0, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M0, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M0, + + 60 = map_size(M0), + 60 = maps:size(M0), + + % with repeating + M1 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 10=>na0,20=>nb0,30=>"nc0","40"=>"nd0",<<"50">>=>"ne0",{["00"]}=>"n10", + 11=>na1,21=>nb1,31=>"nc1","41"=>"nd1",<<"51">>=>"ne1",{["01"]}=>"n11", + 12=>na2,22=>nb2,32=>"nc2","42"=>"nd2",<<"52">>=>"ne2",{["02"]}=>"n12", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + + 13=>na3,23=>nb3,33=>"nc3","43"=>"nd3",<<"53">>=>"ne3",{["03"]}=>"n13", + 14=>na4,24=>nb4,34=>"nc4","44"=>"nd4",<<"54">>=>"ne4",{["04"]}=>"n14", + + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" }, + + #{10:=na0,20:=nb0,30:="nc0","40":="nd0",<<"50">>:="ne0",{["00"]}:="n10"} = M1, + #{11:=na1,21:=nb1,31:="nc1","41":="nd1",<<"51">>:="ne1",{["01"]}:="n11"} = M1, + #{12:=na2,22:=nb2,32:="nc2","42":="nd2",<<"52">>:="ne2",{["02"]}:="n12"} = M1, + #{13:=na3,23:=nb3,33:="nc3","43":="nd3",<<"53">>:="ne3",{["03"]}:="n13"} = M1, + #{14:=na4,24:=nb4,34:="nc4","44":="nd4",<<"54">>:="ne4",{["04"]}:="n14"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M1, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M1, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M1, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M1, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M1, + + 60 = map_size(M1), + 60 = maps:size(M1), + + % with floats + + M2 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9"}, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + 90 = map_size(M2), + 90 = maps:size(M2), + + % with bignums + M3 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + 36893488147419103232=>big1, 73786976294838206464=>big2, + 147573952589676412928=>big3, 18446744073709551616=>big4, + 4294967296=>big5, 8589934592=>big6, + 4294967295=>big7, 67108863=>big8 + }, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{36893488147419103232:=big1,67108863:=big8,"45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{147573952589676412928:=big3,8589934592:=big6,"46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{4294967296:=big5,18446744073709551616:=big4,"47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{4294967295:=big7,73786976294838206464:=big2,"48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + + 98 = map_size(M3), + 98 = maps:size(M3), + + %% with maps + + M4 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M4, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M4, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M4, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M4, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M4, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M4, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M4, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M4, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M4, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M4, + + #{ #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := "small map key 2", + #{ third => small, map => key } := "small map key 3" } = M4, + + #{ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 2" } = M4, + + + #{ 15:=V1,25:=b5,35:=V2,"45":="d5",<<"55">>:=V3,{["05"]}:="15", + #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := V4, + #{ third => small, map => key } := "small map key 3", + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := V5 } = M4, + + a5 = V1, + "c5" = V2, + "e5" = V3, + "small map key 2" = V4, + "large map key 1" = V5, + + 95 = map_size(M4), + 95 = maps:size(M4), + + % call for value + + M5 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M5, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M5, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M5, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M5, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M5, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M5, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M5, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M5, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M5, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M5, + + #{ #{ one => small, map => key } := "small map key 1", + #{ second => small, map => key } := "small map key 2", + #{ third => small, map => key } := "small map key 3" } = M5, + + #{ #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 2" } = M5, + + 95 = map_size(M5), + 95 = maps:size(M5), + + %% remember + + #{10:=a0,20:=b0,30:="c0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M0, + #{11:=a1,21:=b1,31:="c1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M0, + #{12:=a2,22:=b2,32:="c2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M0, + #{13:=a3,23:=b3,33:="c3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M0, + #{14:=a4,24:=b4,34:="c4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M0, + + #{10:=na0,20:=nb0,30:="nc0","40":="nd0",<<"50">>:="ne0",{["00"]}:="n10"} = M1, + #{11:=na1,21:=nb1,31:="nc1","41":="nd1",<<"51">>:="ne1",{["01"]}:="n11"} = M1, + #{12:=na2,22:=nb2,32:="nc2","42":="nd2",<<"52">>:="ne2",{["02"]}:="n12"} = M1, + #{13:=na3,23:=nb3,33:="nc3","43":="nd3",<<"53">>:="ne3",{["03"]}:="n13"} = M1, + #{14:=na4,24:=nb4,34:="nc4","44":="nd4",<<"54">>:="ne4",{["04"]}:="n14"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M1, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M1, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M1, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M1, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M1, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M2, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M2, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M2, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M2, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M2, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M2, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M2, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M2, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M2, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M2, + + #{15:=a5,25:=b5,35:="c5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16:=a6,26:=b6,36:="c6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17:=a7,27:=b7,37:="c7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18:=a8,28:=b8,38:="c8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19:=a9,29:=b9,39:="c9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{10.0:=fa0,20.0:=fb0,30.0:="fc0","40":="d0",<<"50">>:="e0",{["00"]}:="10"} = M3, + #{11.0:=fa1,21.0:=fb1,31.0:="fc1","41":="d1",<<"51">>:="e1",{["01"]}:="11"} = M3, + #{12.0:=fa2,22.0:=fb2,32.0:="fc2","42":="d2",<<"52">>:="e2",{["02"]}:="12"} = M3, + #{13.0:=fa3,23.0:=fb3,33.0:="fc3","43":="d3",<<"53">>:="e3",{["03"]}:="13"} = M3, + #{14.0:=fa4,24.0:=fb4,34.0:="fc4","44":="d4",<<"54">>:="e4",{["04"]}:="14"} = M3, + + #{15.0:=fa5,25.0:=fb5,35.0:="fc5","45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{16.0:=fa6,26.0:=fb6,36.0:="fc6","46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{17.0:=fa7,27.0:=fb7,37.0:="fc7","47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{18.0:=fa8,28.0:=fb8,38.0:="fc8","48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + #{19.0:=fa9,29.0:=fb9,39.0:="fc9","49":="d9",<<"59">>:="e9",{["09"]}:="19"} = M3, + + #{36893488147419103232:=big1,67108863:=big8,"45":="d5",<<"55">>:="e5",{["05"]}:="15"} = M3, + #{147573952589676412928:=big3,8589934592:=big6,"46":="d6",<<"56">>:="e6",{["06"]}:="16"} = M3, + #{4294967296:=big5,18446744073709551616:=big4,"47":="d7",<<"57">>:="e7",{["07"]}:="17"} = M3, + #{4294967295:=big7,73786976294838206464:=big2,"48":="d8",<<"58">>:="e8",{["08"]}:="18"} = M3, + + ok. + + +t_map_size(Config) when is_list(Config) -> + 0 = map_size(#{}), + 1 = map_size(#{a=>1}), + 1 = map_size(#{a=>"wat"}), + 2 = map_size(#{a=>1, b=>2}), + 3 = map_size(#{a=>1, b=>2, b=>"3","33"=><<"n">>}), + + true = map_is_size(#{a=>1}, 1), + true = map_is_size(#{a=>1, a=>2}, 1), + M = #{ "a" => 1, "b" => 2}, + true = map_is_size(M, 2), + false = map_is_size(M, 3), + true = map_is_size(M#{ "a" => 2}, 2), + false = map_is_size(M#{ "c" => 2}, 2), + + Ks = [build_key(fun(K) -> <<1,K:32,1>> end,I)||I<-lists:seq(1,100)], + ok = build_and_check_size(Ks,0,#{}), + + %% try deep collisions + %% statistically we get another subtree at 50k -> 100k elements + %% Try to be nice and don't use too much memory in the testcase, + + N = 500000, + Is = lists:seq(1,N), + N = map_size(maps:from_list([{I,I}||I<-Is])), + N = map_size(maps:from_list([{<<I:32>>,I}||I<-Is])), + N = map_size(maps:from_list([{integer_to_list(I),I}||I<-Is])), + N = map_size(maps:from_list([{float(I),I}||I<-Is])), + + %% Error cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch map_size(T)) + end), + ok. + +build_and_check_size([K|Ks],N,M0) -> + N = map_size(M0), + M1 = M0#{ K => K }, + build_and_check_size(Ks,N + 1,M1); +build_and_check_size([],N,M) -> + N = map_size(M), + ok. + +map_is_size(M,N) when map_size(M) =:= N -> true; +map_is_size(_,_) -> false. + +t_is_map(Config) when is_list(Config) -> + true = is_map(#{}), + true = is_map(#{a=>1}), + false = is_map({a,b}), + false = is_map(x), + if is_map(#{}) -> ok end, + if is_map(#{b=>1}) -> ok end, + if not is_map([1,2,3]) -> ok end, + if not is_map(x) -> ok end, + ok. + +% test map updates without matching +t_update_literals_large(Config) when is_list(Config) -> + Map = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + +t_update_literals(Config) when is_list(Config) -> + Map = #{x=>1,y=>2,z=>3,q=>4}, + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + + +loop_update_literals_x_q(Map, []) -> Map; +loop_update_literals_x_q(Map, [{X,Q}|Vs]) -> + loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs). + +% test map updates with matching +t_match_and_update_literals(Config) when is_list(Config) -> + Map = #{ x=>0,y=>"untouched",z=>"also untouched",q=>1, + #{ "one" => small, map => key } => "small map key 1" }, + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M1 = #{}, + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + +t_match_and_update_literals_large(Config) when is_list(Config) -> + Map = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + x=>0,y=>"untouched",z=>"also untouched",q=>1, + + #{ "one" => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = Map#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M1 = Map#{}, + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + + +loop_match_and_update_literals_x_q(Map, []) -> Map; +loop_match_and_update_literals_x_q(#{ q:=Q0, x:=X0, + #{ "one" => small, map => key } := "small map key 1" } = Map, [{X,Q}|Vs]) -> + loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs). + + +t_update_map_expressions(Config) when is_list(Config) -> + M = maps:new(), + #{ a := 1 } = M#{a => 1}, + + #{ b := 2 } = (maps:new())#{ b => 2 }, + + #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 }, + #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 }, + Ks = lists:seq($a,$z), + #{ "aa" := {$a,$a}, "ac":=41, "dc":=42 } = + (maps:from_list([{[K1,K2],{K1,K2}}|| K1 <- Ks, K2 <- Ks]))#{ "ac" := 41, "dc" => 42 }, + + %% Error cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch (T)#{a:=42,b=>2}) + end), + ok. + +t_update_assoc(Config) when is_list(Config) -> + M0 = #{1=>a,2=>b,3.0=>c,4=>d,5=>e}, + + M1 = M0#{1=>42,2=>100,4=>[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + #{1:=42,2:=b,4:=d,5:=e,2.0:=100,3.0:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{3.0=>new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,3.0=>new}, + + %% Errors cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch T#{nonexisting=>val}) + end), + ok. + + +t_update_assoc_large(Config) when is_list(Config) -> + M0 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + + M1 = M0#{1=>42,2=>100,4=>[a,b,c]}, + #{1:=42,2:=100,10.0:=fa0,4:=[a,b,c],25:=b5} = M1, + #{ 10:=43, 24:=b4, 15:=a5, 35:="c5", 2.0:=100, 13.0:=fa3, 4.0:=[a,b,c]} = + M0#{1.0=>float,10:=43,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{13.0=>new}, + #{10:=a0,20:=b0,13.0:=new,"40":="d0",<<"50">>:="e0"} = M2, + M2 = M0#{13.0:=wrong,13.0=>new}, + + ok. + +t_update_exact(Config) when is_list(Config) -> + M0 = #{1=>a,2=>b,3.0=>c,4=>d,5=>e}, + + M1 = M0#{1:=42,2:=100,4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + M1 = M0#{1:=wrong,1=>42,2=>wrong,2:=100,4:=[a,b,c]}, + + M2 = M0#{3.0:=new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,3.0:=new}, + true = M2 =/= M0#{3=>right,3.0:=new}, + #{ 3 := right, 3.0 := new } = M0#{3=>right,3.0:=new}, + + M3 = #{ 1 => val}, + #{1 := update2,1.0 := new_val4} = M3#{ + 1.0 => new_val1, 1 := update, 1=> update3, + 1 := update2, 1.0 := new_val2, 1.0 => new_val3, + 1.0 => new_val4 }, + + %% Errors cases. + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch T#{nonexisting=>val}) + end), + Empty = #{}, + {'EXIT',{{badkey,nonexisting},_}} = (catch Empty#{nonexisting:=val}), + {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{{badkey,1.0},_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{{badkey,42},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,42.0},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + + ok. + +t_update_exact_large(Config) when is_list(Config) -> + M0 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + + M1 = M0#{10:=42,<<"55">>:=100,10.0:=[a,b,c]}, + #{ 10:=42,<<"55">>:=100,{["05"]}:="15",10.0:=[a,b,c], + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } := "large map key 1" } = M1, + + M1 = M0#{10:=wrong,10=>42,<<"55">>=>wrong,<<"55">>:=100,10.0:=[a,b,c]}, + + M2 = M0#{13.0:=new}, + #{10:=a0,20:=b0,13.0:=new} = M2, + M2 = M0#{13.0=>wrong,13.0:=new}, + + %% Errors cases. + {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{{badkey,1.0},_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{{badkey,42},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,42.0},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + + ok. + +t_update_deep(Config) when is_list(Config) -> + N = 250000, + M0 = maps:from_list([{integer_to_list(I),a}||I<-lists:seq(1,N)]), + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + + M1 = M0#{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + + M2 = M0#{ "1" => c, "10" => c, "100" => c, "1000" => c, "10000" => c }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M2, + + M3 = M2#{ "n1" => d, "n10" => d, "n100" => d, "n1000" => d, "n10000" => d }, + #{ "1" := a, "10" := a, "100" := a, "1000" := a, "10000" := a } = M0, + #{ "1" := b, "10" := b, "100" := b, "1000" := b, "10000" := b } = M1, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M2, + #{ "1" := c, "10" := c, "100" := c, "1000" := c, "10000" := c } = M3, + #{ "n1" := d, "n10" := d, "n100" := d, "n1000" := d, "n10000" := d } = M3, + ok. + +t_guard_bifs(Config) when is_list(Config) -> + true = map_guard_head(#{a=>1}), + false = map_guard_head([]), + true = map_guard_body(#{a=>1}), + false = map_guard_body({}), + true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }), + false = map_guard_pattern("list"), + ok. + +map_guard_head(M) when is_map(M) -> true; +map_guard_head(_) -> false. + +map_guard_body(M) -> is_map(M). + +map_guard_pattern(#{}) -> true; +map_guard_pattern(_) -> false. + +t_guard_sequence(Config) when is_list(Config) -> + {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>"a"}), + {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>"b"}), + {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>"c"}), + {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>"d"}), + {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>"e"}), + + {1,M1} = map_guard_sequence_2(M1 = #{a=>3}), + {2,M2} = map_guard_sequence_2(M2 = #{a=>4, b=>4}), + {3,gg,M3} = map_guard_sequence_2(M3 = #{a=>gg, b=>4}), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = #{a=>sc, b=>3, c=>sc2}), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = #{a=>kk, b=>other, c=>sc2}), + + %% error case + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>"e"})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), + ok. + +t_guard_sequence_large(Config) when is_list(Config) -> + M0 = #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00",03]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01",03]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02",03]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03",03]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04",03]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05",03]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06",03]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07",03]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08",03]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09",03]}=>"19", + + 10.0=>fa0,20.0=>fb0,30.0=>"fc0", + 11.0=>fa1,21.0=>fb1,31.0=>"fc1", + 12.0=>fa2,22.0=>fb2,32.0=>"fc2", + 13.0=>fa3,23.0=>fb3,33.0=>"fc3", + 14.0=>fa4,24.0=>fb4,34.0=>"fc4", + + 15.0=>fa5,25.0=>fb5,35.0=>"fc5", + 16.0=>fa6,26.0=>fb6,36.0=>"fc6", + 17.0=>fa7,27.0=>fb7,37.0=>"fc7", + 18.0=>fa8,28.0=>fb8,38.0=>"fc8", + 19.0=>fa9,29.0=>fb9,39.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + {1, "a"} = map_guard_sequence_1(M0#{seq=>1,val=>"a"}), + {2, "b"} = map_guard_sequence_1(M0#{seq=>2,val=>"b"}), + {3, "c"} = map_guard_sequence_1(M0#{seq=>3,val=>"c"}), + {4, "d"} = map_guard_sequence_1(M0#{seq=>4,val=>"d"}), + {5, "e"} = map_guard_sequence_1(M0#{seq=>5,val=>"e"}), + + {1,M1} = map_guard_sequence_2(M1 = M0#{a=>3}), + {2,M2} = map_guard_sequence_2(M2 = M0#{a=>4, b=>4}), + {3,gg,M3} = map_guard_sequence_2(M3 = M0#{a=>gg, b=>4}), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = M0#{a=>sc, b=>3, c=>sc2}), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = M0#{a=>kk, b=>other, c=>sc2}), + + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(M0#{seq=>6,val=>"e"})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(M0#{b=>5})), + ok. + + +map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=4=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=5=Seq, val:=Val}) -> {Seq,Val}. + +map_guard_sequence_2(#{ a:=3 }=M) -> {1, M}; +map_guard_sequence_2(#{ a:=4 }=M) -> {2, M}; +map_guard_sequence_2(#{ a:=X, a:=X, b:=4 }=M) -> {3,X,M}; +map_guard_sequence_2(#{ a:=X, a:=Y, b:=3 }=M) when X =:= Y -> {4,X,Y,M}; +map_guard_sequence_2(#{ a:=X, a:=Y }=M) when X =:= Y -> {5,X,Y,M}. + + +t_guard_update(Config) when is_list(Config) -> + error = map_guard_update(#{},#{}), + first = map_guard_update(#{}, #{x=>first}), + second = map_guard_update(#{y=>old}, #{x=>second,y=>old}), + ok. + +t_guard_update_large(Config) when is_list(Config) -> + M0 = #{ 70=>a0,80=>b0,90=>"c0","40"=>"d0",<<"50">>=>"e0",{["00",03]}=>"10", + 71=>a1,81=>b1,91=>"c1","41"=>"d1",<<"51">>=>"e1",{["01",03]}=>"11", + 72=>a2,82=>b2,92=>"c2","42"=>"d2",<<"52">>=>"e2",{["02",03]}=>"12", + 73=>a3,83=>b3,93=>"c3","43"=>"d3",<<"53">>=>"e3",{["03",03]}=>"13", + 74=>a4,84=>b4,94=>"c4","44"=>"d4",<<"54">>=>"e4",{["04",03]}=>"14", + + 75=>a5,85=>b5,95=>"c5","45"=>"d5",<<"55">>=>"e5",{["05",03]}=>"15", + 76=>a6,86=>b6,96=>"c6","46"=>"d6",<<"56">>=>"e6",{["06",03]}=>"16", + 77=>a7,87=>b7,97=>"c7","47"=>"d7",<<"57">>=>"e7",{["07",03]}=>"17", + 78=>a8,88=>b8,98=>"c8","48"=>"d8",<<"58">>=>"e8",{["08",03]}=>"18", + 79=>a9,89=>b9,99=>"c9","49"=>"d9",<<"59">>=>"e9",{["09",03]}=>"19", + + 70.0=>fa0,80.0=>fb0,90.0=>"fc0", + 71.0=>fa1,81.0=>fb1,91.0=>"fc1", + 72.0=>fa2,82.0=>fb2,92.0=>"fc2", + 73.0=>fa3,83.0=>fb3,93.0=>"fc3", + 74.0=>fa4,84.0=>fb4,94.0=>"fc4", + + 75.0=>fa5,85.0=>fb5,95.0=>"fc5", + 76.0=>fa6,86.0=>fb6,96.0=>"fc6", + 77.0=>fa7,87.0=>fb7,97.0=>"fc7", + 78.0=>fa8,88.0=>fb8,98.0=>"fc8", + 79.0=>fa9,89.0=>fb9,99.0=>"fc9", + + #{ one => small, map => key } => "small map key 1", + #{ second => small, map => key } => "small map key 2", + #{ third => small, map => key } => "small map key 3", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + 16=>a6,26=>b6,36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 1", + + #{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 13=>a3,23=>b3,33=>"c3","43"=>"d3",<<"53">>=>"e3",{["03"]}=>"13", + 14=>a4,24=>b4,34=>"c4","44"=>"d4",<<"54">>=>"e4",{["04"]}=>"14", + + 15=>a5,25=>b5,35=>"c5","45"=>"d5",<<"55">>=>"e5",{["05"]}=>"15", + k16=>a6,k26=>b6,k36=>"c6","46"=>"d6",<<"56">>=>"e6",{["06"]}=>"16", + 17=>a7,27=>b7,37=>"c7","47"=>"d7",<<"57">>=>"e7",{["07"]}=>"17", + 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", + 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }, + + + error = map_guard_update(M0#{},M0#{}), + first = map_guard_update(M0#{},M0#{x=>first}), + second = map_guard_update(M0#{y=>old}, M0#{x=>second,y=>old}), + ok. + + +map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first; +map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second; +map_guard_update(_, _) -> error. + +t_guard_receive(Config) when is_list(Config) -> + M0 = #{ id => 0 }, + Pid = spawn_link(fun() -> guard_receive_loop() end), + Big = 36893488147419103229, + B1 = <<"some text">>, + B2 = <<"was appended">>, + B3 = <<B1/binary, B2/binary>>, + + #{id:=1, res:=Big} = M1 = call(Pid, M0#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=2, res:=26} = M2 = call(Pid, M1#{op=>idiv,in=>{53,2}}), + #{id:=3, res:=832} = M3 = call(Pid, M2#{op=>imul,in=>{26,32}}), + #{id:=4, res:=4} = M4 = call(Pid, M3#{op=>add,in=>{1,3}}), + #{id:=5, res:=Big} = M5 = call(Pid, M4#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=6, res:=B3} = M6 = call(Pid, M5#{op=>"append",in=>{B1,B2}}), + #{id:=7, res:=4} = _ = call(Pid, M6#{op=>add,in=>{1,3}}), + + + %% update old maps and check id update + #{id:=2, res:=B3} = call(Pid, M1#{op=>"append",in=>{B1,B2}}), + #{id:=5, res:=99} = call(Pid, M4#{op=>add,in=>{33, 66}}), + + %% cleanup + done = call(Pid, done), + ok. + +-define(t_guard_receive_large_procs, 1500). + +t_guard_receive_large(Config) when is_list(Config) -> + M = lists:foldl(fun(_,#{procs := Ps } = M) -> + M#{ procs := Ps#{ spawn_link(fun() -> grecv_loop() end) => 0 }} + end, #{procs => #{}, done => 0}, lists:seq(1,?t_guard_receive_large_procs)), + lists:foreach(fun(Pid) -> + Pid ! {self(), hello} + end, maps:keys(maps:get(procs,M))), + ok = guard_receive_large_loop(M), + ok. + +guard_receive_large_loop(#{done := ?t_guard_receive_large_procs}) -> + ok; +guard_receive_large_loop(M) -> + receive + #{pid := Pid, msg := hello} -> + case M of + #{done := Count, procs := #{Pid := 150}} -> + Pid ! {self(), done}, + guard_receive_large_loop(M#{done := Count + 1}); + #{procs := #{Pid := Count} = Ps} -> + Pid ! {self(), hello}, + guard_receive_large_loop(M#{procs := Ps#{Pid := Count + 1}}) + end + end. + +grecv_loop() -> + receive + {_, done} -> + ok; + {Pid, hello} -> + Pid ! #{pid=>self(), msg=>hello}, + grecv_loop() + end. + +call(Pid, M) -> + Pid ! {self(), M}, receive {Pid, Res} -> Res end. + +guard_receive_loop() -> + receive + {Pid, #{ id:=Id, op:="append", in:={X,Y}}=M} when is_binary(X), is_binary(Y) -> + Pid ! {self(), M#{ id=>Id+1, res=><<X/binary,Y/binary>>}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=add, in:={X,Y}}} -> + Pid ! {self(), #{ id=>Id+1, res=>X+Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=sub, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X-Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=idiv, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X div Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=imul, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X * Y}}, + guard_receive_loop(); + {Pid, done} -> + Pid ! {self(), done}; + {Pid, Other} -> + Pid ! {error, Other}, + guard_receive_loop() + end. + + +t_list_comprehension(Config) when is_list(Config) -> + [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + + Ks = lists:seq($a,$z), + Ms = [#{[K1,K2]=>{K1,K2}} || K1 <- Ks, K2 <- Ks], + [#{"aa" := {$a,$a}},#{"ab":={$a,$b}}|_] = Ms, + [#{"zz" := {$z,$z}},#{"zy":={$z,$y}}|_] = lists:reverse(Ms), + ok. + +t_guard_fun(Config) when is_list(Config) -> + F1 = fun + (#{s:=v,v:=V}) -> {v,V}; + (#{s:=t,v:={V,V}}) -> {t,V}; + (#{s:=l,v:=[V,V]}) -> {l,V} + end, + + F2 = fun + (#{s:=T,v:={V,V}}) -> {T,V}; + (#{s:=T,v:=[V,V]}) -> {T,V}; + (#{s:=T,v:=V}) -> {T,V} + end, + V = <<"hi">>, + + {v,V} = F1(#{s=>v,v=>V}), + {t,V} = F1(#{s=>t,v=>{V,V}}), + {l,V} = F1(#{s=>l,v=>[V,V]}), + + {v,V} = F2(#{s=>v,v=>V}), + {t,V} = F2(#{s=>t,v=>{V,V}}), + {l,V} = F2(#{s=>l,v=>[V,V]}), + + %% error case + {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} = (catch F1(#{s=>none,v=>none})), + ok. + + +t_map_sort_literals(Config) when is_list(Config) -> + % test relation + + %% size order + true = #{ a => 1, b => 2} < #{ a => 1, b => 1, c => 1}, + true = #{ b => 1, a => 1} < #{ c => 1, a => 1, b => 1}, + false = #{ c => 1, b => 1, a => 1} < #{ c => 1, a => 1}, + + %% key order + true = #{ a => 1 } < #{ b => 1}, + false = #{ b => 1 } < #{ a => 1}, + true = #{ a => 1, b => 1, c => 1 } < #{ b => 1, c => 1, d => 1}, + true = #{ b => 1, c => 1, d => 1 } > #{ a => 1, b => 1, c => 1}, + true = #{ c => 1, b => 1, a => 1 } < #{ b => 1, c => 1, d => 1}, + true = #{ "a" => 1 } < #{ <<"a">> => 1}, + false = #{ <<"a">> => 1 } < #{ "a" => 1}, + true = #{ 1 => 1 } < #{ 1.0 => 1}, + false = #{ 1.0 => 1 } < #{ 1 => 1}, + + %% value order + true = #{ a => 1 } < #{ a => 2}, + false = #{ a => 2 } < #{ a => 1}, + false = #{ a => 2, b => 1 } < #{ a => 1, b => 3}, + true = #{ a => 1, b => 1 } < #{ a => 1, b => 3}, + false = #{ a => 1 } < #{ a => 1.0}, + false = #{ a => 1.0 } < #{ a => 1}, + + true = #{ "a" => "hi", b => 134 } == #{ b => 134,"a" => "hi"}, + + %% large maps + + M = maps:from_list([{I,I}||I <- lists:seq(1,500)]), + + %% size order + true = M#{ a => 1, b => 2} < M#{ a => 1, b => 1, c => 1}, + true = M#{ b => 1, a => 1} < M#{ c => 1, a => 1, b => 1}, + false = M#{ c => 1, b => 1, a => 1} < M#{ c => 1, a => 1}, + + %% key order + true = M#{ a => 1 } < M#{ b => 1}, + false = M#{ b => 1 } < M#{ a => 1}, + true = M#{ a => 1, b => 1, c => 1 } < M#{ b => 1, c => 1, d => 1}, + true = M#{ b => 1, c => 1, d => 1 } > M#{ a => 1, b => 1, c => 1}, + true = M#{ c => 1, b => 1, a => 1 } < M#{ b => 1, c => 1, d => 1}, + true = M#{ "a" => 1 } < M#{ <<"a">> => 1}, + false = M#{ <<"a">> => 1 } < #{ "a" => 1}, + true = M#{ 1 => 1 } < maps:remove(1,M#{ 1.0 => 1}), + false = M#{ 1.0 => 1 } < M#{ 1 => 1}, + + %% value order + true = M#{ a => 1 } < M#{ a => 2}, + false = M#{ a => 2 } < M#{ a => 1}, + false = M#{ a => 2, b => 1 } < M#{ a => 1, b => 3}, + true = M#{ a => 1, b => 1 } < M#{ a => 1, b => 3}, + false = M#{ a => 1 } < M#{ a => 1.0}, + false = M#{ a => 1.0 } < M#{ a => 1}, + + true = M#{ "a" => "hi", b => 134 } == M#{ b => 134,"a" => "hi"}, + + %% lists:sort + + SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}], + [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)), + ok. + +t_map_equal(Config) when is_list(Config) -> + true = #{} =:= #{}, + false = #{} =:= #{a=>1}, + false = #{a=>1} =:= #{}, + true = #{ "a" => "hi", b => 134 } =:= #{ b => 134,"a" => "hi"}, + + false = #{ a => 1 } =:= #{ a => 2}, + false = #{ a => 2 } =:= #{ a => 1}, + false = #{ a => 2, b => 1 } =:= #{ a => 1, b => 3}, + false = #{ a => 1, b => 1 } =:= #{ a => 1, b => 3}, + + true = #{ a => 1 } =:= #{ a => 1}, + true = #{ "a" => 2 } =:= #{ "a" => 2}, + true = #{ "a" => 2, b => 3 } =:= #{ "a" => 2, b => 3}, + true = #{ a => 1, b => 3, c => <<"wat">> } =:= #{ a => 1, b => 3, c=><<"wat">>}, + ok. + + +t_map_compare(Config) when is_list(Config) -> + Seed = {erlang:monotonic_time(), + erlang:time_offset(), + erlang:unique_integer()}, + io:format("seed = ~p\n", [Seed]), + random:seed(Seed), + repeat(100, fun(_) -> float_int_compare() end, []), + repeat(100, fun(_) -> recursive_compare() end, []), + ok. + +float_int_compare() -> + Terms = numeric_keys(3), + %%io:format("Keys to use: ~p\n", [Terms]), + Pairs = lists:map(fun(K) -> list_to_tuple([{K,V} || V <- Terms]) end, Terms), + lists:foreach(fun(Size) -> + MapGen = fun() -> map_gen(list_to_tuple(Pairs), Size) end, + repeat(100, fun do_compare/1, [MapGen, MapGen]) + end, + lists:seq(1,length(Terms))), + ok. + +numeric_keys(N) -> + lists:foldl(fun(_,Acc) -> + Int = random:uniform(N*4) - N*2, + Float = float(Int), + [Int, Float, Float * 0.99, Float * 1.01 | Acc] + end, + [], + lists:seq(1,N)). + + +repeat(0, _, _) -> + ok; +repeat(N, Fun, Arg) -> + Fun(Arg), + repeat(N-1, Fun, Arg). + +copy_term(T) -> + Papa = self(), + P = spawn_link(fun() -> receive Msg -> Papa ! Msg end end), + P ! T, + receive R -> R end. + +do_compare([Gen1, Gen2]) -> + M1 = Gen1(), + M2 = Gen2(), + %%io:format("Maps to compare: ~p AND ~p\n", [M1, M2]), + C = (M1 < M2), + Erlang = maps_lessthan(M1, M2), + C = Erlang, + ?CHECK(M1==M1, M1), + + %% Change one key from int to float (or vice versa) and check compare + ML1 = maps:to_list(M1), + {K1,V1} = lists:nth(random:uniform(length(ML1)), ML1), + case K1 of + I when is_integer(I) -> + case maps:find(float(I),M1) of + error -> + M1f = maps:remove(I, maps:put(float(I), V1, M1)), + ?CHECK(M1f > M1, [M1f, M1]); + _ -> ok + end; + + F when is_float(F), round(F) == F -> + case maps:find(round(F),M1) of + error -> + M1i = maps:remove(F, maps:put(round(F), V1, M1)), + ?CHECK(M1i < M1, [M1i, M1]); + _ -> ok + end; + + _ -> ok % skip floats with decimals + end, + + ?CHECK(M2 == M2, [M2]). + + +maps_lessthan(M1, M2) -> + case {maps:size(M1),maps:size(M2)} of + {_S,_S} -> + {K1,V1} = lists:unzip(term_sort(maps:to_list(M1))), + {K2,V2} = lists:unzip(term_sort(maps:to_list(M2))), + + case erts_internal:cmp_term(K1,K2) of + -1 -> true; + 0 -> (V1 < V2); + 1 -> false + end; + + {S1, S2} -> + S1 < S2 + end. + +term_sort(L) -> + lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) =< 0 end, + L). + + +cmp(T1, T2, Exact) when is_tuple(T1) and is_tuple(T2) -> + case {size(T1),size(T2)} of + {_S,_S} -> cmp(tuple_to_list(T1), tuple_to_list(T2), Exact); + {S1,S2} when S1 < S2 -> -1; + {S1,S2} when S1 > S2 -> 1 + end; + +cmp([H1|T1], [H2|T2], Exact) -> + case cmp(H1,H2, Exact) of + 0 -> cmp(T1,T2, Exact); + C -> C + end; + +cmp(M1, M2, Exact) when is_map(M1) andalso is_map(M2) -> + cmp_maps(M1,M2,Exact); +cmp(M1, M2, Exact) -> + cmp_others(M1, M2, Exact). + +cmp_maps(M1, M2, Exact) -> + case {maps:size(M1),maps:size(M2)} of + {_S,_S} -> + {K1,V1} = lists:unzip(term_sort(maps:to_list(M1))), + {K2,V2} = lists:unzip(term_sort(maps:to_list(M2))), + + case cmp(K1, K2, true) of + 0 -> cmp(V1, V2, Exact); + C -> C + end; + + {S1,S2} when S1 < S2 -> -1; + {S1,S2} when S1 > S2 -> 1 + end. + +cmp_others(I, F, true) when is_integer(I), is_float(F) -> + -1; +cmp_others(F, I, true) when is_float(F), is_integer(I) -> + 1; +cmp_others(T1, T2, _) -> + case {T1<T2, T1==T2} of + {true,false} -> -1; + {false,true} -> 0; + {false,false} -> 1 + end. + +map_gen(Pairs, Size) -> + {_,L} = lists:foldl(fun(_, {Keys, Acc}) -> + KI = random:uniform(size(Keys)), + K = element(KI,Keys), + KV = element(random:uniform(size(K)), K), + {erlang:delete_element(KI,Keys), [KV | Acc]} + end, + {Pairs, []}, + lists:seq(1,Size)), + + maps:from_list(L). + + +recursive_compare() -> + Leafs = {atom, 17, 16.9, 17.1, [], self(), spawn(fun() -> ok end), make_ref(), make_ref()}, + {A, B} = term_gen_recursive(Leafs, 0, 0), + %%io:format("Recursive term A = ~p\n", [A]), + %%io:format("Recursive term B = ~p\n", [B]), + + ?CHECK({true,false} =:= case do_cmp(A, B, false) of + -1 -> {A<B, A>=B}; + 0 -> {A==B, A/=B}; + 1 -> {A>B, A=<B} + end, + {A,B}), + A2 = copy_term(A), + ?CHECK(A == A2, {A,A2}), + ?CHECK(0 =:= cmp(A, A2, false), {A,A2}), + + B2 = copy_term(B), + ?CHECK(B == B2, {B,B2}), + ?CHECK(0 =:= cmp(B, B2, false), {B,B2}), + ok. + +do_cmp(A, B, Exact) -> + C = cmp(A, B, Exact), + C. + +%% Generate two terms {A,B} that may only differ +%% at float vs integer types. +term_gen_recursive(Leafs, Flags, Depth) -> + MaxDepth = 10, + Rnd = case {Flags, Depth} of + {_, MaxDepth} -> % Only leafs + random:uniform(size(Leafs)) + 3; + {0, 0} -> % Only containers + random:uniform(3); + {0,_} -> % Anything + random:uniform(size(Leafs)+3) + end, + case Rnd of + 1 -> % Make map + Size = random:uniform(size(Leafs)), + lists:foldl(fun(_, {Acc1,Acc2}) -> + {K1,K2} = term_gen_recursive(Leafs, Flags, + Depth+1), + {V1,V2} = term_gen_recursive(Leafs, Flags, Depth+1), + {maps:put(K1,V1, Acc1), maps:put(K2,V2, Acc2)} + end, + {maps:new(), maps:new()}, + lists:seq(1,Size)); + 2 -> % Make cons + {Car1,Car2} = term_gen_recursive(Leafs, Flags, Depth+1), + {Cdr1,Cdr2} = term_gen_recursive(Leafs, Flags, Depth+1), + {[Car1 | Cdr1], [Car2 | Cdr2]}; + 3 -> % Make tuple + Size = random:uniform(size(Leafs)), + L = lists:map(fun(_) -> term_gen_recursive(Leafs, Flags, Depth+1) end, + lists:seq(1,Size)), + {L1, L2} = lists:unzip(L), + {list_to_tuple(L1), list_to_tuple(L2)}; + + N -> % Make leaf + case element(N-3, Leafs) of + I when is_integer(I) -> + case random:uniform(4) of + 1 -> {I, float(I)}; + 2 -> {float(I), I}; + _ -> {I,I} + end; + T -> {T,T} + end + end. + +%% BIFs +t_bif_map_get(Config) when is_list(Config) -> + %% small map + 1 = maps:get(a, #{ a=> 1}), + 2 = maps:get(b, #{ a=> 1, b => 2}), + "hi" = maps:get("hello", #{ a=>1, "hello" => "hi"}), + "tuple hi" = maps:get({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), + + M0 = #{ k1=>"v1", <<"k2">> => <<"v3">> }, + "v4" = maps:get(<<"k2">>, M0#{<<"k2">> => "v4"}), + + %% large map + M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++ + [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"}, + {k1,"v1"},{<<"k2">>,"v3"}]), + 1 = maps:get(a, M1), + 2 = maps:get(b, M1), + "hi" = maps:get("hello", M1), + "tuple hi" = maps:get({1,1.0}, M1), + "v3" = maps:get(<<"k2">>, M1), + + %% error cases + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,get,_,_}|_]}} = + (catch maps:get(a, T)) + end), + + {'EXIT',{{badkey,{1,1}},[{maps,get,_,_}|_]}} = + (catch maps:get({1,1}, #{{1,1.0} => "tuple"})), + {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} = (catch maps:get(a, #{})), + {'EXIT',{{badkey,a},[{maps,get,_,_}|_]}} = + (catch maps:get(a, #{b=>1, c=>2})), + ok. + +t_bif_map_find(Config) when is_list(Config) -> + %% small map + {ok, 1} = maps:find(a, #{ a=> 1}), + {ok, 2} = maps:find(b, #{ a=> 1, b => 2}), + {ok, "int"} = maps:find(1, #{ 1 => "int"}), + {ok, "float"} = maps:find(1.0, #{ 1.0=> "float"}), + + {ok, "hi"} = maps:find("hello", #{ a=>1, "hello" => "hi"}), + {ok, "tuple hi"} = maps:find({1,1.0}, #{ a=>a, {1,1.0} => "tuple hi"}), + + M0 = #{ k1=>"v1", <<"k2">> => <<"v3">> }, + {ok, "v4"} = maps:find(<<"k2">>, M0#{ <<"k2">> => "v4" }), + + %% large map + M1 = maps:from_list([{I,I}||I<-lists:seq(1,100)] ++ + [{a,1},{b,2},{"hello","hi"},{{1,1.0},"tuple hi"}, + {k1,"v1"},{<<"k2">>,"v3"}]), + {ok, 1} = maps:find(a, M1), + {ok, 2} = maps:find(b, M1), + {ok, "hi"} = maps:find("hello", M1), + {ok, "tuple hi"} = maps:find({1,1.0}, M1), + {ok, "v3"} = maps:find(<<"k2">>, M1), + + %% error case + error = maps:find(a,#{}), + error = maps:find(a,#{b=>1, c=>2}), + error = maps:find(1.0, #{ 1 => "int"}), + error = maps:find(1, #{ 1.0 => "float"}), + error = maps:find({1.0,1}, #{ a=>a, {1,1.0} => "tuple hi"}), % reverse types in tuple key + + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,find,_,_}|_]}} = + (catch maps:find(a, T)) + end), + ok. + + +t_bif_map_is_key(Config) when is_list(Config) -> + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + + true = maps:is_key("hi", M1), + true = maps:is_key(int, M1), + true = maps:is_key(<<"key">>, M1), + true = maps:is_key(4, M1), + + false = maps:is_key(5, M1), + false = maps:is_key(<<"key2">>, M1), + false = maps:is_key("h", M1), + false = maps:is_key("hello", M1), + false = maps:is_key(atom, M1), + false = maps:is_key(any, #{}), + + false = maps:is_key("hi", maps:remove("hi", M1)), + true = maps:is_key("hi", M1), + true = maps:is_key(1, maps:put(1, "number", M1)), + false = maps:is_key(1.0, maps:put(1, "number", M1)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,is_key,_,_}|_]}} = + (catch maps:is_key(a, T)) + end), + ok. + +t_bif_map_keys(Config) when is_list(Config) -> + [] = maps:keys(#{}), + + [1,2,3,4,5] = lists:sort(maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})), + [1,2,3,4,5] = lists:sort(maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})), + + % values in key order: [4,int,"hi",<<"key">>] + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + [4,int,"hi",<<"key">>] = lists:sort(maps:keys(M1)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,keys,_,_}|_]}} = + (catch maps:keys(T)) + end), + ok. + +t_bif_map_new(Config) when is_list(Config) -> + #{} = maps:new(), + 0 = erlang:map_size(maps:new()), + ok. + +t_bif_map_merge(Config) when is_list(Config) -> + 0 = erlang:map_size(maps:merge(#{},#{})), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:merge(#{}, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:merge(M0, #{}), + + M1 = #{ "hi" => "hello again", float => 3.3, {1,2} => "tuple", 4 => integer }, + + #{4 := number, 18446744073709551629 := wat, float := 3.3, int := 3, + {1,2} := "tuple", "hi" := "hello", <<"key">> := <<"value">>} = maps:merge(M1,M0), + + #{4 := integer, 18446744073709551629 := wat, float := 3.3, int := 3, + {1,2} := "tuple", "hi" := "hello again", <<"key">> := <<"value">>} = maps:merge(M0,M1), + + %% try deep collisions + N = 150000, + Is = lists:seq(1,N), + M2 = maps:from_list([{I,I}||I<-Is]), + 150000 = maps:size(M2), + M3 = maps:from_list([{<<I:32>>,I}||I<-Is]), + 150000 = maps:size(M3), + M4 = maps:merge(M2,M3), + 300000 = maps:size(M4), + M5 = maps:from_list([{integer_to_list(I),I}||I<-Is]), + 150000 = maps:size(M5), + M6 = maps:merge(M4,M5), + 450000 = maps:size(M6), + M7 = maps:from_list([{float(I),I}||I<-Is]), + 150000 = maps:size(M7), + M8 = maps:merge(M7,M6), + 600000 = maps:size(M8), + + #{ 1 := 1, "1" := 1, <<1:32>> := 1 } = M8, + #{ 10 := 10, "10" := 10, <<10:32>> := 10 } = M8, + #{ 100 := 100, "100" := 100, <<100:32>> := 100 } = M8, + #{ 1000 := 1000, "1000" := 1000, <<1000:32>> := 1000 } = M8, + #{ 10000 := 10000, "10000" := 10000, <<10000:32>> := 10000 } = M8, + #{ 100000 := 100000, "100000" := 100000, <<100000:32>> := 100000 } = M8, + + %% overlapping + M8 = maps:merge(M2,M8), + M8 = maps:merge(M3,M8), + M8 = maps:merge(M4,M8), + M8 = maps:merge(M5,M8), + M8 = maps:merge(M6,M8), + M8 = maps:merge(M7,M8), + M8 = maps:merge(M8,M8), + + %% maps:merge/2 and mixed + + Ks1 = [764492191,2361333849], %% deep collision + Ks2 = lists:seq(1,33), + M9 = maps:from_list([{K,K}||K <- Ks1]), + M10 = maps:from_list([{K,K}||K <- Ks2]), + M11 = maps:merge(M9,M10), + ok = check_keys_exist(Ks1 ++ Ks2, M11), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(#{}, T)), + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(T, #{})), + {'EXIT',{{badmap,T},[{maps,merge,_,_}|_]}} = + (catch maps:merge(T, T)) + end), + ok. + + +t_bif_map_put(Config) when is_list(Config) -> + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + M1 = #{ "hi" := "hello"} = maps:put("hi", "hello", #{}), + + true = is_members(["hi"],maps:keys(M1)), + true = is_members(["hello"],maps:values(M1)), + + M2 = #{ int := 3 } = maps:put(int, 3, M1), + + true = is_members([int,"hi"],maps:keys(M2)), + true = is_members([3,"hello"],maps:values(M2)), + + M3 = #{ <<"key">> := <<"value">> } = maps:put(<<"key">>, <<"value">>, M2), + + true = is_members([int,"hi",<<"key">>],maps:keys(M3)), + true = is_members([3,"hello",<<"value">>],maps:values(M3)), + + M4 = #{ 18446744073709551629 := wat } = maps:put(18446744073709551629, wat, M3), + + true = is_members([18446744073709551629,int,"hi",<<"key">>],maps:keys(M4)), + true = is_members([wat,3,"hello",<<"value">>],maps:values(M4)), + + M0 = #{ 4 := number } = M5 = maps:put(4, number, M4), + + true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M5)), + true = is_members([number,wat,3,"hello",<<"value">>],maps:values(M5)), + + M6 = #{ <<"key">> := <<"other value">> } = maps:put(<<"key">>, <<"other value">>, M5), + + true = is_members([4,18446744073709551629,int,"hi",<<"key">>],maps:keys(M6)), + true = is_members([number,wat,3,"hello",<<"other value">>],maps:values(M6)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,put,_,_}|_]}} = + (catch maps:put(1, a, T)) + end), + ok. + +is_members(Ks,Ls) when length(Ks) =/= length(Ls) -> false; +is_members(Ks,Ls) -> is_members_do(Ks,Ls). + +is_members_do([],[]) -> true; +is_members_do([],_) -> false; +is_members_do([K|Ks],Ls) -> + is_members_do(Ks, lists:delete(K,Ls)). + +t_bif_map_remove(Config) when is_list(Config) -> + 0 = erlang:map_size(maps:remove(some_key, #{})), + + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + M1 = maps:remove("hi", M0), + true = is_members([4,18446744073709551629,int,<<"key">>],maps:keys(M1)), + true = is_members([number,wat,3,<<"value">>],maps:values(M1)), + + M2 = maps:remove(int, M1), + true = is_members([4,18446744073709551629,<<"key">>],maps:keys(M2)), + true = is_members([number,wat,<<"value">>],maps:values(M2)), + + M3 = maps:remove(<<"key">>, M2), + true = is_members([4,18446744073709551629],maps:keys(M3)), + true = is_members([number,wat],maps:values(M3)), + + M4 = maps:remove(18446744073709551629, M3), + true = is_members([4],maps:keys(M4)), + true = is_members([number],maps:values(M4)), + + M5 = maps:remove(4, M4), + [] = maps:keys(M5), + [] = maps:values(M5), + + M0 = maps:remove(5,M0), + M0 = maps:remove("hi there",M0), + + #{ "hi" := "hello", int := 3, 4 := number} = maps:remove(18446744073709551629,maps:remove(<<"key">>,M0)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,remove,_,_}|_]}} = + (catch maps:remove(a, T)) + end), + ok. + +t_bif_map_update(Config) when is_list(Config) -> + M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + + #{ "hi" := "hello again", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:update("hi", "hello again", M0), + + #{ "hi" := "hello", int := 1337, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wat} = maps:update(int, 1337, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"new value">>, + 4 := number, 18446744073709551629 := wat} = maps:update(<<"key">>, <<"new value">>, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := integer, 18446744073709551629 := wat} = maps:update(4, integer, M0), + + #{ "hi" := "hello", int := 3, <<"key">> := <<"value">>, + 4 := number, 18446744073709551629 := wazzup} = maps:update(18446744073709551629, wazzup, M0), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,update,_,_}|_]}} = + (catch maps:update(1, none, T)) + end), + ok. + + + +t_bif_map_values(Config) when is_list(Config) -> + + [] = maps:values(#{}), + [1] = maps:values(#{a=>1}), + + true = is_members([a,b,c,d,e],maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e})), + true = is_members([a,b,c,d,e],maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c})), + + M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, + M2 = M1#{ "hi" => "hello2", <<"key">> => <<"value2">> }, + true = is_members([number,3,"hello2",<<"value2">>],maps:values(M2)), + true = is_members([number,3,"hello",<<"value">>],maps:values(M1)), + + Vs = lists:seq(1000,20000), + M3 = maps:from_list([{K,K}||K<-Vs]), + M4 = maps:merge(M1,M3), + M5 = maps:merge(M2,M3), + true = is_members(Vs,maps:values(M3)), + true = is_members([number,3,"hello",<<"value">>]++Vs,maps:values(M4)), + true = is_members([number,3,"hello2",<<"value2">>]++Vs,maps:values(M5)), + + %% error case + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},[{maps,values,_,_}|_]}} = + (catch maps:values(T)) + end), + ok. + +t_erlang_hash(Config) when is_list(Config) -> + + ok = t_bif_erlang_phash2(), + ok = t_bif_erlang_phash(), + ok = t_bif_erlang_hash(), + + ok. + +t_bif_erlang_phash2() -> + + 39679005 = erlang:phash2(#{}), + 33667975 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), % 78942764 + 95332690 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), % 37338230 + 108954384 = erlang:phash2(#{ 1 => a }), % 14363616 + 59617982 = erlang:phash2(#{ a => 1 }), % 51612236 + + 42770201 = erlang:phash2(#{{} => <<>>}), % 37468437 + 71687700 = erlang:phash2(#{<<>> => {}}), % 44049159 + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 70249457 = erlang:phash2(M0), % 118679416 + 59617982 = erlang:phash2(M1), % 51612236 + 70249457 = erlang:phash2(M2), % 118679416 + ok. + +t_bif_erlang_phash() -> + Sz = 1 bsl 32, + 1113425985 = erlang:phash(#{},Sz), % 268440612 + 1510068139 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 1196461908 + 3182345590 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 3944426064 + 2927531828 = erlang:phash(#{ 1 => a },Sz), % 1394238263 + 1670235874 = erlang:phash(#{ a => 1 },Sz), % 4066388227 + + 3935089469 = erlang:phash(#{{} => <<>>},Sz), % 1578050717 + 71692856 = erlang:phash(#{<<>> => {}},Sz), % 1578050717 + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 2620391445 = erlang:phash(M0,Sz), % 3590546636 + 1670235874 = erlang:phash(M1,Sz), % 4066388227 + 2620391445 = erlang:phash(M2,Sz), % 3590546636 + ok. + +t_bif_erlang_hash() -> + Sz = 1 bsl 27 - 1, + 39684169 = erlang:hash(#{},Sz), % 5158 + 33673142 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), % 71555838 + 95337869 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), % 5497225 + 108959561 = erlang:hash(#{ 1 => a },Sz), % 126071654 + 59623150 = erlang:hash(#{ a => 1 },Sz), % 126426236 + + 42775386 = erlang:hash(#{{} => <<>>},Sz), % 101655720 + 71692856 = erlang:hash(#{<<>> => {}},Sz), % 101655720 + + M0 = #{ a => 1, "key" => <<"value">> }, + M1 = maps:remove("key",M0), + M2 = M1#{ "key" => <<"value">> }, + + 70254632 = erlang:hash(M0,Sz), % 38260486 + 59623150 = erlang:hash(M1,Sz), % 126426236 + 70254632 = erlang:hash(M2,Sz), % 38260486 + ok. + + +t_map_encode_decode(Config) when is_list(Config) -> + <<131,116,0,0,0,0>> = erlang:term_to_binary(#{}), + Pairs = [ + {a,b},{"key","values"},{<<"key">>,<<"value">>}, + {1,b},{[atom,1],{<<"wat">>,1,2,3}}, + {aa,"values"}, + {1 bsl 64 + (1 bsl 50 - 1), sc1}, + {99, sc2}, + {1 bsl 65 + (1 bsl 51 - 1), sc3}, + {88, sc4}, + {1 bsl 66 + (1 bsl 52 - 1), sc5}, + {77, sc6}, + {1 bsl 67 + (1 bsl 53 - 1), sc3}, + {75, sc6}, {-10,sc8}, + {<<>>, sc9}, {3.14158, sc10}, + {[3.14158], sc11}, {more_atoms, sc12}, + {{more_tuples}, sc13}, {self(), sc14}, + {{},{}},{[],[]} + ], + ok = map_encode_decode_and_match(Pairs,[],#{}), + + %% check sorting + + %% literally #{ b=>2, a=>1 } in the internal order + #{ a:=1, b:=2 } = + erlang:binary_to_term(<<131,116,0,0,0,2,100,0,1,98,97,2,100,0,1,97,97,1>>), + + + %% literally #{ "hi" => "value", a=>33, b=>55 } in the internal order + #{ a:=33, b:=55, "hi" := "value"} = erlang:binary_to_term(<<131,116,0,0,0,3, + 107,0,2,104,105, % "hi" :: list() + 107,0,5,118,97,108,117,101, % "value" :: list() + 100,0,1,97, % a :: atom() + 97,33, % 33 :: integer() + 100,0,1,98, % b :: atom() + 97,55 % 55 :: integer() + >>), + + %% Maps of different sizes + lists:foldl(fun(Key, M0) -> + M1 = M0#{Key => Key}, + case Key rem 17 of + 0 -> + M1 = binary_to_term(term_to_binary(M1)); + _ -> + ok + end, + M1 + end, + #{}, + lists:seq(1,10000)), + + %% many maps in same binary + MapList = lists:foldl(fun(K, [M|_]=Acc) -> [M#{K => K} | Acc] end, + [#{}], + lists:seq(1,100)), + MapList = binary_to_term(term_to_binary(MapList)), + MapListR = lists:reverse(MapList), + MapListR = binary_to_term(term_to_binary(MapListR)), + + %% error cases + %% template: <<131,116,0,0,0,2,100,0,1,97,100,0,1,98,97,1,97,1>> + %% which is: #{ a=>1, b=>1 } + + %% uniqueness violation + %% literally #{ a=>1, "hi"=>"value", a=>2 } + {'EXIT',{badarg,[{_,_,_,_}|_]}} = (catch + erlang:binary_to_term(<<131,116,0,0,0,3, + 100,0,1,97, + 97,1, + 107,0,2,104,105, + 107,0,5,118,97,108,117,101, + 100,0,1,97, + 97,2>>)), + + %% bad size (too large) + {'EXIT',{badarg,[{_,_,_,_}|_]}} = (catch + erlang:binary_to_term(<<131,116,0,0,0,12,100,0,1,97,97,1,100,0,1,98,97,1>>)), + + %% bad size (too small) .. should fail just truncate it .. weird. + %% possibly change external format so truncated will be #{a:=1} + #{ a:=b } = + erlang:binary_to_term(<<131,116,0,0,0,1,100,0,1,97,100,0,1,98,97,1,97,1>>), + + ok. + +map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) -> + M1 = maps:put(K,V,M0), + B0 = erlang:term_to_binary(M1), + Ls = [{erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs], + ok = match_encoded_map(B0, length(Ls), Ls), + %% decode and match it + M1 = erlang:binary_to_term(B0), + map_encode_decode_and_match(Pairs,Ls,M1); +map_encode_decode_and_match([],_,_) -> ok. + +match_encoded_map(<<131,116,Size:32,Encoded/binary>>,Size,Items) -> + match_encoded_map_stripped_size(Encoded,Items,Items); +match_encoded_map(_,_,_) -> no_match_size. + +match_encoded_map_stripped_size(<<>>,_,_) -> ok; +match_encoded_map_stripped_size(B0,[{<<131,K/binary>>,<<131,V/binary>>}|Items],Ls) -> + Ksz = byte_size(K), + Vsz = byte_size(V), + case B0 of + <<K:Ksz/binary,V:Vsz/binary,B1/binary>> -> + match_encoded_map_stripped_size(B1,Ls,Ls); + _ -> + match_encoded_map_stripped_size(B0,Items,Ls) + end; +match_encoded_map_stripped_size(_,[],_) -> fail. + + +t_bif_map_to_list(Config) when is_list(Config) -> + [] = maps:to_list(#{}), + [{a,1},{b,2}] = lists:sort(maps:to_list(#{a=>1,b=>2})), + [{a,1},{b,2},{c,3}] = lists:sort(maps:to_list(#{c=>3,a=>1,b=>2})), + [{a,1},{b,2},{g,3}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2})), + [{a,1},{b,2},{g,3},{"c",4}] = lists:sort(maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4})), + [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = + lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5})), + + [{3,v7},{hi,v9},{{hi,3},v10},{"hi",v8},{<<"hi">>,v6}] = + lists:sort(maps:to_list(#{<<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5, + <<"hi">>=>v6,3=>v7,"hi"=>v8,hi=>v9,{hi,3}=>v10})), + + %% error cases + do_badmap(fun(T) -> + {'EXIT', {{badmap,T},_}} = + (catch maps:to_list(T)) + end), + ok. + + +t_bif_map_from_list(Config) when is_list(Config) -> + #{} = maps:from_list([]), + A = maps:from_list([]), + 0 = erlang:map_size(A), + + #{a:=1,b:=2} = maps:from_list([{a,1},{b,2}]), + #{c:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{c,3}]), + #{g:=3,a:=1,b:=2} = maps:from_list([{a,1},{b,2},{g,3}]), + + #{a:=2} = maps:from_list([{a,1},{a,3},{a,2}]), + + #{ <<"hi">>:=v1,3:=v3,"hi":=v6,hi:=v4,{hi,3}:=v5} = + maps:from_list([{3,v3},{"hi",v6},{hi,v4},{{hi,3},v5},{<<"hi">>,v1}]), + + #{<<"hi">>:=v6,3:=v8,"hi":=v11,hi:=v9,{hi,3}:=v10} = + maps:from_list([ {{hi,3},v3}, {"hi",v0},{3,v1}, {<<"hi">>,v4}, {hi,v2}, + {<<"hi">>,v6}, {{hi,3},v10},{"hi",v11}, {hi,v9}, {3,v8}]), + + %% repeated keys (large -> small) + Ps1 = [{a,I}|| I <- lists:seq(1,32)], + Ps2 = [{a,I}|| I <- lists:seq(33,64)], + + M = maps:from_list(Ps1 ++ [{b,1},{c,1}] ++ Ps2), + #{ a := 64, b := 1, c := 1 } = M, + + %% error cases + {'EXIT', {badarg,_}} = (catch maps:from_list([{a,b},b])), + {'EXIT', {badarg,_}} = (catch maps:from_list([{a,b},{b,b,3}])), + {'EXIT', {badarg,_}} = (catch maps:from_list([{a,b},<<>>])), + {'EXIT', {badarg,_}} = (catch maps:from_list([{a,b}|{b,a}])), + {'EXIT', {badarg,_}} = (catch maps:from_list(a)), + {'EXIT', {badarg,_}} = (catch maps:from_list(42)), + ok. + +t_bif_build_and_check(Config) when is_list(Config) -> + ok = check_build_and_remove(750,[ + fun(K) -> [K,K] end, + fun(K) -> [float(K),K] end, + fun(K) -> K end, + fun(K) -> {1,K} end, + fun(K) -> {K} end, + fun(K) -> [K|K] end, + fun(K) -> [K,1,2,3,4] end, + fun(K) -> {K,atom} end, + fun(K) -> float(K) end, + fun(K) -> integer_to_list(K) end, + fun(K) -> list_to_atom(integer_to_list(K)) end, + fun(K) -> [K,{K,[K,{K,[K]}]}] end, + fun(K) -> <<K:32>> end + ]), + + ok. + +check_build_and_remove(_,[]) -> ok; +check_build_and_remove(N,[F|Fs]) -> + {M,Ks} = build_and_check(N, maps:new(), F, []), + ok = remove_and_check(Ks,M), + check_build_and_remove(N,Fs). + +build_and_check(0, M0, _, Ks) -> {M0, Ks}; +build_and_check(N, M0, F, Ks) -> + K = build_key(F,N), + M1 = maps:put(K,K,M0), + ok = check_keys_exist([I||{I,_} <- [{K,M1}|Ks]], M1), + M2 = maps:update(K,v,M1), + v = maps:get(K,M2), + build_and_check(N-1,M1,F,[{K,M1}|Ks]). + +remove_and_check([],_) -> ok; +remove_and_check([{K,Mc}|Ks], M0) -> + K = maps:get(K,M0), + true = maps:is_key(K,M0), + true = Mc =:= M0, + true = M0 == Mc, + M1 = maps:remove(K,M0), + false = M1 =:= Mc, + false = Mc == M1, + false = maps:is_key(K,M1), + true = maps:is_key(K,M0), + ok = check_keys_exist([I||{I,_} <- Ks],M1), + error = maps:find(K,M1), + remove_and_check(Ks, M1). + +build_key(F,N) when N rem 3 =:= 0 -> F(N); +build_key(F,N) when N rem 3 =:= 1 -> K = F(N), {K,K}; +build_key(F,N) when N rem 3 =:= 2 -> K = F(N), [K,K]. + +check_keys_exist([], _) -> ok; +check_keys_exist([K|Ks],M) -> + true = maps:is_key(K,M), + check_keys_exist(Ks,M). + +t_bif_merge_and_check(Config) when is_list(Config) -> + + io:format("rand:export_seed() -> ~p\n",[rand:export_seed()]), + + %% simple disjunct ones + %% make sure all keys are unique + Kss = [[a,b,c,d], + [1,2,3,4], + [], + ["hi"], + [e], + [build_key(fun(K) -> {small,K} end, I) || I <- lists:seq(1,32)], + lists:seq(5, 28), + lists:seq(29, 59), + [build_key(fun(K) -> integer_to_list(K) end, I) || I <- lists:seq(2000,10000)], + [build_key(fun(K) -> <<K:32>> end, I) || I <- lists:seq(1,80)], + [build_key(fun(K) -> {<<K:32>>} end, I) || I <- lists:seq(100,1000)]], + + + KsMs = build_keys_map_pairs(Kss), + Cs = [{CKs1,CM1,CKs2,CM2} || {CKs1,CM1} <- KsMs, {CKs2,CM2} <- KsMs], + ok = merge_and_check_combo(Cs), + + %% overlapping ones + + KVs1 = [{a,1},{b,2},{c,3}], + KVs2 = [{b,3},{c,4},{d,5}], + KVs = [{I,I} || I <- lists:seq(1,32)], + KVs3 = KVs1 ++ KVs, + KVs4 = KVs2 ++ KVs, + + M1 = maps:from_list(KVs1), + M2 = maps:from_list(KVs2), + M3 = maps:from_list(KVs3), + M4 = maps:from_list(KVs4), + + M12 = maps:merge(M1,M2), + ok = check_key_values(KVs2 ++ [{a,1}], M12), + M21 = maps:merge(M2,M1), + ok = check_key_values(KVs1 ++ [{d,5}], M21), + + M34 = maps:merge(M3,M4), + ok = check_key_values(KVs4 ++ [{a,1}], M34), + M43 = maps:merge(M4,M3), + ok = check_key_values(KVs3 ++ [{d,5}], M43), + + M14 = maps:merge(M1,M4), + ok = check_key_values(KVs4 ++ [{a,1}], M14), + M41 = maps:merge(M4,M1), + ok = check_key_values(KVs1 ++ [{d,5}] ++ KVs, M41), + + [begin Ma = random_map(SzA, a), + Mb = random_map(SzB, b), + ok = merge_maps(Ma, Mb) + end || SzA <- [3,10,20,100,200,1000], SzB <- [3,10,20,100,200,1000]], + + ok. + +% Generate random map with an average of Sz number of pairs: K -> {V,K} +random_map(Sz, V) -> + random_map_insert(#{}, 0, V, Sz*2). + +random_map_insert(M0, K0, _, Sz) when K0 > Sz -> + M0; +random_map_insert(M0, K0, V, Sz) -> + Key = K0 + rand:uniform(3), + random_map_insert(M0#{Key => {V,Key}}, Key, V, Sz). + + +merge_maps(A, B) -> + AB = maps:merge(A, B), + %%io:format("A=~p\nB=~p\n",[A,B]), + maps_foreach(fun(K,VB) -> VB = maps:get(K, AB) + end, B), + maps_foreach(fun(K,VA) -> + case {maps:get(K, AB),maps:find(K, B)} of + {VA, error} -> ok; + {VB, {ok, VB}} -> ok + end + end, A), + + maps_foreach(fun(K,V) -> + case {maps:find(K, A),maps:find(K, B)} of + {{ok, V}, error} -> ok; + {error, {ok, V}} -> ok; + {{ok,_}, {ok, V}} -> ok + end + end, AB), + ok. + +maps_foreach(Fun, Map) -> + maps:fold(fun(K,V,_) -> Fun(K,V) end, void, Map). + + +check_key_values([],_) -> ok; +check_key_values([{K,V}|KVs],M) -> + V = maps:get(K,M), + check_key_values(KVs,M). + +merge_and_check_combo([]) -> ok; +merge_and_check_combo([{Ks1,M1,Ks2,M2}|Cs]) -> + M12 = maps:merge(M1,M2), + ok = check_keys_exist(Ks1 ++ Ks2, M12), + M21 = maps:merge(M2,M1), + ok = check_keys_exist(Ks1 ++ Ks2, M21), + + true = M12 =:= M21, + M12 = M21, + + merge_and_check_combo(Cs). + +build_keys_map_pairs([]) -> []; +build_keys_map_pairs([Ks|Kss]) -> + M = maps:from_list(keys_to_pairs(Ks)), + ok = check_keys_exist(Ks, M), + [{Ks,M}|build_keys_map_pairs(Kss)]. + +keys_to_pairs(Ks) -> [{K,K} || K <- Ks]. + + +%% Maps module, not BIFs +t_maps_fold(_Config) -> + Vs = lists:seq(1,100), + M = maps:from_list([{{k,I},{v,I}}||I<-Vs]), + + %% fold + 5050 = maps:fold(fun({k,_},{v,V},A) -> V + A end, 0, M), + + ok. + +t_maps_map(_Config) -> + Vs = lists:seq(1,100), + M1 = maps:from_list([{I,I}||I<-Vs]), + M2 = maps:from_list([{I,{token,I}}||I<-Vs]), + + M2 = maps:map(fun(_K,V) -> {token,V} end, M1), + ok. + +t_maps_size(_Config) -> + Vs = lists:seq(1,100), + lists:foldl(fun(I,M) -> + M1 = maps:put(I,I,M), + I = maps:size(M1), + M1 + end, #{}, Vs), + ok. + + +t_maps_without(_Config) -> + Ki = [11,22,33,44,55,66,77,88,99], + M0 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100)]), + M1 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100) -- Ki]), + M1 = maps:without([{k,I}||I <- Ki],M0), + ok. + +t_erts_internal_order(_Config) when is_list(_Config) -> + M = #{0 => 0,2147483648 => 0}, + true = M =:= binary_to_term(term_to_binary(M)), + + F1 = fun(_, _) -> 0 end, + F2 = fun(_, _) -> 1 end, + M0 = maps:from_list( [{-2147483649, 0}, {0,0}, {97, 0}, {false, 0}, {flower, 0}, {F1, 0}, {F2, 0}, {<<>>, 0}]), + M1 = maps:merge(M0, #{0 => 1}), + 8 = maps:size(M1), + 1 = maps:get(0,M1), + ok. + +t_erts_internal_hash(_Config) when is_list(_Config) -> + K1 = 0.0, + K2 = 0.0/-1, + M = maps:from_list([{I,I}||I<-lists:seq(1,32)]), + + M1 = M#{ K1 => a, K2 => b }, + b = maps:get(K2,M1), + + M2 = M#{ K2 => a, K1 => b }, + b = maps:get(K1,M2), + + %% test previously faulty hash list optimization + + M3 = M#{[0] => a, [0,0] => b, [0,0,0] => c, [0,0,0,0] => d}, + a = maps:get([0],M3), + b = maps:get([0,0],M3), + c = maps:get([0,0,0],M3), + d = maps:get([0,0,0,0],M3), + + M4 = M#{{[0]} => a, {[0,0]} => b, {[0,0,0]} => c, {[0,0,0,0]} => d}, + a = maps:get({[0]},M4), + b = maps:get({[0,0]},M4), + c = maps:get({[0,0,0]},M4), + d = maps:get({[0,0,0,0]},M4), + + M5 = M3#{[0,0,0] => e, [0,0,0,0] => f, [0,0,0,0,0] => g, + [0,0,0,0,0,0] => h, [0,0,0,0,0,0,0] => i, + [0,0,0,0,0,0,0,0] => j, [0,0,0,0,0,0,0,0,0] => k}, + + a = maps:get([0],M5), + b = maps:get([0,0],M5), + e = maps:get([0,0,0],M5), + f = maps:get([0,0,0,0],M5), + g = maps:get([0,0,0,0,0],M5), + h = maps:get([0,0,0,0,0,0],M5), + i = maps:get([0,0,0,0,0,0,0],M5), + j = maps:get([0,0,0,0,0,0,0,0],M5), + k = maps:get([0,0,0,0,0,0,0,0,0],M5), + + M6 = M4#{{[0,0,0]} => e, {[0,0,0,0]} => f, {[0,0,0,0,0]} => g, + {[0,0,0,0,0,0]} => h, {[0,0,0,0,0,0,0]} => i, + {[0,0,0,0,0,0,0,0]} => j, {[0,0,0,0,0,0,0,0,0]} => k}, + + a = maps:get({[0]},M6), + b = maps:get({[0,0]},M6), + e = maps:get({[0,0,0]},M6), + f = maps:get({[0,0,0,0]},M6), + g = maps:get({[0,0,0,0,0]},M6), + h = maps:get({[0,0,0,0,0,0]},M6), + i = maps:get({[0,0,0,0,0,0,0]},M6), + j = maps:get({[0,0,0,0,0,0,0,0]},M6), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M6), + + M7 = maps:merge(M5,M6), + + a = maps:get([0],M7), + b = maps:get([0,0],M7), + e = maps:get([0,0,0],M7), + f = maps:get([0,0,0,0],M7), + g = maps:get([0,0,0,0,0],M7), + h = maps:get([0,0,0,0,0,0],M7), + i = maps:get([0,0,0,0,0,0,0],M7), + j = maps:get([0,0,0,0,0,0,0,0],M7), + k = maps:get([0,0,0,0,0,0,0,0,0],M7), + a = maps:get({[0]},M7), + b = maps:get({[0,0]},M7), + e = maps:get({[0,0,0]},M7), + f = maps:get({[0,0,0,0]},M7), + g = maps:get({[0,0,0,0,0]},M7), + h = maps:get({[0,0,0,0,0,0]},M7), + i = maps:get({[0,0,0,0,0,0,0]},M7), + j = maps:get({[0,0,0,0,0,0,0,0]},M7), + k = maps:get({[0,0,0,0,0,0,0,0,0]},M7), + ok. + +t_pdict(_Config) -> + + put(#{ a => b, b => a},#{ c => d}), + put(get(#{ a => b, b => a}),1), + 1 = get(#{ c => d}), + #{ c := d } = get(#{ a => b, b => a}). + +t_ets(_Config) -> + + Tid = ets:new(map_table,[]), + + [ets:insert(Tid,{maps:from_list([{I,-I}]),I}) || I <- lists:seq(1,100)], + + + [{#{ 2 := -2},2}] = ets:lookup(Tid,#{ 2 => -2 }), + + %% Test equal + [3,4] = lists:sort( + ets:select(Tid,[{{'$1','$2'}, + [{'or',{'==','$1',#{ 3 => -3 }}, + {'==','$1',#{ 4 => -4 }}}], + ['$2']}])), + %% Test match + [30,50] = lists:sort( + ets:select(Tid, + [{{#{ 30 => -30}, '$1'},[],['$1']}, + {{#{ 50 => -50}, '$1'},[],['$1']}] + )), + + ets:insert(Tid,{#{ a => b, b => c, c => a},transitivity}), + + %% Test equal with map of different size + [] = ets:select(Tid,[{{'$1','_'},[{'==','$1',#{ b => c }}],['$_']}]), + + %% Test match with map of different size + %[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => c },'_'},[],['$_']}]), + + %%% Test match with don't care value + %[{#{ a := b },_}] = ets:select(Tid,[{{#{ b => '_' },'_'},[],['$_']}]), + + %% Test is_map bif + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + ets:insert(Tid,{not_a_map,2}), + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + ets:insert(Tid,{{nope,a,tuple},2}), + 101 = length(ets:select(Tid,[{'$1',[{is_map,{element,1,'$1'}}],['$1']}])), + + %% Test map_size bif + [3] = ets:select(Tid,[{{'$1','_'},[{'==',{map_size,'$1'},3}], + [{map_size,'$1'}]}]), + + true = ets:delete(Tid,#{50 => -50}), + [] = ets:lookup(Tid,#{50 => -50}), + + ets:delete(Tid), + ok. + +t_dets(_Config) -> + ok. + +t_tracing(_Config) -> + + dbg:stop_clear(), + {ok,Tracer} = dbg:tracer(process,{fun trace_collector/2, self()}), + dbg:p(self(),c), + + %% Test basic map call + {ok,_} = dbg:tpl(?MODULE,id,x), + #{ a => b }, + {trace,_,call,{?MODULE,id,[#{ a := b }]}} = getmsg(Tracer), + {trace,_,return_from,{?MODULE,id,1},#{ a := b }} = getmsg(Tracer), + dbg:ctpl(), + + %% Test equals in argument list + {ok,_} = dbg:tpl(?MODULE,id,[{['$1'],[{'==','$1',#{ b => c}}], + [{return_trace}]}]), + #{ a => b }, + #{ b => c }, + {trace,_,call,{?MODULE,id,[#{ b := c }]}} = getmsg(Tracer), + {trace,_,return_from,{?MODULE,id,1},#{ b := c }} = getmsg(Tracer), + dbg:ctpl(), + + %% Test match in head + {ok,_} = dbg:tpl(?MODULE,id,[{[#{b => c}],[],[]}]), + #{ a => b }, + #{ b => c }, + {trace,_,call,{?MODULE,id,[#{ b := c }]}} = getmsg(Tracer), + dbg:ctpl(), + + % Test map guard bifs + {ok,_} = dbg:tpl(?MODULE,id,[{['$1'],[{is_map,{element,1,'$1'}}],[]}]), + #{ a => b }, + {1,2}, + {#{ a => b},2}, + {trace,_,call,{?MODULE,id,[{#{ a := b },2}]}} = getmsg(Tracer), + dbg:ctpl(), + + {ok,_} = dbg:tpl(?MODULE,id,[{['$1'],[{'==',{map_size,{element,1,'$1'}},2}],[]}]), + #{ a => b }, + {1,2}, + {#{ a => b},2}, + {#{ a => b, b => c},atom}, + {trace,_,call,{?MODULE,id,[{#{ a := b, b := c },atom}]}} = getmsg(Tracer), + dbg:ctpl(), + + %MS = dbg:fun2ms(fun([A]) when A == #{ a => b} -> ok end), + %dbg:tpl(?MODULE,id,MS), + %#{ a => b }, + %#{ b => c }, + %{trace,_,call,{?MODULE,id,[#{ a := b }]}} = getmsg(Tracer), + %dbg:ctpl(), + + %% Check to extra messages + timeout = getmsg(Tracer), + + dbg:stop_clear(), + ok. + +getmsg(_Tracer) -> + receive V -> V after 100 -> timeout end. + +trace_collector(Msg,Parent) -> + io:format("~p~n",[Msg]), + Parent ! Msg, + Parent. + +t_has_map_fields(Config) when is_list(Config) -> + true = has_map_fields_1(#{one=>1}), + true = has_map_fields_1(#{one=>1,two=>2}), + false = has_map_fields_1(#{two=>2}), + false = has_map_fields_1(#{}), + + true = has_map_fields_2(#{c=>1,b=>2,a=>3}), + true = has_map_fields_2(#{c=>1,b=>2,a=>3,x=>42}), + false = has_map_fields_2(#{b=>2,c=>1}), + false = has_map_fields_2(#{x=>y}), + false = has_map_fields_2(#{}), + + true = has_map_fields_3(#{c=>1,b=>2,a=>3}), + true = has_map_fields_3(#{c=>1,b=>2,a=>3,[]=>42}), + true = has_map_fields_3(#{b=>2,a=>3,[]=>42,42.0=>43}), + true = has_map_fields_3(#{a=>3,[]=>42,42.0=>43}), + true = has_map_fields_3(#{[]=>42,42.0=>43}), + false = has_map_fields_3(#{b=>2,c=>1}), + false = has_map_fields_3(#{[]=>y}), + false = has_map_fields_3(#{42.0=>x,a=>99}), + false = has_map_fields_3(#{}), + + ok. + +has_map_fields_1(#{one:=_}) -> true; +has_map_fields_1(#{}) -> false. + +has_map_fields_2(#{a:=_,b:=_,c:=_}) -> true; +has_map_fields_2(#{}) -> false. + +has_map_fields_3(#{a:=_,b:=_}) -> true; +has_map_fields_3(#{[]:=_,42.0:=_}) -> true; +has_map_fields_3(#{}) -> false. + +y_regs(Config) when is_list(Config) -> + Val = [length(Config)], + Map0 = y_regs_update(#{}, Val), + Map2 = y_regs_update(Map0, Val), + + Map3 = maps:from_list([{I,I*I} || I <- lists:seq(1, 100)]), + Map4 = y_regs_update(Map3, Val), + + true = is_map(Map2) andalso is_map(Map4), + + ok. + +y_regs_update(Map0, Val0) -> + Val1 = {t,Val0}, + K1 = {key,1}, + K2 = {key,2}, + Map1 = Map0#{K1=>K1, + a=>Val0,b=>Val0,c=>Val0,d=>Val0,e=>Val0, + f=>Val0,g=>Val0,h=>Val0,i=>Val0,j=>Val0, + k=>Val0,l=>Val0,m=>Val0,n=>Val0,o=>Val0, + p=>Val0,q=>Val0,r=>Val0,s=>Val0,t=>Val0, + u=>Val0,v=>Val0,w=>Val0,x=>Val0,y=>Val0, + z=>Val0, + aa=>Val0,ab=>Val0,ac=>Val0,ad=>Val0,ae=>Val0, + af=>Val0,ag=>Val0,ah=>Val0,ai=>Val0,aj=>Val0, + ak=>Val0,al=>Val0,am=>Val0,an=>Val0,ao=>Val0, + ap=>Val0,aq=>Val0,ar=>Val0,as=>Val0,at=>Val0, + au=>Val0,av=>Val0,aw=>Val0,ax=>Val0,ay=>Val0, + az=>Val0, + K2=>[a,b,c]}, + Map2 = Map1#{K1=>K1, + a:=Val1,b:=Val1,c:=Val1,d:=Val1,e:=Val1, + f:=Val1,g:=Val1,h:=Val1,i:=Val1,j:=Val1, + k:=Val1,l:=Val1,m:=Val1,n:=Val1,o:=Val1, + p:=Val1,q:=Val1,r:=Val1,s:=Val1,t:=Val1, + u:=Val1,v:=Val1,w:=Val1,x:=Val1,y:=Val1, + z:=Val1, + aa:=Val1,ab:=Val1,ac:=Val1,ad:=Val1,ae:=Val1, + af:=Val1,ag:=Val1,ah:=Val1,ai:=Val1,aj:=Val1, + ak:=Val1,al:=Val1,am:=Val1,an:=Val1,ao:=Val1, + ap:=Val1,aq:=Val1,ar:=Val1,as:=Val1,at:=Val1, + au:=Val1,av:=Val1,aw:=Val1,ax:=Val1,ay:=Val1, + az:=Val1, + K2=>[a,b,c]}, + + %% Traverse the maps to validate them. + _ = erlang:phash2({Map1,Map2}, 100000), + + _ = {K1,K2,Val0,Val1}, %Force use of Y registers. + Map2. + +do_badmap(Test) -> + Terms = [Test,fun erlang:abs/1,make_ref(),self(),0.0/-1, + <<0:1024>>,<<1:1>>,<<>>,<<1,2,3>>, + [],{a,b,c},[a,b],atom,10.0,42,(1 bsl 65) + 3], + [Test(T) || T <- Terms]. diff --git a/lib/dialyzer/test/map_SUITE_data/src/map_in_guard.erl b/lib/dialyzer/test/map_SUITE_data/src/map_in_guard.erl new file mode 100644 index 0000000000..6176ef1fdf --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/map_in_guard.erl @@ -0,0 +1,35 @@ +-module(map_in_guard). + +-export([test/0, raw_expr/0]). + +test() -> + false = assoc_guard(#{}), + true = assoc_guard(not_a_map), + #{a := true} = assoc_update(#{}), + {'EXIT', {{badmap, not_a_map}, [{?MODULE, assoc_update, 1, _}|_]}} + = (catch assoc_update(not_a_map)), + ok = assoc_guard_clause(#{}), + {'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}} + = (catch assoc_guard_clause(not_a_map)), + true = exact_guard(#{a=>1}), + {'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}} + %% There's nothing we can do to find the error here, is there? + = (catch (begin true = exact_guard(#{}) end)), + ok = exact_guard_clause(#{a => q}), + {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}} + = (catch exact_guard_clause(#{})), + ok. + +assoc_guard(M) when is_map(M#{a => b}) -> true; +assoc_guard(Q) -> false. + +assoc_update(M) -> M#{a => true}. + +assoc_guard_clause(M) when is_map(M#{a => 3}) -> ok. + +exact_guard(M) when (false =/= M#{a := b}) -> true; +exact_guard(_) -> false. + +exact_guard_clause(M) when (false =/= M#{a := b}) -> ok. + +raw_expr() when #{}; true -> ok. %% Must not warn here! diff --git a/lib/dialyzer/test/map_SUITE_data/src/map_in_guard2.erl b/lib/dialyzer/test/map_SUITE_data/src/map_in_guard2.erl new file mode 100644 index 0000000000..ac2205e8fa --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/map_in_guard2.erl @@ -0,0 +1,27 @@ +-module(map_in_guard2). + +-export([test/0]). + +test() -> + false = assoc_guard(not_a_map), + {'EXIT', {{badmap, not_a_map}, [{?MODULE, assoc_update, 1, _}|_]}} + = (catch assoc_update(not_a_map)), + {'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}} + = (catch assoc_guard_clause(not_a_map)), + {'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}} + = (catch (begin true = exact_guard(#{}) end)), + {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}} + = (catch exact_guard_clause(#{})), + ok. + +assoc_guard(M) when is_map(M#{a => b}) -> true; +assoc_guard(_) -> false. + +assoc_update(M) -> M#{a => true}. + +assoc_guard_clause(M) when is_map(M#{a => 3}) -> ok. + +exact_guard(M) when (false =/= M#{a := b}) -> true; +exact_guard(_) -> false. + +exact_guard_clause(M) when (false =/= M#{a := b}) -> ok. diff --git a/lib/dialyzer/test/map_SUITE_data/src/map_size.erl b/lib/dialyzer/test/map_SUITE_data/src/map_size.erl new file mode 100644 index 0000000000..2da4f6904e --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/map_size.erl @@ -0,0 +1,36 @@ +-module(map_size). + +-export([t1/0, e1/0, t2/0, t3/0, t4/0, t5/1, t6/1, t7/1]). + +t1() -> + 0 = maps:size(#{}), + 1 = maps:size(#{}). + +e1() -> + 0 = map_size(#{}), + 1 = map_size(#{}). + +t2() -> p(#{a=>x}). + +p(M) when map_size(M) =:= 0 -> ok. + +t3() -> + 1 = map_size(cio()), + 2 = map_size(cio()), + 3 = map_size(cio()), + 4 = map_size(cio()). + +t4() -> + 0 = map_size(cio()). + +t5(M) when map_size(M) =:= 0 -> + #{a := _} = M. %% Only t5 has no local return; want better message + +t6(M) when map_size(M) =:= 0 -> + #{} = M. + +t7(M=#{a := _}) when map_size(M) =:= 1 -> + #{b := _} = M. %% We should warn here too + +-spec cio() -> #{3 := ok, 9 => _, 11 => x}. +cio() -> binary_to_term(<<131,116,0,0,0,2,97,3,100,0,2,111,107,97,9,97,6>>). diff --git a/lib/dialyzer/test/map_SUITE_data/src/maps_merge.erl b/lib/dialyzer/test/map_SUITE_data/src/maps_merge.erl new file mode 100644 index 0000000000..d4f3c6887a --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/maps_merge.erl @@ -0,0 +1,29 @@ +-module(maps_merge). + +-export([t1/0, t2/0, t3/0, t4/0, t5/0]). + +t1() -> + #{a:=1} = maps:merge(#{}, #{}). + +t2() -> + #{hej := _} = maps:merge(cao(), cio()), + #{{} := _} = maps:merge(cao(), cio()). + +t3() -> + #{a:=1} = maps:merge(cao(), cio()), + #{7:=q} = maps:merge(cao(), cio()). + +t4() -> + #{a:=1} = maps:merge(cio(), cao()), + #{7:=q} = maps:merge(cio(), cao()). + +t5() -> + #{a:=2} = maps:merge(cao(), #{}). + +-spec cao() -> #{a := 1, q => none(), 11 => _, atom() => _}. +cao() -> + binary_to_term(<<131,116,0,0,0,3,100,0,1,97,97,1,100,0,1,98,97,9,100,0,1, + 102,104,0>>). + +-spec cio() -> #{3 := ok, 7 => none(), z => _, integer() => _}. +cio() -> binary_to_term(<<131,116,0,0,0,2,97,3,100,0,2,111,107,97,9,97,6>>). diff --git a/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_adt.erl b/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_adt.erl new file mode 100644 index 0000000000..b98c713c6b --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_adt.erl @@ -0,0 +1,69 @@ +-module(opaque_key_adt). + +-compile(export_all). + +-export_type([t/0, t/1, m/0, s/1, sm/1]). + +-opaque t() :: #{atom() => integer()}. +-opaque t(A) :: #{A => integer()}. + +-opaque m() :: #{t() => integer()}. +-type mt() :: #{t() => integer()}. + +-opaque s(K) :: #{K => integer(), integer() => atom()}. +-opaque sm(K) :: #{K := integer(), integer() := atom()}. +-type smt(K) :: #{K := integer(), integer() := atom()}. + +-spec t0() -> t(). +t0() -> #{}. + +-spec t1() -> t(integer()). +t1() -> #{3 => 1}. + +-spec m0() -> m(). +m0() -> #{#{} => 3}. + +-spec mt0() -> mt(). +mt0() -> #{#{} => 3}. + +-spec s0() -> s(atom()). +s0() -> #{}. + +-spec s1() -> s(atom()). +s1() -> #{3 => a}. + +-spec s2() -> s(atom() | 3). +s2() -> #{3 => a}. %% Contract breakage (not found) + +-spec s3() -> s(atom() | 3). +s3() -> #{3 => 5, a => 6, 7 => 8}. + +-spec s4() -> s(integer()). +s4() -> #{1 => a}. %% Contract breakage + +-spec s5() -> s(1). +s5() -> #{2 => 3}. %% Contract breakage + +-spec s6() -> s(1). +s6() -> #{1 => 3}. + +-spec s7() -> s(integer()). +s7() -> #{1 => 3}. + +-spec sm1() -> sm(1). +sm1() -> #{1 => 2, 3 => a}. + +-spec smt1() -> smt(1). +smt1() -> #{3 => a}. %% Contract breakage + +-spec smt2() -> smt(1). +smt2() -> #{1 => a}. %% Contract breakage + +-spec smt3() -> smt(q). +smt3() -> #{q => 1}. %% Slight contract breakage (probably requires better map type) + +-spec smt4() -> smt(q). +smt4() -> #{q => 2, 3 => a}. + +-spec smt5() -> smt(1). +smt5() -> #{1 => 2, 3 => a}. diff --git a/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_use.erl b/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_use.erl new file mode 100644 index 0000000000..917413fdd2 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_use.erl @@ -0,0 +1,97 @@ +-module(opaque_key_use). + +-compile(export_all). + +-export_type([t/0, t/1]). + +-opaque t() :: #{atom() => integer()}. +-opaque t(A) :: #{A => integer()}. + +tt1() -> + A = t0(), + B = t1(), + A =:= B. % never 'true' + +-spec t0() -> t(). +t0() -> #{a => 1}. + +-spec t1() -> t(integer()). +t1() -> #{3 => 1}. + +adt_tt1() -> + A = adt_t0(), + B = adt_t1(), + A =:= B. % opaque attempt + +adt_tt2() -> + A = adt_t0(), + B = adt_t1(), + #{A => 1 % opaque key + ,B => 2 % opaque key + }. + +adt_tt3() -> + A = map_adt:t0(), + #{A => 1}. % opaque key + +adt_mm1() -> + A = adt_t0(), + M = adt_m0(), + #{A := R} = M, % opaque attempt + R. + +%% adt_ms1() -> +%% A = adt_t0(), +%% M = adt_m0(), +%% M#{A}. % opaque arg + +adt_mu1() -> + A = adt_t0(), + M = adt_m0(), + M#{A := 4}. % opaque arg + +adt_mu2() -> + A = adt_t0(), + M = adt_m0(), + M#{A => 4}. % opaque arg + +adt_mu3() -> + M = adt_m0(), + M#{}. % opaque arg + +adt_mtm1() -> + A = adt_t0(), + M = adt_mt0(), + #{A := R} = M, % opaque key + R. + +%% adt_mts1() -> +%% A = adt_t0(), +%% M = adt_mt0(), +%% M#{A}. % opaque key + +adt_mtu1() -> + A = adt_t0(), + M = adt_mt0(), + M#{A := 4}. % opaque key + +adt_mtu2() -> + A = adt_t0(), + M = adt_mt0(), + M#{A => 4}. % opaque key + +adt_mtu3() -> + M = adt_mt0(), + M#{}. % Ok to not warn + +adt_t0() -> + opaque_key_adt:t0(). + +adt_t1() -> + opaque_key_adt:t1(). + +adt_m0() -> + opaque_key_adt:m0(). + +adt_mt0() -> + opaque_key_adt:mt0(). diff --git a/lib/dialyzer/test/map_SUITE_data/src/order.erl b/lib/dialyzer/test/map_SUITE_data/src/order.erl new file mode 100644 index 0000000000..51868d7e94 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/order.erl @@ -0,0 +1,56 @@ +-module(order). + +-export([t1/0, t2/0, t3/0, t4/0, t5/0, t6/0]). + +t1() -> + case maps:get(a, #{a=>1, a=>b}) of + Int when is_integer(Int) -> fail; + Atom when is_atom(Atom) -> error(ok); + _Else -> fail + end. + +t2() -> + case maps:get(a, #{a=>id_1(1), a=>id_b(b)}) of + Int when is_integer(Int) -> fail; + Atom when is_atom(Atom) -> error(ok); + _Else -> fail + end. + +t3() -> + case maps:get(a, #{a=>id_1(1), id_a(a)=>id_b(b)}) of + Int when is_integer(Int) -> fail; + Atom when is_atom(Atom) -> error(ok); + _Else -> fail + end. + +t4() -> + case maps:get(a, #{a=>id_1(1), a_or_b()=>id_b(b)}) of + Int when is_integer(Int) -> ok; + Atom when is_atom(Atom) -> ok; + _Else -> fail + end. + +t5() -> + case maps:get(c, #{c=>id_1(1), a_or_b()=>id_b(b)}) of + Int when is_integer(Int) -> error(ok); + Atom when is_atom(Atom) -> fail; + _Else -> fail + end. + +t6() -> + case maps:get(a, #{a_or_b()=>id_1(1), id_a(a)=>id_b(b)}) of + Int when is_integer(Int) -> fail; + Atom when is_atom(Atom) -> error(ok); + _Else -> fail + end. + +id_1(X) -> X. + +id_a(X) -> X. + +id_b(X) -> X. + +any() -> binary_to_term(<<>>). + +-spec a_or_b() -> a | b. +a_or_b() -> any(). diff --git a/lib/dialyzer/test/map_SUITE_data/src/subtract_value_flip.erl b/lib/dialyzer/test/map_SUITE_data/src/subtract_value_flip.erl new file mode 100644 index 0000000000..97e6b54e3c --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/subtract_value_flip.erl @@ -0,0 +1,9 @@ +-module(subtract_value_flip). + +-export([t1/1]). + +t1(#{type := _Smth} = Map) -> + case Map of + #{type := a} -> ok; + #{type := b} -> error + end. diff --git a/lib/dialyzer/test/map_SUITE_data/src/typeflow.erl b/lib/dialyzer/test/map_SUITE_data/src/typeflow.erl new file mode 100644 index 0000000000..b43fd6897b --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/typeflow.erl @@ -0,0 +1,25 @@ +-module(typeflow). + +-export([t1/1, t2/1, t3/1, t4/1]). + +t1(M = #{}) -> + a_is_integer(M), + case M of + #{a := X} when is_integer(X) -> ok; + _ -> fail + end. + +a_is_integer(#{a := X}) when is_integer(X) -> ok. + +t2(M = #{}) -> + a_is_integer(M), + lists:sort(maps:get(a, M)), + ok. + +t3(M = #{}) -> + lists:sort(maps:get(a, M)), + ok. + +t4(M) -> + lists:sort(maps:get(a, M)), + ok. diff --git a/lib/dialyzer/test/map_SUITE_data/src/typeflow2.erl b/lib/dialyzer/test/map_SUITE_data/src/typeflow2.erl new file mode 100644 index 0000000000..71a9657a60 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/typeflow2.erl @@ -0,0 +1,88 @@ +-module(typeflow2). + +-export([t1/1, t2/1, t3/1, t4/1, t5/1, t6/1, t7/1, optional3/1]). + +t1(L) -> + M = only_integers_and_lists(L), + optional(M), + case M of + #{a := X} when is_integer(X) -> ok; + #{a := X} when is_list(X) -> ok; %% Must warn here + #{a := X} when is_pid(X) -> ok; + _ -> fail + end. + +optional(#{a:=X}) -> + true = is_integer(X); +optional(#{}) -> + true. + +only_integers_and_lists(L) -> only_integers_and_lists(L, #{}). + +only_integers_and_lists([], M) -> M; +only_integers_and_lists([{K,V}|T], M) when is_integer(V); is_list(V)-> + only_integers_and_lists(T, M#{K => V}). + +t2(L) -> + M = only_integers_and_lists(L), + optional(M), + lists:sort(maps:get(a, M)), + ok. + +t3(L) -> + M = only_integers_and_lists(L), + lists:sort(maps:get(a, M)), + ok. + +t4(V) -> + M=map_with(a,V), + optional2(M), + case M of + #{a := X} when is_integer(X) -> ok; + #{a := X} when is_list(X) -> ok; %% Must warn here + _ -> fail + end. + +optional2(#{a:=X}) -> + true = is_integer(X); +optional2(#{}) -> + true. + +map_with(K, V) when is_integer(V); is_list(V); is_atom(V) -> #{K => V}. + +t5(L) -> + M = only_integers_and_lists(L), + optional3(M), + case M of + #{a := X} when is_integer(X) -> ok; + #{a := X} when is_list(X) -> ok; %% Must warn here + #{a := X} when is_pid(X) -> ok; %% Must warn here + #{a := X} when is_atom(X) -> ok; + _ -> fail + end. + +t6(L) -> + M = only_integers_and_lists(L), + case M of + #{a := X} when is_integer(X) -> ok; + #{a := X} when is_list(X) -> ok; %% Must not warn here + _ -> fail + end. + +optional3(#{a:=X}) -> + true = is_integer(X); +optional3(#{}) -> + true. + +t7(M) -> + optional4(M), + case M of + #{a := X} when is_integer(X) -> ok; + #{a := X} when is_list(X) -> ok; + #{a := X} when is_pid(X) -> ok; %% Must warn here + #{a := X} when is_atom(X) -> ok; %% Must warn here + _ -> fail %% Must not warn here (requires parsing) + end. + +-spec optional4(#{a=>integer()|list()}) -> true. +optional4(#{}) -> true. diff --git a/lib/dialyzer/test/map_SUITE_data/src/typesig.erl b/lib/dialyzer/test/map_SUITE_data/src/typesig.erl new file mode 100644 index 0000000000..b50511af41 --- /dev/null +++ b/lib/dialyzer/test/map_SUITE_data/src/typesig.erl @@ -0,0 +1,9 @@ +-module(typesig). + +-export([t1/0, t2/0, t3/0, test/1]). + +t1() -> test(#{a=>1}). +t2() -> test(#{a=>{b}}). +t3() -> test(#{a=>{3}}). + +test(#{a:={X}}) -> X+1. diff --git a/lib/dialyzer/test/small_SUITE_data/results/literals b/lib/dialyzer/test/small_SUITE_data/results/literals index 222d2c0cdb..1ee39453a4 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/literals +++ b/lib/dialyzer/test/small_SUITE_data/results/literals @@ -5,6 +5,7 @@ literals.erl:14: Function t2/0 has no local return literals.erl:15: Record construction #r{id::'a'} violates the declared type of field id::'integer' literals.erl:17: Function t3/0 has no local return literals.erl:18: Record construction #r{id::'a'} violates the declared type of field id::'integer' +literals.erl:20: Function t4/0 has no local return literals.erl:21: Record construction #r{id::'a'} violates the declared type of field id::'integer' literals.erl:23: Function m1/1 has no local return literals.erl:23: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer'} @@ -12,3 +13,5 @@ literals.erl:26: Function m2/1 has no local return literals.erl:26: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer'} literals.erl:29: Function m3/1 has no local return literals.erl:29: The pattern {{'r', 'a'}} can never match the type any() +literals.erl:32: Function m4/1 has no local return +literals.erl:32: Matching of pattern {'r', 'a'} tagged with a record name violates the declared type of #r{id::'integer'} diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps1 b/lib/dialyzer/test/small_SUITE_data/results/maps1 index e88c91f21f..a178e96b20 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/maps1 +++ b/lib/dialyzer/test/small_SUITE_data/results/maps1 @@ -1,4 +1,4 @@ maps1.erl:43: Function t3/0 has no local return -maps1.erl:44: The call maps1:foo(~{'greger'=>3, ~{'arne'=>'anka'}~=>45}~,1) will never return since it differs in the 2nd argument from the success typing arguments: (#{},'b') -maps1.erl:52: The call Mod:'function'(~{'literal'=>'map'}~,'another_arg') requires that Mod is of type atom() not #{} +maps1.erl:44: The call maps1:foo(#{'greger'=>3, #{'arne'=>'anka'}=>45},1) will never return since it differs in the 1st and 2nd argument from the success typing arguments: (#{'beta':=_, ...},'b') +maps1.erl:52: The variable Mod can never match since previous clauses completely covered the type #{} diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps_difftype b/lib/dialyzer/test/small_SUITE_data/results/maps_difftype index 8980321135..3018b888db 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/maps_difftype +++ b/lib/dialyzer/test/small_SUITE_data/results/maps_difftype @@ -1,3 +1,3 @@ maps_difftype.erl:10: Function empty_mismatch/1 has no local return -maps_difftype.erl:11: The pattern ~{}~ can never match the type tuple() +maps_difftype.erl:11: The pattern #{} can never match the type tuple() diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps_sum b/lib/dialyzer/test/small_SUITE_data/results/maps_sum index a19c0bba96..bd192bdb93 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/maps_sum +++ b/lib/dialyzer/test/small_SUITE_data/results/maps_sum @@ -1,4 +1,4 @@ -maps_sum.erl:15: Invalid type specification for function maps_sum:wrong1/1. The success typing is (#{}) -> any() +maps_sum.erl:15: Invalid type specification for function maps_sum:wrong1/1. The success typing is (map()) -> any() maps_sum.erl:26: Function wrong2/1 has no local return maps_sum.erl:27: The call lists:foldl(fun((_,_,_) -> any()),0,Data::any()) will never return since it differs in the 1st argument from the success typing arguments: (fun((_,_) -> any()),any(),[any()]) diff --git a/lib/dialyzer/test/small_SUITE_data/src/literals.erl b/lib/dialyzer/test/small_SUITE_data/src/literals.erl index abd7033712..354a0f4cdc 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/literals.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/literals.erl @@ -2,7 +2,7 @@ %% Bad records inside structures used to be ignored. The reason: %% v3_core:unfold() does not annotate the parts of a literal. -%% This example does not work perfectly yet, in particular Maps. +%% This example does not work perfectly yet. -export([t1/0, t2/0, t3/0, t4/0, m1/1, m2/1, m3/1, m4/1]). @@ -18,7 +18,7 @@ t3() -> {#r{id = a}}. % violation t4() -> - #{a => #r{id = a}}. % violation found, but t4() returns... (bug) + #{a => #r{id = a}}. % violation m1(#r{id = a}) -> % violation ok. @@ -29,5 +29,5 @@ m2([#r{id = a}]) -> % violation m3({#r{id = a}}) -> % can never match; not so good ok. -m4(#{a := #r{id = a}}) -> % violation not found +m4(#{a := #r{id = a}}) -> % violation ok. diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps1.erl b/lib/dialyzer/test/small_SUITE_data/src/maps1.erl index bb2f66a498..597358d16a 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/maps1.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/maps1.erl @@ -21,7 +21,7 @@ recv(Packet, Fun, Chan) -> #{id := Can_id, data := Can_data} = P = decode(Packet), Fun(P). --spec decode(<<_:64,_:_*8>>) -> #{id => <<_:11>>,timestamp => char()}. +-spec decode(<<_:64,_:_*8>>) -> #{id => <<_:11>>,timestamp => char(),_ => _}. decode(<<_:12, Len:4, Timestamp:16, 0:3, Id:11/bitstring, 0:18, Data:Len/binary, _/binary>>) -> #{id => Id, data => Data, timestamp => Timestamp}. diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk index 44982ab46d..77ea9d0413 100644 --- a/lib/dialyzer/vsn.mk +++ b/lib/dialyzer/vsn.mk @@ -1 +1 @@ -DIALYZER_VSN = 2.9 +DIALYZER_VSN = 2.10 diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index d2494b69fe..94013bb5ac 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -653,20 +653,7 @@ find_invalid_unicode([]) -> none. parse_file(Epp) -> case scan_and_parse(Epp) of {ok, Form} -> - case Form of - {attribute,La,record,{Record, Fields}} -> - case epp:normalize_typed_record_fields(Fields) of - {typed, NewFields} -> - [{attribute, La, record, {Record, NewFields}}, - {attribute, La, type, - {{record, Record}, Fields, []}} - | parse_file(Epp)]; - not_typed -> - [Form | parse_file(Epp)] - end; - _ -> - [Form | parse_file(Epp)] - end; + [Form | parse_file(Epp)]; {error, E} -> [{error, E} | parse_file(Epp)]; {eof, Location} -> diff --git a/lib/edoc/src/edoc_extract.erl b/lib/edoc/src/edoc_extract.erl index 758750083d..e7a4c36ca4 100644 --- a/lib/edoc/src/edoc_extract.erl +++ b/lib/edoc/src/edoc_extract.erl @@ -355,6 +355,8 @@ preprocess_forms_2(F, Fs) -> [F | preprocess_forms_1(Fs)]; text -> [F | preprocess_forms_1(Fs)]; + {attribute, {record, _}} -> + [F | preprocess_forms_1(Fs)]; {attribute, {N, _}} -> case edoc_specs:is_tag(N) of true -> @@ -373,50 +375,62 @@ preprocess_forms_2(F, Fs) -> %% in the list. collect(Fs, Mod) -> - collect(Fs, [], [], [], [], undefined, Mod). + collect(Fs, [], [], [], [], [], undefined, Mod). -collect([F | Fs], Cs, Ss, Ts, As, Header, Mod) -> +collect([F | Fs], Cs, Ss, Ts, Rs, As, Header, Mod) -> case erl_syntax_lib:analyze_form(F) of comment -> - collect(Fs, [F | Cs], Ss, Ts, As, Header, Mod); + collect(Fs, [F | Cs], Ss, Ts, Rs, As, Header, Mod); {function, Name} -> L = erl_syntax:get_pos(F), Export = ordsets:is_element(Name, Mod#module.exports), Args = parameters(erl_syntax:function_clauses(F)), - collect(Fs, [], [], [], + collect(Fs, [], [], [], [], [#entry{name = Name, args = Args, line = L, export = Export, - data = {comment_text(Cs),Ss,Ts}} | As], + data = {comment_text(Cs),Ss,Ts,Rs}} | As], Header, Mod); {attribute, {module, _}} when Header =:= undefined -> L = erl_syntax:get_pos(F), - collect(Fs, [], [], [], As, + collect(Fs, [], [], [], [], As, #entry{name = module, line = L, - data = {comment_text(Cs),Ss,Ts}}, + data = {comment_text(Cs),Ss,Ts,Rs}}, Mod); + {attribute, {record, {_Name, Fields}}} -> + case is_typed_record(Fields) of + true -> + collect(Fs, Cs, Ss, Ts, [F | Rs], As, Header, Mod); + false -> + collect(Fs, Cs, Ss, Ts, Rs, As, Header, Mod) + end; {attribute, {N, _}} -> case edoc_specs:tag(N) of spec -> - collect(Fs, Cs, [F | Ss], Ts, As, Header, Mod); + collect(Fs, Cs, [F | Ss], Ts, Rs, As, Header, Mod); type -> - collect(Fs, Cs, Ss, [F | Ts], As, Header, Mod); + collect(Fs, Cs, Ss, [F | Ts], Rs, As, Header, Mod); unknown -> %% Drop current seen comments. - collect(Fs, [], [], [], As, Header, Mod) + collect(Fs, [], [], [], Rs, As, Header, Mod) end; _ -> %% Drop current seen comments. - collect(Fs, [], [], [], As, Header, Mod) + collect(Fs, [], [], [], [], As, Header, Mod) end; -collect([], Cs, Ss, Ts, As, Header, _Mod) -> - Footer = #entry{name = footer, data = {comment_text(Cs),Ss,Ts}}, +collect([], Cs, Ss, Ts, Rs, As, Header, _Mod) -> + Footer = #entry{name = footer, data = {comment_text(Cs),Ss,Ts,Rs}}, As1 = lists:reverse(As), if Header =:= undefined -> - {#entry{name = module, data = {[],[],[]}}, Footer, As1}; + {#entry{name = module, data = {[],[],[],[]}}, Footer, As1}; true -> {Header, Footer, As1} end. +is_typed_record([]) -> + false; +is_typed_record([{_, {_, Type}} | Fs]) -> + Type =/= none orelse is_typed_record(Fs). + %% Returns a list of simplified comment information (position and text) %% for a list of abstract comments. The order of elements is reversed. @@ -549,8 +563,8 @@ get_tags(Es, Env, File, TypeDocs) -> How = dict:from_list(edoc_tags:tag_parsers()), get_tags(Es, Tags, Env, How, File, TypeDocs). -get_tags([#entry{name = Name, data = {Cs,Specs,Types}} = E | Es], Tags, Env, - How, File, TypeDocs) -> +get_tags([#entry{name = Name, data = {Cs,Specs,Types,Records}} = E | Es], + Tags, Env, How, File, TypeDocs) -> Where = {File, Name}, Ts0 = scan_tags(Cs), {Ts1,Specs1} = select_spec(Ts0, Where, Specs), @@ -558,7 +572,7 @@ get_tags([#entry{name = Name, data = {Cs,Specs,Types}} = E | Es], Tags, Env, Ts3 = edoc_macros:expand_tags(Ts2, Env, Where), Ts4 = edoc_tags:parse_tags(Ts3, How, Env, Where), Ts = selected_specs(Specs1, Ts4), - ETypes = [edoc_specs:type(Type, TypeDocs) || Type <- Types], + ETypes = [edoc_specs:type(Type, TypeDocs) || Type <- Types ++ Records], [E#entry{data = Ts++ETypes} | get_tags(Es, Tags, Env, How, File, TypeDocs)]; get_tags([], _, _, _, _, _) -> []. diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index f2e5891c2e..faee8adf7b 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -42,14 +42,15 @@ %% TypeDocs is a dict of {Name, Doc}. %% Note: #t_typedef.name is set to {record, R} for record types. type(Form, TypeDocs) -> - {Name, Data0} = erl_syntax_lib:analyze_wild_attribute(Form), - type = tag(Name), + {Name, Data0} = analyze_type_attribute(Form), {TypeName, Type, Args, Doc} = case Data0 of - {{record, R}, Fs, []} -> + {R, Fs} -> + record = Name, L = erl_syntax:get_pos(Form), {{record, R}, {type, L, record, [{atom,L,R} | Fs]}, [], ""}; {N,T,As} -> + type = tag(Name), Doc0 = case dict:find({N, length(As)}, TypeDocs) of {ok, Doc1} -> @@ -188,7 +189,7 @@ strip([_ | S]) -> %% Find the type name and the greatest line number of a type spec. %% Should use syntax_tools but this has to do for now. get_name_and_last_line(F) -> - {Name, Data} = erl_syntax_lib:analyze_wild_attribute(F), + {Name, Data} = analyze_type_attribute(F), type = edoc_specs:tag(Name), Attr = {attribute, erl_syntax:get_pos(F), Name, Data}, Fun = fun(A) -> @@ -229,6 +230,7 @@ get_all_tags(Es) -> %% Turns an opaque type into an abstract datatype. %% Note: top level annotation is ignored. opaque2abstr(opaque, _T) -> undefined; +opaque2abstr(record, T) -> T; opaque2abstr(type, T) -> T. %% Replaces the parameters extracted from the source (by @@ -608,6 +610,16 @@ type_name(#tag{name = type, data = {#t_typedef{name = Name, args = As},_}}) -> {Name, length(As)}. +analyze_type_attribute(Form) -> + Name = erl_syntax:atom_value(erl_syntax:attribute_name(Form)), + case tag(Name) of + type -> + erl_syntax_lib:analyze_wild_attribute(Form); + _ when Name =:= record -> + {attribute, _, record, {N, Fields}} = erl_syntax:revert(Form), + {record, {N, Fields}} + end. + %% @doc Return `true' if `Tag' is one of the specification and type %% attribute tags recognized by the Erlang compiler. diff --git a/lib/eldap/vsn.mk b/lib/eldap/vsn.mk index 99c474d588..721387d97d 100644 --- a/lib/eldap/vsn.mk +++ b/lib/eldap/vsn.mk @@ -1 +1 @@ -ELDAP_VSN = 1.2.1 +ELDAP_VSN = 1.2.2 diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 7684dc4a81..9453ca6c6f 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -115,7 +115,16 @@ t_tuple_size/2, t_tuple_subtypes/2, t_is_map/2, - t_map/0 + t_map/0, + t_map/3, + t_map_def_key/2, + t_map_def_val/2, + t_map_get/3, + t_map_is_key/3, + t_map_entries/2, + t_map_put/3, + t_map_update/3, + map_pairwise_merge/3 ]). -ifdef(DO_ERL_BIF_TYPES_TEST). @@ -755,7 +764,7 @@ type(erlang, length, 1, Xs, Opaques) -> strict(erlang, length, 1, Xs, fun (_) -> t_non_neg_fixnum() end, Opaques); %% Guard bif, needs to be here. type(erlang, map_size, 1, Xs, Opaques) -> - strict(erlang, map_size, 1, Xs, fun (_) -> t_non_neg_integer() end, Opaques); + type(maps, size, 1, Xs, Opaques); type(erlang, make_fun, 3, Xs, Opaques) -> strict(erlang, make_fun, 3, Xs, fun ([_, _, Arity]) -> @@ -1645,6 +1654,89 @@ type(lists, zipwith3, 4, Xs, Opaques) -> fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F, Opaques)), t_nil()) end, Opaques); +%%-- maps --------------------------------------------------------------------- +type(maps, from_list, 1, Xs, Opaques) -> + strict(maps, from_list, 1, Xs, + fun ([List]) -> + case t_is_nil(List, Opaques) of + true -> t_from_term(#{}); + false -> + T = t_list_elements(List, Opaques), + case t_tuple_subtypes(T, Opaques) of + unknown -> t_map(); + Stypes when length(Stypes) >= 1 -> + t_sup([begin + [K, V] = t_tuple_args(Args, Opaques), + t_map([], K, V) + end || Args <- Stypes]) + end + end + end, Opaques); +type(maps, get, 2, Xs, Opaques) -> + strict(maps, get, 2, Xs, + fun ([Key, Map]) -> + t_map_get(Key, Map, Opaques) + end, Opaques); +type(maps, is_key, 2, Xs, Opaques) -> + strict(maps, is_key, 2, Xs, + fun ([Key, Map]) -> + t_map_is_key(Key, Map, Opaques) + end, Opaques); +type(maps, merge, 2, Xs, Opaques) -> + strict(maps, merge, 2, Xs, + fun ([MapA, MapB]) -> + ADefK = t_map_def_key(MapA, Opaques), + BDefK = t_map_def_key(MapB, Opaques), + ADefV = t_map_def_val(MapA, Opaques), + BDefV = t_map_def_val(MapB, Opaques), + t_map(map_pairwise_merge( + fun(K, _, _, mandatory, V) -> {K, mandatory, V}; + (K, MNess, VA, optional, VB) -> {K, MNess, t_sup(VA,VB)} + end, MapA, MapB), + t_sup(ADefK, BDefK), t_sup(ADefV, BDefV)) + end, Opaques); +type(maps, put, 3, Xs, Opaques) -> + strict(maps, put, 3, Xs, + fun ([Key, Value, Map]) -> + t_map_put({Key, Value}, Map, Opaques) + end, Opaques); +type(maps, size, 1, Xs, Opaques) -> + strict(maps, size, 1, Xs, + fun ([Map]) -> + Mand = [E || E={_,mandatory,_} <- t_map_entries(Map, Opaques)], + LowerBound = length(Mand), + case t_is_none(t_map_def_key(Map, Opaques)) of + false -> t_from_range(LowerBound, pos_inf); + true -> + Opt = [E || E={_,optional,_} <- t_map_entries(Map, Opaques)], + UpperBound = LowerBound + length(Opt), + t_from_range(LowerBound, UpperBound) + end + end, Opaques); +type(maps, to_list, 1, Xs, Opaques) -> + strict(maps, to_list, 1, Xs, + fun ([Map]) -> + DefK = t_map_def_key(Map, Opaques), + DefV = t_map_def_val(Map, Opaques), + Pairs = t_map_entries(Map, Opaques), + EType = lists:foldl( + fun({K,_,V},EType0) -> + case t_is_none(V) of + true -> t_subtract(EType0, t_tuple([K,t_any()])); + false -> t_sup(EType0, t_tuple([K,V])) + end + end, t_tuple([DefK, DefV]), Pairs), + case t_is_none(EType) of + true -> t_nil(); + false -> t_list(EType) + end + end, Opaques); +type(maps, update, 3, Xs, Opaques) -> + strict(maps, update, 3, Xs, + fun ([Key, Value, Map]) -> + t_map_update({Key, Value}, Map, Opaques) + end, Opaques); + %%----------------------------------------------------------------------------- type(M, F, A, Xs, _O) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> @@ -2556,6 +2648,23 @@ arg_types(lists, zipwith, 3) -> [t_fun([t_any(), t_any()], t_any()), t_list(), t_list()]; arg_types(lists, zipwith3, 4) -> [t_fun([t_any(), t_any(), t_any()], t_any()), t_list(), t_list(), t_list()]; +%%------- maps ---------------------------------------------------------------- +arg_types(maps, from_list, 1) -> + [t_list(t_tuple(2))]; +arg_types(maps, get, 2) -> + [t_any(), t_map()]; +arg_types(maps, is_key, 2) -> + [t_any(), t_map()]; +arg_types(maps, merge, 2) -> + [t_map(), t_map()]; +arg_types(maps, put, 3) -> + [t_any(), t_any(), t_map()]; +arg_types(maps, size, 1) -> + [t_map()]; +arg_types(maps, to_list, 1) -> + [t_map()]; +arg_types(maps, update, 3) -> + [t_any(), t_any(), t_map()]; arg_types(M, F, A) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> unknown. % safe approximation for all functions. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index fae12d7421..84addcc105 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2015. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -140,6 +140,8 @@ t_is_port/1, t_is_port/2, t_is_maybe_improper_list/1, t_is_maybe_improper_list/2, t_is_reference/1, t_is_reference/2, + t_is_singleton/1, + t_is_singleton/2, t_is_string/1, t_is_subtype/2, t_is_tuple/1, t_is_tuple/2, @@ -152,6 +154,14 @@ t_list_termination/1, t_list_termination/2, t_map/0, t_map/1, + t_map/3, + t_map_entries/2, t_map_entries/1, + t_map_def_key/2, t_map_def_key/1, + t_map_def_val/2, t_map_def_val/1, + t_map_get/2, t_map_get/3, + t_map_is_key/2, t_map_is_key/3, + t_map_update/2, t_map_update/3, + t_map_put/2, t_map_put/3, t_matchstate/0, t_matchstate/2, t_matchstate_present/1, @@ -178,6 +188,7 @@ %% t_maybe_improper_list/2, t_product/1, t_reference/0, + t_singleton_to_term/2, t_string/0, t_struct_from_opaque/2, t_subst/2, @@ -208,7 +219,8 @@ lift_list_to_pos_empty/1, lift_list_to_pos_empty/2, is_opaque_type/2, is_erl_type/1, - atom_to_string/1 + atom_to_string/1, + map_pairwise_merge/3 ]). %%-define(DO_ERL_TYPES_TEST, true). @@ -224,7 +236,7 @@ -export([t_is_identifier/1]). -endif. --export_type([erl_type/0, opaques/0, type_table/0, var_table/0]). +-export_type([erl_type/0, opaques/0, type_table/0]). %%-define(DEBUG, true). @@ -341,7 +353,8 @@ -define(nonempty_list(Types, Term),?list(Types, Term, ?nonempty_qual)). -define(number(Set, Qualifier), #c{tag=?number_tag, elements=Set, qualifier=Qualifier}). --define(map(Pairs), #c{tag=?map_tag, elements=Pairs}). +-define(map(Pairs,DefKey,DefVal), + #c{tag=?map_tag, elements={Pairs,DefKey,DefVal}}). -define(opaque(Optypes), #c{tag=?opaque_tag, elements=Optypes}). -define(product(Types), #c{tag=?product_tag, elements=Types}). -define(tuple(Types, Arity, Qual), #c{tag=?tuple_tag, elements=Types, @@ -367,7 +380,7 @@ -type type_table() :: dict:dict(record_key() | type_key(), record_value() | type_value()). --type var_table() :: dict:dict(atom(), erl_type()). +-type var_table() :: #{atom() => erl_type()}. %%----------------------------------------------------------------------------- %% Unions @@ -484,9 +497,8 @@ t_contains_opaque(?int_range(_From, _To), _Opaques) -> false; t_contains_opaque(?int_set(_Set), _Opaques) -> false; t_contains_opaque(?list(Type, Tail, _), Opaques) -> t_contains_opaque(Type, Opaques) orelse t_contains_opaque(Tail, Opaques); -t_contains_opaque(?map(_) = Map, Opaques) -> - list_contains_opaque(map_values(Map), Opaques) orelse - list_contains_opaque(map_keys(Map), Opaques); +t_contains_opaque(?map(_, _, _) = Map, Opaques) -> + list_contains_opaque(map_all_types(Map), Opaques); t_contains_opaque(?matchstate(_P, _Slots), _Opaques) -> false; t_contains_opaque(?nil, _Opaques) -> false; t_contains_opaque(?number(_Set, _Tag), _Opaques) -> false; @@ -1581,16 +1593,107 @@ lift_list_to_pos_empty(?list(Content, Termination, _)) -> %%----------------------------------------------------------------------------- %% Maps %% +%% Representation: +%% ?map(Pairs, DefaultKey, DefaultValue) +%% +%% Pairs is a sorted dictionary of types with a mandatoriness tag on each pair +%% (t_map_dict()). DefaultKey and DefaultValue are plain types. +%% +%% A map M belongs to this type iff +%% For each pair {KT, mandatory, VT} in Pairs, there exists a pair {K, V} in M +%% such that K \in KT and V \in VT. +%% For each pair {KT, optional, VT} in Pairs, either there exists no key K in +%% M s.t. K in KT, or there exists a pair {K, V} in M such that K \in KT and +%% V \in VT. +%% For each remaining pair {K, V} in M (where remaining means that there is no +%% key KT in Pairs s.t. K \in KT), K \in DefaultKey and V \in DefaultValue. +%% +%% Invariants: +%% * The keys in Pairs are singleton types. +%% * The values of Pairs must not be unit, and may only be none if the +%% mandatoriness tag is 'optional'. +%% * Optional must contain no pair {K,V} s.t. K is a subtype of DefaultKey and +%% V is equal to DefaultKey. +%% * DefaultKey must be the empty type iff DefaultValue is the empty type. +%% * DefaultKey must not be a singleton type. +%% * For every key K in Pairs, DefaultKey - K must not be representable; i.e. +%% t_subtract(DefaultKey, K) must return DefaultKey. +%% * For every pair {K, 'optional', ?none} in Pairs, K must be a subtype of +%% DefaultKey. +%% * Pairs must be sorted and not contain any duplicate keys. +%% +%% These invariants ensure that equal map types are represented by equal terms. + +-define(mand, mandatory). +-define(opt, optional). + +-type t_map_mandatoriness() :: ?mand | ?opt. +-type t_map_pair() :: {erl_type(), t_map_mandatoriness(), erl_type()}. +-type t_map_dict() :: [t_map_pair()]. -spec t_map() -> erl_type(). t_map() -> - ?map([]). + t_map([], t_any(), t_any()). -spec t_map([{erl_type(), erl_type()}]) -> erl_type(). -t_map(_) -> - ?map([]). +t_map(L) -> + lists:foldl(fun t_map_put/2, t_map(), L). + +-spec t_map(t_map_dict(), erl_type(), erl_type()) -> erl_type(). + +t_map(Pairs0, DefK0, DefV0) -> + DefK1 = lists:foldl(fun({K,_,_},Acc)->t_subtract(Acc,K)end, DefK0, Pairs0), + {DefK2, DefV1} = + case t_is_none_or_unit(DefK1) orelse t_is_none_or_unit(DefV0) of + true -> {?none, ?none}; + false -> {DefK1, DefV0} + end, + {Pairs1, DefK, DefV} + = case is_singleton_type(DefK2) of + true -> {mapdict_insert({DefK2, ?opt, DefV1}, Pairs0), ?none, ?none}; + false -> {Pairs0, DefK2, DefV1} + end, + Pairs = normalise_map_optionals(Pairs1, DefK, DefV), + %% Validate invariants of the map representation. + %% Since we needed to iterate over the arguments in order to normalise anyway, + %% we might as well save us some future pain and do this even without + %% define(DEBUG, true). + try + validate_map_elements(Pairs) + catch error:badarg -> error(badarg, [Pairs0,DefK0,DefV0]); + error:{badarg, E} -> error({badarg, E}, [Pairs0,DefK0,DefV0]) + end, + ?map(Pairs, DefK, DefV). + +normalise_map_optionals([], _, _) -> []; +normalise_map_optionals([E={K,?opt,?none}|T], DefK, DefV) -> + Diff = t_subtract(DefK, K), + case t_is_subtype(K, DefK) andalso DefK =:= Diff of + true -> [E|normalise_map_optionals(T, DefK, DefV)]; + false -> normalise_map_optionals(T, Diff, DefV) + end; +normalise_map_optionals([E={K,?opt,V}|T], DefK, DefV) -> + case t_is_equal(V, DefV) andalso t_is_subtype(K, DefK) of + true -> normalise_map_optionals(T, DefK, DefV); + false -> [E|normalise_map_optionals(T, DefK, DefV)] + end; +normalise_map_optionals([E|T], DefK, DefV) -> + [E|normalise_map_optionals(T, DefK, DefV)]. + +validate_map_elements([{_,?mand,?none}|_]) -> error({badarg, none_in_mand}); +validate_map_elements([{K1,_,_}|Rest=[{K2,_,_}|_]]) -> + case is_singleton_type(K1) andalso K1 < K2 of + false -> error(badarg); + true -> validate_map_elements(Rest) + end; +validate_map_elements([{K,_,_}]) -> + case is_singleton_type(K) of + false -> error(badarg); + true -> true + end; +validate_map_elements([]) -> true. -spec t_is_map(erl_type()) -> boolean(). @@ -1602,9 +1705,242 @@ t_is_map(Type) -> t_is_map(Type, Opaques) -> do_opaque(Type, Opaques, fun is_map1/1). -is_map1(?map(_)) -> true; +is_map1(?map(_, _, _)) -> true; is_map1(_) -> false. +-spec t_map_entries(erl_type()) -> t_map_dict(). + +t_map_entries(M) -> + t_map_entries(M, 'universe'). + +-spec t_map_entries(erl_type(), opaques()) -> t_map_dict(). + +t_map_entries(M, Opaques) -> + do_opaque(M, Opaques, fun map_entries/1). + +map_entries(?map(Pairs,_,_)) -> + Pairs. + +-spec t_map_def_key(erl_type()) -> erl_type(). + +t_map_def_key(M) -> + t_map_def_key(M, 'universe'). + +-spec t_map_def_key(erl_type(), opaques()) -> erl_type(). + +t_map_def_key(M, Opaques) -> + do_opaque(M, Opaques, fun map_def_key/1). + +map_def_key(?map(_,DefK,_)) -> + DefK. + +-spec t_map_def_val(erl_type()) -> erl_type(). + +t_map_def_val(M) -> + t_map_def_val(M, 'universe'). + +-spec t_map_def_val(erl_type(), opaques()) -> erl_type(). + +t_map_def_val(M, Opaques) -> + do_opaque(M, Opaques, fun map_def_val/1). + +map_def_val(?map(_,_,DefV)) -> + DefV. + +-spec mapdict_store(t_map_pair(), t_map_dict()) -> t_map_dict(). + +mapdict_store(E={K,_,_}, [{K,_,_}|T]) -> [E|T]; +mapdict_store(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2-> + [E2|mapdict_store(E1, T)]; +mapdict_store(E={_,_,_}, T) -> [E|T]. + +-spec mapdict_insert(t_map_pair(), t_map_dict()) -> t_map_dict(). + +mapdict_insert(E={K,_,_}, D=[{K,_,_}|_]) -> error(badarg, [E, D]); +mapdict_insert(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2-> + [E2|mapdict_insert(E1, T)]; +mapdict_insert(E={_,_,_}, T) -> [E|T]. + +%% Merges the pairs of two maps together. Missing pairs become (?opt, DefV) or +%% (?opt, ?none), depending on whether K \in DefK. +-spec map_pairwise_merge(fun((erl_type(), + t_map_mandatoriness(), erl_type(), + t_map_mandatoriness(), erl_type()) + -> t_map_pair() | false), + erl_type(), erl_type()) -> t_map_dict(). +map_pairwise_merge(F, ?map(APairs, ADefK, ADefV), + ?map(BPairs, BDefK, BDefV)) -> + map_pairwise_merge(F, APairs, ADefK, ADefV, BPairs, BDefK, BDefV). + +map_pairwise_merge(_, [], _, _, [], _, _) -> []; +map_pairwise_merge(F, As0, ADefK, ADefV, Bs0, BDefK, BDefV) -> + case {As0, Bs0} of + {[{K,AMNess,AV}|As], [{K, BMNess,BV}|Bs]} -> ok; + {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> + {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)}; + {As, [{K, BMNess,BV}|Bs]} -> + {AMNess, AV} = {?opt, mapmerge_otherv(K, ADefK, ADefV)}; + {[{K,AMNess,AV}|As], []=Bs} -> + {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)} + end, + MK = K, %% Rename to make clear that we are matching below + case F(K, AMNess, AV, BMNess, BV) of + false -> map_pairwise_merge(F,As,ADefK,ADefV,Bs,BDefK,BDefV); + M={MK,_,_} -> [M|map_pairwise_merge(F,As,ADefK,ADefV,Bs,BDefK,BDefV)] + end. + +%% Folds over the pairs in two maps simultaneously in reverse key order. Missing +%% pairs become (?opt, DefV) or (?opt, ?none), depending on whether K \in DefK. +-spec map_pairwise_merge_foldr(fun((erl_type(), + t_map_mandatoriness(), erl_type(), + t_map_mandatoriness(), erl_type(), + Acc) -> Acc), + Acc, erl_type(), erl_type()) -> Acc. + +map_pairwise_merge_foldr(F, AccIn, ?map(APairs, ADefK, ADefV), + ?map(BPairs, BDefK, BDefV)) -> + map_pairwise_merge_foldr(F, AccIn, APairs, ADefK, ADefV, BPairs, BDefK, BDefV). + +map_pairwise_merge_foldr(_, Acc, [], _, _, [], _, _) -> Acc; +map_pairwise_merge_foldr(F, AccIn, As0, ADefK, ADefV, Bs0, BDefK, BDefV) -> + case {As0, Bs0} of + {[{K,AMNess,AV}|As], [{K, BMNess,BV}|Bs]} -> ok; + {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> + {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)}; + {As, [{K, BMNess,BV}|Bs]} -> + {AMNess, AV} = {?opt, mapmerge_otherv(K, ADefK, ADefV)}; + {[{K,AMNess,AV}|As], []=Bs} -> + {BMNess, BV} = {?opt, mapmerge_otherv(K, BDefK, BDefV)} + end, + F(K, AMNess, AV, BMNess, BV, + map_pairwise_merge_foldr(F,AccIn,As,ADefK,ADefV,Bs,BDefK,BDefV)). + +%% By observing that a missing pair in a map is equivalent to an optional pair, +%% with ?none or DefV value, depending on whether K \in DefK, we can simplify +%% merging by denormalising the map pairs temporarily, removing all 'false' +%% cases, at the cost of the creation of more tuples: +mapmerge_otherv(K, ODefK, ODefV) -> + case t_inf(K, ODefK) of + ?none -> ?none; + _KOrOpaque -> ODefV + end. + +-spec t_map_put({erl_type(), erl_type()}, erl_type()) -> erl_type(). + +t_map_put(KV, Map) -> + t_map_put(KV, Map, 'universe'). + +-spec t_map_put({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type(). + +t_map_put(KV, Map, Opaques) -> + do_opaque(Map, Opaques, fun(UM) -> map_put(KV, UM, Opaques) end). + +%% Key and Value are *not* unopaqued, but the map is +map_put(_, ?none, _) -> ?none; +map_put({Key, Value}, ?map(Pairs,DefK,DefV), Opaques) -> + case t_is_none_or_unit(Key) orelse t_is_none_or_unit(Value) of + true -> ?none; + false -> + case is_singleton_type(Key) of + true -> + t_map(mapdict_store({Key, ?mand, Value}, Pairs), DefK, DefV); + false -> + t_map([{K, MNess, case t_is_none(t_inf(K, Key, Opaques)) of + true -> V; + false -> t_sup(V, Value) + end} || {K, MNess, V} <- Pairs], + t_sup(DefK, Key), + t_sup(DefV, Value)) + end + end. + +-spec t_map_update({erl_type(), erl_type()}, erl_type()) -> erl_type(). + +t_map_update(KV, Map) -> + t_map_update(KV, Map, 'universe'). + +-spec t_map_update({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type(). + +t_map_update(_, ?none, _) -> ?none; +t_map_update(KV={Key, _}, M, Opaques) -> + case t_is_subtype(t_atom('true'), t_map_is_key(Key, M, Opaques)) of + false -> ?none; + true -> t_map_put(KV, M, Opaques) + end. + +-spec t_map_get(erl_type(), erl_type()) -> erl_type(). + +t_map_get(Key, Map) -> + t_map_get(Key, Map, 'universe'). + +-spec t_map_get(erl_type(), erl_type(), opaques()) -> erl_type(). + +t_map_get(Key, Map, Opaques) -> + do_opaque(Map, Opaques, + fun(UM) -> + do_opaque(Key, Opaques, fun(UK) -> map_get(UK, UM) end) + end). + +map_get(_, ?none) -> ?none; +map_get(Key, ?map(Pairs, DefK, DefV)) -> + DefRes = + case t_do_overlap(DefK, Key) of + false -> t_none(); + true -> DefV + end, + case is_singleton_type(Key) of + false -> + lists:foldl(fun({K, _, V}, Res) -> + case t_do_overlap(K, Key) of + false -> Res; + true -> t_sup(Res, V) + end + end, DefRes, Pairs); + true -> + case lists:keyfind(Key, 1, Pairs) of + false -> DefRes; + {_, _, ValType} -> ValType + end + end. + +-spec t_map_is_key(erl_type(), erl_type()) -> erl_type(). + +t_map_is_key(Key, Map) -> + t_map_is_key(Key, Map, 'universe'). + +-spec t_map_is_key(erl_type(), erl_type(), opaques()) -> erl_type(). + +t_map_is_key(Key, Map, Opaques) -> + do_opaque(Map, Opaques, + fun(UM) -> + do_opaque(Key, Opaques, fun(UK) -> map_is_key(UK, UM) end) + end). + +map_is_key(_, ?none) -> ?none; +map_is_key(Key, ?map(Pairs, DefK, _DefV)) -> + case is_singleton_type(Key) of + true -> + case lists:keyfind(Key, 1, Pairs) of + {Key, ?mand, _} -> t_atom(true); + {Key, ?opt, ?none} -> t_atom(false); + {Key, ?opt, _} -> t_boolean(); + false -> + case t_do_overlap(DefK, Key) of + false -> t_atom(false); + true -> t_boolean() + end + end; + false -> + case t_do_overlap(DefK, Key) + orelse lists:any(fun({_,_,?none}) -> false; + ({K,_,_}) -> t_do_overlap(K, Key) + end, Pairs) + of + true -> t_boolean(); + false -> t_atom(false) + end + end. + %%----------------------------------------------------------------------------- %% Tuples %% @@ -1862,8 +2198,9 @@ t_has_var(?tuple(Elements, _, _)) -> t_has_var_list(Elements); t_has_var(?tuple_set(_) = T) -> t_has_var_list(t_tuple_subtypes(T)); -t_has_var(?map(_)= Map) -> - t_has_var_list(map_keys(Map)) orelse t_has_var_list(map_values(Map)); +t_has_var(?map(_, DefK, _)= Map) -> + t_has_var_list(map_all_values(Map)) orelse + t_has_var(DefK); t_has_var(?opaque(Set)) -> %% Assume variables in 'args' are also present i 'struct' t_has_var_list([O#opaque.struct || O <- set_to_list(Set)]); @@ -1898,9 +2235,9 @@ t_collect_vars(?tuple(Types, _, _), Acc) -> t_collect_vars_list(Types, Acc); t_collect_vars(?tuple_set(_) = TS, Acc) -> t_collect_vars_list(t_tuple_subtypes(TS), Acc); -t_collect_vars(?map(_) = Map, Acc0) -> - Acc = t_collect_vars_list(map_keys(Map), Acc0), - t_collect_vars_list(map_values(Map), Acc); +t_collect_vars(?map(_, DefK, _) = Map, Acc0) -> + Acc = t_collect_vars_list(map_all_values(Map), Acc0), + t_collect_vars(DefK, Acc); t_collect_vars(?opaque(Set), Acc) -> %% Assume variables in 'args' are also present i 'struct' t_collect_vars_list([O#opaque.struct || O <- set_to_list(Set)], Acc); @@ -1935,7 +2272,15 @@ t_from_term(T) when is_function(T) -> {arity, Arity} = erlang:fun_info(T, arity), t_fun(Arity, t_any()); t_from_term(T) when is_integer(T) -> t_integer(T); -t_from_term(T) when is_map(T) -> t_map(); +t_from_term(T) when is_map(T) -> + Pairs = [{t_from_term(K), ?mand, t_from_term(V)} + || {K, V} <- maps:to_list(T)], + {Stons, Rest} = lists:partition(fun({K,_,_}) -> is_singleton_type(K) end, + Pairs), + {DefK, DefV} + = lists:foldl(fun({K,_,V},{AK,AV}) -> {t_sup(K,AK), t_sup(V,AV)} end, + {t_none(), t_none()}, Rest), + t_map(lists:keysort(1, Stons), DefK, DefV); t_from_term(T) when is_pid(T) -> t_pid(); t_from_term(T) when is_port(T) -> t_port(); t_from_term(T) when is_reference(T) -> t_reference(); @@ -2225,6 +2570,13 @@ t_sup(?tuple_set(List1), T2 = ?tuple(_, Arity, _)) -> sup_tuple_sets(List1, [{Arity, [T2]}]); t_sup(?tuple(_, Arity, _) = T1, ?tuple_set(List2)) -> sup_tuple_sets([{Arity, [T1]}], List2); +t_sup(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> + Pairs = + map_pairwise_merge( + fun(K, MNess, V1, MNess, V2) -> {K, MNess, t_sup(V1, V2)}; + (K, _, V1, _, V2) -> {K, ?opt, t_sup(V1, V2)} + end, A, B), + t_map(Pairs, t_sup(ADefK, BDefK), t_sup(ADefV, BDefV)); t_sup(T1, T2) -> ?union(U1) = force_union(T1), ?union(U2) = force_union(T2), @@ -2343,7 +2695,7 @@ force_union(T = ?list(_, _, _)) -> ?list_union(T); force_union(T = ?nil) -> ?list_union(T); force_union(T = ?number(_, _)) -> ?number_union(T); force_union(T = ?opaque(_)) -> ?opaque_union(T); -force_union(T = ?map(_)) -> ?map_union(T); +force_union(T = ?map(_,_,_)) -> ?map_union(T); force_union(T = ?tuple(_, _, _)) -> ?tuple_union(T); force_union(T = ?tuple_set(_)) -> ?tuple_union(T); force_union(T = ?matchstate(_, _)) -> ?matchstate_union(T); @@ -2380,7 +2732,7 @@ t_elements(?number(_, _) = T) -> end; t_elements(?opaque(_) = T) -> do_elements(T); -t_elements(?map(_) = T) -> [T]; +t_elements(?map(_,_,_) = T) -> [T]; t_elements(?tuple(_, _, _) = T) -> [T]; t_elements(?tuple_set(_) = TS) -> case t_tuple_subtypes(TS) of @@ -2462,6 +2814,25 @@ t_inf(?identifier(Set1), ?identifier(Set2), _Opaques) -> ?none -> ?none; Set -> ?identifier(Set) end; +t_inf(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B, _Opaques) -> + %% Because it simplifies the anonymous function, we allow Pairs to temporarily + %% contain mandatory pairs with none values, since all such cases should + %% result in a none result. + Pairs = + map_pairwise_merge( + %% For optional keys in both maps, when the infinimum is none, we have + %% essentially concluded that K must not be a key in the map. + fun(K, ?opt, V1, ?opt, V2) -> {K, ?opt, t_inf(V1, V2)}; + %% When a key is optional in one map, but mandatory in another, it + %% becomes mandatory in the infinumum + (K, _, V1, _, V2) -> {K, ?mand, t_inf(V1, V2)} + end, A, B), + %% If the infinimum of any mandatory values is ?none, the entire map infinimum + %% is ?none. + case lists:any(fun({_,?mand,?none})->true; ({_,_,_}) -> false end, Pairs) of + true -> t_none(); + false -> t_map(Pairs, t_inf(ADefK, BDefK), t_inf(ADefV, BDefV)) + end; t_inf(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2), _Opaques) -> ?matchstate(t_inf(Pres1, Pres2), t_inf(Slots1, Slots2)); t_inf(?nil, ?nil, _Opaques) -> ?nil; @@ -2924,87 +3295,33 @@ findfirst(N1, N2, U1, B1, U2, B2) -> %%----------------------------------------------------------------------------- %% Substitution of variables %% -%% Dialyzer versions prior to R15B used a dict data structure to map variables -%% to types. Hans Bolinder suggested the use of lists of Key-Value pairs for -%% this data structure and measurements showed a non-trivial speedup when using -%% them for operations within this module (e.g. in t_unify/2). However, there -%% is code outside erl_types that still passes a dict:dict() in the 2nd argument. -%% So, for the time being, this module provides a t_subst/2 function for these -%% external calls and a clone of it (t_subst_kv/2) which is used from all calls -%% from within this module. This code duplication needs to be eliminated at -%% some point. - --spec t_subst(erl_type(), dict:dict(atom(), erl_type())) -> erl_type(). - -t_subst(T, Dict) -> + +-type subst_table() :: #{any() => erl_type()}. + +-spec t_subst(erl_type(), subst_table()) -> erl_type(). + +t_subst(T, Map) -> case t_has_var(T) of - true -> t_subst_dict(T, Dict); + true -> t_subst_aux(T, Map); false -> T end. -t_subst_dict(?var(Id), Dict) -> - case dict:find(Id, Dict) of - error -> ?any; - {ok, Type} -> Type - end; -t_subst_dict(?list(Contents, Termination, Size), Dict) -> - case t_subst_dict(Contents, Dict) of - ?none -> ?none; - NewContents -> - %% Be careful here to make the termination collapse if necessary. - case t_subst_dict(Termination, Dict) of - ?nil -> ?list(NewContents, ?nil, Size); - ?any -> ?list(NewContents, ?any, Size); - Other -> - ?list(NewContents2, NewTermination, _) = t_cons(NewContents, Other), - ?list(NewContents2, NewTermination, Size) - end - end; -t_subst_dict(?function(Domain, Range), Dict) -> - ?function(t_subst_dict(Domain, Dict), t_subst_dict(Range, Dict)); -t_subst_dict(?product(Types), Dict) -> - ?product([t_subst_dict(T, Dict) || T <- Types]); -t_subst_dict(?tuple(?any, ?any, ?any) = T, _Dict) -> - T; -t_subst_dict(?tuple(Elements, _Arity, _Tag), Dict) -> - t_tuple([t_subst_dict(E, Dict) || E <- Elements]); -t_subst_dict(?tuple_set(_) = TS, Dict) -> - t_sup([t_subst_dict(T, Dict) || T <- t_tuple_subtypes(TS)]); -t_subst_dict(?map(Pairs), Dict) -> - ?map([{t_subst_dict(K, Dict), t_subst_dict(V, Dict)} || - {K, V} <- Pairs]); -t_subst_dict(?opaque(Es), Dict) -> - List = [Opaque#opaque{args = [t_subst_dict(Arg, Dict) || Arg <- Args], - struct = t_subst_dict(S, Dict)} || - Opaque = #opaque{args = Args, struct = S} <- set_to_list(Es)], - ?opaque(ordsets:from_list(List)); -t_subst_dict(?union(List), Dict) -> - ?union([t_subst_dict(E, Dict) || E <- List]); -t_subst_dict(T, _Dict) -> - T. - -spec subst_all_vars_to_any(erl_type()) -> erl_type(). subst_all_vars_to_any(T) -> - t_subst_kv(T, []). - -t_subst_kv(T, KVMap) -> - case t_has_var(T) of - true -> t_subst_aux(T, KVMap); - false -> T - end. + t_subst(T, #{}). -t_subst_aux(?var(Id), VarMap) -> - case lists:keyfind(Id, 1, VarMap) of - false -> ?any; - {Id, Type} -> Type +t_subst_aux(?var(Id), Map) -> + case maps:find(Id, Map) of + error -> ?any; + {ok, Type} -> Type end; -t_subst_aux(?list(Contents, Termination, Size), VarMap) -> - case t_subst_aux(Contents, VarMap) of +t_subst_aux(?list(Contents, Termination, Size), Map) -> + case t_subst_aux(Contents, Map) of ?none -> ?none; NewContents -> %% Be careful here to make the termination collapse if necessary. - case t_subst_aux(Termination, VarMap) of + case t_subst_aux(Termination, Map) of ?nil -> ?list(NewContents, ?nil, Size); ?any -> ?list(NewContents, ?any, Size); Other -> @@ -3012,27 +3329,27 @@ t_subst_aux(?list(Contents, Termination, Size), VarMap) -> ?list(NewContents2, NewTermination, Size) end end; -t_subst_aux(?function(Domain, Range), VarMap) -> - ?function(t_subst_aux(Domain, VarMap), t_subst_aux(Range, VarMap)); -t_subst_aux(?product(Types), VarMap) -> - ?product([t_subst_aux(T, VarMap) || T <- Types]); -t_subst_aux(?tuple(?any, ?any, ?any) = T, _VarMap) -> +t_subst_aux(?function(Domain, Range), Map) -> + ?function(t_subst_aux(Domain, Map), t_subst_aux(Range, Map)); +t_subst_aux(?product(Types), Map) -> + ?product([t_subst_aux(T, Map) || T <- Types]); +t_subst_aux(?tuple(?any, ?any, ?any) = T, _Map) -> T; -t_subst_aux(?tuple(Elements, _Arity, _Tag), VarMap) -> - t_tuple([t_subst_aux(E, VarMap) || E <- Elements]); -t_subst_aux(?tuple_set(_) = TS, VarMap) -> - t_sup([t_subst_aux(T, VarMap) || T <- t_tuple_subtypes(TS)]); -t_subst_aux(?map(Pairs), VarMap) -> - ?map([{t_subst_aux(K, VarMap), t_subst_aux(V, VarMap)} || - {K, V} <- Pairs]); -t_subst_aux(?opaque(Es), VarMap) -> - List = [Opaque#opaque{args = [t_subst_aux(Arg, VarMap) || Arg <- Args], - struct = t_subst_aux(S, VarMap)} || - Opaque = #opaque{args = Args, struct = S} <- set_to_list(Es)], - ?opaque(ordsets:from_list(List)); -t_subst_aux(?union(List), VarMap) -> - ?union([t_subst_aux(E, VarMap) || E <- List]); -t_subst_aux(T, _VarMap) -> +t_subst_aux(?tuple(Elements, _Arity, _Tag), Map) -> + t_tuple([t_subst_aux(E, Map) || E <- Elements]); +t_subst_aux(?tuple_set(_) = TS, Map) -> + t_sup([t_subst_aux(T, Map) || T <- t_tuple_subtypes(TS)]); +t_subst_aux(?map(Pairs, DefK, DefV), Map) -> + t_map([{K, MNess, t_subst_aux(V, Map)} || {K, MNess, V} <- Pairs], + t_subst_aux(DefK, Map), t_subst_aux(DefV, Map)); +t_subst_aux(?opaque(Es), Map) -> + List = [Opaque#opaque{args = [t_subst_aux(Arg, Map) || Arg <- Args], + struct = t_subst_aux(S, Map)} || + Opaque = #opaque{args = Args, struct = S} <- set_to_list(Es)], + ?opaque(ordsets:from_list(List)); +t_subst_aux(?union(List), Map) -> + ?union([t_subst_aux(E, Map) || E <- List]); +t_subst_aux(T, _Map) -> T. %%----------------------------------------------------------------------------- @@ -3044,33 +3361,33 @@ t_subst_aux(T, _VarMap) -> -spec t_unify(erl_type(), erl_type()) -> t_unify_ret(). t_unify(T1, T2) -> - {T, VarMap} = t_unify(T1, T2, []), - {t_subst_kv(T, VarMap), lists:keysort(1, VarMap)}. + {T, VarMap} = t_unify(T1, T2, #{}), + {t_subst(T, VarMap), lists:keysort(1, maps:to_list(VarMap))}. t_unify(?var(Id) = T, ?var(Id), VarMap) -> {T, VarMap}; t_unify(?var(Id1) = T, ?var(Id2), VarMap) -> - case lists:keyfind(Id1, 1, VarMap) of - false -> - case lists:keyfind(Id2, 1, VarMap) of - false -> {T, [{Id2, T} | VarMap]}; - {Id2, Type} -> t_unify(T, Type, VarMap) + case maps:find(Id1, VarMap) of + error -> + case maps:find(Id2, VarMap) of + error -> {T, VarMap#{Id2 => T}}; + {ok, Type} -> t_unify(T, Type, VarMap) end; - {Id1, Type1} -> - case lists:keyfind(Id2, 1, VarMap) of - false -> {Type1, [{Id2, T} | VarMap]}; - {Id2, Type2} -> t_unify(Type1, Type2, VarMap) + {ok, Type1} -> + case maps:find(Id2, VarMap) of + error -> {Type1, VarMap#{Id2 => T}}; + {ok, Type2} -> t_unify(Type1, Type2, VarMap) end end; t_unify(?var(Id), Type, VarMap) -> - case lists:keyfind(Id, 1, VarMap) of - false -> {Type, [{Id, Type} | VarMap]}; - {Id, VarType} -> t_unify(VarType, Type, VarMap) + case maps:find(Id, VarMap) of + error -> {Type, VarMap#{Id => Type}}; + {ok, VarType} -> t_unify(VarType, Type, VarMap) end; t_unify(Type, ?var(Id), VarMap) -> - case lists:keyfind(Id, 1, VarMap) of - false -> {Type, [{Id, Type} | VarMap]}; - {Id, VarType} -> t_unify(VarType, Type, VarMap) + case maps:find(Id, VarMap) of + error -> {Type, VarMap#{Id => Type}}; + {ok, VarType} -> t_unify(VarType, Type, VarMap) end; t_unify(?function(Domain1, Range1), ?function(Domain2, Range2), VarMap) -> {Domain, VarMap1} = t_unify(Domain1, Domain2, VarMap), @@ -3104,6 +3421,23 @@ t_unify(?tuple_set(List1) = T1, ?tuple_set(List2) = T2, VarMap) -> {Tuples, NewVarMap} -> {t_sup(Tuples), NewVarMap} catch _:_ -> throw({mismatch, T1, T2}) end; +t_unify(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B, VarMap0) -> + {DefK, VarMap1} = t_unify(ADefK, BDefK, VarMap0), + {DefV, VarMap2} = t_unify(ADefV, BDefV, VarMap1), + {Pairs, VarMap} = + map_pairwise_merge_foldr( + fun(K, MNess, V1, MNess, V2, {Pairs0, VarMap3}) -> + %% We know that the keys unify and do not contain variables, or they + %% would not be singletons + %% TODO: Should V=?none (known missing keys) be handled special? + {V, VarMap4} = t_unify(V1, V2, VarMap3), + {[{K,MNess,V}|Pairs0], VarMap4}; + (K, _, V1, _, V2, {Pairs0, VarMap3}) -> + %% One mandatory and one optional; what should be done in this case? + {V, VarMap4} = t_unify(V1, V2, VarMap3), + {[{K,?mand,V}|Pairs0], VarMap4} + end, {[], VarMap2}, A, B), + {t_map(Pairs, DefK, DefV), VarMap}; t_unify(?opaque(_) = T1, ?opaque(_) = T2, VarMap) -> t_unify(t_opaque_structure(T1), t_opaque_structure(T2), VarMap); t_unify(T1, ?opaque(_) = T2, VarMap) -> @@ -3307,7 +3641,7 @@ t_subtract_list(T, []) -> -spec t_subtract(erl_type(), erl_type()) -> erl_type(). t_subtract(_, ?any) -> ?none; -t_subtract(_, ?var(_)) -> ?none; +t_subtract(T, ?var(_)) -> T; t_subtract(?any, _) -> ?any; t_subtract(?var(_) = T, _) -> T; t_subtract(T, ?unit) -> T; @@ -3460,8 +3794,50 @@ t_subtract(?product(Elements1) = T1, ?product(Elements2)) -> _ -> T1 end end; -t_subtract(?map(_) = T, _) -> % XXX: very crude; will probably need refinement - T; +t_subtract(?map(APairs, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> + case t_is_subtype(ADefK, BDefK) andalso t_is_subtype(ADefV, BDefV) of + false -> A; + true -> + %% We fold over the maps to produce a list of constraints, where + %% constraints are additional key-value pairs to put in Pairs. Only one + %% constraint need to be applied to produce a type that excludes the + %% right-hand-side type, so if more than one constraint is produced, we + %% just return the left-hand-side argument. + %% + %% Each case of the fold may either conclude that + %% * The arguments constrain A at least as much as B, i.e. that A so far + %% is a subtype of B. In that case they return false + %% * That for the particular arguments, A being a subtype of B does not + %% hold, but the infinimum of A and B is nonempty, and by narrowing a + %% pair in A, we can create a type that excludes some elements in the + %% infinumum. In that case, they will return that pair. + %% * That for the particular arguments, A being a subtype of B does not + %% hold, and either the infinumum of A and B is empty, or it is not + %% possible with the current representation to create a type that + %% excludes elements from B without also excluding elements that are + %% only in A. In that case, it will return the pair from A unchanged. + case + map_pairwise_merge( + %% If V1 is a subtype of V2, the case that K does not exist in A + %% remain. + fun(K, ?opt, V1, ?mand, V2) -> {K, ?opt, t_subtract(V1, V2)}; + (K, _, V1, _, V2) -> + %% If we subtract an optional key, that leaves a mandatory key + case t_subtract(V1, V2) of + ?none -> false; + Partial -> {K, ?mand, Partial} + end + end, A, B) + of + %% We produce a list of keys that are constrained. As only one of + %% these should apply at a time, we can't represent the difference if + %% more than one constraint is produced. If we applied all of them, + %% that would make an underapproximation, which we must not do. + [] -> ?none; %% A is a subtype of B + [E] -> t_map(mapdict_store(E, APairs), ADefK, ADefV); + _ -> A + end + end; t_subtract(?product(P1), _) -> ?product(P1); t_subtract(T, ?product(_)) -> @@ -3592,6 +3968,11 @@ subtype_is_equal(T1, T2) -> t_is_instance(ConcreteType, Type) -> t_is_subtype(ConcreteType, t_unopaque(Type)). +-spec t_do_overlap(erl_type(), erl_type()) -> boolean(). + +t_do_overlap(TypeA, TypeB) -> + not (t_is_none_or_unit(t_inf(TypeA, TypeB))). + -spec t_unopaque(erl_type()) -> erl_type(). t_unopaque(T) -> @@ -3622,12 +4003,17 @@ t_unopaque(?union([A,B,F,I,L,N,T,M,O,Map]), Opaques) -> UL = t_unopaque(L, Opaques), UT = t_unopaque(T, Opaques), UF = t_unopaque(F, Opaques), + UM = t_unopaque(M, Opaques), UMap = t_unopaque(Map, Opaques), {OF,UO} = case t_unopaque(O, Opaques) of ?opaque(_) = O1 -> {O1, []}; Type -> {?none, [Type]} end, - t_sup([?union([A,B,UF,I,UL,N,UT,M,OF,UMap])|UO]); + t_sup([?union([A,B,UF,I,UL,N,UT,UM,OF,UMap])|UO]); +t_unopaque(?map(Pairs,DefK,DefV), Opaques) -> + t_map([{K, MNess, t_unopaque(V, Opaques)} || {K, MNess, V} <- Pairs], + t_unopaque(DefK, Opaques), + t_unopaque(DefV, Opaques)); t_unopaque(T, _) -> T. @@ -3679,6 +4065,16 @@ t_limit_k(?opaque(Es), K) -> Opaque#opaque{struct = NewS} end || #opaque{struct = S} = Opaque <- set_to_list(Es)], ?opaque(ordsets:from_list(List)); +t_limit_k(?map(Pairs0, DefK0, DefV0), K) -> + Fun = fun({EK, MNess, EV}, {Exact, DefK1, DefV1}) -> + LV = t_limit_k(EV, K - 1), + case t_limit_k(EK, K - 1) of + EK -> {[{EK,MNess,LV}|Exact], DefK1, DefV1}; + LK -> {Exact, t_sup(LK, DefK1), t_sup(LV, DefV1)} + end + end, + {Pairs, DefK2, DefV2} = lists:foldr(Fun, {[], DefK0, DefV0}, Pairs0), + t_map(Pairs, t_limit_k(DefK2, K - 1), t_limit_k(DefV2, K - 1)); t_limit_k(T, _K) -> T. %%============================================================================ @@ -3753,6 +4149,9 @@ t_map(Fun, ?opaque(Set)) -> [] -> ?none; _ -> ?opaque(ordsets:from_list(L)) end); +t_map(Fun, ?map(Pairs,DefK,DefV)) -> + %% TODO: + Fun(t_map(Pairs, Fun(DefK), Fun(DefV))); t_map(Fun, T) -> Fun(T). @@ -3894,8 +4293,23 @@ t_to_string(?float, _RecDict) -> "float()"; t_to_string(?number(?any, ?unknown_qual), _RecDict) -> "number()"; t_to_string(?product(List), RecDict) -> "<" ++ comma_sequence(List, RecDict) ++ ">"; -t_to_string(?map(Pairs), RecDict) -> - "#{" ++ map_pairs_to_string(Pairs,RecDict) ++ "}"; +t_to_string(?map([],?any,?any), _RecDict) -> "map()"; +t_to_string(?map(Pairs0,DefK,DefV), RecDict) -> + {Pairs, ExtraEl} = + case {DefK, DefV} of + {?none, ?none} -> {Pairs0, []}; + {?any, ?any} -> {Pairs0, ["..."]}; + _ -> {Pairs0 ++ [{DefK,?opt,DefV}], []} + end, + Tos = fun(T) -> case T of + ?any -> "_"; + _ -> t_to_string(T, RecDict) + end end, + StrMand = [{Tos(K),Tos(V)}||{K,?mand,V}<-Pairs], + StrOpt = [{Tos(K),Tos(V)}||{K,?opt,V}<-Pairs], + "#{" ++ string:join([K ++ ":=" ++ V||{K,V}<-StrMand] + ++ [K ++ "=>" ++ V||{K,V}<-StrOpt] + ++ ExtraEl, ", ") ++ "}"; t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()"; t_to_string(?tuple(Elements, _Arity, ?any), RecDict) -> "{" ++ comma_sequence(Elements, RecDict) ++ "}"; @@ -3916,12 +4330,6 @@ t_to_string(?var(Id), _RecDict) when is_integer(Id) -> flat_format("var(~w)", [Id]). -map_pairs_to_string([],_) -> []; -map_pairs_to_string(Pairs,RecDict) -> - StrPairs = [{t_to_string(K,RecDict),t_to_string(V,RecDict)}||{K,V}<-Pairs], - string:join([K ++ "=>" ++ V||{K,V}<-StrPairs], ", "). - - record_to_string(Tag, [_|Fields], FieldNames, RecDict) -> FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []), "#" ++ atom_to_string(Tag) ++ "{" ++ string:join(FieldStrings, ",") ++ "}". @@ -4010,7 +4418,7 @@ mod_name(Mod, Name) -> site(), mod_records()) -> erl_type(). t_from_form(Form, ExpTypes, Site, RecDict) -> - t_from_form(Form, ExpTypes, Site, RecDict, dict:new()). + t_from_form(Form, ExpTypes, Site, RecDict, maps:new()). -spec t_from_form(parse_form(), sets:set(mfa()), site(), mod_records(), var_table()) -> erl_type(). @@ -4027,7 +4435,7 @@ t_from_form_without_remote(Form, Site, TypeTable) -> Module = site_module(Site), RecDict = dict:from_list([{Module, TypeTable}]), ExpTypes = replace_by_none, - {T, _} = t_from_form1(Form, ExpTypes, Site, RecDict, dict:new()), + {T, _} = t_from_form1(Form, ExpTypes, Site, RecDict, maps:new()), T. %% REC_TYPE_LIMIT is used for limiting the depth of recursive types. @@ -4083,7 +4491,7 @@ t_from_form(_, _TypeNames, _ET, _S, _MR, _V, D, L) when D =< 0 ; L =< 0 -> t_from_form({var, _L, '_'}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_any(), L}; t_from_form({var, _L, Name}, _TypeNames, _ET, _S, _MR, V, _D, L) -> - case dict:find(Name, V) of + case maps:find(Name, V) of error -> {t_var(Name), L}; {ok, Val} -> {Val, L} end; @@ -4149,7 +4557,7 @@ t_from_form({type, _L, 'fun', [{type, _, any}, Range]}, TypeNames, t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, TypeNames, ET, S, MR, V, D, L) -> {Dom1, L1} = list_from_form(Domain, TypeNames, ET, S, MR, V, D, L), - {Ran1, L2} = t_from_form(Range, TypeNames, ET, S, MR, V, D - 1, L1), + {Ran1, L2} = t_from_form(Range, TypeNames, ET, S, MR, V, D, L1), {t_fun(Dom1, Ran1), L2}; t_from_form({type, _L, identifier, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_identifier(), L}; @@ -4164,8 +4572,26 @@ t_from_form({type, _L, list, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> t_from_form({type, _L, list, [Type]}, TypeNames, ET, S, MR, V, D, L) -> {T, L1} = t_from_form(Type, TypeNames, ET, S, MR, V, D - 1, L - 1), {t_list(T), L1}; -t_from_form({type, _L, map, _}, TypeNames, ET, S, MR, V, D, L) -> - builtin_type(map, t_map([]), TypeNames, ET, S, MR, V, D, L); +t_from_form({type, _L, map, any}, TypeNames, ET, S, MR, V, D, L) -> + builtin_type(map, t_map(), TypeNames, ET, S, MR, V, D, L); +t_from_form({type, _L, map, List}, TypeNames, ET, S, MR, V, D, L) -> + {Pairs1, L5} = + fun PairsFromForm(_, L1) when L1 =< 0 -> {[{?any,?opt,?any}], L1}; + PairsFromForm([], L1) -> {[], L1}; + PairsFromForm([{type, _, Oper, [KF, VF]}|T], L1) -> + {Key, L2} = t_from_form(KF, TypeNames, ET, S, MR, V, D - 1, L1), + {Val, L3} = t_from_form(VF, TypeNames, ET, S, MR, V, D - 1, L2), + {Pairs0, L4} = PairsFromForm(T, L3 - 1), + case Oper of + map_field_assoc -> {[{Key,?opt, Val}|Pairs0], L4}; + map_field_exact -> {[{Key,?mand,Val}|Pairs0], L4} + end + end(List, L), + try + {Pairs, DefK, DefV} = map_from_form(Pairs1, [], [], [], ?none, ?none), + {t_map(Pairs, DefK, DefV), L5} + catch none -> {t_none(), L5} + end; t_from_form({type, _L, mfa, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> {t_mfa(), L}; t_from_form({type, _L, module, []}, _TypeNames, _ET, _S, _MR, _V, _D, L) -> @@ -4284,7 +4710,7 @@ type_from_form(Name, Args, TypeNames, ET, Site0, MR, V, D, L) -> {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, Site0, MR, V, D, L), List = lists:zip(ArgNames, ArgTypes), - TmpV = dict:from_list(List), + TmpV = maps:from_list(List), Site = TypeName, t_from_form(Form, NewTypeNames, ET, Site, MR, TmpV, D, L1); false -> @@ -4297,7 +4723,7 @@ type_from_form(Name, Args, TypeNames, ET, Site0, MR, V, D, L) -> {ArgTypes, L1} = list_from_form(Args, NewTypeNames, ET, Site0, MR, V, D, L), List = lists:zip(ArgNames, ArgTypes), - TmpV = dict:from_list(List), + TmpV = maps:from_list(List), Site = TypeName, {Rep, L2} = t_from_form(Form, NewTypeNames, ET, Site, MR, TmpV, D, L1), @@ -4339,7 +4765,7 @@ remote_from_form(RemMod, Name, Args, TypeNames, ET, S, MR, V, D, L) -> {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, S, MR, V, D, L), List = lists:zip(ArgNames, ArgTypes), - TmpVarDict = dict:from_list(List), + TmpVarDict = maps:from_list(List), Site = RemType, t_from_form(Form, NewTypeNames, ET, Site, MR, TmpVarDict, D, L1); @@ -4353,7 +4779,7 @@ remote_from_form(RemMod, Name, Args, TypeNames, ET, S, MR, V, D, L) -> {ArgTypes, L1} = list_from_form(Args, NewTypeNames, ET, S, MR, V, D, L), List = lists:zip(ArgNames, ArgTypes), - TmpVarDict = dict:from_list(List), + TmpVarDict = maps:from_list(List), Site = RemType, {NewRep, L2} = t_from_form(Form, NewTypeNames, ET, Site, MR, @@ -4424,7 +4850,7 @@ record_from_form({atom, _, Name}, ModFields, TypeNames, ET, S, MR, V, D, L) -> {ok, NewFields} -> {NewFields1, L2} = fields_from_form(NewFields, NewTypeNames, ET, S1, MR, - dict:new(), D, L1), + maps:new(), D, L1), Rec = t_tuple( [t_atom(Name)|[Type || {_FieldName, Type} <- NewFields1]]), @@ -4495,11 +4921,55 @@ list_from_form([H|Tail], TypeNames, ET, S, MR, V, D, L) -> {T1, L2} = list_from_form(Tail, TypeNames, ET, S, MR, V, D, L1), {[H1|T1], L2}. +%% Sorts, combines non-singleton pairs, and applies precendence and +%% mandatoriness rules. +map_from_form([], ShdwPs, MKs, Pairs, DefK, DefV) -> + verify_possible(MKs, ShdwPs), + {promote_to_mand(MKs, Pairs), DefK, DefV}; +map_from_form([{SKey,MNess,Val}|SPairs], ShdwPs0, MKs0, Pairs0, DefK0, DefV0) -> + Key = lists:foldl(fun({K,_},S)->t_subtract(S,K)end, SKey, ShdwPs0), + ShdwPs = case Key of ?none -> ShdwPs0; _ -> [{Key,Val}|ShdwPs0] end, + MKs = case MNess of ?mand -> [SKey|MKs0]; ?opt -> MKs0 end, + if MNess =:= ?mand, SKey =:= ?none -> throw(none); + true -> ok + end, + {Pairs, DefK, DefV} = + case is_singleton_type(Key) of + true -> + MNess1 = case Val =:= ?none of true -> ?opt; false -> MNess end, + {mapdict_insert({Key,MNess1,Val}, Pairs0), DefK0, DefV0}; + false -> + case Key =:= ?none orelse Val =:= ?none of + true -> {Pairs0, DefK0, DefV0}; + false -> {Pairs0, t_sup(DefK0, Key), t_sup(DefV0, Val)} + end + end, + map_from_form(SPairs, ShdwPs, MKs, Pairs, DefK, DefV). + +%% Verifies that all mandatory keys are possible, throws 'none' otherwise +verify_possible(MKs, ShdwPs) -> + lists:foreach(fun(M) -> verify_possible_1(M, ShdwPs) end, MKs). + +verify_possible_1(M, ShdwPs) -> + case lists:any(fun({K,_}) -> t_inf(M, K) =/= ?none end, ShdwPs) of + true -> ok; + false -> throw(none) + end. + +-spec promote_to_mand([erl_type()], t_map_dict()) -> t_map_dict(). + +promote_to_mand(_, []) -> []; +promote_to_mand(MKs, [E={K,_,V}|T]) -> + [case lists:any(fun(M) -> t_is_equal(K,M) end, MKs) of + true -> {K, ?mand, V}; + false -> E + end|promote_to_mand(MKs, T)]. + -spec t_check_record_fields(parse_form(), sets:set(mfa()), site(), mod_records()) -> ok. t_check_record_fields(Form, ExpTypes, Site, RecDict) -> - t_check_record_fields(Form, ExpTypes, Site, RecDict, dict:new()). + t_check_record_fields(Form, ExpTypes, Site, RecDict, maps:new()). -spec t_check_record_fields(parse_form(), sets:set(mfa()), site(), mod_records(), var_table()) -> ok. @@ -4627,8 +5097,13 @@ t_form_to_string({type, _L, iodata, []}) -> "iodata()"; t_form_to_string({type, _L, iolist, []}) -> "iolist()"; t_form_to_string({type, _L, list, [Type]}) -> "[" ++ t_form_to_string(Type) ++ "]"; -t_form_to_string({type, _L, map, _}) -> - "#{}"; +t_form_to_string({type, _L, map, any}) -> "map()"; +t_form_to_string({type, _L, map, Args}) -> + "#{" ++ string:join(t_form_to_string_list(Args), ",") ++ "}"; +t_form_to_string({type, _L, map_field_assoc, [Key, Val]}) -> + t_form_to_string(Key) ++ "=>" ++ t_form_to_string(Val); +t_form_to_string({type, _L, map_field_exact, [Key, Val]}) -> + t_form_to_string(Key) ++ ":=" ++ t_form_to_string(Val); t_form_to_string({type, _L, mfa, []}) -> "mfa()"; t_form_to_string({type, _L, module, []}) -> "module()"; t_form_to_string({type, _L, node, []}) -> "node()"; @@ -4663,8 +5138,9 @@ t_form_to_string({type, _L, Name, []} = T) -> D0 = dict:new(), MR = dict:from_list([{M, D0}]), S = {type, {M,Name,0}}, + V = #{}, {T1, _} = - t_from_form(T, [], sets:new(), S, MR, D0, _Deep=1000, _ALot=100000), + t_from_form(T, [], sets:new(), S, MR, V, _Deep=1000, _ALot=100000), t_to_string(T1) catch throw:{error, _} -> atom_to_string(Name) ++ "()" end; @@ -4789,11 +5265,70 @@ do_opaque(?union(List) = Type, Opaques, Pred) -> do_opaque(Type, _Opaques, Pred) -> Pred(Type). -map_keys(?map(Pairs)) -> - [K || {K, _} <- Pairs]. +map_all_values(?map(Pairs,_,DefV)) -> + [DefV|[V || {V, _, _} <- Pairs]]. + +map_all_keys(?map(Pairs,DefK,_)) -> + [DefK|[K || {_, _, K} <- Pairs]]. + +map_all_types(M) -> + map_all_keys(M) ++ map_all_values(M). + +%% Tests if a type has exactly one possible value. +-spec t_is_singleton(erl_type()) -> boolean(). + +t_is_singleton(Type) -> + t_is_singleton(Type, 'universe'). + +-spec t_is_singleton(erl_type(), opaques()) -> boolean(). + +t_is_singleton(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_singleton_type/1). + +%% Incomplete; not all representable singleton types are included. +is_singleton_type(?nil) -> true; +is_singleton_type(?atom(?any)) -> false; +is_singleton_type(?atom(Set)) -> + ordsets:size(Set) =:= 1; +is_singleton_type(?int_range(V, V)) -> true; +is_singleton_type(?int_set(Set)) -> + ordsets:size(Set) =:= 1; +is_singleton_type(?tuple(Types, Arity, _)) when is_integer(Arity) -> + lists:all(fun is_singleton_type/1, Types); +is_singleton_type(?tuple_set([{Arity, [OnlyTuple]}])) when is_integer(Arity) -> + is_singleton_type(OnlyTuple); +is_singleton_type(?map(Pairs, ?none, ?none)) -> + lists:all(fun({_,MNess,V}) -> MNess =:= ?mand andalso is_singleton_type(V) + end, Pairs); +is_singleton_type(_) -> + false. + +%% Returns the only possible value of a singleton type. +-spec t_singleton_to_term(erl_type(), opaques()) -> term(). + +t_singleton_to_term(Type, Opaques) -> + do_opaque(Type, Opaques, fun singleton_type_to_term/1). -map_values(?map(Pairs)) -> - [V || {_, V} <- Pairs]. +singleton_type_to_term(?nil) -> []; +singleton_type_to_term(?atom(Set)) when Set =/= ?any -> + case ordsets:size(Set) of + 1 -> hd(ordsets:to_list(Set)); + _ -> error(badarg) + end; +singleton_type_to_term(?int_range(V, V)) -> V; +singleton_type_to_term(?int_set(Set)) -> + case ordsets:size(Set) of + 1 -> hd(ordsets:to_list(Set)); + _ -> error(badarg) + end; +singleton_type_to_term(?tuple(Types, Arity, _)) when is_integer(Arity) -> + lists:map(fun singleton_type_to_term/1, Types); +singleton_type_to_term(?tuple_set([{Arity, [OnlyTuple]}])) + when is_integer(Arity) -> + singleton_type_to_term(OnlyTuple); +singleton_type_to_term(?map(Pairs, ?none, ?none)) -> + maps:from_list([{singleton_type_to_term(K), singleton_type_to_term(V)} + || {K,?mand,V} <- Pairs]). %% ----------------------------------- %% Set diff --git a/lib/hipe/test/hipe_SUITE.erl b/lib/hipe/test/hipe_SUITE.erl index 9319b710d9..a5b3924aa8 100644 --- a/lib/hipe/test/hipe_SUITE.erl +++ b/lib/hipe/test/hipe_SUITE.erl @@ -19,9 +19,6 @@ -compile([export_all]). -include_lib("common_test/include/ct.hrl"). -suite() -> - [{ct_hooks, [ts_install_cth]}]. - all() -> [app, appup]. diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index bd6b76a73e..5cebce18a9 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,25 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.2.2</title> + <section><title>Inets 6.2.3</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Put back unused module inets_regexp and remove it in OTP + 19 instead as it is an incompatibility, although it is an + undocumented module and should not affect other + applications.</p> + <p> + Own Id: OTP-13533</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.2.2</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile index 1d870c14e8..a294381f67 100644 --- a/lib/inets/src/inets_app/Makefile +++ b/lib/inets/src/inets_app/Makefile @@ -49,7 +49,8 @@ MODULES = \ inets_sup \ inets_trace \ inets_lib \ - inets_time_compat + inets_time_compat \ + inets_regexp INTERNAL_HRL_FILES = inets_internal.hrl EXTERNAL_HRL_FILES = ../../include/httpd.hrl \ diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index 5706a335d7..abf8c0cdea 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -29,6 +29,7 @@ inets_trace, inets_lib, inets_time_compat, + inets_regexp, %% FTP ftp, diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index a603357ebd..3a31daeb20 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,16 +18,10 @@ %% %CopyrightEnd% {"%VSN%", [ - {<<"6.2.1">>, [{load_module, httpd_script_env, soft_purge, soft_purge, []}]}, - {<<"6.2">>, [{load_module, httpd_script_env, soft_purge, soft_purge, []}, - {load_module, httpc, soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ], [ - {<<"6.2.1">>, [{load_module, httpd_script_env, soft_purge, soft_purge, []}]}, - {<<"6.2">>, [{load_module, httpd_script_env, soft_purge, soft_purge, []}, - {load_module, httpc, soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ] diff --git a/lib/inets/src/inets_app/inets_regexp.erl b/lib/inets/src/inets_app/inets_regexp.erl new file mode 100644 index 0000000000..fc1608bc5a --- /dev/null +++ b/lib/inets/src/inets_app/inets_regexp.erl @@ -0,0 +1,414 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(inets_regexp). + +-export([parse/1, match/2, first_match/2, split/2, sub/3, gsub/3]). + + +%%%========================================================================= +%%% API +%%%========================================================================= + +%% parse(RegExp) -> {ok, RE} | {error, E}. +%% Parse the regexp described in the string RegExp. + +parse(S) -> + case (catch reg(S)) of + {R, []} -> + {ok, R}; + {_R, [C|_]} -> + {error, {illegal, [C]}}; + {error, E} -> + {error, E} + end. + + +%% Find the longest match of RegExp in String. + +match(S, RegExp) when is_list(RegExp) -> + case parse(RegExp) of + {ok,RE} -> match(S, RE); + {error,E} -> {error,E} + end; +match(S, RE) -> + case match(RE, S, 1, 0, -1) of + {Start,Len} when Len >= 0 -> + {match, Start, Len}; + {_Start,_Len} -> + nomatch + end. + +%% Find the first match of RegExp in String. + +first_match(S, RegExp) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + first_match(S, RE); + {error, E} -> + {error, E} + end; +first_match(S, RE) -> + case first_match(RE, S, 1) of + {Start,Len} when Len >= 0 -> + {match, Start,Len}; + nomatch -> + nomatch + end. + +first_match(RE, S, St) when S =/= [] -> + case re_apply(S, St, RE) of + {match, P, _Rest} -> + {St, P-St}; + nomatch -> + first_match(RE, tl(S), St+1) + end; +first_match(_RE, [], _St) -> + nomatch. + + +match(RE, S, St, Pos, L) -> + case first_match(RE, S, St) of + {St1, L1} -> + Nst = St1 + 1, + if L1 > L -> + match(RE, lists:nthtail(Nst-St, S), Nst, St1, L1); + true -> + match(RE, lists:nthtail(Nst-St, S), Nst, Pos, L) + end; + nomatch -> + {Pos, L} + end. + + +%% Split a string into substrings where the RegExp describes the +%% field seperator. The RegExp " " is specially treated. + +split(String, " ") -> %This is really special + {ok, RE} = parse("[ \t]+"), + case split_apply(String, RE, true) of + [[]|Ss] -> + {ok,Ss}; + Ss -> + {ok,Ss} + end; +split(String, RegExp) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + {ok, split_apply(String, RE, false)}; + {error, E} -> + {error,E} + end; +split(String, RE) -> + {ok, split_apply(String, RE, false)}. + + +%% Substitute the first match of the regular expression RegExp +%% with the string Replace in String. Accept pre-parsed regular +%% expressions. + +sub(String, RegExp, Rep) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + sub(String, RE, Rep); + {error, E} -> + {error, E} + end; +sub(String, RE, Rep) -> + Ss = sub_match(String, RE, 1), + {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}. + + +%% Substitute every match of the regular expression RegExp with +%% the string New in String. Accept pre-parsed regular expressions. + +gsub(String, RegExp, Rep) when is_list(RegExp) -> + case parse(RegExp) of + {ok, RE} -> + gsub(String, RE, Rep); + {error, E} -> + {error, E} + end; +gsub(String, RE, Rep) -> + Ss = matches(String, RE, 1), + {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}. + + +%%%======================================================================== +%%% Internal functions +%%%======================================================================== + +%% This is the regular expression grammar used. It is equivalent to the +%% one used in AWK, except that we allow ^ $ to be used anywhere and fail +%% in the matching. +%% +%% reg -> reg1 : '$1'. +%% reg1 -> reg1 "|" reg2 : {'or','$1','$2'}. +%% reg1 -> reg2 : '$1'. +%% reg2 -> reg2 reg3 : {concat,'$1','$2'}. +%% reg2 -> reg3 : '$1'. +%% reg3 -> reg3 "*" : {kclosure,'$1'}. +%% reg3 -> reg3 "+" : {pclosure,'$1'}. +%% reg3 -> reg3 "?" : {optional,'$1'}. +%% reg3 -> reg4 : '$1'. +%% reg4 -> "(" reg ")" : '$2'. +%% reg4 -> "\\" char : '$2'. +%% reg4 -> "^" : bos. +%% reg4 -> "$" : eos. +%% reg4 -> "." : char. +%% reg4 -> "[" class "]" : {char_class,char_class('$2')} +%% reg4 -> "[" "^" class "]" : {comp_class,char_class('$3')} +%% reg4 -> "\"" chars "\"" : char_string('$2') +%% reg4 -> char : '$1'. +%% reg4 -> empty : epsilon. +%% The grammar of the current regular expressions. The actual parser +%% is a recursive descent implementation of the grammar. + +reg(S) -> reg1(S). + +%% reg1 -> reg2 reg1' +%% reg1' -> "|" reg2 +%% reg1' -> empty + +reg1(S0) -> + {L,S1} = reg2(S0), + reg1p(S1, L). + +reg1p([$||S0], L) -> + {R,S1} = reg2(S0), + reg1p(S1, {'or',L,R}); +reg1p(S, L) -> {L,S}. + +%% reg2 -> reg3 reg2' +%% reg2' -> reg3 +%% reg2' -> empty + +reg2(S0) -> + {L,S1} = reg3(S0), + reg2p(S1, L). + +reg2p([C|S0], L) when (C =/= $|) andalso (C =/= $)) -> + {R,S1} = reg3([C|S0]), + reg2p(S1, {concat,L,R}); +reg2p(S, L) -> {L,S}. + +%% reg3 -> reg4 reg3' +%% reg3' -> "*" reg3' +%% reg3' -> "+" reg3' +%% reg3' -> "?" reg3' +%% reg3' -> empty + +reg3(S0) -> + {L,S1} = reg4(S0), + reg3p(S1, L). + +reg3p([$*|S], L) -> reg3p(S, {kclosure,L}); +reg3p([$+|S], L) -> reg3p(S, {pclosure,L}); +reg3p([$?|S], L) -> reg3p(S, {optional,L}); +reg3p(S, L) -> {L,S}. + +reg4([$(|S0]) -> + case reg(S0) of + {R,[$)|S1]} -> {R,S1}; + {_R,_S} -> throw({error,{unterminated,"("}}) + end; +reg4([$\\,O1,O2,O3|S]) + when ((O1 >= $0) andalso + (O1 =< $7) andalso + (O2 >= $0) andalso + (O2 =< $7) andalso + (O3 >= $0) andalso + (O3 =< $7)) -> + {(O1*8 + O2)*8 + O3 - 73*$0,S}; +reg4([$\\,C|S]) -> + {escape_char(C),S}; +reg4([$\\]) -> + throw({error, {unterminated,"\\"}}); +reg4([$^|S]) -> + {bos,S}; +reg4([$$|S]) -> + {eos,S}; +reg4([$.|S]) -> + {{comp_class,"\n"},S}; +reg4("[^" ++ S0) -> + case char_class(S0) of + {Cc,[$]|S1]} -> {{comp_class,Cc},S1}; + {_Cc,_S} -> throw({error,{unterminated,"["}}) + end; +reg4([$[|S0]) -> + case char_class(S0) of + {Cc,[$]|S1]} -> {{char_class,Cc},S1}; + {_Cc,_S1} -> throw({error,{unterminated,"["}}) + end; +reg4([C|S]) + when (C =/= $*) andalso (C =/= $+) andalso (C =/= $?) andalso (C =/= $]) -> + {C, S}; +reg4([C|_S]) -> + throw({error,{illegal,[C]}}); +reg4([]) -> + {epsilon,[]}. + +escape_char($n) -> $\n; %\n = LF +escape_char($r) -> $\r; %\r = CR +escape_char($t) -> $\t; %\t = TAB +escape_char($v) -> $\v; %\v = VT +escape_char($b) -> $\b; %\b = BS +escape_char($f) -> $\f; %\f = FF +escape_char($e) -> $\e; %\e = ESC +escape_char($s) -> $\s; %\s = SPACE +escape_char($d) -> $\d; %\d = DEL +escape_char(C) -> C. + +char_class([$]|S]) -> char_class(S, [$]]); +char_class(S) -> char_class(S, []). + +char($\\, [O1,O2,O3|S]) when + O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 -> + {(O1*8 + O2)*8 + O3 - 73*$0,S}; +char($\\, [C|S]) -> {escape_char(C),S}; +char(C, S) -> {C,S}. + +char_class([C1|S0], Cc) when C1 =/= $] -> + case char(C1, S0) of + {Cf,[$-,C2|S1]} when C2 =/= $] -> + case char(C2, S1) of + {Cl,S2} when Cf < Cl -> char_class(S2, [{Cf,Cl}|Cc]); + {Cl,_S2} -> throw({error,{char_class,[Cf,$-,Cl]}}) + end; + {C,S1} -> char_class(S1, [C|Cc]) + end; +char_class(S, Cc) -> {Cc,S}. + + +%% re_apply(String, StartPos, RegExp) -> re_app_res(). +%% +%% Apply the (parse of the) regular expression RegExp to String. If +%% there is a match return the position of the remaining string and +%% the string if else return 'nomatch'. BestMatch specifies if we want +%% the longest match, or just a match. +%% +%% StartPos should be the real start position as it is used to decide +%% if we ae at the beginning of the string. +%% +%% Pass two functions to re_apply_or so it can decide, on the basis +%% of BestMatch, whether to just any take any match or try both to +%% find the longest. This is slower but saves duplicatng code. + +re_apply(S, St, RE) -> re_apply(RE, [], S, St). + +re_apply(epsilon, More, S, P) -> %This always matches + re_apply_more(More, S, P); +re_apply({'or',RE1,RE2}, More, S, P) -> + re_apply_or(re_apply(RE1, More, S, P), + re_apply(RE2, More, S, P)); +re_apply({concat,RE1,RE2}, More, S0, P) -> + re_apply(RE1, [RE2|More], S0, P); +re_apply({kclosure,CE}, More, S, P) -> + %% Be careful with the recursion, explicitly do one call before + %% looping. + re_apply_or(re_apply_more(More, S, P), + re_apply(CE, [{kclosure,CE}|More], S, P)); +re_apply({pclosure,CE}, More, S, P) -> + re_apply(CE, [{kclosure,CE}|More], S, P); +re_apply({optional,CE}, More, S, P) -> + re_apply_or(re_apply_more(More, S, P), + re_apply(CE, More, S, P)); +re_apply(bos, More, S, 1) -> re_apply_more(More, S, 1); +re_apply(eos, More, [$\n|S], P) -> re_apply_more(More, S, P); +re_apply(eos, More, [], P) -> re_apply_more(More, [], P); +re_apply({char_class,Cc}, More, [C|S], P) -> + case in_char_class(C, Cc) of + true -> re_apply_more(More, S, P+1); + false -> nomatch + end; +re_apply({comp_class,Cc}, More, [C|S], P) -> + case in_char_class(C, Cc) of + true -> nomatch; + false -> re_apply_more(More, S, P+1) + end; +re_apply(C, More, [C|S], P) when is_integer(C) -> + re_apply_more(More, S, P+1); +re_apply(_RE, _More, _S, _P) -> nomatch. + +%% re_apply_more([RegExp], String, Length) -> re_app_res(). + +re_apply_more([RE|More], S, P) -> re_apply(RE, More, S, P); +re_apply_more([], S, P) -> {match,P,S}. + +%% in_char_class(Char, Class) -> bool(). + +in_char_class(C, [{C1,C2}|_Cc]) when C >= C1, C =< C2 -> true; +in_char_class(C, [C|_Cc]) -> true; +in_char_class(C, [_|Cc]) -> in_char_class(C, Cc); +in_char_class(_C, []) -> false. + +%% re_apply_or(Match1, Match2) -> re_app_res(). +%% If we want the best match then choose the longest match, else just +%% choose one by trying sequentially. + +re_apply_or({match,P1,S1}, {match,P2,_S2}) when P1 >= P2 -> {match,P1,S1}; +re_apply_or({match,_P1,_S1}, {match,P2,S2}) -> {match,P2,S2}; +re_apply_or(nomatch, R2) -> R2; +re_apply_or(R1, nomatch) -> R1. + + +matches(S, RE, St) -> + case first_match(RE, S, St) of + {St1,0} -> + [{St1,0}|matches(string:substr(S, St1+2-St), RE, St1+1)]; + {St1,L1} -> + [{St1,L1}|matches(string:substr(S, St1+L1+1-St), RE, St1+L1)]; + nomatch -> + [] + end. + +sub_match(S, RE, St) -> + case first_match(RE, S, St) of + {St1,L1} -> [{St1,L1}]; + nomatch -> [] + end. + +sub_repl([{St,L}|Ss], Rep, S, Pos) -> + Rs = sub_repl(Ss, Rep, S, St+L), + string:substr(S, Pos, St-Pos) ++ + sub_repl(Rep, string:substr(S, St, L), Rs); +sub_repl([], _Rep, S, Pos) -> + string:substr(S, Pos). + +sub_repl([$&|Rep], M, Rest) -> M ++ sub_repl(Rep, M, Rest); +sub_repl("\\&" ++ Rep, M, Rest) -> [$&|sub_repl(Rep, M, Rest)]; +sub_repl([C|Rep], M, Rest) -> [C|sub_repl(Rep, M, Rest)]; +sub_repl([], _M, Rest) -> Rest. + +split_apply(S, RE, Trim) -> split_apply(S, 1, RE, Trim, []). + +split_apply([], _P, _RE, true, []) -> + []; +split_apply([], _P, _RE, _T, Sub) -> + [lists:reverse(Sub)]; +split_apply(S, P, RE, T, Sub) -> + case re_apply(S, P, RE) of + {match,P,_Rest} -> + split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]); + {match,P1,Rest} -> + [lists:reverse(Sub)|split_apply(Rest, P1, RE, T, [])]; + nomatch -> + split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]) + end. diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index fc33b546d9..d52dbad555 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.2.2 +INETS_VSN = 6.2.3 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/java_src/pom.xml.src b/lib/jinterface/java_src/pom.xml.src index cef49b735a..98232db78c 100644 --- a/lib/jinterface/java_src/pom.xml.src +++ b/lib/jinterface/java_src/pom.xml.src @@ -7,14 +7,14 @@ <version>%VSN%</version> <name>jinterface</name> <description> - Jinterface Java package contains java classes, which help you integrate programs written in Java with Erlang. + Jinterface Java package contains java classes, which help you integrate programs written in Java with Erlang. Erlang is a programming language designed at the Ericsson Computer Science Laboratory. - </description> + </description> <url>http://erlang.org/</url> <licenses> <license> - <name>ERLANG PUBLIC LICENSE 1.1</name> - <url>http://www.erlang.org/EPLICENSE</url> + <name>Apache License 2.0</name> + <url>http://www.apache.org/licenses/LICENSE-2.0</url> <distribution>repo</distribution> </license> </licenses> @@ -37,14 +37,16 @@ <plugin> <groupId>org.apache.maven.plugins</groupId> <artifactId>maven-compiler-plugin</artifactId> + <version>3.5.1</version> <configuration> - <source>1.5</source> - <target>1.5</target> + <source>1.6</source> + <target>1.6</target> </configuration> </plugin> <plugin> <groupId>org.codehaus.mojo</groupId> <artifactId>build-helper-maven-plugin</artifactId> + <version>1.10</version> <executions> <execution> <phase>generate-sources</phase> @@ -59,6 +61,32 @@ </execution> </executions> </plugin> + <plugin> + <groupId>org.apache.maven.plugins</groupId> + <artifactId>maven-source-plugin</artifactId> + <version>3.0.0</version> + <executions> + <execution> + <id>attach-sources</id> + <goals> + <goal>jar-no-fork</goal> + </goals> + </execution> + </executions> + </plugin> + <plugin> + <groupId>org.apache.maven.plugins</groupId> + <artifactId>maven-javadoc-plugin</artifactId> + <version>2.10.3</version> + <executions> + <execution> + <id>attach-javadocs</id> + <goals> + <goal>jar</goal> + </goals> + </execution> + </executions> + </plugin> </plugins> </build> <distributionManagement> @@ -85,7 +113,7 @@ <plugin> <groupId>org.apache.maven.plugins</groupId> <artifactId>maven-gpg-plugin</artifactId> - <version>1.0-alpha-4</version> + <version>1.6</version> <executions> <execution> <id>sign-artifacts</id> diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 25dddb1f6c..6174136507 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -32,7 +32,12 @@ -import(lists, [foreach/2]). --type on_load_item() :: {reference(),module(),file:name_all(),[pid()]}. +-type on_load_action() :: + fun((term(), state()) -> {'reply',term(),state()} | + {'noreply',state()}). + +-type on_load_item() :: {{pid(),reference()},module(), + [{pid(),on_load_action()}]}. -record(state, {supervisor :: pid(), root :: file:name_all(), @@ -76,7 +81,7 @@ init(Ref, Parent, [Root,Mode]) -> interactive -> LibDir = filename:append(Root, "lib"), {ok,Dirs} = erl_prim_loader:list_dir(LibDir), - {Paths,_Libs} = make_path(LibDir, Dirs), + Paths = make_path(LibDir, Dirs), UserLibPaths = get_user_lib_dirs(), ["."] ++ UserLibPaths ++ Paths; _ -> @@ -111,7 +116,7 @@ get_user_lib_dirs() -> get_user_lib_dirs_1([Dir|DirList]) -> case erl_prim_loader:list_dir(Dir) of {ok, Dirs} -> - {Paths,_Libs} = make_path(Dir, Dirs), + Paths = make_path(Dir, Dirs), %% Only add paths trailing with ./ebin. [P || P <- Paths, filename:basename(P) =:= "ebin"] ++ get_user_lib_dirs_1(DirList); @@ -142,7 +147,7 @@ reply(Pid, Res) -> loop(#state{supervisor=Supervisor}=State0) -> receive {code_call, Pid, Req} -> - case handle_call(Req, {Pid, call}, State0) of + case handle_call(Req, Pid, State0) of {reply, Res, State} -> _ = reply(Pid, Res), loop(State); @@ -155,8 +160,8 @@ loop(#state{supervisor=Supervisor}=State0) -> system_terminate(Reason, Supervisor, [], State0); {system, From, Msg} -> handle_system_msg(running,Msg, From, Supervisor, State0); - {'DOWN',Ref,process,_,Res} -> - State = finish_on_load(Ref, Res, State0), + {'DOWN',Ref,process,Pid,Res} -> + State = finish_on_load({Pid,Ref}, Res, State0), loop(State); _Msg -> loop(State0) @@ -225,90 +230,90 @@ system_code_change(State, _Module, _OldVsn, _Extra) -> %% The gen_server call back functions. %% -handle_call({stick_dir,Dir}, {_From,_Tag}, S) -> +handle_call({stick_dir,Dir}, _From, S) -> {reply,stick_dir(Dir, true, S),S}; -handle_call({unstick_dir,Dir}, {_From,_Tag}, S) -> +handle_call({unstick_dir,Dir}, _From, S) -> {reply,stick_dir(Dir, false, S),S}; -handle_call({stick_mod,Mod}, {_From,_Tag}, S) -> +handle_call({stick_mod,Mod}, _From, S) -> {reply,stick_mod(Mod, true, S),S}; -handle_call({unstick_mod,Mod}, {_From,_Tag}, S) -> +handle_call({unstick_mod,Mod}, _From, S) -> {reply,stick_mod(Mod, false, S),S}; -handle_call({dir,Dir}, {_From,_Tag}, S) -> +handle_call({dir,Dir}, _From, S) -> Root = S#state.root, Resp = do_dir(Root,Dir,S#state.namedb), {reply,Resp,S}; -handle_call({load_file,Mod}, Caller, St) when is_atom(Mod) -> - load_file(Mod, Caller, St); +handle_call({load_file,Mod}, From, St) when is_atom(Mod) -> + load_file(Mod, From, St); -handle_call({add_path,Where,Dir0}, {_From,_Tag}, +handle_call({add_path,Where,Dir0}, _From, #state{namedb=Namedb,path=Path0}=S) -> {Resp,Path} = add_path(Where, Dir0, Path0, Namedb), {reply,Resp,S#state{path=Path}}; -handle_call({add_paths,Where,Dirs0}, {_From,_Tag}, +handle_call({add_paths,Where,Dirs0}, _From, #state{namedb=Namedb,path=Path0}=S) -> {Resp,Path} = add_paths(Where, Dirs0, Path0, Namedb), {reply,Resp,S#state{path=Path}}; -handle_call({set_path,PathList}, {_From,_Tag}, +handle_call({set_path,PathList}, _From, #state{path=Path0,namedb=Namedb}=S) -> {Resp,Path,NewDb} = set_path(PathList, Path0, Namedb), {reply,Resp,S#state{path=Path,namedb=NewDb}}; -handle_call({del_path,Name}, {_From,_Tag}, +handle_call({del_path,Name}, _From, #state{path=Path0,namedb=Namedb}=S) -> {Resp,Path} = del_path(Name, Path0, Namedb), {reply,Resp,S#state{path=Path}}; -handle_call({replace_path,Name,Dir}, {_From,_Tag}, +handle_call({replace_path,Name,Dir}, _From, #state{path=Path0,namedb=Namedb}=S) -> {Resp,Path} = replace_path(Name, Dir, Path0, Namedb), {reply,Resp,S#state{path=Path}}; -handle_call(get_path, {_From,_Tag}, S) -> +handle_call(get_path, _From, S) -> {reply,S#state.path,S}; %% Messages to load, delete and purge modules/files. -handle_call({load_abs,File,Mod}, Caller, S) when is_atom(Mod) -> +handle_call({load_abs,File,Mod}, From, S) when is_atom(Mod) -> case modp(File) of false -> {reply,{error,badarg},S}; true -> - load_abs(File, Mod, Caller, S) + load_abs(File, Mod, From, S) end; -handle_call({load_binary,Mod,File,Bin}, Caller, S) when is_atom(Mod) -> - do_load_binary(Mod, File, Bin, Caller, S); +handle_call({load_binary,Mod,File,Bin}, From, S) when is_atom(Mod) -> + do_load_binary(Mod, File, Bin, From, S); -handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) -> +handle_call({load_native_partial,Mod,Bin}, _From, S) -> Architecture = erlang:system_info(hipe_architecture), Result = (catch hipe_unified_loader:load(Mod, Bin, Architecture)), Status = hipe_result_to_status(Result, S), {reply,Status,S}; -handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) -> +handle_call({load_native_sticky,Mod,Bin,WholeModule}, _From, S) -> Architecture = erlang:system_info(hipe_architecture), Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule, Architecture)), Status = hipe_result_to_status(Result, S), {reply,Status,S}; -handle_call({ensure_loaded,Mod}, Caller, St) when is_atom(Mod) -> +handle_call({ensure_loaded,Mod}, From, St) when is_atom(Mod) -> case erlang:module_loaded(Mod) of true -> {reply,{module,Mod},St}; false when St#state.mode =:= interactive -> - load_file(Mod, Caller, St); + ensure_loaded(Mod, From, St); false -> {reply,{error,embedded},St} end; -handle_call({delete,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> +handle_call({delete,Mod}, _From, St) when is_atom(Mod) -> case catch erlang:delete_module(Mod) of true -> ets:delete(St#state.moddb, Mod), @@ -317,48 +322,50 @@ handle_call({delete,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> {reply,false,St} end; -handle_call({purge,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> +handle_call({purge,Mod}, _From, St) when is_atom(Mod) -> {reply,do_purge(Mod),St}; -handle_call({soft_purge,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> +handle_call({soft_purge,Mod}, _From, St) when is_atom(Mod) -> {reply,do_soft_purge(Mod),St}; -handle_call({is_loaded,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> +handle_call({is_loaded,Mod}, _From, St) when is_atom(Mod) -> {reply,is_loaded(Mod, St#state.moddb),St}; -handle_call(all_loaded, {_From,_Tag}, S) -> +handle_call(all_loaded, _From, S) -> Db = S#state.moddb, {reply,all_loaded(Db),S}; -handle_call({get_object_code,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> +handle_call({get_object_code,Mod}, _From, St) when is_atom(Mod) -> Path = St#state.path, case mod_to_bin(Path, Mod) of {_,Bin,FName} -> {reply,{Mod,Bin,FName},St}; Error -> {reply,Error,St} end; -handle_call({is_sticky, Mod}, {_From,_Tag}, S) -> +handle_call({is_sticky, Mod}, _From, S) -> Db = S#state.moddb, {reply, is_sticky(Mod,Db), S}; -handle_call(stop,{_From,_Tag}, S) -> +handle_call(stop,_From, S) -> {stop,normal,stopped,S}; -handle_call({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}, {_From,_Tag}, S=#state{mode=Mode}) -> - case erl_prim_loader:set_primary_archive(File, ArchiveBin, FileInfo, ParserFun) of +handle_call({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}, + _From, S=#state{mode=Mode}) -> + case erl_prim_loader:set_primary_archive(File, ArchiveBin, FileInfo, + ParserFun) of {ok, Files} -> {reply, {ok, Mode, Files}, S}; {error, _Reason} = Error -> {reply, Error, S} end; -handle_call(get_mode, {_From,_Tag}, S=#state{mode=Mode}) -> +handle_call(get_mode, _From, S=#state{mode=Mode}) -> {reply, Mode, S}; -handle_call({finish_loading,Prepared,EnsureLoaded}, {_,_}, S) -> +handle_call({finish_loading,Prepared,EnsureLoaded}, _From, S) -> {reply,finish_loading(Prepared, EnsureLoaded, S),S}; -handle_call(Other,{_From,_Tag}, S) -> +handle_call(Other,_From, S) -> error_msg(" ** Codeserver*** ignoring ~w~n ",[Other]), {noreply,S}. @@ -371,7 +378,7 @@ handle_call(Other,{_From,_Tag}, S) -> %% make_path(BundleDir, Bundles0) -> Bundles = choose_bundles(Bundles0), - make_path(BundleDir, Bundles, [], []). + make_path(BundleDir, Bundles, []). choose_bundles(Bundles) -> ArchiveExt = archive_extension(), @@ -381,12 +388,10 @@ choose_bundles(Bundles) -> create_bundle(FullName, ArchiveExt) -> BaseName = filename:basename(FullName, ArchiveExt), - case split(BaseName, "-") of - [_, _|_] = Toks -> - VsnStr = lists:last(Toks), + case split_base(BaseName) of + {Name, VsnStr} -> case vsn_to_num(VsnStr) of {ok, VsnNum} -> - Name = join(lists:sublist(Toks, length(Toks)-1),"-"), {Name,VsnNum,FullName}; false -> {FullName,[0],FullName} @@ -457,41 +462,44 @@ choose([{Name,NumVsn,NewFullName}=New|Bs], Acc, ArchiveExt) -> choose([],Acc, _ArchiveExt) -> Acc. -make_path(_,[],Res,Bs) -> - {Res,Bs}; -make_path(BundleDir,[Bundle|Tail],Res,Bs) -> - Dir = filename:append(BundleDir,Bundle), - Ebin = filename:append(Dir,"ebin"), +make_path(_, [], Res) -> + Res; +make_path(BundleDir, [Bundle|Tail], Res) -> + Dir = filename:append(BundleDir, Bundle), + Ebin = filename:append(Dir, "ebin"), %% First try with /ebin - case erl_prim_loader:read_file_info(Ebin) of - {ok,#file_info{type=directory}} -> - make_path(BundleDir,Tail,[Ebin|Res],[Bundle|Bs]); - _ -> + case is_dir(Ebin) of + true -> + make_path(BundleDir, Tail, [Ebin|Res]); + false -> %% Second try with archive Ext = archive_extension(), - Base = filename:basename(Dir, Ext), - Ebin2 = filename:join([filename:dirname(Dir), Base ++ Ext, Base, "ebin"]), + Base = filename:basename(Bundle, Ext), + Ebin2 = filename:join([BundleDir, Base ++ Ext, Base, "ebin"]), Ebins = - case split(Base, "-") of - [_, _|_] = Toks -> - AppName = join(lists:sublist(Toks, length(Toks)-1),"-"), - Ebin3 = filename:join([filename:dirname(Dir), Base ++ Ext, AppName, "ebin"]), + case split_base(Base) of + {AppName,_} -> + Ebin3 = filename:join([BundleDir, Base ++ Ext, + AppName, "ebin"]), [Ebin3, Ebin2, Dir]; _ -> [Ebin2, Dir] end, - try_ebin_dirs(Ebins,BundleDir,Tail,Res,Bundle, Bs) + case try_ebin_dirs(Ebins) of + {ok,FoundEbin} -> + make_path(BundleDir, Tail, [FoundEbin|Res]); + error -> + make_path(BundleDir, Tail, Res) + end end. -try_ebin_dirs([Ebin | Ebins],BundleDir,Tail,Res,Bundle,Bs) -> - case erl_prim_loader:read_file_info(Ebin) of - {ok,#file_info{type=directory}} -> - make_path(BundleDir,Tail,[Ebin|Res],[Bundle|Bs]); - _ -> - try_ebin_dirs(Ebins,BundleDir,Tail,Res,Bundle,Bs) +try_ebin_dirs([Ebin|Ebins]) -> + case is_dir(Ebin) of + true -> {ok,Ebin}; + false -> try_ebin_dirs(Ebins) end; -try_ebin_dirs([],BundleDir,Tail,Res,_Bundle,Bs) -> - make_path(BundleDir,Tail,Res,Bs). +try_ebin_dirs([]) -> + error. %% @@ -609,19 +617,34 @@ exclude(Dir,Path) -> %% %% get_name(Dir) -> - get_name2(get_name1(Dir), []). + get_name_from_splitted(filename:split(Dir)). + +get_name_from_splitted([DirName,"ebin"]) -> + discard_after_hyphen(DirName); +get_name_from_splitted([DirName]) -> + discard_after_hyphen(DirName); +get_name_from_splitted([_|T]) -> + get_name_from_splitted(T); +get_name_from_splitted([]) -> + "". %No name. + +discard_after_hyphen("-"++_) -> + []; +discard_after_hyphen([H|T]) -> + [H|discard_after_hyphen(T)]; +discard_after_hyphen([]) -> + []. -get_name1(Dir) -> - case lists:reverse(filename:split(Dir)) of - ["ebin",DirName|_] -> DirName; - [DirName|_] -> DirName; - _ -> "" % No name ! +split_base(BaseName) -> + case split(BaseName, "-") of + [_, _|_] = Toks -> + Vsn = lists:last(Toks), + AllButLast = lists:droplast(Toks), + {join(AllButLast, "-"),Vsn}; + [_|_] -> + BaseName end. -get_name2([$-|_],Acc) -> lists:reverse(Acc); -get_name2([H|T],Acc) -> get_name2(T,[H|Acc]); -get_name2(_,Acc) -> lists:reverse(Acc). - check_path(Path) -> PathChoice = init:code_path_choice(), ArchiveExt = archive_extension(), @@ -630,23 +653,23 @@ check_path(Path) -> do_check_path([], _PathChoice, _ArchiveExt, Acc) -> {ok, lists:reverse(Acc)}; do_check_path([Dir | Tail], PathChoice, ArchiveExt, Acc) -> - case catch erl_prim_loader:read_file_info(Dir) of - {ok, #file_info{type=directory}} -> + case is_dir(Dir) of + true -> do_check_path(Tail, PathChoice, ArchiveExt, [Dir | Acc]); - _ when PathChoice =:= strict -> + false when PathChoice =:= strict -> %% Be strict. Only use dir as explicitly stated {error, bad_directory}; - _ when PathChoice =:= relaxed -> + false when PathChoice =:= relaxed -> %% Be relaxed case catch lists:reverse(filename:split(Dir)) of {'EXIT', _} -> {error, bad_directory}; ["ebin", App] -> Dir2 = filename:join([App ++ ArchiveExt, App, "ebin"]), - case erl_prim_loader:read_file_info(Dir2) of - {ok, #file_info{type = directory}} -> + case is_dir(Dir2) of + true -> do_check_path(Tail, PathChoice, ArchiveExt, [Dir2 | Acc]); - _ -> + false -> {error, bad_directory} end; ["ebin", App, OptArchive | RevTop] -> @@ -666,10 +689,10 @@ do_check_path([Dir | Tail], PathChoice, ArchiveExt, Acc) -> Top = lists:reverse([OptArchive | RevTop]), filename:join(Top ++ [App ++ ArchiveExt, App, "ebin"]) end, - case erl_prim_loader:read_file_info(Dir2) of - {ok, #file_info{type = directory}} -> + case is_dir(Dir2) of + true -> do_check_path(Tail, PathChoice, ArchiveExt, [Dir2 | Acc]); - _ -> + false -> {error, bad_directory} end; _ -> @@ -768,7 +791,7 @@ init_namedb(Path) -> Db. init_namedb([P|Path], Db) -> - insert_name(P, Db), + insert_dir(P, Db), init_namedb(Path, Db); init_namedb([], _) -> ok. @@ -781,59 +804,39 @@ clear_namedb([], _) -> ok. -endif. -insert_name(Dir, Db) -> - case get_name(Dir) of - Dir -> false; - Name -> insert_name(Name, Dir, Db) - end. +%% Dir must be a complete pathname (not only a name). +insert_dir(Dir, Db) -> + Splitted = filename:split(Dir), + Name = get_name_from_splitted(Splitted), + AppDir = filename:join(del_ebin_1(Splitted)), + do_insert_name(Name, AppDir, Db). insert_name(Name, Dir, Db) -> AppDir = del_ebin(Dir), + do_insert_name(Name, AppDir, Db). + +do_insert_name(Name, AppDir, Db) -> {Base, SubDirs} = archive_subdirs(AppDir), ets:insert(Db, {Name, AppDir, Base, SubDirs}), true. archive_subdirs(AppDir) -> - IsDir = - fun(RelFile) -> - File = filename:join([AppDir, RelFile]), - case erl_prim_loader:read_file_info(File) of - {ok, #file_info{type = directory}} -> - false; - _ -> - true - end - end, - {Base, ArchiveDirs} = all_archive_subdirs(AppDir), - {Base, lists:filter(IsDir, ArchiveDirs)}. - -all_archive_subdirs(AppDir) -> - Ext = archive_extension(), Base = filename:basename(AppDir), - Dirs = - case split(Base, "-") of - [_, _|_] = Toks -> - Base2 = join(lists:sublist(Toks, length(Toks)-1), "-"), - [Base2, Base]; - _ -> - [Base] + Dirs = case split_base(Base) of + {Name, _} -> [Name, Base]; + _ -> [Base] end, + Ext = archive_extension(), try_archive_subdirs(AppDir ++ Ext, Base, Dirs). try_archive_subdirs(Archive, Base, [Dir | Dirs]) -> - ArchiveDir = filename:join([Archive, Dir]), + ArchiveDir = filename:append(Archive, Dir), case erl_prim_loader:list_dir(ArchiveDir) of {ok, Files} -> - IsDir = - fun(RelFile) -> - File = filename:join([ArchiveDir, RelFile]), - case erl_prim_loader:read_file_info(File) of - {ok, #file_info{type = directory}} -> - true; - _ -> - false - end - end, + IsDir = fun(RelFile) -> + File = filename:append(ArchiveDir, RelFile), + is_dir(File) + end, {Dir, lists:filter(IsDir, Files)}; _ -> try_archive_subdirs(Archive, Base, Dirs) @@ -927,22 +930,22 @@ check_pars(Name,Dir) -> end. del_ebin(Dir) -> - case filename:basename(Dir) of - "ebin" -> - Dir2 = filename:dirname(Dir), - Dir3 = filename:dirname(Dir2), - Ext = archive_extension(), - case filename:extension(Dir3) of - E when E =:= Ext -> - %% Strip archive extension - filename:join([filename:dirname(Dir3), - filename:basename(Dir3, Ext)]); - _ -> - Dir2 - end; - _ -> - Dir - end. + filename:join(del_ebin_1(filename:split(Dir))). + +del_ebin_1([Parent,App,"ebin"]) -> + Ext = archive_extension(), + case filename:basename(Parent, Ext) of + Parent -> + %% Plain directory. + [Parent,App]; + Archive -> + %% Archive. + [Archive] + end; +del_ebin_1([H|T]) -> + [H|del_ebin_1(T)]; +del_ebin_1([]) -> + []. replace_name(Dir, Db) -> case get_name(Dir) of @@ -1058,14 +1061,14 @@ add_paths(Where,[Dir|Tail],Path,NameDb) -> add_paths(_,_,Path,_) -> {ok,Path}. -do_load_binary(Module, File, Binary, Caller, St) -> +do_load_binary(Module, File, Binary, From, St) -> case modp(File) andalso is_binary(Binary) of true -> case erlang:module_loaded(Module) of true -> do_purge(Module); false -> ok end, - try_load_module(File, Module, Binary, Caller, St); + try_load_module(File, Module, Binary, From, St); false -> {reply,{error,badarg},St} end. @@ -1074,63 +1077,61 @@ modp(Atom) when is_atom(Atom) -> true; modp(List) when is_list(List) -> int_list(List); modp(_) -> false. -load_abs(File, Mod, Caller, St) -> +load_abs(File, Mod, From, St) -> Ext = objfile_extension(), FileName0 = lists:concat([File, Ext]), FileName = absname(FileName0), case erl_prim_loader:get_file(FileName) of {ok,Bin,_} -> - try_load_module(FileName, Mod, Bin, Caller, St); + try_load_module(FileName, Mod, Bin, From, St); error -> {reply,{error,nofile},St} end. -try_load_module(File, Mod, Bin, {From,_}=Caller, St0) -> - case pending_on_load(Mod, From, St0) of - no -> - try_load_module_1(File, Mod, Bin, Caller, St0); - {yes,St} -> - {noreply,St} - end. +try_load_module(File, Mod, Bin, From, St) -> + Action = fun(_, S) -> + try_load_module_1(File, Mod, Bin, From, S) + end, + handle_pending_on_load(Action, Mod, From, St). -try_load_module_1(File, Mod, Bin, Caller, #state{moddb=Db}=St) -> +try_load_module_1(File, Mod, Bin, From, #state{moddb=Db}=St) -> case is_sticky(Mod, Db) of true -> %% Sticky file reject the load error_msg("Can't load module '~w' that resides in sticky dir\n",[Mod]), {reply,{error,sticky_directory},St}; false -> Architecture = erlang:system_info(hipe_architecture), - try_load_module_2(File, Mod, Bin, Caller, Architecture, St) + try_load_module_2(File, Mod, Bin, From, Architecture, St) end. -try_load_module_2(File, Mod, Bin, Caller, undefined, St) -> - try_load_module_3(File, Mod, Bin, Caller, undefined, St); -try_load_module_2(File, Mod, Bin, Caller, Architecture, +try_load_module_2(File, Mod, Bin, From, undefined, St) -> + try_load_module_3(File, Mod, Bin, From, undefined, St); +try_load_module_2(File, Mod, Bin, From, Architecture, #state{moddb=Db}=St) -> case catch hipe_unified_loader:load_native_code(Mod, Bin, Architecture) of {module,Mod} = Module -> ets:insert(Db, [{{native,Mod},true},{Mod,File}]), {reply,Module,St}; no_native -> - try_load_module_3(File, Mod, Bin, Caller, Architecture, St); + try_load_module_3(File, Mod, Bin, From, Architecture, St); Error -> error_msg("Native loading of ~ts failed: ~p\n", [File,Error]), {reply,ok,St} end. -try_load_module_3(File, Mod, Bin, Caller, Architecture, - #state{moddb=Db}=St) -> - case erlang:load_module(Mod, Bin) of - {module,Mod} = Module -> - ets:insert(Db, {Mod,File}), - post_beam_load([Mod], Architecture, St), - {reply,Module,St}; - {error,on_load} -> - handle_on_load(Mod, File, Caller, St); - {error,What} = Error -> - error_msg("Loading of ~ts failed: ~p\n", [File, What]), - {reply,Error,St} - end. +try_load_module_3(File, Mod, Bin, From, Architecture, St0) -> + Action = fun({module,_}=Module, #state{moddb=Db}=S) -> + ets:insert(Db, {Mod,File}), + post_beam_load([Mod], Architecture, S), + {reply,Module,S}; + ({error,on_load_failure}=Error, S) -> + {reply,Error,S}; + ({error,What}=Error, S) -> + error_msg("Loading of ~ts failed: ~p\n", [File, What]), + {reply,Error,S} + end, + Res = erlang:load_module(Mod, Bin), + handle_on_load(Res, Action, Mod, From, St0). hipe_result_to_status(Result, #state{moddb=Db}) -> case Result of @@ -1155,18 +1156,29 @@ int_list([H|T]) when is_integer(H) -> int_list(T); int_list([_|_]) -> false; int_list([]) -> true. -load_file(Mod, {From,_}=Caller, St0) -> - case pending_on_load(Mod, From, St0) of - no -> load_file_1(Mod, Caller, St0); - {yes,St} -> {noreply,St} - end. - -load_file_1(Mod, Caller, #state{path=Path}=St) -> +ensure_loaded(Mod, From, St0) -> + Action = fun(_, S) -> + case erlang:module_loaded(Mod) of + true -> + {reply,{module,Mod},S}; + false -> + load_file_1(Mod, From, S) + end + end, + handle_pending_on_load(Action, Mod, From, St0). + +load_file(Mod, From, St0) -> + Action = fun(_, S) -> + load_file_1(Mod, From, S) + end, + handle_pending_on_load(Action, Mod, From, St0). + +load_file_1(Mod, From, #state{path=Path}=St) -> case mod_to_bin(Path, Mod) of error -> {reply,{error,nofile},St}; {Mod,Binary,File} -> - try_load_module_1(File, Mod, Binary, Caller, St) + try_load_module_1(File, Mod, Binary, From, St) end. mod_to_bin([Dir|Tail], Mod) -> @@ -1174,8 +1186,13 @@ mod_to_bin([Dir|Tail], Mod) -> case erl_prim_loader:get_file(File) of error -> mod_to_bin(Tail, Mod); - {ok,Bin,FName} -> - {Mod,Bin,absname(FName)} + {ok,Bin,_} -> + case filename:pathtype(File) of + absolute -> + {Mod,Bin,File}; + _ -> + {Mod,Bin,absname(File)} + end end; mod_to_bin([], Mod) -> %% At last, try also erl_prim_loader's own method @@ -1236,6 +1253,11 @@ do_purge(Mod) -> do_soft_purge(Mod) -> erts_code_purger:soft_purge(Mod). +is_dir(Path) -> + case erl_prim_loader:read_file_info(Path) of + {ok,#file_info{type=directory}} -> true; + _ -> false + end. %%% %%% Loading of multiple modules in parallel. @@ -1299,59 +1321,78 @@ run([F|Fs], Data0) -> %% The on_load functionality. %% ------------------------------------------------------- -handle_on_load(Mod, File, {From,_}, #state{on_load=OnLoad0}=St0) -> +handle_on_load({error,on_load}, Action, Mod, From, St0) -> + #state{on_load=OnLoad0} = St0, Fun = fun() -> Res = erlang:call_on_load_function(Mod), exit(Res) end, - {_,Ref} = spawn_monitor(Fun), - OnLoad = [{Ref,Mod,File,[From]}|OnLoad0], + PidRef = spawn_monitor(Fun), + PidAction = {From,Action}, + OnLoad = [{PidRef,Mod,[PidAction]}|OnLoad0], St = St0#state{on_load=OnLoad}, - {noreply,St}. + {noreply,St}; +handle_on_load(Res, Action, _, _, St) -> + Action(Res, St). -pending_on_load(_, _, #state{on_load=[]}) -> - no; -pending_on_load(Mod, From, #state{on_load=OnLoad0}=St) -> - case lists:keymember(Mod, 2, OnLoad0) of +handle_pending_on_load(Action, Mod, From, #state{on_load=OnLoad0}=St) -> + case lists:keyfind(Mod, 2, OnLoad0) of false -> - no; - true -> - OnLoad = pending_on_load_1(Mod, From, OnLoad0), - {yes,St#state{on_load=OnLoad}} + Action(ok, St); + {{From,_Ref},Mod,_Pids} -> + %% The on_load function tried to make an external + %% call to its own module. That would be a deadlock. + %% Fail the call. (The call is probably from error_handler, + %% and it will ignore the actual error reason and cause + %% an undef execption.) + {reply,{error,deadlock},St}; + {_,_,_} -> + OnLoad = handle_pending_on_load_1(Mod, {From,Action}, OnLoad0), + {noreply,St#state{on_load=OnLoad}} end. -pending_on_load_1(Mod, From, [{Ref,Mod,File,Pids}|T]) -> - [{Ref,Mod,File,[From|Pids]}|T]; -pending_on_load_1(Mod, From, [H|T]) -> - [H|pending_on_load_1(Mod, From, T)]; -pending_on_load_1(_, _, []) -> []. +handle_pending_on_load_1(Mod, From, [{PidRef,Mod,Pids}|T]) -> + [{PidRef,Mod,[From|Pids]}|T]; +handle_pending_on_load_1(Mod, From, [H|T]) -> + [H|handle_pending_on_load_1(Mod, From, T)]; +handle_pending_on_load_1(_, _, []) -> []. -finish_on_load(Ref, OnLoadRes, #state{on_load=OnLoad0,moddb=Db}=State) -> - case lists:keyfind(Ref, 1, OnLoad0) of +finish_on_load(PidRef, OnLoadRes, #state{on_load=OnLoad0}=St0) -> + case lists:keyfind(PidRef, 1, OnLoad0) of false -> %% Since this process in general silently ignores messages %% it doesn't understand, it should also ignore a 'DOWN' %% message with an unknown reference. - State; - {Ref,Mod,File,WaitingPids} -> - finish_on_load_1(Mod, File, OnLoadRes, WaitingPids, Db), - OnLoad = [E || {R,_,_,_}=E <- OnLoad0, R =/= Ref], - State#state{on_load=OnLoad} + St0; + {PidRef,Mod,Waiting} -> + St = finish_on_load_1(Mod, OnLoadRes, Waiting, St0), + OnLoad = [E || {R,_,_}=E <- OnLoad0, R =/= PidRef], + St#state{on_load=OnLoad} end. -finish_on_load_1(Mod, File, OnLoadRes, WaitingPids, Db) -> +finish_on_load_1(Mod, OnLoadRes, Waiting, St) -> Keep = OnLoadRes =:= ok, erlang:finish_after_on_load(Mod, Keep), Res = case Keep of false -> _ = finish_on_load_report(Mod, OnLoadRes), + _ = erts_code_purger:purge(Mod), {error,on_load_failure}; true -> - ets:insert(Db, {Mod,File}), {module,Mod} end, - _ = [reply(Pid, Res) || Pid <- WaitingPids], - ok. + finish_on_load_2(Waiting, Res, St). + +finish_on_load_2([{Pid,Action}|T], Res, St0) -> + case Action(Res, St0) of + {reply,Rep,St} -> + _ = reply(Pid, Rep), + finish_on_load_2(T, Res, St); + {noreply,St} -> + finish_on_load_2(T, Res, St) + end; +finish_on_load_2([], _, St) -> + St. finish_on_load_report(_Mod, Atom) when is_atom(Atom) -> %% No error reports for atoms. diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index 580a896357..47d0c1b861 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -156,7 +156,7 @@ is_allowed(#hs_data{other_node = Node, send_status(HSData, not_allowed), error_msg("** Connection attempt from " "disallowed node ~w ** ~n", [Node]), - ?shutdown(Node); + ?shutdown2(Node, {is_allowed, not_allowed}); _ -> true end. @@ -607,10 +607,10 @@ recv_challenge_reply(#hs_data{socket = Socket, _ -> error_msg("** Connection attempt from " "disallowed node ~w ** ~n", [NodeB]), - ?shutdown(NodeB) + ?shutdown2(NodeB, {recv_challenge_reply_failed, bad_cookie}) end; - _ -> - ?shutdown(no_node) + Other -> + ?shutdown2(no_node, {recv_challenge_reply_failed, Other}) end. recv_challenge_ack(#hs_data{socket = Socket, f_recv = FRecv, diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl index 6f9ce17c0c..21bff02214 100644 --- a/lib/kernel/src/rpc.erl +++ b/lib/kernel/src/rpc.erl @@ -63,7 +63,7 @@ %%------------------------------------------------------------------------ --type state() :: gb_trees:tree(pid(), {pid(), reference()}). +-type state() :: map(). %%------------------------------------------------------------------------ @@ -91,7 +91,7 @@ stop(Rpc) -> init([]) -> process_flag(trap_exit, true), - {ok, gb_trees:empty()}. + {ok, maps:new()}. -spec handle_call(term(), term(), state()) -> {'noreply', state()} | @@ -130,29 +130,15 @@ handle_cast(_, S) -> -spec handle_info(term(), state()) -> {'noreply', state()}. +handle_info({'DOWN', _, process, Caller, normal}, S) -> + {noreply, maps:remove(Caller, S)}; handle_info({'DOWN', _, process, Caller, Reason}, S) -> - case gb_trees:lookup(Caller, S) of - {value, To} -> - receive - {Caller, {reply, Reply}} -> - gen_server:reply(To, Reply) - after 0 -> - gen_server:reply(To, {badrpc, {'EXIT', Reason}}) - end, - {noreply, gb_trees:delete(Caller, S)}; - none -> - {noreply, S} - end; -handle_info({Caller, {reply, Reply}}, S) -> - case gb_trees:lookup(Caller, S) of - {value, To} -> - receive - {'DOWN', _, process, Caller, _} -> - gen_server:reply(To, Reply), - {noreply, gb_trees:delete(Caller, S)} - end; - none -> - {noreply, S} + case maps:get(Caller, S, undefined) of + undefined -> + {noreply, S}; + {_, _} = To -> + gen_server:reply(To, {badrpc, {'EXIT', Reason}}), + {noreply, maps:remove(Caller, S)} end; handle_info({From, {sbcast, Name, Msg}}, S) -> _ = case catch Name ! Msg of %% use catch to get the printout @@ -190,7 +176,6 @@ code_change(_, S, _) -> %% Auxiliary function to avoid a false dialyzer warning -- do not inline %% handle_call_call(Mod, Fun, Args, Gleader, To, S) -> - RpcServer = self(), %% Spawn not to block the rpc server. {Caller,_} = erlang:spawn_monitor( @@ -205,9 +190,9 @@ handle_call_call(Mod, Fun, Args, Gleader, To, S) -> Result -> Result end, - RpcServer ! {self(), {reply, Reply}} + gen_server:reply(To, Reply) end), - {noreply, gb_trees:insert(Caller, To, S)}. + {noreply, maps:put(Caller, To, S)}. %% RPC aid functions .... diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 7f9718a354..8da67c89f8 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -20,6 +20,7 @@ -module(code_SUITE). -include_lib("common_test/include/ct.hrl"). +-include_lib("syntax_tools/include/merl.hrl"). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2]). -export([set_path/1, get_path/1, add_path/1, add_paths/1, del_path/1, @@ -33,7 +34,9 @@ where_is_file/1, purge_stacktrace/1, mult_lib_roots/1, bad_erl_libs/1, code_archive/1, code_archive2/1, on_load/1, on_load_binary/1, - on_load_embedded/1, on_load_errors/1, big_boot_embedded/1, + on_load_embedded/1, on_load_errors/1, on_load_update/1, + on_load_purge/1, on_load_self_call/1, on_load_pending/1, + big_boot_embedded/1, native_early_modules/1, get_mode/1, normalized_paths/1]). @@ -61,7 +64,8 @@ all() -> ext_mod_dep, clash, where_is_file, purge_stacktrace, mult_lib_roots, bad_erl_libs, code_archive, code_archive2, on_load, - on_load_binary, on_load_embedded, on_load_errors, + on_load_binary, on_load_embedded, on_load_errors, on_load_update, + on_load_purge, on_load_self_call, on_load_pending, big_boot_embedded, native_early_modules, get_mode, normalized_paths]. groups() -> @@ -826,6 +830,12 @@ check_funs({'$M_EXPR',warning_msg,2}, [{code_server,finish_on_load_report,2} | _]) -> 0; check_funs({'$M_EXPR','$F_EXPR',1}, [{code_server,run,2}|_]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',2}, + [{code_server,handle_on_load,5}|_]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',2}, + [{code_server,handle_pending_on_load,4}|_]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',2}, + [{code_server,finish_on_load_2,3}|_]) -> 0; %% This is cheating! /raimo %% %% check_funs(This = {M,_,_}, Path) -> @@ -1023,6 +1033,12 @@ do_code_archive(Config, Root, StripVsn) when is_list(Config) -> {ok, _} = zip:create(Archive, [Base], [{compress, []}, {cwd, PrivDir}]), + %% Create a directory and a file outside of the archive. + OtherFile = filename:join([RootDir,VsnBase,"other","other.txt"]), + OtherContents = ?MODULE:module_info(md5), + filelib:ensure_dir(OtherFile), + ok = file:write_file(OtherFile, OtherContents), + %% Set up ERL_LIBS and start a slave node. {ok, Node} = test_server:start_node(code_archive, slave, @@ -1037,13 +1053,25 @@ do_code_archive(Config, Root, StripVsn) when is_list(Config) -> %% Start the app ok = rpc:call(Node, application, start, [App]), + %% Get the lib dir for the app. + AppLibDir = rpc:call(Node, code, lib_dir, [App]), + io:format("AppLibDir: ~p\n", [AppLibDir]), + AppLibDir = filename:join(RootDir, VsnBase), + %% Access the app priv dir AppPrivDir = rpc:call(Node, code, priv_dir, [App]), AppPrivFile = filename:join([AppPrivDir, "code_archive.txt"]), io:format("AppPrivFile: ~p\n", [AppPrivFile]), - {ok, _Bin, _Path} = + {ok, _Bin, _} = rpc:call(Node, erl_prim_loader, get_file, [AppPrivFile]), + %% Read back the other text file. + OtherDirPath = rpc:call(Node, code, lib_dir, [App,other]), + OtherFilePath = filename:join(OtherDirPath, "other.txt"), + io:format("OtherFilePath: ~p\n", [OtherFilePath]), + {ok, OtherContents, _} = + rpc:call(Node, erl_prim_loader, get_file, [OtherFilePath]), + %% Use the app Tab = code_archive_tab, Key = foo, @@ -1166,22 +1194,17 @@ on_load_binary(_) -> register(Master, self()), %% Construct, compile and pretty-print. - Mod = on_load_binary, + Mod = ?FUNCTION_NAME, File = atom_to_list(Mod) ++ ".erl", - Forms = [{attribute,1,file,{File,1}}, - {attribute,1,module,Mod}, - {attribute,2,export,[{ok,0}]}, - {attribute,3,on_load,{init,0}}, - {function,5,init,0, - [{clause,5,[],[], - [{op,6,'!', - {atom,6,Master}, - {tuple,6,[{atom,6,Mod},{call,6,{atom,6,self},[]}]}}, - {'receive',7,[{clause,8,[{atom,8,go}],[],[{atom,8,ok}]}]}]}]}, - {function,11,ok,0,[{clause,11,[],[],[{atom,11,true}]}]}], - Forms1 = erl_parse:new_anno(Forms), - {ok,Mod,Bin} = compile:forms(Forms1, [report]), - [io:put_chars(erl_pp:form(F)) || F <- Forms1], + Tree = ?Q(["-module('@Mod@').\n", + "-export([ok/0]).\n", + "-on_load({init,0}).\n", + "init() ->\n", + " '@Master@' ! {on_load_binary,self()},\n", + " receive go -> ok end.\n", + "ok() -> true.\n"]), + {ok,Mod,Bin} = merl:compile(Tree), + merl:print(Tree), {Pid1,Ref1} = spawn_monitor(fun() -> code:load_binary(Mod, File, Bin), @@ -1423,6 +1446,163 @@ do_on_load_error(ReturnValue) -> {undef,[{on_load_error,main,[],_}|_]} = Exit end. +on_load_update(_Config) -> + {Mod,Code1} = on_load_update_code(1), + {module,Mod} = code:load_binary(Mod, "", Code1), + 42 = Mod:a(), + 100 = Mod:b(99), + 4 = erlang:trace_pattern({Mod,'_','_'}, true), + + {Mod,Code2} = on_load_update_code(2), + {error,on_load_failure} = code:load_binary(Mod, "", Code2), + 42 = Mod:a(), + 100 = Mod:b(99), + {'EXIT',{undef,_}} = (catch Mod:never()), + 4 = erlang:trace_pattern({Mod,'_','_'}, false), + + {Mod,Code3} = on_load_update_code(3), + {module,Mod} = code:load_binary(Mod, "", Code3), + 100 = Mod:c(), + {'EXIT',{undef,_}} = (catch Mod:a()), + {'EXIT',{undef,_}} = (catch Mod:b(10)), + {'EXIT',{undef,_}} = (catch Mod:never()), + + ok. + +on_load_update_code(Version) -> + Mod = ?FUNCTION_NAME, + Tree = on_load_update_code_1(Version, Mod), + io:format("Version ~p", [Version]), + {ok,Mod,Code} = merl:compile(Tree), + merl:print(Tree), + io:nl(), + {Mod,Code}. + +on_load_update_code_1(1, Mod) -> + ?Q(["-module('@Mod@').\n", + "-export([a/0,b/1]).\n" + "-on_load(f/0).\n", + "f() -> ok.\n", + "a() -> 42.\n" + "b(I) -> I+1.\n"]); +on_load_update_code_1(2, Mod) -> + ?Q(["-module('@Mod@').\n", + "-export([never/0]).\n" + "-on_load(f/0).\n", + "f() -> 42 = '@Mod@':a(), 1 = '@Mod@':b(0), fail.\n", + "never() -> never.\n"]); +on_load_update_code_1(3, Mod) -> + ?Q(["-module('@Mod@').\n", + "-export([c/0]).\n" + "-on_load(f/0).\n", + "f() -> ok.\n", + "c() -> 100.\n"]). + +on_load_purge(_Config) -> + Mod = ?FUNCTION_NAME, + register(Mod, self()), + Tree = ?Q(["-module('@Mod@').\n", + "-on_load(f/0).\n", + "loop() -> loop().\n", + "f() ->\n", + "'@Mod@' ! {self(),spawn(fun loop/0)},\n", + "receive Ack -> Ack end.\n"]), + merl:print(Tree), + {ok,Mod,Code} = merl:compile(Tree), + P = spawn(fun() -> + exit(code:load_binary(Mod, "", Code)) + end), + monitor(process, P), + receive + {Pid1,Pid2} -> + monitor(process, Pid2), + Pid1 ! ack_and_failure, + receive + {'DOWN',_,process,P,Exit1} -> + {error,on_load_failure} = Exit1 + end, + receive + {'DOWN',_,process,Pid2,Exit2} -> + io:format("~p\n", [Exit2]) + after 10000 -> + ct:fail(no_down_message) + end + end. + +on_load_self_call(_Config) -> + Mod = ?FUNCTION_NAME, + register(Mod, self()), + Tree = ?Q(["-module('@Mod@').\n", + "-export([ext/0]).\n", + "-on_load(f/0).\n", + "f() ->\n", + " '@Mod@' ! (catch '@Mod@':ext()),\n", + " ok.\n", + "ext() -> good_work.\n"]), + merl:print(Tree), + {ok,Mod,Code} = merl:compile(Tree), + + {'EXIT',{undef,_}} = on_load_do_load(Mod, Code), + good_work = on_load_do_load(Mod, Code), + + ok. + +on_load_do_load(Mod, Code) -> + spawn(fun() -> + {module,Mod} = code:load_binary(Mod, "", Code) + end), + receive + Any -> Any + end. + +on_load_pending(_Config) -> + Mod = ?FUNCTION_NAME, + Tree1 = ?Q(["-module('@Mod@').\n", + "-on_load(f/0).\n", + "f() ->\n", + " register('@Mod@', self()),\n", + " receive _ -> ok end.\n"]), + merl:print(Tree1), + {ok,Mod,Code1} = merl:compile(Tree1), + + Tree2 = ?Q(["-module('@Mod@').\n", + "-export([t/0]).\n", + "t() -> ok.\n"]), + merl:print(Tree2), + {ok,Mod,Code2} = merl:compile(Tree2), + + Self = self(), + {_,Ref1} = + spawn_monitor(fun() -> + Self ! started1, + {module,Mod} = code:load_binary(Mod, "", Code1) + end), + receive started1 -> ok end, + timer:sleep(10), + {_,Ref2} = + spawn_monitor(fun() -> + Self ! started2, + {module,Mod} = code:load_binary(Mod, "", Code2), + ok = Mod:t() + end), + receive started2 -> ok end, + receive + Unexpected -> + ct:fail({unexpected,Unexpected}) + after 100 -> + ok + end, + Mod ! go, + receive + {'DOWN',Ref1,process,_,normal} -> ok + end, + receive + {'DOWN',Ref2,process,_,normal} -> ok + end, + ok = Mod:t(), + ok. + + %% Test that the native code of early loaded modules is loaded. native_early_modules(Config) when is_list(Config) -> case erlang:system_info(hipe_architecture) of diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index bf1548591a..eb58e92224 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -634,7 +634,7 @@ monitor_nodes_nodedown_reason(Config) when is_list(Config) -> stop_node(N4), true = net_kernel:disconnect(N2), TickTime = net_kernel:get_net_ticktime(), - SleepTime = TickTime + (TickTime div 4), + SleepTime = TickTime + (TickTime div 2), spawn(N3, fun () -> block_emu(SleepTime*1000), halt() @@ -911,15 +911,14 @@ monitor_nodes_otp_6481_test(Config, TestType) when is_list(Config) -> %% Verify that '{nodeup, Node}' comes before '{NodeMsg, 1}' (the message %% bringing up the connection). - no_msgs(500), {nodeup, Node} = receive Msg1 -> Msg1 end, - {NodeMsg, 1} = receive Msg2 -> Msg2 end, + {NodeMsg, N} = receive Msg2 -> Msg2 end, %% msg stream has begun, kill the node RemotePid ! {self(), kill_it}, %% Verify that '{nodedown, Node}' comes after the last '{NodeMsg, N}' %% message. - {nodedown, Node} = flush_node_msgs(NodeMsg, 2), + {nodedown, Node} = flush_node_msgs(NodeMsg, N+1), no_msgs(500), Mon = erlang:monitor(process, MN), @@ -932,8 +931,10 @@ monitor_nodes_otp_6481_test(Config, TestType) when is_list(Config) -> flush_node_msgs(NodeMsg, No) -> case receive Msg -> Msg end of - {NodeMsg, No} -> flush_node_msgs(NodeMsg, No+1); - OtherMsg -> OtherMsg + {NodeMsg, N} when N >= No -> + flush_node_msgs(NodeMsg, N+1); + OtherMsg -> + OtherMsg end. node_loop_send(Pid, Msg, No) -> diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl index 000994751f..be23a1933f 100644 --- a/lib/kernel/test/seq_trace_SUITE.erl +++ b/lib/kernel/test/seq_trace_SUITE.erl @@ -498,7 +498,13 @@ match_set_seq_token(Config) when is_list(Config) -> exit(P2, timeout), {error, "Test node hung"} end, - ok = check_match_set_seq_token_log(Lbl, Log), + + %% Sort the log on Pid, as events from different processes + %% are not guaranteed to arrive in a certain order to the + %% tracer + SortedLog = lists:keysort(2, Log), + + ok = check_match_set_seq_token_log(Lbl, SortedLog), %% stop_node(Sandbox), ok. @@ -551,13 +557,13 @@ do_match_set_seq_token(Label) -> check_match_set_seq_token_log( Label, - [{trace,C,call,{?MODULE,countdown,[B,Ref]}, {0,Label,0,C,0}}, + [{trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,2,B,1}}, + {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,4,B,3}}, + {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,6,B,5}}, + {trace,C,call,{?MODULE,countdown,[B,Ref]}, {0,Label,0,C,0}}, {trace,C,call,{?MODULE,countdown,[B,Ref,3]},{0,Label,0,C,0}}, - {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,2,B,1}}, {trace,C,call,{?MODULE,countdown,[B,Ref,2]},{0,Label,2,B,1}}, - {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,4,B,3}}, {trace,C,call,{?MODULE,countdown,[B,Ref,1]},{0,Label,4,B,3}}, - {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,6,B,5}}, {trace,C,call,{?MODULE,countdown,[B,Ref,0]},{0,Label,6,B,5}} ]) -> ok; diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl index d37623d1cc..77609b11ce 100644 --- a/lib/observer/src/observer_alloc_wx.erl +++ b/lib/observer/src/observer_alloc_wx.erl @@ -53,25 +53,29 @@ start_link(Notebook, Parent) -> init([Notebook, Parent]) -> try - Panel = wxPanel:new(Notebook), + TopP = wxPanel:new(Notebook), Main = wxBoxSizer:new(?wxVERTICAL), + Panel = wxPanel:new(TopP), + GSzr = wxBoxSizer:new(?wxVERTICAL), BorderFlags = ?wxLEFT bor ?wxRIGHT, - Carrier = make_win(alloc, Panel, Main, BorderFlags bor ?wxTOP), - Utilz = make_win(utilz, Panel, Main, BorderFlags), - - MemWin = {MemPanel,_} = create_mem_info(Panel), - wxSizer:add(Main, MemPanel, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM}, - {proportion, 1}, {border, 5}]), - wxWindow:setSizer(Panel, Main), + Carrier = make_win(alloc, Panel, GSzr, BorderFlags bor ?wxTOP), + Utilz = make_win(utilz, Panel, GSzr, BorderFlags), + wxWindow:setSizer(Panel, GSzr), + wxSizer:add(Main, Panel, [{flag, ?wxEXPAND},{proportion,2}]), + + MemWin = create_mem_info(TopP), + wxSizer:add(Main, MemWin, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM}, + {proportion, 1}, {border, 5}]), + wxWindow:setSizer(TopP, Main), Windows = [Carrier, Utilz], PaintInfo = setup_graph_drawing(Windows), - {Panel, #state{parent= Parent, - panel = Panel, - wins = Windows, - mem = MemWin, - paint = PaintInfo, - time = setup_time() - } + {TopP, #state{parent= Parent, + panel = Panel, + wins = Windows, + mem = MemWin, + paint = PaintInfo, + time = setup_time() + } } catch _:Err -> io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]), @@ -84,12 +88,14 @@ setup_time() -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% handle_event(#wx{id=?ID_REFRESH_INTERVAL, event=#wxCommand{type=command_menu_selected}}, - #state{panel=Panel, appmon=Old, wins=Wins0, time=#ti{fetch=F0} = Ti0} = State) -> + #state{active=Active, panel=Panel, appmon=Old, wins=Wins0, time=#ti{fetch=F0} = Ti0} = State) -> case interval_dialog(Panel, Ti0) of Ti0 -> {noreply, State}; #ti{fetch=F0} = Ti -> %% Same fetch interval force refresh Wins = [W#win{max=undefined} || W <- Wins0], {noreply, precalc(State#state{time=Ti, wins=Wins})}; + Ti when not Active -> + {noreply, State#state{time=Ti}}; Ti -> %% Changed fetch interval, drop all data {noreply, restart_fetcher(Old, State#state{time=Ti})} end; @@ -120,7 +126,7 @@ handle_info({Key, {promise_reply, {badrpc, _}}}, #state{async=Key} = State) -> {noreply, State#state{active=false, appmon=undefined}}; handle_info({Key, {promise_reply, SysInfo}}, - #state{async=Key, panel=Panel, samples=Data, active=Active, wins=Wins0, + #state{async=Key, panel=_Panel, samples=Data, active=Active, wins=Wins0, time=#ti{tick=Tick, disp=Disp0}=Ti} = S0) -> Disp = trunc(Disp0), Next = max(Tick - Disp, 0), @@ -131,7 +137,6 @@ handle_info({Key, {promise_reply, SysInfo}}, if Active -> update_alloc(S0, Info), State = precalc(S1), - catch wxWindow:refresh(Panel), {noreply, State}; true -> {noreply, S1} @@ -193,7 +198,8 @@ precalc(#state{samples=Data0, paint=Paint, time=Ti, wins=Wins0}=State) -> State#state{wins=Wins}. -update_alloc(#state{mem={_, Grid}}, Fields) -> +update_alloc(#state{mem=Grid}, Fields) -> + wxWindow:freeze(Grid), Max = wxListCtrl:getItemCount(Grid), Update = fun({Name, BS, CS}, Row) -> (Row >= Max) andalso wxListCtrl:insertItem(Grid, Row, ""), @@ -203,6 +209,7 @@ update_alloc(#state{mem={_, Grid}}, Fields) -> Row + 1 end, wx:foldl(Update, 0, Fields), + wxWindow:thaw(Grid), Fields. alloc_info(SysInfo) -> @@ -249,10 +256,9 @@ sum_alloc_one_instance([],BS,CS,TotalBS,TotalCS) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% create_mem_info(Parent) -> - Panel = wxPanel:new(Parent), - wxWindow:setBackgroundColour(Panel, {255,255,255}), Style = ?wxLC_REPORT bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES bor ?wxLC_VRULES, - Grid = wxListCtrl:new(Panel, [{style, Style}]), + Grid = wxListCtrl:new(Parent, [{style, Style}]), + Li = wxListItem:new(), AddListEntry = fun({Name, Align, DefSize}, Col) -> wxListItem:setText(Li, Name), @@ -267,12 +273,7 @@ create_mem_info(Parent) -> lists:foldl(AddListEntry, 0, ListItems), wxListItem:destroy(Li), - Sizer = wxBoxSizer:new(?wxVERTICAL), - wxSizer:add(Sizer, Grid, [{flag, ?wxEXPAND bor ?wxLEFT bor ?wxRIGHT}, - {border, 5}, {proportion, 1}]), - wxWindow:setSizerAndFit(Panel, Sizer), - {Panel, Grid}. - + Grid. create_menus(Parent, _) -> View = {"View", [#create_menu{id = ?ID_REFRESH_INTERVAL, text = "Graph Settings"}]}, diff --git a/lib/observer/src/observer_app_wx.erl b/lib/observer/src/observer_app_wx.erl index 0e01429aa7..cef83037d0 100644 --- a/lib/observer/src/observer_app_wx.erl +++ b/lib/observer/src/observer_app_wx.erl @@ -302,7 +302,9 @@ handle_info({delivery, _Pid, app, _Curr, {[], [], [], []}}, handle_info({delivery, Pid, app, Curr, AppData}, State = #state{panel=Panel, appmon=Pid, current=Curr, usegc=UseGC, app_w=AppWin, paint=#paint{font=Font}}) -> - GC = make_gc(AppWin, UseGC), + GC = if UseGC -> {?wxGC:create(AppWin), false}; + true -> {false, wxWindowDC:new(AppWin)} + end, setFont(GC, Font, {0,0,0}), App = build_tree(AppData, GC), destroy_gc(GC), diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index f0b8a004ec..c6a1c73c83 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -122,7 +122,7 @@ display_yes_no_dialog(Str) -> %% display_info(Parent, [{Title, [{Label, Info}]}]) -> {Panel, Sizer, InfoFieldsToUpdate} display_info(Frame, Info) -> Panel = wxPanel:new(Frame), - wxWindow:setBackgroundColour(Panel, {255,255,255}), + wxWindow:setBackgroundStyle(Panel, ?wxBG_STYLE_SYSTEM), Sizer = wxBoxSizer:new(?wxVERTICAL), wxSizer:addSpacer(Sizer, 5), Add = fun(BoxInfo) -> @@ -201,22 +201,21 @@ update_info2([Scroll = {_, _, _}|Fs], [{_, NewInfo}|Rest]) -> update_scroll_boxes(Scroll, NewInfo), update_info2(Fs, Rest); update_info2([Field|Fs], [{_Str, {click, Value}}|Rest]) -> - wxTextCtrl:setValue(Field, to_str(Value)), + wxStaticText:setLabel(Field, to_str(Value)), update_info2(Fs, Rest); update_info2([Field|Fs], [{_Str, Value}|Rest]) -> - wxTextCtrl:setValue(Field, to_str(Value)), + wxStaticText:setLabel(Field, to_str(Value)), update_info2(Fs, Rest); update_info2([Field|Fs], [undefined|Rest]) -> - wxTextCtrl:setValue(Field, ""), + wxStaticText:setLabel(Field, ""), update_info2(Fs, Rest); update_info2([], []) -> ok. update_scroll_boxes({_, _, 0}, {_, []}) -> ok; update_scroll_boxes({Win, Sizer, _}, {Type, List}) -> [wxSizerItem:deleteWindows(Child) || Child <- wxSizer:getChildren(Sizer)], - BC = wxWindow:getBackgroundColour(Win), Cursor = wxCursor:new(?wxCURSOR_HAND), - add_entries(Type, List, Win, Sizer, BC, Cursor), + add_entries(Type, List, Win, Sizer, Cursor), wxCursor:destroy(Cursor), wxSizer:recalcSizes(Sizer), wxWindow:refresh(Win), @@ -379,25 +378,22 @@ add_box(Panel, OuterBox, Cursor, Title, Proportion, {Format, List}) -> wxScrolledWindow:setScrollbars(Scroll,1,1,0,0), ScrollSizer = wxBoxSizer:new(?wxVERTICAL), wxScrolledWindow:setSizer(Scroll, ScrollSizer), - BC = wxWindow:getBackgroundColour(Panel), - wxWindow:setBackgroundColour(Scroll,BC), - add_entries(Format, List, Scroll, ScrollSizer, BC, Cursor), + wxWindow:setBackgroundStyle(Scroll, ?wxBG_STYLE_SYSTEM), + add_entries(Format, List, Scroll, ScrollSizer, Cursor), wxSizer:add(Box,Scroll,[{proportion,1},{flag,?wxEXPAND}]), wxSizer:add(OuterBox,Box,[{proportion,Proportion},{flag,?wxEXPAND}]), {Scroll,ScrollSizer,length(List)}. -add_entries(click, List, Scroll, ScrollSizer, BC, Cursor) -> +add_entries(click, List, Scroll, ScrollSizer, Cursor) -> Add = fun(Link) -> TC = link_entry(Scroll, Link, Cursor), - wxWindow:setBackgroundColour(TC,BC), - wxSizer:add(ScrollSizer,TC,[{flag,?wxEXPAND}]) + wxWindow:setBackgroundStyle(TC, ?wxBG_STYLE_SYSTEM), + wxSizer:add(ScrollSizer,TC, [{flag,?wxEXPAND}]) end, [Add(Link) || Link <- List]; -add_entries(plain, List, Scroll, ScrollSizer, _, _) -> +add_entries(plain, List, Scroll, ScrollSizer, _) -> Add = fun(String) -> - TC = wxTextCtrl:new(Scroll, ?wxID_ANY, - [{style,?SINGLE_LINE_STYLE}, - {value,String}]), + TC = wxStaticText:new(Scroll, ?wxID_ANY, String), wxSizer:add(ScrollSizer,TC,[{flag,?wxEXPAND}]) end, [Add(String) || String <- List]. @@ -435,51 +431,44 @@ create_box(Panel, {scroll_boxes,Data}) -> wxSizer:layout(OuterBox), {OuterBox, Boxes}; -create_box(Panel, Data) -> - {Title, Align, Info} = get_box_info(Data), - Box = wxStaticBoxSizer:new(?wxVERTICAL, Panel, [{label, Title}]), - LeftSize = get_max_size(Panel,Info), - LeftProportion = [{proportion,0}], - RightProportion = [{proportion,1}, {flag, Align bor ?wxEXPAND}], +create_box(Parent, Data) -> + {Title, _Align, Info} = get_box_info(Data), + Top = wxStaticBoxSizer:new(?wxVERTICAL, Parent, [{label, Title}]), + Panel = wxPanel:new(Parent), + Box = wxBoxSizer:new(?wxVERTICAL), + LeftSize = 30 + get_max_width(Panel,Info), + RightProportion = [{flag, ?wxEXPAND}], AddRow = fun({Desc0, Value0}) -> Desc = Desc0++":", Line = wxBoxSizer:new(?wxHORIZONTAL), - wxSizer:add(Line, - wxTextCtrl:new(Panel, ?wxID_ANY, - [{style,?SINGLE_LINE_STYLE}, - {size,LeftSize}, - {value,Desc}]), - LeftProportion), + Label = wxStaticText:new(Panel, ?wxID_ANY, Desc), + wxSizer:add(Line, 5, 0), + wxSizer:add(Line, Label), + wxSizer:setItemMinSize(Line, Label, LeftSize, -1), Field = case Value0 of {click,"unknown"} -> - wxTextCtrl:new(Panel, ?wxID_ANY, - [{style,?SINGLE_LINE_STYLE}, - {value,"unknown"}]); + wxStaticText:new(Panel, ?wxID_ANY,"unknown"); {click,Value} -> link_entry(Panel,Value); _ -> Value = to_str(Value0), - TCtrl = wxTextCtrl:new(Panel, ?wxID_ANY, - [{style,?SINGLE_LINE_STYLE}, - {value,Value}]), + TCtrl = wxStaticText:new(Panel, ?wxID_ANY,Value), length(Value) > 50 andalso wxWindow:setToolTip(TCtrl,wxToolTip:new(Value)), TCtrl end, wxSizer:add(Line, 10, 0), % space of size 10 horisontally wxSizer:add(Line, Field, RightProportion), - - {_,H,_,_} = wxTextCtrl:getTextExtent(Field,"Wj"), - wxTextCtrl:setMinSize(Field,{0,H}), - - wxSizer:add(Box, Line, [{proportion,0},{flag,?wxEXPAND}]), + wxSizer:add(Box, Line, [{proportion,1},{flag,?wxEXPAND}]), Field; (undefined) -> undefined end, InfoFields = [AddRow(Entry) || Entry <- Info], - {Box, InfoFields}. + wxWindow:setSizer(Panel, Box), + wxSizer:add(Top, Panel, [{proportion,1},{flag,?wxEXPAND}]), + {Top, InfoFields}. link_entry(Panel, Link) -> Cursor = wxCursor:new(?wxCURSOR_HAND), @@ -490,13 +479,12 @@ link_entry(Panel, Link, Cursor) -> link_entry2(Panel, to_link(Link), Cursor). link_entry2(Panel,{Target,Str},Cursor) -> - TC = wxTextCtrl:new(Panel, ?wxID_ANY, [{style, ?SINGLE_LINE_STYLE}]), - wxTextCtrl:setForegroundColour(TC,?wxBLUE), - wxTextCtrl:appendText(TC, Str), + TC = wxStaticText:new(Panel, ?wxID_ANY, Str), + wxWindow:setForegroundColour(TC,?wxBLUE), wxWindow:setCursor(TC, Cursor), - wxTextCtrl:connect(TC, left_down, [{userData,Target}]), - wxTextCtrl:connect(TC, enter_window), - wxTextCtrl:connect(TC, leave_window), + wxWindow:connect(TC, left_down, [{userData,Target}]), + wxWindow:connect(TC, enter_window), + wxWindow:connect(TC, leave_window), ToolTip = wxToolTip:new("Click to see properties for " ++ Str), wxWindow:setToolTip(TC, ToolTip), TC. @@ -521,23 +509,12 @@ html_window(Panel, Html) -> wxHtmlWindow:setPage(Win, Html), Win. -get_max_size(Panel,Info) -> - Txt = wxTextCtrl:new(Panel, ?wxID_ANY, []), - Size = get_max_size(Txt,Info,0,0), - wxTextCtrl:destroy(Txt), - Size. - -get_max_size(Txt,[{Desc,_}|Info],MaxX,MaxY) -> - {X,Y,_,_} = wxTextCtrl:getTextExtent(Txt,Desc++":"), - if X>MaxX -> - get_max_size(Txt,Info,X,Y); - true -> - get_max_size(Txt,Info,MaxX,MaxY) - end; -get_max_size(Txt,[undefined|Info],MaxX,MaxY) -> - get_max_size(Txt,Info,MaxX,MaxY); -get_max_size(_,[],X,_Y) -> - {X+2,-1}. +get_max_width(Parent,Info) -> + lists:foldl(fun({Desc,_}, Max) -> + {W, _, _, _} = wxWindow:getTextExtent(Parent, Desc), + max(W,Max); + (_, Max) -> Max + end, 0, Info). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% set_listctrl_col_size(LCtrl, Total) -> diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl index 017f07d2c4..1010a6af4c 100644 --- a/lib/observer/src/observer_perf_wx.erl +++ b/lib/observer/src/observer_perf_wx.erl @@ -100,7 +100,7 @@ setup_graph_drawing(Panels) -> IsWindows = element(1, os:type()) =:= win32, IgnoreCB = {callback, fun(_,_) -> ok end}, Do = fun(#win{panel=Panel}) -> - wxWindow:setBackgroundColour(Panel, ?wxWHITE), + wxWindow:setBackgroundStyle(Panel, ?wxBG_STYLE_SYSTEM), wxPanel:connect(Panel, paint, [callback]), IsWindows andalso wxPanel:connect(Panel, erase_background, [IgnoreCB]) @@ -142,6 +142,8 @@ handle_event(#wx{id=?ID_REFRESH_INTERVAL, event=#wxCommand{type=command_menu_sel #ti{fetch=F0} = Ti -> %% Same fetch interval force refresh Wins = [W#win{max=undefined} || W <- Wins0], {noreply, precalc(State#state{time=Ti, wins=Wins})}; + Ti when Old =:= undefined -> + {noreply, State#state{time=Ti}}; Ti -> %% Changed fetch interval, drop all data {noreply, restart_fetcher(node(Old), State#state{time=Ti})} end; @@ -762,7 +764,10 @@ make_gc(Panel,UseGC) -> destroy_gc({GC, DC}) -> (GC =/= false) andalso ?wxGC:destroy(GC), - wxPaintDC:destroy(DC). + case DC =/= false andalso wx:getObjectType(DC) of + false -> ok; + Type -> Type:destroy(DC) + end. haveGC() -> try diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 9d6aa84384..cff5fbb474 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -125,11 +125,11 @@ handle_event(#wx{event=#wxMouse{type=left_down}, userData=TargetPid}, State) -> {noreply, State}; handle_event(#wx{obj=Obj, event=#wxMouse{type=enter_window}}, State) -> - wxTextCtrl:setForegroundColour(Obj,{0,0,100,255}), + wxStaticText:setForegroundColour(Obj,{0,0,100,255}), {noreply, State}; handle_event(#wx{obj=Obj, event=#wxMouse{type=leave_window}}, State) -> - wxTextCtrl:setForegroundColour(Obj,?wxBLUE), + wxStaticText:setForegroundColour(Obj,?wxBLUE), {noreply, State}; handle_event(#wx{event=#wxHtmlLink{linkInfo=#wxHtmlLinkInfo{href=Href}}}, diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index a795c4fe25..73ed890802 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 <- [r16b,'17'], ?t:is_release_available(R)] ++ [current], + Rels = [R || R <- ['17','18'], ?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]. @@ -606,21 +606,21 @@ dos_dump(DataDir,Rel,Dump) -> rel_opt(Rel) -> case Rel of - r16b -> [{erl,[{release,"r16b_latest"}]}]; '17' -> [{erl,[{release,"17_latest"}]}]; + '18' -> [{erl,[{release,"18_latest"}]}]; current -> [] end. dump_prefix(Rel) -> case Rel of - r16b -> "r16b_dump."; '17' -> "r17_dump."; - current -> "r18_dump." + '18' -> "r18_dump."; + current -> "r19_dump." end. compat_rel(Rel) -> case Rel of - r16b -> "+R16 "; '17' -> "+R17 "; + '18' -> "+R18 "; current -> "" end. diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl index 0045b2c09f..5664615230 100644 --- a/lib/os_mon/src/cpu_sup.erl +++ b/lib/os_mon/src/cpu_sup.erl @@ -68,7 +68,7 @@ -type util_cpus() :: 'all' | integer() | [integer()]. -type util_state() :: 'user' | 'nice_user' | 'kernel' | 'wait' | 'idle'. --type util_value() :: {util_state(), float()} | float(). +-type util_value() :: [{util_state(), float()}] | float(). -type util_desc() :: {util_cpus(), util_value(), util_value(), []}. %%---------------------------------------------------------------------- diff --git a/lib/runtime_tools/c_src/Makefile.in b/lib/runtime_tools/c_src/Makefile.in index 70b48daf97..4530a83aee 100644 --- a/lib/runtime_tools/c_src/Makefile.in +++ b/lib/runtime_tools/c_src/Makefile.in @@ -91,7 +91,7 @@ $(OBJDIR): $(LIBDIR): -@mkdir -p $(LIBDIR) -$(OBJDIR)/%$(TYPEMARKER).o: %.c +$(OBJDIR)/%$(TYPEMARKER).o: %.c dyntrace_lttng.h $(V_CC) -c -o $@ $(ALL_CFLAGS) $< $(LIBDIR)/%$(TYPEMARKER).@DED_EXT@: $(OBJDIR)/%$(TYPEMARKER).o diff --git a/lib/runtime_tools/c_src/dyntrace.c b/lib/runtime_tools/c_src/dyntrace.c index 0ef8eaf4d3..0178d95efb 100644 --- a/lib/runtime_tools/c_src/dyntrace.c +++ b/lib/runtime_tools/c_src/dyntrace.c @@ -29,7 +29,13 @@ #include "sys.h" #include "dtrace-wrapper.h" #if defined(USE_DYNAMIC_TRACE) && (defined(USE_DTRACE) || defined(USE_SYSTEMTAP)) -#define HAVE_USE_DTRACE 1 +# define HAVE_USE_DTRACE 1 +#endif +#if defined(USE_LTTNG) +# define HAVE_USE_LTTNG 1 +# define TRACEPOINT_DEFINE +# define TRACEPOINT_CREATE_PROBES +# include "dyntrace_lttng.h" #endif void dtrace_nifenv_str(ErlNifEnv *env, char *process_buf); @@ -60,11 +66,56 @@ static ERL_NIF_TERM user_trace_s1(ErlNifEnv* env, int argc, const ERL_NIF_TERM a static ERL_NIF_TERM user_trace_i4s4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM user_trace_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +#ifdef HAVE_USE_LTTNG +static ERL_NIF_TERM trace_procs(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_ports(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_running_procs(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_running_ports(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_call(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_send(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_receive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM trace_garbage_collection(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ERL_NIF_TERM enabled_procs(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_ports(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_running_procs(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_running_ports(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_call(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_send(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_receive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM enabled_garbage_collection(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +#endif + + static ErlNifFunc nif_funcs[] = { {"available", 0, available}, {"user_trace_s1", 1, user_trace_s1}, {"user_trace_i4s4", 9, user_trace_i4s4}, - {"user_trace_n", 10, user_trace_n} + {"user_trace_n", 10, user_trace_n}, +#ifdef HAVE_USE_LTTNG + {"trace_procs", 6, trace_procs}, + {"trace_ports", 6, trace_ports}, + {"trace_running_procs", 6, trace_running_procs}, + {"trace_running_ports", 6, trace_running_ports}, + {"trace_call", 6, trace_call}, + {"trace_send", 6, trace_send}, + {"trace_receive", 6, trace_receive}, + {"trace_garbage_collection", 6, trace_garbage_collection}, + {"enabled_procs", 3, enabled_procs}, + {"enabled_ports", 3, enabled_ports}, + {"enabled_running_procs", 3, enabled_running_procs}, + {"enabled_running_ports", 3, enabled_running_ports}, + {"enabled_call", 3, enabled_call}, + {"enabled_send", 3, enabled_send}, + {"enabled_receive", 3, enabled_receive}, + {"enabled_garbage_collection", 3, enabled_garbage_collection}, +#endif + {"enabled", 3, enabled}, + {"trace", 5, trace}, + {"trace", 6, trace} }; ERL_NIF_INIT(dyntrace, nif_funcs, load, NULL, NULL, NULL) @@ -76,6 +127,61 @@ static ERL_NIF_TERM atom_not_available; static ERL_NIF_TERM atom_badarg; static ERL_NIF_TERM atom_ok; +static ERL_NIF_TERM atom_trace; +static ERL_NIF_TERM atom_seq_trace; +static ERL_NIF_TERM atom_remove; +static ERL_NIF_TERM atom_discard; + +#ifdef HAVE_USE_LTTNG + +/* gc atoms */ + +static ERL_NIF_TERM atom_gc_minor_start; +static ERL_NIF_TERM atom_gc_minor_end; +static ERL_NIF_TERM atom_gc_major_start; +static ERL_NIF_TERM atom_gc_major_end; + +static ERL_NIF_TERM atom_old_heap_block_size; /* for debug */ +static ERL_NIF_TERM atom_heap_block_size; /* for debug */ + +/* process 'procs' */ + +static ERL_NIF_TERM atom_spawn; +static ERL_NIF_TERM atom_exit; +static ERL_NIF_TERM atom_register; +static ERL_NIF_TERM atom_unregister; +static ERL_NIF_TERM atom_link; +static ERL_NIF_TERM atom_unlink; +static ERL_NIF_TERM atom_getting_linked; +static ERL_NIF_TERM atom_getting_unlinked; + +/* process 'running' and 'exiting' */ + +static ERL_NIF_TERM atom_in; +static ERL_NIF_TERM atom_out; +static ERL_NIF_TERM atom_in_exiting; +static ERL_NIF_TERM atom_out_exiting; +static ERL_NIF_TERM atom_out_exited; + +/* process messages 'send' and 'receive' */ + +static ERL_NIF_TERM atom_send; +static ERL_NIF_TERM atom_receive; +static ERL_NIF_TERM atom_send_to_non_existing_process; + +/* ports 'ports' */ + +static ERL_NIF_TERM atom_open; +static ERL_NIF_TERM atom_closed; + +/* 'call' */ + +static ERL_NIF_TERM atom_call; +static ERL_NIF_TERM atom_return_from; +static ERL_NIF_TERM atom_return_to; +static ERL_NIF_TERM atom_exception_from; +#endif + static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) { atom_true = enif_make_atom(env,"true"); @@ -85,6 +191,61 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) atom_badarg = enif_make_atom(env,"badarg"); atom_ok = enif_make_atom(env,"ok"); + atom_trace = enif_make_atom(env,"trace"); + atom_seq_trace = enif_make_atom(env,"seq_trace"); + atom_remove = enif_make_atom(env,"remove"); + atom_discard = enif_make_atom(env,"discard"); + +#ifdef HAVE_USE_LTTNG + + /* gc */ + + atom_gc_minor_start = enif_make_atom(env,"gc_minor_start"); + atom_gc_minor_end = enif_make_atom(env,"gc_minor_end"); + atom_gc_major_start = enif_make_atom(env,"gc_major_start"); + atom_gc_major_end = enif_make_atom(env,"gc_major_end"); + + atom_old_heap_block_size = enif_make_atom(env,"old_heap_block_size"); + atom_heap_block_size = enif_make_atom(env,"heap_block_size"); + + /* process 'proc' */ + + atom_spawn = enif_make_atom(env,"spawn"); + atom_exit = enif_make_atom(env,"exit"); + atom_register = enif_make_atom(env,"register"); + atom_unregister = enif_make_atom(env,"unregister"); + atom_link = enif_make_atom(env,"link"); + atom_unlink = enif_make_atom(env,"unlink"); + atom_getting_unlinked = enif_make_atom(env,"getting_unlinked"); + atom_getting_linked = enif_make_atom(env,"getting_linked"); + + /* process 'running' and 'exiting' */ + + atom_in = enif_make_atom(env,"in"); + atom_out = enif_make_atom(env,"out"); + atom_in_exiting = enif_make_atom(env,"in_exiting"); + atom_out_exiting = enif_make_atom(env,"out_exiting"); + atom_out_exited = enif_make_atom(env,"out_exited"); + + /* process messages 'send' and 'receive' */ + + atom_send = enif_make_atom(env,"send"); + atom_receive = enif_make_atom(env,"receive"); + atom_send_to_non_existing_process = enif_make_atom(env,"send_to_non_existing_process"); + + /* ports 'ports' */ + + atom_open = enif_make_atom(env,"open"); + atom_closed = enif_make_atom(env,"closed"); + + /* 'call' */ + + atom_call = enif_make_atom(env,"call"); + atom_return_from = enif_make_atom(env,"return_from"); + atom_return_to = enif_make_atom(env,"return_to"); + atom_exception_from = enif_make_atom(env,"exception_from"); +#endif + return 0; } @@ -123,3 +284,442 @@ static ERL_NIF_TERM user_trace_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar return atom_error; #endif } + +static ERL_NIF_TERM enabled(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ +#ifdef HAVE_USE_LTTNG + ASSERT(argc == 3); + return atom_trace; +#endif + return atom_remove; +} + +static ERL_NIF_TERM trace(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return atom_ok; +} + +#ifdef HAVE_USE_LTTNG +static ERL_NIF_TERM enabled_garbage_collection(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + + if (argv[0] == atom_gc_minor_start && LTTNG_ENABLED(gc_minor_start)) { + return atom_trace; + } else if (argv[0] == atom_gc_minor_end && LTTNG_ENABLED(gc_minor_end)) { + return atom_trace; + } else if (argv[0] == atom_gc_major_start && LTTNG_ENABLED(gc_major_start)) { + return atom_trace; + } else if (argv[0] == atom_gc_major_end && LTTNG_ENABLED(gc_major_end)) { + return atom_trace; + } + + return atom_discard; +} + +static ERL_NIF_TERM trace_garbage_collection(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_procbuf(pid); + ERL_NIF_TERM gci, tup; + const ERL_NIF_TERM *vals; + int arity; + unsigned long ohbsz, nhbsz, size; + + ASSERT(argc == 6); + + /* Assume gc info order does not change */ + gci = argv[3]; + + /* get reclaimed or need */ + enif_get_list_cell(env, gci, &tup, &gci); + enif_get_tuple(env, tup, &arity, &vals); + ASSERT(arity == 2); + enif_get_ulong(env, vals[1], &size); + + /* get old heap block size */ + enif_get_list_cell(env, gci, &tup, &gci); + enif_get_tuple(env, tup, &arity, &vals); + ASSERT(arity == 2); + ASSERT(vals[0] == atom_old_heap_block_size); + enif_get_ulong(env, vals[1], &ohbsz); + + /* get new heap block size */ + enif_get_list_cell(env, gci, &tup, &gci); + enif_get_tuple(env, tup, &arity, &vals); + ASSERT(arity == 2); + ASSERT(vals[0] == atom_heap_block_size); + enif_get_ulong(env, vals[1], &nhbsz); + + lttng_pid_to_str(argv[2], pid); + + if (argv[0] == atom_gc_minor_start) { + LTTNG4(gc_minor_start, pid, size, nhbsz, ohbsz); + } else if (argv[0] == atom_gc_minor_end) { + LTTNG4(gc_minor_end, pid, size, nhbsz, ohbsz); + } else if (argv[0] == atom_gc_major_start) { + LTTNG4(gc_major_start, pid, size, nhbsz, ohbsz); + } else if (argv[0] == atom_gc_major_end) { + LTTNG4(gc_major_end, pid, size, nhbsz, ohbsz); + } + return atom_ok; +} + +static ERL_NIF_TERM enabled_call(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + + if (argv[0] == atom_call && LTTNG_ENABLED(function_call)) + return atom_trace; + else if (argv[0] == atom_return_from && LTTNG_ENABLED(function_return)) + return atom_trace; + else if (argv[0] == atom_exception_from && LTTNG_ENABLED(function_exception)) + return atom_trace; + + return atom_discard; +} + +static ERL_NIF_TERM trace_call(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_procbuf(pid); + unsigned int len; + char undef[] = "undefined"; + + lttng_pid_to_str(argv[2], pid); + + if (argv[0] == atom_call) { + const ERL_NIF_TERM* tuple; + int arity; + lttng_decl_mfabuf(mfa); + + if (enif_get_tuple(env, argv[3], &arity, &tuple)) { + if (enif_is_list(env, tuple[2])) { + enif_get_list_length(env, tuple[2], &len); + } else { + enif_get_uint(env, tuple[2], &len); + } + lttng_mfa_to_str(tuple[0], tuple[1], len, mfa); + LTTNG3(function_call, pid, mfa, 0); + } else { + LTTNG3(function_call, pid, undef, 0); + } + } else if (argv[0] == atom_return_from) { + const ERL_NIF_TERM* tuple; + int arity; + lttng_decl_mfabuf(mfa); + + if (enif_get_tuple(env, argv[3], &arity, &tuple)) { + enif_get_uint(env, tuple[2], &len); + lttng_mfa_to_str(tuple[0], tuple[1], len, mfa); + LTTNG3(function_return, pid, mfa, 0); + } else { + LTTNG3(function_return, pid, undef, 0); + } + } else if (argv[0] == atom_return_to) { + const ERL_NIF_TERM* tuple; + int arity; + lttng_decl_mfabuf(mfa); + + if (enif_get_tuple(env, argv[3], &arity, &tuple)) { + enif_get_uint(env, tuple[2], &len); + lttng_mfa_to_str(tuple[0], tuple[1], len, mfa); + LTTNG3(function_return, pid, mfa, 0); + } else { + LTTNG3(function_return, pid, undef, 0); + } + } else if (argv[0] == atom_exception_from) { + const ERL_NIF_TERM* tuple; + int arity; + lttng_decl_mfabuf(mfa); + char class[LTTNG_BUFFER_SZ]; + + enif_get_tuple(env, argv[4], &arity, &tuple); + erts_snprintf(class, LTTNG_BUFFER_SZ, "%T", tuple[0]); + + if (enif_get_tuple(env, argv[3], &arity, &tuple)) { + enif_get_uint(env, tuple[2], &len); + lttng_mfa_to_str(tuple[0], tuple[1], len, mfa); + LTTNG3(function_exception, pid, mfa, class); + } else { + LTTNG3(function_exception, pid, undef, class); + } + } + return atom_ok; +} + +static ERL_NIF_TERM enabled_send(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + if (LTTNG_ENABLED(message_send)) + return atom_trace; + + return atom_discard; +} + +static ERL_NIF_TERM trace_send(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_procbuf(pid); + lttng_pid_to_str(argv[2], pid); + + if (argv[0] == atom_send) { + lttng_decl_procbuf(to); + char msg[LTTNG_BUFFER_SZ]; + + lttng_pid_to_str(argv[4], to); + erts_snprintf(msg, LTTNG_BUFFER_SZ, "%T", argv[3]); + + LTTNG3(message_send, pid, to, msg); + } else if (argv[0] == atom_send_to_non_existing_process) { + lttng_decl_procbuf(to); + char msg[LTTNG_BUFFER_SZ]; + + lttng_pid_to_str(argv[4], to); + erts_snprintf(msg, LTTNG_BUFFER_SZ, "%T", argv[3]); + /* mark it as non existing ? */ + + LTTNG3(message_send, pid, to, msg); + } + return atom_ok; +} + +static ERL_NIF_TERM enabled_receive(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + if (LTTNG_ENABLED(message_receive)) + return atom_trace; + + return atom_discard; +} + +static ERL_NIF_TERM trace_receive(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + if (argv[0] == atom_receive) { + lttng_decl_procbuf(pid); + char msg[LTTNG_BUFFER_SZ]; + + lttng_pid_to_str(argv[2], pid); + erts_snprintf(msg, LTTNG_BUFFER_SZ, "%T", argv[3]); + + LTTNG2(message_receive, pid, msg); + } + return atom_ok; +} + +static ERL_NIF_TERM enabled_procs(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + + if (argv[0] == atom_spawn && LTTNG_ENABLED(process_spawn)) { + return atom_trace; + } else if (argv[0] == atom_register && LTTNG_ENABLED(process_register)) { + return atom_trace; + } else if (argv[0] == atom_unregister && LTTNG_ENABLED(process_register)) { + return atom_trace; + } else if (argv[0] == atom_link && LTTNG_ENABLED(process_link)) { + return atom_trace; + } else if (argv[0] == atom_unlink && LTTNG_ENABLED(process_link)) { + return atom_trace; + } else if (argv[0] == atom_getting_linked && LTTNG_ENABLED(process_link)) { + return atom_trace; + } else if (argv[0] == atom_getting_unlinked && LTTNG_ENABLED(process_link)) { + return atom_trace; + } else if (argv[0] == atom_exit && LTTNG_ENABLED(process_exit)) { + return atom_trace; + } + + return atom_discard; +} + +static ERL_NIF_TERM trace_procs(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_procbuf(pid); + lttng_decl_procbuf(to); + + lttng_pid_to_str(argv[2], pid); + + /* spawn */ + if (argv[0] == atom_spawn) { + char undef[] = "undefined"; + const ERL_NIF_TERM* tuple; + int arity; + unsigned int len; + lttng_decl_mfabuf(mfa); + + lttng_pid_to_str(argv[3], to); + + if (enif_get_tuple(env, argv[4], &arity, &tuple)) { + if (enif_is_list(env, tuple[2])) { + enif_get_list_length(env, tuple[2], &len); + } else { + enif_get_uint(env, tuple[2], &len); + } + lttng_mfa_to_str(tuple[0], tuple[1], len, mfa); + LTTNG3(process_spawn, to, pid, mfa); + } else { + LTTNG3(process_spawn, to, pid, undef); + } + + /* register */ + } else if (argv[0] == atom_register) { + char name[LTTNG_BUFFER_SZ]; + erts_snprintf(name, LTTNG_BUFFER_SZ, "%T", argv[3]); + LTTNG3(process_register, pid, name, "register"); + } else if (argv[0] == atom_unregister) { + char name[LTTNG_BUFFER_SZ]; + erts_snprintf(name, LTTNG_BUFFER_SZ, "%T", argv[3]); + LTTNG3(process_register, pid, name, "unregister"); + /* link */ + } else if (argv[0] == atom_link) { + lttng_pid_to_str(argv[3], to); + LTTNG3(process_link, pid, to, "link"); + } else if (argv[0] == atom_unlink) { + lttng_pid_to_str(argv[3], to); + LTTNG3(process_link, pid, to, "unlink"); + } else if (argv[0] == atom_getting_linked) { + lttng_pid_to_str(argv[3], to); + LTTNG3(process_link, to, pid, "link"); + } else if (argv[0] == atom_getting_unlinked) { + lttng_pid_to_str(argv[3], to); + LTTNG3(process_link, to, pid, "unlink"); + /* exit */ + } else if (argv[0] == atom_exit) { + char reason[LTTNG_BUFFER_SZ]; + erts_snprintf(reason, LTTNG_BUFFER_SZ, "%T", argv[3]); + LTTNG2(process_exit, pid, reason); + } + return atom_ok; +} + +static ERL_NIF_TERM enabled_ports(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + + if (argv[0] == atom_open && LTTNG_ENABLED(port_open)) { + return atom_trace; + } else if (argv[0] == atom_link && LTTNG_ENABLED(port_link)) { + return atom_trace; + } else if (argv[0] == atom_unlink && LTTNG_ENABLED(port_link)) { + return atom_trace; + } else if (argv[0] == atom_getting_linked && LTTNG_ENABLED(port_link)) { + return atom_trace; + } else if (argv[0] == atom_getting_unlinked && LTTNG_ENABLED(port_link)) { + return atom_trace; + } else if (argv[0] == atom_closed && LTTNG_ENABLED(port_exit)) { + return atom_trace; + } + + return atom_discard; +} + +static ERL_NIF_TERM trace_ports(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_portbuf(port); + lttng_decl_procbuf(to); + + lttng_portid_to_str(argv[2], port); + + /* open and closed */ + if (argv[0] == atom_open) { + char driver[LTTNG_BUFFER_SZ]; + lttng_decl_procbuf(pid); + lttng_pid_to_str(argv[3], pid); + + erts_snprintf(driver, LTTNG_BUFFER_SZ, "%T", argv[4]); + LTTNG3(port_open, pid, driver, port); + } else if (argv[0] == atom_closed) { + char reason[LTTNG_BUFFER_SZ]; + erts_snprintf(reason, LTTNG_BUFFER_SZ, "%T", argv[3]); + + LTTNG2(port_exit, port, reason); + /* link */ + } else if (argv[0] == atom_link) { + lttng_pid_to_str(argv[3], to); + LTTNG3(port_link, port, to, "link"); + } else if (argv[0] == atom_unlink) { + lttng_pid_to_str(argv[3], to); + LTTNG3(port_link, port, to, "unlink"); + } else if (argv[0] == atom_getting_linked) { + lttng_pid_to_str(argv[3], to); + LTTNG3(port_link, to, port, "link"); + } else if (argv[0] == atom_getting_unlinked) { + lttng_pid_to_str(argv[3], to); + LTTNG3(port_link, to, port, "unlink"); + } + return atom_ok; +} + +static ERL_NIF_TERM enabled_running_procs(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + + if (LTTNG_ENABLED(process_scheduled)) + return atom_trace; + + return atom_discard; +} + +static ERL_NIF_TERM trace_running_procs(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_procbuf(pid); + const ERL_NIF_TERM* tuple; + char *mfastr = "undefined"; + int arity; + lttng_decl_mfabuf(mfa); + + lttng_pid_to_str(argv[2], pid); + + if (enif_get_tuple(env, argv[3], &arity, &tuple)) { + int val; + enif_get_int(env, tuple[2], &val); + lttng_mfa_to_str(tuple[0], tuple[1], val, mfa); + mfastr = mfa; + } + /* running processes */ + if (argv[0] == atom_in) { + LTTNG3(process_scheduled, pid, mfastr, "in"); + } else if (argv[0] == atom_out) { + LTTNG3(process_scheduled, pid, mfastr, "out"); + /* exiting */ + } else if (argv[0] == atom_in_exiting) { + LTTNG3(process_scheduled, pid, mfastr, "in_exiting"); + } else if (argv[0] == atom_out_exiting) { + LTTNG3(process_scheduled, pid, mfastr, "out_exiting"); + } else if (argv[0] == atom_out_exited) { + LTTNG3(process_scheduled, pid, mfastr, "out_exited"); + } + + return atom_ok; +} + +static ERL_NIF_TERM enabled_running_ports(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) +{ + ASSERT(argc == 3); + + if (LTTNG_ENABLED(port_scheduled)) + return atom_trace; + + return atom_discard; +} + +static ERL_NIF_TERM trace_running_ports(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + lttng_decl_procbuf(pid); + lttng_decl_mfabuf(where); + + lttng_portid_to_str(argv[2], pid); + erts_snprintf(where, LTTNG_BUFFER_SZ, "%T", argv[3]); + + /* running ports */ + if (argv[0] == atom_in) { + LTTNG3(port_scheduled, pid, where, "in"); + } else if (argv[0] == atom_out) { + LTTNG3(port_scheduled, pid, where, "out"); + /* exiting */ + } else if (argv[0] == atom_in_exiting) { + LTTNG3(port_scheduled, pid, where, "in_exiting"); + } else if (argv[0] == atom_out_exiting) { + LTTNG3(port_scheduled, pid, where, "out_exiting"); + } else if (argv[0] == atom_out_exited) { + LTTNG3(port_scheduled, pid, where, "out_exited"); + } + return atom_ok; +} +#endif diff --git a/lib/runtime_tools/c_src/dyntrace_lttng.h b/lib/runtime_tools/c_src/dyntrace_lttng.h new file mode 100644 index 0000000000..3550a1cab5 --- /dev/null +++ b/lib/runtime_tools/c_src/dyntrace_lttng.h @@ -0,0 +1,367 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2016. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +#undef TRACEPOINT_PROVIDER +#define TRACEPOINT_PROVIDER com_ericsson_dyntrace + +#if !defined(DYNTRACE_LTTNG_H) || defined(TRACEPOINT_HEADER_MULTI_READ) +#define DYNTRACE_LTTNG_H + +#include <lttng/tracepoint.h> + +#define LTTNG1(Name, Arg1) \ + tracepoint(com_ericsson_dyntrace, Name, (Arg1)) + +#define LTTNG2(Name, Arg1, Arg2) \ + tracepoint(com_ericsson_dyntrace, Name, (Arg1), (Arg2)) + +#define LTTNG3(Name, Arg1, Arg2, Arg3) \ + tracepoint(com_ericsson_dyntrace, Name, (Arg1), (Arg2), (Arg3)) + +#define LTTNG4(Name, Arg1, Arg2, Arg3, Arg4) \ + tracepoint(com_ericsson_dyntrace, Name, (Arg1), (Arg2), (Arg3), (Arg4)) + +#define LTTNG5(Name, Arg1, Arg2, Arg3, Arg4, Arg5) \ + tracepoint(com_ericsson_dyntrace, Name, (Arg1), (Arg2), (Arg3), (Arg4), (Arg5)) + +#define LTTNG_ENABLED(Name) \ + tracepoint_enabled(com_ericsson_dyntrace, Name) + +#define LTTNG_BUFFER_SZ (256) +#define LTTNG_PROC_BUFFER_SZ (16) +#define LTTNG_PORT_BUFFER_SZ (20) +#define LTTNG_MFA_BUFFER_SZ (256) + +#define lttng_decl_procbuf(Name) \ + char Name[LTTNG_PROC_BUFFER_SZ] + +#define lttng_decl_portbuf(Name) \ + char Name[LTTNG_PORT_BUFFER_SZ] + +#define lttng_decl_mfabuf(Name) \ + char Name[LTTNG_MFA_BUFFER_SZ] + +#define lttng_pid_to_str(pid, name) \ + erts_snprintf(name, LTTNG_PROC_BUFFER_SZ, "%T", (pid)) + +#define lttng_portid_to_str(pid, name) \ + erts_snprintf(name, LTTNG_PORT_BUFFER_SZ, "%T", (pid)) + +#define lttng_proc_to_str(p, name) \ + lttng_pid_to_str(((p) ? (p)->common.id : ERTS_INVALID_PID), name) + +#define lttng_port_to_str(p, name) \ + lttng_portid_to_str(((p) ? (p)->common.id : ERTS_INVALID_PORT), name) + +#define lttng_mfa_to_str(m,f,a, Name) \ + erts_snprintf(Name, LTTNG_MFA_BUFFER_SZ, "%T:%T/%lu", (Eterm)(m), (Eterm)(f), (Uint)(a)) + +/* Process scheduling */ + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + process_spawn, + TP_ARGS( + char*, p, + char*, parent, + char*, mfa + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_string(parent, parent) + ctf_string(entry, mfa) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + process_link, + TP_ARGS( + char*, from, + char*, to, + char*, type + ), + TP_FIELDS( + ctf_string(from, from) + ctf_string(to, to) + ctf_string(type, type) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + process_exit, + TP_ARGS( + char*, p, + char*, reason + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_string(reason, reason) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + process_register, + TP_ARGS( + char*, pid, + char*, name, + char*, type + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(name, name) + ctf_string(type, type) + ) +) + +/* Scheduled */ + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + process_scheduled, + TP_ARGS( + char*, p, + char*, mfa, + char*, type + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_string(entry, mfa) + ctf_string(type, type) + ) +) + +/* Ports */ + + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + port_open, + TP_ARGS( + char*, pid, + char*, driver, + char*, port + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(driver, driver) + ctf_string(port, port) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + port_exit, + TP_ARGS( + char*, port, + char*, reason + ), + TP_FIELDS( + ctf_string(port, port) + ctf_string(reason, reason) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + port_link, + TP_ARGS( + char*, from, + char*, to, + char*, type + ), + TP_FIELDS( + ctf_string(from, from) + ctf_string(to, to) + ctf_string(type, type) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + port_scheduled, + TP_ARGS( + char*, p, + char*, op, + char*, type + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_string(entry, op) + ctf_string(type, type) + ) +) + +/* Call tracing */ + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + function_call, + TP_ARGS( + char*, pid, + char*, mfa, + unsigned int, depth + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(entry, mfa) + ctf_integer(unsigned int, depth, depth) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + function_return, + TP_ARGS( + char*, pid, + char*, mfa, + unsigned int, depth + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(entry, mfa) + ctf_integer(unsigned int, depth, depth) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + function_exception, + TP_ARGS( + char*, pid, + char*, mfa, + char*, type + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(entry, mfa) + ctf_string(class, type) + ) +) + +/* Process messages */ + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + message_send, + TP_ARGS( + char*, sender, + char*, receiver, + char*, msg + ), + TP_FIELDS( + ctf_string(from, sender) + ctf_string(to, receiver) + ctf_string(message, msg) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + message_receive, + TP_ARGS( + char*, receiver, + char*, msg + ), + TP_FIELDS( + ctf_string(to, receiver) + ctf_string(message, msg) + ) +) + +/* Process Memory */ + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + gc_minor_start, + TP_ARGS( + char*, p, + unsigned long, need, + unsigned long, nh, + unsigned long, oh + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_integer(unsigned long, need, need) + ctf_integer(unsigned long, heap, nh) + ctf_integer(unsigned long, old_heap, oh) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + gc_minor_end, + TP_ARGS( + char*, p, + unsigned long, reclaimed, + unsigned long, nh, + unsigned long, oh + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_integer(unsigned long, reclaimed, reclaimed) + ctf_integer(unsigned long, heap, nh) + ctf_integer(unsigned long, old_heap, oh) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + gc_major_start, + TP_ARGS( + char*, p, + unsigned long, need, + unsigned long, nh, + unsigned long, oh + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_integer(unsigned long, need, need) + ctf_integer(unsigned long, heap, nh) + ctf_integer(unsigned long, old_heap, oh) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_dyntrace, + gc_major_end, + TP_ARGS( + char*, p, + unsigned long, reclaimed, + unsigned long, nh, + unsigned long, oh + ), + TP_FIELDS( + ctf_string(pid, p) + ctf_integer(unsigned long, reclaimed, reclaimed) + ctf_integer(unsigned long, heap, nh) + ctf_integer(unsigned long, old_heap, oh) + ) +) + +#endif /* DYNTRACE_LTTNG_H */ + +#undef TRACEPOINT_INCLUDE +#define TRACEPOINT_INCLUDE "./dyntrace_lttng.h" + +/* This part must be outside protection */ +#include <lttng/tracepoint-event.h> diff --git a/lib/runtime_tools/doc/src/LTTng.xml b/lib/runtime_tools/doc/src/LTTng.xml new file mode 100644 index 0000000000..4a87133c57 --- /dev/null +++ b/lib/runtime_tools/doc/src/LTTng.xml @@ -0,0 +1,461 @@ +<?xml version="1.0" encoding="utf8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> +<chapter> + <header> + <copyright> + <year>2016</year><year>2016</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + </legalnotice> + + <title>LTTng and Erlang/OTP</title> + <prepared></prepared> + <responsible></responsible> + <docno></docno> + <approved></approved> + <checked></checked> + <date>2016-04-27</date> + <rev></rev> + <file>LTTng.xml</file> + </header> + + <section> + <title>Introduction</title> + <p>The Linux Trace Toolkit: next generation is an open source system software package + for correlated tracing of the Linux kernel, user applications and libraries. </p> + <p>For more information, please visit <url href="http://lttng.org">http://lttng.org</url></p> + </section> + + <section> + <title>Building Erlang/OTP with LTTng support</title> + <p> + Configure and build Erlang with LTTng support: + </p> + <p>For LTTng to work properly with Erlang/OTP you need + the following packages installed:</p> + + <list type="bulleted"> + <item><p>LTTng-tools: a command line interface to control tracing sessions.</p></item> + <item><p>LTTng-UST: user space tracing library.</p></item> + </list> + + <p>On Ubuntu this can be installed via <c>aptitude</c>:</p> + + <code type="none">$ sudo aptitude install lttng-tools liblttng-ust-dev</code> + <p>See <url href="http://lttng.org/docs/#doc-installing-lttng">Installing LTTng</url> + for more information on how to install LTTng on your system.</p> + + <p>After LTTng is properly installed on the system Erlang/OTP can be built with LTTng support.</p> + + +<code type="none">$ ./configure --with-dynamic-trace=lttng +$ make </code> + </section> + + <section> + <title>Dyntrace Tracepoints</title> + <p>All tracepoints are in the domain of <c>com_ericsson_dyntrace</c></p> + <p>All Erlang types are the string equivalent in LTTng.</p> + + <p><em>process_spawn</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>parent : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>entry : string</c> :: Code Location. Ex. <c>"lists:sort/1"</c></item> + </list> + <p>Example:</p> + <p><code type="none">process_spawn: { cpu_id = 3 }, { pid = "<0.131.0>", parent = "<0.130.0>", entry = "erlang:apply/2" }</code></p> + + <p><em>process_link</em></p> + <list type="bulleted"> + <item><c>to : string</c> :: Process ID or Port ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>from : string</c> :: Process ID or Port ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>type : string</c> :: <c>"link" | "unlink"</c></item> + </list> + <p>Example:</p> + <p><code type="none">process_link: { cpu_id = 3 }, { from = "<0.130.0>", to = "<0.131.0>", type = "link" }</code></p> + + + <p><em>process_exit</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>reason : string</c> :: Exit reason. Ex. <c>"normal"</c></item> + </list> + <p>Example:</p> + <p><code type="none">process_exit: { cpu_id = 3 }, { pid = "<0.130.0>", reason = "normal" }</code></p> + + <p><em>process_register</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>name : string</c> :: Registered name. Ex. <c>"error_logger"</c></item> + <item><c>type : string</c> :: <c>"register" | "unregister"</c></item> + </list> + <p>Example:</p> + <p><code type="none">process_register: { cpu_id = 0 }, { pid = "<0.128.0>", name = "dyntrace_lttng_SUITE" type = "register" }</code></p> + + <p><em>process_scheduled</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>entry : string</c> :: Code Location. Ex. <c>"lists:sort/1"</c></item> + <item><c>type : string</c> :: <c>"in" | "out" | "in_exiting" | "out_exiting" | "out_exited"</c></item> + </list> + + <p>Example:</p> + <p><code type="none">process_scheduled: { cpu_id = 0 }, { pid = "<0.136.0>", entry = "erlang:apply/2", type = "in" }</code></p> + + + <p><em>port_open</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + </list> + + <p>Example:</p> + <p><code type="none">port_open: { cpu_id = 5 }, { pid = "<0.131.0>", driver = "'/bin/sh -s unix:cmd'", port = "#Port<0.1887>" }</code></p> + + <p><em>port_exit</em></p> + <list type="bulleted"> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>reason : string</c> :: Exit reason. Ex. <c>"normal"</c></item> + </list> + <p>Example:</p> + <p><code type="none">port_exit: { cpu_id = 5 }, { port = "#Port<0.1887>", reason = "normal" }</code></p> + + <p><em>port_link</em></p> + <list type="bulleted"> + <item><c>to : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>from : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>type : string</c> :: <c>"link" | "unlink"</c></item> + </list> + <p>Example:</p> + <p><code type="none">port_link: { cpu_id = 5 }, { from = "#Port<0.1887>", to = "<0.131.0>", type = "unlink" }</code></p> + + <p><em>port_scheduled</em></p> + <list type="bulleted"> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>entry : string</c> :: Callback. Ex. <c>"open"</c></item> + <item><c>type : string</c> :: <c>"in" | "out" | "in_exiting" | "out_exiting" | "out_exited"</c></item> + </list> + + <p>Example:</p> + <p><code type="none">port_scheduled: { cpu_id = 5 }, { pid = "#Port<0.1905>", entry = "close", type = "out" }</code></p> + + <p><em>function_call</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>entry : string</c> :: Code Location. Ex. <c>"lists:sort/1"</c></item> + <item><c>depth : integer</c> :: Stack depth. Ex. <c>0</c></item> + </list> + <p>Example:</p> + <p><code type="none">function_call: { cpu_id = 5 }, { pid = "<0.145.0>", entry = "dyntrace_lttng_SUITE:'-t_call/1-fun-1-'/0", depth = 0 }</code></p> + + <p><em>function_return</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>entry : string</c> :: Code Location. Ex. <c>"lists:sort/1"</c></item> + <item><c>depth : integer</c> :: Stack depth. Ex. <c>0</c></item> + </list> + <p>Example:</p> + <p><code type="none">function_return: { cpu_id = 5 }, { pid = "<0.145.0>", entry = "dyntrace_lttng_SUITE:waiter/0", depth = 0 }</code></p> + + <p><em>function_exception</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>entry : string</c> :: Code Location. Ex. <c>"lists:sort/1"</c></item> + <item><c>class : string</c> :: Error reason. Ex. <c>"error"</c></item> + </list> + <p>Example:</p> + <p><code type="none">function_exception: { cpu_id = 5 }, { pid = "<0.144.0>", entry = "t:call_exc/1", class = "error" }</code></p> + + <p><em>message_send</em></p> + <list type="bulleted"> + <item><c>from : string</c> :: Process ID or Port ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>to : string</c> :: Process ID or Port ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>message : string</c> :: Message sent. Ex. <c>"{<0.162.0>,ok}"</c></item> + </list> + <p>Example:</p> + <p><code type="none">message_send: { cpu_id = 3 }, { from = "#Port<0.1938>", to = "<0.160.0>", message = "{#Port<0.1938>,eof}" }</code></p> + + <p><em>message_receive</em></p> + <list type="bulleted"> + <item><c>to : string</c> :: Process ID or Port ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>message : string</c> :: Message received. Ex. <c>"{<0.162.0>,ok}"</c></item> + </list> + <p>Example:</p> + <p><code type="none">message_receive: { cpu_id = 7 }, { to = "<0.167.0>", message = "{<0.165.0>,ok}" }</code></p> + + <p><em>gc_minor_start</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>need : integer</c> :: Heap need. Ex. <c>2</c></item> + <item><c>heap : integer</c> :: Young heap word size. Ex. <c>233</c></item> + <item><c>old_heap : integer</c> :: Old heap word size. Ex. <c>233</c></item> + </list> + <p>Example:</p> + <p><code type="none">gc_minor_start: { cpu_id = 0 }, { pid = "<0.172.0>", need = 0, heap = 610, old_heap = 0 }</code></p> + + <p><em>gc_minor_end</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>reclaimed : integer</c> :: Heap reclaimed. Ex. <c>2</c></item> + <item><c>heap : integer</c> :: Young heap word size. Ex. <c>233</c></item> + <item><c>old_heap : integer</c> :: Old heap word size. Ex. <c>233</c></item> + </list> + <p>Example:</p> + <p><code type="none">gc_minor_end: { cpu_id = 0 }, { pid = "<0.172.0>", reclaimed = 120, heap = 1598, old_heap = 1598 }</code></p> + + <p><em>gc_major_start</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>need : integer</c> :: Heap need. Ex. <c>2</c></item> + <item><c>heap : integer</c> :: Young heap word size. Ex. <c>233</c></item> + <item><c>old_heap : integer</c> :: Old heap word size. Ex. <c>233</c></item> + </list> + <p>Example:</p> + <p><code type="none">gc_major_start: { cpu_id = 0 }, { pid = "<0.172.0>", need = 8, heap = 2586, old_heap = 1598 }</code></p> + + <p><em>gc_major_end</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>reclaimed : integer</c> :: Heap reclaimed. Ex. <c>2</c></item> + <item><c>heap : integer</c> :: Young heap word size. Ex. <c>233</c></item> + <item><c>old_heap : integer</c> :: Old heap word size. Ex. <c>233</c></item> + </list> + <p>Example:</p> + <p><code type="none">gc_major_end: { cpu_id = 0 }, { pid = "<0.172.0>", reclaimed = 240, heap = 4185, old_heap = 0 }</code></p> + + </section> + + <section> + <title>BEAM Tracepoints</title> + <p>All tracepoints are in the domain of <c>com_ericsson_otp</c></p> + <p>All Erlang types are the string equivalent in LTTng.</p> + + <p><em>scheduler_poll</em></p> + <list type="bulleted"> + <item><c>scheduler : integer</c> :: Scheduler ID. Ex. <c>1</c></item> + <item><c>runnable : integer</c> :: Runnable. Ex. <c>1</c></item> + </list> + <p>Example:</p> + <p><code type="none">scheduler_poll: { cpu_id = 4 }, { scheduler = 1, runnable = 1 }</code></p> + + <p><em>driver_init</em></p> + <list type="bulleted"> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>major : integer</c> :: Major version. Ex. <c>3</c></item> + <item><c>minor : integer</c> :: Minor version. Ex. <c>1</c></item> + <item><c>flags : integer</c> :: Flags. Ex. <c>1</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_init: { cpu_id = 2 }, { driver = "caller_drv", major = 3, minor = 3, flags = 1 }</code></p> + + <p><em>driver_start</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_start: { cpu_id = 2 }, { pid = "<0.198.0>", driver = "caller_drv", port = "#Port<0.3676>" }</code></p> + + <p><em>driver_output</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_output: { cpu_id = 2 }, { pid = "<0.198.0>", port = "#Port<0.3677>", driver = "/bin/sh -s unix:cmd", bytes = 36 }</code></p> + + <p><em>driver_outputv</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_outputv: { cpu_id = 5 }, { pid = "<0.194.0>", port = "#Port<0.3663>", driver = "tcp_inet", bytes = 3 }</code></p> + + <p><em>driver_ready_input</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_ready_input: { cpu_id = 5 }, { pid = "<0.189.0>", port = "#Port<0.3637>", driver = "inet_gethost 4 " }</code></p> + + <p><em>driver_ready_output</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_ready_output: { cpu_id = 5 }, { pid = "<0.194.0>", port = "#Port<0.3663>", driver = "tcp_inet" }</code></p> + + <p><em>driver_timeout</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_timeout: { cpu_id = 5 }, { pid = "<0.196.0>", port = "#Port<0.3664>", driver = "tcp_inet" }</code></p> + + <p><em>driver_stop_select</em></p> + <list type="bulleted"> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_stop_select: { cpu_id = 5 }, { driver = "unknown" }</code></p> + + <p><em>driver_flush</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_flush: { cpu_id = 7 }, { pid = "<0.204.0>", port = "#Port<0.3686>", driver = "tcp_inet" }</code></p> + + <p><em>driver_stop</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_stop: { cpu_id = 5 }, { pid = "[]", port = "#Port<0.3673>", driver = "efile" }</code></p> + + <p><em>driver_process_exit</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + + <p><em>driver_ready_async</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_ready_async: { cpu_id = 3 }, { pid = "<0.181.0>", port = "#Port<0.3622>", driver = "efile" }</code></p> + + <p><em>driver_call</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>command : integer</c> :: Command integer. Ex. <c>1</c></item> + <item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_call: { cpu_id = 2 }, { pid = "<0.202.0>", port = "#Port<0.3676>", driver = "caller_drv", command = 0, bytes = 2 }</code></p> + + <p><em>driver_control</em></p> + <list type="bulleted"> + <item><c>pid : string</c> :: Process ID. Ex. <c>"<0.131.0>"</c></item> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>driver : string</c> :: Driver name. Ex. <c>"efile"</c></item> + <item><c>command : integer</c> :: Command integer. Ex. <c>1</c></item> + <item><c>bytes : integer</c> :: Size of data returned. Ex. <c>82</c></item> + </list> + <p>Example:</p> + <p><code type="none">driver_control: { cpu_id = 3 }, { pid = "<0.32767.8191>", port = "#Port<0.0>", driver = "forker", command = 83, bytes = 32 }</code></p> + + <p><em>aio_pool_get</em></p> + <list type="bulleted"> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>length : integer</c> :: Async queue length. Ex. <c>0</c></item> + </list> + <p>Example:</p> + <p><code type="none">aio_pool_get: { cpu_id = 4 }, { port = "#Port<0.3614>", length = 0 }</code></p> + + <p><em>aio_pool_put</em></p> + <list type="bulleted"> + <item><c>port : string</c> :: Port ID. Ex. <c>"#Port<0.1031>"</c></item> + <item><c>length : integer</c> :: Async queue length. Ex. <c>-1</c></item> + </list> + <p>Async queue length is not defined for <c>put</c> operations.</p> + <p>Example:</p> + <p><code type="none">aio_pool_put: { cpu_id = 3 }, { port = "#Port<0.3614>", length = -1 }</code></p> + + <p><em>carrier_create</em></p> + <list type="bulleted"> + <item><c>type : string</c> :: Carrier type. Ex. <c>"ets_alloc"</c></item> + <item><c>instance : integer</c> :: Allocator instance. Ex. <c>1</c></item> + <item><c>size : integer</c> :: Carrier size. Ex. <c>262144</c></item> + <item><c>mbc_carriers : integer</c> :: Number of multiblock carriers in instance. Ex. <c>3</c></item> + <item><c>mbc_carriers_size : integer</c> :: Total size of multiblock blocks carriers in instance. Ex. <c>1343488</c></item> + <item><c>mbc_blocks : integer</c> :: Number of multiblock blocks in instance. Ex. <c>122</c></item> + <item><c>mbc_blocks_size : integer</c> :: Total size of all multiblock blocks in instance. Ex. <c>285296</c></item> + <item><c>sbc_carriers : integer</c> :: Number of singleblock carriers in instance. Ex. <c>1</c></item> + <item><c>sbc_carriers_size : integer</c> :: Total size of singleblock blocks carriers in instance. Ex. <c>1343488</c></item> + <item><c>sbc_blocks : integer</c> :: Number of singleblocks in instance. Ex. <c>1</c></item> + <item><c>sbc_blocks_size : integer</c> :: Total size of all singleblock blocks in instance. Ex. <c>285296</c></item> + + </list> + <p>Example:</p> + <p><code type="none">carrier_create: { cpu_id = 2 }, { type = "ets_alloc", instance = 7, size = 2097152, mbc_carriers = 4, mbc_carriers_size = 3440640, mbc_blocks = 526, mbc_blocks_size = 1278576, sbc_carriers = 0, sbc_carriers_size = 0, sbc_blocks = 0, sbc_blocks_size = 0 }</code></p> + + <p><em>carrier_destroy</em></p> + <list type="bulleted"> + <item><c>type : string</c> :: Carrier type. Ex. <c>"ets_alloc"</c></item> + <item><c>instance : integer</c> :: Allocator instance. Ex. <c>1</c></item> + <item><c>size : integer</c> :: Carrier size. Ex. <c>262144</c></item> + <item><c>mbc_carriers : integer</c> :: Number of multiblock carriers in instance. Ex. <c>3</c></item> + <item><c>mbc_carriers_size : integer</c> :: Total size of multiblock blocks carriers in instance. Ex. <c>1343488</c></item> + <item><c>mbc_blocks : integer</c> :: Number of multiblock blocks in instance. Ex. <c>122</c></item> + <item><c>mbc_blocks_size : integer</c> :: Total size of all multiblock blocks in instance. Ex. <c>285296</c></item> + <item><c>sbc_carriers : integer</c> :: Number of singleblock carriers in instance. Ex. <c>1</c></item> + <item><c>sbc_carriers_size : integer</c> :: Total size of singleblock blocks carriers in instance. Ex. <c>1343488</c></item> + <item><c>sbc_blocks : integer</c> :: Number of singleblocks in instance. Ex. <c>1</c></item> + <item><c>sbc_blocks_size : integer</c> :: Total size of all singleblock blocks in instance. Ex. <c>285296</c></item> + + </list> + <p>Example:</p> + <p><code type="none">carrier_destroy: { cpu_id = 6 }, { type = "ets_alloc", instance = 7, size = 262144, mbc_carriers = 3, mbc_carriers_size = 3178496, mbc_blocks = 925, mbc_blocks_size = 2305336, sbc_carriers = 0, sbc_carriers_size = 0, sbc_blocks = 0, sbc_blocks_size = 0 }</code></p> + + <p><em>carrier_pool_put</em></p> + <list type="bulleted"> + <item><c>type : string</c> :: Carrier type. Ex. <c>"ets_alloc"</c></item> + <item><c>instance : integer</c> :: Allocator instance. Ex. <c>1</c></item> + <item><c>size : integer</c> :: Carrier size. Ex. <c>262144</c></item> + </list> + <p>Example:</p> + <p><code type="none">carrier_pool_put: { cpu_id = 3 }, { type = "ets_alloc", instance = 5, size = 1048576 }</code></p> + + <p><em>carrier_pool_get</em></p> + <list type="bulleted"> + <item><c>type : string</c> :: Carrier type. Ex. <c>"ets_alloc"</c></item> + <item><c>instance : integer</c> :: Allocator instance. Ex. <c>1</c></item> + <item><c>size : integer</c> :: Carrier size. Ex. <c>262144</c></item> + </list> + <p>Example:</p> + <p><code type="none">carrier_pool_get: { cpu_id = 7 }, { type = "ets_alloc", instance = 4, size = 3208 }</code></p> + + </section> + + + <section> + <title>Examples</title> + </section> +</chapter> diff --git a/lib/runtime_tools/doc/src/Makefile b/lib/runtime_tools/doc/src/Makefile index 0a590ff9ec..5ce40bb995 100644 --- a/lib/runtime_tools/doc/src/Makefile +++ b/lib/runtime_tools/doc/src/Makefile @@ -45,7 +45,7 @@ XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.x XML_REF6_FILES = runtime_tools_app.xml XML_PART_FILES = part_notes.xml part_notes_history.xml part.xml -XML_CHAPTER_FILES = notes.xml notes_history.xml +XML_CHAPTER_FILES = notes.xml notes_history.xml LTTng.xml GENERATED_XML_FILES = DTRACE.xml SYSTEMTAP.xml diff --git a/lib/runtime_tools/doc/src/part.xml b/lib/runtime_tools/doc/src/part.xml index 14e8b71c83..34acf69fc8 100644 --- a/lib/runtime_tools/doc/src/part.xml +++ b/lib/runtime_tools/doc/src/part.xml @@ -34,6 +34,7 @@ <p><em>Runtime Tools</em></p> </description> + <xi:include href="LTTng.xml"/> <xi:include href="DTRACE.xml"/> <xi:include href="SYSTEMTAP.xml"/> </part> diff --git a/lib/runtime_tools/src/dyntrace.erl b/lib/runtime_tools/src/dyntrace.erl index f7dbef6929..28e6d67d96 100644 --- a/lib/runtime_tools/src/dyntrace.erl +++ b/lib/runtime_tools/src/dyntrace.erl @@ -41,6 +41,28 @@ pn/1, pn/2, pn/3, pn/4, pn/5, pn/6, pn/7, pn/8, pn/9]). -export([put_tag/1, get_tag/0, get_tag_data/0, spread_tag/1, restore_tag/1]). +-export([trace/5, + trace/6, + trace_procs/6, + trace_ports/6, + trace_running_procs/6, + trace_running_ports/6, + trace_call/6, + trace_send/6, + trace_receive/6, + trace_garbage_collection/6]). + +-export([enabled_procs/3, + enabled_ports/3, + enabled_running_procs/3, + enabled_running_ports/3, + enabled_call/3, + enabled_send/3, + enabled_receive/3, + enabled_garbage_collection/3, + enabled/3]). + + -export([user_trace_i4s4/9]). % Know what you're doing! -on_load(on_load/0). @@ -125,6 +147,63 @@ user_trace_i4s4(_, _, _, _, _, _, _, _, _) -> user_trace_n(_, _, _, _, _, _, _, _, _, _) -> erlang:nif_error(nif_not_loaded). +trace(_TracerState, _Label, _SeqTraceInfo, _, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_procs(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_ports(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_running_procs(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_running_ports(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_call(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_send(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_receive(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +trace_garbage_collection(_TraceTag, _TracerState, _Tracee, _FirstTraceTerm, _SecondTraceTerm, _Opts) -> + erlang:nif_error(nif_not_loaded). + +enabled(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_procs(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_ports(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_running_procs(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_running_ports(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_call(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_send(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_receive(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + +enabled_garbage_collection(_TraceTag, _TracerState, _Tracee) -> + erlang:nif_error(nif_not_loaded). + %%% %%% Erlang support functions %%% diff --git a/lib/runtime_tools/src/msacc.erl b/lib/runtime_tools/src/msacc.erl index 612effa5aa..4db5dbec91 100644 --- a/lib/runtime_tools/src/msacc.erl +++ b/lib/runtime_tools/src/msacc.erl @@ -32,18 +32,18 @@ -type msacc_data() :: [msacc_data_thread()]. --type msacc_data_thread() :: #{ '$type' => msacc_data, - type => msacc_type(), id => msacc_id(), - counters => msacc_data_counters() }. +-type msacc_data_thread() :: #{ '$type' := msacc_data, + type := msacc_type(), id := msacc_id(), + counters := msacc_data_counters() }. -type msacc_data_counters() :: #{ msacc_state() => non_neg_integer()}. -type msacc_stats() :: [msacc_stats_thread()]. --type msacc_stats_thread() :: #{ '$type' => msacc_stats, - type => msacc_type(), id => msacc_id(), - system => float(), - counters => msacc_stats_counters()}. --type msacc_stats_counters() :: #{ msacc_state() => #{ thread => float(), - system => float()}}. +-type msacc_stats_thread() :: #{ '$type' := msacc_stats, + type := msacc_type(), id := msacc_id(), + system := float(), + counters := msacc_stats_counters()}. +-type msacc_stats_counters() :: #{ msacc_state() => #{ thread := float(), + system := float()}}. -type msacc_type() :: scheduler | aux | async. diff --git a/lib/runtime_tools/src/system_information.erl b/lib/runtime_tools/src/system_information.erl index ad7ee7311c..1add01612d 100644 --- a/lib/runtime_tools/src/system_information.erl +++ b/lib/runtime_tools/src/system_information.erl @@ -28,31 +28,25 @@ -behaviour(gen_server). %% API --export([ - report/0, +-export([report/0, from_file/1, - to_file/1 - ]). --export([ - start/0, stop/0, - load_report/0, load_report/2, - applications/0, applications/1, - application/1, application/2, - environment/0, environment/1, - module/1, module/2, - modules/1, - sanity_check/0 - ]). + to_file/1]). +-export([start/0, stop/0, + load_report/0, load_report/2, + applications/0, applications/1, + application/1, application/2, + environment/0, environment/1, + module/1, module/2, + modules/1, + sanity_check/0]). %% gen_server callbacks --export([ - init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3 - ]). +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). -define(SERVER, ?MODULE). @@ -71,13 +65,13 @@ start() -> gen_server:start({local, ?SERVER}, ?MODULE, [], []). stop() -> - gen_server:call(?SERVER, stop). + gen_server:call(?SERVER, stop, infinity). load_report() -> load_report(data, report()). load_report(file, File) -> load_report(data, from_file(File)); load_report(data, Report) -> - start(), gen_server:call(?SERVER, {load_report, Report}). + start(), gen_server:call(?SERVER, {load_report, Report}, infinity). report() -> [ {init_arguments, init:get_arguments()}, @@ -120,22 +114,22 @@ from_file(File) -> applications() -> applications([]). applications(Opts) when is_list(Opts) -> - gen_server:call(?SERVER, {applications, Opts}). + gen_server:call(?SERVER, {applications, Opts}, infinity). application(App) when is_atom(App) -> application(App, []). application(App, Opts) when is_atom(App), is_list(Opts) -> - gen_server:call(?SERVER, {application, App, Opts}). + gen_server:call(?SERVER, {application, App, Opts}, infinity). environment() -> environment([]). environment(Opts) when is_list(Opts) -> - gen_server:call(?SERVER, {environment, Opts}). + gen_server:call(?SERVER, {environment, Opts}, infinity). module(M) when is_atom(M) -> module(M, []). module(M, Opts) when is_atom(M), is_list(Opts) -> - gen_server:call(?SERVER, {module, M, Opts}). + gen_server:call(?SERVER, {module, M, Opts}, infinity). modules(Opt) when is_atom(Opt) -> - gen_server:call(?SERVER, {modules, Opt}). + gen_server:call(?SERVER, {modules, Opt}, infinity). -spec sanity_check() -> ok | {failed, Failures} when diff --git a/lib/runtime_tools/test/Makefile b/lib/runtime_tools/test/Makefile index 432a361468..61377ea09e 100644 --- a/lib/runtime_tools/test/Makefile +++ b/lib/runtime_tools/test/Makefile @@ -4,6 +4,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES = \ dyntrace_SUITE \ + dyntrace_lttng_SUITE \ runtime_tools_SUITE \ system_information_SUITE \ dbg_SUITE \ diff --git a/lib/runtime_tools/test/dbg_SUITE.erl b/lib/runtime_tools/test/dbg_SUITE.erl index 9c9d6ca352..0777503ef7 100644 --- a/lib/runtime_tools/test/dbg_SUITE.erl +++ b/lib/runtime_tools/test/dbg_SUITE.erl @@ -167,8 +167,8 @@ distributed(Config) when is_list(Config) -> {value, {matched, Node, 1}} = lists:keysearch(Node, 2, Z), dbg:cn(Node), dbg:tp(dbg,ln,[]), - ok = rpc:call(Node, dbg, ltp, []), - ok = rpc:call(Node, dbg, ln, []), + ok = rpc:block_call(Node, dbg, ltp, []), + ok = rpc:block_call(Node, dbg, ln, []), ok = dbg:ln(), S = self(), {TraceSend, TraceCall} = @@ -447,12 +447,6 @@ file_port_schedfix1(Config) when is_list(Config) -> %% {ok,[{matched,_,_}]} = dbg:p(all, [clear]), stop(), - % Some debug code to run on all platforms, for finding the fault on genny - % Dont touch please /PaN - io:format("Trace dump by PaN BEGIN~n"), - dbg:trace_client(file,{FName, wrap, ".wraplog"},{fun(end_of_trace,Pid)-> Pid ! done; (Mesg,Pid) -> io:format("~w~n",[Mesg]),Pid end,self()}), - receive done -> ok end, - io:format("Trace dump by PaN END~n"), %% %% Get the trace result %% @@ -473,14 +467,12 @@ file_port_schedfix1(Config) when is_list(Config) -> %% %% Analyze the result %% - {Min, Max} = - lists:foldl( - fun({_Pid, M}, {Mi, Ma}) -> - {if M < Mi -> M; true -> Mi end, - if M > Ma -> M; true -> Ma end} - end, - {void, 0}, - Result), + {Min, Max} = lists:foldl(fun({_Pid, M}, {Mi, Ma}) -> + {if M < Mi -> M; true -> Mi end, + if M > Ma -> M; true -> Ma end} + end, + {void, 0}, + Result), % More PaN debug io:format("Min = ~f, Max = ~f~n",[Min,Max]), %% @@ -895,6 +887,10 @@ schedstat_handler(TraceMsg, {Parent, Tag, Data} = State) -> Data end, {Parent, Tag, NewData}; + {trace_ts,_Pid,spawned,_OtherPid,_,_Ts} -> + State; + {trace_ts,_Pid,getting_linked,_OtherPid,_Ts} -> + State; {trace_ts, Pid, exit, normal, {A3, B3, C3}} -> NewData = case lists:keysearch(Pid, 1, Data) of diff --git a/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl b/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl new file mode 100644 index 0000000000..e6c147b003 --- /dev/null +++ b/lib/runtime_tools/test/dyntrace_lttng_SUITE.erl @@ -0,0 +1,377 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(dyntrace_lttng_SUITE). +-include_lib("common_test/include/ct.hrl"). + +-export([all/0, suite/0]). +-export([init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). + +%% Test cases +-export([t_lttng_list/1, + t_procs/1, + t_ports/1, + t_running_process/1, + t_running_port/1, + t_call/1, + t_call_return_to/1, + t_call_silent/1, + t_send/1, + t_receive/1, + t_garbage_collection/1, + t_all/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. + +all() -> + [t_lttng_list, + t_procs, + t_ports, + t_running_process, + t_running_port, + t_call, + t_call_return_to, + t_call_silent, + t_send, + t_receive, + t_garbage_collection, + t_all]. + + +init_per_suite(Config) -> + case erlang:system_info(dynamic_trace) of + lttng -> + ensure_lttng_stopped("--all"), + Config; + _ -> + {skip, "No LTTng configured on system."} + end. + +end_per_suite(_Config) -> + ensure_lttng_stopped("--all"), + ok. + +init_per_testcase(Case, Config) -> + %% ensure loaded + _ = dyntrace:module_info(), + Name = atom_to_list(Case), + ok = ensure_lttng_started(Name, Config), + [{session, Name}|Config]. + +end_per_testcase(Case, _Config) -> + Name = atom_to_list(Case), + ok = ensure_lttng_stopped(Name), + ok. + +%% tracepoints +%% +%% com_ericsson_dyntrace:gc_major_end +%% com_ericsson_dyntrace:gc_major_start +%% com_ericsson_dyntrace:gc_minor_end +%% com_ericsson_dyntrace:gc_minor_start +%% com_ericsson_dyntrace:message_receive +%% com_ericsson_dyntrace:message_send +%% -com_ericsson_dyntrace:message_queued +%% com_ericsson_dyntrace:function_exception +%% com_ericsson_dyntrace:function_return +%% com_ericsson_dyntrace:function_call +%% com_ericsson_dyntrace:port_link +%% com_ericsson_dyntrace:port_exit +%% com_ericsson_dyntrace:port_open +%% com_ericsson_dyntrace:port_scheduled +%% com_ericsson_dyntrace:process_scheduled +%% com_ericsson_dyntrace:process_register +%% com_ericsson_dyntrace:process_exit +%% com_ericsson_dyntrace:process_link +%% com_ericsson_dyntrace:process_spawn +%% +%% Testcases +%% + +t_lttng_list(_Config) -> + {ok, _} = cmd("lttng list -u"), + ok. + +t_procs(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:process_*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},procs]), + + Pid = spawn_link(fun() -> waiter() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + timer:sleep(1000), + + _ = erlang:trace(all, false, [procs]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:process_spawn", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_link", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_exit", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_register", Res), + ok. + +t_ports(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:port_*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},ports]), + + _ = os:cmd("ls"), + + _ = erlang:trace(all, false, [{tracer, dyntrace, []},ports]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:port_open", Res), + ok = check_tracepoint("com_ericsson_dyntrace:port_link", Res), + ok = check_tracepoint("com_ericsson_dyntrace:port_exit", Res), + ok. + +t_running_process(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:process_scheduled", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},running]), + + Pid = spawn_link(fun() -> waiter() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + timer:sleep(1000), + + _ = erlang:trace(all, false, [running]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:process_scheduled", Res), + ok. + +t_running_port(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:port_scheduled", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},running_ports]), + + _ = os:cmd("ls"), + _ = os:cmd("ls"), + + _ = erlang:trace(all, false, [running_ports]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:port_scheduled", Res), + ok. + + +t_call(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:function_*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []}, call]), + _ = erlang:trace_pattern({?MODULE, '_', '_'}, [{'_',[],[{exception_trace}]}], [local]), + + DontLink = spawn(fun() -> foo_clause_exception(nope) end), + Pid = spawn_link(fun() -> waiter() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + + timer:sleep(10), + undefined = erlang:process_info(DontLink), + + _ = erlang:trace_pattern({?MODULE, '_', '_'}, false, [local]), + _ = erlang:trace(all, false, [call]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:function_call", Res), + ok = check_tracepoint("com_ericsson_dyntrace:function_return", Res), + ok = check_tracepoint("com_ericsson_dyntrace:function_exception", Res), + ok. + +t_send(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:message_send", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},send]), + + Pid = spawn_link(fun() -> waiter() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + _ = os:cmd("ls"), + timer:sleep(10), + + _ = erlang:trace(all, false, [send]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:message_send", Res), + ok. + +t_call_return_to(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:function_*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []}, call, return_to]), + _ = erlang:trace_pattern({lists, '_', '_'}, true, [local]), + _ = erlang:trace_pattern({?MODULE, '_', '_'}, true, [local]), + + Pid = spawn_link(fun() -> gcfier(10) end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + timer:sleep(10), + + _ = erlang:trace_pattern({?MODULE, '_', '_'}, false, [local]), + _ = erlang:trace_pattern({lists, '_', '_'}, false, [local]), + _ = erlang:trace(all, false, [call,return_to]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:function_call", Res), + ok. + +t_call_silent(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:function_*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []}, call, silent]), + _ = erlang:trace_pattern({?MODULE, '_', '_'}, [{'_',[],[{exception_trace}]}], [local]), + + DontLink = spawn(fun() -> foo_clause_exception(nope) end), + Pid = spawn_link(fun() -> waiter() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + + timer:sleep(10), + undefined = erlang:process_info(DontLink), + + _ = erlang:trace_pattern({?MODULE, '_', '_'}, false, [local]), + _ = erlang:trace(all, false, [call]), + Res = lttng_stop_and_view(Config), + notfound = check_tracepoint("com_ericsson_dyntrace:function_call", Res), + notfound = check_tracepoint("com_ericsson_dyntrace:function_return", Res), + notfound = check_tracepoint("com_ericsson_dyntrace:function_exception", Res), + ok. + + +t_receive(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:message_receive", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},'receive']), + + Pid = spawn_link(fun() -> waiter() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + timer:sleep(10), + _ = erlang:trace(all, false, ['receive']), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:message_receive", Res), + ok. + +t_garbage_collection(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:gc_*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},garbage_collection]), + + Pid = spawn_link(fun() -> gcfier() end), + Pid ! {self(), ok}, + ok = receive {Pid,ok} -> ok end, + timer:sleep(10), + _ = erlang:trace(all, false, [garbage_collection]), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_dyntrace:gc_major_start", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_major_end", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_minor_start", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_minor_end", Res), + ok. + +t_all(Config) when is_list(Config) -> + ok = lttng_start_event("com_ericsson_dyntrace:*", Config), + _ = erlang:trace(new, true, [{tracer, dyntrace, []},all]), + + Pid1 = spawn_link(fun() -> waiter() end), + Pid1 ! {self(), ok}, + ok = receive {Pid1,ok} -> ok end, + + Pid2 = spawn_link(fun() -> gcfier() end), + Pid2 ! {self(), ok}, + ok = receive {Pid2,ok} -> ok end, + _ = os:cmd("ls"), + _ = os:cmd("ls"), + timer:sleep(10), + + _ = erlang:trace(all, false, [all]), + Res = lttng_stop_and_view(Config), + + ok = check_tracepoint("com_ericsson_dyntrace:process_spawn", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_link", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_exit", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_register", Res), + ok = check_tracepoint("com_ericsson_dyntrace:port_open", Res), + ok = check_tracepoint("com_ericsson_dyntrace:port_link", Res), + ok = check_tracepoint("com_ericsson_dyntrace:port_exit", Res), + ok = check_tracepoint("com_ericsson_dyntrace:process_scheduled", Res), + ok = check_tracepoint("com_ericsson_dyntrace:port_scheduled", Res), + ok = check_tracepoint("com_ericsson_dyntrace:message_send", Res), + ok = check_tracepoint("com_ericsson_dyntrace:message_receive", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_major_start", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_major_end", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_minor_start", Res), + ok = check_tracepoint("com_ericsson_dyntrace:gc_minor_end", Res), + ok. + + +%% aux + +gcfier() -> + gcfier(10000). +gcfier(N) -> + receive + {Pid, ok} -> + _ = lists:reverse(lists:seq(1,N)), + true = erlang:garbage_collect(), + Pid ! {self(), ok} + end. + + +waiter() -> + true = register(?MODULE, self()), + receive + {Pid, ok} -> + Child = spawn(fun() -> receive ok -> ok end end), + link(Child), + unlink(Child), + _ = lists:seq(1,1000), + Child ! ok, + true = unregister(?MODULE), + Pid ! {self(),ok} + end. + +foo_clause_exception({1,2}) -> badness. + +%% lttng +lttng_stop_and_view(Config) -> + Path = proplists:get_value(priv_dir, Config), + Name = proplists:get_value(session, Config), + {ok,_} = cmd("lttng stop " ++ Name), + {ok,Res} = cmd("lttng view " ++ Name ++ " --trace-path=" ++ Path), + Res. + +check_tracepoint(TP, Data) -> + case re:run(Data, TP, [global]) of + {match, _} -> ok; + _ -> notfound + end. + +lttng_start_event(Event, Config) -> + Name = proplists:get_value(session, Config), + {ok, _} = cmd("lttng enable-event -u " ++ Event ++ " --session=" ++ Name), + {ok, _} = cmd("lttng start " ++ Name), + ok. + +ensure_lttng_started(Name, Config) -> + Out = case proplists:get_value(priv_dir, Config) of + undefined -> []; + Path -> "--output="++Path++" " + end, + {ok,_} = cmd("lttng create " ++ Out ++ Name), + ok. + +ensure_lttng_stopped(Name) -> + {ok,_} = cmd("lttng stop"), + {ok,_} = cmd("lttng destroy " ++ Name), + ok. + +cmd(Cmd) -> + io:format("<< ~ts~n", [Cmd]), + Res = os:cmd(Cmd), + io:format(">> ~ts~n", [Res]), + {ok,Res}. diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 850557444d..ff2d6e082a 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -241,6 +241,7 @@ {server2client,['aes128-cbc','3des-cbc']}]}, {mac,['hmac-sha2-256','hmac-sha1']}, {compression,[none,zlib]} + ] } </code> <p>The example specifies different algorithms in the two directions (client2server and server2client), @@ -359,7 +360,8 @@ </type> <desc> <p>Starts a server listening for SSH connections on the given - port.</p> + port. If the <c>Port</c> is 0, a random free port is selected. See + <seealso marker="#daemon_info/1">daemon_info/1</seealso> about how to find the selected port number.</p> <p>Options:</p> <taglist> <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag> @@ -460,6 +462,7 @@ {server2client,['aes128-cbc','3des-cbc']}]}, {mac,['hmac-sha2-256','hmac-sha1']}, {compression,[none,zlib]} + ] } </code> <p>The example specifies different algorithms in the two directions (client2server and server2client), @@ -680,6 +683,18 @@ </func> <func> + <name>daemon_info(Daemon) -> {ok, [{port,Port}]} | {error,Error}</name> + <fsummary>Get info about a daemon</fsummary> + <type> + <v>Port = integer()</v> + <v>Error = bad_daemon_ref</v> + </type> + <desc> + <p>Returns a key-value list with information about the daemon. For now, only the listening port is returned. This is intended for the case the daemon is started with the port set to 0.</p> + </desc> + </func> + + <func> <name>default_algorithms() -> algs_list()</name> <fsummary>Get a list declaring the supported algorithms</fsummary> <desc> diff --git a/lib/ssh/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml index 1d37933369..071d46ec57 100644 --- a/lib/ssh/doc/src/ssh_sftp.xml +++ b/lib/ssh/doc/src/ssh_sftp.xml @@ -44,24 +44,41 @@ </p> <taglist> + <tag><c>reason()</c></tag> + <item> + <p>= <c>atom()</c> A description of the reason why an operation failed.</p> + <p> + The value is formed from the sftp error codes in the protocol-level responses as defined in + <url href="https://tools.ietf.org/id/draft-ietf-secsh-filexfer-13.txt">draft-ietf-secsh-filexfer-13.txt</url> + section 9.1. + </p> + <p> + The codes are named as <c>SSH_FX_*</c> which are transformed into lowercase of the star-part. + E.g. the error code <c>SSH_FX_NO_SUCH_FILE</c> + will cause the <c>reason()</c> to be <c>no_such_file</c>. + </p> + </item> + <tag><c>ssh_connection_ref() =</c></tag> - <item><p>opaque() - as returned by <c>ssh:connect/3</c></p></item> + <item><p><c>opaque()</c> - as returned by + <seealso marker="ssh#connect-3"><c>ssh:connect/3</c></seealso></p></item> + <tag><c>timeout()</c></tag> - <item><p>= <c>infinity | integer() in milliseconds. Default infinity.</c></p></item> + <item><p>= <c>infinity | integer()</c> in milliseconds. Default infinity.</p></item> </taglist> </section> <section> <title>Time-outs</title> <p>If the request functions for the SFTP channel return <c>{error, timeout}</c>, - it does not guarantee that the request never reached the server and was - not performed. It only means that no answer was received from the - server within the expected time.</p> + no answer was received from the server within the expected time.</p> + <p>The request may have reached the server and may have been performed. + However, no answer was received from the server within the expected time.</p> </section> <funcs> <func> - <name>apread(ChannelPid, Handle, Position, Len) -> {async, N} | {error, Reason}</name> + <name>apread(ChannelPid, Handle, Position, Len) -> {async, N} | {error, reason()}</name> <fsummary>Reads asynchronously from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -69,16 +86,15 @@ <v>Position = integer()</v> <v>Len = integer()</v> <v>N = term()</v> - <v>Reason = term()</v> </type> - - <desc><p>The <c><![CDATA[apread]]></c> function reads from a specified position, - combining the <c><![CDATA[position]]></c> and <c><![CDATA[aread]]></c> functions.</p> - <p><seealso marker="#apread-4">ssh_sftp:apread/4</seealso></p> </desc> + <desc><p>The <c><![CDATA[apread/4]]></c> function reads from a specified position, + combining the <seealso marker="#position-3"><c>position/3</c></seealso> and + <seealso marker="#aread-3"><c>aread/3</c></seealso> functions.</p> + </desc> </func> <func> - <name>apwrite(ChannelPid, Handle, Position, Data) -> ok | {error, Reason}</name> + <name>apwrite(ChannelPid, Handle, Position, Data) -> {async, N} | {error, reason()}</name> <fsummary>Writes asynchronously to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -87,16 +103,16 @@ <v>Len = integer()</v> <v>Data = binary()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> + <v>N = term()</v> </type> - <desc> - <p><c><![CDATA[apwrite]]></c> writes on a specified position, combining - the <c><![CDATA[position]]></c> and <c><![CDATA[awrite]]></c> operations.</p> - <p><seealso marker="#awrite-3">ssh_sftp:awrite/3</seealso> </p></desc> + <desc><p>The <c><![CDATA[apwrite/4]]></c> function writes to a specified position, + combining the <seealso marker="#position-3"><c>position/3</c></seealso> and + <seealso marker="#awrite-3"><c>awrite/3</c></seealso> functions.</p> + </desc> </func> <func> - <name>aread(ChannelPid, Handle, Len) -> {async, N} | {error, Error}</name> + <name>aread(ChannelPid, Handle, Len) -> {async, N} | {error, reason()}</name> <fsummary>Reads asynchronously from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -104,7 +120,6 @@ <v>Position = integer()</v> <v>Len = integer()</v> <v>N = term()</v> - <v>Reason = term()</v> </type> <desc> <p>Reads from an open file, without waiting for the result. If the @@ -113,14 +128,12 @@ The actual data is sent as a message to the calling process. This message has the form <c><![CDATA[{async_reply, N, Result}]]></c>, where <c><![CDATA[Result]]></c> is the result from the read, either <c><![CDATA[{ok, Data}]]></c>, - <c><![CDATA[eof]]></c>, or <c><![CDATA[{error, Error}]]></c>.</p> + <c><![CDATA[eof]]></c>, or <c><![CDATA[{error, reason()}]]></c>.</p> </desc> </func> - - <func> - <name>awrite(ChannelPid, Handle, Data) -> ok | {error, Reason}</name> + <name>awrite(ChannelPid, Handle, Data) -> {async, N} | {error, reason()}</name> <fsummary>Writes asynchronously to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -129,7 +142,6 @@ <v>Len = integer()</v> <v>Data = binary()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Writes to an open file, without waiting for the result. If the @@ -138,19 +150,18 @@ <c><![CDATA[awrite]]></c>. The result of the <c><![CDATA[write]]></c> operation is sent as a message to the calling process. This message has the form <c><![CDATA[{async_reply, N, Result}]]></c>, where <c><![CDATA[Result]]></c> is the result - from the write, either <c><![CDATA[ok]]></c>, or <c><![CDATA[{error, Error}]]></c>.</p> + from the write, either <c><![CDATA[ok]]></c>, or <c><![CDATA[{error, reason()}]]></c>.</p> </desc> </func> <func> <name>close(ChannelPid, Handle) -></name> - <name>close(ChannelPid, Handle, Timeout) -> ok | {error, Reason}</name> + <name>close(ChannelPid, Handle, Timeout) -> ok | {error, reason()}</name> <fsummary>Closes an open handle.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Handle = term()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Closes a handle to an open file or directory on the server.</p> @@ -159,29 +170,27 @@ <func> <name>delete(ChannelPid, Name) -></name> - <name>delete(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> + <name>delete(ChannelPid, Name, Timeout) -> ok | {error, reason()}</name> <fsummary>Deletes a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> - <p>Deletes the file specified by <c><![CDATA[Name]]></c>, like - <seealso marker="kernel:file#delete-1">file:delete/1</seealso></p> + <p>Deletes the file specified by <c><![CDATA[Name]]></c>. + </p> </desc> </func> <func> <name>del_dir(ChannelPid, Name) -></name> - <name>del_dir(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> + <name>del_dir(ChannelPid, Name, Timeout) -> ok | {error, reason()}</name> <fsummary>Deletes an empty directory.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Deletes a directory specified by <c><![CDATA[Name]]></c>. @@ -192,7 +201,7 @@ <func> <name>list_dir(ChannelPid, Path) -></name> - <name>list_dir(ChannelPid, Path, Timeout) -> {ok, Filenames} | {error, Reason}</name> + <name>list_dir(ChannelPid, Path, Timeout) -> {ok, Filenames} | {error, reason()}</name> <fsummary>Lists the directory.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -200,7 +209,6 @@ <v>Filenames = [Filename]</v> <v>Filename = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Lists the given directory on the server, returning the @@ -210,13 +218,12 @@ <func> <name>make_dir(ChannelPid, Name) -></name> - <name>make_dir(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> + <name>make_dir(ChannelPid, Name, Timeout) -> ok | {error, reason()}</name> <fsummary>Creates a directory.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Creates a directory specified by <c><![CDATA[Name]]></c>. <c><![CDATA[Name]]></c> @@ -227,24 +234,23 @@ <func> <name>make_symlink(ChannelPid, Name, Target) -></name> - <name>make_symlink(ChannelPid, Name, Target, Timeout) -> ok | {error, Reason}</name> + <name>make_symlink(ChannelPid, Name, Target, Timeout) -> ok | {error, reason()}</name> <fsummary>Creates a symbolic link.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Target = string()</v> - <v>Reason = term()</v> </type> <desc> <p>Creates a symbolic link pointing to <c><![CDATA[Target]]></c> with the - name <c><![CDATA[Name]]></c>, like - <seealso marker="kernel:file#make_symlink-2">file:make_symlink/2</seealso></p> + name <c><![CDATA[Name]]></c>. + </p> </desc> </func> <func> <name>open(ChannelPid, File, Mode) -></name> - <name>open(ChannelPid, File, Mode, Timeout) -> {ok, Handle} | {error, Reason}</name> + <name>open(ChannelPid, File, Mode, Timeout) -> {ok, Handle} | {error, reason()}</name> <fsummary>Opens a file and returns a handle.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -253,7 +259,6 @@ <v>Modeflag = read | write | creat | trunc | append | binary</v> <v>Timeout = timeout()</v> <v>Handle = term()</v> - <v>Reason = term()</v> </type> <desc> <p>Opens a file on the server and returns a handle, which @@ -262,13 +267,12 @@ </func> <func> <name>opendir(ChannelPid, Path) -></name> - <name>opendir(ChannelPid, Path, Timeout) -> {ok, Handle} | {error, Reason}</name> + <name>opendir(ChannelPid, Path, Timeout) -> {ok, Handle} | {error, reason()}</name> <fsummary>Opens a directory and returns a handle.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Path = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Opens a handle to a directory on the server. The handle @@ -278,7 +282,7 @@ <func> <name>open_tar(ChannelPid, Path, Mode) -></name> - <name>open_tar(ChannelPid, Path, Mode, Timeout) -> {ok, Handle} | {error, Reason}</name> + <name>open_tar(ChannelPid, Path, Mode, Timeout) -> {ok, Handle} | {error, reason()}</name> <fsummary>Opens a tar file on the server to which <c>ChannelPid</c> is connected and returns a handle.</fsummary> <type> @@ -298,7 +302,6 @@ <v>DecryptResult = {ok,PlainBin,CryptoState} | {ok,PlainBin,CryptoState,ChunkSize}</v> <v>CloseFun = (fun(PlainBin,CryptoState) -> {ok,EncryptedBin})</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Opens a handle to a tar file on the server, associated with <c>ChannelPid</c>. @@ -333,7 +336,7 @@ <func> <name>position(ChannelPid, Handle, Location) -></name> - <name>position(ChannelPid, Handle, Location, Timeout) -> {ok, NewPosition} | {error, Reason}</name> + <name>position(ChannelPid, Handle, Location, Timeout) -> {ok, NewPosition | {error, reason()}</name> <fsummary>Sets the file position of a file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -343,12 +346,11 @@ <v>Offset = integer()</v> <v>Timeout = timeout()</v> <v>NewPosition = integer()</v> - <v>Reason = term()</v> </type> <desc> <p>Sets the file position of the file referenced by <c><![CDATA[Handle]]></c>. Returns <c><![CDATA[{ok, NewPosition}]]></c> (as an absolute offset) if - successful, otherwise <c><![CDATA[{error, Reason}]]></c>. <c><![CDATA[Location]]></c> is + successful, otherwise <c><![CDATA[{error, reason()}]]></c>. <c><![CDATA[Location]]></c> is one of the following:</p> <taglist> <tag><c><![CDATA[Offset]]></c></tag> @@ -379,7 +381,7 @@ <func> <name>pread(ChannelPid, Handle, Position, Len) -></name> - <name>pread(ChannelPid, Handle, Position, Len, Timeout) -> {ok, Data} | eof | {error, Error}</name> + <name>pread(ChannelPid, Handle, Position, Len, Timeout) -> {ok, Data} | eof | {error, reason()}</name> <fsummary>Reads from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -388,18 +390,16 @@ <v>Len = integer()</v> <v>Timeout = timeout()</v> <v>Data = string() | binary()</v> - <v>Reason = term()</v> </type> - <desc> - <p>The <c><![CDATA[pread]]></c> function reads from a specified position, - combining the <c><![CDATA[position]]></c> and <c><![CDATA[read]]></c> functions.</p> - <p><seealso marker="#read-4">ssh_sftp:read/4</seealso></p> - </desc> - </func> + <desc><p>The <c><![CDATA[pread/3,4]]></c> function reads from a specified position, + combining the <seealso marker="#position-3"><c>position/3</c></seealso> and + <seealso marker="#read-3"><c>read/3,4</c></seealso> functions.</p> + </desc> + </func> <func> <name>pwrite(ChannelPid, Handle, Position, Data) -> ok</name> - <name>pwrite(ChannelPid, Handle, Position, Data, Timeout) -> ok | {error, Reason}</name> + <name>pwrite(ChannelPid, Handle, Position, Data, Timeout) -> ok | {error, reason()}</name> <fsummary>Writes to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -407,19 +407,16 @@ <v>Position = integer()</v> <v>Data = iolist()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> - <desc> - <p>The <c><![CDATA[pread]]></c> function writes to a specified position, - combining the <c><![CDATA[position]]></c> and <c><![CDATA[write]]></c> functions.</p> - <p><seealso marker="#write-3">ssh_sftp:write/3</seealso></p> - </desc> + <desc><p>The <c><![CDATA[pwrite/3,4]]></c> function writes to a specified position, + combining the <seealso marker="#position-3"><c>position/3</c></seealso> and + <seealso marker="#write-3"><c>write/3,4</c></seealso> functions.</p> + </desc> </func> - - <func> + <func> <name>read(ChannelPid, Handle, Len) -></name> - <name>read(ChannelPid, Handle, Len, Timeout) -> {ok, Data} | eof | {error, Error}</name> + <name>read(ChannelPid, Handle, Len, Timeout) -> {ok, Data} | eof | {error, reason()}</name> <fsummary>Reads from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -428,12 +425,11 @@ <v>Len = integer()</v> <v>Timeout = timeout()</v> <v>Data = string() | binary()</v> - <v>Reason = term()</v> </type> <desc> <p>Reads <c><![CDATA[Len]]></c> bytes from the file referenced by <c><![CDATA[Handle]]></c>. Returns <c><![CDATA[{ok, Data}]]></c>, <c><![CDATA[eof]]></c>, or - <c><![CDATA[{error, Reason}]]></c>. If the file is opened with <c><![CDATA[binary]]></c>, + <c><![CDATA[{error, reason()}]]></c>. If the file is opened with <c><![CDATA[binary]]></c>, <c><![CDATA[Data]]></c> is a binary, otherwise it is a string.</p> <p>If the file is read past <c>eof</c>, only the remaining bytes are read and returned. If no bytes are read, <c><![CDATA[eof]]></c> @@ -443,25 +439,22 @@ <func> <name>read_file(ChannelPid, File) -></name> - <name>read_file(ChannelPid, File, Timeout) -> {ok, Data} | {error, Reason}</name> + <name>read_file(ChannelPid, File, Timeout) -> {ok, Data} | {error, reason()}</name> <fsummary>Reads a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>File = string()</v> <v>Data = binary()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> - <p>Reads a file from the server, and returns the data in a binary, - like - <seealso marker="kernel:file#read_file-1">file:read_file/1</seealso></p> + <p>Reads a file from the server, and returns the data in a binary.</p> </desc> </func> <func> <name>read_file_info(ChannelPid, Name) -></name> - <name>read_file_info(ChannelPid, Name, Timeout) -> {ok, FileInfo} | {error, Reason}</name> + <name>read_file_info(ChannelPid, Name, Timeout) -> {ok, FileInfo} | {error, reason()}</name> <fsummary>Gets information about a file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -469,35 +462,34 @@ <v>Handle = term()</v> <v>Timeout = timeout()</v> <v>FileInfo = record()</v> - <v>Reason = term()</v> </type> <desc> <p>Returns a <c><![CDATA[file_info]]></c> record from the file specified by - <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>, - like <seealso marker="kernel:file#read_file_info-2">file:read_file_info/2</seealso></p> + <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>. See + <seealso marker="kernel:file#read_file_info-2">file:read_file_info/2</seealso> + for information about the record. + </p> </desc> </func> <func> <name>read_link(ChannelPid, Name) -></name> - <name>read_link(ChannelPid, Name, Timeout) -> {ok, Target} | {error, Reason}</name> + <name>read_link(ChannelPid, Name, Timeout) -> {ok, Target} | {error, reason()}</name> <fsummary>Reads symbolic link.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Target = string()</v> - <v>Reason = term()</v> </type> <desc> - <p>Reads the link target from the symbolic link specified - by <c><![CDATA[name]]></c>, like - <seealso marker="kernel:file#read_link-1">file:read_link/1</seealso></p> + <p>Reads the link target from the symbolic link specified by <c><![CDATA[name]]></c>. + </p> </desc> </func> <func> - <name>read_link_info(ChannelPid, Name) -> {ok, FileInfo} | {error, Reason}</name> - <name>read_link_info(ChannelPid, Name, Timeout) -> {ok, FileInfo} | {error, Reason}</name> + <name>read_link_info(ChannelPid, Name) -> {ok, FileInfo} | {error, reason()}</name> + <name>read_link_info(ChannelPid, Name, Timeout) -> {ok, FileInfo} | {error, reason()}</name> <fsummary>Gets information about a symbolic link.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -505,30 +497,31 @@ <v>Handle = term()</v> <v>Timeout = timeout()</v> <v>FileInfo = record()</v> - <v>Reason = term()</v> </type> <desc> <p>Returns a <c><![CDATA[file_info]]></c> record from the symbolic - link specified by <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>, like - <seealso marker="kernel:file#read_link_info-2">file:read_link_info/2</seealso></p> + link specified by <c><![CDATA[Name]]></c> or <c><![CDATA[Handle]]></c>. + See + <seealso marker="kernel:file#read_link_info-2">file:read_link_info/2</seealso> + for information about the record. + </p> </desc> </func> <func> <name>rename(ChannelPid, OldName, NewName) -> </name> - <name>rename(ChannelPid, OldName, NewName, Timeout) -> ok | {error, Reason}</name> + <name>rename(ChannelPid, OldName, NewName, Timeout) -> ok | {error, reason()}</name> <fsummary>Renames a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>OldName = string()</v> <v>NewName = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Renames a file named <c><![CDATA[OldName]]></c> and gives it the name - <c><![CDATA[NewName]]></c>, like - <seealso marker="kernel:file#rename-2">file:rename/2</seealso></p> + <c><![CDATA[NewName]]></c>. + </p> </desc> </func> @@ -537,14 +530,13 @@ <name>start_channel(ConnectionRef, Options) -></name> <name>start_channel(Host, Options) -></name> <name>start_channel(Host, Port, Options) -> {ok, Pid} | {ok, Pid, ConnectionRef} | - {error, Reason}</name> + {error, reason()|term()}</name> <fsummary>Starts an SFTP client.</fsummary> <type> <v>Host = string()</v> <v>ConnectionRef = ssh_connection_ref()</v> <v>Port = integer()</v> <v>Options = [{Option, Value}]</v> - <v>Reason = term()</v> </type> <desc> <p>If no connection reference is provided, a connection is set @@ -592,7 +584,7 @@ <func> <name>write(ChannelPid, Handle, Data) -></name> - <name>write(ChannelPid, Handle, Data, Timeout) -> ok | {error, Reason}</name> + <name>write(ChannelPid, Handle, Data, Timeout) -> ok | {error, reason()}</name> <fsummary>Writes to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> @@ -600,61 +592,47 @@ <v>Position = integer()</v> <v>Data = iolist()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Writes <c><![CDATA[data]]></c> to the file referenced by <c><![CDATA[Handle]]></c>. The file is to be opened with <c><![CDATA[write]]></c> or <c><![CDATA[append]]></c> - flag. Returns <c><![CDATA[ok]]></c> if successful or <c><![CDATA[{error, Reason}]]></c> + flag. Returns <c><![CDATA[ok]]></c> if successful or <c><![CDATA[{error, reason()}]]></c> otherwise.</p> - <p>Typical error reasons:</p> - <taglist> - <tag><c><![CDATA[ebadf]]></c></tag> - <item> - <p>File is not opened for writing.</p> - </item> - <tag><c><![CDATA[enospc]]></c></tag> - <item> - <p>No space is left on the device.</p> - </item> - </taglist> </desc> </func> <func> <name>write_file(ChannelPid, File, Iolist) -></name> - <name>write_file(ChannelPid, File, Iolist, Timeout) -> ok | {error, Reason}</name> + <name>write_file(ChannelPid, File, Iolist, Timeout) -> ok | {error, reason()}</name> <fsummary>Writes a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>File = string()</v> <v>Iolist = iolist()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> - <p>Writes a file to the server, like <seealso - marker="kernel:file#write_file-2">file:write_file/2</seealso> The - file is created if it does not exist. The file is overwritten - if it exists.</p> + <p>Writes a file to the server. The file is created if it does not exist + but overwritten if it exists.</p> </desc> </func> <func> <name>write_file_info(ChannelPid, Name, Info) -></name> - <name>write_file_info(ChannelPid, Name, Info, Timeout) -> ok | {error, Reason}</name> + <name>write_file_info(ChannelPid, Name, Info, Timeout) -> ok | {error, reason()}</name> <fsummary>Writes information for a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> <v>Info = record()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> </type> <desc> <p>Writes file information from a <c><![CDATA[file_info]]></c> record to the - file specified by <c><![CDATA[Name]]></c>, like - <seealso marker="kernel:file#write_file_info-2">file:write_file_info/[2,3]</seealso></p> + file specified by <c><![CDATA[Name]]></c>. See + <seealso marker="kernel:file#write_file_info-2">file:write_file_info/[2,3]</seealso> + for information about the record. + </p> </desc> </func> </funcs> diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index c67350bf72..3245ba5197 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -40,7 +40,12 @@ {applications, [kernel, stdlib, crypto, public_key]}, {env, []}, {mod, {ssh_app, []}}, - {runtime_dependencies, ["stdlib-2.3","public_key-0.22","kernel-3.0", - "erts-6.0","crypto-3.3"]}]}. + {runtime_dependencies, [ + "crypto-3.3", + "erts-6.0", + "kernel-3.0", + "public_key-1.1", + "stdlib-3.0" + ]}]}. diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index d0121e73ba..09b07b7a2a 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -30,12 +30,18 @@ -export([start/0, start/1, stop/0, connect/3, connect/4, close/1, connection_info/2, channel_info/3, daemon/1, daemon/2, daemon/3, + daemon_info/1, default_algorithms/0, stop_listener/1, stop_listener/2, stop_listener/3, stop_daemon/1, stop_daemon/2, stop_daemon/3, shell/1, shell/2, shell/3 ]). +%%% Type exports +-export_type([connection_ref/0, + channel_id/0 + ]). + %%-------------------------------------------------------------------- -spec start() -> ok | {error, term()}. -spec start(permanent | transient | temporary) -> ok | {error, term()}. @@ -81,7 +87,7 @@ connect(Host, Port, Options, Timeout) -> ConnectionTimeout = proplists:get_value(connect_timeout, Options, infinity), try Transport:connect(Host, Port, [ {active, false} | SocketOptions], ConnectionTimeout) of {ok, Socket} -> - Opts = [{user_pid, self()}, {host, Host} | fix_idle_time(SshOptions)], + Opts = [{user_pid,self()}, {host,Host} | SshOptions], ssh_connection_handler:start_connection(client, Socket, Opts, Timeout); {error, Reason} -> {error, Reason} @@ -153,6 +159,19 @@ daemon(HostAddr, Port, Options0) -> start_daemon(Host, Port, Options, Inet). %%-------------------------------------------------------------------- +daemon_info(Pid) -> + case catch ssh_system_sup:acceptor_supervisor(Pid) of + AsupPid when is_pid(AsupPid) -> + [Port] = + [Prt || {{ssh_acceptor_sup,any,Prt,default}, + _WorkerPid,worker,[ssh_acceptor]} <- supervisor:which_children(AsupPid)], + {ok, [{port,Port}]}; + + _ -> + {error,bad_daemon_ref} + end. + +%%-------------------------------------------------------------------- -spec stop_listener(pid()) -> ok. -spec stop_listener(inet:ip_address(), integer()) -> ok. %% @@ -223,13 +242,6 @@ default_algorithms() -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -fix_idle_time(SshOptions) -> - case proplists:get_value(idle_time, SshOptions) of - undefined -> - [{idle_time, infinity}|SshOptions]; - _ -> - SshOptions - end. start_daemon(Host, Port, Options, Inet) -> case handle_options(Options) of {error, _Reason} = Error -> @@ -243,32 +255,52 @@ start_daemon(Host, Port, Options, Inet) -> end end. -do_start_daemon(Host0, Port0, Options, SocketOptions) -> - {Host,Port} = try - case proplists:get_value(fd, SocketOptions) of - undefined -> - {Host0,Port0}; - Fd when Port0==0 -> - find_hostport(Fd); - _ -> - {Host0,Port0} - end - catch - _:_ -> throw(bad_fd) - end, - Profile = proplists:get_value(profile, Options, ?DEFAULT_PROFILE), +do_start_daemon(Host0, Port0, SshOptions, SocketOptions) -> + {Host,Port1} = + try + case proplists:get_value(fd, SocketOptions) of + undefined -> + {Host0,Port0}; + Fd when Port0==0 -> + find_hostport(Fd); + _ -> + {Host0,Port0} + end + catch + _:_ -> throw(bad_fd) + end, + Profile = proplists:get_value(profile, SshOptions, ?DEFAULT_PROFILE), + {Port, WaitRequestControl, Opts} = + case Port1 of + 0 -> %% Allocate the socket here to get the port number... + {_, Callback, _} = + proplists:get_value(transport, SshOptions, {tcp, gen_tcp, tcp_closed}), + {ok,LSock} = ssh_acceptor:callback_listen(Callback, 0, SocketOptions), + {ok,{_,LPort}} = inet:sockname(LSock), + {LPort, + {LSock,Callback}, + [{lsocket,LSock},{lsock_owner,self()}] + }; + _ -> + {Port1, false, []} + end, case ssh_system_sup:system_supervisor(Host, Port, Profile) of undefined -> %% It would proably make more sense to call the %% address option host but that is a too big change at the %% monent. The name is a legacy name! try sshd_sup:start_child([{address, Host}, - {port, Port}, {role, server}, + {port, Port}, + {role, server}, {socket_opts, SocketOptions}, - {ssh_opts, Options}]) of + {ssh_opts, SshOptions} + | Opts]) of {error, {already_started, _}} -> {error, eaddrinuse}; - Result = {Code, _} when (Code == ok) or (Code == error) -> + Result = {ok,_} -> + sync_request_control(WaitRequestControl), + Result; + Result = {error, _} -> Result catch exit:{noproc, _} -> @@ -277,18 +309,31 @@ do_start_daemon(Host0, Port0, Options, SocketOptions) -> Sup -> AccPid = ssh_system_sup:acceptor_supervisor(Sup), case ssh_acceptor_sup:start_child(AccPid, [{address, Host}, - {port, Port}, {role, server}, + {port, Port}, + {role, server}, {socket_opts, SocketOptions}, - {ssh_opts, Options}]) of + {ssh_opts, SshOptions} + | Opts]) of {error, {already_started, _}} -> {error, eaddrinuse}; {ok, _} -> + sync_request_control(WaitRequestControl), {ok, Sup}; Other -> Other end end. +sync_request_control(false) -> + ok; +sync_request_control({LSock,Callback}) -> + receive + {request_control,LSock,ReqPid} -> + ok = Callback:controlling_process(LSock, ReqPid), + ReqPid ! {its_yours,LSock}, + ok + end. + find_hostport(Fd) -> %% Using internal functions inet:open/8 and inet:close/0. %% Don't try this at home unless you know what you are doing! diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 73d6e4d2bc..868f3a9181 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -70,8 +70,6 @@ -record(ssh, { - %%state, %% what it's waiting for - role, %% client | server peer, %% string version of peer address @@ -135,8 +133,8 @@ user, service, userauth_quiet_mode, % boolean() - userauth_supported_methods, % string() eg "keyboard-interactive,password" userauth_methods, % list( string() ) eg ["keyboard-interactive", "password"] + userauth_supported_methods, % string() eg "keyboard-interactive,password" kb_tries_left = 0, % integer(), num tries left for "keyboard-interactive" userauth_preference, available_host_keys, diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index d94dedf1bf..90fd951dcd 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -26,7 +26,8 @@ %% Internal application API -export([start_link/5, - number_of_connections/1]). + number_of_connections/1, + callback_listen/3]). %% spawn export -export([acceptor_init/6, acceptor_loop/6]). @@ -46,15 +47,39 @@ start_link(Port, Address, SockOpts, Opts, AcceptTimeout) -> acceptor_init(Parent, Port, Address, SockOpts, Opts, AcceptTimeout) -> {_, Callback, _} = proplists:get_value(transport, Opts, {tcp, gen_tcp, tcp_closed}), - case (catch do_socket_listen(Callback, Port, [{active, false} | SockOpts])) of - {ok, ListenSocket} -> + + SockOwner = proplists:get_value(lsock_owner, Opts), + LSock = proplists:get_value(lsocket, Opts), + UseExistingSocket = + case catch inet:sockname(LSock) of + {ok,{_,Port}} -> is_pid(SockOwner); + _ -> false + end, + + case UseExistingSocket of + true -> proc_lib:init_ack(Parent, {ok, self()}), - acceptor_loop(Callback, - Port, Address, Opts, ListenSocket, AcceptTimeout); - Error -> - proc_lib:init_ack(Parent, Error), - error + request_ownership(LSock, SockOwner), + acceptor_loop(Callback, Port, Address, Opts, LSock, AcceptTimeout); + + false -> + case (catch do_socket_listen(Callback, Port, SockOpts)) of + {ok, ListenSocket} -> + proc_lib:init_ack(Parent, {ok, self()}), + acceptor_loop(Callback, + Port, Address, Opts, ListenSocket, AcceptTimeout); + Error -> + proc_lib:init_ack(Parent, Error), + error + end end. + +request_ownership(LSock, SockOwner) -> + SockOwner ! {request_control,LSock,self()}, + receive + {its_yours,LSock} -> ok + end. + do_socket_listen(Callback, Port0, Opts) -> Port = @@ -62,6 +87,10 @@ do_socket_listen(Callback, Port0, Opts) -> undefined -> Port0; _ -> 0 end, + callback_listen(Callback, Port, Opts). + +callback_listen(Callback, Port, Opts0) -> + Opts = [{active, false}, {reuseaddr,true} | Opts0], case Callback:listen(Port, Opts) of {error, nxdomain} -> Callback:listen(Port, lists:delete(inet6, Opts)); diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl index b2f489a971..4f76dbe6f0 100644 --- a/lib/ssh/src/ssh_acceptor_sup.erl +++ b/lib/ssh/src/ssh_acceptor_sup.erl @@ -85,10 +85,7 @@ child_spec(ServerOpts) -> Profile = proplists:get_value(profile, proplists:get_value(ssh_opts, ServerOpts), ?DEFAULT_PROFILE), Name = id(Address, Port, Profile), SocketOpts = proplists:get_value(socket_opts, ServerOpts), - StartFunc = {ssh_acceptor, start_link, [Port, Address, - [{active, false}, - {reuseaddr, true}] ++ SocketOpts, - ServerOpts, Timeout]}, + StartFunc = {ssh_acceptor, start_link, [Port, Address, SocketOpts, ServerOpts, Timeout]}, Restart = transient, Shutdown = brutal_kill, Modules = [ssh_acceptor], diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index 4b3c21ce3f..49eec8072f 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -135,9 +135,9 @@ init_userauth_request_msg(#ssh{opts = Opts} = Ssh) -> service = "ssh-connection"}); {error, no_user} -> ErrStr = "Could not determine the users name", - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_ILLEGAL_USER_NAME, - description = ErrStr, - language = "en"}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_ILLEGAL_USER_NAME, + description = ErrStr}) end. userauth_request_msg(#ssh{userauth_preference = []} = Ssh) -> @@ -355,10 +355,10 @@ handle_userauth_info_response(#ssh_msg_userauth_info_response{num_responses = 1, handle_userauth_info_response(#ssh_msg_userauth_info_response{}, _Auth) -> - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "Server does not support" - "keyboard-interactive", - language = "en"}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "Server does not support keyboard-interactive" + }). %%-------------------------------------------------------------------- @@ -420,10 +420,10 @@ check_password(User, Password, Opts, Ssh) -> {false,NewState} -> {false, Ssh#ssh{pwdfun_user_state=NewState}}; disconnect -> - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = - "Unable to connect using the available authentication methods", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "Unable to connect using the available authentication methods" + }) end end. diff --git a/lib/ssh/src/ssh_channel.erl b/lib/ssh/src/ssh_channel.erl index de6908bb38..a8e6ebde16 100644 --- a/lib/ssh/src/ssh_channel.erl +++ b/lib/ssh/src/ssh_channel.erl @@ -68,7 +68,7 @@ %% Internal application API -export([cache_create/0, cache_lookup/2, cache_update/2, cache_delete/1, cache_delete/2, cache_foldl/3, - cache_find/2, + cache_info/2, cache_find/2, get_print_info/1]). -record(state, { @@ -335,6 +335,9 @@ cache_delete(Cache) -> cache_foldl(Fun, Acc, Cache) -> ets:foldl(Fun, Acc, Cache). +cache_info(num_entries, Cache) -> + proplists:get_value(size, ets:info(Cache)). + cache_find(ChannelPid, Cache) -> case ets:match_object(Cache, #channel{user = ChannelPid}) of [] -> diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl index 397d51de9d..4fb6bc39f3 100644 --- a/lib/ssh/src/ssh_connect.hrl +++ b/lib/ssh/src/ssh_connect.hrl @@ -22,13 +22,15 @@ %%% Description : SSH connection protocol --type channel_id() :: integer(). +-type role() :: client | server . +-type connection_ref() :: pid(). +-type channel_id() :: pos_integer(). -define(DEFAULT_PACKET_SIZE, 65536). -define(DEFAULT_WINDOW_SIZE, 10*?DEFAULT_PACKET_SIZE). -define(DEFAULT_TIMEOUT, 5000). --define(MAX_PROTO_VERSION, 255). +-define(MAX_PROTO_VERSION, 255). % Max length of the hello string %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @@ -241,7 +243,7 @@ -record(channel, { - type, %% "session", "x11", "forwarded-tcpip", "direct-tcpip" + type, %% "session" sys, %% "none", "shell", "exec" "subsystem" user, %% "user" process id (default to cm user) flow_control, diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index a34478732c..d0f2d54c06 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -38,8 +38,7 @@ %% Potential API currently unsupported and not tested -export([window_change/4, window_change/6, - direct_tcpip/6, direct_tcpip/8, tcpip_forward/3, - cancel_tcpip_forward/3, signal/3, exit_status/3]). + signal/3, exit_status/3]). %% Internal application API -export([channel_data/5, handle_msg/3, channel_eof_msg/1, @@ -48,7 +47,7 @@ channel_adjust_window_msg/2, channel_data_msg/3, channel_open_msg/5, channel_open_confirmation_msg/4, channel_open_failure_msg/4, channel_request_msg/4, - global_request_msg/3, request_failure_msg/0, + request_failure_msg/0, request_success_msg/1, bind/4, unbind/3, unbind_channel/2, bound_channel/3, encode_ip/1]). @@ -232,52 +231,6 @@ exit_status(ConnectionHandler, Channel, Status) -> ssh_connection_handler:request(ConnectionHandler, Channel, "exit-status", false, [?uint32(Status)], 0). -direct_tcpip(ConnectionHandler, RemoteHost, - RemotePort, OrigIP, OrigPort, Timeout) -> - direct_tcpip(ConnectionHandler, RemoteHost, RemotePort, OrigIP, OrigPort, - ?DEFAULT_WINDOW_SIZE, ?DEFAULT_PACKET_SIZE, Timeout). - -direct_tcpip(ConnectionHandler, RemoteIP, RemotePort, OrigIP, OrigPort, - InitialWindowSize, MaxPacketSize, Timeout) -> - case {encode_ip(RemoteIP), encode_ip(OrigIP)} of - {false, _} -> - {error, einval}; - {_, false} -> - {error, einval}; - {RIP, OIP} -> - ssh_connection_handler:open_channel(ConnectionHandler, - "direct-tcpip", - [?string(RIP), - ?uint32(RemotePort), - ?string(OIP), - ?uint32(OrigPort)], - InitialWindowSize, - MaxPacketSize, - Timeout) - end. - -tcpip_forward(ConnectionHandler, BindIP, BindPort) -> - case encode_ip(BindIP) of - false -> - {error, einval}; - IPStr -> - ssh_connection_handler:global_request(ConnectionHandler, - "tcpip-forward", true, - [?string(IPStr), - ?uint32(BindPort)]) - end. - -cancel_tcpip_forward(ConnectionHandler, BindIP, Port) -> - case encode_ip(BindIP) of - false -> - {error, einval}; - IPStr -> - ssh_connection_handler:global_request(ConnectionHandler, - "cancel-tcpip-forward", true, - [?string(IPStr), - ?uint32(Port)]) - end. - %%-------------------------------------------------------------------- %%% Internal API %%-------------------------------------------------------------------- @@ -300,22 +253,11 @@ l2b([]) -> channel_data(ChannelId, DataType, Data, Connection, From) when is_list(Data)-> - channel_data(ChannelId, DataType, -%% list_to_binary(Data), Connection, From); - l2b(Data), Connection, From); - %% try list_to_binary(Data) - %% of - %% B -> B - %% catch - %% _:_ -> io:format('BAD BINARY: ~p~n',[Data]), - %% unicode:characters_to_binary(Data) - %% end, - %% Connection, From); + channel_data(ChannelId, DataType, l2b(Data), Connection, From); channel_data(ChannelId, DataType, Data, #connection{channel_cache = Cache} = Connection, From) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of #channel{remote_id = Id, sent_close = false} = Channel0 -> {SendList, Channel} = @@ -331,8 +273,7 @@ channel_data(ChannelId, DataType, Data, FlowCtrlMsgs = flow_control(Replies, Channel, Cache), {{replies, Replies ++ FlowCtrlMsgs}, Connection}; _ -> - gen_fsm:reply(From, {error, closed}), - {noreply, Connection} + {{replies,[{channel_request_reply,From,{error,closed}}]}, Connection} end. handle_msg(#ssh_msg_channel_open_confirmation{recipient_channel = ChannelId, @@ -499,7 +440,8 @@ handle_msg(#ssh_msg_channel_open{channel_type = "session" = Type, handle_msg(#ssh_msg_channel_open{channel_type = "session", sender_channel = RemoteId}, - Connection, client) -> + Connection, + client) -> %% Client implementations SHOULD reject any session channel open %% requests to make it more difficult for a corrupt server to attack the %% client. See See RFC 4254 6.1. @@ -509,73 +451,6 @@ handle_msg(#ssh_msg_channel_open{channel_type = "session", {{replies, [{connection_reply, FailMsg}]}, Connection}; -handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip" = Type, - sender_channel = RemoteId, - initial_window_size = RWindowSz, - maximum_packet_size = RPacketSz, - data = Data}, - #connection{channel_cache = Cache, - options = SSHopts} = Connection0, server) -> - <<?UINT32(ALen), Address:ALen/binary, ?UINT32(Port), - ?UINT32(OLen), Orig:OLen/binary, ?UINT32(OrigPort)>> = Data, - - MinAcceptedPackSz = proplists:get_value(minimal_remote_max_packet_size, SSHopts, 0), - - if - MinAcceptedPackSz =< RPacketSz -> - case bound_channel(Address, Port, Connection0) of - undefined -> - FailMsg = channel_open_failure_msg(RemoteId, - ?SSH_OPEN_CONNECT_FAILED, - "Connection refused", "en"), - {{replies, - [{connection_reply, FailMsg}]}, Connection0}; - ChannelPid -> - {ChannelId, Connection1} = new_channel_id(Connection0), - LWindowSz = ?DEFAULT_WINDOW_SIZE, - LPacketSz = ?DEFAULT_PACKET_SIZE, - Channel = #channel{type = Type, - sys = "none", - user = ChannelPid, - local_id = ChannelId, - recv_window_size = LWindowSz, - recv_packet_size = LPacketSz, - send_window_size = RWindowSz, - send_packet_size = RPacketSz, - send_buf = queue:new() - }, - ssh_channel:cache_update(Cache, Channel), - OpenConfMsg = channel_open_confirmation_msg(RemoteId, ChannelId, - LWindowSz, LPacketSz), - {OpenMsg, Connection} = - reply_msg(Channel, Connection1, - {open, Channel, {forwarded_tcpip, - decode_ip(Address), Port, - decode_ip(Orig), OrigPort}}), - {{replies, [{connection_reply, OpenConfMsg}, - OpenMsg]}, Connection} - end; - - MinAcceptedPackSz > RPacketSz -> - FailMsg = channel_open_failure_msg(RemoteId, - ?SSH_OPEN_ADMINISTRATIVELY_PROHIBITED, - lists:concat(["Maximum packet size below ",MinAcceptedPackSz, - " not supported"]), "en"), - {{replies, [{connection_reply, FailMsg}]}, Connection0} - end; - - -handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip", - sender_channel = RemoteId}, - Connection, client) -> - %% Client implementations SHOULD reject direct TCP/IP open requests for - %% security reasons. See RFC 4254 7.2. - FailMsg = channel_open_failure_msg(RemoteId, - ?SSH_OPEN_CONNECT_FAILED, - "Connection refused", "en"), - {{replies, [{connection_reply, FailMsg}]}, Connection}; - - handle_msg(#ssh_msg_channel_open{sender_channel = RemoteId}, Connection, _) -> FailMsg = channel_open_failure_msg(RemoteId, ?SSH_OPEN_ADMINISTRATIVELY_PROHIBITED, @@ -786,11 +661,11 @@ handle_msg(#ssh_msg_global_request{name = _Type, handle_msg(#ssh_msg_request_failure{}, #connection{requests = [{_, From} | Rest]} = Connection, _) -> - {{replies, [{channel_requst_reply, From, {failure, <<>>}}]}, + {{replies, [{channel_request_reply, From, {failure, <<>>}}]}, Connection#connection{requests = Rest}}; handle_msg(#ssh_msg_request_success{data = Data}, #connection{requests = [{_, From} | Rest]} = Connection, _) -> - {{replies, [{channel_requst_reply, From, {success, Data}}]}, + {{replies, [{channel_request_reply, From, {success, Data}}]}, Connection#connection{requests = Rest}}; handle_msg(#ssh_msg_disconnect{code = Code, @@ -886,10 +761,6 @@ channel_request_msg(ChannelId, Type, WantReply, Data) -> want_reply = WantReply, data = Data}. -global_request_msg(Type, WantReply, Data) -> - #ssh_msg_global_request{name = Type, - want_reply = WantReply, - data = Data}. request_failure_msg() -> #ssh_msg_request_failure{}. @@ -1059,7 +930,7 @@ request_reply_or_data(#channel{local_id = ChannelId, user = ChannelPid}, Connection, Reply) -> case lists:keysearch(ChannelId, 1, Requests) of {value, {ChannelId, From}} -> - {{channel_requst_reply, From, Reply}, + {{channel_request_reply, From, Reply}, Connection#connection{requests = lists:keydelete(ChannelId, 1, Requests)}}; false when (Reply == success) or (Reply == failure) -> @@ -1351,11 +1222,6 @@ decode_pty_opts2(<<Code, ?UINT32(Value), Tail/binary>>) -> end, [{Op, Value} | decode_pty_opts2(Tail)]. -decode_ip(Addr) when is_binary(Addr) -> - case inet_parse:address(binary_to_list(Addr)) of - {error,_} -> Addr; - {ok,A} -> A - end. backwards_compatible([], Acc) -> Acc; diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 2bef6a41cd..0327a72c12 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -28,94 +28,90 @@ -module(ssh_connection_handler). --behaviour(gen_fsm). +-behaviour(gen_statem). -include("ssh.hrl"). -include("ssh_transport.hrl"). -include("ssh_auth.hrl"). -include("ssh_connect.hrl"). --compile(export_all). --export([start_link/3]). -%% Internal application API --export([open_channel/6, reply_request/3, request/6, request/7, - global_request/4, send/5, send_eof/2, info/1, info/2, - connection_info/2, channel_info/3, - adjust_window/3, close/2, stop/1, renegotiate/1, renegotiate_data/1, - start_connection/4, - get_print_info/1]). - -%% gen_fsm callbacks --export([hello/2, kexinit/2, key_exchange/2, - key_exchange_dh_gex_init/2, key_exchange_dh_gex_reply/2, - new_keys/2, - service_request/2, connected/2, - userauth/2, - userauth_keyboard_interactive/2, - userauth_keyboard_interactive_info_response/2, - error/2]). - --export([init/1, handle_event/3, - handle_sync_event/4, handle_info/3, terminate/3, format_status/2, code_change/4]). - --record(state, { - role, - client, - starter, - auth_user, - connection_state, - latest_channel_id = 0, - idle_timer_ref, - transport_protocol, % ex: tcp - transport_cb, - transport_close_tag, - ssh_params, % #ssh{} - from ssh.hrl - socket, % socket() - decoded_data_buffer, % binary() - encoded_data_buffer, % binary() - undecoded_packet_length, % integer() - key_exchange_init_msg, % #ssh_msg_kexinit{} - renegotiate = false, % boolean() - last_size_rekey = 0, - event_queue = [], - connection_queue, - address, - port, - opts, - recbuf - }). - --type state_name() :: hello | kexinit | key_exchange | key_exchange_dh_gex_init | - key_exchange_dh_gex_reply | new_keys | service_request | - userauth | userauth_keyboard_interactive | - userauth_keyboard_interactive_info_response | - connection. - --type gen_fsm_state_return() :: {next_state, state_name(), term()} | - {next_state, state_name(), term(), timeout()} | - {stop, term(), term()}. - --type gen_fsm_sync_return() :: {next_state, state_name(), term()} | - {next_state, state_name(), term(), timeout()} | - {reply, term(), state_name(), term()} | - {stop, term(), term(), term()}. +%%==================================================================== +%%% Exports +%%==================================================================== + +%%% Start and stop +-export([start_link/3, + stop/1 + ]). + +%%% Internal application API +-export([start_connection/4, + open_channel/6, + request/6, request/7, + reply_request/3, + send/5, + send_eof/2, + info/1, info/2, + connection_info/2, + channel_info/3, + adjust_window/3, close/2, + disconnect/1, disconnect/2, + get_print_info/1 + ]). + +%%% Behaviour callbacks +-export([handle_event/4, terminate/3, format_status/2, code_change/4]). + +%%% Exports not intended to be used :). They are used for spawning and tests +-export([init_connection_handler/3, % proc_lib:spawn needs this + init_ssh_record/3, % Export of this internal function + % intended for low-level protocol test suites + renegotiate/1, renegotiate_data/1 % Export intended for test cases + ]). %%==================================================================== -%% Internal application API +%% Start / stop %%==================================================================== +%%-------------------------------------------------------------------- +-spec start_link(role(), + inet:socket(), + proplists:proplist() + ) -> {ok, pid()}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +start_link(Role, Socket, Options) -> + {ok, proc_lib:spawn_link(?MODULE, init_connection_handler, [Role, Socket, Options])}. + %%-------------------------------------------------------------------- --spec start_connection(client| server, port(), proplists:proplist(), - timeout()) -> {ok, pid()} | {error, term()}. +-spec stop(connection_ref() + ) -> ok | {error, term()}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +stop(ConnectionHandler)-> + case call(ConnectionHandler, stop) of + {error, closed} -> + ok; + Other -> + Other + end. + +%%==================================================================== +%% Internal application API +%%==================================================================== + +-define(DefaultTransport, {tcp, gen_tcp, tcp_closed} ). + %%-------------------------------------------------------------------- +-spec start_connection(role(), + inet:socket(), + proplists:proplist(), + timeout() + ) -> {ok, connection_ref()} | {error, term()}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . start_connection(client = Role, Socket, Options, Timeout) -> try {ok, Pid} = sshc_sup:start_child([Role, Socket, Options]), - {_, Callback, _} = - proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}), - ok = socket_control(Socket, Pid, Callback), - Ref = erlang:monitor(process, Pid), - handshake(Pid, Ref, Timeout) + ok = socket_control(Socket, Pid, Options), + handshake(Pid, erlang:monitor(process,Pid), Timeout) catch exit:{noproc, _} -> {error, ssh_not_started}; @@ -128,8 +124,8 @@ start_connection(server = Role, Socket, Options, Timeout) -> try case proplists:get_value(parallel_login, SSH_Opts, false) of true -> - HandshakerPid = - spawn_link(fun() -> + HandshakerPid = + spawn_link(fun() -> receive {do_handshake, Pid} -> handshake(Pid, erlang:monitor(process,Pid), Timeout) @@ -148,953 +144,1123 @@ start_connection(server = Role, Socket, Options, Timeout) -> {error, Error} end. -start_the_connection_child(UserPid, Role, Socket, Options) -> - Sups = proplists:get_value(supervisors, Options), - ConnectionSup = proplists:get_value(connection_sup, Sups), - Opts = [{supervisors, Sups}, {user_pid, UserPid} | proplists:get_value(ssh_opts, Options, [])], - {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Opts]), - {_, Callback, _} = proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}), - socket_control(Socket, Pid, Callback), - Pid. - +%%-------------------------------------------------------------------- +%%% Some other module has decided to disconnect. +-spec disconnect(#ssh_msg_disconnect{}) -> no_return(). +-spec disconnect(#ssh_msg_disconnect{}, iodata()) -> no_return(). +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +disconnect(Msg = #ssh_msg_disconnect{}) -> + throw({keep_state_and_data, + [{next_event, internal, {disconnect, Msg, Msg#ssh_msg_disconnect.description}}]}). -start_link(Role, Socket, Options) -> - {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Socket, Options]])}. +disconnect(Msg = #ssh_msg_disconnect{}, ExtraInfo) -> + throw({keep_state_and_data, + [{next_event, internal, {disconnect, Msg, {Msg#ssh_msg_disconnect.description,ExtraInfo}}}]}). -init([Role, Socket, SshOpts]) -> - process_flag(trap_exit, true), - {NumVsn, StrVsn} = ssh_transport:versions(Role, SshOpts), - {Protocol, Callback, CloseTag} = - proplists:get_value(transport, SshOpts, {tcp, gen_tcp, tcp_closed}), - Cache = ssh_channel:cache_create(), - State0 = #state{ - role = Role, - connection_state = #connection{channel_cache = Cache, - channel_id_seed = 0, - port_bindings = [], - requests = [], - options = SshOpts}, - socket = Socket, - decoded_data_buffer = <<>>, - encoded_data_buffer = <<>>, - transport_protocol = Protocol, - transport_cb = Callback, - transport_close_tag = CloseTag, - opts = SshOpts - }, - - State = init_role(State0), - - try init_ssh(Role, NumVsn, StrVsn, SshOpts, Socket) of - Ssh -> - gen_fsm:enter_loop(?MODULE, [], hello, - State#state{ssh_params = Ssh}) - catch - _:Error -> - gen_fsm:enter_loop(?MODULE, [], error, {Error, State}) - end. -%% Temporary fix for the Nessus error. SYN-> <-SYNACK ACK-> RST-> ? -error(_Event, {Error,State=#state{}}) -> - case Error of - {badmatch,{error,enotconn}} -> - %% {error,enotconn} probably from inet:peername in - %% init_ssh(server,..)/5 called from init/1 - {stop, {shutdown,"TCP connenction to server was prematurely closed by the client"}, State}; - _ -> - {stop, {shutdown,{init,Error}}, State} - end; -error(Event, State) -> - %% State deliberately not checked beeing #state. This is a panic-clause... - {stop, {shutdown,{init,{spurious_error,Event}}}, State}. - -%%-------------------------------------------------------------------- --spec open_channel(pid(), string(), iodata(), integer(), integer(), - timeout()) -> {open, channel_id()} | {error, term()}. %%-------------------------------------------------------------------- -open_channel(ConnectionHandler, ChannelType, ChannelSpecificData, - InitialWindowSize, - MaxPacketSize, Timeout) -> - sync_send_all_state_event(ConnectionHandler, {open, self(), ChannelType, - InitialWindowSize, MaxPacketSize, - ChannelSpecificData, - Timeout}). -%%-------------------------------------------------------------------- --spec request(pid(), pid(), channel_id(), string(), boolean(), iodata(), - timeout()) -> success | failure | ok | {error, term()}. +-spec open_channel(connection_ref(), + string(), + iodata(), + pos_integer(), + pos_integer(), + timeout() + ) -> {open, channel_id()} | {error, term()}. + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +open_channel(ConnectionHandler, + ChannelType, ChannelSpecificData, InitialWindowSize, MaxPacketSize, + Timeout) -> + call(ConnectionHandler, + {open, + self(), + ChannelType, InitialWindowSize, MaxPacketSize, ChannelSpecificData, + Timeout}). + %%-------------------------------------------------------------------- +-spec request(connection_ref(), + pid(), + channel_id(), + string(), + boolean(), + iodata(), + timeout() + ) -> success | failure | ok | {error,timeout}. + +-spec request(connection_ref(), + channel_id(), + string(), + boolean(), + iodata(), + timeout() + ) -> success | failure | ok | {error,timeout}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . request(ConnectionHandler, ChannelPid, ChannelId, Type, true, Data, Timeout) -> - sync_send_all_state_event(ConnectionHandler, {request, ChannelPid, ChannelId, Type, Data, - Timeout}); + call(ConnectionHandler, {request, ChannelPid, ChannelId, Type, Data, Timeout}); request(ConnectionHandler, ChannelPid, ChannelId, Type, false, Data, _) -> - send_all_state_event(ConnectionHandler, {request, ChannelPid, ChannelId, Type, Data}). + cast(ConnectionHandler, {request, ChannelPid, ChannelId, Type, Data}). -%%-------------------------------------------------------------------- --spec request(pid(), channel_id(), string(), boolean(), iodata(), - timeout()) -> success | failure | {error, timeout}. -%%-------------------------------------------------------------------- request(ConnectionHandler, ChannelId, Type, true, Data, Timeout) -> - sync_send_all_state_event(ConnectionHandler, {request, ChannelId, Type, Data, Timeout}); + call(ConnectionHandler, {request, ChannelId, Type, Data, Timeout}); request(ConnectionHandler, ChannelId, Type, false, Data, _) -> - send_all_state_event(ConnectionHandler, {request, ChannelId, Type, Data}). + cast(ConnectionHandler, {request, ChannelId, Type, Data}). %%-------------------------------------------------------------------- --spec reply_request(pid(), success | failure, channel_id()) -> ok. -%%-------------------------------------------------------------------- +-spec reply_request(connection_ref(), + success | failure, + channel_id() + ) -> ok. + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . reply_request(ConnectionHandler, Status, ChannelId) -> - send_all_state_event(ConnectionHandler, {reply_request, Status, ChannelId}). - -%%-------------------------------------------------------------------- --spec global_request(pid(), string(), boolean(), iolist()) -> ok | error. -%%-------------------------------------------------------------------- -global_request(ConnectionHandler, Type, true = Reply, Data) -> - case sync_send_all_state_event(ConnectionHandler, - {global_request, self(), Type, Reply, Data}) of - {ssh_cm, ConnectionHandler, {success, _}} -> - ok; - {ssh_cm, ConnectionHandler, {failure, _}} -> - error - end; -global_request(ConnectionHandler, Type, false = Reply, Data) -> - send_all_state_event(ConnectionHandler, {global_request, self(), Type, Reply, Data}). + cast(ConnectionHandler, {reply_request, Status, ChannelId}). %%-------------------------------------------------------------------- --spec send(pid(), channel_id(), integer(), iodata(), timeout()) -> - ok | {error, timeout} | {error, closed}. -%%-------------------------------------------------------------------- +-spec send(connection_ref(), + channel_id(), + non_neg_integer(), + iodata(), + timeout() + ) -> ok | {error, timeout|closed}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . send(ConnectionHandler, ChannelId, Type, Data, Timeout) -> - sync_send_all_state_event(ConnectionHandler, {data, ChannelId, Type, Data, Timeout}). + call(ConnectionHandler, {data, ChannelId, Type, Data, Timeout}). %%-------------------------------------------------------------------- --spec send_eof(pid(), channel_id()) -> ok | {error, closed}. -%%-------------------------------------------------------------------- +-spec send_eof(connection_ref(), + channel_id() + ) -> ok | {error,closed}. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . send_eof(ConnectionHandler, ChannelId) -> - sync_send_all_state_event(ConnectionHandler, {eof, ChannelId}). + call(ConnectionHandler, {eof, ChannelId}). %%-------------------------------------------------------------------- --spec connection_info(pid(), [atom()]) -> proplists:proplist(). +-spec info(connection_ref() + ) -> {ok, [#channel{}]} . + +-spec info(connection_ref(), + pid() | all + ) -> {ok, [#channel{}]} . +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +info(ConnectionHandler) -> + info(ConnectionHandler, all). + +info(ConnectionHandler, ChannelProcess) -> + call(ConnectionHandler, {info, ChannelProcess}). + %%-------------------------------------------------------------------- +-type local_sock_info() :: {inet:ip_address(), non_neg_integer()} | string(). +-type peer_sock_info() :: {inet:ip_address(), non_neg_integer()} | string(). +-type state_info() :: iolist(). + +-spec get_print_info(connection_ref() + ) -> {{local_sock_info(), peer_sock_info()}, + state_info() + }. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . get_print_info(ConnectionHandler) -> - sync_send_all_state_event(ConnectionHandler, get_print_info, 1000). + call(ConnectionHandler, get_print_info, 1000). +%%-------------------------------------------------------------------- +-spec connection_info(connection_ref(), + [atom()] + ) -> proplists:proplist(). +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . connection_info(ConnectionHandler, Options) -> - sync_send_all_state_event(ConnectionHandler, {connection_info, Options}). + call(ConnectionHandler, {connection_info, Options}). %%-------------------------------------------------------------------- --spec channel_info(pid(), channel_id(), [atom()]) -> proplists:proplist(). -%%-------------------------------------------------------------------- +-spec channel_info(connection_ref(), + channel_id(), + [atom()] + ) -> proplists:proplist(). +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . channel_info(ConnectionHandler, ChannelId, Options) -> - sync_send_all_state_event(ConnectionHandler, {channel_info, ChannelId, Options}). + call(ConnectionHandler, {channel_info, ChannelId, Options}). %%-------------------------------------------------------------------- --spec adjust_window(pid(), channel_id(), integer()) -> ok. -%%-------------------------------------------------------------------- +-spec adjust_window(connection_ref(), + channel_id(), + integer() + ) -> ok. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . adjust_window(ConnectionHandler, Channel, Bytes) -> - send_all_state_event(ConnectionHandler, {adjust_window, Channel, Bytes}). -%%-------------------------------------------------------------------- --spec renegotiate(pid()) -> ok. -%%-------------------------------------------------------------------- -renegotiate(ConnectionHandler) -> - send_all_state_event(ConnectionHandler, renegotiate). - -%%-------------------------------------------------------------------- --spec renegotiate_data(pid()) -> ok. -%%-------------------------------------------------------------------- -renegotiate_data(ConnectionHandler) -> - send_all_state_event(ConnectionHandler, data_size). + cast(ConnectionHandler, {adjust_window, Channel, Bytes}). %%-------------------------------------------------------------------- --spec close(pid(), channel_id()) -> ok. -%%-------------------------------------------------------------------- +-spec close(connection_ref(), + channel_id() + ) -> ok. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . close(ConnectionHandler, ChannelId) -> - case sync_send_all_state_event(ConnectionHandler, {close, ChannelId}) of + case call(ConnectionHandler, {close, ChannelId}) of ok -> ok; - {error, closed} -> + {error, closed} -> ok - end. - -%%-------------------------------------------------------------------- --spec stop(pid()) -> ok | {error, term()}. -%%-------------------------------------------------------------------- -stop(ConnectionHandler)-> - case sync_send_all_state_event(ConnectionHandler, stop) of - {error, closed} -> - ok; - Other -> - Other end. -info(ConnectionHandler) -> - info(ConnectionHandler, {info, all}). +%%==================================================================== +%% Test support +%%==================================================================== +%%-------------------------------------------------------------------- +-spec renegotiate(connection_ref() + ) -> ok. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +renegotiate(ConnectionHandler) -> + cast(ConnectionHandler, renegotiate). -info(ConnectionHandler, ChannelProcess) -> - sync_send_all_state_event(ConnectionHandler, {info, ChannelProcess}). +%%-------------------------------------------------------------------- +-spec renegotiate_data(connection_ref() + ) -> ok. +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +renegotiate_data(ConnectionHandler) -> + cast(ConnectionHandler, data_size). %%==================================================================== -%% gen_fsm callbacks +%% Internal process state %%==================================================================== +-record(data, { + starter :: pid(), + auth_user :: string() + | undefined, + connection_state :: #connection{}, + latest_channel_id = 0 :: non_neg_integer(), + idle_timer_ref :: undefined + | infinity + | reference(), + idle_timer_value = infinity :: infinity + | pos_integer(), + transport_protocol :: atom(), % ex: tcp + transport_cb :: atom(), % ex: gen_tcp + transport_close_tag :: atom(), % ex: tcp_closed + ssh_params :: #ssh{} + | undefined, + socket :: inet:socket(), + decrypted_data_buffer = <<>> :: binary(), + encrypted_data_buffer = <<>> :: binary(), + undecrypted_packet_length :: undefined | non_neg_integer(), + key_exchange_init_msg :: #ssh_msg_kexinit{} + | undefined, + last_size_rekey = 0 :: non_neg_integer(), + event_queue = [] :: list(), + opts :: proplists:proplist(), + inet_initial_recbuf_size :: pos_integer() + | undefined + }). +%%==================================================================== +%% Intitialisation +%%==================================================================== %%-------------------------------------------------------------------- --spec hello(socket_control | {info_line, list()} | {version_exchange, list()}, - #state{}) -> gen_fsm_state_return(). +-spec init_connection_handler(role(), + inet:socket(), + proplists:proplist() + ) -> no_return(). +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . +init_connection_handler(Role, Socket, Opts) -> + process_flag(trap_exit, true), + S0 = init_process_state(Role, Socket, Opts), + try + {Protocol, Callback, CloseTag} = + proplists:get_value(transport, Opts, ?DefaultTransport), + S0#data{ssh_params = init_ssh_record(Role, Socket, Opts), + transport_protocol = Protocol, + transport_cb = Callback, + transport_close_tag = CloseTag + } + of + S -> + gen_statem:enter_loop(?MODULE, + [], %%[{debug,[trace,log,statistics,debug]} || Role==server], + handle_event_function, + {hello,Role}, + S) + catch + _:Error -> + gen_statem:enter_loop(?MODULE, + [], + handle_event_function, + {init_error,Error}, + S0) + end. + + +init_process_state(Role, Socket, Opts) -> + D = #data{connection_state = + C = #connection{channel_cache = ssh_channel:cache_create(), + channel_id_seed = 0, + port_bindings = [], + requests = [], + options = Opts}, + starter = proplists:get_value(user_pid, Opts), + socket = Socket, + opts = Opts + }, + case Role of + client -> + %% Start the renegotiation timers + timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), + timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), + cache_init_idle_timer(D); + server -> + D#data{connection_state = init_connection(Role, C, Opts)} + end. + + +init_connection(server, C = #connection{}, Opts) -> + Sups = proplists:get_value(supervisors, Opts), + SystemSup = proplists:get_value(system_sup, Sups), + SubSystemSup = proplists:get_value(subsystem_sup, Sups), + ConnectionSup = proplists:get_value(connection_sup, Sups), + Shell = proplists:get_value(shell, Opts), + Exec = proplists:get_value(exec, Opts), + CliSpec = proplists:get_value(ssh_cli, Opts, {ssh_cli, [Shell]}), + C#connection{cli_spec = CliSpec, + exec = Exec, + system_supervisor = SystemSup, + sub_system_supervisor = SubSystemSup, + connection_supervisor = ConnectionSup + }. + + +init_ssh_record(Role, Socket, Opts) -> + {ok, PeerAddr} = inet:peername(Socket), + KeyCb = proplists:get_value(key_cb, Opts, ssh_file), + AuthMethods = proplists:get_value(auth_methods, Opts, ?SUPPORTED_AUTH_METHODS), + S0 = #ssh{role = Role, + key_cb = KeyCb, + opts = Opts, + userauth_supported_methods = AuthMethods, + available_host_keys = supported_host_keys(Role, KeyCb, Opts), + random_length_padding = proplists:get_value(max_random_length_padding, + Opts, + (#ssh{})#ssh.random_length_padding) + }, + + {Vsn, Version} = ssh_transport:versions(Role, Opts), + case Role of + client -> + PeerName = proplists:get_value(host, Opts), + S0#ssh{c_vsn = Vsn, + c_version = Version, + io_cb = case proplists:get_value(user_interaction, Opts, true) of + true -> ssh_io; + false -> ssh_no_io + end, + userauth_quiet_mode = proplists:get_value(quiet_mode, Opts, false), + peer = {PeerName, PeerAddr} + }; + + server -> + S0#ssh{s_vsn = Vsn, + s_version = Version, + io_cb = proplists:get_value(io_cb, Opts, ssh_io), + userauth_methods = string:tokens(AuthMethods, ","), + kb_tries_left = 3, + peer = {undefined, PeerAddr} + } + end. + + + +%%==================================================================== +%% gen_statem callbacks +%%==================================================================== %%-------------------------------------------------------------------- +-type event_content() :: any(). + +-type renegotiate_flag() :: init | renegotiate. + +-type state_name() :: + {init_error,any()} + | {hello, role()} + | {kexinit, role(), renegotiate_flag()} + | {key_exchange, role(), renegotiate_flag()} + | {key_exchange_dh_gex_init, server, renegotiate_flag()} + | {key_exchange_dh_gex_reply, client, renegotiate_flag()} + | {new_keys, role()} + | {service_request, role()} + | {userauth, role()} + | {userauth_keyboard_interactive, role()} + | {connected, role()} + . + +-type handle_event_result() :: gen_statem:handle_event_result(). + +-spec handle_event(gen_statem:event_type(), + event_content(), + state_name(), + #data{} + ) -> handle_event_result(). + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +%%% ######## Error in the initialisation #### + +handle_event(_, _Event, {init_error,Error}, _) -> + case Error of + {badmatch,{error,enotconn}} -> + %% Handles the abnormal sequence: + %% SYN-> + %% <-SYNACK + %% ACK-> + %% RST-> + {stop, {shutdown,"TCP connenction to server was prematurely closed by the client"}}; + + OtherError -> + {stop, {shutdown,{init,OtherError}}} + end; -hello(socket_control, #state{socket = Socket, ssh_params = Ssh} = State) -> - VsnMsg = ssh_transport:hello_version_msg(string_version(Ssh)), - send_msg(VsnMsg, State), - case getopt(recbuf, Socket) of - {ok, Size} -> - inet:setopts(Socket, [{packet, line}, {active, once}, {recbuf, ?MAX_PROTO_VERSION}]), - {next_state, hello, State#state{recbuf = Size}}; - {error, Reason} -> - {stop, {shutdown, Reason}, State} + +%%% ######## {hello, client|server} #### +%% The very first event that is sent when the we are set as controlling process of Socket +handle_event(_, socket_control, {hello,_}, D) -> + VsnMsg = ssh_transport:hello_version_msg(string_version(D#data.ssh_params)), + ok = send_bytes(VsnMsg, D), + case inet:getopts(Socket=D#data.socket, [recbuf]) of + {ok, [{recbuf,Size}]} -> + %% Set the socket to the hello text line handling mode: + inet:setopts(Socket, [{packet, line}, + {active, once}, + % Expecting the version string which might + % be max ?MAX_PROTO_VERSION bytes: + {recbuf, ?MAX_PROTO_VERSION}, + {nodelay,true}]), + {keep_state, D#data{inet_initial_recbuf_size=Size}}; + + Other -> + {stop, {shutdown,{unexpected_getopts_return, Other}}} end; -hello({info_line, _Line},#state{role = client, socket = Socket} = State) -> - %% The server may send info lines before the version_exchange - inet:setopts(Socket, [{active, once}]), - {next_state, hello, State}; - -hello({info_line, _Line},#state{role = server, - socket = Socket, - transport_cb = Transport } = State) -> - %% as openssh - Transport:send(Socket, "Protocol mismatch."), - {stop, {shutdown,"Protocol mismatch in version exchange."}, State}; - -hello({version_exchange, Version}, #state{ssh_params = Ssh0, - socket = Socket, - recbuf = Size} = State) -> +handle_event(_, {info_line,_Line}, {hello,Role}, D) -> + case Role of + client -> + %% The server may send info lines to the client before the version_exchange + inet:setopts(D#data.socket, [{active, once}]), + keep_state_and_data; + server -> + %% But the client may NOT send them to the server. Openssh answers with cleartext, + %% and so do we + ok = send_bytes("Protocol mismatch.", D), + {stop, {shutdown,"Protocol mismatch in version exchange. Client sent info lines."}} + end; + +handle_event(_, {version_exchange,Version}, {hello,Role}, D) -> {NumVsn, StrVsn} = ssh_transport:handle_hello_version(Version), - case handle_version(NumVsn, StrVsn, Ssh0) of + case handle_version(NumVsn, StrVsn, D#data.ssh_params) of {ok, Ssh1} -> - inet:setopts(Socket, [{packet,0}, {mode,binary}, {active, once}, {recbuf, Size}]), + %% Since the hello part is finnished correctly, we set the + %% socket to the packet handling mode (including recbuf size): + inet:setopts(D#data.socket, [{packet,0}, + {mode,binary}, + {active, once}, + {recbuf, D#data.inet_initial_recbuf_size}]), {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh1), - send_msg(SshPacket, State), - {next_state, kexinit, next_packet(State#state{ssh_params = Ssh, - key_exchange_init_msg = - KeyInitMsg})}; + ok = send_bytes(SshPacket, D), + {next_state, {kexinit,Role,init}, D#data{ssh_params = Ssh, + key_exchange_init_msg = KeyInitMsg}}; not_supported -> - DisconnectMsg = - #ssh_msg_disconnect{code = - ?SSH_DISCONNECT_PROTOCOL_VERSION_NOT_SUPPORTED, - description = "Protocol version " ++ StrVsn - ++ " not supported", - language = "en"}, - handle_disconnect(DisconnectMsg, State) - end. + disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_VERSION_NOT_SUPPORTED, + description = ["Protocol version ",StrVsn," not supported"]}, + {next_state, {hello,Role}, D}) + end; -%%-------------------------------------------------------------------- --spec kexinit({#ssh_msg_kexinit{}, binary()}, #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -kexinit({#ssh_msg_kexinit{} = Kex, Payload}, - #state{ssh_params = #ssh{role = Role} = Ssh0, - key_exchange_init_msg = OwnKex} = - State) -> - Ssh1 = ssh_transport:key_init(opposite_role(Role), Ssh0, Payload), - case ssh_transport:handle_kexinit_msg(Kex, OwnKex, Ssh1) of - {ok, NextKexMsg, Ssh} when Role == client -> - send_msg(NextKexMsg, State), - {next_state, key_exchange, - next_packet(State#state{ssh_params = Ssh})}; - {ok, Ssh} when Role == server -> - {next_state, key_exchange, - next_packet(State#state{ssh_params = Ssh})} - end. + +%%% ######## {kexinit, client|server, init|renegotiate} #### -%%-------------------------------------------------------------------- --spec key_exchange(#ssh_msg_kexdh_init{} | #ssh_msg_kexdh_reply{} | - #ssh_msg_kex_dh_gex_group{} | #ssh_msg_kex_dh_gex_request{} | - #ssh_msg_kex_dh_gex_request{} | #ssh_msg_kex_dh_gex_reply{}, #state{}) - -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- +handle_event(_, {#ssh_msg_kexinit{}=Kex, Payload}, {kexinit,Role,ReNeg}, + D = #data{key_exchange_init_msg = OwnKex}) -> + Ssh1 = ssh_transport:key_init(peer_role(Role), D#data.ssh_params, Payload), + Ssh = case ssh_transport:handle_kexinit_msg(Kex, OwnKex, Ssh1) of + {ok, NextKexMsg, Ssh2} when Role==client -> + ok = send_bytes(NextKexMsg, D), + Ssh2; + {ok, Ssh2} when Role==server -> + Ssh2 + end, + {next_state, {key_exchange,Role,ReNeg}, D#data{ssh_params=Ssh}}; -key_exchange(#ssh_msg_kexdh_init{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - case ssh_transport:handle_kexdh_init(Msg, Ssh0) of - {ok, KexdhReply, Ssh1} -> - send_msg(KexdhReply, State), - {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})} - end; -key_exchange(#ssh_msg_kexdh_reply{} = Msg, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - {ok, NewKeys, Ssh} = ssh_transport:handle_kexdh_reply(Msg, Ssh0), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}; - -key_exchange(#ssh_msg_kex_dh_gex_request{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, Ssh0), - send_msg(GexGroup, State), - {next_state, key_exchange_dh_gex_init, next_packet(State#state{ssh_params = Ssh})}; - -key_exchange(#ssh_msg_kex_dh_gex_request_old{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, Ssh0), - send_msg(GexGroup, State), - {next_state, key_exchange_dh_gex_init, next_packet(State#state{ssh_params = Ssh})}; - -key_exchange(#ssh_msg_kex_dh_gex_group{} = Msg, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - {ok, KexGexInit, Ssh} = ssh_transport:handle_kex_dh_gex_group(Msg, Ssh0), - send_msg(KexGexInit, State), - {next_state, key_exchange_dh_gex_reply, next_packet(State#state{ssh_params = Ssh})}; - -key_exchange(#ssh_msg_kex_ecdh_init{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - {ok, KexEcdhReply, Ssh1} = ssh_transport:handle_kex_ecdh_init(Msg, Ssh0), - send_msg(KexEcdhReply, State), +%%% ######## {key_exchange, client|server, init|renegotiate} #### + +%%%---- diffie-hellman +handle_event(_, #ssh_msg_kexdh_init{} = Msg, {key_exchange,server,ReNeg}, D) -> + {ok, KexdhReply, Ssh1} = ssh_transport:handle_kexdh_init(Msg, D#data.ssh_params), + ok = send_bytes(KexdhReply, D), + {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1), + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}}; + +handle_event(_, #ssh_msg_kexdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) -> + {ok, NewKeys, Ssh} = ssh_transport:handle_kexdh_reply(Msg, D#data.ssh_params), + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh}}; + +%%%---- diffie-hellman group exchange +handle_event(_, #ssh_msg_kex_dh_gex_request{} = Msg, {key_exchange,server,ReNeg}, D) -> + {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + ok = send_bytes(GexGroup, D), + {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; + +handle_event(_, #ssh_msg_kex_dh_gex_request_old{} = Msg, {key_exchange,server,ReNeg}, D) -> + {ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + ok = send_bytes(GexGroup, D), + {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; + +handle_event(_, #ssh_msg_kex_dh_gex_group{} = Msg, {key_exchange,client,ReNeg}, D) -> + {ok, KexGexInit, Ssh} = ssh_transport:handle_kex_dh_gex_group(Msg, D#data.ssh_params), + ok = send_bytes(KexGexInit, D), + {next_state, {key_exchange_dh_gex_reply,client,ReNeg}, D#data{ssh_params=Ssh}}; + +%%%---- elliptic curve diffie-hellman +handle_event(_, #ssh_msg_kex_ecdh_init{} = Msg, {key_exchange,server,ReNeg}, D) -> + {ok, KexEcdhReply, Ssh1} = ssh_transport:handle_kex_ecdh_init(Msg, D#data.ssh_params), + ok = send_bytes(KexEcdhReply, D), {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}; + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}}; -key_exchange(#ssh_msg_kex_ecdh_reply{} = Msg, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - {ok, NewKeys, Ssh} = ssh_transport:handle_kex_ecdh_reply(Msg, Ssh0), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}. +handle_event(_, #ssh_msg_kex_ecdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) -> + {ok, NewKeys, Ssh} = ssh_transport:handle_kex_ecdh_reply(Msg, D#data.ssh_params), + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh}}; -%%-------------------------------------------------------------------- --spec key_exchange_dh_gex_init(#ssh_msg_kex_dh_gex_init{}, #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -key_exchange_dh_gex_init(#ssh_msg_kex_dh_gex_init{} = Msg, - #state{ssh_params = #ssh{role = server} = Ssh0} = State) -> - {ok, KexGexReply, Ssh1} = ssh_transport:handle_kex_dh_gex_init(Msg, Ssh0), - send_msg(KexGexReply, State), + +%%% ######## {key_exchange_dh_gex_init, server, init|renegotiate} #### + +handle_event(_, #ssh_msg_kex_dh_gex_init{} = Msg, {key_exchange_dh_gex_init,server,ReNeg}, D) -> + {ok, KexGexReply, Ssh1} = ssh_transport:handle_kex_dh_gex_init(Msg, D#data.ssh_params), + ok = send_bytes(KexGexReply, D), {ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh})}. + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}}; -%%-------------------------------------------------------------------- --spec key_exchange_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{}, #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -key_exchange_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{} = Msg, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - {ok, NewKeys, Ssh1} = ssh_transport:handle_kex_dh_gex_reply(Msg, Ssh0), - send_msg(NewKeys, State), - {next_state, new_keys, next_packet(State#state{ssh_params = Ssh1})}. -%%-------------------------------------------------------------------- --spec new_keys(#ssh_msg_newkeys{}, #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- +%%% ######## {key_exchange_dh_gex_reply, client, init|renegotiate} #### -new_keys(#ssh_msg_newkeys{} = Msg, #state{ssh_params = Ssh0} = State0) -> - {ok, Ssh} = ssh_transport:handle_new_keys(Msg, Ssh0), - after_new_keys(next_packet(State0#state{ssh_params = Ssh})). +handle_event(_, #ssh_msg_kex_dh_gex_reply{} = Msg, {key_exchange_dh_gex_reply,client,ReNeg}, D) -> + {ok, NewKeys, Ssh1} = ssh_transport:handle_kex_dh_gex_reply(Msg, D#data.ssh_params), + ok = send_bytes(NewKeys, D), + {next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh1}}; -%%-------------------------------------------------------------------- --spec service_request(#ssh_msg_service_request{} | #ssh_msg_service_accept{}, - #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -service_request(#ssh_msg_service_request{name = "ssh-userauth"} = Msg, - #state{ssh_params = #ssh{role = server, - session_id = SessionId} = Ssh0} = State) -> - {ok, {Reply, Ssh}} = ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})}; - -service_request(#ssh_msg_service_accept{name = "ssh-userauth"}, - #state{ssh_params = #ssh{role = client, - service = "ssh-userauth"} = Ssh0} = - State) -> + +%%% ######## {new_keys, client|server} #### + +%% First key exchange round: +handle_event(_, #ssh_msg_newkeys{} = Msg, {new_keys,Role,init}, D) -> + {ok, Ssh1} = ssh_transport:handle_new_keys(Msg, D#data.ssh_params), + Ssh = case Role of + client -> + {MsgReq, Ssh2} = ssh_auth:service_request_msg(Ssh1), + ok = send_bytes(MsgReq, D), + Ssh2; + server -> + Ssh1 + end, + {next_state, {service_request,Role}, D#data{ssh_params=Ssh}}; + +%% Subsequent key exchange rounds (renegotiation): +handle_event(_, #ssh_msg_newkeys{}, {new_keys,Role,renegotiate}, D) -> + {next_state, {connected,Role}, D}; + +%%% ######## {service_request, client|server} + +handle_event(_, Msg = #ssh_msg_service_request{name=ServiceName}, StateName = {service_request,server}, D) -> + case ServiceName of + "ssh-userauth" -> + Ssh0 = #ssh{session_id=SessionId} = D#data.ssh_params, + {ok, {Reply, Ssh}} = ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0), + ok = send_bytes(Reply, D), + {next_state, {userauth,server}, D#data{ssh_params = Ssh}}; + + _ -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "Unknown service"}, + StateName, D) + end; + +handle_event(_, #ssh_msg_service_accept{name = "ssh-userauth"}, {service_request,client}, + #data{ssh_params = #ssh{service="ssh-userauth"} = Ssh0} = State) -> {Msg, Ssh} = ssh_auth:init_userauth_request_msg(Ssh0), - send_msg(Msg, State), - {next_state, userauth, next_packet(State#state{auth_user = Ssh#ssh.user, ssh_params = Ssh})}. + ok = send_bytes(Msg, State), + {next_state, {userauth,client}, State#data{auth_user = Ssh#ssh.user, ssh_params = Ssh}}; -%%-------------------------------------------------------------------- --spec userauth(#ssh_msg_userauth_request{} | #ssh_msg_userauth_info_request{} | - #ssh_msg_userauth_info_response{} | #ssh_msg_userauth_success{} | - #ssh_msg_userauth_failure{} | #ssh_msg_userauth_banner{}, - #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -userauth(#ssh_msg_userauth_request{service = "ssh-connection", - method = "none"} = Msg, - #state{ssh_params = #ssh{session_id = SessionId, role = server, - service = "ssh-connection"} = Ssh0 - } = State) -> - {not_authorized, {_User, _Reason}, {Reply, Ssh}} = - ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})}; - -userauth(#ssh_msg_userauth_request{service = "ssh-connection", - method = Method} = Msg, - #state{ssh_params = #ssh{session_id = SessionId, role = server, - service = "ssh-connection", - peer = {_, Address}} = Ssh0, - opts = Opts, starter = Pid} = State) -> - case lists:member(Method, Ssh0#ssh.userauth_methods) of - true -> - case ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0) of - {authorized, User, {Reply, Ssh}} -> - send_msg(Reply, State), - Pid ! ssh_connected, - connected_fun(User, Address, Method, Opts), - {next_state, connected, - next_packet(State#state{auth_user = User, ssh_params = Ssh#ssh{authenticated = true}})}; - {not_authorized, {User, Reason}, {Reply, Ssh}} when Method == "keyboard-interactive" -> - retry_fun(User, Address, Reason, Opts), - send_msg(Reply, State), - {next_state, userauth_keyboard_interactive, next_packet(State#state{ssh_params = Ssh})}; - {not_authorized, {User, Reason}, {Reply, Ssh}} -> - retry_fun(User, Address, Reason, Opts), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + +%%% ######## {userauth, client|server} #### + +%%---- userauth request to server +handle_event(_, + Msg = #ssh_msg_userauth_request{service = ServiceName, method = Method}, + StateName = {userauth,server}, + D = #data{ssh_params=Ssh0}) -> + + case {ServiceName, Ssh0#ssh.service, Method} of + {"ssh-connection", "ssh-connection", "none"} -> + %% Probably the very first userauth_request but we deny unauthorized login + {not_authorized, _, {Reply,Ssh}} = + ssh_auth:handle_userauth_request(Msg, Ssh0#ssh.session_id, Ssh0), + ok = send_bytes(Reply, D), + {keep_state, D#data{ssh_params = Ssh}}; + + {"ssh-connection", "ssh-connection", Method} -> + %% Userauth request with a method like "password" or so + case lists:member(Method, Ssh0#ssh.userauth_methods) of + true -> + %% Yepp! we support this method + case ssh_auth:handle_userauth_request(Msg, Ssh0#ssh.session_id, Ssh0) of + {authorized, User, {Reply, Ssh}} -> + ok = send_bytes(Reply, D), + D#data.starter ! ssh_connected, + connected_fun(User, Method, D), + {next_state, {connected,server}, + D#data{auth_user = User, + ssh_params = Ssh#ssh{authenticated = true}}}; + {not_authorized, {User, Reason}, {Reply, Ssh}} when Method == "keyboard-interactive" -> + retry_fun(User, Reason, D), + ok = send_bytes(Reply, D), + {next_state, {userauth_keyboard_interactive,server}, D#data{ssh_params = Ssh}}; + {not_authorized, {User, Reason}, {Reply, Ssh}} -> + retry_fun(User, Reason, D), + ok = send_bytes(Reply, D), + {keep_state, D#data{ssh_params = Ssh}} + end; + false -> + %% No we do not support this method (=/= none) + %% At least one non-erlang client does like this. Retry as the next event + {keep_state_and_data, + [{next_event, internal, Msg#ssh_msg_userauth_request{method="none"}}] + } end; - false -> - userauth(Msg#ssh_msg_userauth_request{method="none"}, State) + + %% {"ssh-connection", Expected, Method} when Expected =/= ServiceName -> Do what? + %% {ServiceName, Expected, Method} when Expected =/= ServiceName -> Do what? + + {ServiceName, _, _} when ServiceName =/= "ssh-connection" -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "Unknown service"}, + StateName, D) end; -userauth(#ssh_msg_userauth_success{}, #state{ssh_params = #ssh{role = client} = Ssh, - starter = Pid} = State) -> - Pid ! ssh_connected, - {next_state, connected, next_packet(State#state{ssh_params = - Ssh#ssh{authenticated = true}})}; -userauth(#ssh_msg_userauth_failure{}, - #state{ssh_params = #ssh{role = client, - userauth_methods = []}} - = State) -> - Msg = #ssh_msg_disconnect{code = - ?SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE, +%%---- userauth success to client +handle_event(_, #ssh_msg_userauth_success{}, {userauth,client}, D=#data{ssh_params = Ssh}) -> + D#data.starter ! ssh_connected, + {next_state, {connected,client}, D#data{ssh_params=Ssh#ssh{authenticated = true}}}; + + +%%---- userauth failure response to client +handle_event(_, #ssh_msg_userauth_failure{}, {userauth,client}=StateName, + D = #data{ssh_params = #ssh{userauth_methods = []}}) -> + Msg = #ssh_msg_disconnect{code = ?SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE, description = "Unable to connect using the available" - " authentication methods", - language = "en"}, - handle_disconnect(Msg, State); - -%% Server tells us which authentication methods that are allowed -userauth(#ssh_msg_userauth_failure{authentications = Methodes}, - #state{ssh_params = #ssh{role = client, - userauth_methods = none} = Ssh0} = State) -> - AuthMethods = string:tokens(Methodes, ","), - Ssh1 = Ssh0#ssh{userauth_methods = AuthMethods}, + " authentication methods"}, + disconnect(Msg, StateName, D); + +handle_event(_, #ssh_msg_userauth_failure{authentications = Methods}, StateName={userauth,client}, + D = #data{ssh_params = Ssh0}) -> + %% The prefered authentication method failed try next method + Ssh1 = case Ssh0#ssh.userauth_methods of + none -> + %% Server tells us which authentication methods that are allowed + Ssh0#ssh{userauth_methods = string:tokens(Methods, ",")}; + _ -> + %% We already know... + Ssh0 + end, case ssh_auth:userauth_request_msg(Ssh1) of {disconnect, DisconnectMsg, {Msg, Ssh}} -> - send_msg(Msg, State), - handle_disconnect(DisconnectMsg, State#state{ssh_params = Ssh}); + send_bytes(Msg, D), + disconnect(DisconnectMsg, StateName, D#data{ssh_params = Ssh}); {"keyboard-interactive", {Msg, Ssh}} -> - send_msg(Msg, State), - {next_state, userauth_keyboard_interactive, next_packet(State#state{ssh_params = Ssh})}; + send_bytes(Msg, D), + {next_state, {userauth_keyboard_interactive,client}, D#data{ssh_params = Ssh}}; {_Method, {Msg, Ssh}} -> - send_msg(Msg, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + send_bytes(Msg, D), + {keep_state, D#data{ssh_params = Ssh}} end; -%% The prefered authentication method failed try next method -userauth(#ssh_msg_userauth_failure{}, - #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> - case ssh_auth:userauth_request_msg(Ssh0) of - {disconnect, DisconnectMsg,{Msg, Ssh}} -> - send_msg(Msg, State), - handle_disconnect(DisconnectMsg, State#state{ssh_params = Ssh}); - {"keyboard-interactive", {Msg, Ssh}} -> - send_msg(Msg, State), - {next_state, userauth_keyboard_interactive, next_packet(State#state{ssh_params = Ssh})}; - {_Method, {Msg, Ssh}} -> - send_msg(Msg, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} - end; +%%---- banner to client +handle_event(_, #ssh_msg_userauth_banner{message = Msg}, {userauth,client}, D) -> + case D#data.ssh_params#ssh.userauth_quiet_mode of + false -> io:format("~s", [Msg]); + true -> ok + end, + keep_state_and_data; -userauth(#ssh_msg_userauth_banner{}, - #state{ssh_params = #ssh{userauth_quiet_mode = true, - role = client}} = State) -> - {next_state, userauth, next_packet(State)}; -userauth(#ssh_msg_userauth_banner{message = Msg}, - #state{ssh_params = - #ssh{userauth_quiet_mode = false, role = client}} = State) -> - io:format("~s", [Msg]), - {next_state, userauth, next_packet(State)}. - - - -userauth_keyboard_interactive(#ssh_msg_userauth_info_request{} = Msg, - #state{ssh_params = #ssh{role = client, - io_cb = IoCb} = Ssh0} = State) -> - {ok, {Reply, Ssh}} = ssh_auth:handle_userauth_info_request(Msg, IoCb, Ssh0), - send_msg(Reply, State), - {next_state, userauth_keyboard_interactive_info_response, next_packet(State#state{ssh_params = Ssh})}; - -userauth_keyboard_interactive(#ssh_msg_userauth_info_response{} = Msg, - #state{ssh_params = #ssh{role = server, - peer = {_, Address}} = Ssh0, - opts = Opts, starter = Pid} = State) -> - case ssh_auth:handle_userauth_info_response(Msg, Ssh0) of + +%%% ######## {userauth_keyboard_interactive, client|server} + +handle_event(_, #ssh_msg_userauth_info_request{} = Msg, {userauth_keyboard_interactive, client}, + #data{ssh_params = Ssh0} = D) -> + {ok, {Reply, Ssh}} = ssh_auth:handle_userauth_info_request(Msg, Ssh0#ssh.io_cb, Ssh0), + send_bytes(Reply, D), + {next_state, {userauth_keyboard_interactive_info_response,client}, D#data{ssh_params = Ssh}}; + +handle_event(_, #ssh_msg_userauth_info_response{} = Msg, {userauth_keyboard_interactive, server}, D) -> + case ssh_auth:handle_userauth_info_response(Msg, D#data.ssh_params) of {authorized, User, {Reply, Ssh}} -> - send_msg(Reply, State), - Pid ! ssh_connected, - connected_fun(User, Address, "keyboard-interactive", Opts), - {next_state, connected, - next_packet(State#state{auth_user = User, ssh_params = Ssh#ssh{authenticated = true}})}; + send_bytes(Reply, D), + D#data.starter ! ssh_connected, + connected_fun(User, "keyboard-interactive", D), + {next_state, {connected,server}, D#data{auth_user = User, + ssh_params = Ssh#ssh{authenticated = true}}}; {not_authorized, {User, Reason}, {Reply, Ssh}} -> - retry_fun(User, Address, Reason, Opts), - send_msg(Reply, State), - {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} + retry_fun(User, Reason, D), + send_bytes(Reply, D), + {next_state, {userauth,server}, D#data{ssh_params = Ssh}} end; -userauth_keyboard_interactive(Msg = #ssh_msg_userauth_failure{}, - #state{ssh_params = Ssh0 = - #ssh{role = client, - userauth_preference = Prefs0}} - = State) -> - Prefs = [{Method,M,F,A} || {Method,M,F,A} <- Prefs0, + +handle_event(_, Msg = #ssh_msg_userauth_failure{}, {userauth_keyboard_interactive, client}, + #data{ssh_params = Ssh0} = D0) -> + Prefs = [{Method,M,F,A} || {Method,M,F,A} <- Ssh0#ssh.userauth_preference, Method =/= "keyboard-interactive"], - userauth(Msg, State#state{ssh_params = Ssh0#ssh{userauth_preference=Prefs}}). + D = D0#data{ssh_params = Ssh0#ssh{userauth_preference=Prefs}}, + {next_state, {userauth,client}, D, [{next_event, internal, Msg}]}; +handle_event(_, Msg=#ssh_msg_userauth_failure{}, {userauth_keyboard_interactive_info_response, client}, D) -> + {next_state, {userauth,client}, D, [{next_event, internal, Msg}]}; +handle_event(_, Msg=#ssh_msg_userauth_success{}, {userauth_keyboard_interactive_info_response, client}, D) -> + {next_state, {userauth,client}, D, [{next_event, internal, Msg}]}; -userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_failure{}, - #state{ssh_params = #ssh{role = client}} = State) -> - userauth(Msg, State); -userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_success{}, - #state{ssh_params = #ssh{role = client}} = State) -> - userauth(Msg, State); -userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_info_request{}, - #state{ssh_params = #ssh{role = client}} = State) -> - userauth_keyboard_interactive(Msg, State). +handle_event(_, Msg=#ssh_msg_userauth_info_request{}, {userauth_keyboard_interactive_info_response, client}, D) -> + {next_state, {userauth_keyboard_interactive,client}, D, [{next_event, internal, Msg}]}; -%%-------------------------------------------------------------------- --spec connected({#ssh_msg_kexinit{}, binary()}, %%| %% #ssh_msg_kexdh_init{}, - #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -connected({#ssh_msg_kexinit{}, _Payload} = Event, #state{ssh_params = Ssh0} = State0) -> - {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh0), - State = State0#state{ssh_params = Ssh, - key_exchange_init_msg = KeyInitMsg, - renegotiate = true}, - send_msg(SshPacket, State), - kexinit(Event, State). -%%-------------------------------------------------------------------- --spec handle_event(#ssh_msg_disconnect{} | #ssh_msg_ignore{} | #ssh_msg_debug{} | - #ssh_msg_unimplemented{} | {adjust_window, integer(), integer()} | - {reply_request, success | failure, integer()} | renegotiate | - data_size | {request, pid(), integer(), integer(), iolist()} | - {request, integer(), integer(), iolist()}, state_name(), - #state{}) -> gen_fsm_state_return(). +%%% ######## {connected, client|server} #### -%%-------------------------------------------------------------------- -handle_event(#ssh_msg_disconnect{description = Desc} = DisconnectMsg, _StateName, #state{} = State) -> - handle_disconnect(peer, DisconnectMsg, State), - {stop, {shutdown, Desc}, State}; - -handle_event(#ssh_msg_ignore{}, StateName, State) -> - {next_state, StateName, next_packet(State)}; - -handle_event(#ssh_msg_debug{always_display = Display, message = DbgMsg, language=Lang}, - StateName, #state{opts = Opts} = State) -> - F = proplists:get_value(ssh_msg_debug_fun, Opts, - fun(_ConnRef, _AlwaysDisplay, _Msg, _Language) -> ok end - ), - catch F(self(), Display, DbgMsg, Lang), - {next_state, StateName, next_packet(State)}; - -handle_event(#ssh_msg_unimplemented{}, StateName, State) -> - {next_state, StateName, next_packet(State)}; - -handle_event(renegotiate, connected, #state{ssh_params = Ssh0} - = State) -> - {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh0), - send_msg(SshPacket, State), - timer:apply_after(?REKEY_TIMOUT, gen_fsm, send_all_state_event, [self(), renegotiate]), - {next_state, kexinit, - next_packet(State#state{ssh_params = Ssh, - key_exchange_init_msg = KeyInitMsg, - renegotiate = true})}; - -handle_event(renegotiate, StateName, State) -> +handle_event(_, {#ssh_msg_kexinit{},_} = Event, {connected,Role}, D0) -> + {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(D0#data.ssh_params), + D = D0#data{ssh_params = Ssh, + key_exchange_init_msg = KeyInitMsg}, + send_bytes(SshPacket, D), + {next_state, {kexinit,Role,renegotiate}, D, [{next_event, internal, Event}]}; + +handle_event(_, #ssh_msg_disconnect{description=Desc} = Msg, StateName, D0) -> + {disconnect, _, {{replies,Replies}, _}} = + ssh_connection:handle_msg(Msg, D0#data.connection_state, role(StateName)), + {Actions,D} = send_replies(Replies, D0), + disconnect_fun(Desc, D), + {stop_and_reply, {shutdown,Desc}, Actions, D}; + +handle_event(_, #ssh_msg_ignore{}, _, _) -> + keep_state_and_data; + +handle_event(_, #ssh_msg_unimplemented{}, _, _) -> + keep_state_and_data; + +handle_event(_, #ssh_msg_debug{} = Msg, _, D) -> + debug_fun(Msg, D), + keep_state_and_data; + +handle_event(internal, Msg=#ssh_msg_global_request{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_request_success{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_request_failure{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_open{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_open_confirmation{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_open_failure{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_window_adjust{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_data{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_extended_data{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_eof{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_close{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_request{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_success{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + +handle_event(internal, Msg=#ssh_msg_channel_failure{}, StateName, D) -> + handle_connection_msg(Msg, StateName, D); + + +handle_event(cast, renegotiate, {connected,Role}, D) -> + {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(D#data.ssh_params), + send_bytes(SshPacket, D), + timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), + {next_state, {kexinit,Role,renegotiate}, D#data{ssh_params = Ssh, + key_exchange_init_msg = KeyInitMsg}}; + +handle_event(cast, renegotiate, _, _) -> %% Already in key-exchange so safe to ignore - {next_state, StateName, State}; + timer:apply_after(?REKEY_TIMOUT, gen_statem, cast, [self(), renegotiate]), % FIXME: not here in original + keep_state_and_data; + %% Rekey due to sent data limit reached? -handle_event(data_size, connected, #state{ssh_params = Ssh0} = State) -> - {ok, [{send_oct,Sent0}]} = inet:getstat(State#state.socket, [send_oct]), - Sent = Sent0 - State#state.last_size_rekey, - MaxSent = proplists:get_value(rekey_limit, State#state.opts, 1024000000), - timer:apply_after(?REKEY_DATA_TIMOUT, gen_fsm, send_all_state_event, [self(), data_size]), +handle_event(cast, data_size, {connected,Role}, D) -> + {ok, [{send_oct,Sent0}]} = inet:getstat(D#data.socket, [send_oct]), + Sent = Sent0 - D#data.last_size_rekey, + MaxSent = proplists:get_value(rekey_limit, D#data.opts, 1024000000), + timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), case Sent >= MaxSent of true -> - {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh0), - send_msg(SshPacket, State), - {next_state, kexinit, - next_packet(State#state{ssh_params = Ssh, - key_exchange_init_msg = KeyInitMsg, - renegotiate = true, - last_size_rekey = Sent0})}; + {KeyInitMsg, SshPacket, Ssh} = + ssh_transport:key_exchange_init_msg(D#data.ssh_params), + send_bytes(SshPacket, D), + {next_state, {kexinit,Role,renegotiate}, D#data{ssh_params = Ssh, + key_exchange_init_msg = KeyInitMsg, + last_size_rekey = Sent0}}; _ -> - {next_state, connected, next_packet(State)} + keep_state_and_data end; -handle_event(data_size, StateName, State) -> + +handle_event(cast, data_size, _, _) -> %% Already in key-exchange so safe to ignore - {next_state, StateName, State}; - -handle_event(Event, StateName, State) when StateName /= connected -> - Events = [{event, Event} | State#state.event_queue], - {next_state, StateName, State#state{event_queue = Events}}; - -handle_event({adjust_window, ChannelId, Bytes}, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - State = - case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{recv_window_size = WinSize, - recv_window_pending = Pending, - recv_packet_size = PktSize} = Channel - when (WinSize-Bytes) >= 2*PktSize -> - %% The peer can send at least two more *full* packet, no hurry. - ssh_channel:cache_update(Cache, - Channel#channel{recv_window_pending = Pending + Bytes}), - State0; - - #channel{recv_window_size = WinSize, - recv_window_pending = Pending, - remote_id = Id} = Channel -> - %% Now we have to update the window - we can't receive so many more pkts - ssh_channel:cache_update(Cache, - Channel#channel{recv_window_size = - WinSize + Bytes + Pending, - recv_window_pending = 0}), - Msg = ssh_connection:channel_adjust_window_msg(Id, Bytes + Pending), - send_replies([{connection_reply, Msg}], State0); + timer:apply_after(?REKEY_DATA_TIMOUT, gen_statem, cast, [self(), data_size]), % FIXME: not here in original + keep_state_and_data; + + + +handle_event(cast, _, StateName, _) when StateName /= {connected,server}, + StateName /= {connected,client} -> + {keep_state_and_data, [postpone]}; + + +handle_event(cast, {adjust_window,ChannelId,Bytes}, {connected,_}, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of + #channel{recv_window_size = WinSize, + recv_window_pending = Pending, + recv_packet_size = PktSize} = Channel + when (WinSize-Bytes) >= 2*PktSize -> + %% The peer can send at least two more *full* packet, no hurry. + ssh_channel:cache_update(cache(D), + Channel#channel{recv_window_pending = Pending + Bytes}), + keep_state_and_data; + + #channel{recv_window_size = WinSize, + recv_window_pending = Pending, + remote_id = Id} = Channel -> + %% Now we have to update the window - we can't receive so many more pkts + ssh_channel:cache_update(cache(D), + Channel#channel{recv_window_size = + WinSize + Bytes + Pending, + recv_window_pending = 0}), + Msg = ssh_connection:channel_adjust_window_msg(Id, Bytes + Pending), + {keep_state, send_msg(Msg,D)}; - undefined -> - State0 - end, - {next_state, StateName, next_packet(State)}; - -handle_event({reply_request, success, ChannelId}, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - State = case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{remote_id = RemoteId} -> - Msg = ssh_connection:channel_success_msg(RemoteId), - send_replies([{connection_reply, Msg}], State0); - undefined -> - State0 - end, - {next_state, StateName, State}; - -handle_event({request, ChannelPid, ChannelId, Type, Data}, StateName, State0) -> - {{replies, Replies}, State1} = handle_request(ChannelPid, ChannelId, - Type, Data, - false, none, State0), - State = send_replies(Replies, State1), - {next_state, StateName, next_packet(State)}; - -handle_event({request, ChannelId, Type, Data}, StateName, State0) -> - {{replies, Replies}, State1} = handle_request(ChannelId, Type, Data, - false, none, State0), - State = send_replies(Replies, State1), - {next_state, StateName, next_packet(State)}; - -handle_event({unknown, Data}, StateName, State) -> + undefined -> + keep_state_and_data + end; + +handle_event(cast, {reply_request,success,ChannelId}, {connected,_}, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of + #channel{remote_id = RemoteId} -> + Msg = ssh_connection:channel_success_msg(RemoteId), + {keep_state, send_msg(Msg,D)}; + + undefined -> + keep_state_and_data + end; + +handle_event(cast, {request,ChannelPid, ChannelId, Type, Data}, {connected,_}, D) -> + {keep_state, handle_request(ChannelPid, ChannelId, Type, Data, false, none, D)}; + +handle_event(cast, {request,ChannelId,Type,Data}, {connected,_}, D) -> + {keep_state, handle_request(ChannelId, Type, Data, false, none, D)}; + +handle_event(cast, {unknown,Data}, {connected,_}, D) -> Msg = #ssh_msg_unimplemented{sequence = Data}, - send_msg(Msg, State), - {next_state, StateName, next_packet(State)}. + {keep_state, send_msg(Msg,D)}; -%%-------------------------------------------------------------------- --spec handle_sync_event({request, pid(), channel_id(), integer(), binary(), timeout()} | - {request, channel_id(), integer(), binary(), timeout()} | - {global_request, pid(), integer(), boolean(), binary()} | {eof, integer()} | - {open, pid(), integer(), channel_id(), integer(), binary(), _} | - {send_window, channel_id()} | {recv_window, channel_id()} | - {connection_info, [client_version | server_version | peer | - sockname]} | {channel_info, channel_id(), [recv_window | - send_window]} | - {close, channel_id()} | stop, term(), state_name(), #state{}) - -> gen_fsm_sync_return(). -%%-------------------------------------------------------------------- -handle_sync_event(get_print_info, _From, StateName, State) -> +%%% Previously handle_sync_event began here +handle_event({call,From}, get_print_info, StateName, D) -> Reply = try - {inet:sockname(State#state.socket), - inet:peername(State#state.socket) + {inet:sockname(D#data.socket), + inet:peername(D#data.socket) } of - {{ok,Local}, {ok,Remote}} -> {{Local,Remote},io_lib:format("statename=~p",[StateName])}; - _ -> {{"-",0},"-"} + {{ok,Local}, {ok,Remote}} -> + {{Local,Remote},io_lib:format("statename=~p",[StateName])}; + _ -> + {{"-",0},"-"} catch - _:_ -> {{"?",0},"?"} + _:_ -> + {{"?",0},"?"} end, - {reply, Reply, StateName, State}; + {keep_state_and_data, [{reply,From,Reply}]}; -handle_sync_event({connection_info, Options}, _From, StateName, State) -> - Info = ssh_info(Options, State, []), - {reply, Info, StateName, State}; +handle_event({call,From}, {connection_info, Options}, _, D) -> + Info = ssh_info(Options, D, []), + {keep_state_and_data, [{reply,From,Info}]}; -handle_sync_event({channel_info, ChannelId, Options}, _From, StateName, - #state{connection_state = #connection{channel_cache = Cache}} = State) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{} = Channel -> +handle_event({call,From}, {channel_info,ChannelId,Options}, _, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of + #channel{} = Channel -> Info = ssh_channel_info(Options, Channel, []), - {reply, Info, StateName, State}; + {keep_state_and_data, [{reply,From,Info}]}; undefined -> - {reply, [], StateName, State} + {keep_state_and_data, [{reply,From,[]}]} end; -handle_sync_event({info, ChannelPid}, _From, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State) -> + +handle_event({call,From}, {info, all}, _, D) -> + Result = ssh_channel:cache_foldl(fun(Channel, Acc) -> + [Channel | Acc] + end, + [], cache(D)), + {keep_state_and_data, [{reply, From, {ok,Result}}]}; + +handle_event({call,From}, {info, ChannelPid}, _, D) -> Result = ssh_channel:cache_foldl( - fun(Channel, Acc) when ChannelPid == all; - Channel#channel.user == ChannelPid -> + fun(Channel, Acc) when Channel#channel.user == ChannelPid -> [Channel | Acc]; (_, Acc) -> Acc - end, [], Cache), - {reply, {ok, Result}, StateName, State}; + end, [], cache(D)), + {keep_state_and_data, [{reply, From, {ok,Result}}]}; -handle_sync_event(stop, _, _StateName, #state{connection_state = Connection0, - role = Role} = State0) -> +handle_event({call,From}, stop, StateName, D0) -> {disconnect, _Reason, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "User closed down connection", - language = "en"}, Connection0, Role), - State = send_replies(Replies, State0), - {stop, normal, ok, State#state{connection_state = Connection}}; - - -handle_sync_event(Event, From, StateName, State) when StateName /= connected -> - Events = [{sync, Event, From} | State#state.event_queue], - {next_state, StateName, State#state{event_queue = Events}}; - -handle_sync_event({request, ChannelPid, ChannelId, Type, Data, Timeout}, From, StateName, State0) -> - {{replies, Replies}, State1} = handle_request(ChannelPid, - ChannelId, Type, Data, - true, From, State0), - %% Note reply to channel will happen later when - %% reply is recived from peer on the socket - State = send_replies(Replies, State1), - start_timeout(ChannelId, From, Timeout), - handle_idle_timeout(State), - {next_state, StateName, next_packet(State)}; - -handle_sync_event({request, ChannelId, Type, Data, Timeout}, From, StateName, State0) -> - {{replies, Replies}, State1} = handle_request(ChannelId, Type, Data, - true, From, State0), - %% Note reply to channel will happen later when - %% reply is recived from peer on the socket - State = send_replies(Replies, State1), - start_timeout(ChannelId, From, Timeout), - handle_idle_timeout(State), - {next_state, StateName, next_packet(State)}; - -handle_sync_event({global_request, Pid, _, _, _} = Request, From, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - State1 = handle_global_request(Request, State0), - Channel = ssh_channel:cache_find(Pid, Cache), - State = add_request(true, Channel#channel.local_id, From, State1), - {next_state, StateName, next_packet(State)}; - -handle_sync_event({data, ChannelId, Type, Data, Timeout}, From, StateName, - #state{connection_state = #connection{channel_cache = _Cache} - = Connection0} = State0) -> - - case ssh_connection:channel_data(ChannelId, Type, Data, Connection0, From) of - {{replies, Replies}, Connection} -> - State = send_replies(Replies, State0#state{connection_state = Connection}), - start_timeout(ChannelId, From, Timeout), - {next_state, StateName, next_packet(State)}; - {noreply, Connection} -> - start_timeout(ChannelId, From, Timeout), - {next_state, StateName, next_packet(State0#state{connection_state = Connection})} - end; - -handle_sync_event({eof, ChannelId}, _From, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of + description = "User closed down connection"}, + D0#data.connection_state, + role(StateName)), + {Repls,D} = send_replies(Replies, D0), + {stop_and_reply, normal, [{reply,From,ok}|Repls], D#data{connection_state=Connection}}; + +handle_event({call,_}, _, StateName, _) when StateName /= {connected,server}, + StateName /= {connected,client} -> + {keep_state_and_data, [postpone]}; + +handle_event({call,From}, {request, ChannelPid, ChannelId, Type, Data, Timeout}, {connected,_}, D0) -> + D = handle_request(ChannelPid, ChannelId, Type, Data, true, From, D0), + %% Note reply to channel will happen later when reply is recived from peer on the socket + start_channel_request_timer(ChannelId, From, Timeout), + {keep_state, cache_request_idle_timer_check(D)}; + +handle_event({call,From}, {request, ChannelId, Type, Data, Timeout}, {connected,_}, D0) -> + D = handle_request(ChannelId, Type, Data, true, From, D0), + %% Note reply to channel will happen later when reply is recived from peer on the socket + start_channel_request_timer(ChannelId, From, Timeout), + {keep_state, cache_request_idle_timer_check(D)}; + +handle_event({call,From}, {data, ChannelId, Type, Data, Timeout}, {connected,_}, D0) -> + {{replies, Replies}, Connection} = + ssh_connection:channel_data(ChannelId, Type, Data, D0#data.connection_state, From), + {Repls,D} = send_replies(Replies, D0#data{connection_state = Connection}), + start_channel_request_timer(ChannelId, From, Timeout), % FIXME: No message exchange so why? + {keep_state, D, Repls}; + +handle_event({call,From}, {eof, ChannelId}, {connected,_}, D0) -> + case ssh_channel:cache_lookup(cache(D0), ChannelId) of #channel{remote_id = Id, sent_close = false} -> - State = send_replies([{connection_reply, - ssh_connection:channel_eof_msg(Id)}], State0), - {reply, ok, StateName, next_packet(State)}; + D = send_msg(ssh_connection:channel_eof_msg(Id), D0), + {keep_state, D, [{reply,From,ok}]}; _ -> - {reply, {error,closed}, StateName, State0} + {keep_state, D0, [{reply,From,{error,closed}}]} end; -handle_sync_event({open, ChannelPid, Type, InitialWindowSize, MaxPacketSize, Data, Timeout}, - From, StateName, #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> +handle_event({call,From}, + {open, ChannelPid, Type, InitialWindowSize, MaxPacketSize, Data, Timeout}, + {connected,_}, + D0) -> erlang:monitor(process, ChannelPid), - {ChannelId, State1} = new_channel_id(State0), - Msg = ssh_connection:channel_open_msg(Type, ChannelId, - InitialWindowSize, - MaxPacketSize, Data), - State2 = send_replies([{connection_reply, Msg}], State1), - Channel = #channel{type = Type, - sys = "none", - user = ChannelPid, - local_id = ChannelId, - recv_window_size = InitialWindowSize, - recv_packet_size = MaxPacketSize, - send_buf = queue:new() - }, - ssh_channel:cache_update(Cache, Channel), - State = add_request(true, ChannelId, From, State2), - start_timeout(ChannelId, From, Timeout), - {next_state, StateName, next_packet(remove_timer_ref(State))}; - -handle_sync_event({send_window, ChannelId}, _From, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State) -> - Reply = case ssh_channel:cache_lookup(Cache, ChannelId) of + {ChannelId, D1} = new_channel_id(D0), + D2 = send_msg(ssh_connection:channel_open_msg(Type, ChannelId, + InitialWindowSize, + MaxPacketSize, Data), + D1), + ssh_channel:cache_update(cache(D2), + #channel{type = Type, + sys = "none", + user = ChannelPid, + local_id = ChannelId, + recv_window_size = InitialWindowSize, + recv_packet_size = MaxPacketSize, + send_buf = queue:new() + }), + D = add_request(true, ChannelId, From, D2), + start_channel_request_timer(ChannelId, From, Timeout), + {keep_state, cache_cancel_idle_timer(D)}; + +handle_event({call,From}, {send_window, ChannelId}, {connected,_}, D) -> + Reply = case ssh_channel:cache_lookup(cache(D), ChannelId) of #channel{send_window_size = WinSize, send_packet_size = Packsize} -> {ok, {WinSize, Packsize}}; undefined -> {error, einval} end, - {reply, Reply, StateName, next_packet(State)}; - -handle_sync_event({recv_window, ChannelId}, _From, StateName, - #state{connection_state = #connection{channel_cache = Cache}} - = State) -> + {keep_state_and_data, [{reply,From,Reply}]}; - Reply = case ssh_channel:cache_lookup(Cache, ChannelId) of +handle_event({call,From}, {recv_window, ChannelId}, {connected,_}, D) -> + Reply = case ssh_channel:cache_lookup(cache(D), ChannelId) of #channel{recv_window_size = WinSize, recv_packet_size = Packsize} -> {ok, {WinSize, Packsize}}; undefined -> {error, einval} end, - {reply, Reply, StateName, next_packet(State)}; - -handle_sync_event({close, ChannelId}, _, StateName, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - State = - case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{remote_id = Id} = Channel -> - State1 = send_replies([{connection_reply, - ssh_connection:channel_close_msg(Id)}], State0), - ssh_channel:cache_update(Cache, Channel#channel{sent_close = true}), - handle_idle_timeout(State1), - State1; - undefined -> - State0 - end, - {reply, ok, StateName, next_packet(State)}. + {keep_state_and_data, [{reply,From,Reply}]}; + +handle_event({call,From}, {close, ChannelId}, {connected,_}, D0) -> + case ssh_channel:cache_lookup(cache(D0), ChannelId) of + #channel{remote_id = Id} = Channel -> + D1 = send_msg(ssh_connection:channel_close_msg(Id), D0), + ssh_channel:cache_update(cache(D1), Channel#channel{sent_close = true}), + {keep_state, cache_request_idle_timer_check(D1), [{reply,From,ok}]}; + undefined -> + {keep_state_and_data, [{reply,From,ok}]} + end; -%%-------------------------------------------------------------------- --spec handle_info({atom(), port(), binary()} | {atom(), port()} | - term (), state_name(), #state{}) -> gen_fsm_state_return(). -%%-------------------------------------------------------------------- -handle_info({Protocol, Socket, "SSH-" ++ _ = Version}, hello, - #state{socket = Socket, - transport_protocol = Protocol} = State ) -> - event({version_exchange, Version}, hello, State); - -handle_info({Protocol, Socket, Info}, hello, - #state{socket = Socket, - transport_protocol = Protocol} = State) -> - event({info_line, Info}, hello, State); - -handle_info({Protocol, Socket, Data}, StateName, - #state{socket = Socket, - transport_protocol = Protocol, - ssh_params = Ssh0, - decoded_data_buffer = DecData0, - encoded_data_buffer = EncData0, - undecoded_packet_length = RemainingSshPacketLen0} = State0) -> - Encoded = <<EncData0/binary, Data/binary>>, - try ssh_transport:handle_packet_part(DecData0, Encoded, RemainingSshPacketLen0, Ssh0) +%%===== Reception of encrypted bytes, decryption and framing +handle_event(info, {Proto, Sock, Info}, {hello,_}, #data{socket = Sock, + transport_protocol = Proto}) -> + case Info of + "SSH-" ++ _ -> + {keep_state_and_data, [{next_event, internal, {version_exchange,Info}}]}; + _ -> + {keep_state_and_data, [{next_event, internal, {info_line,Info}}]} + end; + +handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, + transport_protocol = Proto}) -> + try ssh_transport:handle_packet_part( + D0#data.decrypted_data_buffer, + <<(D0#data.encrypted_data_buffer)/binary, NewData/binary>>, + D0#data.undecrypted_packet_length, + D0#data.ssh_params) of - {get_more, DecBytes, EncDataRest, RemainingSshPacketLen, Ssh1} -> - {next_state, StateName, - next_packet(State0#state{encoded_data_buffer = EncDataRest, - decoded_data_buffer = DecBytes, - undecoded_packet_length = RemainingSshPacketLen, - ssh_params = Ssh1})}; - {decoded, MsgBytes, EncDataRest, Ssh1} -> - generate_event(MsgBytes, StateName, - State0#state{ssh_params = Ssh1, - %% Important to be set for - %% next_packet -%%% FIXME: the following three seem to always be set in generate_event! - decoded_data_buffer = <<>>, - undecoded_packet_length = undefined, - encoded_data_buffer = EncDataRest}, - EncDataRest); + {packet_decrypted, DecryptedBytes, EncryptedDataRest, Ssh1} -> + D = D0#data{ssh_params = + Ssh1#ssh{recv_sequence = ssh_transport:next_seqnum(Ssh1#ssh.recv_sequence)}, + decrypted_data_buffer = <<>>, + undecrypted_packet_length = undefined, + encrypted_data_buffer = EncryptedDataRest}, + try + ssh_message:decode(set_kex_overload_prefix(DecryptedBytes,D)) + of + Msg = #ssh_msg_kexinit{} -> + {keep_state, D, [{next_event, internal, {Msg,DecryptedBytes}}, + {next_event, internal, prepare_next_packet} + ]}; + Msg -> + {keep_state, D, [{next_event, internal, Msg}, + {next_event, internal, prepare_next_packet} + ]} + catch + _C:_E -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Encountered unexpected input"}, + StateName, D) + end; + + {get_more, DecryptedBytes, EncryptedDataRest, RemainingSshPacketLen, Ssh1} -> + %% Here we know that there are not enough bytes in + %% EncryptedDataRest to use. We must wait for more. + inet:setopts(Sock, [{active, once}]), + {keep_state, D0#data{encrypted_data_buffer = EncryptedDataRest, + decrypted_data_buffer = DecryptedBytes, + undecrypted_packet_length = RemainingSshPacketLen, + ssh_params = Ssh1}}; + {bad_mac, Ssh1} -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad mac", - language = ""}, - handle_disconnect(DisconnectMsg, State0#state{ssh_params=Ssh1}); + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Bad mac"}, + StateName, D0#data{ssh_params=Ssh1}); {error, {exceeds_max_size,PacketLen}} -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad packet length " - ++ integer_to_list(PacketLen), - language = ""}, - handle_disconnect(DisconnectMsg, State0) + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Bad packet length " + ++ integer_to_list(PacketLen)}, + StateName, D0) catch - _:_ -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad packet", - language = ""}, - handle_disconnect(DisconnectMsg, State0) + _C:_E -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Bad packet"}, + StateName, D0) end; - -handle_info({CloseTag, _Socket}, _StateName, - #state{transport_close_tag = CloseTag, - ssh_params = #ssh{role = _Role, opts = _Opts}} = State) -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "Connection closed", - language = "en"}, - handle_disconnect(DisconnectMsg, State); - -handle_info({timeout, {_, From} = Request}, Statename, - #state{connection_state = #connection{requests = Requests} = Connection} = State) -> + + +%%%==== +handle_event(internal, prepare_next_packet, _, D) -> + Enough = erlang:max(8, D#data.ssh_params#ssh.decrypt_block_size), + case size(D#data.encrypted_data_buffer) of + Sz when Sz >= Enough -> + self() ! {D#data.transport_protocol, D#data.socket, <<>>}; + _ -> + inet:setopts(D#data.socket, [{active, once}]) + end, + keep_state_and_data; + +handle_event(info, {CloseTag,Socket}, StateName, + D = #data{socket = Socket, + transport_close_tag = CloseTag}) -> + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Connection closed"}, + StateName, D); + +handle_event(info, {timeout, {_, From} = Request}, _, + #data{connection_state = #connection{requests = Requests} = C0} = D) -> case lists:member(Request, Requests) of true -> - gen_fsm:reply(From, {error, timeout}), - {next_state, Statename, - State#state{connection_state = - Connection#connection{requests = - lists:delete(Request, Requests)}}}; + %% A channel request is not answered in time. Answer {error,timeout} + %% to the caller + C = C0#connection{requests = lists:delete(Request, Requests)}, + {keep_state, D#data{connection_state=C}, [{reply,From,{error,timeout}}]}; false -> - {next_state, Statename, State} + %% The request is answered - just ignore the timeout + keep_state_and_data end; %%% Handle that ssh channels user process goes down -handle_info({'DOWN', _Ref, process, ChannelPid, _Reason}, Statename, State0) -> - {{replies, Replies}, State1} = handle_channel_down(ChannelPid, State0), - State = send_replies(Replies, State1), - {next_state, Statename, next_packet(State)}; +handle_event(info, {'DOWN', _Ref, process, ChannelPid, _Reason}, _, D0) -> + {{replies, Replies}, D1} = handle_channel_down(ChannelPid, D0), + {Repls, D} = send_replies(Replies, D1), + {keep_state, D, Repls}; %%% So that terminate will be run when supervisor is shutdown -handle_info({'EXIT', _Sup, Reason}, _StateName, State) -> - {stop, {shutdown, Reason}, State}; +handle_event(info, {'EXIT', _Sup, Reason}, _, _) -> + {stop, {shutdown, Reason}}; -handle_info({check_cache, _ , _}, - StateName, #state{connection_state = - #connection{channel_cache = Cache}} = State) -> - {next_state, StateName, check_cache(State, Cache)}; +handle_event(info, check_cache, _, D) -> + {keep_state, cache_check_set_idle_timer(D)}; -handle_info(UnexpectedMessage, StateName, #state{opts = Opts, - ssh_params = SshParams} = State) -> - case unexpected_fun(UnexpectedMessage, Opts, SshParams) of +handle_event(info, UnexpectedMessage, StateName, D = #data{ssh_params = Ssh}) -> + case unexpected_fun(UnexpectedMessage, D) of report -> Msg = lists:flatten( io_lib:format( "Unexpected message '~p' received in state '~p'\n" "Role: ~p\n" "Peer: ~p\n" - "Local Address: ~p\n", [UnexpectedMessage, StateName, - SshParams#ssh.role, SshParams#ssh.peer, - proplists:get_value(address, SshParams#ssh.opts)])), - error_logger:info_report(Msg); + "Local Address: ~p\n", [UnexpectedMessage, + StateName, + Ssh#ssh.role, + Ssh#ssh.peer, + proplists:get_value(address, Ssh#ssh.opts)])), + error_logger:info_report(Msg), + keep_state_and_data; skip -> - ok; + keep_state_and_data; Other -> Msg = lists:flatten( @@ -1103,200 +1269,181 @@ handle_info(UnexpectedMessage, StateName, #state{opts = Opts, "Message: ~p\n" "Role: ~p\n" "Peer: ~p\n" - "Local Address: ~p\n", [Other, UnexpectedMessage, - SshParams#ssh.role, - element(2,SshParams#ssh.peer), - proplists:get_value(address, SshParams#ssh.opts)] + "Local Address: ~p\n", [Other, + UnexpectedMessage, + Ssh#ssh.role, + element(2,Ssh#ssh.peer), + proplists:get_value(address, Ssh#ssh.opts)] )), + error_logger:error_report(Msg), + keep_state_and_data + end; + +handle_event(internal, {disconnect,Msg,_Reason}, StateName, D) -> + disconnect(Msg, StateName, D); + +handle_event(Type, Ev, StateName, D) -> + Descr = + case catch atom_to_list(element(1,Ev)) of + "ssh_msg_" ++_ when Type==internal -> + "Message in wrong state"; + _ -> + "Internal error" + end, + disconnect(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = Descr}, + StateName, D). - error_logger:error_report(Msg) - end, - {next_state, StateName, State}. %%-------------------------------------------------------------------- --spec terminate(Reason::term(), state_name(), #state{}) -> _. -%%-------------------------------------------------------------------- -terminate(normal, _, #state{transport_cb = Transport, - connection_state = Connection, - socket = Socket}) -> - terminate_subsystem(Connection), - (catch Transport:close(Socket)), - ok; +-spec terminate(any(), + state_name(), + #data{} + ) -> finalize_termination_result() . + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +terminate(normal, StateName, State) -> + finalize_termination(StateName, State); terminate({shutdown,{init,Reason}}, StateName, State) -> error_logger:info_report(io_lib:format("Erlang ssh in connection handler init: ~p~n",[Reason])), - terminate(normal, StateName, State); - -%% Terminated by supervisor -terminate(shutdown, StateName, #state{ssh_params = Ssh0} = State) -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "Application shutdown", - language = "en"}, - {SshPacket, Ssh} = ssh_transport:ssh_packet(DisconnectMsg, Ssh0), - send_msg(SshPacket, State), - terminate(normal, StateName, State#state{ssh_params = Ssh}); - -terminate({shutdown, #ssh_msg_disconnect{} = Msg}, StateName, - #state{ssh_params = Ssh0} = State) -> - {SshPacket, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), - send_msg(SshPacket, State), - terminate(normal, StateName, State#state{ssh_params = Ssh}); - -terminate({shutdown, _}, StateName, State) -> - terminate(normal, StateName, State); - -terminate(Reason, StateName, #state{ssh_params = Ssh0, starter = _Pid, - connection_state = Connection} = State) -> - terminate_subsystem(Connection), + finalize_termination(StateName, State); + +terminate(shutdown, StateName, State0) -> + %% Terminated by supervisor + State = send_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Application shutdown"}, + State0), +timer:sleep(400), %% FIXME!!! gen_tcp:shutdown instead + finalize_termination(StateName, State); + +%% terminate({shutdown,Msg}, StateName, State0) when is_record(Msg,ssh_msg_disconnect)-> +%% State = send_msg(Msg, State0), +%% timer:sleep(400), %% FIXME!!! gen_tcp:shutdown instead +%% finalize_termination(StateName, Msg, State); + +terminate({shutdown,_R}, StateName, State) -> + finalize_termination(StateName, State); + +terminate(Reason, StateName, State0) -> + %% Others, e.g undef, {badmatch,_} log_error(Reason), - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "Internal error", - language = "en"}, - {SshPacket, Ssh} = ssh_transport:ssh_packet(DisconnectMsg, Ssh0), - send_msg(SshPacket, State), - terminate(normal, StateName, State#state{ssh_params = Ssh}). - - -terminate_subsystem(#connection{system_supervisor = SysSup, - sub_system_supervisor = SubSysSup}) when is_pid(SubSysSup) -> - ssh_system_sup:stop_subsystem(SysSup, SubSysSup); -terminate_subsystem(_) -> - ok. - -format_status(normal, [_, State]) -> - [{data, [{"StateData", State}]}]; -format_status(terminate, [_, State]) -> - SshParams0 = (State#state.ssh_params), - SshParams = SshParams0#ssh{c_keyinit = "***", - s_keyinit = "***", - send_mac_key = "***", - send_mac_size = "***", - recv_mac_key = "***", - recv_mac_size = "***", - encrypt_keys = "***", - encrypt_ctx = "***", - decrypt_keys = "***", - decrypt_ctx = "***", - compress_ctx = "***", - decompress_ctx = "***", - shared_secret = "***", - exchanged_hash = "***", - session_id = "***", - keyex_key = "***", - keyex_info = "***", - available_host_keys = "***"}, - [{data, [{"StateData", State#state{decoded_data_buffer = "***", - encoded_data_buffer = "***", - key_exchange_init_msg = "***", - opts = "***", - recbuf = "***", - ssh_params = SshParams - }}]}]. + State = send_msg(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Internal error"}, + State0), + finalize_termination(StateName, State). %%-------------------------------------------------------------------- --spec code_change(OldVsn::term(), state_name(), Oldstate::term(), Extra::term()) -> - {ok, state_name(), #state{}}. + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +format_status(normal, [_, _StateName, D]) -> + [{data, [{"State", D}]}]; +format_status(terminate, [_, _StateName, D]) -> + DataPropList0 = fmt_stat_rec(record_info(fields, data), D, + [decrypted_data_buffer, + encrypted_data_buffer, + key_exchange_init_msg, + user_passwords, + opts, + inet_initial_recbuf_size]), + SshPropList = fmt_stat_rec(record_info(fields, ssh), D#data.ssh_params, + [c_keyinit, + s_keyinit, + send_mac_key, + send_mac_size, + recv_mac_key, + recv_mac_size, + encrypt_keys, + encrypt_ctx, + decrypt_keys, + decrypt_ctx, + compress_ctx, + decompress_ctx, + shared_secret, + exchanged_hash, + session_id, + keyex_key, + keyex_info, + available_host_keys]), + DataPropList = lists:keyreplace(ssh_params, 1, DataPropList0, + {ssh_params,SshPropList}), + [{data, [{"State", DataPropList}]}]. + + +fmt_stat_rec(FieldNames, Rec, Exclude) -> + Values = tl(tuple_to_list(Rec)), + [P || {K,_} = P <- lists:zip(FieldNames, Values), + not lists:member(K, Exclude)]. + %%-------------------------------------------------------------------- +-spec code_change(term() | {down,term()}, + state_name(), + #data{}, + term() + ) -> {gen_statem:callback_mode(), state_name(), #data{}}. + +%% . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + code_change(_OldVsn, StateName, State, _Extra) -> - {ok, StateName, State}. + {handle_event_function, StateName, State}. + + +%%==================================================================== +%% Internal functions +%%==================================================================== %%-------------------------------------------------------------------- -%%% Internal functions -%%-------------------------------------------------------------------- -init_role(#state{role = client, opts = Opts} = State0) -> - Pid = proplists:get_value(user_pid, Opts), - TimerRef = get_idle_time(Opts), - timer:apply_after(?REKEY_TIMOUT, gen_fsm, send_all_state_event, [self(), renegotiate]), - timer:apply_after(?REKEY_DATA_TIMOUT, gen_fsm, send_all_state_event, - [self(), data_size]), - State0#state{starter = Pid, - idle_timer_ref = TimerRef}; -init_role(#state{role = server, opts = Opts, connection_state = Connection} = State) -> - Sups = proplists:get_value(supervisors, Opts), - Pid = proplists:get_value(user_pid, Opts), - SystemSup = proplists:get_value(system_sup, Sups), - SubSystemSup = proplists:get_value(subsystem_sup, Sups), +%% Starting + +start_the_connection_child(UserPid, Role, Socket, Options) -> + Sups = proplists:get_value(supervisors, Options), ConnectionSup = proplists:get_value(connection_sup, Sups), - Shell = proplists:get_value(shell, Opts), - Exec = proplists:get_value(exec, Opts), - CliSpec = proplists:get_value(ssh_cli, Opts, {ssh_cli, [Shell]}), - State#state{starter = Pid, connection_state = Connection#connection{ - cli_spec = CliSpec, - exec = Exec, - system_supervisor = SystemSup, - sub_system_supervisor = SubSystemSup, - connection_supervisor = ConnectionSup - }}. - -get_idle_time(SshOptions) -> - case proplists:get_value(idle_time, SshOptions) of - infinity -> - infinity; - _IdleTime -> %% We dont want to set the timeout on first connect - undefined - end. + Opts = [{supervisors, Sups}, {user_pid, UserPid} | proplists:get_value(ssh_opts, Options, [])], + {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Opts]), + ok = socket_control(Socket, Pid, Options), + Pid. -init_ssh(client = Role, Vsn, Version, Options, Socket) -> - IOCb = case proplists:get_value(user_interaction, Options, true) of - true -> - ssh_io; - false -> - ssh_no_io - end, +%%-------------------------------------------------------------------- +%% Stopping +-type finalize_termination_result() :: ok . + +finalize_termination(_StateName, #data{transport_cb = Transport, + connection_state = Connection, + socket = Socket}) -> + case Connection of + #connection{system_supervisor = SysSup, + sub_system_supervisor = SubSysSup} when is_pid(SubSysSup) -> + ssh_system_sup:stop_subsystem(SysSup, SubSysSup); + _ -> + do_nothing + end, + (catch Transport:close(Socket)), + ok. - AuthMethods = proplists:get_value(auth_methods, Options, - ?SUPPORTED_AUTH_METHODS), - {ok, PeerAddr} = inet:peername(Socket), - - PeerName = proplists:get_value(host, Options), - KeyCb = proplists:get_value(key_cb, Options, ssh_file), - - #ssh{role = Role, - c_vsn = Vsn, - c_version = Version, - key_cb = KeyCb, - io_cb = IOCb, - userauth_quiet_mode = proplists:get_value(quiet_mode, Options, false), - opts = Options, - userauth_supported_methods = AuthMethods, - peer = {PeerName, PeerAddr}, - available_host_keys = supported_host_keys(Role, KeyCb, Options), - random_length_padding = proplists:get_value(max_random_length_padding, - Options, - (#ssh{})#ssh.random_length_padding) - }; - -init_ssh(server = Role, Vsn, Version, Options, Socket) -> - AuthMethods = proplists:get_value(auth_methods, Options, - ?SUPPORTED_AUTH_METHODS), - AuthMethodsAsList = string:tokens(AuthMethods, ","), - {ok, PeerAddr} = inet:peername(Socket), - KeyCb = proplists:get_value(key_cb, Options, ssh_file), - - #ssh{role = Role, - s_vsn = Vsn, - s_version = Version, - key_cb = KeyCb, - io_cb = proplists:get_value(io_cb, Options, ssh_io), - opts = Options, - userauth_supported_methods = AuthMethods, - userauth_methods = AuthMethodsAsList, - kb_tries_left = 3, - peer = {undefined, PeerAddr}, - available_host_keys = supported_host_keys(Role, KeyCb, Options), - random_length_padding = proplists:get_value(max_random_length_padding, - Options, - (#ssh{})#ssh.random_length_padding) - }. +%%-------------------------------------------------------------------- +%% "Invert" the Role +peer_role(client) -> server; +peer_role(server) -> client. + +%%-------------------------------------------------------------------- +%% StateName to Role +role({_,Role}) -> Role; +role({_,Role,_}) -> Role. +%%-------------------------------------------------------------------- +%% Check the StateName to see if we are in the renegotiation phase +renegotiation({_,_,ReNeg}) -> ReNeg == renegotiation; +renegotiation(_) -> false. + +%%-------------------------------------------------------------------- supported_host_keys(client, _, Options) -> try - case proplists:get_value(public_key, + case proplists:get_value(public_key, proplists:get_value(preferred_algorithms,Options,[]) ) of - undefined -> + undefined -> ssh_transport:default_algorithms(public_key); L -> L -- (L--ssh_transport:default_algorithms(public_key)) @@ -1311,7 +1458,7 @@ supported_host_keys(client, _, Options) -> {stop, {shutdown, Reason}} end; supported_host_keys(server, KeyCb, Options) -> - [atom_to_list(A) || A <- proplists:get_value(public_key, + [atom_to_list(A) || A <- proplists:get_value(public_key, proplists:get_value(preferred_algorithms,Options,[]), ssh_transport:default_algorithms(public_key) ), @@ -1322,10 +1469,16 @@ supported_host_keys(server, KeyCb, Options) -> available_host_key(KeyCb, Alg, Opts) -> element(1, catch KeyCb:host_key(Alg, Opts)) == ok. -send_msg(Msg, #state{socket = Socket, transport_cb = Transport}) -> - Transport:send(Socket, Msg). -handle_version({2, 0} = NumVsn, StrVsn, Ssh0) -> +send_msg(Msg, State=#data{ssh_params=Ssh0}) when is_tuple(Msg) -> + {Bytes, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), + send_bytes(Bytes, State), + State#data{ssh_params=Ssh}. + +send_bytes(Bytes, #data{socket = Socket, transport_cb = Transport}) -> + Transport:send(Socket, Bytes). + +handle_version({2, 0} = NumVsn, StrVsn, Ssh0) -> Ssh = counterpart_versions(NumVsn, StrVsn, Ssh0), {ok, Ssh}; handle_version(_,_,_) -> @@ -1336,419 +1489,185 @@ string_version(#ssh{role = client, c_version = Vsn}) -> string_version(#ssh{role = server, s_version = Vsn}) -> Vsn. -send_event(FsmPid, Event) -> - gen_fsm:send_event(FsmPid, Event). -send_all_state_event(FsmPid, Event) -> - gen_fsm:send_all_state_event(FsmPid, Event). +cast(FsmPid, Event) -> + gen_statem:cast(FsmPid, Event). -sync_send_all_state_event(FsmPid, Event) -> - sync_send_all_state_event(FsmPid, Event, infinity). +call(FsmPid, Event) -> + call(FsmPid, Event, infinity). -sync_send_all_state_event(FsmPid, Event, Timeout) -> - try gen_fsm:sync_send_all_state_event(FsmPid, Event, Timeout) of - {closed, _Channel} -> +call(FsmPid, Event, Timeout) -> + try gen_statem:call(FsmPid, Event, Timeout) of + {closed, _R} -> + {error, closed}; + {killed, _R} -> {error, closed}; Result -> Result catch - exit:{noproc, _} -> + exit:{noproc, _R} -> {error, closed}; - exit:{normal, _} -> + exit:{normal, _R} -> {error, closed}; - exit:{{shutdown, _},_} -> + exit:{{shutdown, _R},_} -> {error, closed} end. -%% simulate send_all_state_event(self(), Event) -event(#ssh_msg_disconnect{} = Event, StateName, State) -> - handle_event(Event, StateName, State); -event(#ssh_msg_ignore{} = Event, StateName, State) -> - handle_event(Event, StateName, State); -event(#ssh_msg_debug{} = Event, StateName, State) -> - handle_event(Event, StateName, State); -event(#ssh_msg_unimplemented{} = Event, StateName, State) -> - handle_event(Event, StateName, State); -%% simulate send_event(self(), Event) -event(Event, StateName, State) -> - try - ?MODULE:StateName(Event, State) + +handle_connection_msg(Msg, StateName, State0 = + #data{starter = User, + connection_state = Connection0, + event_queue = Qev0}) -> + Renegotiation = renegotiation(StateName), + Role = role(StateName), + try ssh_connection:handle_msg(Msg, Connection0, Role) of + {{replies, Replies}, Connection} -> + case StateName of + {connected,_} -> + {Repls, State} = send_replies(Replies, + State0#data{connection_state=Connection}), + {keep_state, State, Repls}; + _ -> + {ConnReplies, Replies} = + lists:splitwith(fun not_connected_filter/1, Replies), + {Repls, State} = send_replies(Replies, + State0#data{event_queue = Qev0 ++ ConnReplies}), + {keep_state, State, Repls} + end; + + {noreply, Connection} -> + {keep_state, State0#data{connection_state = Connection}}; + + {disconnect, Reason0, {{replies, Replies}, Connection}} -> + {Repls,State} = send_replies(Replies, State0#data{connection_state = Connection}), + case {Reason0,Role} of + {{_, Reason}, client} when ((StateName =/= {connected,client}) and (not Renegotiation)) -> + User ! {self(), not_connected, Reason}; + _ -> + ok + end, + {stop, {shutdown,normal}, Repls, State#data{connection_state = Connection}} + catch - throw:#ssh_msg_disconnect{} = DisconnectMsg -> - handle_disconnect(DisconnectMsg, State); - throw:{ErrorToDisplay, #ssh_msg_disconnect{} = DisconnectMsg} -> - handle_disconnect(DisconnectMsg, State, ErrorToDisplay); - _C:_Error -> - handle_disconnect(#ssh_msg_disconnect{code = error_code(StateName), - description = "Invalid state", - language = "en"}, State) + _:Error -> + {disconnect, _Reason, {{replies, Replies}, Connection}} = + ssh_connection:handle_msg( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, + description = "Internal error"}, + Connection0, Role), + {Repls,State} = send_replies(Replies, State0#data{connection_state = Connection}), + {stop, {shutdown,Error}, Repls, State#data{connection_state = Connection}} end. -error_code(key_exchange) -> - ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED; -error_code(new_keys) -> - ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED; -error_code(_) -> - ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE. - -generate_event(<<?BYTE(Byte), _/binary>> = Msg, StateName, - #state{ - role = Role, - starter = User, - renegotiate = Renegotiation, - connection_state = Connection0} = State0, EncData) - when Byte == ?SSH_MSG_GLOBAL_REQUEST; - Byte == ?SSH_MSG_REQUEST_SUCCESS; - Byte == ?SSH_MSG_REQUEST_FAILURE; - Byte == ?SSH_MSG_CHANNEL_OPEN; - Byte == ?SSH_MSG_CHANNEL_OPEN_CONFIRMATION; - Byte == ?SSH_MSG_CHANNEL_OPEN_FAILURE; - Byte == ?SSH_MSG_CHANNEL_WINDOW_ADJUST; - Byte == ?SSH_MSG_CHANNEL_DATA; - Byte == ?SSH_MSG_CHANNEL_EXTENDED_DATA; - Byte == ?SSH_MSG_CHANNEL_EOF; - Byte == ?SSH_MSG_CHANNEL_CLOSE; - Byte == ?SSH_MSG_CHANNEL_REQUEST; - Byte == ?SSH_MSG_CHANNEL_SUCCESS; - Byte == ?SSH_MSG_CHANNEL_FAILURE -> - try - ssh_message:decode(Msg) - of - ConnectionMsg -> - State1 = generate_event_new_state(State0, EncData), - try ssh_connection:handle_msg(ConnectionMsg, Connection0, Role) of - {{replies, Replies0}, Connection} -> - if StateName == connected -> - Replies = Replies0, - State2 = State1; - true -> - {ConnReplies, Replies} = - lists:splitwith(fun not_connected_filter/1, Replies0), - Q = State1#state.event_queue ++ ConnReplies, - State2 = State1#state{ event_queue = Q } - end, - State = send_replies(Replies, State2#state{connection_state = Connection}), - {next_state, StateName, next_packet(State)}; - {noreply, Connection} -> - {next_state, StateName, next_packet(State1#state{connection_state = Connection})}; - {disconnect, {_, Reason}, {{replies, Replies}, Connection}} when - Role == client andalso ((StateName =/= connected) and (not Renegotiation)) -> - State = send_replies(Replies, State1#state{connection_state = Connection}), - User ! {self(), not_connected, Reason}, - {stop, {shutdown, normal}, - next_packet(State#state{connection_state = Connection})}; - {disconnect, _Reason, {{replies, Replies}, Connection}} -> - State = send_replies(Replies, State1#state{connection_state = Connection}), - {stop, {shutdown, normal}, State#state{connection_state = Connection}} - catch - _:Error -> - {disconnect, _Reason, {{replies, Replies}, Connection}} = - ssh_connection:handle_msg( - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_BY_APPLICATION, - description = "Internal error", - language = "en"}, Connection0, Role), - State = send_replies(Replies, State1#state{connection_state = Connection}), - {stop, {shutdown, Error}, State#state{connection_state = Connection}} - end - catch - _:_ -> - handle_disconnect( - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Bad packet received", - language = ""}, State0) - end; -generate_event(Msg, StateName, State0, EncData) -> - try - Event = ssh_message:decode(set_prefix_if_trouble(Msg,State0)), - State = generate_event_new_state(State0, EncData), - case Event of - #ssh_msg_kexinit{} -> - %% We need payload for verification later. - event({Event, Msg}, StateName, State); - _ -> - event(Event, StateName, State) - end - catch - _C:_E -> - DisconnectMsg = - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Encountered unexpected input", - language = "en"}, - handle_disconnect(DisconnectMsg, State0) - end. - - -set_prefix_if_trouble(Msg = <<?BYTE(Op),_/binary>>, #state{ssh_params=SshParams}) +set_kex_overload_prefix(Msg = <<?BYTE(Op),_/binary>>, #data{ssh_params=SshParams}) when Op == 30; Op == 31 -> case catch atom_to_list(kex(SshParams)) of - "ecdh-sha2-" ++ _ -> + "ecdh-sha2-" ++ _ -> <<"ecdh",Msg/binary>>; "diffie-hellman-group-exchange-" ++ _ -> <<"dh_gex",Msg/binary>>; "diffie-hellman-group" ++ _ -> <<"dh",Msg/binary>>; - _ -> + _ -> Msg end; -set_prefix_if_trouble(Msg, _) -> +set_kex_overload_prefix(Msg, _) -> Msg. kex(#ssh{algorithms=#alg{kex=Kex}}) -> Kex; kex(_) -> undefined. +cache(#data{connection_state=C}) -> C#connection.channel_cache. + -handle_request(ChannelPid, ChannelId, Type, Data, WantReply, From, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of +%%%---------------------------------------------------------------- +handle_request(ChannelPid, ChannelId, Type, Data, WantReply, From, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of #channel{remote_id = Id} = Channel -> - update_sys(Cache, Channel, Type, ChannelPid), - Msg = ssh_connection:channel_request_msg(Id, Type, - WantReply, Data), - Replies = [{connection_reply, Msg}], - State = add_request(WantReply, ChannelId, From, State0), - {{replies, Replies}, State}; + update_sys(cache(D), Channel, Type, ChannelPid), + send_msg(ssh_connection:channel_request_msg(Id, Type, WantReply, Data), + add_request(WantReply, ChannelId, From, D)); undefined -> - {{replies, []}, State0} + D end. -handle_request(ChannelId, Type, Data, WantReply, From, - #state{connection_state = - #connection{channel_cache = Cache}} = State0) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{remote_id = Id} -> - Msg = ssh_connection:channel_request_msg(Id, Type, - WantReply, Data), - Replies = [{connection_reply, Msg}], - State = add_request(WantReply, ChannelId, From, State0), - {{replies, Replies}, State}; +handle_request(ChannelId, Type, Data, WantReply, From, D) -> + case ssh_channel:cache_lookup(cache(D), ChannelId) of + #channel{remote_id = Id} -> + send_msg(ssh_connection:channel_request_msg(Id, Type, WantReply, Data), + add_request(WantReply, ChannelId, From, D)); undefined -> - {{replies, []}, State0} - end. - -handle_global_request({global_request, ChannelPid, - "tcpip-forward" = Type, WantReply, - <<?UINT32(IPLen), - IP:IPLen/binary, ?UINT32(Port)>> = Data}, - #state{connection_state = - #connection{channel_cache = Cache} - = Connection0} = State) -> - ssh_channel:cache_update(Cache, #channel{user = ChannelPid, - type = "forwarded-tcpip", - sys = none}), - Connection = ssh_connection:bind(IP, Port, ChannelPid, Connection0), - Msg = ssh_connection:global_request_msg(Type, WantReply, Data), - send_replies([{connection_reply, Msg}], State#state{connection_state = Connection}); - -handle_global_request({global_request, _Pid, "cancel-tcpip-forward" = Type, - WantReply, <<?UINT32(IPLen), - IP:IPLen/binary, ?UINT32(Port)>> = Data}, - #state{connection_state = Connection0} = State) -> - Connection = ssh_connection:unbind(IP, Port, Connection0), - Msg = ssh_connection:global_request_msg(Type, WantReply, Data), - send_replies([{connection_reply, Msg}], State#state{connection_state = Connection}); - -handle_global_request({global_request, _, "cancel-tcpip-forward" = Type, - WantReply, Data}, State) -> - Msg = ssh_connection:global_request_msg(Type, WantReply, Data), - send_replies([{connection_reply, Msg}], State). - -handle_idle_timeout(#state{opts = Opts}) -> - case proplists:get_value(idle_time, Opts, infinity) of - infinity -> - ok; - IdleTime -> - erlang:send_after(IdleTime, self(), {check_cache, [], []}) + D end. -handle_channel_down(ChannelPid, #state{connection_state = - #connection{channel_cache = Cache}} = - State) -> +%%%---------------------------------------------------------------- +handle_channel_down(ChannelPid, D) -> ssh_channel:cache_foldl( fun(Channel, Acc) when Channel#channel.user == ChannelPid -> - ssh_channel:cache_delete(Cache, + ssh_channel:cache_delete(cache(D), Channel#channel.local_id), Acc; (_,Acc) -> Acc - end, [], Cache), - {{replies, []}, check_cache(State, Cache)}. + end, [], cache(D)), + {{replies, []}, cache_check_set_idle_timer(D)}. + update_sys(Cache, Channel, Type, ChannelPid) -> ssh_channel:cache_update(Cache, Channel#channel{sys = Type, user = ChannelPid}). + add_request(false, _ChannelId, _From, State) -> State; -add_request(true, ChannelId, From, #state{connection_state = - #connection{requests = Requests0} = - Connection} = State) -> +add_request(true, ChannelId, From, #data{connection_state = + #connection{requests = Requests0} = + Connection} = State) -> Requests = [{ChannelId, From} | Requests0], - State#state{connection_state = Connection#connection{requests = Requests}}. + State#data{connection_state = Connection#connection{requests = Requests}}. -new_channel_id(#state{connection_state = #connection{channel_id_seed = Id} = - Connection} +new_channel_id(#data{connection_state = #connection{channel_id_seed = Id} = + Connection} = State) -> - {Id, State#state{connection_state = - Connection#connection{channel_id_seed = Id + 1}}}. - -generate_event_new_state(#state{ssh_params = - #ssh{recv_sequence = SeqNum0} - = Ssh} = State, EncData) -> - SeqNum = ssh_transport:next_seqnum(SeqNum0), - State#state{ssh_params = Ssh#ssh{recv_sequence = SeqNum}, - decoded_data_buffer = <<>>, - encoded_data_buffer = EncData, - undecoded_packet_length = undefined}. - -next_packet(#state{decoded_data_buffer = <<>>, - encoded_data_buffer = Buff, - ssh_params = #ssh{decrypt_block_size = BlockSize}, - socket = Socket, - transport_protocol = Protocol} = State) when Buff =/= <<>> -> - case size(Buff) >= erlang:max(8, BlockSize) of - true -> - %% Enough data from the next packet has been received to - %% decode the length indicator, fake a socket-recive - %% message so that the data will be processed - self() ! {Protocol, Socket, <<>>}; - false -> - inet:setopts(Socket, [{active, once}]) - end, - State; - -next_packet(#state{socket = Socket} = State) -> - inet:setopts(Socket, [{active, once}]), - State. - -after_new_keys(#state{renegotiate = true} = State) -> - State1 = State#state{renegotiate = false, event_queue = []}, - lists:foldr(fun after_new_keys_events/2, {next_state, connected, State1}, State#state.event_queue); -after_new_keys(#state{renegotiate = false, - ssh_params = #ssh{role = client} = Ssh0} = State) -> - {Msg, Ssh} = ssh_auth:service_request_msg(Ssh0), - send_msg(Msg, State), - {next_state, service_request, State#state{ssh_params = Ssh}}; -after_new_keys(#state{renegotiate = false, - ssh_params = #ssh{role = server}} = State) -> - {next_state, service_request, State}. - -after_new_keys_events({sync, _Event, From}, {stop, _Reason, _StateData}=Terminator) -> - gen_fsm:reply(From, {error, closed}), - Terminator; -after_new_keys_events(_, {stop, _Reason, _StateData}=Terminator) -> - Terminator; -after_new_keys_events({sync, Event, From}, {next_state, StateName, StateData}) -> - case handle_sync_event(Event, From, StateName, StateData) of - {reply, Reply, NextStateName, NewStateData} -> - gen_fsm:reply(From, Reply), - {next_state, NextStateName, NewStateData}; - {next_state, NextStateName, NewStateData}-> - {next_state, NextStateName, NewStateData}; - {stop, Reason, Reply, NewStateData} -> - gen_fsm:reply(From, Reply), - {stop, Reason, NewStateData} - end; -after_new_keys_events({event, Event}, {next_state, StateName, StateData}) -> - case handle_event(Event, StateName, StateData) of - {next_state, NextStateName, NewStateData}-> - {next_state, NextStateName, NewStateData}; - {stop, Reason, NewStateData} -> - {stop, Reason, NewStateData} - end; -after_new_keys_events({connection_reply, _Data} = Reply, {StateName, State}) -> - NewState = send_replies([Reply], State), - {next_state, StateName, NewState}. - - -handle_disconnect(DisconnectMsg, State) -> - handle_disconnect(own, DisconnectMsg, State). - -handle_disconnect(#ssh_msg_disconnect{} = DisconnectMsg, State, Error) -> - handle_disconnect(own, DisconnectMsg, State, Error); -handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, role = Role} = State0) -> - {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), - State = send_replies(disconnect_replies(Type, Msg, Replies), State0), - disconnect_fun(Desc, State#state.opts), - {stop, {shutdown, Desc}, State#state{connection_state = Connection}}. - -handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, - role = Role} = State0, ErrorMsg) -> - {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), - State = send_replies(disconnect_replies(Type, Msg, Replies), State0), - disconnect_fun(Desc, State#state.opts), - {stop, {shutdown, {Desc, ErrorMsg}}, State#state{connection_state = Connection}}. - -disconnect_replies(own, Msg, Replies) -> - [{connection_reply, Msg} | Replies]; -disconnect_replies(peer, _, Replies) -> - Replies. - + {Id, State#data{connection_state = + Connection#connection{channel_id_seed = Id + 1}}}. + +%%%---------------------------------------------------------------- +%% %%% This server/client has decided to disconnect via the state machine: +disconnect(Msg=#ssh_msg_disconnect{description=Description}, _StateName, State0) -> + State = send_msg(Msg, State0), + disconnect_fun(Description, State), +timer:sleep(400), + {stop, {shutdown,Description}, State}. + +%%%---------------------------------------------------------------- counterpart_versions(NumVsn, StrVsn, #ssh{role = server} = Ssh) -> Ssh#ssh{c_vsn = NumVsn , c_version = StrVsn}; counterpart_versions(NumVsn, StrVsn, #ssh{role = client} = Ssh) -> Ssh#ssh{s_vsn = NumVsn , s_version = StrVsn}. -opposite_role(client) -> - server; -opposite_role(server) -> - client. -connected_fun(User, PeerAddr, Method, Opts) -> - case proplists:get_value(connectfun, Opts) of - undefined -> - ok; - Fun -> - catch Fun(User, PeerAddr, Method) - end. - -retry_fun(_, _, undefined, _) -> - ok; - -retry_fun(User, PeerAddr, {error, Reason}, Opts) -> - case proplists:get_value(failfun, Opts) of - undefined -> - ok; - Fun -> - do_retry_fun(Fun, User, PeerAddr, Reason) - end; - -retry_fun(User, PeerAddr, Reason, Opts) -> - case proplists:get_value(infofun, Opts) of - undefined -> - ok; - Fun -> - do_retry_fun(Fun, User, PeerAddr, Reason) - end. - -do_retry_fun(Fun, User, PeerAddr, Reason) -> - case erlang:fun_info(Fun, arity) of - {arity, 2} -> %% Backwards compatible - catch Fun(User, Reason); - {arity, 3} -> - catch Fun(User, PeerAddr, Reason) - end. - ssh_info([], _State, Acc) -> Acc; -ssh_info([client_version | Rest], #state{ssh_params = #ssh{c_vsn = IntVsn, +ssh_info([client_version | Rest], #data{ssh_params = #ssh{c_vsn = IntVsn, c_version = StringVsn}} = State, Acc) -> ssh_info(Rest, State, [{client_version, {IntVsn, StringVsn}} | Acc]); -ssh_info([server_version | Rest], #state{ssh_params =#ssh{s_vsn = IntVsn, +ssh_info([server_version | Rest], #data{ssh_params =#ssh{s_vsn = IntVsn, s_version = StringVsn}} = State, Acc) -> ssh_info(Rest, State, [{server_version, {IntVsn, StringVsn}} | Acc]); -ssh_info([peer | Rest], #state{ssh_params = #ssh{peer = Peer}} = State, Acc) -> +ssh_info([peer | Rest], #data{ssh_params = #ssh{peer = Peer}} = State, Acc) -> ssh_info(Rest, State, [{peer, Peer} | Acc]); -ssh_info([sockname | Rest], #state{socket = Socket} = State, Acc) -> +ssh_info([sockname | Rest], #data{socket = Socket} = State, Acc) -> {ok, SockName} = inet:sockname(Socket), ssh_info(Rest, State, [{sockname, SockName}|Acc]); -ssh_info([user | Rest], #state{auth_user = User} = State, Acc) -> +ssh_info([user | Rest], #data{auth_user = User} = State, Acc) -> ssh_info(Rest, State, [{user, User}|Acc]); ssh_info([ _ | Rest], State, Acc) -> ssh_info(Rest, State, Acc). + ssh_channel_info([], _, Acc) -> Acc; @@ -1765,43 +1684,49 @@ ssh_channel_info([send_window | Rest], #channel{send_window_size = WinSize, ssh_channel_info([ _ | Rest], Channel, Acc) -> ssh_channel_info(Rest, Channel, Acc). + log_error(Reason) -> - Report = io_lib:format("Erlang ssh connection handler failed with reason: " - "~p ~n, Stacktrace: ~p ~n", - [Reason, erlang:get_stacktrace()]), - error_logger:error_report(Report), - "Internal error". - -not_connected_filter({connection_reply, _Data}) -> - true; -not_connected_filter(_) -> - false. - -send_replies([], State) -> - State; -send_replies([{connection_reply, Data} | Rest], #state{ssh_params = Ssh0} = State) -> - {Packet, Ssh} = ssh_transport:ssh_packet(Data, Ssh0), - send_msg(Packet, State), - send_replies(Rest, State#state{ssh_params = Ssh}); -send_replies([Msg | Rest], State) -> - catch send_reply(Msg), - send_replies(Rest, State). - -send_reply({channel_data, Pid, Data}) -> - Pid ! {ssh_cm, self(), Data}; -send_reply({channel_requst_reply, From, Data}) -> - gen_fsm:reply(From, Data); -send_reply({flow_control, Cache, Channel, From, Msg}) -> + Report = io_lib:format("Erlang ssh connection handler failed with reason:~n" + " ~p~n" + "Stacktrace:~n" + " ~p~n", + [Reason, erlang:get_stacktrace()]), + error_logger:error_report(Report). + + +%%%---------------------------------------------------------------- +not_connected_filter({connection_reply, _Data}) -> true; +not_connected_filter(_) -> false. + +%%%---------------------------------------------------------------- +send_replies(Repls, State) -> + lists:foldl(fun get_repl/2, + {[],State}, + Repls). + +get_repl({connection_reply,Msg}, {CallRepls,S}) -> + {CallRepls, send_msg(Msg,S)}; +get_repl({channel_data,undefined,_Data}, Acc) -> + Acc; +get_repl({channel_data,Pid,Data}, Acc) -> + Pid ! {ssh_cm, self(), Data}, + Acc; +get_repl({channel_request_reply,From,Data}, {CallRepls,S}) -> + {[{reply,From,Data}|CallRepls], S}; +get_repl({flow_control,Cache,Channel,From,Msg}, {CallRepls,S}) -> ssh_channel:cache_update(Cache, Channel#channel{flow_control = undefined}), - gen_fsm:reply(From, Msg); -send_reply({flow_control, From, Msg}) -> - gen_fsm:reply(From, Msg). + {[{reply,From,Msg}|CallRepls], S}; +get_repl({flow_control,From,Msg}, {CallRepls,S}) -> + {[{reply,From,Msg}|CallRepls], S}; +get_repl(noreply, Acc) -> + Acc; +get_repl(X, Acc) -> + exit({get_repl,X,Acc}). -disconnect_fun({disconnect,Msg}, Opts) -> - disconnect_fun(Msg, Opts); -disconnect_fun(_, undefined) -> - ok; -disconnect_fun(Reason, Opts) -> +%%%---------------------------------------------------------------- +disconnect_fun({disconnect,Msg}, D) -> + disconnect_fun(Msg, D); +disconnect_fun(Reason, #data{opts=Opts}) -> case proplists:get_value(disconnectfun, Opts) of undefined -> ok; @@ -1809,50 +1734,137 @@ disconnect_fun(Reason, Opts) -> catch Fun(Reason) end. -unexpected_fun(UnexpectedMessage, Opts, #ssh{peer={_,Peer}}) -> +unexpected_fun(UnexpectedMessage, #data{opts = Opts, + ssh_params = #ssh{peer = {_,Peer} } + } ) -> case proplists:get_value(unexpectedfun, Opts) of undefined -> report; Fun -> - catch Fun(UnexpectedMessage, Peer) + catch Fun(UnexpectedMessage, Peer) end. -check_cache(#state{opts = Opts} = State, Cache) -> - %% Check the number of entries in Cache - case proplists:get_value(size, ets:info(Cache)) of - 0 -> - case proplists:get_value(idle_time, Opts, infinity) of - infinity -> - State; - Time -> - handle_idle_timer(Time, State) - end; +debug_fun(#ssh_msg_debug{always_display = Display, + message = DbgMsg, + language = Lang}, + #data{opts = Opts}) -> + case proplists:get_value(ssh_msg_debug_fun, Opts) of + undefined -> + ok; + Fun -> + catch Fun(self(), Display, DbgMsg, Lang) + end. + + +connected_fun(User, Method, #data{ssh_params = #ssh{peer = {_,Peer}}, + opts = Opts}) -> + case proplists:get_value(connectfun, Opts) of + undefined -> + ok; + Fun -> + catch Fun(User, Peer, Method) + end. + +retry_fun(_, undefined, _) -> + ok; +retry_fun(User, Reason, #data{ssh_params = #ssh{opts = Opts, + peer = {_,Peer} + }}) -> + {Tag,Info} = + case Reason of + {error, Error} -> + {failfun, Error}; + _ -> + {infofun, Reason} + end, + Fun = proplists:get_value(Tag, Opts, fun(_,_)-> ok end), + try erlang:fun_info(Fun, arity) + of + {arity, 2} -> %% Backwards compatible + catch Fun(User, Info); + {arity, 3} -> + catch Fun(User, Peer, Info); _ -> - State + ok + catch + _:_ -> + ok + end. + +%%%---------------------------------------------------------------- +%%% Cache idle timer that closes the connection if there are no +%%% channels open for a while. + +cache_init_idle_timer(D) -> + case proplists:get_value(idle_time, D#data.opts, infinity) of + infinity -> + D#data{idle_timer_value = infinity, + idle_timer_ref = infinity % A flag used later... + }; + IdleTime -> + %% We dont want to set the timeout on first connect + D#data{idle_timer_value = IdleTime} end. -handle_idle_timer(Time, #state{idle_timer_ref = undefined} = State) -> - TimerRef = erlang:send_after(Time, self(), {'EXIT', [], "Timeout"}), - State#state{idle_timer_ref=TimerRef}; -handle_idle_timer(_, State) -> - State. - -remove_timer_ref(State) -> - case State#state.idle_timer_ref of - infinity -> %% If the timer is not activated - State; - undefined -> %% If we already has cancelled the timer - State; - TimerRef -> %% Timer is active + +cache_check_set_idle_timer(D = #data{idle_timer_ref = undefined, + idle_timer_value = IdleTime}) -> + %% No timer set - shall we set one? + case ssh_channel:cache_info(num_entries, cache(D)) of + 0 when IdleTime == infinity -> + %% No. Meaningless to set a timer that fires in an infinite time... + D; + 0 -> + %% Yes, we'll set one since the cache is empty and it should not + %% be that for a specified time + D#data{idle_timer_ref = + erlang:send_after(IdleTime, self(), {'EXIT',[],"Timeout"})}; + _ -> + %% No - there are entries in the cache + D + end; +cache_check_set_idle_timer(D) -> + %% There is already a timer set or the timeout time is infinite + D. + + +cache_cancel_idle_timer(D) -> + case D#data.idle_timer_ref of + infinity -> + %% The timer is not activated + D; + undefined -> + %% The timer is already cancelled + D; + TimerRef -> + %% The timer is active erlang:cancel_timer(TimerRef), - State#state{idle_timer_ref = undefined} + D#data{idle_timer_ref = undefined} end. -socket_control(Socket, Pid, Transport) -> - case Transport:controlling_process(Socket, Pid) of + +cache_request_idle_timer_check(D = #data{idle_timer_value = infinity}) -> + D; +cache_request_idle_timer_check(D = #data{idle_timer_value = IdleTime}) -> + erlang:send_after(IdleTime, self(), check_cache), + D. + +%%%---------------------------------------------------------------- +start_channel_request_timer(_,_, infinity) -> + ok; +start_channel_request_timer(Channel, From, Time) -> + erlang:send_after(Time, self(), {timeout, {Channel, From}}). + +%%%---------------------------------------------------------------- +%%% Connection start and initalization helpers + +socket_control(Socket, Pid, Options) -> + {_, TransportCallback, _} = % For example {_,gen_tcp,_} + proplists:get_value(transport, Options, ?DefaultTransport), + case TransportCallback:controlling_process(Socket, Pid) of ok -> - send_event(Pid, socket_control); + gen_statem:cast(Pid, socket_control); {error, Reason} -> {error, Reason} end. @@ -1881,16 +1893,3 @@ handshake(Pid, Ref, Timeout) -> {error, timeout} end. -start_timeout(_,_, infinity) -> - ok; -start_timeout(Channel, From, Time) -> - erlang:send_after(Time, self(), {timeout, {Channel, From}}). - -getopt(Opt, Socket) -> - case inet:getopts(Socket, [Opt]) of - {ok, [{Opt, Value}]} -> - {ok, Value}; - Other -> - {error, {unexpected_getopts_return, Other}} - end. - diff --git a/lib/ssh/src/ssh_info.erl b/lib/ssh/src/ssh_info.erl index 67130d5eac..0c24c09887 100644 --- a/lib/ssh/src/ssh_info.erl +++ b/lib/ssh/src/ssh_info.erl @@ -37,7 +37,7 @@ print() -> io:format("~s", [string()]). print(File) when is_list(File) -> - {ok,D} = file:open(File, write), + {ok,D} = file:open(File, [write]), print(D), file:close(D); print(D) -> diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index 65754956aa..db80d4c9e3 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -50,13 +50,7 @@ -define(Empint(X), (ssh_bits:mpint(X))/binary ). -define(Ebinary(X), ?STRING(X) ). -%% encode(Msg) -> -%% try encode1(Msg) -%% catch -%% C:E -> -%% io:format('***********************~n~p:~p ~p~n',[C,E,Msg]), -%% error(E) -%% end. +-define(unicode_list(B), unicode:characters_to_list(B)). encode(#ssh_msg_global_request{ name = Name, @@ -176,7 +170,7 @@ encode(#ssh_msg_userauth_pk_ok{ encode(#ssh_msg_userauth_passwd_changereq{prompt = Prompt, languge = Lang })-> - <<?Ebyte(?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ), ?Estring(Prompt), ?Estring(Lang)>>; + <<?Ebyte(?SSH_MSG_USERAUTH_PASSWD_CHANGEREQ), ?Estring_utf8(Prompt), ?Estring(Lang)>>; encode(#ssh_msg_userauth_info_request{ name = Name, @@ -184,14 +178,14 @@ encode(#ssh_msg_userauth_info_request{ language_tag = Lang, num_prompts = NumPromtps, data = Data}) -> - <<?Ebyte(?SSH_MSG_USERAUTH_INFO_REQUEST), ?Estring(Name), ?Estring(Inst), ?Estring(Lang), + <<?Ebyte(?SSH_MSG_USERAUTH_INFO_REQUEST), ?Estring_utf8(Name), ?Estring_utf8(Inst), ?Estring(Lang), ?Euint32(NumPromtps), ?'E...'(Data)>>; encode(#ssh_msg_userauth_info_response{ num_responses = Num, data = Data}) -> lists:foldl(fun %%("", Acc) -> Acc; % commented out since it seem wrong - (Response, Acc) -> <<Acc/binary, ?Estring(Response)>> + (Response, Acc) -> <<Acc/binary, ?Estring_utf8(Response)>> end, <<?Ebyte(?SSH_MSG_USERAUTH_INFO_RESPONSE), ?Euint32(Num)>>, Data); @@ -201,17 +195,17 @@ encode(#ssh_msg_disconnect{ description = Desc, language = Lang }) -> - <<?Ebyte(?SSH_MSG_DISCONNECT), ?Euint32(Code), ?Estring(Desc), ?Estring(Lang)>>; + <<?Ebyte(?SSH_MSG_DISCONNECT), ?Euint32(Code), ?Estring_utf8(Desc), ?Estring(Lang)>>; encode(#ssh_msg_service_request{ name = Service }) -> - <<?Ebyte(?SSH_MSG_SERVICE_REQUEST), ?Estring(Service)>>; + <<?Ebyte(?SSH_MSG_SERVICE_REQUEST), ?Estring_utf8(Service)>>; encode(#ssh_msg_service_accept{ name = Service }) -> - <<?Ebyte(?SSH_MSG_SERVICE_ACCEPT), ?Estring(Service)>>; + <<?Ebyte(?SSH_MSG_SERVICE_ACCEPT), ?Estring_utf8(Service)>>; encode(#ssh_msg_newkeys{}) -> <<?Ebyte(?SSH_MSG_NEWKEYS)>>; @@ -283,7 +277,7 @@ encode(#ssh_msg_kex_ecdh_reply{public_host_key = Key, q_s = Q_s, h_sig = Sign}) <<?Ebyte(?SSH_MSG_KEX_ECDH_REPLY), ?Ebinary(EncKey), ?Empint(Q_s), ?Ebinary(EncSign)>>; encode(#ssh_msg_ignore{data = Data}) -> - <<?Ebyte(?SSH_MSG_IGNORE), ?Estring(Data)>>; + <<?Ebyte(?SSH_MSG_IGNORE), ?Estring_utf8(Data)>>; encode(#ssh_msg_unimplemented{sequence = Seq}) -> <<?Ebyte(?SSH_MSG_UNIMPLEMENTED), ?Euint32(Seq)>>; @@ -291,7 +285,7 @@ encode(#ssh_msg_unimplemented{sequence = Seq}) -> encode(#ssh_msg_debug{always_display = Bool, message = Msg, language = Lang}) -> - <<?Ebyte(?SSH_MSG_DEBUG), ?Eboolean(Bool), ?Estring(Msg), ?Estring(Lang)>>. + <<?Ebyte(?SSH_MSG_DEBUG), ?Eboolean(Bool), ?Estring_utf8(Msg), ?Estring(Lang)>>. %% Connection Messages @@ -330,7 +324,7 @@ decode(<<?BYTE(?SSH_MSG_CHANNEL_OPEN_FAILURE), ?UINT32(Recipient), ?UINT32(Reas #ssh_msg_channel_open_failure{ recipient_channel = Recipient, reason = Reason, - description = unicode:characters_to_list(Desc), + description = ?unicode_list(Desc), lang = Lang }; decode(<<?BYTE(?SSH_MSG_CHANNEL_WINDOW_ADJUST), ?UINT32(Recipient), ?UINT32(Bytes)>>) -> @@ -363,7 +357,7 @@ decode(<<?BYTE(?SSH_MSG_CHANNEL_REQUEST), ?UINT32(Recipient), ?DEC_BIN(RequestType,__0), ?BYTE(Bool), Data/binary>>) -> #ssh_msg_channel_request{ recipient_channel = Recipient, - request_type = unicode:characters_to_list(RequestType), + request_type = ?unicode_list(RequestType), want_reply = erl_boolean(Bool), data = Data }; @@ -381,9 +375,9 @@ decode(<<?BYTE(?SSH_MSG_USERAUTH_REQUEST), ?DEC_BIN(User,__0), ?DEC_BIN(Service,__1), ?DEC_BIN(Method,__2), Data/binary>>) -> #ssh_msg_userauth_request{ - user = unicode:characters_to_list(User), - service = unicode:characters_to_list(Service), - method = unicode:characters_to_list(Method), + user = ?unicode_list(User), + service = ?unicode_list(Service), + method = ?unicode_list(Method), data = Data }; @@ -391,7 +385,7 @@ decode(<<?BYTE(?SSH_MSG_USERAUTH_FAILURE), ?DEC_BIN(Auths,__0), ?BYTE(Bool)>>) -> #ssh_msg_userauth_failure { - authentications = unicode:characters_to_list(Auths), + authentications = ?unicode_list(Auths), partial_success = erl_boolean(Bool) }; @@ -493,18 +487,18 @@ decode(<<"ecdh",?BYTE(?SSH_MSG_KEX_ECDH_REPLY), decode(<<?SSH_MSG_SERVICE_REQUEST, ?DEC_BIN(Service,__0)>>) -> #ssh_msg_service_request{ - name = unicode:characters_to_list(Service) + name = ?unicode_list(Service) }; decode(<<?SSH_MSG_SERVICE_ACCEPT, ?DEC_BIN(Service,__0)>>) -> #ssh_msg_service_accept{ - name = unicode:characters_to_list(Service) + name = ?unicode_list(Service) }; decode(<<?BYTE(?SSH_MSG_DISCONNECT), ?UINT32(Code), ?DEC_BIN(Desc,__0), ?DEC_BIN(Lang,__1)>>) -> #ssh_msg_disconnect{ code = Code, - description = unicode:characters_to_list(Desc), + description = ?unicode_list(Desc), language = Lang }; @@ -512,7 +506,7 @@ decode(<<?BYTE(?SSH_MSG_DISCONNECT), ?UINT32(Code), ?DEC_BIN(Desc,__0), ?DEC_BIN decode(<<?BYTE(?SSH_MSG_DISCONNECT), ?UINT32(Code), ?DEC_BIN(Desc,__0)>>) -> #ssh_msg_disconnect{ code = Code, - description = unicode:characters_to_list(Desc), + description = ?unicode_list(Desc), language = <<"en">> }; @@ -554,7 +548,7 @@ decode_kex_init(<<?BYTE(Bool)>>, Acc, 0) -> X = 0, list_to_tuple(lists:reverse([X, erl_boolean(Bool) | Acc])); decode_kex_init(<<?DEC_BIN(Data,__0), Rest/binary>>, Acc, N) -> - Names = string:tokens(unicode:characters_to_list(Data), ","), + Names = string:tokens(?unicode_list(Data), ","), decode_kex_init(Rest, [Names | Acc], N -1). diff --git a/lib/ssh/src/ssh_no_io.erl b/lib/ssh/src/ssh_no_io.erl index 8144aac66e..1da257ed99 100644 --- a/lib/ssh/src/ssh_no_io.erl +++ b/lib/ssh/src/ssh_no_io.erl @@ -27,27 +27,39 @@ -export([yes_no/2, read_password/2, read_line/2, format/2]). + +-spec yes_no(any(), any()) -> no_return(). + yes_no(_, _) -> - throw({{no_io_allowed, yes_no}, - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "User interaction is not allowed", - language = "en"}}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "User interaction is not allowed"}, + {no_io_allowed, yes_no}). + + +-spec read_password(any(), any()) -> no_return(). read_password(_, _) -> - throw({{no_io_allowed, read_password}, - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "User interaction is not allowed", - language = "en"}}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "User interaction is not allowed"}, + {no_io_allowed, read_password}). + + +-spec read_line(any(), any()) -> no_return(). read_line(_, _) -> - throw({{no_io_allowed, read_line}, - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "User interaction is not allowed", - language = "en"}} ). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "User interaction is not allowed"}, + {no_io_allowed, read_line}). + + +-spec format(any(), any()) -> no_return(). format(_, _) -> - throw({{no_io_allowed, format}, - #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, - description = "User interaction is not allowed", - language = "en"}}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "User interaction is not allowed"}, + {no_io_allowed, format}). diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index 6314671f0d..9a9786a914 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -192,6 +192,9 @@ stop_acceptor(Sup) -> [{Name, AcceptorSup}] = [{SupName, ASup} || {SupName, ASup, _, [ssh_acceptor_sup]} <- supervisor:which_children(Sup)], - supervisor:terminate_child(AcceptorSup, Name). - - + case supervisor:terminate_child(AcceptorSup, Name) of + ok -> + supervisor:delete_child(AcceptorSup, Name); + Error -> + Error + end. diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index c04bd350c7..7cb3b75ac0 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -265,7 +265,8 @@ new_keys_message(Ssh0) -> {SshPacket, Ssh} = ssh_packet(#ssh_msg_newkeys{}, Ssh0), {ok, SshPacket, Ssh}. - + + handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, #ssh{role = client} = Ssh0) -> {ok, Algoritms} = select_algorithm(client, Own, CounterPart), @@ -275,10 +276,10 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, Ssh0#ssh{algorithms = Algoritms}); _ -> %% TODO: Correct code? - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Selection of key exchange" - " algorithm failed", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Selection of key exchange algorithm failed" + }) end; handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, @@ -288,10 +289,10 @@ handle_kexinit_msg(#ssh_msg_kexinit{} = CounterPart, #ssh_msg_kexinit{} = Own, true -> {ok, Ssh#ssh{algorithms = Algoritms}}; _ -> - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Selection of key exchange" - " algorithm failed", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Selection of key exchange algorithm failed" + }) end. @@ -371,12 +372,12 @@ handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, session_id = sid(Ssh1, H)}}; true -> - throw({{error,bad_e_from_peer}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'e' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'e' out of bounds"}, + {error,bad_e_from_peer} + ) end. handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = PeerPubHostKey, @@ -396,21 +397,20 @@ handle_kexdh_reply(#ssh_msg_kexdh_reply{public_host_key = PeerPubHostKey, exchanged_hash = H, session_id = sid(Ssh, H)}}; Error -> - throw({Error, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed", - language = "en"} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed"}, + Error) end; true -> - throw({{error,bad_f_from_peer}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'f' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'f' out of bounds"}, + bad_f_from_peer + ) end. @@ -435,10 +435,11 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request{min = Min0, keyex_info = {Min, Max, NBits} }}; {error,_} -> - throw(#ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "No possible diffie-hellman-group-exchange group found", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "No possible diffie-hellman-group-exchange group found" + }) end; handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits}, @@ -469,19 +470,19 @@ handle_kex_dh_gex_request(#ssh_msg_kex_dh_gex_request_old{n = NBits}, keyex_info = {-1, -1, NBits} % flag for kex_h hash calc }}; {error,_} -> - throw(#ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "No possible diffie-hellman-group-exchange group found", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "No possible diffie-hellman-group-exchange group found" + }) end; handle_kex_dh_gex_request(_, _) -> - throw({{error,bad_ssh_msg_kex_dh_gex_request}, + ssh_connection_handler:disconnect( #ssh_msg_disconnect{ code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, bad values in ssh_msg_kex_dh_gex_request", - language = ""} - }). + description = "Key exchange failed, bad values in ssh_msg_kex_dh_gex_request"}, + bad_ssh_msg_kex_dh_gex_request). adjust_gex_min_max(Min0, Max0, Opts) -> @@ -495,10 +496,11 @@ adjust_gex_min_max(Min0, Max0, Opts) -> Min2 =< Max2 -> {Min2, Max2}; Max2 < Min2 -> - throw(#ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "No possible diffie-hellman-group-exchange group possible", - language = ""}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "No possible diffie-hellman-group-exchange group possible" + }) end end. @@ -535,20 +537,18 @@ handle_kex_dh_gex_init(#ssh_msg_kex_dh_gex_init{e = E}, session_id = sid(Ssh, H) }}; true -> - throw({{error,bad_K}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'K' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'K' out of bounds"}, + bad_K) end; true -> - throw({{error,bad_e_from_peer}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'e' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'e' out of bounds"}, + bad_e_from_peer) end. handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = PeerPubHostKey, @@ -572,29 +572,28 @@ handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = PeerPubHostK exchanged_hash = H, session_id = sid(Ssh, H)}}; _Error -> - throw(#ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed", - language = ""} - ) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed" + }) end; true -> - throw({{error,bad_K}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'K' out of bounds", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'K' out of bounds"}, + bad_K) end; true -> - throw({{error,bad_f_from_peer}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed, 'f' out of bounds", - language = ""} - }) - end. + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed, 'f' out of bounds"}, + bad_f_from_peer + ) + end. %%%---------------------------------------------------------------- %%% @@ -624,12 +623,11 @@ handle_kex_ecdh_init(#ssh_msg_kex_ecdh_init{q_c = PeerPublic}, session_id = sid(Ssh1, H)}} catch _:_ -> - throw({{error,invalid_peer_public_key}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Peer ECDH public key is invalid", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Peer ECDH public key is invalid"}, + invalid_peer_public_key) end. handle_kex_ecdh_reply(#ssh_msg_kex_ecdh_reply{public_host_key = PeerPubHostKey, @@ -650,21 +648,19 @@ handle_kex_ecdh_reply(#ssh_msg_kex_ecdh_reply{public_host_key = PeerPubHostKey, exchanged_hash = H, session_id = sid(Ssh, H)}}; Error -> - throw({Error, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Key exchange failed", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Key exchange failed"}, + Error) end catch _:_ -> - throw({{error,invalid_peer_public_key}, - #ssh_msg_disconnect{ - code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, - description = "Peer ECDH public key is invalid", - language = ""} - }) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{ + code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, + description = "Peer ECDH public key is invalid"}, + invalid_peer_public_key) end. @@ -675,9 +671,10 @@ handle_new_keys(#ssh_msg_newkeys{}, Ssh0) -> {ok, Ssh} catch _C:_Error -> %% TODO: Throw earlier .... - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = "Install alg failed", - language = "en"}) + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Install alg failed" + }) end. %% select session id @@ -929,9 +926,9 @@ select_all(CL, SL) when length(CL) + length(SL) < ?MAX_NUM_ALGORITHMS -> lists:map(fun(ALG) -> list_to_atom(ALG) end, (CL -- A)); select_all(CL, SL) -> Err = lists:concat(["Received too many algorithms (",length(CL),"+",length(SL)," >= ",?MAX_NUM_ALGORITHMS,")."]), - throw(#ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, - description = Err, - language = ""}). + ssh_connection_handler:disconnect( + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = Err}). select([], []) -> @@ -1042,7 +1039,7 @@ handle_packet_part(DecryptedPfx, EncryptedBuffer, TotalNeeded, {bad_mac, Ssh1}; true -> {Ssh, DecompressedPayload} = decompress(Ssh1, payload(DecryptedPacket)), - {decoded, DecompressedPayload, NextPacketBytes, Ssh} + {packet_decrypted, DecompressedPayload, NextPacketBytes, Ssh} end; aead -> PacketLenBin = DecryptedPfx, @@ -1052,7 +1049,7 @@ handle_packet_part(DecryptedPfx, EncryptedBuffer, TotalNeeded, {Ssh1, DecryptedSfx} -> DecryptedPacket = <<DecryptedPfx/binary, DecryptedSfx/binary>>, {Ssh, DecompressedPayload} = decompress(Ssh1, payload(DecryptedPacket)), - {decoded, DecompressedPayload, NextPacketBytes, Ssh} + {packet_decrypted, DecompressedPayload, NextPacketBytes, Ssh} end end. diff --git a/lib/ssh/src/sshc_sup.erl b/lib/ssh/src/sshc_sup.erl index 5667fd2aec..71b5c2c46a 100644 --- a/lib/ssh/src/sshc_sup.erl +++ b/lib/ssh/src/sshc_sup.erl @@ -64,7 +64,7 @@ child_spec(_) -> Name = undefined, % As simple_one_for_one is used. StartFunc = {ssh_connection_handler, start_link, []}, Restart = temporary, - Shutdown = infinity, + Shutdown = 4000, Modules = [ssh_connection_handler], - Type = supervisor, + Type = worker, {Name, StartFunc, Restart, Shutdown, Type, Modules}. diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 4ecc662c13..6ce6d6f537 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -55,6 +55,7 @@ MODULES= \ ssh_relay HRL_FILES_NEEDED_IN_TEST= \ + $(ERL_TOP)/lib/ssh/test/ssh_test_lib.hrl \ $(ERL_TOP)/lib/ssh/src/ssh.hrl \ $(ERL_TOP)/lib/ssh/src/ssh_xfer.hrl diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index bdc980e65c..9910b8f1d7 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -192,7 +192,7 @@ simple_exec_groups_no_match_too_large(Config) -> %%-------------------------------------------------------------------- %% Testing all default groups -simple_exec_groups() -> [{timetrap,{seconds,180}}]. +simple_exec_groups() -> [{timetrap,{minutes,5}}]. simple_exec_groups(Config) -> Sizes = interpolate( public_key:dh_gex_group_sizes() ), @@ -226,28 +226,13 @@ sshc_simple_exec(Config) -> KnownHosts = filename:join(PrivDir, "known_hosts"), {Host,Port} = ?config(srvr_addr, Config), Cmd = lists:concat(["ssh -p ",Port, - " -C -o UserKnownHostsFile=",KnownHosts, + " -C", + " -o UserKnownHostsFile=",KnownHosts, + " -o StrictHostKeyChecking=no", " ",Host," 1+1."]), ct:log("~p",[Cmd]), - SshPort = open_port({spawn, Cmd}, [binary]), - Expect = <<"2\n">>, - rcv_expected(SshPort, Expect). - - -rcv_expected(SshPort, Expect) -> - receive - {SshPort, {data,Expect}} -> - ct:log("Got expected ~p from ~p",[Expect,SshPort]), - catch port_close(SshPort), - ok; - Other -> - ct:log("Got UNEXPECTED ~p",[Other]), - rcv_expected(SshPort, Expect) - - after ?TIMEOUT -> - catch port_close(SshPort), - ct:fail("Did not receive answer") - end. + OpenSsh = ssh_test_lib:open_port({spawn, Cmd}, [eof,exit_status]), + ssh_test_lib:rcv_expected({data,<<"2\n">>}, OpenSsh, ?TIMEOUT). %%-------------------------------------------------------------------- %% Connect to the ssh server of the OS @@ -361,13 +346,15 @@ get_atoms(L) -> %%% Test case related %%% start_std_daemon(Opts, Config) -> + ct:log("starting std_daemon",[]), {Pid, Host, Port} = ssh_test_lib:std_daemon(Config, Opts), ct:log("started ~p:~p ~p",[Host,Port,Opts]), [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config]. -start_pubkey_daemon(Opts, Config) -> +start_pubkey_daemon(Opts0, Config) -> + Opts = [{auth_methods,"publickey"}|Opts0], {Pid, Host, Port} = ssh_test_lib:std_daemon1(Config, Opts), - ct:log("started1 ~p:~p ~p",[Host,Port,Opts]), + ct:log("started pubkey_daemon ~p:~p ~p",[Host,Port,Opts]), [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config]. diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl index 6e1d18cc95..d9be1a32b7 100644 --- a/lib/ssh/test/ssh_benchmark_SUITE.erl +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -333,52 +333,64 @@ find_time(accept_to_hello, L) -> [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) -> C#call.t_call end, - fun(C=#call{mfa = {ssh_connection_handler,hello,_}, - args = [socket_control|_]}) -> - C#call.t_return - end + ?LINE, + fun(C=#call{mfa = {ssh_connection_handler,handle_event,4}, + args = [_, {version_exchange,_}, {hello,_}, _]}) -> + C#call.t_call + end, + ?LINE ], L, []), {accept_to_hello, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(kex, L) -> - [T0,T1] = find([fun(C=#call{mfa = {ssh_connection_handler,hello,_}, - args = [socket_control|_]}) -> + [T0,T1] = find([fun(C=#call{mfa = {ssh_connection_handler,handle_event,4}, + args = [_, {version_exchange,_}, {hello,_}, _]}) -> C#call.t_call end, - ?send(#ssh_msg_newkeys{}) + ?LINE, + ?send(#ssh_msg_newkeys{}), + ?LINE ], L, []), {kex, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(kex_to_auth, L) -> [T0,T1] = find([?send(#ssh_msg_newkeys{}), - ?recv(#ssh_msg_userauth_request{}) + ?LINE, + ?recv(#ssh_msg_userauth_request{}), + ?LINE ], L, []), {kex_to_auth, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(auth, L) -> [T0,T1] = find([?recv(#ssh_msg_userauth_request{}), - ?send(#ssh_msg_userauth_success{}) + ?LINE, + ?send(#ssh_msg_userauth_success{}), + ?LINE ], L, []), {auth, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(to_prompt, L) -> [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) -> C#call.t_call end, - ?recv(#ssh_msg_channel_request{request_type="env"}) + ?LINE, + ?recv(#ssh_msg_channel_request{request_type="env"}), + ?LINE ], L, []), {to_prompt, now2micro_sec(now_diff(T1,T0)), microsec}; find_time(channel_open_close, L) -> [T0,T1] = find([?recv(#ssh_msg_channel_request{request_type="subsystem"}), - ?send(#ssh_msg_channel_close{}) + ?LINE, + ?send(#ssh_msg_channel_close{}), + ?LINE ], L, []), {channel_open_close, now2micro_sec(now_diff(T1,T0)), microsec}. -find([F|Fs], [C|Cs], Acc) when is_function(F,1) -> +find([F,Id|Fs], [C|Cs], Acc) when is_function(F,1) -> try F(C) of T -> find(Fs, Cs, [T|Acc]) catch - _:_ -> find([F|Fs], Cs, Acc) + _:_ -> find([F,Id|Fs], Cs, Acc) end; find([], _, Acc) -> lists:reverse(Acc). @@ -444,7 +456,7 @@ erlang_trace() -> 0 = erlang:trace(new, true, [call,timestamp,{tracer,TracerPid}]), [init_trace(MFA, tp(MFA)) || MFA <- [{ssh_acceptor,handle_connection,5}, - {ssh_connection_handler,hello,2}, +%% {ssh_connection_handler,hello,2}, {ssh_message,encode,1}, {ssh_message,decode,1}, {ssh_transport,select_algorithm,3}, @@ -454,6 +466,10 @@ erlang_trace() -> {ssh_message,decode,1}, {public_key,dh_gex_group,4} % To find dh_gex group size ]], + init_trace({ssh_connection_handler,handle_event,4}, + [{['_', {version_exchange,'_'}, {hello,'_'}, '_'], + [], + [return_trace]}]), {ok, TracerPid}. tp({_M,_F,Arity}) -> diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index a5f424f863..0f757a0322 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -23,6 +23,7 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("ssh/src/ssh_connect.hrl"). +-include("ssh_test_lib.hrl"). -compile(export_all). @@ -655,15 +656,21 @@ max_channels_option(Config) when is_list(Config) -> {user_interaction, true}, {user_dir, UserDir}]), + %% Allocate a number of ChannelId:s to play with. (This operation is not + %% counted by the max_channel option). {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId1} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId2} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId3} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId4} = ssh_connection:session_channel(ConnectionRef, infinity), {ok, ChannelId5} = ssh_connection:session_channel(ConnectionRef, infinity), - {ok, _ChannelId6} = ssh_connection:session_channel(ConnectionRef, infinity), + {ok, ChannelId6} = ssh_connection:session_channel(ConnectionRef, infinity), + {ok, _ChannelId7} = ssh_connection:session_channel(ConnectionRef, infinity), - %%%---- shell + %% Now start to open the channels (this is counted my max_channels) to check that + %% it gives a failure at right place + + %%%---- Channel 1(3): shell ok = ssh_connection:shell(ConnectionRef,ChannelId0), receive {ssh_cm,ConnectionRef, {data, ChannelId0, 0, <<"Eshell",_/binary>>}} -> @@ -672,10 +679,10 @@ max_channels_option(Config) when is_list(Config) -> ct:fail("CLI Timeout") end, - %%%---- subsystem "echo_n" + %%%---- Channel 2(3): subsystem "echo_n" success = ssh_connection:subsystem(ConnectionRef, ChannelId1, "echo_n", infinity), - %%%---- exec #1 + %%%---- Channel 3(3): exec. This closes itself. success = ssh_connection:exec(ConnectionRef, ChannelId2, "testing1.\n", infinity), receive {ssh_cm, ConnectionRef, {data, ChannelId2, 0, <<"testing1",_/binary>>}} -> @@ -684,13 +691,13 @@ max_channels_option(Config) when is_list(Config) -> ct:fail("Exec #1 Timeout") end, - %%%---- ptty - success = ssh_connection:ptty_alloc(ConnectionRef, ChannelId3, []), + %%%---- Channel 3(3): subsystem "echo_n" (Note that ChannelId2 should be closed now) + ?wait_match(success, ssh_connection:subsystem(ConnectionRef, ChannelId3, "echo_n", infinity)), - %%%---- exec #2 + %%%---- Channel 4(3) !: exec This should fail failure = ssh_connection:exec(ConnectionRef, ChannelId4, "testing2.\n", infinity), - %%%---- close the shell + %%%---- close the shell (Frees one channel) ok = ssh_connection:send(ConnectionRef, ChannelId0, "exit().\n", 5000), %%%---- wait for the subsystem to terminate @@ -703,14 +710,11 @@ max_channels_option(Config) when is_list(Config) -> ct:fail("exit Timeout",[]) end, - %%%---- exec #3 - success = ssh_connection:exec(ConnectionRef, ChannelId5, "testing3.\n", infinity), - receive - {ssh_cm, ConnectionRef, {data, ChannelId5, 0, <<"testing3",_/binary>>}} -> - ok - after 5000 -> - ct:fail("Exec #3 Timeout") - end, + %%---- Try that we can open one channel instead of the closed one + ?wait_match(success, ssh_connection:subsystem(ConnectionRef, ChannelId5, "echo_n", infinity)), + + %%---- But not a fourth one... + failure = ssh_connection:subsystem(ConnectionRef, ChannelId6, "echo_n", infinity), ssh:close(ConnectionRef), ssh:stop_daemon(Pid). diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 1d14a16065..4ca6a473fa 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -51,9 +51,7 @@ ssh_connect_arg4_timeout/1, ssh_connect_negtimeout_parallel/1, ssh_connect_negtimeout_sequential/1, - ssh_connect_nonegtimeout_connected_parallel/0, ssh_connect_nonegtimeout_connected_parallel/1, - ssh_connect_nonegtimeout_connected_sequential/0, ssh_connect_nonegtimeout_connected_sequential/1, ssh_connect_timeout/1, connect/4, ssh_daemon_minimal_remote_max_packet_size_option/1, @@ -82,7 +80,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{seconds,40}}]. + {timetrap,{seconds,30}}]. all() -> [connectfun_disconnectfun_server, @@ -493,7 +491,7 @@ ssh_msg_debug_fun_option_client(Config) -> {user_interaction, false}, {ssh_msg_debug_fun,DbgFun}]), %% Beware, implementation knowledge: - gen_fsm:send_all_state_event(ConnectionRef,{ssh_msg_debug,false,<<"Hello">>,<<>>}), + gen_statem:cast(ConnectionRef,{ssh_msg_debug,false,<<"Hello">>,<<>>}), receive {msg_dbg,X={ConnectionRef,false,<<"Hello">>,<<>>}} -> ct:log("Got expected dbg msg ~p",[X]), @@ -606,7 +604,7 @@ ssh_msg_debug_fun_option_server(Config) -> receive {connection_pid,Server} -> %% Beware, implementation knowledge: - gen_fsm:send_all_state_event(Server,{ssh_msg_debug,false,<<"Hello">>,<<>>}), + gen_statem:cast(Server,{ssh_msg_debug,false,<<"Hello">>,<<>>}), receive {msg_dbg,X={_,false,<<"Hello">>,<<>>}} -> ct:log("Got expected dbg msg ~p",[X]), @@ -982,16 +980,10 @@ ssh_connect_negtimeout(Config, Parallel) -> %%-------------------------------------------------------------------- %%% Test that ssh connection does not timeout if the connection is established (parallel) - -ssh_connect_nonegtimeout_connected_parallel() -> [{timetrap,{seconds,90}}]. - ssh_connect_nonegtimeout_connected_parallel(Config) -> ssh_connect_nonegtimeout_connected(Config, true). %%% Test that ssh connection does not timeout if the connection is established (non-parallel) - -ssh_connect_nonegtimeout_connected_sequential() -> [{timetrap,{seconds,90}}]. - ssh_connect_nonegtimeout_connected_sequential(Config) -> ssh_connect_nonegtimeout_connected(Config, false). @@ -1000,7 +992,7 @@ ssh_connect_nonegtimeout_connected(Config, Parallel) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), - NegTimeOut = 20000, % ms + NegTimeOut = 2000, % ms ct:log("Parallel: ~p",[Parallel]), {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, @@ -1131,21 +1123,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> %% This is expected %% Now stop one connection and try to open one more ok = ssh:close(hd(Connections)), - receive after 250 -> ok end, % sleep so the supervisor has time to count down. Not nice... - try Connect(Host,Port) - of - _ConnectionRef1 -> - %% Step 3 ok: could set up one more connection after killing one - %% Thats good. - ssh:stop_daemon(Pid), - ok - catch - error:{badmatch,{error,"Connection closed"}} -> - %% Bad indeed. Could not set up one more connection even after killing - %% one existing. Very bad. - ssh:stop_daemon(Pid), - {fail,"Does not decrease # active sessions"} - end + try_to_connect(Connect, Host, Port, Pid) end catch error:{badmatch,{error,"Connection closed"}} -> @@ -1153,6 +1131,35 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> {fail,"Too few connections accepted"} end. + +try_to_connect(Connect, Host, Port, Pid) -> + {ok,Tref} = timer:send_after(3000, timeout_no_connection), % give the supervisors some time... + try_to_connect(Connect, Host, Port, Pid, Tref, 1). % will take max 3300 ms after 11 tries + +try_to_connect(Connect, Host, Port, Pid, Tref, N) -> + try Connect(Host,Port) + of + _ConnectionRef1 -> + %% Step 3 ok: could set up one more connection after killing one + %% Thats good. + timer:cancel(Tref), + ssh:stop_daemon(Pid), + receive % flush. + timeout_no_connection -> ok + after 0 -> ok + end + catch + error:{badmatch,{error,"Connection closed"}} -> + %% Could not set up one more connection. Try again until timeout. + receive + timeout_no_connection -> + ssh:stop_daemon(Pid), + {fail,"Does not decrease # active sessions"} + after N*50 -> % retry after this time + try_to_connect(Connect, Host, Port, Pid, Tref, N+1) + end + end. + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_renegotiate_SUITE.erl b/lib/ssh/test/ssh_renegotiate_SUITE.erl index 90132becbd..f1a909cbd0 100644 --- a/lib/ssh/test/ssh_renegotiate_SUITE.erl +++ b/lib/ssh/test/ssh_renegotiate_SUITE.erl @@ -33,7 +33,6 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{seconds,40}}]. - all() -> [{group,default_algs}, {group,aes_gcm} ]. @@ -238,7 +237,7 @@ renegotiate2(Config) -> %% get_kex_init - helper function to get key_exchange_init_msg get_kex_init(Conn) -> %% First, validate the key exchange is complete (StateName == connected) - {connected,S} = sys:get_state(Conn), + {{connected,_},S} = sys:get_state(Conn), %% Next, walk through the elements of the #state record looking %% for the #ssh_msg_kexinit record. This method is robust against %% changes to either record. The KEXINIT message contains a cookie diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index cd6c5f82b9..f6d7be41d6 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -38,7 +38,6 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{seconds,40}}]. - all() -> [{group, not_unicode}, {group, unicode} @@ -301,9 +300,9 @@ end_per_testcase(_, Config) -> end_per_testcase(Config) -> {Sftp, Connection} = ?config(sftp, Config), - ssh_sftp:stop_channel(Sftp), + ok = ssh_sftp:stop_channel(Sftp), catch ssh_sftp:stop_channel(?config(channel_pid2, Config)), - ssh:close(Connection). + ok = ssh:close(Connection). %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- @@ -365,7 +364,7 @@ write_file(Config) when is_list(Config) -> {Sftp, _} = ?config(sftp, Config), Data = list_to_binary("Hej hopp!"), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Data} = file:read_file(FileName). %%-------------------------------------------------------------------- @@ -378,7 +377,7 @@ write_file_iolist(Config) when is_list(Config) -> Data = list_to_binary("Hej hopp!"), lists:foreach( fun(D) -> - ssh_sftp:write_file(Sftp, FileName, [D]), + ok = ssh_sftp:write_file(Sftp, FileName, [D]), Expected = if is_binary(D) -> D; is_list(D) -> list_to_binary(D) end, @@ -397,7 +396,7 @@ write_big_file(Config) when is_list(Config) -> {Sftp, _} = ?config(sftp, Config), Data = list_to_binary(lists:duplicate(750000,"a")), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Data} = file:read_file(FileName). %%-------------------------------------------------------------------- @@ -409,7 +408,7 @@ sftp_read_big_file(Config) when is_list(Config) -> Data = list_to_binary(lists:duplicate(750000,"a")), ct:log("Data size to write is ~p bytes",[size(Data)]), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Data} = ssh_sftp:read_file(Sftp, FileName). %%-------------------------------------------------------------------- @@ -425,7 +424,7 @@ remove_file(Config) when is_list(Config) -> ok = ssh_sftp:delete(Sftp, FileName), {ok, NewFiles} = ssh_sftp:list_dir(Sftp, PrivDir), false = lists:member(filename:basename(FileName), NewFiles), - {error, _} = ssh_sftp:delete(Sftp, FileName). + {error, no_such_file} = ssh_sftp:delete(Sftp, FileName). %%-------------------------------------------------------------------- rename_file() -> [{doc, "Test API function rename_file/2"}]. @@ -500,7 +499,7 @@ set_attributes(Config) when is_list(Config) -> io:put_chars(Fd,"foo"), ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#400}), {error, eacces} = file:write_file(FileName, "hello again"), - ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#600}), + ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#600}), ok = file:write_file(FileName, "hello again"). %%-------------------------------------------------------------------- @@ -549,7 +548,7 @@ position(Config) when is_list(Config) -> {Sftp, _} = ?config(sftp, Config), Data = list_to_binary("1234567890"), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Handle} = ssh_sftp:open(Sftp, FileName, [read]), {ok, 3} = ssh_sftp:position(Sftp, Handle, {bof, 3}), @@ -577,7 +576,7 @@ pos_read(Config) when is_list(Config) -> FileName = ?config(testfile, Config), {Sftp, _} = ?config(sftp, Config), Data = list_to_binary("Hej hopp!"), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Handle} = ssh_sftp:open(Sftp, FileName, [read]), {async, Ref} = ssh_sftp:apread(Sftp, Handle, {bof, 5}, 4), @@ -607,7 +606,7 @@ pos_write(Config) when is_list(Config) -> {ok, Handle} = ssh_sftp:open(Sftp, FileName, [write]), Data = list_to_binary("Bye,"), - ssh_sftp:write_file(Sftp, FileName, [Data]), + ok = ssh_sftp:write_file(Sftp, FileName, [Data]), NewData = list_to_binary(" see you tomorrow"), {async, Ref} = ssh_sftp:apwrite(Sftp, Handle, {bof, 4}, NewData), diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index fb1a9687af..9385bd127d 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -105,7 +105,6 @@ init_per_testcase(TestCase, Config) -> ClientUserDir = filename:join(PrivDir, nopubkey), SystemDir = filename:join(?config(priv_dir, Config), system), - Port = ssh_test_lib:inet_port(node()), Options = [{system_dir, SystemDir}, {user_dir, PrivDir}, {user_passwords,[{?USER, ?PASSWD}]}, @@ -113,11 +112,13 @@ init_per_testcase(TestCase, Config) -> {ok, Sftpd} = case TestCase of ver6_basic -> SubSystems = [ssh_sftpd:subsystem_spec([{sftpd_vsn, 6}])], - ssh:daemon(Port, [{subsystems, SubSystems}|Options]); + ssh:daemon(0, [{subsystems, SubSystems}|Options]); _ -> SubSystems = [ssh_sftpd:subsystem_spec([])], - ssh:daemon(Port, [{subsystems, SubSystems}|Options]) + ssh:daemon(0, [{subsystems, SubSystems}|Options]) end, + {ok,Dinf} = ssh:daemon_info(Sftpd), + Port = proplists:get_value(port, Dinf), Cm = ssh_test_lib:connect(Port, [{user_dir, ClientUserDir}, diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl index 09bef87148..355ce6a8f5 100644 --- a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl @@ -39,7 +39,6 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{seconds,40}}]. - all() -> [close_file, quit, diff --git a/lib/ssh/test/ssh_sup_SUITE.erl b/lib/ssh/test/ssh_sup_SUITE.erl index f800ea806d..f8929b30ff 100644 --- a/lib/ssh/test/ssh_sup_SUITE.erl +++ b/lib/ssh/test/ssh_sup_SUITE.erl @@ -22,21 +22,23 @@ -module(ssh_sup_SUITE). -include_lib("common_test/include/ct.hrl"). -include_lib("ssh/src/ssh.hrl"). +-include("ssh_test_lib.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). --define(WAIT_FOR_SHUTDOWN, 500). -define(USER, "Alladin"). -define(PASSWD, "Sesame"). +-define(WAIT_FOR_SHUTDOWN, 500). + %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap,{seconds,40}}]. + {timetrap,{seconds,100}}]. all() -> [default_tree, sshc_subtree, sshd_subtree, sshd_subtree_profile]. @@ -92,8 +94,8 @@ default_tree(Config) when is_list(Config) -> lists:keysearch(sshc_sup, 1, TopSupChildren), {value, {sshd_sup, _,supervisor,[sshd_sup]}} = lists:keysearch(sshd_sup, 1, TopSupChildren), - [] = supervisor:which_children(sshc_sup), - [] = supervisor:which_children(sshd_sup). + ?wait_match([], supervisor:which_children(sshc_sup)), + ?wait_match([], supervisor:which_children(sshd_sup)). sshc_subtree() -> [{doc, "Make sure the sshc subtree is correct"}]. @@ -101,24 +103,27 @@ sshc_subtree(Config) when is_list(Config) -> {_Pid, Host, Port} = ?config(server, Config), UserDir = ?config(userdir, Config), - [] = supervisor:which_children(sshc_sup), + ?wait_match([], supervisor:which_children(sshc_sup)), + {ok, Pid1} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, {user_interaction, false}, {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), - [{_, _,supervisor,[ssh_connection_handler]}] = - supervisor:which_children(sshc_sup), + + ?wait_match([{_, _,worker,[ssh_connection_handler]}], + supervisor:which_children(sshc_sup)), + {ok, Pid2} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, {user_interaction, false}, {user, ?USER}, {password, ?PASSWD}, {user_dir, UserDir}]), - [{_,_,supervisor,[ssh_connection_handler]}, - {_,_,supervisor,[ssh_connection_handler]}] = - supervisor:which_children(sshc_sup), + ?wait_match([{_,_,worker,[ssh_connection_handler]}, + {_,_,worker,[ssh_connection_handler]}], + supervisor:which_children(sshc_sup)), + ssh:close(Pid1), - [{_,_,supervisor,[ssh_connection_handler]}] = - supervisor:which_children(sshc_sup), + ?wait_match([{_,_,worker,[ssh_connection_handler]}], + supervisor:which_children(sshc_sup)), ssh:close(Pid2), - ct:sleep(?WAIT_FOR_SHUTDOWN), - [] = supervisor:which_children(sshc_sup). + ?wait_match([], supervisor:which_children(sshc_sup)). sshd_subtree() -> [{doc, "Make sure the sshd subtree is correct"}]. @@ -130,14 +135,16 @@ sshd_subtree(Config) when is_list(Config) -> {failfun, fun ssh_test_lib:failfun/2}, {user_passwords, [{?USER, ?PASSWD}]}]), - [{{server,ssh_system_sup, HostIP, Port, ?DEFAULT_PROFILE}, - Daemon, supervisor, - [ssh_system_sup]}] = - supervisor:which_children(sshd_sup), + + ?wait_match([{{server,ssh_system_sup, HostIP, Port, ?DEFAULT_PROFILE}, + Daemon, supervisor, + [ssh_system_sup]}], + supervisor:which_children(sshd_sup), + Daemon), check_sshd_system_tree(Daemon, Config), ssh:stop_daemon(HostIP, Port), ct:sleep(?WAIT_FOR_SHUTDOWN), - [] = supervisor:which_children(sshd_sup). + ?wait_match([], supervisor:which_children(sshd_sup)). sshd_subtree_profile() -> [{doc, "Make sure the sshd subtree using profile option is correct"}]. @@ -152,14 +159,15 @@ sshd_subtree_profile(Config) when is_list(Config) -> {user_passwords, [{?USER, ?PASSWD}]}, {profile, Profile}]), - [{{server,ssh_system_sup, HostIP,Port,Profile}, - Daemon, supervisor, - [ssh_system_sup]}] = - supervisor:which_children(sshd_sup), + ?wait_match([{{server,ssh_system_sup, HostIP,Port,Profile}, + Daemon, supervisor, + [ssh_system_sup]}], + supervisor:which_children(sshd_sup), + Daemon), check_sshd_system_tree(Daemon, Config), ssh:stop_daemon(HostIP, Port, Profile), ct:sleep(?WAIT_FOR_SHUTDOWN), - [] = supervisor:which_children(sshd_sup). + ?wait_match([], supervisor:which_children(sshd_sup)). check_sshd_system_tree(Daemon, Config) -> @@ -170,28 +178,31 @@ check_sshd_system_tree(Daemon, Config) -> {user_interaction, false}, {user, ?USER}, {password, ?PASSWD},{user_dir, UserDir}]), - [{_,SubSysSup, supervisor,[ssh_subsystem_sup]}, - {{ssh_acceptor_sup,_,_,_}, AccSup, supervisor,[ssh_acceptor_sup]}] - = supervisor:which_children(Daemon), + ?wait_match([{_,SubSysSup, supervisor,[ssh_subsystem_sup]}, + {{ssh_acceptor_sup,_,_,_}, AccSup, supervisor,[ssh_acceptor_sup]}], + supervisor:which_children(Daemon), + [SubSysSup,AccSup]), - [{{server,ssh_connection_sup, _,_}, - ConnectionSup, supervisor, - [ssh_connection_sup]}, - {{server,ssh_channel_sup,_ ,_}, - ChannelSup,supervisor, - [ssh_channel_sup]}] = supervisor:which_children(SubSysSup), + ?wait_match([{{server,ssh_connection_sup, _,_}, + ConnectionSup, supervisor, + [ssh_connection_sup]}, + {{server,ssh_channel_sup,_ ,_}, + ChannelSup,supervisor, + [ssh_channel_sup]}], + supervisor:which_children(SubSysSup), + [ConnectionSup,ChannelSup]), - [{{ssh_acceptor_sup,_,_,_},_,worker,[ssh_acceptor]}] = - supervisor:which_children(AccSup), + ?wait_match([{{ssh_acceptor_sup,_,_,_},_,worker,[ssh_acceptor]}], + supervisor:which_children(AccSup)), - [{_, _, worker,[ssh_connection_handler]}] = - supervisor:which_children(ConnectionSup), + ?wait_match([{_, _, worker,[ssh_connection_handler]}], + supervisor:which_children(ConnectionSup)), - [] = supervisor:which_children(ChannelSup), + ?wait_match([], supervisor:which_children(ChannelSup)), ssh_sftp:start_channel(Client), - [{_, _,worker,[ssh_channel]}] = - supervisor:which_children(ChannelSup), + ?wait_match([{_, _,worker,[ssh_channel]}], + supervisor:which_children(ChannelSup)), ssh:close(Client). diff --git a/lib/ssh/test/ssh_test_cli.erl b/lib/ssh/test/ssh_test_cli.erl index 697ddb730d..f96b9967d2 100644 --- a/lib/ssh/test/ssh_test_cli.erl +++ b/lib/ssh/test/ssh_test_cli.erl @@ -75,10 +75,11 @@ terminate(_Why, _S) -> run_portprog(User, cli, TmpDir) -> Pty_bin = os:find_executable("cat"), - open_port({spawn_executable, Pty_bin}, - [stream, {cd, TmpDir}, {env, [{"USER", User}]}, - {args, []}, binary, - exit_status, use_stdio, stderr_to_stdout]). + ssh_test_lib:open_port({spawn_executable, Pty_bin}, + [stream, + {cd, TmpDir}, + {env, [{"USER", User}]}, + {args, []}]). get_ssh_user(Ref) -> [{user, User}] = ssh:connection_info(Ref, [user]), diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 4db7d09ccd..c6541461a1 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -32,15 +32,8 @@ -define(TIMEOUT, 50000). -connect(Options) -> - connect(hostname(), inet_port(), Options). - connect(Port, Options) when is_integer(Port) -> - connect(hostname(), Port, Options); -connect(any, Options) -> - connect(hostname(), inet_port(), Options); -connect(Host, Options) -> - connect(Host, inet_port(), Options). + connect(hostname(), Port, Options). connect(any, Port, Options) -> connect(hostname(), Port, Options); @@ -49,23 +42,33 @@ connect(Host, Port, Options) -> ConnectionRef. daemon(Options) -> - daemon(any, inet_port(), Options). + daemon(any, 0, Options). daemon(Port, Options) when is_integer(Port) -> daemon(any, Port, Options); daemon(Host, Options) -> - daemon(Host, inet_port(), Options). + daemon(Host, 0, Options). + daemon(Host, Port, Options) -> + ct:log("~p:~p Calling ssh:daemon(~p, ~p, ~p)",[?MODULE,?LINE,Host,Port,Options]), case ssh:daemon(Host, Port, Options) of {ok, Pid} when Host == any -> - {Pid, hostname(), Port}; + ct:log("ssh:daemon ok (1)",[]), + {Pid, hostname(), daemon_port(Port,Pid)}; {ok, Pid} -> - {Pid, Host, Port}; + ct:log("ssh:daemon ok (2)",[]), + {Pid, Host, daemon_port(Port,Pid)}; Error -> + ct:log("ssh:daemon error ~p",[Error]), Error end. +daemon_port(0, Pid) -> {ok,Dinf} = ssh:daemon_info(Pid), + proplists:get_value(port, Dinf); +daemon_port(Port, _) -> Port. + + std_daemon(Config, ExtraOpts) -> PrivDir = ?config(priv_dir, Config), @@ -201,6 +204,35 @@ reply(TestCase, Result) -> %%ct:log("reply ~p sending ~p ! ~p",[self(), TestCase, Result]), TestCase ! Result. + + +rcv_expected(Expect, SshPort, Timeout) -> + receive + {SshPort, Expect} -> + ct:log("Got expected ~p from ~p",[Expect,SshPort]), + catch port_close(SshPort), + rcv_lingering(50); + Other -> + ct:log("Got UNEXPECTED ~p~nExpect ~p",[Other, {SshPort,Expect}]), + rcv_expected(Expect, SshPort, Timeout) + + after Timeout -> + catch port_close(SshPort), + ct:fail("Did not receive answer") + end. + +rcv_lingering(Timeout) -> + receive + Msg -> + ct:log("Got LINGERING ~p",[Msg]), + rcv_lingering(Timeout) + + after Timeout -> + ct:log("No more lingering messages",[]), + ok + end. + + receive_exec_result(Msg) -> ct:log("Expect data! ~p", [Msg]), receive @@ -470,8 +502,9 @@ openssh_supports(ClientOrServer, Tag, Alg) when ClientOrServer == sshc ; %% Check if we have a "newer" ssh client that supports these test cases ssh_client_supports_Q() -> - ErlPort = open_port({spawn, "ssh -Q cipher"}, [exit_status, stderr_to_stdout]), - 0 == check_ssh_client_support2(ErlPort). + 0 == check_ssh_client_support2( + ?MODULE:open_port({spawn, "ssh -Q cipher"}) + ). check_ssh_client_support2(P) -> receive @@ -690,3 +723,16 @@ has_inet6_address() -> catch throw:6 -> true end. + +%%%---------------------------------------------------------------- +open_port(Arg1) -> + ?MODULE:open_port(Arg1, []). + +open_port(Arg1, ExtraOpts) -> + erlang:open_port(Arg1, + [binary, + stderr_to_stdout, + exit_status, + use_stdio, + overlapped_io, hide %only affects windows + | ExtraOpts]). diff --git a/lib/ssh/test/ssh_test_lib.hrl b/lib/ssh/test/ssh_test_lib.hrl new file mode 100644 index 0000000000..7cb7edeaa8 --- /dev/null +++ b/lib/ssh/test/ssh_test_lib.hrl @@ -0,0 +1,27 @@ +%%------------------------------------------------------------------------- +%% Help macro +%%------------------------------------------------------------------------- +-define(wait_match(Pattern, FunctionCall, Bind, Timeout, Ntries), + Bind = + (fun() -> + F = fun(N, F1) -> + case FunctionCall of + Pattern -> Bind; + _ when N>0 -> + ct:pal("Must sleep ~p ms at ~p:~p",[Timeout,?MODULE,?LINE]), + timer:sleep(Timeout), + F1(N-1, F1); + Other -> + ct:fail("Unexpected ~p:~p ~p",[?MODULE,?LINE,Other]) + end + end, + F(Ntries, F) + end)() + ). + +-define(wait_match(Pattern, FunctionCall, Timeout, Ntries), ?wait_match(Pattern, FunctionCall, ok, Timeout, Ntries)). + +-define(wait_match(Pattern, FunctionCall, Bind), ?wait_match(Pattern, FunctionCall, Bind, 500, 10) ). + +-define(wait_match(Pattern, FunctionCall), ?wait_match(Pattern, FunctionCall, ok) ). + diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 5b65edc32f..2be75fd7f3 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -34,7 +34,7 @@ %%-------------------------------------------------------------------- suite() -> - [{timetrap,{seconds,40}}]. + [{timetrap,{seconds,20}}]. all() -> case os:find_executable("ssh") of @@ -50,13 +50,15 @@ groups() -> [{erlang_client, [], [erlang_shell_client_openssh_server, erlang_client_openssh_server_exec_compressed, erlang_client_openssh_server_setenv, - erlang_client_openssh_server_publickey_rsa, erlang_client_openssh_server_publickey_dsa, + erlang_client_openssh_server_publickey_rsa, erlang_client_openssh_server_password, erlang_client_openssh_server_kexs, erlang_client_openssh_server_nonexistent_subsystem ]}, - {erlang_server, [], [erlang_server_openssh_client_public_key_dsa]} + {erlang_server, [], [erlang_server_openssh_client_public_key_dsa, + erlang_server_openssh_client_public_key_rsa + ]} ]. init_per_suite(Config) -> @@ -74,6 +76,7 @@ init_per_group(erlang_server, Config) -> DataDir = ?config(data_dir, Config), UserDir = ?config(priv_dir, Config), ssh_test_lib:setup_dsa_known_host(DataDir, UserDir), + ssh_test_lib:setup_rsa_known_host(DataDir, UserDir), Config; init_per_group(erlang_client, Config) -> CommonAlgs = ssh_test_lib:algo_intersection( @@ -86,6 +89,7 @@ init_per_group(_, Config) -> end_per_group(erlang_server, Config) -> UserDir = ?config(priv_dir, Config), ssh_test_lib:clean_dsa(UserDir), + ssh_test_lib:clean_rsa(UserDir), Config; end_per_group(_, Config) -> Config. @@ -93,6 +97,8 @@ end_per_group(_, Config) -> init_per_testcase(erlang_server_openssh_client_public_key_dsa, Config) -> chk_key(sshc, 'ssh-dss', ".ssh/id_dsa", Config); +init_per_testcase(erlang_server_openssh_client_public_key_rsa, Config) -> + chk_key(sshc, 'ssh-rsa', ".ssh/id_rsa", Config); init_per_testcase(erlang_client_openssh_server_publickey_dsa, Config) -> chk_key(sshd, 'ssh-dss', ".ssh/id_dsa", Config); init_per_testcase(_TestCase, Config) -> @@ -347,14 +353,24 @@ erlang_client_openssh_server_publickey_dsa(Config) when is_list(Config) -> %%-------------------------------------------------------------------- erlang_server_openssh_client_public_key_dsa() -> - [{doc, "Validate using dsa publickey."}]. + [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}, + {doc, "Validate using dsa publickey."}]. erlang_server_openssh_client_public_key_dsa(Config) when is_list(Config) -> + erlang_server_openssh_client_public_key_X(Config, ssh_dsa). + +erlang_server_openssh_client_public_key_rsa() -> + [{timetrap, {seconds,(?TIMEOUT div 1000)+10}}, + {doc, "Validate using rsa publickey."}]. +erlang_server_openssh_client_public_key_rsa(Config) when is_list(Config) -> + erlang_server_openssh_client_public_key_X(Config, ssh_rsa). + + +erlang_server_openssh_client_public_key_X(Config, PubKeyAlg) -> SystemDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), KnownHosts = filename:join(PrivDir, "known_hosts"), - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, - {public_key_alg, ssh_dsa}, + {public_key_alg, PubKeyAlg}, {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), @@ -362,18 +378,8 @@ erlang_server_openssh_client_public_key_dsa(Config) when is_list(Config) -> Cmd = "ssh -p " ++ integer_to_list(Port) ++ " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " 1+1.", - SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), - - receive - {SshPort,{data, <<"2\n">>}} -> - ok - after ?TIMEOUT -> - receive - X -> ct:fail("Received: ~p",[X]) - after 0 -> - ct:fail("Did not receive answer") - end - end, + OpenSsh = ssh_test_lib:open_port({spawn, Cmd}), + ssh_test_lib:rcv_expected({data,<<"2\n">>}, OpenSsh, ?TIMEOUT), ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_to_openssh_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl index 4269529ae8..e34071af99 100644 --- a/lib/ssh/test/ssh_trpt_test_lib.erl +++ b/lib/ssh/test/ssh_trpt_test_lib.erl @@ -294,12 +294,11 @@ instantiate(X, _S) -> %%%================================================================ %%% init_ssh(Role, Socket, Options0) -> - Options = [{user_interaction,false} + Options = [{user_interaction, false}, + {vsn, {2,0}}, + {id_string, "ErlangTestLib"} | Options0], - ssh_connection_handler:init_ssh(Role, - {2,0}, - lists:concat(["SSH-2.0-ErlangTestLib ",Role]), - Options, Socket). + ssh_connection_handler:init_ssh_record(Role, Socket, Options). mangle_opts(Options) -> SysOpts = [{reuseaddr, true}, diff --git a/lib/ssh/test/ssh_upgrade_SUITE.erl b/lib/ssh/test/ssh_upgrade_SUITE.erl index 5c7ec17dac..06bef2455e 100644 --- a/lib/ssh/test/ssh_upgrade_SUITE.erl +++ b/lib/ssh/test/ssh_upgrade_SUITE.erl @@ -146,7 +146,8 @@ setup_server_client(#state{config=Config} = State) -> SFTP = ssh_sftpd:subsystem_spec([{root,FtpRootDir},{cwd,FtpRootDir}]), - {Server,Host,Port} = ssh_test_lib:daemon([{system_dir,DataDir}, + {Server,Host,Port} = ssh_test_lib:daemon(ssh_test_lib:inet_port(), % when lower rel is 18.x + [{system_dir,DataDir}, {user_passwords,[{"hej","hopp"}]}, {subsystems,[SFTP]}]), diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 41b42d454b..b165928877 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.2.2 +SSH_VSN = 4.3 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 00419b63db..e9b523d9e1 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -28,6 +28,23 @@ <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 7.3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Correct cipher suites conversion and gaurd expression. + Caused problems with GCM cipher suites and client side + option to set signature_algorithms extention values.</p> + <p> + Own Id: OTP-13525</p> + </item> + </list> + </section> + +</section> + <section><title>SSL 7.3.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index e490de7eeb..82d6faee42 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -21,7 +21,7 @@ %% Internal application API --behaviour(gen_fsm). +-behaviour(gen_statem). -include("dtls_connection.hrl"). -include("dtls_handshake.hrl"). @@ -36,37 +36,38 @@ %% Internal application API %% Setup --export([start_fsm/8]). +-export([start_fsm/8, start_link/7, init/1]). %% State transition handling --export([next_record/1, next_state/4%, - %%next_state_connection/2 - ]). +-export([next_record/1, next_event/3]). %% Handshake handling --export([%%renegotiate/1, +-export([%%renegotiate/2, send_handshake/2, send_change_cipher/2]). + %% Alert and close handling --export([send_alert/2, handle_own_alert/4, %%handle_close_alert/3, - handle_normal_shutdown/3 - %%handle_unexpected_message/3, - %%alert_user/5, alert_user/8 +-export([%%send_alert/2, handle_own_alert/4, handle_close_alert/3, + handle_normal_shutdown/3 %%, close/5 + %%alert_user/6, alert_user/9 ]). %% Data handling -export([%%write_application_data/3, - read_application_data/2%%, -%% passive_receive/2, next_record_if_active/1 + read_application_data/2, + %%passive_receive/2, + next_record_if_active/1 %%, + %%handle_common_event/4 ]). -%% Called by tls_connection_sup --export([start_link/7]). +%% gen_statem state functions +-export([init/3, error/3, downgrade/3, %% Initiation and take down states + hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states + connection/3]). +%% gen_statem callbacks +-export([terminate/3, code_change/4, format_status/2]). -%% gen_fsm callbacks --export([init/1, hello/2, certify/2, cipher/2, - abbreviated/2, connection/2, handle_event/3, - handle_sync_event/4, handle_info/3, terminate/3, code_change/4]). +-define(GEN_STATEM_CB_MODE, state_functions). %%==================================================================== %% Internal application API @@ -141,75 +142,74 @@ send_change_cipher(Msg, #state{connection_states = ConnectionStates0, start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}. -init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) -> +init([Role, Host, Port, Socket, Options, User, CbInfo]) -> process_flag(trap_exit, true), State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), - Handshake = ssl_handshake:init_handshake_history(), - TimeStamp = erlang:monotonic_time(), - try ssl_config:init(SSLOpts0, Role) of - {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbInfo, OwnCert, Key, DHParams} -> - Session = State0#state.session, - State = State0#state{ - tls_handshake_history = Handshake, - session = Session#session{own_certificate = OwnCert, - time_stamp = TimeStamp}, - file_ref_db = FileRefHandle, - cert_db_ref = Ref, - cert_db = CertDbHandle, - crl_db = CRLDbInfo, - session_cache = CacheHandle, - private_key = Key, - diffie_hellman_params = DHParams}, - gen_fsm:enter_loop(?MODULE, [], hello, State, get_timeout(State)) + try + State = ssl_connection:ssl_config(State0#state.ssl_options, Role, State0), + gen_statem:enter_loop(?MODULE, [], ?GEN_STATEM_CB_MODE, init, State) catch throw:Error -> - gen_fsm:enter_loop(?MODULE, [], error, {Error,State0}, get_timeout(State0)) + gen_statem:enter_loop(?MODULE, [], ?GEN_STATEM_CB_MODE, error, {Error,State0}) end. %%-------------------------------------------------------------------- -%% Description:There should be one instance of this function for each -%% possible state name. Whenever a gen_fsm receives an event sent -%% using gen_fsm:send_event/2, the instance of this function with the -%% same name as the current state name StateName is called to handle -%% the event. It is also called if a timeout occurs. -%% -hello(start, #state{host = Host, port = Port, role = client, - ssl_options = SslOpts, - session = #session{own_certificate = Cert} = Session0, - session_cache = Cache, session_cache_cb = CacheCb, - transport_cb = Transport, socket = Socket, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _}} = State0) -> +%% State functionsconnection/2 +%%-------------------------------------------------------------------- + +init({call, From}, {start, Timeout}, + #state{host = Host, port = Port, role = client, + ssl_options = SslOpts, + session = #session{own_certificate = Cert} = Session0, + transport_cb = Transport, socket = Socket, + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}, + session_cache = Cache, + session_cache_cb = CacheCb + } = State0) -> + Timer = ssl_connection:start_or_recv_cancel_timer(Timeout, From), Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, - Cache, CacheCb, Renegotiation, Cert), + Cache, CacheCb, Renegotiation, Cert), Version = Hello#client_hello.client_version, + HelloVersion = dtls_record:lowest_protocol_version(SslOpts#ssl_options.versions), Handshake0 = ssl_handshake:init_handshake_history(), {BinMsg, ConnectionStates, Handshake} = - encode_handshake(Hello, Version, ConnectionStates0, Handshake0), + encode_handshake(Hello, HelloVersion, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), State1 = State0#state{connection_states = ConnectionStates, negotiated_version = Version, %% Requested version session = Session0#session{session_id = Hello#client_hello.session_id}, - tls_handshake_history = Handshake}, + tls_handshake_history = Handshake, + start_or_recv_from = From, + timer = Timer}, {Record, State} = next_record(State1), - next_state(hello, hello, Record, State); - -hello(Hello = #client_hello{client_version = ClientVersion}, - State = #state{connection_states = ConnectionStates0, - port = Port, session = #session{own_certificate = Cert} = Session0, - renegotiation = {Renegotiation, _}, - session_cache = Cache, - session_cache_cb = CacheCb, - ssl_options = SslOpts}) -> + next_event(hello, Record, State); +init(Type, Event, State) -> + ssl_connection:init(Type, Event, State, ?MODULE). + +error({call, From}, {start, _Timeout}, {Error, State}) -> + {stop_and_reply, normal, {reply, From, {error, Error}}, State}; +error({call, From}, Msg, State) -> + handle_call(Msg, From, error, State); +error(_, _, _) -> + {keep_state_and_data, [postpone]}. + +hello(internal, #client_hello{client_version = ClientVersion} = Hello, + #state{connection_states = ConnectionStates0, + port = Port, session = #session{own_certificate = Cert} = Session0, + renegotiation = {Renegotiation, _}, + session_cache = Cache, + session_cache_cb = CacheCb, + ssl_options = SslOpts} = State) -> case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) of {Version, {Type, Session}, ConnectionStates, #hello_extensions{ec_point_formats = EcPointFormats, elliptic_curves = EllipticCurves} = ServerHelloExt, HashSign} -> - ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign}, + ssl_connection:hello(internal, {common_client_hello, Type, ServerHelloExt, HashSign}, State#state{connection_states = ConnectionStates, negotiated_version = Version, session = Session, @@ -217,7 +217,7 @@ hello(Hello = #client_hello{client_version = ClientVersion}, #alert{} = Alert -> handle_own_alert(Alert, ClientVersion, hello, State) end; -hello(Hello, +hello(internal, Hello, #state{connection_states = ConnectionStates0, negotiated_version = ReqVersion, role = client, @@ -230,20 +230,30 @@ hello(Hello, ssl_connection:handle_session(Hello, Version, NewId, ConnectionStates, ProtoExt, Protocol, State) end; - -hello(Msg, State) -> - ssl_connection:hello(Msg, State, ?MODULE). - -abbreviated(Msg, State) -> - ssl_connection:abbreviated(Msg, State, ?MODULE). - -certify(Msg, State) -> - ssl_connection:certify(Msg, State, ?MODULE). - -cipher(Msg, State) -> - ssl_connection:cipher(Msg, State, ?MODULE). - -connection(#hello_request{}, #state{host = Host, port = Port, +hello(info, Event, State) -> + handle_info(Event, hello, State); + +hello(Type, Event, State) -> + ssl_connection:hello(Type, Event, State, ?MODULE). + +abbreviated(info, Event, State) -> + handle_info(Event, abbreviated, State); +abbreviated(Type, Event, State) -> + ssl_connection:abbreviated(Type, Event, State, ?MODULE). + +certify(info, Event, State) -> + handle_info(Event, certify, State); +certify(Type, Event, State) -> + ssl_connection:certify(Type, Event, State, ?MODULE). + +cipher(info, Event, State) -> + handle_info(Event, cipher, State); +cipher(Type, Event, State) -> + ssl_connection:cipher(Type, Event, State, ?MODULE). + +connection(info, Event, State) -> + handle_info(Event, connection, State); +connection(internal, #hello_request{}, #state{host = Host, port = Port, session = #session{own_certificate = Cert} = Session0, session_cache = Cache, session_cache_cb = CacheCb, ssl_options = SslOpts, @@ -257,40 +267,30 @@ connection(#hello_request{}, #state{host = Host, port = Port, next_record( State1#state{session = Session0#session{session_id = Hello#client_hello.session_id}}), - next_state(connection, hello, Record, State); + next_event(hello, Record, State); -connection(#client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) -> +connection(internal, #client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) -> %% Mitigate Computational DoS attack %% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html %% http://www.thc.org/thc-ssl-dos/ Rather than disabling client %% initiated renegotiation we will disallow many client initiated %% renegotiations immediately after each other. erlang:send_after(?WAIT_TO_ALLOW_RENEGOTIATION, self(), allow_renegotiate), - hello(Hello, State#state{allow_renegotiate = false}); + {next_state, hello, State#state{allow_renegotiate = false}, [{next_event, internal, Hello}]}; + -connection(#client_hello{}, #state{role = server, allow_renegotiate = false} = State0) -> +connection(internal, #client_hello{}, #state{role = server, allow_renegotiate = false} = State0) -> Alert = ?ALERT_REC(?WARNING, ?NO_RENEGOTIATION), - State = send_alert(Alert, State0), - next_state_connection(connection, State); + State1 = send_alert(Alert, State0), + {Record, State} = ssl_connection:prepare_connection(State1, ?MODULE), + next_event(connection, Record, State); -connection(Msg, State) -> - ssl_connection:connection(Msg, State, tls_connection). +connection(Type, Event, State) -> + ssl_connection:connection(Type, Event, State, ?MODULE). -%%-------------------------------------------------------------------- -%% Description: Whenever a gen_fsm receives an event sent using -%% gen_fsm:send_all_state_event/2, this function is called to handle -%% the event. Not currently used! -%%-------------------------------------------------------------------- -handle_event(_Event, StateName, State) -> - {next_state, StateName, State, get_timeout(State)}. +downgrade(Type, Event, State) -> + ssl_connection:downgrade(Type, Event, State, ?MODULE). -%%-------------------------------------------------------------------- -%% Description: Whenever a gen_fsm receives an event sent using -%% gen_fsm:sync_send_all_state_event/2,3, this function is called to handle -%% the event. -%%-------------------------------------------------------------------- -handle_sync_event(Event, From, StateName, State) -> - ssl_connection:handle_sync_event(Event, From, StateName, State). %%-------------------------------------------------------------------- %% Description: This function is called by a gen_fsm when it receives any @@ -301,26 +301,25 @@ handle_sync_event(Event, From, StateName, State) -> %% raw data from socket, unpack records handle_info({Protocol, _, Data}, StateName, #state{data_tag = Protocol} = State0) -> - %% Simplify for now to avoid dialzer warnings before implementation is compleate - %% case next_tls_record(Data, State0) of - %% {Record, State} -> - %% next_state(StateName, StateName, Record, State); - %% #alert{} = Alert -> - %% handle_normal_shutdown(Alert, StateName, State0), - %% {stop, {shutdown, own_alert}, State0} - %% end; - {Record, State} = next_tls_record(Data, State0), - next_state(StateName, StateName, Record, State); - + case next_tls_record(Data, State0) of + {Record, State} -> + next_event(StateName, Record, State); + #alert{} = Alert -> + handle_normal_shutdown(Alert, StateName, State0), + {stop, {shutdown, own_alert}} + end; handle_info({CloseTag, Socket}, StateName, #state{socket = Socket, close_tag = CloseTag, negotiated_version = _Version} = State) -> handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), - {stop, {shutdown, transport_closed}, State}; + {stop, {shutdown, transport_closed}}; handle_info(Msg, StateName, State) -> ssl_connection:handle_info(Msg, StateName, State). +handle_call(Event, From, StateName, State) -> + ssl_connection:handle_call(Event, From, StateName, State, ?MODULE). + %%-------------------------------------------------------------------- %% Description:This function is called by a gen_fsm when it is about %% to terminate. It should be the opposite of Module:init/1 and do any @@ -335,7 +334,10 @@ terminate(Reason, StateName, State) -> %% Description: Convert process state when code is changed %%-------------------------------------------------------------------- code_change(_OldVsn, StateName, State, _Extra) -> - {ok, StateName, State}. + {?GEN_STATEM_CB_MODE, StateName, State}. + +format_status(Type, Data) -> + ssl_connection:format_status(Type, Data). %%-------------------------------------------------------------------- %%% Internal functions @@ -372,96 +374,28 @@ next_record(#state{socket = Socket, next_record(State) -> {no_record, State}. -next_state(Current,_, #alert{} = Alert, #state{negotiated_version = Version} = State) -> - handle_own_alert(Alert, Version, Current, State); - -next_state(_,Next, no_record, State) -> - {next_state, Next, State, get_timeout(State)}; - -%% next_state(_,Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, State) -> -%% Alerts = decode_alerts(EncAlerts), -%% handle_alerts(Alerts, {next_state, Next, State, get_timeout(State)}); - -next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, - State0 = #state{protocol_buffers = - #protocol_buffers{dtls_handshake_buffer = Buf0} = Buffers, - negotiated_version = Version}) -> - Handle = - fun({#hello_request{} = Packet, _}, {next_state, connection = SName, State}) -> - %% This message should not be included in handshake - %% message hashes. Starts new handshake (renegotiation) - Hs0 = ssl_handshake:init_handshake_history(), - ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs0, - renegotiation = {true, peer}}); - ({#hello_request{} = Packet, _}, {next_state, SName, State}) -> - %% This message should not be included in handshake - %% message hashes. Already in negotiation so it will be ignored! - ?MODULE:SName(Packet, State); - ({#client_hello{} = Packet, Raw}, {next_state, connection = SName, State}) -> - Version = Packet#client_hello.client_version, - Hs0 = ssl_handshake:init_handshake_history(), - Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), - ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs1, - renegotiation = {true, peer}}); - ({Packet, Raw}, {next_state, SName, State = #state{tls_handshake_history=Hs0}}) -> - Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), - ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs1}); - (_, StopState) -> StopState - end, - try - {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0), - State = State0#state{protocol_buffers = - Buffers#protocol_buffers{dtls_packets = Packets, - dtls_handshake_buffer = Buf}}, - handle_dtls_handshake(Handle, Next, State) - catch throw:#alert{} = Alert -> - handle_own_alert(Alert, Version, Current, State0) - end; -next_state(_, StateName, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, State0) -> - %% Simplify for now to avoid dialzer warnings before implementation is compleate - %% case read_application_data(Data, State0) of - %% Stop = {stop,_,_} -> - %% Stop; - %% {Record, State} -> - %% next_state(StateName, StateName, Record, State) - %% end; - {Record, State} = read_application_data(Data, State0), - next_state(StateName, StateName, Record, State); - -next_state(Current, Next, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} = - _ChangeCipher, - #state{connection_states = ConnectionStates0} = State0) -> - ConnectionStates1 = - ssl_record:activate_pending_connection_state(ConnectionStates0, read), - {Record, State} = next_record(State0#state{connection_states = ConnectionStates1}), - next_state(Current, Next, Record, State); -next_state(Current, Next, #ssl_tls{type = _Unknown}, State0) -> - %% Ignore unknown type - {Record, State} = next_record(State0), - next_state(Current, Next, Record, State). - -handle_dtls_handshake(Handle, StateName, - #state{protocol_buffers = - #protocol_buffers{dtls_packets = [Packet]} = Buffers} = State) -> - FsmReturn = {next_state, StateName, State#state{protocol_buffers = - Buffers#protocol_buffers{dtls_packets = []}}}, - Handle(Packet, FsmReturn); - -handle_dtls_handshake(Handle, StateName, - #state{protocol_buffers = - #protocol_buffers{dtls_packets = [Packet | Packets]} = Buffers} = - State0) -> - FsmReturn = {next_state, StateName, State0#state{protocol_buffers = - Buffers#protocol_buffers{dtls_packets = - Packets}}}, - case Handle(Packet, FsmReturn) of - {next_state, NextStateName, State, _Timeout} -> - handle_dtls_handshake(Handle, NextStateName, State); - {stop, _,_} = Stop -> - Stop - end. +next_event(StateName, Record, State) -> + next_event(StateName, Record, State, []). +next_event(connection = StateName, no_record, State0, Actions) -> + case next_record_if_active(State0) of + {no_record, State} -> + ssl_connection:hibernate_after(StateName, State, Actions); + {#ssl_tls{} = Record, State} -> + {next_state, StateName, State, [{next_event, internal, {dtls_record, Record}} | Actions]}; + {#alert{} = Alert, State} -> + {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} + end; +next_event(StateName, Record, State, Actions) -> + case Record of + no_record -> + {next_state, StateName, State, Actions}; + #ssl_tls{} = Record -> + {next_state, StateName, State, [{next_event, internal, {dtls_record, Record}} | Actions]}; + #alert{} = Alert -> + {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} + end. send_flight(Fragments, #state{transport_cb = Transport, socket = Socket, protocol_buffers = _PBuffers} = State) -> @@ -514,21 +448,23 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, renegotiation = {false, first}, allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, - send_queue = queue:new(), protocol_cb = ?MODULE }. read_application_data(_,State) -> {#ssl_tls{fragment = <<"place holder">>}, State}. - + +next_tls_record(<<>>, _State) -> + #alert{}; %% Place holder next_tls_record(_, State) -> {#ssl_tls{fragment = <<"place holder">>}, State}. -get_timeout(_) -> %% Place holder - infinity. - -next_state_connection(_, State) -> %% Place holder - {next_state, connection, State, get_timeout(State)}. - sequence(_) -> %%TODO real imp 1. +next_record_if_active(State = + #state{socket_options = + #socket_options{active = false}}) -> + {no_record ,State}; + +next_record_if_active(State) -> + next_record(State). diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index 2530d66052..e79e1cede0 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -39,7 +39,7 @@ -export([encode_plain_text/4, encode_handshake/3, encode_change_cipher_spec/2]). %% Protocol version handling --export([protocol_version/1, lowest_protocol_version/2, +-export([protocol_version/1, lowest_protocol_version/2, lowest_protocol_version/1, highest_protocol_version/1, supported_protocol_versions/0, is_acceptable_version/2]). @@ -254,6 +254,18 @@ lowest_protocol_version(Version = {M,_}, {N, _}) when M > N -> Version; lowest_protocol_version(_,Version) -> Version. + +%%-------------------------------------------------------------------- +-spec lowest_protocol_version([dtls_version()]) -> dtls_version(). +%% +%% Description: Lowest protocol version present in a list +%%-------------------------------------------------------------------- +lowest_protocol_version([]) -> + lowest_protocol_version(); +lowest_protocol_version(Versions) -> + [Ver | Vers] = Versions, + lowest_list_protocol_version(Ver, Vers). + %%-------------------------------------------------------------------- -spec highest_protocol_version([dtls_version()]) -> dtls_version(). %% @@ -302,6 +314,12 @@ supported_protocol_versions([]) -> supported_protocol_versions([_|_] = Vsns) -> Vsns. +%% highest_protocol_version() -> +%% highest_protocol_version(supported_protocol_versions()). + +lowest_protocol_version() -> + lowest_protocol_version(supported_protocol_versions()). + supported_connection_protocol_versions([]) -> ?ALL_DATAGRAM_SUPPORTED_VERSIONS. @@ -421,3 +439,8 @@ 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)>>. + +lowest_list_protocol_version(Ver, []) -> + Ver; +lowest_list_protocol_version(Ver1, [Ver2 | Rest]) -> + lowest_list_protocol_version(lowest_protocol_version(Ver1, Ver2), Rest). diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 025e8cea61..dbbb25025c 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -696,7 +696,7 @@ handle_options(Opts0, Role) -> default_option_role(server, true, Role), server, Role), renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), - hibernate_after = handle_option(hibernate_after, Opts, undefined), + hibernate_after = handle_option(hibernate_after, Opts, infinity), erl_dist = handle_option(erl_dist, Opts, false), alpn_advertised_protocols = handle_option(alpn_advertised_protocols, Opts, undefined), @@ -885,10 +885,13 @@ validate_option(client_renegotiation, Value) when is_boolean(Value) -> validate_option(renegotiate_at, Value) when is_integer(Value) -> erlang:min(Value, ?DEFAULT_RENEGOTIATE_AT); -validate_option(hibernate_after, undefined) -> - undefined; +validate_option(hibernate_after, undefined) -> %% Backwards compatibility + infinity; +validate_option(hibernate_after, infinity) -> + infinity; validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 -> Value; + validate_option(erl_dist,Value) when is_boolean(Value) -> Value; validate_option(Opt, Value) diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 544d9b41cd..dc0a0c2cc4 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -992,21 +992,21 @@ suite({ecdh_rsa, aes_256_cbc, sha384, sha384}) -> %% RFC 5288 AES-GCM Cipher Suites suite({rsa, aes_128_gcm, null, sha256}) -> ?TLS_RSA_WITH_AES_128_GCM_SHA256; -suite({rsa, aes_256_gcm, null}) -> +suite({rsa, aes_256_gcm, null, sha384}) -> ?TLS_RSA_WITH_AES_256_GCM_SHA384; -suite({dhe_rsa, aes_128_gcm, null, sha384}) -> +suite({dhe_rsa, aes_128_gcm, null, sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; -suite({dhe_rsa, aes_256_gcm, null, sha256}) -> +suite({dhe_rsa, aes_256_gcm, null, sha384}) -> ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; -suite({dh_rsa, aes_128_gcm, null, sha384}) -> +suite({dh_rsa, aes_128_gcm, null, sha256}) -> ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; -suite({dh_rsa, aes_256_gcm, null, sha256}) -> +suite({dh_rsa, aes_256_gcm, null, sha384}) -> ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; -suite({dhe_dss, aes_128_gcm, null, sha384}) -> +suite({dhe_dss, aes_128_gcm, null, sha256}) -> ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; -suite({dhe_dss, aes_256_gcm, null, sha256}) -> +suite({dhe_dss, aes_256_gcm, null, sha384}) -> ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; -suite({dh_dss, aes_128_gcm, null, sha384}) -> +suite({dh_dss, aes_128_gcm, null, sha256}) -> ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; suite({dh_dss, aes_256_gcm, null, sha384}) -> ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 0073e86e26..26c371a8ea 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -38,7 +38,7 @@ %% Setup -export([connect/8, ssl_accept/7, handshake/2, handshake/3, - socket_control/4, socket_control/5]). + socket_control/4, socket_control/5, start_or_recv_cancel_timer/2]). %% User Events -export([send/2, recv/3, close/2, shutdown/2, @@ -47,12 +47,16 @@ connection_information/1 ]). --export([handle_session/7]). +%% General gen_statem state functions with extra callback argument +%% to determine if it is an SSL/TLS or DTLS gen_statem machine +-export([init/4, hello/4, abbreviated/4, certify/4, cipher/4, connection/4, downgrade/4]). -%% SSL FSM state functions --export([hello/3, abbreviated/3, certify/3, cipher/3, connection/3]). -%% SSL all state functions --export([handle_sync_event/4, handle_info/3, terminate/3, format_status/2]). +%% gen_statem callbacks +-export([terminate/3, format_status/2]). + +%% +-export([handle_info/3, handle_call/5, handle_session/7, ssl_config/3, + prepare_connection/2, hibernate_after/3]). %%==================================================================== @@ -100,7 +104,7 @@ ssl_accept(Connection, Port, Socket, Opts, User, CbInfo, Timeout) -> %% Description: Starts ssl handshake. %%-------------------------------------------------------------------- handshake(#sslsocket{pid = Pid}, Timeout) -> - case sync_send_all_state_event(Pid, {start, Timeout}) of + case call(Pid, {start, Timeout}) of connected -> ok; Error -> @@ -114,7 +118,7 @@ handshake(#sslsocket{pid = Pid}, Timeout) -> %% Description: Starts ssl handshake with some new options %%-------------------------------------------------------------------- handshake(#sslsocket{pid = Pid}, SslOptions, Timeout) -> - case sync_send_all_state_event(Pid, {start, SslOptions, Timeout}) of + case call(Pid, {start, SslOptions, Timeout}) of connected -> ok; Error -> @@ -148,7 +152,7 @@ socket_control(Connection, Socket, Pid, Transport, ListenTracker) -> %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- send(Pid, Data) -> - sync_send_all_state_event(Pid, {application_data, + call(Pid, {application_data, %% iolist_to_binary should really %% be called iodata_to_binary() erlang:iolist_to_binary(Data)}). @@ -160,7 +164,7 @@ send(Pid, Data) -> %% Description: Receives data when active = false %%-------------------------------------------------------------------- recv(Pid, Length, Timeout) -> - sync_send_all_state_event(Pid, {recv, Length, Timeout}). + call(Pid, {recv, Length, Timeout}). %%-------------------------------------------------------------------- -spec connection_information(pid()) -> {ok, list()} | {error, reason()}. @@ -168,7 +172,7 @@ recv(Pid, Length, Timeout) -> %% Description: Get the SNI hostname %%-------------------------------------------------------------------- connection_information(Pid) when is_pid(Pid) -> - sync_send_all_state_event(Pid, connection_information). + call(Pid, connection_information). %%-------------------------------------------------------------------- -spec close(pid(), {close, Timeout::integer() | @@ -178,7 +182,7 @@ connection_information(Pid) when is_pid(Pid) -> %% Description: Close an ssl connection %%-------------------------------------------------------------------- close(ConnectionPid, How) -> - case sync_send_all_state_event(ConnectionPid, How) of + case call(ConnectionPid, How) of {error, closed} -> ok; Other -> @@ -190,7 +194,7 @@ close(ConnectionPid, How) -> %% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- shutdown(ConnectionPid, How) -> - sync_send_all_state_event(ConnectionPid, {shutdown, How}). + call(ConnectionPid, {shutdown, How}). %%-------------------------------------------------------------------- -spec new_user(pid(), pid()) -> ok | {error, reason()}. @@ -199,7 +203,7 @@ shutdown(ConnectionPid, How) -> %% or once. %%-------------------------------------------------------------------- new_user(ConnectionPid, User) -> - sync_send_all_state_event(ConnectionPid, {new_user, User}). + call(ConnectionPid, {new_user, User}). %%-------------------------------------------------------------------- -spec negotiated_protocol(pid()) -> {ok, binary()} | {error, reason()}. @@ -207,7 +211,7 @@ new_user(ConnectionPid, User) -> %% Description: Returns the negotiated protocol %%-------------------------------------------------------------------- negotiated_protocol(ConnectionPid) -> - sync_send_all_state_event(ConnectionPid, negotiated_protocol). + call(ConnectionPid, negotiated_protocol). %%-------------------------------------------------------------------- -spec get_opts(pid(), list()) -> {ok, list()} | {error, reason()}. @@ -215,14 +219,14 @@ negotiated_protocol(ConnectionPid) -> %% Description: Same as inet:getopts/2 %%-------------------------------------------------------------------- get_opts(ConnectionPid, OptTags) -> - sync_send_all_state_event(ConnectionPid, {get_opts, OptTags}). + call(ConnectionPid, {get_opts, OptTags}). %%-------------------------------------------------------------------- -spec set_opts(pid(), list()) -> ok | {error, reason()}. %% %% Description: Same as inet:setopts/2 %%-------------------------------------------------------------------- set_opts(ConnectionPid, Options) -> - sync_send_all_state_event(ConnectionPid, {set_opts, Options}). + call(ConnectionPid, {set_opts, Options}). %%-------------------------------------------------------------------- -spec session_info(pid()) -> {ok, list()} | {error, reason()}. @@ -230,7 +234,7 @@ set_opts(ConnectionPid, Options) -> %% Description: Returns info about the ssl session %%-------------------------------------------------------------------- session_info(ConnectionPid) -> - sync_send_all_state_event(ConnectionPid, session_info). + call(ConnectionPid, session_info). %%-------------------------------------------------------------------- -spec peer_certificate(pid()) -> {ok, binary()| undefined} | {error, reason()}. @@ -238,7 +242,7 @@ session_info(ConnectionPid) -> %% Description: Returns the peer cert %%-------------------------------------------------------------------- peer_certificate(ConnectionPid) -> - sync_send_all_state_event(ConnectionPid, peer_certificate). + call(ConnectionPid, peer_certificate). %%-------------------------------------------------------------------- -spec renegotiation(pid()) -> ok | {error, reason()}. @@ -246,7 +250,7 @@ peer_certificate(ConnectionPid) -> %% Description: Starts a renegotiation of the ssl session. %%-------------------------------------------------------------------- renegotiation(ConnectionPid) -> - sync_send_all_state_event(ConnectionPid, renegotiate). + call(ConnectionPid, renegotiate). %%-------------------------------------------------------------------- -spec prf(pid(), binary() | 'master_secret', binary(), @@ -256,9 +260,13 @@ renegotiation(ConnectionPid) -> %% Description: use a ssl sessions TLS PRF to generate key material %%-------------------------------------------------------------------- prf(ConnectionPid, Secret, Label, Seed, WantedLength) -> - sync_send_all_state_event(ConnectionPid, {prf, Secret, Label, Seed, WantedLength}). - + call(ConnectionPid, {prf, Secret, Label, Seed, WantedLength}). +%%-------------------------------------------------------------------- +-spec handle_session(#server_hello{}, ssl_record:ssl_version(), + binary(), #connection_states{}, _,_, #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- handle_session(#server_hello{cipher_suite = CipherSuite, compression_method = Compression}, Version, NewId, ConnectionStates, ProtoExt, Protocol0, @@ -290,61 +298,104 @@ handle_session(#server_hello{cipher_suite = CipherSuite, handle_resumed_session(NewId, State#state{connection_states = ConnectionStates}) end. - + %%-------------------------------------------------------------------- --spec hello(start | #hello_request{} | #server_hello{} | term(), - #state{}, tls_connection | dtls_connection) -> - gen_fsm_state_return(). +-spec ssl_config(#ssl_options{}, client | server, #state{}) -> #state{}. %%-------------------------------------------------------------------- -hello(start, #state{role = server} = State0, Connection) -> - {Record, State} = Connection:next_record(State0), - Connection:next_state(hello, hello, Record, State); +ssl_config(Opts, Role, State) -> + {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbInfo, + OwnCert, Key, DHParams} = + ssl_config:init(Opts, Role), + Handshake = ssl_handshake:init_handshake_history(), + TimeStamp = erlang:monotonic_time(), + Session = State#state.session, + State#state{tls_handshake_history = Handshake, + session = Session#session{own_certificate = OwnCert, + time_stamp = TimeStamp}, + file_ref_db = FileRefHandle, + cert_db_ref = Ref, + cert_db = CertDbHandle, + crl_db = CRLDbInfo, + session_cache = CacheHandle, + private_key = Key, + diffie_hellman_params = DHParams, + ssl_options = Opts}. -hello(#hello_request{}, #state{role = client} = State0, Connection) -> - {Record, State} = Connection:next_record(State0), - Connection:next_state(hello, hello, Record, State); +%%==================================================================== +%% gen_statem state functions +%%==================================================================== +%%-------------------------------------------------------------------- +-spec init(gen_statem:event_type(), + {start, timeout()} | {start, {list(), list()}, timeout()}| term(), + #state{}, tls_connection | dtls_connection) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- -hello({common_client_hello, Type, ServerHelloExt}, - State, Connection) -> +init({call, From}, {start, Timeout}, State0, Connection) -> + Timer = start_or_recv_cancel_timer(Timeout, From), + {Record, State} = Connection:next_record(State0#state{start_or_recv_from = From, + timer = Timer}), + Connection:next_event(hello, Record, State); +init({call, From}, {start, {Opts, EmOpts}, Timeout}, + #state{role = Role} = State0, Connection) -> + try + State = ssl_config(Opts, Role, State0), + init({call, From}, {start, Timeout}, + State#state{ssl_options = Opts, socket_options = EmOpts}, Connection) + catch throw:Error -> + {stop_and_reply, normal, {reply, From, {error, Error}}} + end; +init({call, From}, Msg, State, Connection) -> + handle_call(Msg, From, init, State, Connection); +init(_Type, _Event, _State, _Connection) -> + {keep_state_and_data, [postpone]}. + +%%-------------------------------------------------------------------- +-spec hello(gen_statem:event_type(), + #hello_request{} | #server_hello{} | term(), + #state{}, tls_connection | dtls_connection) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +hello({call, From}, Msg, State, Connection) -> + handle_call(Msg, From, hello, State, Connection); +hello(internal, {common_client_hello, Type, ServerHelloExt}, State, Connection) -> do_server_hello(Type, ServerHelloExt, State, Connection); -hello(timeout, State, _) -> - {next_state, hello, State, hibernate}; - -hello(Msg, State, Connection) -> - Connection:handle_unexpected_message(Msg, hello, State). +hello(info, Msg, State, _) -> + handle_info(Msg, hello, State); +hello(Type, Msg, State, Connection) -> + handle_common_event(Type, Msg, hello, State, Connection). %%-------------------------------------------------------------------- --spec abbreviated(#hello_request{} | #finished{} | term(), +-spec abbreviated(gen_statem:event_type(), + #hello_request{} | #finished{} | term(), #state{}, tls_connection | dtls_connection) -> - gen_fsm_state_return(). + gen_statem:state_function_result(). %%-------------------------------------------------------------------- -abbreviated(#hello_request{}, State0, Connection) -> - {Record, State} = Connection:next_record(State0), - Connection:next_state(abbreviated, hello, Record, State); +abbreviated({call, From}, Msg, State, Connection) -> + handle_call(Msg, From, abbreviated, State, Connection); -abbreviated(#finished{verify_data = Data} = Finished, +abbreviated(internal, #finished{verify_data = Data} = Finished, #state{role = server, negotiated_version = Version, expecting_finished = true, tls_handshake_history = Handshake, session = #session{master_secret = MasterSecret}, connection_states = ConnectionStates0} = - State, Connection) -> + State0, Connection) -> case ssl_handshake:verify_connection(Version, Finished, client, get_current_prf(ConnectionStates0, write), MasterSecret, Handshake) of verified -> ConnectionStates = ssl_record:set_client_verify_data(current_both, Data, ConnectionStates0), - Connection:next_state_connection(abbreviated, - ack_connection( - State#state{connection_states = ConnectionStates, - expecting_finished = false})); + {Record, State} = prepare_connection(State0#state{connection_states = ConnectionStates, + expecting_finished = false}, Connection), + Connection:next_event(connection, Record, State); #alert{} = Alert -> - Connection:handle_own_alert(Alert, Version, abbreviated, State) + Connection:handle_own_alert(Alert, Version, abbreviated, State0) end; -abbreviated(#finished{verify_data = Data} = Finished, +abbreviated(internal, #finished{verify_data = Data} = Finished, #state{role = client, tls_handshake_history = Handshake0, session = #session{master_secret = MasterSecret}, negotiated_version = Version, @@ -355,40 +406,49 @@ abbreviated(#finished{verify_data = Data} = Finished, verified -> ConnectionStates1 = ssl_record:set_server_verify_data(current_read, Data, ConnectionStates0), - State = + State1 = finalize_handshake(State0#state{connection_states = ConnectionStates1}, abbreviated, Connection), - Connection:next_state_connection(abbreviated, - ack_connection(State#state{expecting_finished = false})); - #alert{} = Alert -> + {Record, State} = prepare_connection(State1#state{expecting_finished = false}, Connection), + Connection:next_event(connection, Record, State); + #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, abbreviated, State0) end; %% only allowed to send next_protocol message after change cipher spec %% & before finished message and it is not allowed during renegotiation -abbreviated(#next_protocol{selected_protocol = SelectedProtocol}, +abbreviated(internal, #next_protocol{selected_protocol = SelectedProtocol}, #state{role = server, expecting_next_protocol_negotiation = true} = State0, Connection) -> - {Record, State} = Connection:next_record(State0#state{negotiated_protocol = SelectedProtocol}), - Connection:next_state(abbreviated, abbreviated, Record, State#state{expecting_next_protocol_negotiation = false}); - -abbreviated(timeout, State, _) -> - {next_state, abbreviated, State, hibernate }; - -abbreviated(Msg, State, Connection) -> - Connection:handle_unexpected_message(Msg, abbreviated, State). - + {Record, State} = + Connection:next_record(State0#state{negotiated_protocol = SelectedProtocol}), + Connection:next_event(abbreviated, Record, + State#state{expecting_next_protocol_negotiation = false}); +abbreviated(internal, + #change_cipher_spec{type = <<1>>}, #state{connection_states = ConnectionStates0} = + State0, Connection) -> + ConnectionStates1 = + ssl_record:activate_pending_connection_state(ConnectionStates0, read), + {Record, State} = Connection:next_record(State0#state{connection_states = + ConnectionStates1}), + Connection:next_event(abbreviated, Record, State#state{expecting_finished = true}); +abbreviated(info, Msg, State, _) -> + handle_info(Msg, abbreviated, State); +abbreviated(Type, Msg, State, Connection) -> + handle_common_event(Type, Msg, abbreviated, State, Connection). + %%-------------------------------------------------------------------- --spec certify(#hello_request{} | #certificate{} | #server_key_exchange{} | +-spec certify(gen_statem:event_type(), + #hello_request{} | #certificate{} | #server_key_exchange{} | #certificate_request{} | #server_hello_done{} | #client_key_exchange{} | term(), #state{}, tls_connection | dtls_connection) -> - gen_fsm_state_return(). + gen_statem:state_function_result(). %%-------------------------------------------------------------------- -certify(#hello_request{}, State0, Connection) -> - {Record, State} = Connection:next_record(State0), - Connection:next_state(certify, hello, Record, State); - -certify(#certificate{asn1_certificates = []}, +certify({call, From}, Msg, State, Connection) -> + handle_call(Msg, From, certify, State, Connection); +certify(info, Msg, State, _) -> + handle_info(Msg, certify, State); +certify(internal, #certificate{asn1_certificates = []}, #state{role = server, negotiated_version = Version, ssl_options = #ssl_options{verify = verify_peer, fail_if_no_peer_cert = true}} = @@ -396,15 +456,16 @@ certify(#certificate{asn1_certificates = []}, Alert = ?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE), Connection:handle_own_alert(Alert, Version, certify, State); -certify(#certificate{asn1_certificates = []}, +certify(internal, #certificate{asn1_certificates = []}, #state{role = server, ssl_options = #ssl_options{verify = verify_peer, fail_if_no_peer_cert = false}} = State0, Connection) -> - {Record, State} = Connection:next_record(State0#state{client_certificate_requested = false}), - Connection:next_state(certify, certify, Record, State); + {Record, State} = + Connection:next_record(State0#state{client_certificate_requested = false}), + Connection:next_event(certify, Record, State); -certify(#certificate{} = Cert, +certify(internal, #certificate{} = Cert, #state{negotiated_version = Version, role = Role, cert_db = CertDbHandle, @@ -426,7 +487,7 @@ certify(#certificate{} = Cert, Connection:handle_own_alert(Alert, Version, certify, State) end; -certify(#server_key_exchange{exchange_keys = Keys}, +certify(internal, #server_key_exchange{exchange_keys = Keys}, #state{role = client, negotiated_version = Version, key_algorithm = Alg, public_key_info = PubKeyInfo, @@ -438,28 +499,28 @@ certify(#server_key_exchange{exchange_keys = Keys}, Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon -> Params = ssl_handshake:decode_server_key(Keys, Alg, Version), + %% Use negotiated value if TLS-1.2 otherwhise return default HashSign = negotiated_hashsign(Params#server_key_params.hashsign, Alg, PubKeyInfo, Version), + case is_anonymous(Alg) of true -> calculate_secret(Params#server_key_params.params, State#state{hashsign_algorithm = HashSign}, Connection); false -> - case ssl_handshake:verify_server_key(Params, HashSign, ConnectionStates, Version, PubKeyInfo) of + case ssl_handshake:verify_server_key(Params, HashSign, + ConnectionStates, Version, PubKeyInfo) of true -> calculate_secret(Params#server_key_params.params, - State#state{hashsign_algorithm = HashSign}, Connection); + State#state{hashsign_algorithm = HashSign}, + Connection); false -> Connection:handle_own_alert(?ALERT_REC(?FATAL, ?DECRYPT_ERROR), Version, certify, State) end end; -certify(#server_key_exchange{} = Msg, - #state{role = client, key_algorithm = rsa} = State, Connection) -> - Connection:handle_unexpected_message(Msg, certify_server_keyexchange, State); - -certify(#certificate_request{hashsign_algorithms = HashSigns}, +certify(internal, #certificate_request{hashsign_algorithms = HashSigns}, #state{session = #session{own_certificate = Cert}, key_algorithm = KeyExAlg, ssl_options = #ssl_options{signature_algs = SupportedHashSigns}, @@ -470,12 +531,12 @@ certify(#certificate_request{hashsign_algorithms = HashSigns}, Connection:handle_own_alert(Alert, Version, certify, State0); NegotiatedHashSign -> {Record, State} = Connection:next_record(State0#state{client_certificate_requested = true}), - Connection:next_state(certify, certify, Record, + Connection:next_event(certify, Record, State#state{cert_hashsign_algorithm = NegotiatedHashSign}) end; %% PSK and RSA_PSK might bypass the Server-Key-Exchange -certify(#server_hello_done{}, +certify(internal, #server_hello_done{}, #state{session = #session{master_secret = undefined}, negotiated_version = Version, psk_identity = PSKIdentity, @@ -493,10 +554,10 @@ certify(#server_hello_done{}, client_certify_and_key_exchange(State, Connection) end; -certify(#server_hello_done{}, +certify(internal, #server_hello_done{}, #state{session = #session{master_secret = undefined}, ssl_options = #ssl_options{user_lookup_fun = PSKLookup}, - negotiated_version = {Major, Minor}, + negotiated_version = {Major, Minor} = Version, psk_identity = PSKIdentity, premaster_secret = undefined, role = client, @@ -504,16 +565,18 @@ certify(#server_hello_done{}, when Alg == rsa_psk -> Rand = ssl_cipher:random_bytes(?NUM_OF_PREMASTERSECRET_BYTES-2), RSAPremasterSecret = <<?BYTE(Major), ?BYTE(Minor), Rand/binary>>, - case ssl_handshake:premaster_secret({Alg, PSKIdentity}, PSKLookup, RSAPremasterSecret) of + case ssl_handshake:premaster_secret({Alg, PSKIdentity}, PSKLookup, + RSAPremasterSecret) of #alert{} = Alert -> - Alert; + Connection:handle_own_alert(Alert, Version, certify, State0); PremasterSecret -> - State = master_secret(PremasterSecret, State0#state{premaster_secret = RSAPremasterSecret}), + State = master_secret(PremasterSecret, + State0#state{premaster_secret = RSAPremasterSecret}), client_certify_and_key_exchange(State, Connection) end; %% Master secret was determined with help of server-key exchange msg -certify(#server_hello_done{}, +certify(internal, #server_hello_done{}, #state{session = #session{master_secret = MasterSecret} = Session, connection_states = ConnectionStates0, negotiated_version = Version, @@ -529,7 +592,7 @@ certify(#server_hello_done{}, end; %% Master secret is calculated from premaster_secret -certify(#server_hello_done{}, +certify(internal, #server_hello_done{}, #state{session = Session0, connection_states = ConnectionStates0, negotiated_version = Version, @@ -546,14 +609,15 @@ certify(#server_hello_done{}, Connection:handle_own_alert(Alert, Version, certify, State0) end; -certify(#client_key_exchange{} = Msg, +certify(internal = Type, #client_key_exchange{} = Msg, #state{role = server, client_certificate_requested = true, - ssl_options = #ssl_options{fail_if_no_peer_cert = true}} = State, Connection) -> + ssl_options = #ssl_options{fail_if_no_peer_cert = true}} = State, + Connection) -> %% We expect a certificate here - Connection:handle_unexpected_message(Msg, certify_client_key_exchange, State); + handle_common_event(Type, Msg, certify, State, Connection); -certify(#client_key_exchange{exchange_keys = Keys}, +certify(internal, #client_key_exchange{exchange_keys = Keys}, State = #state{key_algorithm = KeyAlg, negotiated_version = Version}, Connection) -> try certify_client_key_exchange(ssl_handshake:decode_client_key(Keys, KeyAlg, Version), @@ -563,22 +627,23 @@ certify(#client_key_exchange{exchange_keys = Keys}, Connection:handle_own_alert(Alert, Version, certify, State) end; -certify(timeout, State, _) -> - {next_state, certify, State, hibernate}; - -certify(Msg, State, Connection) -> - Connection:handle_unexpected_message(Msg, certify, State). - +certify(Type, Msg, State, Connection) -> + handle_common_event(Type, Msg, certify, State, Connection). + %%-------------------------------------------------------------------- --spec cipher(#hello_request{} | #certificate_verify{} | #finished{} | term(), +-spec cipher(gen_statem:event_type(), + #hello_request{} | #certificate_verify{} | #finished{} | term(), #state{}, tls_connection | dtls_connection) -> - gen_fsm_state_return(). + gen_statem:state_function_result(). %%-------------------------------------------------------------------- -cipher(#hello_request{}, State0, Connection) -> - {Record, State} = Connection:next_record(State0), - Connection:next_state(cipher, hello, Record, State); +cipher({call, From}, Msg, State, Connection) -> + handle_call(Msg, From, cipher, State, Connection); -cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashSign}, +cipher(info, Msg, State, _) -> + handle_info(Msg, cipher, State); + +cipher(internal, #certificate_verify{signature = Signature, + hashsign_algorithm = CertHashSign}, #state{role = server, key_algorithm = KexAlg, public_key_info = PublicKeyInfo, @@ -593,19 +658,20 @@ cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashS Version, HashSign, MasterSecret, Handshake) of valid -> {Record, State} = Connection:next_record(State0), - Connection:next_state(cipher, cipher, Record, + Connection:next_event(cipher, Record, State#state{cert_hashsign_algorithm = HashSign}); #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, cipher, State0) end; %% client must send a next protocol message if we are expecting it -cipher(#finished{}, #state{role = server, expecting_next_protocol_negotiation = true, - negotiated_protocol = undefined, negotiated_version = Version} = State0, +cipher(internal, #finished{}, + #state{role = server, expecting_next_protocol_negotiation = true, + negotiated_protocol = undefined, negotiated_version = Version} = State0, Connection) -> Connection:handle_own_alert(?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), Version, cipher, State0); -cipher(#finished{verify_data = Data} = Finished, +cipher(internal, #finished{verify_data = Data} = Finished, #state{negotiated_version = Version, host = Host, port = Port, @@ -621,109 +687,154 @@ cipher(#finished{verify_data = Data} = Finished, MasterSecret, Handshake0) of verified -> Session = register_session(Role, Host, Port, Session0), - cipher_role(Role, Data, Session, State#state{expecting_finished = false}, Connection); + cipher_role(Role, Data, Session, + State#state{expecting_finished = false}, Connection); #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, cipher, State) end; %% only allowed to send next_protocol message after change cipher spec %% & before finished message and it is not allowed during renegotiation -cipher(#next_protocol{selected_protocol = SelectedProtocol}, +cipher(internal, #next_protocol{selected_protocol = SelectedProtocol}, #state{role = server, expecting_next_protocol_negotiation = true, expecting_finished = true} = State0, Connection) -> - {Record, State} = Connection:next_record(State0#state{negotiated_protocol = SelectedProtocol}), - Connection:next_state(cipher, cipher, Record, State#state{expecting_next_protocol_negotiation = false}); - -cipher(timeout, State, _) -> - {next_state, cipher, State, hibernate}; - -cipher(Msg, State, Connection) -> - Connection:handle_unexpected_message(Msg, cipher, State). + {Record, State} = + Connection:next_record(State0#state{negotiated_protocol = SelectedProtocol}), + Connection:next_event(cipher, Record, + State#state{expecting_next_protocol_negotiation = false}); +cipher(internal, #change_cipher_spec{type = <<1>>}, #state{connection_states = ConnectionStates0} = + State0, Connection) -> + ConnectionStates1 = + ssl_record:activate_pending_connection_state(ConnectionStates0, read), + {Record, State} = Connection:next_record(State0#state{connection_states = + ConnectionStates1}), + Connection:next_event(cipher, Record, State#state{expecting_finished = true}); +cipher(Type, Msg, State, Connection) -> + handle_common_event(Type, Msg, cipher, State, Connection). %%-------------------------------------------------------------------- --spec connection(term(), #state{}, tls_connection | dtls_connection) -> - gen_fsm_state_return(). +-spec connection(gen_statem:event_type(), term(), + #state{}, tls_connection | dtls_connection) -> + gen_statem:state_function_result(). %%-------------------------------------------------------------------- -connection(timeout, State, _) -> - {next_state, connection, State, hibernate}; +connection({call, From}, {application_data, Data}, + #state{protocol_cb = Connection} = State, Connection) -> + %% We should look into having a worker process to do this to + %% parallize send and receive decoding and not block the receiver + %% if sending is overloading the socket. + try + Connection:write_application_data(Data, From, State) + catch throw:Error -> + hibernate_after(connection, State, [{reply, From, Error}]) + end; +connection({call, RecvFrom}, {recv, N, Timeout}, + #state{protocol_cb = Connection, socket_options = + #socket_options{active = false}} = State0, Connection) -> + Timer = start_or_recv_cancel_timer(Timeout, RecvFrom), + Connection:passive_receive(State0#state{bytes_to_read = N, + start_or_recv_from = RecvFrom, + timer = Timer}, connection); +connection({call, From}, renegotiate, #state{protocol_cb = Connection} = State, + Connection) -> + Connection:renegotiate(State#state{renegotiation = {true, From}}, []); +connection({call, From}, peer_certificate, + #state{session = #session{peer_certificate = Cert}} = State, _) -> + hibernate_after(connection, State, [{reply, From, {ok, Cert}}]); +connection({call, From}, connection_information, State, _) -> + Info = connection_info(State), + hibernate_after(connection, State, [{reply, From, {ok, Info}}]); +connection({call, From}, session_info, #state{session = #session{session_id = Id, + cipher_suite = Suite}} = State, _) -> + SessionInfo = [{session_id, Id}, + {cipher_suite, ssl_cipher:erl_suite_definition(Suite)}], + hibernate_after(connection, State, [{reply, From, SessionInfo}]); +connection({call, From}, negotiated_protocol, + #state{negotiated_protocol = undefined} = State, _) -> + hibernate_after(connection, State, [{reply, From, {error, protocol_not_negotiated}}]); +connection({call, From}, negotiated_protocol, + #state{negotiated_protocol = SelectedProtocol} = State, _) -> + hibernate_after(connection, State, + [{reply, From, {ok, SelectedProtocol}}]); +connection({call, From}, Msg, State, Connection) -> + handle_call(Msg, From, connection, State, Connection); +connection(info, Msg, State, _) -> + handle_info(Msg, connection, State); +connection(internal, {recv, _}, State, Connection) -> + Connection:passive_receive(State, connection); +connection(Type, Msg, State, Connection) -> + handle_common_event(Type, Msg, connection, State, Connection). -connection(Msg, State, Connection) -> - Connection:handle_unexpected_message(Msg, connection, State). +%%-------------------------------------------------------------------- +-spec downgrade(gen_statem:event_type(), term(), + #state{}, tls_connection | dtls_connection) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +downgrade(internal, #alert{description = ?CLOSE_NOTIFY}, + #state{transport_cb = Transport, socket = Socket, + downgrade = {Pid, From}} = State, _) -> + ssl_socket:setopts(Transport, Socket, [{active, false}, {packet, 0}, {mode, binary}]), + Transport:controlling_process(Socket, Pid), + gen_statem:reply(From, {ok, Socket}), + {stop, normal, State}; +downgrade(timeout, downgrade, #state{downgrade = {_, From}} = State, _) -> + gen_statem:reply(From, {error, timeout}), + {stop, normal, State}; +downgrade(Type, Event, State, Connection) -> + handle_common_event(Type, Event, downgrade, State, Connection). %%-------------------------------------------------------------------- -%% Description: Whenever a gen_fsm receives an event sent using -%% gen_fsm:sync_send_all_state_event/2,3, this function is called to handle -%% the event. +%% Event handling functions called by state functions to handle +%% common or unexpected events for the state. %%-------------------------------------------------------------------- -handle_sync_event({application_data, Data}, From, connection, - #state{protocol_cb = Connection} = State) -> - %% We should look into having a worker process to do this to - %% parallize send and receive decoding and not block the receiver - %% if sending is overloading the socket. - try - Connection:write_application_data(Data, From, State) - catch throw:Error -> - {reply, Error, connection, State, get_timeout(State)} +handle_common_event(internal, {tls_record, TLSRecord}, StateName, State, Connection) -> + Connection:handle_common_event(internal, TLSRecord, StateName, State); +handle_common_event(internal, #hello_request{}, StateName, #state{role = client} = State0, Connection) + when StateName =:= connection -> + {Record, State} = Connection:next_record(State0), + Connection:next_event(StateName, Record, State); +handle_common_event(timeout, hibernate, _, _, _) -> + {keep_state_and_data, [hibernate]}; +handle_common_event(internal, {application_data, Data}, StateName, State0, Connection) -> + case Connection:read_application_data(Data, State0) of + {stop, Reason, State} -> + {stop, Reason, State}; + {Record, State} -> + Connection:next_event(StateName, Record, State) end; -handle_sync_event({application_data, Data}, From, StateName, - #state{send_queue = Queue} = State) -> +handle_common_event(internal, #change_cipher_spec{type = <<1>>}, StateName, + #state{negotiated_version = Version} = State, Connection) -> + Connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Version, + StateName, State); +handle_common_event(internal, _, _, _, _) -> + {keep_state_and_data, [postpone]}; +handle_common_event(_Type, Msg, StateName, #state{negotiated_version = Version} = State, + Connection) -> + Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), + Connection:handle_own_alert(Alert, Version, {StateName, Msg}, State). + +handle_call({application_data, _Data}, _, _, _, _) -> %% In renegotiation priorities handshake, send data when handshake is finished - {next_state, StateName, - State#state{send_queue = queue:in({From, Data}, Queue)}, - get_timeout(State)}; - -handle_sync_event({start, Timeout}, StartFrom, hello, #state{role = Role, - protocol_cb = Connection, - ssl_options = SSLOpts} = State0) -> - try - State = ssl_config(SSLOpts, Role, State0), - Timer = start_or_recv_cancel_timer(Timeout, StartFrom), - Connection:hello(start, State#state{start_or_recv_from = StartFrom, - timer = Timer}) - catch throw:Error -> - {stop, normal, {error, Error}, State0} - end; - -handle_sync_event({start, {Opts, EmOpts}, Timeout}, From, StateName, State) -> - try - handle_sync_event({start, Timeout}, From, StateName, State#state{socket_options = EmOpts, - ssl_options = Opts}) - catch throw:Error -> - {stop, normal, {error, Error}, State} - end; - -%% These two clauses below could happen if a server upgrades a socket in -%% active mode. Note that in this case we are lucky that -%% controlling_process has been evalueated before receiving handshake -%% messages from client. The server should put the socket in passive -%% mode before telling the client that it is willing to upgrade -%% and before calling ssl:ssl_accept/2. These clauses are -%% here to make sure it is the users problem and not owers if -%% they upgrade an active socket. -handle_sync_event({start,_}, _, connection, State) -> - {reply, connected, connection, State, get_timeout(State)}; - -handle_sync_event({start, Timeout}, StartFrom, StateName, #state{role = Role, ssl_options = SslOpts} = State0) -> - try - State = ssl_config(SslOpts, Role, State0), - Timer = start_or_recv_cancel_timer(Timeout, StartFrom), - {next_state, StateName, State#state{start_or_recv_from = StartFrom, - timer = Timer}, get_timeout(State)} - catch throw:Error -> - {stop, normal, {error, Error}, State0} - end; - -handle_sync_event({close, _} = Close, _, StateName, #state{protocol_cb = Connection} = State) -> + {keep_state_and_data, [postpone]}; +handle_call({close, {Pid, Timeout}}, From, StateName, State0, Connection) when is_pid(Pid) -> + %% terminate will send close alert to peer + State = State0#state{downgrade = {Pid, From}}, + Connection:terminate(downgrade, StateName, State), + %% User downgrades connection + %% When downgrading an TLS connection to a transport connection + %% we must recive the close alert from the peer before releasing the + %% transport socket. + {next_state, downgrade, State, [{timeout, Timeout, downgrade}]}; +handle_call({close, _} = Close, From, StateName, State, Connection) -> %% Run terminate before returning so that the reuseaddr - %% inet-option and possible downgrade will work as intended. + %% inet-option Result = Connection:terminate(Close, StateName, State), - {stop, normal, Result, State#state{terminated = true}}; - -handle_sync_event({shutdown, How0}, _, StateName, - #state{transport_cb = Transport, - negotiated_version = Version, - connection_states = ConnectionStates, - socket = Socket} = State) -> + {stop_and_reply, {shutdown, normal}, + {reply, From, Result}, State}; +handle_call({shutdown, How0}, From, _, + #state{transport_cb = Transport, + negotiated_version = Version, + connection_states = ConnectionStates, + socket = Socket}, _) -> case How0 of How when How == write; How == both -> Alert = ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), @@ -733,95 +844,91 @@ handle_sync_event({shutdown, How0}, _, StateName, _ -> ok end, - + case Transport:shutdown(Socket, How0) of ok -> - {reply, ok, StateName, State, get_timeout(State)}; + {keep_state_and_data, [{reply, From, ok}]}; Error -> - {stop, normal, Error, State} + gen_statem:reply(From, {error, Error}), + {stop, normal} end; -handle_sync_event({recv, _N, _Timeout}, _RecvFrom, StateName, - #state{socket_options = #socket_options{active = Active}} = State) when Active =/= false -> - {reply, {error, einval}, StateName, State, get_timeout(State)}; -handle_sync_event({recv, N, Timeout}, RecvFrom, connection = StateName, - #state{protocol_cb = Connection} = State0) -> - Timer = start_or_recv_cancel_timer(Timeout, RecvFrom), - Connection:passive_receive(State0#state{bytes_to_read = N, - start_or_recv_from = RecvFrom, timer = Timer}, StateName); -%% Doing renegotiate wait with handling request until renegotiate is -%% finished. Will be handled by next_state_is_connection/2. -handle_sync_event({recv, N, Timeout}, RecvFrom, StateName, State) -> +handle_call({recv, _N, _Timeout}, From, _, + #state{socket_options = + #socket_options{active = Active}}, _) when Active =/= false -> + {keep_state_and_data, [{reply, From, {error, einval}}]}; +handle_call({recv, N, Timeout}, RecvFrom, StateName, State, _) -> + %% Doing renegotiate wait with handling request until renegotiate is + %% finished. Timer = start_or_recv_cancel_timer(Timeout, RecvFrom), {next_state, StateName, State#state{bytes_to_read = N, start_or_recv_from = RecvFrom, - timer = Timer}, - get_timeout(State)}; -handle_sync_event({new_user, User}, _From, StateName, - State =#state{user_application = {OldMon, _}}) -> + timer = Timer}, + [{next_event, internal, {recv, RecvFrom}}]}; +handle_call({new_user, User}, From, StateName, + State =#state{user_application = {OldMon, _}}, _) -> NewMon = erlang:monitor(process, User), erlang:demonitor(OldMon, [flush]), - {reply, ok, StateName, State#state{user_application = {NewMon,User}}, - get_timeout(State)}; -handle_sync_event({get_opts, OptTags}, _From, StateName, + {next_state, StateName, State#state{user_application = {NewMon,User}}, + [{reply, From, ok}]}; +handle_call({get_opts, OptTags}, From, _, #state{socket = Socket, transport_cb = Transport, - socket_options = SockOpts} = State) -> + socket_options = SockOpts}, _) -> OptsReply = get_socket_opts(Transport, Socket, OptTags, SockOpts, []), - {reply, OptsReply, StateName, State, get_timeout(State)}; -handle_sync_event(negotiated_protocol, _From, StateName, #state{negotiated_protocol = undefined} = State) -> - {reply, {error, protocol_not_negotiated}, StateName, State, get_timeout(State)}; -handle_sync_event(negotiated_protocol, _From, StateName, #state{negotiated_protocol = SelectedProtocol} = State) -> - {reply, {ok, SelectedProtocol}, StateName, State, get_timeout(State)}; -handle_sync_event({set_opts, Opts0}, _From, StateName0, - #state{socket_options = Opts1, + {keep_state_and_data, [{reply, From, OptsReply}]}; +handle_call({set_opts, Opts0}, From, connection = StateName0, + #state{socket_options = Opts1, protocol_cb = Connection, socket = Socket, transport_cb = Transport, - user_data_buffer = Buffer} = State0) -> + user_data_buffer = Buffer} = State0, _) -> {Reply, Opts} = set_socket_opts(Transport, Socket, Opts0, Opts1, []), State1 = State0#state{socket_options = Opts}, if Opts#socket_options.active =:= false -> - {reply, Reply, StateName0, State1, get_timeout(State1)}; + hibernate_after(StateName0, State1, [{reply, From, Reply}]); Buffer =:= <<>>, Opts1#socket_options.active =:= false -> %% Need data, set active once {Record, State2} = Connection:next_record_if_active(State1), %% Note: Renogotiation may cause StateName0 =/= StateName - case Connection:next_state(StateName0, StateName0, Record, State2) of - {next_state, StateName, State, Timeout} -> - {reply, Reply, StateName, State, Timeout}; + case Connection:next_event(StateName0, Record, State2) of + {next_state, StateName, State} -> + hibernate_after(StateName, State, [{reply, From, Reply}]); + {next_state, StateName, State, Actions} -> + hibernate_after(StateName, State, [{reply, From, Reply} | Actions]); {stop, Reason, State} -> {stop, Reason, State} end; Buffer =:= <<>> -> %% Active once already set - {reply, Reply, StateName0, State1, get_timeout(State1)}; + hibernate_after(StateName0, State1, [{reply, From, Reply}]); true -> case Connection:read_application_data(<<>>, State1) of - Stop = {stop,_,_} -> - Stop; + {stop, Reason, State} -> + {stop, Reason, State}; {Record, State2} -> %% Note: Renogotiation may cause StateName0 =/= StateName - case Connection:next_state(StateName0, StateName0, Record, State2) of - {next_state, StateName, State, Timeout} -> - {reply, Reply, StateName, State, Timeout}; - {stop, Reason, State} -> - {stop, Reason, State} + case Connection:next_event(StateName0, Record, State2) of + {next_state, StateName, State} -> + hibernate_after(StateName, State, [{reply, From, Reply}]); + {next_state, StateName, State, Actions} -> + hibernate_after(StateName, State, [{reply, From, Reply} | Actions]); + {stop, _, _} = Stop -> + Stop end end end; -handle_sync_event(renegotiate, From, connection, #state{protocol_cb = Connection} = State) -> - Connection:renegotiate(State#state{renegotiation = {true, From}}); -handle_sync_event(renegotiate, _, StateName, State) -> - {reply, {error, already_renegotiating}, StateName, State, get_timeout(State)}; -handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, - #state{connection_states = ConnectionStates, - negotiated_version = Version} = State) -> +handle_call(renegotiate, From, StateName, _, _) when StateName =/= connection -> + {keep_state_and_data, [{reply, From, {error, already_renegotiating}}]}; +handle_call({prf, Secret, Label, Seed, WantedLength}, From, _, + #state{connection_states = ConnectionStates, + negotiated_version = Version}, _) -> ConnectionState = ssl_record:current_connection_state(ConnectionStates, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{master_secret = MasterSecret, client_random = ClientRandom, - server_random = ServerRandom} = SecParams, + server_random = ServerRandom, + prf_algorithm = PRFAlgorithm} = SecParams, Reply = try SecretToUse = case Secret of _ when is_binary(Secret) -> Secret; @@ -832,32 +939,14 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, (client_random, Acc) -> [ClientRandom|Acc]; (server_random, Acc) -> [ServerRandom|Acc] end, [], Seed)), - ssl_handshake:prf(Version, SecretToUse, Label, SeedToUse, WantedLength) + ssl_handshake:prf(Version, PRFAlgorithm, SecretToUse, Label, SeedToUse, WantedLength) catch exit:_ -> {error, badarg}; error:Reason -> {error, Reason} end, - {reply, Reply, StateName, State, get_timeout(State)}; -handle_sync_event(session_info, _, StateName, - #state{session = #session{session_id = Id, - cipher_suite = Suite}} = State) -> - {reply, [{session_id, Id}, - {cipher_suite, ssl_cipher:erl_suite_definition(Suite)}], - StateName, State, get_timeout(State)}; -handle_sync_event(peer_certificate, _, StateName, - #state{session = #session{peer_certificate = Cert}} - = State) -> - {reply, {ok, Cert}, StateName, State, get_timeout(State)}; -handle_sync_event(connection_information, _, StateName, State) -> - Info = connection_info(State), - {reply, {ok, Info}, StateName, State, get_timeout(State)}. - -connection_info(#state{sni_hostname = SNIHostname, - session = #session{cipher_suite = CipherSuite}, - negotiated_version = Version, ssl_options = Opts}) -> - [{protocol, tls_record:protocol_version(Version)}, - {cipher_suite, ssl_cipher:erl_suite_definition(CipherSuite)}, - {sni_hostname, SNIHostname}] ++ ssl_options_list(Opts). + {keep_state_and_data, [{reply, From, Reply}]}; +handle_call(_,_,_,_,_) -> + {keep_state_and_data, [postpone]}. handle_info({ErrorTag, Socket, econnaborted}, StateName, #state{socket = Socket, transport_cb = Transport, @@ -865,7 +954,8 @@ handle_info({ErrorTag, Socket, econnaborted}, StateName, protocol_cb = Connection, error_tag = ErrorTag, tracker = Tracker} = State) when StateName =/= connection -> - Connection:alert_user(Transport, Tracker,Socket, StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role), + Connection:alert_user(Transport, Tracker,Socket, + StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role), {stop, normal, State}; handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket, @@ -888,47 +978,46 @@ handle_info({'EXIT', Socket, normal}, _StateName, #state{socket = Socket} = Stat {stop, {shutdown, transport_closed}, State}; handle_info(allow_renegotiate, StateName, State) -> - {next_state, StateName, State#state{allow_renegotiate = true}, get_timeout(State)}; + {next_state, StateName, State#state{allow_renegotiate = true}}; handle_info({cancel_start_or_recv, StartFrom}, StateName, #state{renegotiation = {false, first}} = State) when StateName =/= connection -> - gen_fsm:reply(StartFrom, {error, timeout}), - {stop, {shutdown, user_timeout}, State#state{timer = undefined}}; + {stop_and_reply, {shutdown, user_timeout}, + {reply, StartFrom, {error, timeout}}, State#state{timer = undefined}}; -handle_info({cancel_start_or_recv, RecvFrom}, StateName, #state{start_or_recv_from = RecvFrom} = State) -> - gen_fsm:reply(RecvFrom, {error, timeout}), +handle_info({cancel_start_or_recv, RecvFrom}, StateName, + #state{start_or_recv_from = RecvFrom} = State) when RecvFrom =/= undefined -> {next_state, StateName, State#state{start_or_recv_from = undefined, bytes_to_read = undefined, - timer = undefined}, get_timeout(State)}; + timer = undefined}, [{reply, RecvFrom, {error, timeout}}]}; handle_info({cancel_start_or_recv, _RecvFrom}, StateName, State) -> - {next_state, StateName, State#state{timer = undefined}, get_timeout(State)}; + {next_state, StateName, State#state{timer = undefined}}; handle_info(Msg, StateName, #state{socket = Socket, error_tag = Tag} = State) -> Report = io_lib:format("SSL: Got unexpected info: ~p ~n", [{Msg, Tag, Socket}]), error_logger:info_report(Report), - {next_state, StateName, State, get_timeout(State)}. - + {next_state, StateName, State}. +%%-------------------------------------------------------------------- +%% gen_statem callbacks +%%-------------------------------------------------------------------- terminate(_, _, #state{terminated = true}) -> %% Happens when user closes the connection using ssl:close/1 %% we want to guarantee that Transport:close has been called %% when ssl:close/1 returns. ok; + terminate({shutdown, transport_closed} = Reason, - _StateName, #state{send_queue = SendQueue, protocol_cb = Connection, - socket = Socket, transport_cb = Transport, - renegotiation = Renegotiate} = State) -> + _StateName, #state{protocol_cb = Connection, + socket = Socket, transport_cb = Transport} = State) -> handle_trusted_certs_db(State), - notify_senders(SendQueue), - notify_renegotiater(Renegotiate), Connection:close(Reason, Socket, Transport, undefined, undefined); -terminate({shutdown, own_alert}, _StateName, #state{send_queue = SendQueue, protocol_cb = Connection, - socket = Socket, transport_cb = Transport, - renegotiation = Renegotiate} = State) -> +terminate({shutdown, own_alert}, _StateName, #state{%%send_queue = SendQueue, + protocol_cb = Connection, + socket = Socket, + transport_cb = Transport} = State) -> handle_trusted_certs_db(State), - notify_senders(SendQueue), - notify_renegotiater(Renegotiate), case application:get_env(ssl, alert_timeout) of {ok, Timeout} when is_integer(Timeout) -> Connection:close({timeout, Timeout}, Socket, Transport, undefined, undefined); @@ -939,26 +1028,22 @@ terminate(Reason, connection, #state{negotiated_version = Version, protocol_cb = Connection, connection_states = ConnectionStates0, ssl_options = #ssl_options{padding_check = Check}, - transport_cb = Transport, socket = Socket, - send_queue = SendQueue, renegotiation = Renegotiate} = State) -> + transport_cb = Transport, socket = Socket + } = State) -> handle_trusted_certs_db(State), - notify_senders(SendQueue), - notify_renegotiater(Renegotiate), {BinAlert, ConnectionStates} = terminate_alert(Reason, Version, ConnectionStates0), Transport:send(Socket, BinAlert), Connection:close(Reason, Socket, Transport, ConnectionStates, Check); terminate(Reason, _StateName, #state{transport_cb = Transport, protocol_cb = Connection, - socket = Socket, send_queue = SendQueue, - renegotiation = Renegotiate} = State) -> + socket = Socket + } = State) -> handle_trusted_certs_db(State), - notify_senders(SendQueue), - notify_renegotiater(Renegotiate), Connection:close(Reason, Socket, Transport, undefined, undefined). -format_status(normal, [_, State]) -> - [{data, [{"StateData", State}]}]; -format_status(terminate, [_, State]) -> +format_status(normal, [_, StateName, State]) -> + [{data, [{"State", {StateName, State}}]}]; +format_status(terminate, [_, StateName, State]) -> SslOptions = (State#state.ssl_options), NewOptions = SslOptions#ssl_options{password = ?SECRET_PRINTOUT, cert = ?SECRET_PRINTOUT, @@ -967,39 +1052,29 @@ format_status(terminate, [_, State]) -> dh = ?SECRET_PRINTOUT, psk_identity = ?SECRET_PRINTOUT, srp_identity = ?SECRET_PRINTOUT}, - [{data, [{"StateData", State#state{connection_states = ?SECRET_PRINTOUT, - protocol_buffers = ?SECRET_PRINTOUT, - user_data_buffer = ?SECRET_PRINTOUT, - tls_handshake_history = ?SECRET_PRINTOUT, - session = ?SECRET_PRINTOUT, - private_key = ?SECRET_PRINTOUT, - diffie_hellman_params = ?SECRET_PRINTOUT, - diffie_hellman_keys = ?SECRET_PRINTOUT, - srp_params = ?SECRET_PRINTOUT, - srp_keys = ?SECRET_PRINTOUT, - premaster_secret = ?SECRET_PRINTOUT, - ssl_options = NewOptions - }}]}]. + [{data, [{"State", {StateName, State#state{connection_states = ?SECRET_PRINTOUT, + protocol_buffers = ?SECRET_PRINTOUT, + user_data_buffer = ?SECRET_PRINTOUT, + tls_handshake_history = ?SECRET_PRINTOUT, + session = ?SECRET_PRINTOUT, + private_key = ?SECRET_PRINTOUT, + diffie_hellman_params = ?SECRET_PRINTOUT, + diffie_hellman_keys = ?SECRET_PRINTOUT, + srp_params = ?SECRET_PRINTOUT, + srp_keys = ?SECRET_PRINTOUT, + premaster_secret = ?SECRET_PRINTOUT, + ssl_options = NewOptions} + }}]}]. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -ssl_config(Opts, Role, State) -> - {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbInfo, OwnCert, Key, DHParams} = - ssl_config:init(Opts, Role), - Handshake = ssl_handshake:init_handshake_history(), - TimeStamp = erlang:monotonic_time(), - Session = State#state.session, - State#state{tls_handshake_history = Handshake, - session = Session#session{own_certificate = OwnCert, - time_stamp = TimeStamp}, - file_ref_db = FileRefHandle, - cert_db_ref = Ref, - cert_db = CertDbHandle, - crl_db = CRLDbInfo, - session_cache = CacheHandle, - private_key = Key, - diffie_hellman_params = DHParams, - ssl_options = Opts}. +connection_info(#state{sni_hostname = SNIHostname, + session = #session{cipher_suite = CipherSuite}, + negotiated_version = Version, ssl_options = Opts}) -> + [{protocol, tls_record:protocol_version(Version)}, + {cipher_suite, ssl_cipher:erl_suite_definition(CipherSuite)}, + {sni_hostname, SNIHostname}] ++ ssl_options_list(Opts). do_server_hello(Type, #hello_extensions{next_protocol_negotiation = NextProtocols} = ServerHelloExt, @@ -1033,7 +1108,7 @@ new_server_hello(#server_hello{cipher_suite = CipherSuite, cipher_suite = CipherSuite, compression_method = Compression}, {Record, State} = Connection:next_record(State2#state{session = Session}), - Connection:next_state(hello, certify, Record, State) + Connection:next_event(certify, Record, State) catch #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, hello, State0) @@ -1051,7 +1126,7 @@ resumed_server_hello(#state{session = Session, State2 = finalize_handshake(State1, abbreviated, Connection), {Record, State} = Connection:next_record(State2), - Connection:next_state(hello, abbreviated, Record, State); + Connection:next_event(abbreviated, Record, State); #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, hello, State0) end. @@ -1076,7 +1151,7 @@ handle_peer_cert(Role, PeerCert, PublicKeyInfo, State2 = handle_peer_cert_key(Role, PeerCert, PublicKeyInfo, KeyAlg, State1), {Record, State} = Connection:next_record(State2), - Connection:next_state(certify, certify, Record, State). + Connection:next_event(certify, Record, State). handle_peer_cert_key(client, _, {?'id-ecPublicKey', #'ECPoint'{point = _ECPoint} = PublicKey, @@ -1139,7 +1214,7 @@ client_certify_and_key_exchange(#state{negotiated_version = Version} = %% Reinitialize client_certificate_requested = false}, {Record, State} = Connection:next_record(State3), - Connection:next_state(certify, cipher, Record, State) + Connection:next_event(cipher, Record, State) catch throw:#alert{} = Alert -> Connection:handle_own_alert(Alert, Version, certify, State0) @@ -1173,20 +1248,25 @@ certify_client_key_exchange(#client_ec_diffie_hellman_public{dh_public = ClientP calculate_master_secret(PremasterSecret, State, Connection, certify, cipher); certify_client_key_exchange(#client_psk_identity{} = ClientKey, - #state{ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = State0, Connection) -> + #state{ssl_options = + #ssl_options{user_lookup_fun = PSKLookup}} = State0, + Connection) -> PremasterSecret = ssl_handshake:premaster_secret(ClientKey, PSKLookup), calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher); certify_client_key_exchange(#client_dhe_psk_identity{} = ClientKey, #state{diffie_hellman_params = #'DHParameter'{} = Params, diffie_hellman_keys = {_, ServerDhPrivateKey}, - ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = State0, + ssl_options = + #ssl_options{user_lookup_fun = PSKLookup}} = State0, Connection) -> - PremasterSecret = ssl_handshake:premaster_secret(ClientKey, ServerDhPrivateKey, Params, PSKLookup), + PremasterSecret = + ssl_handshake:premaster_secret(ClientKey, ServerDhPrivateKey, Params, PSKLookup), calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher); certify_client_key_exchange(#client_rsa_psk_identity{} = ClientKey, #state{private_key = Key, - ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = State0, + ssl_options = + #ssl_options{user_lookup_fun = PSKLookup}} = State0, Connection) -> PremasterSecret = ssl_handshake:premaster_secret(ClientKey, Key, PSKLookup), calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher); @@ -1198,8 +1278,11 @@ certify_client_key_exchange(#client_srp_public{} = ClientKey, PremasterSecret = ssl_handshake:premaster_secret(ClientKey, Key, Params), calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher). -certify_server(#state{key_algorithm = Algo} = State, _) - when Algo == dh_anon; Algo == ecdh_anon; Algo == psk; Algo == dhe_psk; Algo == srp_anon -> +certify_server(#state{key_algorithm = Algo} = State, _) when Algo == dh_anon; + Algo == ecdh_anon; + Algo == psk; + Algo == dhe_psk; + Algo == srp_anon -> State; certify_server(#state{cert_db = CertDbHandle, @@ -1297,10 +1380,11 @@ key_exchange(#state{role = server, key_algorithm = dhe_psk, SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = ssl_handshake:key_exchange(server, Version, {dhe_psk, PskIdentityHint, DHKeys, Params, - HashSignAlgo, ClientRandom, - ServerRandom, - PrivateKey}), + Msg = ssl_handshake:key_exchange(server, Version, {dhe_psk, + PskIdentityHint, DHKeys, Params, + HashSignAlgo, ClientRandom, + ServerRandom, + PrivateKey}), State = Connection:send_handshake(Msg, State0), State#state{diffie_hellman_keys = DHKeys}; @@ -1389,7 +1473,8 @@ key_exchange(#state{role = client, ssl_options = SslOpts, key_algorithm = psk, negotiated_version = Version} = State0, Connection) -> - Msg = ssl_handshake:key_exchange(client, Version, {psk, SslOpts#ssl_options.psk_identity}), + Msg = ssl_handshake:key_exchange(client, Version, + {psk, SslOpts#ssl_options.psk_identity}), Connection:send_handshake(Msg, State0); key_exchange(#state{role = client, @@ -1398,7 +1483,8 @@ key_exchange(#state{role = client, negotiated_version = Version, diffie_hellman_keys = {DhPubKey, _}} = State0, Connection) -> Msg = ssl_handshake:key_exchange(client, Version, - {dhe_psk, SslOpts#ssl_options.psk_identity, DhPubKey}), + {dhe_psk, + SslOpts#ssl_options.psk_identity, DhPubKey}), Connection:send_handshake(Msg, State0); key_exchange(#state{role = client, ssl_options = SslOpts, @@ -1438,7 +1524,8 @@ rsa_key_exchange(Version, PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) rsa_key_exchange(_, _, _) -> throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE)). -rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) +rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret, + PublicKeyInfo = {Algorithm, _, _}) when Algorithm == ?rsaEncryption; Algorithm == ?md2WithRSAEncryption; Algorithm == ?md5WithRSAEncryption; @@ -1473,10 +1560,11 @@ request_client_cert(#state{ssl_options = #ssl_options{verify = verify_none}} = State, _) -> State. -calculate_master_secret(PremasterSecret, #state{negotiated_version = Version, - connection_states = ConnectionStates0, - session = Session0} = State0, Connection, - Current, Next) -> +calculate_master_secret(PremasterSecret, + #state{negotiated_version = Version, + connection_states = ConnectionStates0, + session = Session0} = State0, Connection, + _Current, Next) -> case ssl_handshake:master_secret(record_cb(Connection), Version, PremasterSecret, ConnectionStates0, server) of {MasterSecret, ConnectionStates} -> @@ -1484,7 +1572,7 @@ calculate_master_secret(PremasterSecret, #state{negotiated_version = Version, State1 = State0#state{connection_states = ConnectionStates, session = Session}, {Record, State} = Connection:next_record(State1), - Connection:next_state(Current, Next, Record, State); + Connection:next_event(Next, Record, State); #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, certify, State0) end. @@ -1535,31 +1623,36 @@ save_verify_data(client, #finished{verify_data = Data}, ConnectionStates, abbrev save_verify_data(server, #finished{verify_data = Data}, ConnectionStates, abbreviated) -> ssl_record:set_server_verify_data(current_write, Data, ConnectionStates). -calculate_secret(#server_dh_params{dh_p = Prime, dh_g = Base, dh_y = ServerPublicDhKey} = Params, - State, Connection) -> +calculate_secret(#server_dh_params{dh_p = Prime, dh_g = Base, + dh_y = ServerPublicDhKey} = Params, + State, Connection) -> Keys = {_, PrivateDhKey} = crypto:generate_key(dh, [Prime, Base]), PremasterSecret = ssl_handshake:premaster_secret(ServerPublicDhKey, PrivateDhKey, Params), calculate_master_secret(PremasterSecret, - State#state{diffie_hellman_keys = Keys}, Connection, certify, certify); + State#state{diffie_hellman_keys = Keys}, + Connection, certify, certify); calculate_secret(#server_ecdh_params{curve = ECCurve, public = ECServerPubKey}, State, Connection) -> ECDHKeys = public_key:generate_key(ECCurve), - PremasterSecret = ssl_handshake:premaster_secret(#'ECPoint'{point = ECServerPubKey}, ECDHKeys), + PremasterSecret = + ssl_handshake:premaster_secret(#'ECPoint'{point = ECServerPubKey}, ECDHKeys), calculate_master_secret(PremasterSecret, - State#state{diffie_hellman_keys = ECDHKeys}, Connection, certify, certify); + State#state{diffie_hellman_keys = ECDHKeys}, + Connection, certify, certify); calculate_secret(#server_psk_params{ - hint = IdentityHint}, + hint = IdentityHint}, State0, Connection) -> %% store for later use {Record, State} = Connection:next_record(State0#state{psk_identity = IdentityHint}), - Connection:next_state(certify, certify, Record, State); + Connection:next_event(certify, Record, State); calculate_secret(#server_dhe_psk_params{ dh_params = #server_dh_params{dh_p = Prime, dh_g = Base}} = ServerKey, - #state{ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = State, Connection) -> + #state{ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = + State, Connection) -> Keys = {_, PrivateDhKey} = crypto:generate_key(dh, [Prime, Base]), PremasterSecret = ssl_handshake:premaster_secret(ServerKey, PrivateDhKey, PSKLookup), @@ -1567,10 +1660,12 @@ calculate_secret(#server_dhe_psk_params{ Connection, certify, certify); calculate_secret(#server_srp_params{srp_n = Prime, srp_g = Generator} = ServerKey, - #state{ssl_options = #ssl_options{srp_identity = SRPId}} = State, Connection) -> + #state{ssl_options = #ssl_options{srp_identity = SRPId}} = State, + Connection) -> Keys = generate_srp_client_keys(Generator, Prime, 0), PremasterSecret = ssl_handshake:premaster_secret(ServerKey, Keys, SRPId), - calculate_master_secret(PremasterSecret, State#state{srp_keys = Keys}, Connection, certify, certify). + calculate_master_secret(PremasterSecret, State#state{srp_keys = Keys}, Connection, + certify, certify). master_secret(#alert{} = Alert, _) -> Alert; @@ -1626,21 +1721,23 @@ handle_srp_identity(Username, {Fun, UserState}) -> end. -cipher_role(client, Data, Session, #state{connection_states = ConnectionStates0} = State, +cipher_role(client, Data, Session, #state{connection_states = ConnectionStates0} = State0, Connection) -> - ConnectionStates = ssl_record:set_server_verify_data(current_both, Data, ConnectionStates0), - Connection:next_state_connection(cipher, - ack_connection( - State#state{session = Session, - connection_states = ConnectionStates})); - + ConnectionStates = ssl_record:set_server_verify_data(current_both, Data, + ConnectionStates0), + {Record, State} = prepare_connection(State0#state{session = Session, + connection_states = ConnectionStates}, + Connection), + Connection:next_event(connection, Record, State); cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0} = State0, Connection) -> - ConnectionStates1 = ssl_record:set_client_verify_data(current_read, Data, ConnectionStates0), - State = + ConnectionStates1 = ssl_record:set_client_verify_data(current_read, Data, + ConnectionStates0), + State1 = finalize_handshake(State0#state{connection_states = ConnectionStates1, session = Session}, cipher, Connection), - Connection:next_state_connection(cipher, ack_connection(State#state{session = Session})). + {Record, State} = prepare_connection(State1, Connection), + Connection:next_event(connection, Record, State). select_curve(#state{client_ecc = {[Curve|_], _}}) -> {namedCurve, Curve}; @@ -1674,8 +1771,8 @@ record_cb(tls_connection) -> record_cb(dtls_connection) -> dtls_record. -sync_send_all_state_event(FsmPid, Event) -> - try gen_fsm:sync_send_all_state_event(FsmPid, Event, infinity) +call(FsmPid, Event) -> + try gen_statem:call(FsmPid, Event) catch exit:{noproc, _} -> {error, closed}; @@ -1731,38 +1828,42 @@ set_socket_opts(Transport, Socket, [], SockOpts, Other) -> {{error, {options, {socket_options, Other, Error}}}, SockOpts} end; -set_socket_opts(Transport,Socket, [{mode, Mode}| Opts], SockOpts, Other) when Mode == list; Mode == binary -> +set_socket_opts(Transport,Socket, [{mode, Mode}| Opts], SockOpts, Other) + when Mode == list; Mode == binary -> set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{mode = Mode}, Other); set_socket_opts(_, _, [{mode, _} = Opt| _], SockOpts, _) -> {{error, {options, {socket_options, Opt}}}, SockOpts}; -set_socket_opts(Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) when Packet == raw; - Packet == 0; - Packet == 1; - Packet == 2; - Packet == 4; - Packet == asn1; - Packet == cdr; - Packet == sunrm; - Packet == fcgi; - Packet == tpkt; - Packet == line; - Packet == http; - Packet == httph; - Packet == http_bin; - Packet == httph_bin -> +set_socket_opts(Transport,Socket, [{packet, Packet}| Opts], SockOpts, Other) + when Packet == raw; + Packet == 0; + Packet == 1; + Packet == 2; + Packet == 4; + Packet == asn1; + Packet == cdr; + Packet == sunrm; + Packet == fcgi; + Packet == tpkt; + Packet == line; + Packet == http; + Packet == httph; + Packet == http_bin; + Packet == httph_bin -> set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{packet = Packet}, Other); set_socket_opts(_, _, [{packet, _} = Opt| _], SockOpts, _) -> {{error, {options, {socket_options, Opt}}}, SockOpts}; -set_socket_opts(Transport, Socket, [{header, Header}| Opts], SockOpts, Other) when is_integer(Header) -> +set_socket_opts(Transport, Socket, [{header, Header}| Opts], SockOpts, Other) + when is_integer(Header) -> set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{header = Header}, Other); set_socket_opts(_, _, [{header, _} = Opt| _], SockOpts, _) -> {{error,{options, {socket_options, Opt}}}, SockOpts}; -set_socket_opts(Transport, Socket, [{active, Active}| Opts], SockOpts, Other) when Active == once; - Active == true; - Active == false -> +set_socket_opts(Transport, Socket, [{active, Active}| Opts], SockOpts, Other) + when Active == once; + Active == true; + Active == false -> set_socket_opts(Transport, Socket, Opts, SockOpts#socket_options{active = Active}, Other); set_socket_opts(_, _, [{active, _} = Opt| _], SockOpts, _) -> @@ -1775,11 +1876,10 @@ start_or_recv_cancel_timer(infinity, _RecvFrom) -> start_or_recv_cancel_timer(Timeout, RecvFrom) -> erlang:send_after(Timeout, self(), {cancel_start_or_recv, RecvFrom}). -get_timeout(#state{ssl_options=#ssl_options{hibernate_after = undefined}}) -> - infinity; -get_timeout(#state{ssl_options=#ssl_options{hibernate_after = HibernateAfter}}) -> - HibernateAfter. - +hibernate_after(StateName, #state{ssl_options=#ssl_options{hibernate_after = HibernateAfter}} = State, + Actions) -> + {next_state, StateName, State, [{timeout, HibernateAfter, hibernate} | Actions]}. + terminate_alert(normal, Version, ConnectionStates) -> ssl_alert:encode(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), Version, ConnectionStates); @@ -1789,10 +1889,12 @@ terminate_alert({Reason, _}, Version, ConnectionStates) when Reason == close; Version, ConnectionStates); terminate_alert(_, Version, ConnectionStates) -> - ssl_alert:encode(?ALERT_REC(?FATAL, ?INTERNAL_ERROR), - Version, ConnectionStates). + {BinAlert, _} = ssl_alert:encode(?ALERT_REC(?FATAL, ?INTERNAL_ERROR), + Version, ConnectionStates), + BinAlert. -handle_trusted_certs_db(#state{ssl_options = #ssl_options{cacertfile = <<>>, cacerts = []}}) -> +handle_trusted_certs_db(#state{ssl_options = + #ssl_options{cacertfile = <<>>, cacerts = []}}) -> %% No trusted certs specified ok; handle_trusted_certs_db(#state{cert_db_ref = Ref, @@ -1802,7 +1904,8 @@ handle_trusted_certs_db(#state{cert_db_ref = Ref, %% with other connections and it is safe to delete them when the connection ends. ssl_pkix_db:remove_trusted_certs(Ref, CertDb); handle_trusted_certs_db(#state{file_ref_db = undefined}) -> - %% Something went wrong early (typically cacertfile does not exist) so there is nothing to handle + %% Something went wrong early (typically cacertfile does not + %% exist) so there is nothing to handle ok; handle_trusted_certs_db(#state{cert_db_ref = Ref, file_ref_db = RefDb, @@ -1814,29 +1917,31 @@ handle_trusted_certs_db(#state{cert_db_ref = Ref, ok end. -notify_senders(SendQueue) -> - lists:foreach(fun({From, _}) -> - gen_fsm:reply(From, {error, closed}) - end, queue:to_list(SendQueue)). - -notify_renegotiater({true, From}) when not is_atom(From) -> - gen_fsm:reply(From, {error, closed}); -notify_renegotiater(_) -> - ok. +prepare_connection(#state{renegotiation = Renegotiate, + start_or_recv_from = RecvFrom} = State0, Connection) + when Renegotiate =/= {false, first}, + RecvFrom =/= undefined -> + State1 = Connection:reinit_handshake_data(State0), + {Record, State} = Connection:next_record(State1), + {Record, ack_connection(State)}; +prepare_connection(State0, Connection) -> + State = Connection:reinit_handshake_data(State0), + {no_record, ack_connection(State)}. ack_connection(#state{renegotiation = {true, Initiater}} = State) when Initiater == internal; Initiater == peer -> State#state{renegotiation = undefined}; ack_connection(#state{renegotiation = {true, From}} = State) -> - gen_fsm:reply(From, ok), + gen_statem:reply(From, ok), State#state{renegotiation = undefined}; ack_connection(#state{renegotiation = {false, first}, start_or_recv_from = StartFrom, timer = Timer} = State) when StartFrom =/= undefined -> - gen_fsm:reply(StartFrom, connected), + gen_statem:reply(StartFrom, connected), cancel_timer(Timer), - State#state{renegotiation = undefined, start_or_recv_from = undefined, timer = undefined}; + State#state{renegotiation = undefined, + start_or_recv_from = undefined, timer = undefined}; ack_connection(State) -> State. @@ -1857,13 +1962,14 @@ register_session(server, _, Port, #session{is_resumable = new} = Session0) -> register_session(_, _, _, Session) -> Session. %% Already registered -handle_new_session(NewId, CipherSuite, Compression, #state{session = Session0, - protocol_cb = Connection} = State0) -> +handle_new_session(NewId, CipherSuite, Compression, + #state{session = Session0, + protocol_cb = Connection} = State0) -> Session = Session0#session{session_id = NewId, cipher_suite = CipherSuite, compression_method = Compression}, {Record, State} = Connection:next_record(State0#state{session = Session}), - Connection:next_state(hello, certify, Record, State). + Connection:next_event(certify, Record, State). handle_resumed_session(SessId, #state{connection_states = ConnectionStates0, negotiated_version = Version, @@ -1879,7 +1985,7 @@ handle_resumed_session(SessId, #state{connection_states = ConnectionStates0, Connection:next_record(State0#state{ connection_states = ConnectionStates, session = Session}), - Connection:next_state(hello, abbreviated, Record, State); + Connection:next_event(abbreviated, Record, State); #alert{} = Alert -> Connection:handle_own_alert(Alert, Version, hello, State0) end. diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index bb41ef2b62..7682cb86ea 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -75,7 +75,7 @@ renegotiation :: undefined | {boolean(), From::term() | internal | peer}, start_or_recv_from :: term(), timer :: undefined | reference(), % start_or_recive_timer - send_queue :: queue:queue(), + %%send_queue :: queue:queue(), terminated = false ::boolean(), allow_renegotiate = true ::boolean(), expecting_next_protocol_negotiation = false ::boolean(), @@ -83,7 +83,8 @@ negotiated_protocol = undefined :: undefined | binary(), client_ecc, % {Curves, PointFmt} tracker :: pid() | 'undefined', %% Tracker process for listen socket - sni_hostname = undefined + sni_hostname = undefined, + downgrade }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 2a2a7b7d25..598d4e4112 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -74,7 +74,7 @@ ]). %% MISC --export([select_version/3, prf/5, select_hashsign/5, +-export([select_version/3, prf/6, select_hashsign/5, select_hashsign_algs/3, premaster_secret/2, premaster_secret/3, premaster_secret/4]). @@ -564,17 +564,15 @@ server_key_exchange_hash(md5sha, Value) -> server_key_exchange_hash(Hash, Value) -> crypto:hash(Hash, Value). %%-------------------------------------------------------------------- --spec prf(ssl_record:ssl_version(), binary(), binary(), [binary()], non_neg_integer()) -> +-spec prf(ssl_record:ssl_version(), non_neg_integer(), binary(), binary(), [binary()], non_neg_integer()) -> {ok, binary()} | {error, undefined}. %% %% Description: use the TLS PRF to generate key material %%-------------------------------------------------------------------- -prf({3,0}, _, _, _, _) -> +prf({3,0}, _, _, _, _, _) -> {error, undefined}; -prf({3,1}, Secret, Label, Seed, WantedLength) -> - {ok, tls_v1:prf(?MD5SHA, Secret, Label, Seed, WantedLength)}; -prf({3,_N}, Secret, Label, Seed, WantedLength) -> - {ok, tls_v1:prf(?SHA256, Secret, Label, Seed, WantedLength)}. +prf({3,_N}, PRFAlgo, Secret, Label, Seed, WantedLength) -> + {ok, tls_v1:prf(PRFAlgo, Secret, Label, Seed, WantedLength)}. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 9c52f5a315..076e663cd4 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -118,7 +118,7 @@ %% undefined if not hibernating, or number of ms of %% inactivity after which ssl_connection will go into %% hibernation - hibernate_after :: boolean() | 'undefined', + hibernate_after :: timeout(), %% This option should only be set to true by inet_tls_dist erl_dist = false :: boolean(), alpn_advertised_protocols = undefined :: [binary()] | undefined , diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 2349158b11..60b4fbe995 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -610,8 +610,8 @@ server_register_session(Port, Session, #state{session_cache_server_max = Max, do_register_session(Key, Session, Max, Pid, Cache, CacheCb) -> try CacheCb:size(Cache) of - N when N > Max -> - invalidate_session_cache(Pid, CacheCb, Cache); + Max -> + invalidate_session_cache(Pid, CacheCb, Cache); _ -> CacheCb:update(Cache, Key, Session), Pid diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index a1d13d1850..208edc644a 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -28,7 +28,7 @@ -module(tls_connection). --behaviour(gen_fsm). +-behaviour(gen_statem). -include("tls_connection.hrl"). -include("tls_handshake.hrl"). @@ -43,31 +43,33 @@ %% Internal application API %% Setup --export([start_fsm/8]). +-export([start_fsm/8, start_link/7, init/1]). %% State transition handling --export([next_record/1, next_state/4, next_state_connection/2]). +-export([next_record/1, next_event/3]). %% Handshake handling --export([renegotiate/1, send_handshake/2, send_change_cipher/2]). +-export([renegotiate/2, send_handshake/2, send_change_cipher/2, + reinit_handshake_data/1]). %% Alert and close handling -export([send_alert/2, handle_own_alert/4, handle_close_alert/3, - handle_normal_shutdown/3, handle_unexpected_message/3, + handle_normal_shutdown/3, close/5, alert_user/6, alert_user/9 ]). %% Data handling -export([write_application_data/3, read_application_data/2, - passive_receive/2, next_record_if_active/1]). + passive_receive/2, next_record_if_active/1, handle_common_event/4]). -%% Called by tls_connection_sup --export([start_link/7]). - -%% gen_fsm callbacks --export([init/1, hello/2, certify/2, cipher/2, - abbreviated/2, connection/2, handle_event/3, - handle_sync_event/4, handle_info/3, terminate/3, code_change/4, format_status/2]). +%% gen_statem state functions +-export([init/3, error/3, downgrade/3, %% Initiation and take down states + hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states + connection/3]). +%% gen_statem callbacks +-export([terminate/3, code_change/4, format_status/2]). + +-define(GEN_STATEM_CB_MODE, state_functions). %%==================================================================== %% Internal application API @@ -130,6 +132,16 @@ send_change_cipher(Msg, #state{connection_states = ConnectionStates0, Transport:send(Socket, BinChangeCipher), State0#state{connection_states = ConnectionStates}. +reinit_handshake_data(State) -> + %% premaster_secret, public_key_info and tls_handshake_info + %% are only needed during the handshake phase. + %% To reduce memory foot print of a connection reinitialize them. + State#state{ + premaster_secret = undefined, + public_key_info = undefined, + tls_handshake_history = ssl_handshake:init_handshake_history() + }. + %%==================================================================== %% tls_connection_sup API %%==================================================================== @@ -147,23 +159,34 @@ start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> init([Role, Host, Port, Socket, Options, User, CbInfo]) -> process_flag(trap_exit, true), - State = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), - gen_fsm:enter_loop(?MODULE, [], hello, State, get_timeout(State)). + State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), + try + State = ssl_connection:ssl_config(State0#state.ssl_options, Role, State0), + gen_statem:enter_loop(?MODULE, [], ?GEN_STATEM_CB_MODE, init, State) + catch throw:Error -> + gen_statem:enter_loop(?MODULE, [], ?GEN_STATEM_CB_MODE, error, {Error, State0}) + end. %%-------------------------------------------------------------------- -%% Description:There should be one instance of this function for each -%% possible state name. Whenever a gen_fsm receives an event sent -%% using gen_fsm:send_event/2, the instance of this function with the -%% same name as the current state name StateName is called to handle -%% the event. It is also called if a timeout occurs. -%% -hello(start, #state{host = Host, port = Port, role = client, - ssl_options = SslOpts, - session = #session{own_certificate = Cert} = Session0, - session_cache = Cache, session_cache_cb = CacheCb, - transport_cb = Transport, socket = Socket, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _}} = State0) -> +%% State functions +%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- +-spec init(gen_statem:event_type(), + {start, timeout()} | term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- + +init({call, From}, {start, Timeout}, + #state{host = Host, port = Port, role = client, + ssl_options = SslOpts, + session = #session{own_certificate = Cert} = Session0, + transport_cb = Transport, socket = Socket, + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}, + session_cache = Cache, + session_cache_cb = CacheCb + } = State0) -> + Timer = ssl_connection:start_or_recv_cancel_timer(Timeout, From), Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, Cert), @@ -177,13 +200,36 @@ hello(start, #state{host = Host, port = Port, role = client, negotiated_version = Version, %% Requested version session = Session0#session{session_id = Hello#client_hello.session_id}, - tls_handshake_history = Handshake}, + tls_handshake_history = Handshake, + start_or_recv_from = From, + timer = Timer}, {Record, State} = next_record(State1), - next_state(hello, hello, Record, State); + next_event(hello, Record, State); +init(Type, Event, State) -> + ssl_connection:init(Type, Event, State, ?MODULE). + +%%-------------------------------------------------------------------- +-spec error(gen_statem:event_type(), + {start, timeout()} | term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- -hello(Hello = #client_hello{client_version = ClientVersion, - extensions = #hello_extensions{ec_point_formats = EcPointFormats, - elliptic_curves = EllipticCurves}}, +error({call, From}, {start, _Timeout}, {Error, State}) -> + {stop_and_reply, normal, {reply, From, {error, Error}}, State}; +error({call, From}, Msg, State) -> + handle_call(Msg, From, error, State); +error(_, _, _) -> + {keep_state_and_data, [postpone]}. + +%%-------------------------------------------------------------------- +-spec hello(gen_statem:event_type(), + #hello_request{} | #client_hello{} | #server_hello{} | term(), + #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +hello(internal, #client_hello{client_version = ClientVersion, + extensions = #hello_extensions{ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves}} = Hello, State = #state{connection_states = ConnectionStates0, port = Port, session = #session{own_certificate = Cert} = Session0, renegotiation = {Renegotiation, _}, @@ -203,7 +249,8 @@ hello(Hello = #client_hello{client_version = ClientVersion, undefined -> CurrentProtocol; _ -> Protocol0 end, - ssl_connection:hello({common_client_hello, Type, ServerHelloExt}, + + ssl_connection:hello(internal, {common_client_hello, Type, ServerHelloExt}, State#state{connection_states = ConnectionStates, negotiated_version = Version, hashsign_algorithm = HashSign, @@ -211,8 +258,7 @@ hello(Hello = #client_hello{client_version = ClientVersion, client_ecc = {EllipticCurves, EcPointFormats}, negotiated_protocol = Protocol}, ?MODULE) end; - -hello(Hello = #server_hello{}, +hello(internal, #server_hello{} = Hello, #state{connection_states = ConnectionStates0, negotiated_version = ReqVersion, role = client, @@ -225,25 +271,52 @@ hello(Hello = #server_hello{}, ssl_connection:handle_session(Hello, Version, NewId, ConnectionStates, ProtoExt, Protocol, State) end; +hello(info, Event, State) -> + handle_info(Event, hello, State); +hello(Type, Event, State) -> + ssl_connection:hello(Type, Event, State, ?MODULE). -hello(Msg, State) -> - ssl_connection:hello(Msg, State, ?MODULE). - -abbreviated(Msg, State) -> - ssl_connection:abbreviated(Msg, State, ?MODULE). +%%-------------------------------------------------------------------- +-spec abbreviated(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +abbreviated(info, Event, State) -> + handle_info(Event, abbreviated, State); +abbreviated(Type, Event, State) -> + ssl_connection:abbreviated(Type, Event, State, ?MODULE). -certify(Msg, State) -> - ssl_connection:certify(Msg, State, ?MODULE). +%%-------------------------------------------------------------------- +-spec certify(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +certify(info, Event, State) -> + handle_info(Event, certify, State); +certify(Type, Event, State) -> + ssl_connection:certify(Type, Event, State, ?MODULE). -cipher(Msg, State) -> - ssl_connection:cipher(Msg, State, ?MODULE). +%%-------------------------------------------------------------------- +-spec cipher(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +cipher(info, Event, State) -> + handle_info(Event, cipher, State); +cipher(Type, Event, State) -> + ssl_connection:cipher(Type, Event, State, ?MODULE). -connection(#hello_request{}, #state{host = Host, port = Port, - session = #session{own_certificate = Cert} = Session0, - session_cache = Cache, session_cache_cb = CacheCb, - ssl_options = SslOpts, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _}} = State0) -> +%%-------------------------------------------------------------------- +-spec connection(gen_statem:event_type(), + #hello_request{} | #client_hello{}| term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +connection(info, Event, State) -> + handle_info(Event, connection, State); +connection(internal, #hello_request{}, + #state{host = Host, port = Port, + session = #session{own_certificate = Cert} = Session0, + session_cache = Cache, session_cache_cb = CacheCb, + ssl_options = SslOpts, + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}} = State0) -> Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, Cert), State1 = send_handshake(Hello, State0), @@ -251,58 +324,49 @@ connection(#hello_request{}, #state{host = Host, port = Port, next_record( State1#state{session = Session0#session{session_id = Hello#client_hello.session_id}}), - next_state(connection, hello, Record, State); - -connection(#client_hello{} = Hello, #state{role = server, allow_renegotiate = true} = State) -> + next_event(hello, Record, State); +connection(internal, #client_hello{} = Hello, + #state{role = server, allow_renegotiate = true} = State) -> %% Mitigate Computational DoS attack %% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html %% http://www.thc.org/thc-ssl-dos/ Rather than disabling client %% initiated renegotiation we will disallow many client initiated %% renegotiations immediately after each other. erlang:send_after(?WAIT_TO_ALLOW_RENEGOTIATION, self(), allow_renegotiate), - hello(Hello, State#state{allow_renegotiate = false}); - -connection(#client_hello{}, #state{role = server, allow_renegotiate = false} = State0) -> + {next_state, hello, State#state{allow_renegotiate = false}, [{next_event, internal, Hello}]}; +connection(internal, #client_hello{}, + #state{role = server, allow_renegotiate = false} = State0) -> Alert = ?ALERT_REC(?WARNING, ?NO_RENEGOTIATION), - State = send_alert(Alert, State0), - next_state_connection(connection, State); - -connection(Msg, State) -> - ssl_connection:connection(Msg, State, tls_connection). + State1 = send_alert(Alert, State0), + {Record, State} = ssl_connection:prepare_connection(State1, ?MODULE), + next_event(connection, Record, State); +connection(Type, Event, State) -> + ssl_connection:connection(Type, Event, State, ?MODULE). %%-------------------------------------------------------------------- -%% Description: Whenever a gen_fsm receives an event sent using -%% gen_fsm:send_all_state_event/2, this function is called to handle -%% the event. Not currently used! +-spec downgrade(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). %%-------------------------------------------------------------------- -handle_event(_Event, StateName, State) -> - {next_state, StateName, State, get_timeout(State)}. +downgrade(Type, Event, State) -> + ssl_connection:downgrade(Type, Event, State, ?MODULE). %%-------------------------------------------------------------------- -%% Description: Whenever a gen_fsm receives an event sent using -%% gen_fsm:sync_send_all_state_event/2,3, this function is called to handle -%% the event. +%% Event handling functions called by state functions to handle +%% common or unexpected events for the state. %%-------------------------------------------------------------------- -handle_sync_event(Event, From, StateName, State) -> - ssl_connection:handle_sync_event(Event, From, StateName, State). - -%%-------------------------------------------------------------------- -%% Description: This function is called by a gen_fsm when it receives any -%% other message than a synchronous or asynchronous event -%% (or a system message). -%%-------------------------------------------------------------------- - +handle_call(Event, From, StateName, State) -> + ssl_connection:handle_call(Event, From, StateName, State, ?MODULE). + %% raw data from socket, unpack records handle_info({Protocol, _, Data}, StateName, #state{data_tag = Protocol} = State0) -> case next_tls_record(Data, State0) of {Record, State} -> - next_state(StateName, StateName, Record, State); + next_event(StateName, Record, State); #alert{} = Alert -> handle_normal_shutdown(Alert, StateName, State0), - {stop, {shutdown, own_alert}, State0} + {stop, {shutdown, own_alert}} end; - handle_info({CloseTag, Socket}, StateName, #state{socket = Socket, close_tag = CloseTag, negotiated_version = Version} = State) -> @@ -321,32 +385,98 @@ handle_info({CloseTag, Socket}, StateName, ok end, handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State), - {stop, {shutdown, transport_closed}, State}; - + {stop, {shutdown, transport_closed}}; handle_info(Msg, StateName, State) -> ssl_connection:handle_info(Msg, StateName, State). +handle_common_event(internal, #alert{} = Alert, StateName, + #state{negotiated_version = Version} = State) -> + handle_own_alert(Alert, Version, StateName, State); + +%%% TLS record protocol level handshake messages +handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, + StateName, #state{protocol_buffers = + #protocol_buffers{tls_handshake_buffer = Buf0} = Buffers, + negotiated_version = Version} = State0) -> + + Handle = + fun({#hello_request{} = Packet, _}, {connection, HState}) -> + %% This message should not be included in handshake + %% message hashes. Starts new handshake (renegotiation) + Hs0 = ssl_handshake:init_handshake_history(), + {HState#state{tls_handshake_history = Hs0, + renegotiation = {true, peer}}, + {next_event, internal, Packet}}; + ({#hello_request{}, _}, {next_state, _SName, HState}) -> + %% This message should not be included in handshake + %% message hashes. Already in negotiation so it will be ignored! + {HState, []}; + ({#client_hello{} = Packet, Raw}, {connection, HState0}) -> + HState = handle_sni_extension(Packet, HState0), + Version = Packet#client_hello.client_version, + Hs0 = ssl_handshake:init_handshake_history(), + Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), + {HState#state{tls_handshake_history = Hs1, + renegotiation = {true, peer}}, + {next_event, internal, Packet}}; + + ({Packet, Raw}, {_SName, HState0 = #state{tls_handshake_history=Hs0}}) -> + HState = handle_sni_extension(Packet, HState0), + Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), + {HState#state{tls_handshake_history=Hs1}, {next_event, internal, Packet}} + end, + try + {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0), + State1 = State0#state{protocol_buffers = + Buffers#protocol_buffers{tls_packets = Packets, + tls_handshake_buffer = Buf}}, + {State, Events} = tls_handshake_events(Handle, StateName, State1, []), + case StateName of + connection -> + ssl_connection:hibernate_after(StateName, State, Events); + _ -> + {next_state, StateName, State, Events} + end + catch throw:#alert{} = Alert -> + handle_own_alert(Alert, Version, StateName, State0) + end; +%%% TLS record protocol level application data messages +handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) -> + {next_state, StateName, State, [{next_event, internal, {application_data, Data}}]}; +%%% TLS record protocol level change cipher messages +handle_common_event(internal, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Data}, StateName, State) -> + {next_state, StateName, State, [{next_event, internal, #change_cipher_spec{type = Data}}]}; +%%% TLS record protocol level Alert messages +handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName, + #state{negotiated_version = Version} = State) -> + case decode_alerts(EncAlerts) of + Alerts = [_|_] -> + handle_alerts(Alerts, {next_state, StateName, State}); + #alert{} = Alert -> + handle_own_alert(Alert, Version, StateName, State) + end; +%% Ignore unknown TLS record level protocol messages +handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) -> + {next_state, StateName, State}. + %%-------------------------------------------------------------------- -%% Description:This function is called by a gen_fsm when it is about -%% to terminate. It should be the opposite of Module:init/1 and do any -%% necessary cleaning up. When it returns, the gen_fsm terminates with -%% Reason. The return value is ignored. +%% gen_statem callbacks %%-------------------------------------------------------------------- terminate(Reason, StateName, State) -> catch ssl_connection:terminate(Reason, StateName, State). +format_status(Type, Data) -> + ssl_connection:format_status(Type, Data). + %%-------------------------------------------------------------------- %% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState} %% Description: Convert process state when code is changed %%-------------------------------------------------------------------- code_change(_OldVsn, StateName, State0, {Direction, From, To}) -> State = convert_state(State0, Direction, From, To), - {ok, StateName, State}; + {?GEN_STATEM_CB_MODE, StateName, State}; code_change(_OldVsn, StateName, State, _) -> - {ok, StateName, State}. - -format_status(Type, Data) -> - ssl_connection:format_status(Type, Data). + {?GEN_STATEM_CB_MODE, StateName, State}. %%-------------------------------------------------------------------- %%% Internal functions @@ -396,7 +526,6 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us renegotiation = {false, first}, allow_renegotiate = SSLOptions#ssl_options.client_renegotiation, start_or_recv_from = undefined, - send_queue = queue:new(), protocol_cb = ?MODULE, tracker = Tracker }. @@ -418,80 +547,6 @@ update_ssl_options_from_sni(OrigSSLOptions, SNIHostname) -> ssl:handle_options(SSLOption, OrigSSLOptions) end. -next_state(Current,_, #alert{} = Alert, #state{negotiated_version = Version} = State) -> - handle_own_alert(Alert, Version, Current, State); - -next_state(_,Next, no_record, State) -> - {next_state, Next, State, get_timeout(State)}; - -next_state(Current, Next, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, #state{negotiated_version = Version} = State) -> - case decode_alerts(EncAlerts) of - Alerts = [_|_] -> - handle_alerts(Alerts, {next_state, Next, State, get_timeout(State)}); - #alert{} = Alert -> - handle_own_alert(Alert, Version, Current, State) - end; -next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, - State0 = #state{protocol_buffers = - #protocol_buffers{tls_handshake_buffer = Buf0} = Buffers, - negotiated_version = Version}) -> - Handle = - fun({#hello_request{} = Packet, _}, {next_state, connection = SName, State}) -> - %% This message should not be included in handshake - %% message hashes. Starts new handshake (renegotiation) - Hs0 = ssl_handshake:init_handshake_history(), - ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs0, - renegotiation = {true, peer}}); - ({#hello_request{} = Packet, _}, {next_state, SName, State}) -> - %% This message should not be included in handshake - %% message hashes. Already in negotiation so it will be ignored! - ?MODULE:SName(Packet, State); - ({#client_hello{} = Packet, Raw}, {next_state, connection = SName, HState0}) -> - HState = handle_sni_extension(Packet, HState0), - Version = Packet#client_hello.client_version, - Hs0 = ssl_handshake:init_handshake_history(), - Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), - ?MODULE:SName(Packet, HState#state{tls_handshake_history=Hs1, - renegotiation = {true, peer}}); - ({Packet, Raw}, {next_state, SName, HState0 = #state{tls_handshake_history=Hs0}}) -> - HState = handle_sni_extension(Packet, HState0), - Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), - ?MODULE:SName(Packet, HState#state{tls_handshake_history=Hs1}); - (_, StopState) -> StopState - end, - try - {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0), - State = State0#state{protocol_buffers = - Buffers#protocol_buffers{tls_packets = Packets, - tls_handshake_buffer = Buf}}, - handle_tls_handshake(Handle, Next, State) - catch throw:#alert{} = Alert -> - handle_own_alert(Alert, Version, Current, State0) - end; - -next_state(_, StateName, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, State0) -> - case read_application_data(Data, State0) of - Stop = {stop,_,_} -> - Stop; - {Record, State} -> - next_state(StateName, StateName, Record, State) - end; -next_state(Current, Next, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} = - _ChangeCipher, - #state{connection_states = ConnectionStates0} = State0) - when Next == cipher; Next == abbreviated -> - ConnectionStates1 = - ssl_record:activate_pending_connection_state(ConnectionStates0, read), - {Record, State} = next_record(State0#state{connection_states = ConnectionStates1}), - next_state(Current, Next, Record, State#state{expecting_finished = true}); -next_state(Current, _Next, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} = - _ChangeCipher, #state{negotiated_version = Version} = State) -> - handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Version, Current, State); -next_state(Current, Next, #ssl_tls{type = _Unknown}, State0) -> - %% Ignore unknown type - {Record, State} = next_record(State0), - next_state(Current, Next, Record, State). - next_tls_record(Data, #state{protocol_buffers = #protocol_buffers{tls_record_buffer = Buf0, tls_cipher_texts = CT0} = Buffers} = State0) -> case tls_record:get_tls_records(Data, Buf0) of @@ -504,11 +559,6 @@ next_tls_record(Data, #state{protocol_buffers = #protocol_buffers{tls_record_buf Alert end. -next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = []}, - socket = Socket, - transport_cb = Transport} = State) -> - ssl_socket:setopts(Transport, Socket, [{active,once}]), - {no_record, State}; next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = [CT | Rest]} = Buffers, @@ -522,6 +572,11 @@ next_record(#state{protocol_buffers = #alert{} = Alert -> {Alert, State} end; +next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = []}, + socket = Socket, + transport_cb = Transport} = State) -> + ssl_socket:setopts(Transport, Socket, [{active,once}]), + {no_record, State}; next_record(State) -> {no_record, State}. @@ -533,55 +588,36 @@ next_record_if_active(State = next_record_if_active(State) -> next_record(State). -next_state_connection(StateName, #state{send_queue = Queue0, - negotiated_version = Version, - socket = Socket, - transport_cb = Transport, - connection_states = ConnectionStates0 - } = State) -> - %% Send queued up data that was queued while renegotiating - case queue:out(Queue0) of - {{value, {From, Data}}, Queue} -> - {Msgs, ConnectionStates} = - ssl_record:encode_data(Data, Version, ConnectionStates0), - Result = Transport:send(Socket, Msgs), - gen_fsm:reply(From, Result), - next_state_connection(StateName, - State#state{connection_states = ConnectionStates, - send_queue = Queue}); - {empty, Queue0} -> - next_state_is_connection(StateName, State) - end. - -%% In next_state_is_connection/1: clear tls_handshake, -%% premaster_secret and public_key_info (only needed during handshake) -%% to reduce memory foot print of a connection. -next_state_is_connection(_, State = - #state{start_or_recv_from = RecvFrom, - socket_options = - #socket_options{active = false}}) when RecvFrom =/= undefined -> - passive_receive(State#state{premaster_secret = undefined, - public_key_info = undefined, - tls_handshake_history = ssl_handshake:init_handshake_history()}, connection); - -next_state_is_connection(StateName, State0) -> - {Record, State} = next_record_if_active(State0), - next_state(StateName, connection, Record, State#state{premaster_secret = undefined, - public_key_info = undefined, - tls_handshake_history = ssl_handshake:init_handshake_history()}). - passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) -> case Buffer of <<>> -> {Record, State} = next_record(State0), - next_state(StateName, StateName, Record, State); + next_event(StateName, Record, State); _ -> - case read_application_data(<<>>, State0) of - Stop = {stop, _, _} -> - Stop; - {Record, State} -> - next_state(StateName, StateName, Record, State) - end + {Record, State} = read_application_data(<<>>, State0), + next_event(StateName, Record, State) + end. + +next_event(StateName, Record, State) -> + next_event(StateName, Record, State, []). + +next_event(connection = StateName, no_record, State0, Actions) -> + case next_record_if_active(State0) of + {no_record, State} -> + ssl_connection:hibernate_after(StateName, State, Actions); + {#ssl_tls{} = Record, State} -> + {next_state, StateName, State, [{next_event, internal, {tls_record, Record}} | Actions]}; + {#alert{} = Alert, State} -> + {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} + end; +next_event(StateName, Record, State, Actions) -> + case Record of + no_record -> + {next_state, StateName, State, Actions}; + #ssl_tls{} = Record -> + {next_state, StateName, State, [{next_event, internal, {tls_record, Record}} | Actions]}; + #alert{} = Alert -> + {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} end. read_application_data(Data, #state{user_application = {_Mon, Pid}, @@ -625,11 +661,6 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, {stop, normal, State0} end. -get_timeout(#state{ssl_options=#ssl_options{hibernate_after = undefined}}) -> - infinity; -get_timeout(#state{ssl_options=#ssl_options{hibernate_after = HibernateAfter}}) -> - HibernateAfter. - %% Picks ClientData get_data(_, _, <<>>) -> {more, <<>>}; @@ -736,7 +767,7 @@ header(N, Binary) -> [ByteN | header(N-1, NewBinary)]. send_or_reply(false, _Pid, From, Data) when From =/= undefined -> - gen_fsm:reply(From, Data); + gen_statem:reply(From, Data); %% Can happen when handling own alert or tcp error/close and there is %% no outstanding gen_fsm sync events send_or_reply(false, no_pid, _, _) -> @@ -747,51 +778,43 @@ send_or_reply(_, Pid, _From, Data) -> send_user(Pid, Msg) -> Pid ! Msg. -handle_tls_handshake(Handle, StateName, - #state{protocol_buffers = - #protocol_buffers{tls_packets = [Packet]} = Buffers} = State) -> - FsmReturn = {next_state, StateName, State#state{protocol_buffers = - Buffers#protocol_buffers{tls_packets = []}}}, - Handle(Packet, FsmReturn); - -handle_tls_handshake(Handle, StateName, - #state{protocol_buffers = - #protocol_buffers{tls_packets = [Packet | Packets]} = Buffers} = - State0) -> - FsmReturn = {next_state, StateName, State0#state{protocol_buffers = - Buffers#protocol_buffers{tls_packets = - Packets}}}, - case Handle(Packet, FsmReturn) of - {next_state, NextStateName, State, _Timeout} -> - handle_tls_handshake(Handle, NextStateName, State); - {next_state, NextStateName, State} -> - handle_tls_handshake(Handle, NextStateName, State); - {stop, _,_} = Stop -> - Stop - end; - -handle_tls_handshake(_Handle, _StateName, #state{}) -> - throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). +tls_handshake_events(Handle, StateName, + #state{protocol_buffers = + #protocol_buffers{tls_packets = [Packet]} = Buffers} = State0, Acc) -> + {State, Event} = Handle(Packet, {StateName, + State0#state{protocol_buffers = + Buffers#protocol_buffers{tls_packets = []}}}), + {State, lists:reverse([Event |Acc])}; +tls_handshake_events(Handle, StateName, + #state{protocol_buffers = + #protocol_buffers{tls_packets = + [Packet | Packets]} = Buffers} = State0, Acc) -> + {State, Event} = Handle(Packet, {StateName, State0#state{protocol_buffers = + Buffers#protocol_buffers{tls_packets = + Packets}}}), + tls_handshake_events(Handle, StateName, State, [Event | Acc]); + +tls_handshake_events(_Handle, _, #state{}, _) -> + throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE)). write_application_data(Data0, From, #state{socket = Socket, negotiated_version = Version, transport_cb = Transport, connection_states = ConnectionStates0, - send_queue = SendQueue, socket_options = SockOpts, ssl_options = #ssl_options{renegotiate_at = RenegotiateAt}} = State) -> Data = encode_packet(Data0, SockOpts), case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of true -> - renegotiate(State#state{send_queue = queue:in_r({From, Data}, SendQueue), - renegotiation = {true, internal}}); + renegotiate(State#state{renegotiation = {true, internal}}, + [{next_event, {call, From}, {application_data, Data0}}]); false -> {Msgs, ConnectionStates} = ssl_record:encode_data(Data, Version, ConnectionStates0), Result = Transport:send(Socket, Msgs), - {reply, Result, - connection, State#state{connection_states = ConnectionStates}, get_timeout(State)} + ssl_connection:hibernate_after(connection, State#state{connection_states = ConnectionStates}, + [{reply, From, Result}]) end. encode_packet(Data, #socket_options{packet=Packet}) -> @@ -823,69 +846,73 @@ is_time_to_renegotiate(N, M) when N < M-> false; is_time_to_renegotiate(_,_) -> true. -renegotiate(#state{role = client} = State) -> +renegotiate(#state{role = client} = State, Actions) -> %% Handle same way as if server requested %% the renegotiation Hs0 = ssl_handshake:init_handshake_history(), - connection(#hello_request{}, State#state{tls_handshake_history = Hs0}); + {next_state, connection, State#state{tls_handshake_history = Hs0}, + [{next_event, internal, #hello_request{}} | Actions]}; + renegotiate(#state{role = server, socket = Socket, transport_cb = Transport, negotiated_version = Version, - connection_states = ConnectionStates0} = State0) -> + connection_states = ConnectionStates0} = State0, Actions) -> HelloRequest = ssl_handshake:hello_request(), Frag = tls_handshake:encode_handshake(HelloRequest, Version), Hs0 = ssl_handshake:init_handshake_history(), {BinMsg, ConnectionStates} = ssl_record:encode_handshake(Frag, Version, ConnectionStates0), Transport:send(Socket, BinMsg), - {Record, State} = next_record(State0#state{connection_states = - ConnectionStates, - tls_handshake_history = Hs0}), - next_state(connection, hello, Record, State#state{allow_renegotiate = true}). + State1 = State0#state{connection_states = + ConnectionStates, + tls_handshake_history = Hs0}, + {Record, State} = next_record(State1), + next_event(hello, Record, State, Actions). handle_alerts([], Result) -> Result; -handle_alerts(_, {stop, _, _} = Stop) -> - %% If it is a fatal alert immediately close +handle_alerts(_, {stop,_} = Stop) -> Stop; -handle_alerts([Alert | Alerts], {next_state, StateName, State, _Timeout}) -> - handle_alerts(Alerts, handle_alert(Alert, StateName, State)). - +handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> + handle_alerts(Alerts, handle_alert(Alert, StateName, State)); +handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) -> + handle_alerts(Alerts, handle_alert(Alert, StateName, State)). handle_alert(#alert{level = ?FATAL} = Alert, StateName, #state{socket = Socket, transport_cb = Transport, ssl_options = SslOpts, start_or_recv_from = From, host = Host, port = Port, session = Session, user_application = {_Mon, Pid}, - role = Role, socket_options = Opts, tracker = Tracker} = State) -> + role = Role, socket_options = Opts, tracker = Tracker}) -> invalidate_session(Role, Host, Port, Session), log_alert(SslOpts#ssl_options.log_alert, StateName, Alert), alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role), - {stop, normal, State}; + {stop, normal}; handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, StateName, State) -> handle_normal_shutdown(Alert, StateName, State), - {stop, {shutdown, peer_close}, State}; + {stop, {shutdown, peer_close}}; handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, #state{ssl_options = SslOpts, renegotiation = {true, internal}} = State) -> log_alert(SslOpts#ssl_options.log_alert, StateName, Alert), handle_normal_shutdown(Alert, StateName, State), - {stop, {shutdown, peer_close}, State}; + {stop, {shutdown, peer_close}}; handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, #state{ssl_options = SslOpts, renegotiation = {true, From}} = State0) -> log_alert(SslOpts#ssl_options.log_alert, StateName, Alert), - gen_fsm:reply(From, {error, renegotiation_rejected}), + gen_statem:reply(From, {error, renegotiation_rejected}), {Record, State} = next_record(State0), - next_state(StateName, connection, Record, State); + %% Go back to connection! + next_event(connection, Record, State); %% Gracefully log and ignore all other warning alerts handle_alert(#alert{level = ?WARNING} = Alert, StateName, #state{ssl_options = SslOpts} = State0) -> log_alert(SslOpts#ssl_options.log_alert, StateName, Alert), {Record, State} = next_record(State0), - next_state(StateName, StateName, Record, State). + next_event(StateName, Record, State). alert_user(Transport, Tracker, Socket, connection, Opts, Pid, From, Alert, Role) -> alert_user(Transport, Tracker, Socket, Opts#socket_options.active, Pid, From, Alert, Role); @@ -937,7 +964,7 @@ handle_own_alert(Alert, Version, StateName, catch _:_ -> ok end, - {stop, {shutdown, own_alert}, State}. + {stop, {shutdown, own_alert}}. handle_normal_shutdown(Alert, _, #state{socket = Socket, transport_cb = Transport, @@ -954,11 +981,6 @@ handle_normal_shutdown(Alert, StateName, #state{socket = Socket, start_or_recv_from = RecvFrom, role = Role}) -> alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role). -handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) -> - Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), - handle_own_alert(Alert, Version, {Info, Msg}, State). - - handle_close_alert(Data, StateName, State0) -> case next_tls_record(Data, State0) of {#ssl_tls{type = ?ALERT, fragment = EncAlerts}, State} -> @@ -979,27 +1001,6 @@ invalidate_session(client, Host, Port, Session) -> invalidate_session(server, _, Port, Session) -> ssl_manager:invalidate_session(Port, Session). -%% User downgrades connection -%% When downgrading an TLS connection to a transport connection -%% we must recive the close message before releasing the -%% transport socket. -close({close, {Pid, Timeout}}, Socket, Transport, ConnectionStates, Check) when is_pid(Pid) -> - ssl_socket:setopts(Transport, Socket, [{active, false}, {packet, ssl_tls}]), - case Transport:recv(Socket, 0, Timeout) of - {ok, {ssl_tls, Socket, ?ALERT, Version, Fragment}} -> - case tls_record:decode_cipher_text(#ssl_tls{type = ?ALERT, - version = Version, - fragment = Fragment - }, ConnectionStates, Check) of - {#ssl_tls{fragment = Plain}, _} -> - [Alert| _] = decode_alerts(Plain), - downgrade(Alert, Transport, Socket, Pid) - end; - {error, timeout} -> - {error, timeout}; - _ -> - {error, no_tls_close} - end; %% User closes or recursive call! close({close, Timeout}, Socket, Transport = gen_tcp, _,_) -> ssl_socket:setopts(Transport, Socket, [{active, false}]), @@ -1020,15 +1021,11 @@ close({shutdown, own_alert}, Socket, Transport = gen_tcp, ConnectionStates, Chec %% with the network but we want to maximise the odds that %% peer application gets all data sent on the tcp connection. close({close, ?DEFAULT_TIMEOUT}, Socket, Transport, ConnectionStates, Check); +close(downgrade, _,_,_,_) -> + ok; %% Other close(_, Socket, Transport, _,_) -> Transport:close(Socket). -downgrade(#alert{description = ?CLOSE_NOTIFY}, Transport, Socket, Pid) -> - ssl_socket:setopts(Transport, Socket, [{active, false}, {packet, 0}, {mode, binary}]), - Transport:controlling_process(Socket, Pid), - {ok, Socket}; -downgrade(_, _,_,_) -> - {error, no_tls_close}. convert_state(#state{ssl_options = Options} = State, up, "5.3.5", "5.3.6") -> State#state{ssl_options = convert_options_partial_chain(Options, up)}; @@ -1069,4 +1066,3 @@ handle_sni_extension(#client_hello{extensions = HelloExtensions}, State0) -> end; handle_sni_extension(_, State0) -> State0. - diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index ef718c13df..102dbba198 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -278,10 +278,11 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, {Version, SessionId, ConnectionStates, ProtoExt, Protocol} end. -available_signature_algs(undefined, SupportedHashSigns, _, {Major, Minor}) when (Major < 3) andalso (Minor < 3) -> +available_signature_algs(undefined, SupportedHashSigns, _, {Major, Minor}) when + (Major >= 3) andalso (Minor >= 3) -> SupportedHashSigns; available_signature_algs(#hash_sign_algos{hash_sign_algos = ClientHashSigns}, SupportedHashSigns, - _, {Major, Minor}) when (Major < 3) andalso (Minor < 3) -> + _, {Major, Minor}) when (Major >= 3) andalso (Minor >= 3) -> ordsets:intersection(ClientHashSigns, SupportedHashSigns); available_signature_algs(_, _, _, _) -> undefined. diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 0c3c7aa39b..9341d2cae7 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -88,7 +88,8 @@ basic_tests() -> connect_dist, clear_pem_cache, defaults, - fallback + fallback, + cipher_format ]. options_tests() -> @@ -144,7 +145,8 @@ api_tests() -> versions_option, server_name_indication_option, accept_pool, - new_options_in_accept + new_options_in_accept, + prf ]. session_tests() -> @@ -325,6 +327,31 @@ init_per_testcase(rizzo, Config) -> ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), ct:timetrap({seconds, 40}), Config; +init_per_testcase(prf, Config) -> + ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), + ct:timetrap({seconds, 40}), + case ?config(tc_group_path, Config) of + [] -> Prop = []; + [Prop] -> Prop + end, + case ?config(name, Prop) of + undefined -> TlsVersions = [sslv3, tlsv1, 'tlsv1.1', 'tlsv1.2']; + TlsVersion when is_atom(TlsVersion) -> + TlsVersions = [TlsVersion] + end, + PRFS=[md5, sha, sha256, sha384, sha512], + %All are the result of running tls_v1:prf(PrfAlgo, <<>>, <<>>, <<>>, 16) + %with the specified PRF algorithm + ExpectedPrfResults= + [{md5, <<96,139,180,171,236,210,13,10,28,32,2,23,88,224,235,199>>}, + {sha, <<95,3,183,114,33,169,197,187,231,243,19,242,220,228,70,151>>}, + {sha256, <<166,249,145,171,43,95,158,232,6,60,17,90,183,180,0,155>>}, + {sha384, <<153,182,217,96,186,130,105,85,65,103,123,247,146,91,47,106>>}, + {sha512, <<145,8,98,38,243,96,42,94,163,33,53,49,241,4,127,28>>}, + %TLS 1.0 and 1.1 PRF: + {md5sha, <<63,136,3,217,205,123,200,177,251,211,17,229,132,4,173,80>>}], + TestPlan = prf_create_plan(TlsVersions, PRFS, ExpectedPrfResults), + [{prf_test_plan, TestPlan} | Config]; init_per_testcase(TestCase, Config) when TestCase == ssl_accept_timeout; TestCase == client_closes_socket; @@ -430,6 +457,25 @@ new_options_in_accept(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +prf() -> + [{doc,"Test that ssl:prf/5 uses the negotiated PRF."}]. +prf(Config) when is_list(Config) -> + TestPlan = ?config(prf_test_plan, Config), + case TestPlan of + [] -> ct:fail({error, empty_prf_test_plan}); + _ -> lists:foreach(fun(Suite) -> + lists:foreach( + fun(Test) -> + V = ?config(tls_ver, Test), + C = ?config(ciphers, Test), + E = ?config(expected, Test), + P = ?config(prf, Test), + prf_run_test(Config, V, C, E, P) + end, Suite) + end, TestPlan) + end. + +%%-------------------------------------------------------------------- connection_info() -> [{doc,"Test the API function ssl:connection_information/1"}]. @@ -719,21 +765,27 @@ clear_pem_cache(Config) when is_list(Config) -> State = ssl_test_lib:state(Prop), [_,FilRefDb |_] = element(6, State), {Server, Client} = basic_verify_test_no_close(Config), - 2 = ets:info(FilRefDb, size), + CountReferencedFiles = fun({_,-1}, Acc) -> + Acc; + ({_, N}, Acc) -> + N + Acc + end, + + 2 = ets:foldl(CountReferencedFiles, 0, FilRefDb), ssl:clear_pem_cache(), _ = sys:get_status(whereis(ssl_manager)), {Server1, Client1} = basic_verify_test_no_close(Config), - 4 = ets:info(FilRefDb, size), + 4 = ets:foldl(CountReferencedFiles, 0, FilRefDb), ssl_test_lib:close(Server), ssl_test_lib:close(Client), - ct:sleep(5000), + ct:sleep(2000), _ = sys:get_status(whereis(ssl_manager)), - 2 = ets:info(FilRefDb, size), + 2 = ets:foldl(CountReferencedFiles, 0, FilRefDb), ssl_test_lib:close(Server1), ssl_test_lib:close(Client1), - ct:sleep(5000), + ct:sleep(2000), _ = sys:get_status(whereis(ssl_manager)), - 0 = ets:info(FilRefDb, size). + 0 = ets:foldl(CountReferencedFiles, 0, FilRefDb). %%-------------------------------------------------------------------- @@ -764,6 +816,14 @@ fallback(Config) when is_list(Config) -> Client, {error,{tls_alert,"inappropriate fallback"}}). %%-------------------------------------------------------------------- +cipher_format() -> + [{doc, "Test that cipher conversion from tuples to binarys works"}]. +cipher_format(Config) when is_list(Config) -> + {ok, Socket} = ssl:listen(0, [{ciphers, ssl:cipher_suites()}]), + ssl:close(Socket). + +%%-------------------------------------------------------------------- + peername() -> [{doc,"Test API function peername/1"}]. @@ -2556,6 +2616,13 @@ der_input(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), DHParamFile = filename:join(DataDir, "dHParam.pem"), + {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), + [_, _,_, _, Prop] = StatusInfo, + State = ssl_test_lib:state(Prop), + [CADb | _] = element(6, State), + + Size = ets:info(CADb, size), + SeverVerifyOpts = ?config(server_verification_opts, Config), {ServerCert, ServerKey, ServerCaCerts, DHParams} = der_input_opts([{dhfile, DHParamFile} | SeverVerifyOpts]), @@ -2583,13 +2650,8 @@ der_input(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), ssl_test_lib:close(Client), + Size = ets:info(CADb, size). - {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), - [_, _,_, _, Prop] = StatusInfo, - State = ssl_test_lib:state(Prop), - [CADb | _] = element(6, State), - [] = ets:tab2list(CADb). - %%-------------------------------------------------------------------- der_input_opts(Opts) -> Certfile = proplists:get_value(certfile, Opts), @@ -3051,6 +3113,7 @@ hibernate(Config) -> {current_function, _} = process_info(Pid, current_function), + ssl_test_lib:check_result(Server, ok, Client, ok), timer:sleep(1100), {current_function, {erlang, hibernate, 3}} = @@ -3084,15 +3147,29 @@ hibernate_right_away(Config) -> Server1 = ssl_test_lib:start_server(StartServerOpts), Port1 = ssl_test_lib:inet_port(Server1), - {Client1, #sslsocket{}} = ssl_test_lib:start_client(StartClientOpts ++ + {Client1, #sslsocket{pid = Pid1}} = ssl_test_lib:start_client(StartClientOpts ++ [{port, Port1}, {options, [{hibernate_after, 0}|ClientOpts]}]), + + ssl_test_lib:check_result(Server1, ok, Client1, ok), + + {current_function, {erlang, hibernate, 3}} = + process_info(Pid1, current_function), + ssl_test_lib:close(Server1), ssl_test_lib:close(Client1), Server2 = ssl_test_lib:start_server(StartServerOpts), Port2 = ssl_test_lib:inet_port(Server2), - {Client2, #sslsocket{}} = ssl_test_lib:start_client(StartClientOpts ++ + {Client2, #sslsocket{pid = Pid2}} = ssl_test_lib:start_client(StartClientOpts ++ [{port, Port2}, {options, [{hibernate_after, 1}|ClientOpts]}]), + + ssl_test_lib:check_result(Server2, ok, Client2, ok), + + ct:sleep(100), %% Schedule out + + {current_function, {erlang, hibernate, 3}} = + process_info(Pid2, current_function), + ssl_test_lib:close(Server2), ssl_test_lib:close(Client2). @@ -3677,6 +3754,81 @@ basic_test(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). +prf_create_plan(TlsVersions, PRFs, Results) -> + lists:foldl(fun(Ver, Acc) -> + A = prf_ciphers_and_expected(Ver, PRFs, Results), + [A|Acc] + end, [], TlsVersions). +prf_ciphers_and_expected(TlsVer, PRFs, Results) -> + case TlsVer of + TlsVer when TlsVer == sslv3 orelse TlsVer == tlsv1 + orelse TlsVer == 'tlsv1.1' -> + Ciphers = ssl:cipher_suites(), + {_, Expected} = lists:keyfind(md5sha, 1, Results), + [[{tls_ver, TlsVer}, {ciphers, Ciphers}, {expected, Expected}, {prf, md5sha}]]; + 'tlsv1.2' -> + lists:foldl( + fun(PRF, Acc) -> + Ciphers = prf_get_ciphers(TlsVer, PRF), + case Ciphers of + [] -> + ct:log("No ciphers for PRF algorithm ~p. Skipping.", [PRF]), + Acc; + Ciphers -> + {_, Expected} = lists:keyfind(PRF, 1, Results), + [[{tls_ver, TlsVer}, {ciphers, Ciphers}, {expected, Expected}, + {prf, PRF}] | Acc] + end + end, [], PRFs) + end. +prf_get_ciphers(TlsVer, PRF) -> + case TlsVer of + 'tlsv1.2' -> + lists:filter( + fun(C) when tuple_size(C) == 4 andalso + element(4, C) == PRF -> + true; + (_) -> false + end, ssl:cipher_suites()) + end. +prf_run_test(_, TlsVer, [], _, Prf) -> + ct:fail({error, cipher_list_empty, TlsVer, Prf}); +prf_run_test(Config, TlsVer, Ciphers, Expected, Prf) -> + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + BaseOpts = [{active, true}, {versions, [TlsVer]}, {ciphers, Ciphers}], + ServerOpts = BaseOpts ++ ?config(server_opts, Config), + ClientOpts = BaseOpts ++ ?config(client_opts, Config), + Server = ssl_test_lib:start_server( + [{node, ServerNode}, {port, 0}, {from, self()}, + {mfa, {?MODULE, prf_verify_value, [TlsVer, Expected, Prf]}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client( + [{node, ClientNode}, {port, Port}, + {host, Hostname}, {from, self()}, + {mfa, {?MODULE, prf_verify_value, [TlsVer, Expected, Prf]}}, + {options, ClientOpts}]), + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). +prf_verify_value(Socket, TlsVer, Expected, Algo) -> + Ret = ssl:prf(Socket, <<>>, <<>>, [<<>>], 16), + case TlsVer of + sslv3 -> + case Ret of + {error, undefined} -> ok; + _ -> + {error, {expected, {error, undefined}, + got, Ret, tls_ver, TlsVer, prf_algorithm, Algo}} + end; + _ -> + case Ret of + {ok, Expected} -> ok; + {ok, Val} -> {error, {expected, Expected, got, Val, tls_ver, TlsVer, + prf_algorithm, Algo}} + end + end. + send_recv_result_timeout_client(Socket) -> {error, timeout} = ssl:recv(Socket, 11, 500), ssl:send(Socket, "Hello world"), diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 66ccbb1da4..49c0b9c5a1 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -52,8 +52,8 @@ groups() -> {error_handling, [],error_handling_tests()}]. tests() -> - [server_verify_peer, - server_verify_none, + [verify_peer, + verify_none, server_require_peer_cert_ok, server_require_peer_cert_fail, server_require_peer_cert_partial_chain, @@ -110,6 +110,17 @@ init_per_group(_, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_testcase(TestCase, Config) when TestCase == cert_expired; + TestCase == invalid_signature_client; + TestCase == invalid_signature_server; + TestCase == extended_key_usage_verify_none; + TestCase == extended_key_usage_verify_peer; + TestCase == critical_extension_verify_none; + TestCase == critical_extension_verify_peer; + TestCase == no_authority_key_identifier; + TestCase == no_authority_key_identifier_and_nonstandard_encoding-> + ssl:clear_pem_cache(), + init_per_testcase(common, Config); init_per_testcase(_TestCase, Config) -> ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), ct:timetrap({seconds, 5}), @@ -122,9 +133,9 @@ end_per_testcase(_TestCase, Config) -> %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- -server_verify_peer() -> - [{doc,"Test server option verify_peer"}]. -server_verify_peer(Config) when is_list(Config) -> +verify_peer() -> + [{doc,"Test option verify_peer"}]. +verify_peer(Config) when is_list(Config) -> ClientOpts = ?config(client_verification_opts, Config), ServerOpts = ?config(server_verification_opts, Config), Active = ?config(active, Config), @@ -147,10 +158,10 @@ server_verify_peer(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- -server_verify_none() -> - [{doc,"Test server option verify_none"}]. +verify_none() -> + [{doc,"Test option verify_none"}]. -server_verify_none(Config) when is_list(Config) -> +verify_none(Config) when is_list(Config) -> ClientOpts = ?config(client_verification_opts, Config), ServerOpts = ?config(server_verification_opts, Config), Active = ?config(active, Config), @@ -220,18 +231,21 @@ server_require_peer_cert_ok(Config) when is_list(Config) -> ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true} | ?config(server_verification_opts, Config)], ClientOpts = ?config(client_verification_opts, Config), + Active = ?config(active, Config), + ReceiveFunction = ?config(receive_function, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {ssl_test_lib,send_recv_result, []}}, - {options, [{active, false} | ServerOpts]}]), + {mfa, {ssl_test_lib, ReceiveFunction, []}}, + {options, [{active, Active} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {ssl_test_lib, send_recv_result, []}}, - {options, [{active, false} | ClientOpts]}]), + {mfa, {ssl_test_lib, ReceiveFunction, []}}, + {options, [{active, Active} | ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), @@ -313,6 +327,8 @@ server_require_peer_cert_allow_partial_chain(Config) when is_list(Config) -> | ?config(server_verification_opts, Config)], ClientOpts = ?config(client_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Active = ?config(active, Config), + ReceiveFunction = ?config(receive_function, Config), {ok, ServerCAs} = file:read_file(proplists:get_value(cacertfile, ServerOpts)), [{_,_,_}, {_, IntermidiateCA, _}] = public_key:pem_decode(ServerCAs), @@ -328,16 +344,17 @@ server_require_peer_cert_allow_partial_chain(Config) when is_list(Config) -> Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {ssl_test_lib, send_recv_result_active, []}}, - {options, [{cacerts, [IntermidiateCA]}, + {mfa, {ssl_test_lib, ReceiveFunction, []}}, + {options, [{active, Active}, + {cacerts, [IntermidiateCA]}, {partial_chain, PartialChain} | proplists:delete(cacertfile, ServerOpts)]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {ssl_test_lib, send_recv_result_active, []}}, - {options, ClientOpts}]), + {mfa, {ssl_test_lib, ReceiveFunction, []}}, + {options, [{active, Active} | ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), ssl_test_lib:close(Client). @@ -522,32 +539,6 @@ verify_fun_always_run_server(Config) when is_list(Config) -> %%-------------------------------------------------------------------- -client_verify_none_passive() -> - [{doc,"Test client option verify_none"}]. - -client_verify_none_passive(Config) when is_list(Config) -> - ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, send_recv_result, []}}, - {options, [{active, false} - | ServerOpts]}]), - Port = ssl_test_lib:inet_port(Server), - - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {ssl_test_lib, send_recv_result, []}}, - {options, [{active, false}, - {verify, verify_none} - | ClientOpts]}]), - - ssl_test_lib:check_result(Server, ok, Client, ok), - ssl_test_lib:close(Server), - ssl_test_lib:close(Client). -%%-------------------------------------------------------------------- cert_expired() -> [{doc,"Test server with expired certificate"}]. @@ -616,64 +607,6 @@ two_digits_str(N) -> lists:flatten(io_lib:format("~p", [N])). %%-------------------------------------------------------------------- - -client_verify_none_active() -> - [{doc,"Test client option verify_none"}]. - -client_verify_none_active(Config) when is_list(Config) -> - ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, - send_recv_result_active, []}}, - {options, [{active, true} - | ServerOpts]}]), - Port = ssl_test_lib:inet_port(Server), - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {ssl_test_lib, - send_recv_result_active, []}}, - {options, [{active, true}, - {verify, verify_none} - | ClientOpts]}]), - - ssl_test_lib:check_result(Server, ok, Client, ok), - ssl_test_lib:close(Server), - ssl_test_lib:close(Client). - -%%-------------------------------------------------------------------- -client_verify_none_active_once() -> - [{doc,"Test client option verify_none"}]. - -client_verify_none_active_once(Config) when is_list(Config) -> - ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), - - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, send_recv_result_active, []}}, - {options, [{active, once} | ServerOpts]}]), - Port = ssl_test_lib:inet_port(Server), - - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {ssl_test_lib, - send_recv_result_active_once, - []}}, - {options, [{active, once}, - {verify, verify_none} - | ClientOpts]}]), - - ssl_test_lib:check_result(Server, ok, Client, ok), - ssl_test_lib:close(Server), - ssl_test_lib:close(Client). - -%%-------------------------------------------------------------------- extended_key_usage_verify_peer() -> [{doc,"Test cert that has a critical extended_key_usage extension in verify_peer mode"}]. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index db9e1c3d38..38cc3532d8 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1041,10 +1041,13 @@ receive_rizzo_duong_beast() -> end end. -state([{data,[{"State", State}]} | _]) -> - State; -state([{data,[{"StateData", State}]} | _]) -> + +state([{data,[{"State", {_StateName, StateData}}]} | _]) -> %% gen_statem + StateData; +state([{data,[{"State", State}]} | _]) -> %% gen_server State; +state([{data,[{"StateData", State}]} | _]) -> %% gen_fsm + State; state([_ | Rest]) -> state(Rest). diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 8c732002de..8f4f384497 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 7.3.1 +SSL_VSN = 7.3.2 diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index ec7f267c64..d83e17b177 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -396,17 +396,17 @@ handle_event(_, _, State, Data) -> <tag><c>pid()</c><br /> <c>LocalName</c></tag> <item>The <c>gen_statem</c> is locally registered.</item> - <tag><c>Name, Node</c></tag> + <tag><c>{Name,Node}</c></tag> <item> The <c>gen_statem</c> is locally registered on another node. </item> - <tag><c>GlobalName</c></tag> + <tag><c>{global,GlobalName}</c></tag> <item> The <c>gen_statem</c> is globally registered in <seealso marker="kernel:global"><c>global</c></seealso>. </item> - <tag><c>RegMod, ViaName</c></tag> + <tag><c>{via,RegMod,ViaName}</c></tag> <item> The <c>gen_statem</c> is registered through an alternative process registry. diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index a8435efc6f..03d0063599 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -262,6 +262,21 @@ flatmap(Fun, List1) -> </desc> </func> <func> + <name name="join" arity="2"/> + <fsummary>Insert an element between elements in a list</fsummary> + <desc> + <p>Inserts <c><anno>Sep</anno></c> between each element in <c><anno>List1</anno></c>. Has no + effect on the empty list and on a singleton list. For example:</p> + <pre> +> <input>lists:join(x, [a,b,c]).</input> +[a,x,b,x,c] +> <input>lists:join(x, [a]).</input> +[a] +> <input>lists:join(x, []).</input> +[]</pre> + </desc> + </func> + <func> <name name="foreach" arity="2"/> <fsummary>Apply a function to each element of a list</fsummary> <desc> diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml index 0f58f19421..bf45461e2b 100644 --- a/lib/stdlib/doc/src/maps.xml +++ b/lib/stdlib/doc/src/maps.xml @@ -301,6 +301,30 @@ false</code> </func> <func> + <name name="take" arity="2"/> + <fsummary></fsummary> + <desc> + <p> + The function removes the <c><anno>Key</anno></c>, if it exists, and its associated value from + <c><anno>Map1</anno></c> and returns a tuple with the removed <c><anno>Value</anno></c> and + the new map <c><anno>Map2</anno></c> without key <c><anno>Key</anno></c>. + If the key does not exist <c>error</c> is returned. + </p> + <p> + The call will fail with a <c>{badmap,Map}</c> exception if <c><anno>Map1</anno></c> is not a map. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{"a" => "hello", "b" => "world"}. +#{"a" => "hello", "b" => "world"} +> maps:take("a",Map). +{"hello",#{"b" => "world"}} +> maps:take("does not exist",Map). +error</code> + </desc> + </func> + + <func> <name name="size" arity="1"/> <fsummary></fsummary> <desc> @@ -357,6 +381,42 @@ false</code> </desc> </func> + <func> + <name name="update_with" arity="3"/> + <fsummary></fsummary> + <desc> + <p>Update a value in a <c><anno>Map1</anno></c> associated with <c><anno>Key</anno></c> by + calling <c><anno>Fun</anno></c> on the old value to get a new value. An exception + <c>{badkey,<anno>Key</anno>}</c> is generated if + <c><anno>Key</anno></c> is not present in the map.</p> + <p>Example:</p> + <code type="none"> +> Map = #{"counter" => 1}, + Fun = fun(V) -> V + 1 end, + maps:update_with("counter",Fun,Map). +#{"counter" => 2}</code> + </desc> + </func> + + <func> + <name name="update_with" arity="4"/> + <fsummary></fsummary> + <desc> + <p>Update a value in a <c><anno>Map1</anno></c> associated with <c><anno>Key</anno></c> by + calling <c><anno>Fun</anno></c> on the old value to get a new value. + If <c><anno>Key</anno></c> is not present + in <c><anno>Map1</anno></c> then <c><anno>Init</anno></c> will be associated with + <c><anno>Key</anno></c>. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{"counter" => 1}, + Fun = fun(V) -> V + 1 end, + maps:update_with("new counter",Fun,42,Map). +#{"counter" => 1,"new counter" => 42}</code> + </desc> + </func> + <func> <name name="values" arity="1"/> <fsummary></fsummary> diff --git a/lib/stdlib/examples/erl_id_trans.erl b/lib/stdlib/examples/erl_id_trans.erl index c2e345763a..eab2ec4164 100644 --- a/lib/stdlib/examples/erl_id_trans.erl +++ b/lib/stdlib/examples/erl_id_trans.erl @@ -671,6 +671,10 @@ map_pair_types([{type,Line,map_field_assoc,[K,V]}|Ps]) -> K1 = type(K), V1 = type(V), [{type,Line,map_field_assoc,[K1,V1]}|map_pair_types(Ps)]; +map_pair_types([{type,Line,map_field_exact,[K,V]}|Ps]) -> + K1 = type(K), + V1 = type(V), + [{type,Line,map_field_exact,[K1,V1]}|map_pair_types(Ps)]; map_pair_types([]) -> []. field_types([{type,Line,field_type,[{atom,La,A},T]}|Fs]) -> diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 936c095aef..73934e0e3c 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -43,13 +43,18 @@ -type name() :: atom(). -type argspec() :: 'none' %No arguments | non_neg_integer(). %Number of arguments +-type argnames() :: [atom()]. -type tokens() :: [erl_scan:token()]. +-type predef() :: 'undefined' | {'none', tokens()}. +-type userdef() :: {argspec(), {argnames(), tokens()}}. -type used() :: {name(), argspec()}. -type function_name_type() :: 'undefined' | {atom(),non_neg_integer()} | tokens(). +-type warning_info() :: {erl_anno:location(), module(), term()}. + -define(DEFAULT_ENCODING, utf8). %% Epp state record. @@ -63,7 +68,7 @@ sstk=[] :: [#epp{}], %State stack path=[] :: [file:name()], %Include-path macs = #{} %Macros (don't care locations) - :: #{name() => {argspec(), tokens()}}, + :: #{name() => predef() | [userdef()]}, uses = #{} %Macro use structure :: #{name() => [{argspec(), [used()]}]}, default_encoding = ?DEFAULT_ENCODING :: source_encoding(), @@ -155,11 +160,13 @@ scan_erl_form(Epp) -> epp_request(Epp, scan_erl_form). -spec parse_erl_form(Epp) -> - {'ok', AbsForm} | {'eof', Line} | {error, ErrorInfo} when + {'ok', AbsForm} | {error, ErrorInfo} | + {'warning',WarningInfo} | {'eof',Line} when Epp :: epp_handle(), AbsForm :: erl_parse:abstract_form(), Line :: erl_anno:line(), - ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). + ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(), + WarningInfo :: warning_info(). parse_erl_form(Epp) -> case epp_request(Epp, scan_erl_form) of @@ -216,6 +223,10 @@ format_error({illegal_function_usage,Macro}) -> io_lib:format("?~s must not begin a form", [Macro]); format_error({'NYI',What}) -> io_lib:format("not yet implemented '~s'", [What]); +format_error({error,Term}) -> + io_lib:format("-error(~p).", [Term]); +format_error({warning,Term}) -> + io_lib:format("-warning(~p).", [Term]); format_error(E) -> file:format_error(E). -spec parse_file(FileName, IncludePath, PredefMacros) -> @@ -260,9 +271,11 @@ parse_file(Ifile, Options) -> -spec parse_file(Epp) -> [Form] when Epp :: epp_handle(), - Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | {'eof',Line}, + Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | + {'warning',WarningInfo} | {'eof',Line}, Line :: erl_anno:line(), - ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). + ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(), + WarningInfo :: warning_info(). parse_file(Epp) -> case parse_erl_form(Epp) of @@ -270,6 +283,8 @@ parse_file(Epp) -> [Form|parse_file(Epp)]; {error,E} -> [{error,E}|parse_file(Epp)]; + {warning,W} -> + [{warning,W}|parse_file(Epp)]; {eof,Location} -> [{eof,erl_anno:new(Location)}] end. @@ -749,6 +764,10 @@ scan_toks([{'-',_Lh},{atom,_Ld,define}=Define|Toks], From, St) -> scan_define(Toks, Define, From, St); scan_toks([{'-',_Lh},{atom,_Ld,undef}=Undef|Toks], From, St) -> scan_undef(Toks, Undef, From, St); +scan_toks([{'-',_Lh},{atom,_Ld,error}=Error|Toks], From, St) -> + scan_err_warn(Toks, Error, From, St); +scan_toks([{'-',_Lh},{atom,_Ld,warning}=Warn|Toks], From, St) -> + scan_err_warn(Toks, Warn, From, St); scan_toks([{'-',_Lh},{atom,_Li,include}=Inc|Toks], From, St) -> scan_include(Toks, Inc, From, St); scan_toks([{'-',_Lh},{atom,_Li,include_lib}=IncLib|Toks], From, St) -> @@ -804,6 +823,24 @@ scan_extends([{atom,Ln,A}=ModAtom,{')',_Lr}|_Ts], Ms0) -> Ms#{'BASE_MODULE_STRING':={none,[{string,Ln,ModString}]}}; scan_extends(_Ts, Ms) -> Ms. +scan_err_warn([{'(',_}|_]=Toks0, {atom,_,Tag}=Token, From, St) -> + try expand_macros(Toks0, St) of + Toks when is_list(Toks) -> + case erl_parse:parse_term(Toks) of + {ok,Term} -> + epp_reply(From, {Tag,{loc(Token),epp,{Tag,Term}}}); + {error,_} -> + epp_reply(From, {error,{loc(Token),epp,{bad,Tag}}}) + end + catch + _:_ -> + epp_reply(From, {error,{loc(Token),epp,{bad,Tag}}}) + end, + wait_req_scan(St); +scan_err_warn(_Toks, {atom,_,Tag}=Token, From, St) -> + epp_reply(From, {error,{loc(Token),epp,{bad,Tag}}}), + wait_req_scan(St). + %% scan_define(Tokens, DefineToken, From, EppState) scan_define([{'(',_Lp},{Type,_Lm,_}=Mac|Toks], Def, From, St) @@ -930,9 +967,15 @@ scan_include(_Toks, Inc, From, St) -> %% normal search path, if not we assume that the first directory name %% is a library name, find its true directory and try with that. -find_lib_dir(NewName) -> - [Lib | Rest] = filename:split(NewName), - {code:lib_dir(list_to_atom(Lib)), Rest}. +expand_lib_dir(Name) -> + try + [App|Path] = filename:split(Name), + LibDir = code:lib_dir(list_to_atom(App)), + {ok,fname_join([LibDir|Path])} + catch + _:_ -> + error + end. scan_include_lib([{'(',_Llp},{string,_Lf,_NewName0},{')',_Lrp},{dot,_Ld}], Inc, From, St) @@ -947,12 +990,11 @@ scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], {ok,NewF,Pname} -> wait_req_scan(enter_file2(NewF, Pname, From, St, Loc)); {error,_E1} -> - case catch find_lib_dir(NewName) of - {LibDir, Rest} when is_list(LibDir) -> - LibName = fname_join([LibDir | Rest]), - case file:open(LibName, [read]) of + case expand_lib_dir(NewName) of + {ok,Header} -> + case file:open(Header, [read]) of {ok,NewF} -> - wait_req_scan(enter_file2(NewF, LibName, From, + wait_req_scan(enter_file2(NewF, Header, From, St, Loc)); {error,_E2} -> epp_reply(From, @@ -960,7 +1002,7 @@ scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], {include,lib,NewName}}}), wait_req_scan(St) end; - _Error -> + error -> epp_reply(From, {error,{loc(Inc),epp, {include,lib,NewName}}}), wait_req_scan(St) diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index b14102ac38..2508f96b91 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -1502,7 +1502,7 @@ pattern({op,_Line,'++',{string,_Li,_S},R}, Vt, Old, Bvt, St) -> pattern({match,_Line,Pat1,Pat2}, Vt, Old, Bvt, St0) -> {Lvt,Bvt1,St1} = pattern(Pat1, Vt, Old, Bvt, St0), {Rvt,Bvt2,St2} = pattern(Pat2, Vt, Old, Bvt, St1), - St3 = reject_bin_alias(Pat1, Pat2, St2), + St3 = reject_invalid_alias(Pat1, Pat2, Vt, St2), {vtmerge_pat(Lvt, Rvt),vtmerge_pat(Bvt1,Bvt2),St3}; %% Catch legal constant expressions, including unary +,-. pattern(Pat, _Vt, _Old, _Bvt, St) -> @@ -1517,56 +1517,77 @@ pattern_list(Ps, Vt, Old, Bvt0, St) -> {vtmerge_pat(Pvt, Psvt),vtmerge_pat(Bvt,Bvt1),St1} end, {[],[],St}, Ps). -%% reject_bin_alias(Pat, Expr, St) -> St' + + +%% reject_invalid_alias(Pat, Expr, Vt, St) -> St' %% Reject aliases for binary patterns at the top level. +%% Reject aliases for maps patterns at the top level. +%% The variables table (Vt) are for maps checkking. + +reject_invalid_alias_expr({bin,_,_}=P, {match,_,P0,E}, Vt, St0) -> + St = reject_invalid_alias(P, P0, Vt, St0), + reject_invalid_alias_expr(P, E, Vt, St); +reject_invalid_alias_expr({map,_,_}=P, {match,_,P0,E}, Vt, St0) -> + St = reject_invalid_alias(P, P0, Vt, St0), + reject_invalid_alias_expr(P, E, Vt, St); +reject_invalid_alias_expr({match,_,_,_}=P, {match,_,P0,E}, Vt, St0) -> + St = reject_invalid_alias(P, P0, Vt, St0), + reject_invalid_alias_expr(P, E, Vt, St); +reject_invalid_alias_expr(_, _, _, St) -> St. -reject_bin_alias_expr({bin,_,_}=P, {match,_,P0,E}, St0) -> - St = reject_bin_alias(P, P0, St0), - reject_bin_alias_expr(P, E, St); -reject_bin_alias_expr({match,_,_,_}=P, {match,_,P0,E}, St0) -> - St = reject_bin_alias(P, P0, St0), - reject_bin_alias_expr(P, E, St); -reject_bin_alias_expr(_, _, St) -> St. -%% reject_bin_alias(Pat1, Pat2, St) -> St' +%% reject_invalid_alias(Pat1, Pat2, St) -> St' %% Aliases of binary patterns, such as <<A:8>> = <<B:4,C:4>> or even %% <<A:8>> = <<A:8>>, are not allowed. Traverse the patterns in parallel %% and generate an error if any binary aliases are found. %% We generate an error even if is obvious that the overall pattern can't %% possibly match, for instance, {a,<<A:8>>,c}={x,<<A:8>>} WILL generate an %% error. +%% Maps should reject unbound variables here. -reject_bin_alias({bin,Line,_}, {bin,_,_}, St) -> +reject_invalid_alias({bin,Line,_}, {bin,_,_}, _, St) -> add_error(Line, illegal_bin_pattern, St); -reject_bin_alias({cons,_,H1,T1}, {cons,_,H2,T2}, St0) -> - St = reject_bin_alias(H1, H2, St0), - reject_bin_alias(T1, T2, St); -reject_bin_alias({tuple,_,Es1}, {tuple,_,Es2}, St) -> - reject_bin_alias_list(Es1, Es2, St); -reject_bin_alias({record,_,Name1,Pfs1}, {record,_,Name2,Pfs2}, +reject_invalid_alias({map,_Line,Ps1}, {map,_,Ps2}, Vt, St0) -> + Fun = fun ({map_field_exact,L,{var,_,K},_V}, Sti) -> + case is_var_bound(K,Vt) of + true -> + Sti; + false -> + add_error(L, {unbound_var,K}, Sti) + end; + ({map_field_exact,_L,_K,_V}, Sti) -> + Sti + end, + foldl(Fun, foldl(Fun, St0, Ps1), Ps2); +reject_invalid_alias({cons,_,H1,T1}, {cons,_,H2,T2}, Vt, St0) -> + St = reject_invalid_alias(H1, H2, Vt, St0), + reject_invalid_alias(T1, T2, Vt, St); +reject_invalid_alias({tuple,_,Es1}, {tuple,_,Es2}, Vt, St) -> + reject_invalid_alias_list(Es1, Es2, Vt, St); +reject_invalid_alias({record,_,Name1,Pfs1}, {record,_,Name2,Pfs2}, Vt, #lint{records=Recs}=St) -> case {dict:find(Name1, Recs),dict:find(Name2, Recs)} of {{ok,{_Line1,Fields1}},{ok,{_Line2,Fields2}}} -> - reject_bin_alias_rec(Pfs1, Pfs2, Fields1, Fields2, St); + reject_invalid_alias_rec(Pfs1, Pfs2, Fields1, Fields2, Vt, St); {_,_} -> %% One or more non-existing records. (An error messages has %% already been generated, so we are done here.) St end; -reject_bin_alias({match,_,P1,P2}, P, St0) -> - St = reject_bin_alias(P1, P, St0), - reject_bin_alias(P2, P, St); -reject_bin_alias(P, {match,_,_,_}=M, St) -> - reject_bin_alias(M, P, St); -reject_bin_alias(_P1, _P2, St) -> St. - -reject_bin_alias_list([E1|Es1], [E2|Es2], St0) -> - St = reject_bin_alias(E1, E2, St0), - reject_bin_alias_list(Es1, Es2, St); -reject_bin_alias_list(_, _, St) -> St. - -reject_bin_alias_rec(PfsA0, PfsB0, FieldsA0, FieldsB0, St) -> +reject_invalid_alias({match,_,P1,P2}, P, Vt, St0) -> + St = reject_invalid_alias(P1, P, Vt, St0), + reject_invalid_alias(P2, P, Vt, St); +reject_invalid_alias(P, {match,_,_,_}=M, Vt, St) -> + reject_invalid_alias(M, P, Vt, St); +reject_invalid_alias(_P1, _P2, _Vt, St) -> St. + +reject_invalid_alias_list([E1|Es1], [E2|Es2], Vt, St0) -> + St = reject_invalid_alias(E1, E2, Vt, St0), + reject_invalid_alias_list(Es1, Es2, Vt, St); +reject_invalid_alias_list(_, _, _, St) -> St. + +reject_invalid_alias_rec(PfsA0, PfsB0, FieldsA0, FieldsB0, Vt, St) -> %% We treat records as if they have been converted to tuples. PfsA1 = rbia_field_vars(PfsA0), PfsB1 = rbia_field_vars(PfsB0), @@ -1582,7 +1603,7 @@ reject_bin_alias_rec(PfsA0, PfsB0, FieldsA0, FieldsB0, St) -> D = sofs:projection({external,fun({_,_,P1,_,P2}) -> {P1,P2} end}, C), E = sofs:to_external(D), {Ps1,Ps2} = lists:unzip(E), - reject_bin_alias_list(Ps1, Ps2, St). + reject_invalid_alias_list(Ps1, Ps2, Vt, St). rbia_field_vars(Fs) -> [{Name,Pat} || {record_field,_,{atom,_,Name},Pat} <- Fs]. @@ -2284,7 +2305,7 @@ expr({'catch',Line,E}, Vt, St0) -> expr({match,_Line,P,E}, Vt, St0) -> {Evt,St1} = expr(E, Vt, St0), {Pvt,Bvt,St2} = pattern(P, vtupdate(Evt, Vt), St1), - St = reject_bin_alias_expr(P, E, St2), + St = reject_invalid_alias_expr(P, E, Vt, St2), {vtupdate(Bvt, vtmerge(Evt, Pvt)),St}; %% No comparison or boolean operators yet. expr({op,_Line,_Op,A}, Vt, St) -> @@ -2381,7 +2402,7 @@ is_valid_call(Call) -> _ -> true end. -%% is_valid_map_key(K,St) -> true | false +%% is_valid_map_key(K) -> true | false %% variables are allowed for patterns only at the top of the tree is_valid_map_key({var,_,_}) -> true; @@ -3413,6 +3434,14 @@ warn_unused_vars(U, Vt, St0) -> UVt = map(fun ({V,{State,_,Ls}}) -> {V,{State,used,Ls}} end, U), {vtmerge(Vt, UVt), St1}. + +is_var_bound(V, Vt) -> + case orddict:find(V, Vt) of + {ok,{bound,_Usage,_}} -> true; + _ -> false + end. + + %% vtupdate(UpdVarTable, VarTable) -> VarTable. %% Add the variables in the updated vartable to VarTable. The variables %% will be updated with their property in UpdVarTable. The state of diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 6f8e5e8449..a896de4f1c 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -170,9 +170,16 @@ fun_type -> '(' top_types ')' '->' top_type : {type, ?anno('$1'), 'fun', [{type, ?anno('$1'), product, '$2'},'$5']}. +map_pair_types -> '...' : [{type, ?anno('$1'), map_field_assoc, + [{type, ?anno('$1'), any, []}, + {type, ?anno('$1'), any, []}]}]. map_pair_types -> map_pair_type : ['$1']. map_pair_types -> map_pair_type ',' map_pair_types : ['$1'|'$3']. -map_pair_type -> top_type '=>' top_type : {type, ?anno('$2'), map_field_assoc,['$1','$3']}. + +map_pair_type -> top_type '=>' top_type : {type, ?anno('$2'), + map_field_assoc,['$1','$3']}. +map_pair_type -> top_type ':=' top_type : {type, ?anno('$2'), + map_field_exact,['$1','$3']}. field_types -> field_type : ['$1']. field_types -> field_type ',' field_types : ['$1'|'$3']. @@ -810,7 +817,8 @@ Erlang code. | {'type', anno(), 'map', [af_map_pair_type()]}. -type af_map_pair_type() :: - {'type', anno(), 'map_field_assoc', [abstract_type()]}. + {'type', anno(), 'map_field_assoc', [abstract_type()]} + | {'type', anno(), 'map_field_exact', [abstract_type()]}. -type af_predefined_type() :: {'type', anno(), type_name(), [abstract_type()]}. diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index c5177aca90..ca764675fc 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -344,11 +344,31 @@ binary_type(I1, I2) -> map_type(Fs) -> {first,[$#],map_pair_types(Fs)}. -map_pair_types(Fs) -> +map_pair_types(Fs0) -> + Fs = replace_any_map(Fs0), tuple_type(Fs, fun map_pair_type/2). +replace_any_map([{type,Line,map_field_assoc,[KType,VType]}]=Fs) -> + IsAny = fun({type,_,any,[]}) -> true; + %% ({var,_,'_'}) -> true; + (_) -> false + end, + case IsAny(KType) andalso IsAny(VType) of + true -> + [{type,Line,map_field_assoc,any}]; + false -> + Fs + end; +replace_any_map([F|Fs]) -> + [F|replace_any_map(Fs)]; +replace_any_map([]) -> []. + +map_pair_type({type,_Line,map_field_assoc,any}, _Prec) -> + leaf("..."); map_pair_type({type,_Line,map_field_assoc,[KType,VType]}, Prec) -> - {list,[{cstep,[ltype(KType, Prec),leaf(" =>")],ltype(VType, Prec)}]}. + {list,[{cstep,[ltype(KType, Prec),leaf(" =>")],ltype(VType, Prec)}]}; +map_pair_type({type,_Line,map_field_exact,[KType,VType]}, Prec) -> + {list,[{cstep,[ltype(KType, Prec),leaf(" :=")],ltype(VType, Prec)}]}. record_type(Name, Fields) -> {first,[record_name(Name)],field_types(Fields)}. diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index f9e2e5f7d2..23bddafeed 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -97,7 +97,7 @@ %% * Postponing the current event is performed %% iff 'postpone' is 'true'. %% * A state timer is started iff 'timeout' is set. - %% * Pending events are processed or if there are + %% * Pending events are handled or if there are %% no pending events the server goes into receive %% or hibernate (iff 'hibernate' is 'true') %% @@ -282,16 +282,6 @@ event_type(Type) -> STACKTRACE(), try throw(ok) catch _ -> erlang:get_stacktrace() end). --define( - TERMINATE(Class, Reason, Debug, S, Q), - terminate( - begin Class end, - begin Reason end, - ?STACKTRACE(), - begin Debug end, - begin S end, - begin Q end)). - %%%========================================================================== %%% API @@ -300,11 +290,11 @@ event_type(Type) -> | {'via', RegMod :: module(), Name :: term()} | {'local', atom()}. -type server_ref() :: - {'global', GlobalName :: term()} - | {'via', RegMod :: module(), ViaName :: term()} + pid() | (LocalName :: atom()) | {Name :: atom(), Node :: atom()} - | pid(). + | {'global', GlobalName :: term()} + | {'via', RegMod :: module(), ViaName :: term()}. -type debug_opt() :: {'debug', Dbgs :: @@ -523,12 +513,15 @@ send(Proc, Msg) -> ok end. -%% Here init_it/6 and enter_loop/5,6,7 functions converge +%% Here the init_it/6 and enter_loop/5,6,7 functions converge enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) -> %% The values should already have been type checked Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), - PrevState = make_ref(), % Will be discarded by loop_event_actions/9 + P = Events = [], + Event = {internal,initial_state}, + %% We enforce {postpone,false} to ensure that + %% our fake Event gets discarded, thought it might get logged NewActions = if is_list(Actions) -> @@ -540,15 +533,17 @@ enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) -> callback_mode => CallbackMode, module => Module, name => Name, - state => PrevState, + %% All fields below will be replaced according to the arguments to + %% loop_event_actions/10 when it finally loops back to loop/3 + state => State, data => Data, - timer => undefined, - postponed => [], - hibernate => false}, + postponed => P, + hibernate => false, + timer => undefined}, + NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), loop_event_actions( - Parent, Debug, S, [], - {event,undefined}, % Will be discarded thanks to {postpone,false} - PrevState, State, Data, NewActions). + Parent, NewDebug, S, Events, + State, Data, P, Event, State, NewActions). %%%========================================================================== %%% gen callbacks @@ -617,8 +612,12 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> system_continue(Parent, Debug, S) -> loop(Parent, Debug, S). -system_terminate(Reason, _Parent, Debug, S) -> - ?TERMINATE(exit, Reason, Debug, S, []). +system_terminate( + Reason, _Parent, Debug, + #{state := State, data := Data, postponed := P} = S) -> + terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, [], State, Data, P). system_code_change( #{module := Module, @@ -634,7 +633,10 @@ system_code_change( {NewCallbackMode,NewState,NewData} -> callback_mode(NewCallbackMode) orelse error({callback_mode,NewCallbackMode}), - {ok,S#{state := NewState, data := NewData}}; + {ok, + S#{callback_mode := NewCallbackMode, + state := NewState, + data := NewData}}; {ok,_} = Error -> error({case_clause,Error}); Error -> @@ -654,7 +656,7 @@ system_replace_state( format_status( Opt, [PDict,SysState,Parent,Debug, - #{name := Name, postponed := P} = S]) -> + #{name := Name, postponed := P, state := State, data := Data} = S]) -> Header = gen:format_status_header("Status for state machine", Name), Log = sys:get_debug(log, Debug, []), [{header,Header}, @@ -663,7 +665,7 @@ format_status( {"Parent",Parent}, {"Logged Events",Log}, {"Postponed",P}]} | - case format_status(Opt, PDict, S) of + case format_status(Opt, PDict, S, State, Data) of L when is_list(L) -> L; T -> [T] end]. @@ -673,21 +675,21 @@ format_status( %% them, not as the real erlang messages. Use trace for that. %%--------------------------------------------------------------------------- -print_event(Dev, {in,Event}, #{name := Name}) -> +print_event(Dev, {in,Event}, {Name,_}) -> io:format( Dev, "*DBG* ~p received ~s~n", [Name,event_string(Event)]); -print_event(Dev, {out,Reply,{To,_Tag}}, #{name := Name}) -> +print_event(Dev, {out,Reply,{To,_Tag}}, {Name,_}) -> io:format( Dev, "*DBG* ~p sent ~p to ~p~n", [Name,Reply,To]); -print_event(Dev, {Tag,Event,NewState}, #{name := Name, state := State}) -> +print_event(Dev, {Tag,Event,NextState}, {Name,State}) -> StateString = - case NewState of + case NextState of State -> io_lib:format("~p", [State]); _ -> - io_lib:format("~p => ~p", [State,NewState]) + io_lib:format("~p => ~p", [State,NextState]) end, io:format( Dev, "*DBG* ~p ~w ~s in state ~s~n", @@ -697,16 +699,17 @@ event_string(Event) -> case Event of {{call,{Pid,_Tag}},Request} -> io_lib:format("call ~p from ~w", [Request,Pid]); - {Tag,Content} -> - io_lib:format("~w ~p", [Tag,Content]) + {EventType,EventContent} -> + io_lib:format("~w ~p", [EventType,EventContent]) end. -sys_debug(Debug, S, Entry) -> +sys_debug(Debug, #{name := Name}, State, Entry) -> case Debug of [] -> Debug; _ -> - sys:handle_debug(Debug, fun print_event/3, S, Entry) + sys:handle_debug( + Debug, fun print_event/3, {Name,State}, Entry) end. %%%========================================================================== @@ -720,7 +723,7 @@ wakeup_from_hibernate(Parent, Debug, S) -> %%% State Machine engine implementation of proc_lib/gen server %% Server loop, consists of all loop* functions -%% and some detours through sys and proc_lib +%% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3 %% Entry point for system_continue/3 loop(Parent, Debug, #{hibernate := Hibernate} = S) -> @@ -749,12 +752,16 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> sys:handle_system_msg( Req, Pid, Parent, ?MODULE, Debug, S, Hibernate); {'EXIT',Parent,Reason} = EXIT -> + #{state := State, data := Data, postponed := P} = S, %% EXIT is not a 2-tuple and therefore %% not an event and has no event_type(), %% but this will stand out in the crash report... - ?TERMINATE(exit, Reason, Debug, S, [EXIT]); + terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, [EXIT], State, Data, P); {timeout,Timer,Content} when Timer =/= undefined -> - loop_event(Parent, Debug, S, {timeout,Content}); + loop_receive_result( + Parent, Debug, S, {timeout,Content}); _ -> %% Cancel Timer if running case Timer of @@ -782,30 +789,81 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> _ -> {info,Msg} end, - loop_event(Parent, Debug, S, Event) + loop_receive_result(Parent, Debug, S, Event) end end. -loop_event(Parent, Debug, S, Event) -> - %% The timer field and the hibernate flag in S - %% are now invalid and ignored until we get back to loop/3 - NewDebug = sys_debug(Debug, S, {in,Event}), - %% Here the queue of not yet processed events is created - loop_events(Parent, NewDebug, S, [Event], false). - -%% Process first the event queue, or if it is empty -%% loop back to receive a new event -loop_events(Parent, Debug, S, [], _Hibernate) -> - loop(Parent, Debug, S); +loop_receive_result( + Parent, Debug, + #{state := State, + data := Data, + postponed := P} = S, + Event) -> + %% The engine state map S is now dismantled + %% and will not be restored until we return to loop/3. + %% + %% The fields 'callback_mode', 'module', and 'name' are still valid. + %% The fields 'state', 'data', and 'postponed' are held in arguments. + %% The fields 'timer' and 'hibernate' will be recalculated. + %% + NewDebug = sys_debug(Debug, S, State, {in,Event}), + %% Here the queue of not yet handled events is created + Events = [], + Hibernate = false, + loop_event( + Parent, NewDebug, S, Events, State, Data, P, Event, Hibernate). + +%% Process the event queue, or if it is empty +%% loop back to loop/3 to receive a new event +loop_events( + Parent, Debug, S, [Event|Events], + State, Data, P, Hibernate, _Timeout) -> + %% + %% If there was a state timer requested we just ignore that + %% since we have events to handle which cancels the timer + loop_event( + Parent, Debug, S, Events, State, Data, P, Event, Hibernate); loop_events( + Parent, Debug, S, [], + State, Data, P, Hibernate, Timeout) -> + case Timeout of + {timeout,0,EventContent} -> + %% Immediate timeout - simulate it + %% so we do not get the timeout message + %% after any received event + loop_event( + Parent, Debug, S, [], + State, Data, P, {timeout,EventContent}, Hibernate); + {timeout,Time,EventContent} -> + %% Actually start a timer + Timer = erlang:start_timer(Time, self(), EventContent), + loop_events_done( + Parent, Debug, S, Timer, State, Data, P, Hibernate); + undefined -> + %% No state timeout has been requested + Timer = undefined, + loop_events_done( + Parent, Debug, S, Timer, State, Data, P, Hibernate) + end. +%% +loop_events_done(Parent, Debug, S, Timer, State, Data, P, Hibernate) -> + NewS = + S#{ + state := State, + data := Data, + postponed := P, + hibernate := Hibernate, + timer := Timer}, + loop(Parent, Debug, NewS). + +loop_event( Parent, Debug, #{callback_mode := CallbackMode, - module := Module, - state := State, - data := Data} = S, - [{Type,Content} = Event|Events] = Q, - Hibernate) -> - %% If the Hibernate flag is true here it can only be + module := Module} = S, + Events, + State, Data, P, {Type,Content} = Event, Hibernate) -> + %% + %% If Hibernate is true here it can only be %% because it was set from an event action %% and we did not go into hibernation since there %% were events in queue, so we do what the user @@ -813,6 +871,7 @@ loop_events( %% would have happened if we actually hibernated %% and immediately was awakened Hibernate andalso garbage_collect(), + %% try case CallbackMode of state_functions -> @@ -822,11 +881,11 @@ loop_events( end of Result -> loop_event_result( - Parent, Debug, S, Events, Event, Result) + Parent, Debug, S, Events, State, Data, P, Event, Result) catch Result -> loop_event_result( - Parent, Debug, S, Events, Event, Result); + Parent, Debug, S, Events, State, Data, P, Event, Result); error:badarg when CallbackMode =:= state_functions -> case erlang:get_stacktrace() of [{erlang,apply,[Module,State,_],_}|Stacktrace] -> @@ -835,9 +894,11 @@ loop_events( error, {undef_state_function,{Module,State,Args}}, Stacktrace, - Debug, S, Q); + Debug, S, [Event|Events], State, Data, P); Stacktrace -> - terminate(error, badarg, Stacktrace, Debug, S, Q) + terminate( + error, badarg, Stacktrace, + Debug, S, [Event|Events], State, Data, P) end; error:undef -> %% Process an undef to check for the simple mistake @@ -852,7 +913,7 @@ loop_events( error, {undef_state_function,{Module,State,Args}}, Stacktrace, - Debug, S, Q); + Debug, S, [Event|Events], State, Data, P); [{Module,handle_event, [Type,Content,State,Data]=Args, _} @@ -860,86 +921,85 @@ loop_events( when CallbackMode =:= handle_event_function -> terminate( error, - {undef_state_function, - {Module,handle_event,Args}}, + {undef_state_function,{Module,handle_event,Args}}, Stacktrace, - Debug, S, Q); + Debug, S, [Event|Events], State, Data, P); Stacktrace -> - terminate(error, undef, Stacktrace, Debug, S, Q) + terminate( + error, undef, Stacktrace, + Debug, S, [Event|Events], State, Data, P) end; Class:Reason -> Stacktrace = erlang:get_stacktrace(), - terminate(Class, Reason, Stacktrace, Debug, S, Q) + terminate( + Class, Reason, Stacktrace, + Debug, S, [Event|Events], State, Data, P) end. %% Interpret all callback return variants loop_event_result( - Parent, Debug, - #{state := State, data := Data} = S, - Events, Event, Result) -> - %% From now until we loop back to the loop_events/4 - %% the state and data fields in S are old + Parent, Debug, S, Events, State, Data, P, Event, Result) -> case Result of stop -> - ?TERMINATE(exit, normal, Debug, S, [Event|Events]); + terminate( + exit, normal, ?STACKTRACE(), + Debug, S, [Event|Events], State, Data, P); {stop,Reason} -> - ?TERMINATE(exit, Reason, Debug, S, [Event|Events]); + terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, [Event|Events], State, Data, P); {stop,Reason,NewData} -> - NewS = S#{data := NewData}, - Q = [Event|Events], - ?TERMINATE(exit, Reason, Debug, NewS, Q); + terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P); {stop_and_reply,Reason,Replies} -> Q = [Event|Events], - [Class,NewReason,Stacktrace,NewDebug] = - reply_then_terminate( - exit, Reason, ?STACKTRACE(), Debug, S, Q, Replies), - %% Since we got back here Replies was bad - terminate(Class, NewReason, Stacktrace, NewDebug, S, Q); + reply_then_terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, Q, State, Data, P, Replies); {stop_and_reply,Reason,Replies,NewData} -> - NewS = S#{data := NewData}, Q = [Event|Events], - [Class,NewReason,Stacktrace,NewDebug] = - reply_then_terminate( - exit, Reason, ?STACKTRACE(), Debug, NewS, Q, Replies), - %% Since we got back here Replies was bad - terminate(Class, NewReason, Stacktrace, NewDebug, NewS, Q); + reply_then_terminate( + exit, Reason, ?STACKTRACE(), + Debug, S, Q, State, NewData, P, Replies); {next_state,NextState,NewData} -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, []); + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, []); {next_state,NextState,NewData,Actions} -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions); + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions); {keep_state,NewData} -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, State, NewData, []); + Parent, Debug, S, Events, + State, NewData, P, Event, State, []); {keep_state,NewData,Actions} -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, State, NewData, Actions); + Parent, Debug, S, Events, + State, NewData, P, Event, State, Actions); keep_state_and_data -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, State, Data, []); + Parent, Debug, S, Events, + State, Data, P, Event, State, []); {keep_state_and_data,Actions} -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, State, Data, Actions); + Parent, Debug, S, Events, + State, Data, P, Event, State, Actions); _ -> - ?TERMINATE( - error, {bad_return_value,Result}, Debug, S, [Event|Events]) + terminate( + error, {bad_return_value,Result}, ?STACKTRACE(), + Debug, S, [Event|Events], State, Data, P) end. loop_event_actions( - Parent, Debug, S, Events, Event, State, NextState, NewData, Actions) -> - Postpone = false, % Shall we postpone this event, true or false + Parent, Debug, S, Events, State, NewData, P, Event, NextState, Actions) -> + Postpone = false, % Shall we postpone this event; boolean() Hibernate = false, Timeout = undefined, NextEvents = [], loop_event_actions( - Parent, Debug, S, Events, Event, State, NextState, NewData, + Parent, Debug, S, Events, State, NewData, P, Event, NextState, if is_list(Actions) -> Actions; @@ -948,97 +1008,103 @@ loop_event_actions( end, Postpone, Hibernate, Timeout, NextEvents). %% -%% Process all action()s +%% Process all actions loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, [Action|Actions], + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, [Action|Actions], Postpone, Hibernate, Timeout, NextEvents) -> case Action of %% Actual actions {reply,From,Reply} -> case from(From) of true -> - NewDebug = do_reply(Debug, S, From, Reply), + NewDebug = do_reply(Debug, S, State, From, Reply), loop_event_actions( - Parent, NewDebug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, NewDebug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, Hibernate, Timeout, NextEvents); false -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]) + terminate( + error, {bad_action,Action}, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P) end; {next_event,Type,Content} -> case event_type(Type) of true -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, Hibernate, Timeout, [{Type,Content}|NextEvents]); false -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]) + terminate( + error, {bad_action,Action}, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P) end; %% Actions that set options {postpone,NewPostpone} when is_boolean(NewPostpone) -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, NewPostpone, Hibernate, Timeout, NextEvents); {postpone,_} -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]); + terminate( + error, {bad_action,Action}, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P); postpone -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, true, Hibernate, Timeout, NextEvents); {hibernate,NewHibernate} when is_boolean(NewHibernate) -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, NewHibernate, Timeout, NextEvents); {hibernate,_} -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]); + terminate( + error, {bad_action,Action}, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P); hibernate -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, true, Timeout, NextEvents); {timeout,infinity,_} -> % Clear timer - it will never trigger loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, Hibernate, undefined, NextEvents); {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, Hibernate, NewTimeout, NextEvents); {timeout,_,_} -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]); + terminate( + error, {bad_action,Action}, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P); infinity -> % Clear timer - it will never trigger loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, Hibernate, undefined, NextEvents); Time when is_integer(Time), Time >= 0 -> NewTimeout = {timeout,Time,Time}, loop_event_actions( - Parent, Debug, S, Events, Event, - State, NextState, NewData, Actions, + Parent, Debug, S, Events, + State, NewData, P, Event, NextState, Actions, Postpone, Hibernate, NewTimeout, NextEvents); _ -> - ?TERMINATE( - error, {bad_action,Action}, Debug, S, [Event|Events]) + terminate( + error, {bad_action,Action}, ?STACKTRACE(), + Debug, S, [Event|Events], State, NewData, P) end; %% %% End of actions list loop_event_actions( - Parent, Debug, #{postponed := P0} = S, Events, Event, - State, NextState, NewData, [], + Parent, Debug, S, Events, + State, NewData, P0, Event, NextState, [], Postpone, Hibernate, Timeout, NextEvents) -> %% %% All options have been collected and next_events are buffered. @@ -1059,89 +1125,62 @@ loop_event_actions( {lists:reverse(P1, Events),[]} end, %% Place next events first in queue - Q3 = lists:reverse(NextEvents, Q2), + Q = lists:reverse(NextEvents, Q2), %% NewDebug = sys_debug( - Debug, S, + Debug, S, State, case Postpone of true -> {postpone,Event,NextState}; false -> {consume,Event,NextState} end), - %% Have a peek on the event queue so we can avoid starting - %% the state timer unless we have to - {Q,Timer} = - case Timeout of - undefined -> - %% No state timeout has been requested - {Q3,undefined}; - {timeout,Time,EventContent} -> - %% A state timeout has been requested - case Q3 of - [] when Time =:= 0 -> - %% Immediate timeout - simulate it - %% so we do not get the timeout message - %% after any received event - {[{timeout,EventContent}],undefined}; - [] -> - %% Actually start a timer - {Q3,erlang:start_timer(Time, self(), EventContent)}; - _ -> - %% Do not start a timer since any queued - %% event cancels the state timer so we pretend - %% that the timer has been started and cancelled - {Q3,undefined} - end - end, - %% Loop to top of event queue loop; process next event loop_events( - Parent, NewDebug, - S#{ - state := NextState, - data := NewData, - timer := Timer, - postponed := P, - hibernate := Hibernate}, - Q, Hibernate). + Parent, NewDebug, S, Q, NextState, NewData, P, Hibernate, Timeout). %%--------------------------------------------------------------------------- %% Server helpers -reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, Replies) -> +reply_then_terminate( + Class, Reason, Stacktrace, + Debug, S, Q, State, Data, P, Replies) -> if is_list(Replies) -> do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, Replies); + Class, Reason, Stacktrace, + Debug, S, Q, State, Data, P, Replies); true -> do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, [Replies]) + Class, Reason, Stacktrace, + Debug, S, Q, State, Data, P, [Replies]) end. %% -do_reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, []) -> - terminate(Class, Reason, Stacktrace, Debug, S, Q); do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, [R|Rs]) -> + Class, Reason, Stacktrace, Debug, S, Q, State, Data, P, []) -> + terminate(Class, Reason, Stacktrace, Debug, S, Q, State, Data, P); +do_reply_then_terminate( + Class, Reason, Stacktrace, Debug, S, Q, State, Data, P, [R|Rs]) -> case R of {reply,{_To,_Tag}=From,Reply} -> - NewDebug = do_reply(Debug, S, From, Reply), + NewDebug = do_reply(Debug, S, State, From, Reply), do_reply_then_terminate( - Class, Reason, Stacktrace, NewDebug, S, Q, Rs); + Class, Reason, Stacktrace, + NewDebug, S, Q, State, Data, P, Rs); _ -> - [error,{bad_action,R},?STACKTRACE(),Debug] + terminate( + error, {bad_action,R}, ?STACKTRACE(), + Debug, S, Q, State, Data, P) end. -do_reply(Debug, S, From, Reply) -> +do_reply(Debug, S, State, From, Reply) -> reply(From, Reply), - sys_debug(Debug, S, {out,Reply,From}). + sys_debug(Debug, S, State, {out,Reply,From}). terminate( - Class, Reason, Stacktrace, Debug, - #{module := Module, - state := State, data := Data} = S, - Q) -> + Class, Reason, Stacktrace, + Debug, #{module := Module} = S, Q, State, Data, P) -> try Module:terminate(Reason, State, Data) of _ -> ok catch @@ -1149,8 +1188,8 @@ terminate( C:R -> ST = erlang:get_stacktrace(), error_info( - C, R, ST, Debug, S, Q, - format_status(terminate, get(), S)), + C, R, ST, Debug, S, Q, P, + format_status(terminate, get(), S, State, Data)), erlang:raise(C, R, ST) end, case Reason of @@ -1159,8 +1198,8 @@ terminate( {shutdown,_} -> ok; _ -> error_info( - Class, Reason, Stacktrace, Debug, S, Q, - format_status(terminate, get(), S)) + Class, Reason, Stacktrace, Debug, S, Q, P, + format_status(terminate, get(), S, State, Data)) end, case Stacktrace of [] -> @@ -1171,9 +1210,8 @@ terminate( error_info( Class, Reason, Stacktrace, Debug, - #{name := Name, callback_mode := CallbackMode, - state := State, postponed := P}, - Q, FmtData) -> + #{name := Name, callback_mode := CallbackMode}, + Q, P, FmtData) -> {FixedReason,FixedStacktrace} = case Stacktrace of [{M,F,Args,_}|ST] @@ -1202,46 +1240,49 @@ error_info( error_logger:format( "** State machine ~p terminating~n" ++ case Q of - [] -> - ""; - _ -> - "** Last event = ~p~n" + [] -> ""; + _ -> "** Last event = ~p~n" end ++ - "** When Server state = ~p~n" ++ + "** When server state = ~p~n" ++ "** Reason for termination = ~w:~p~n" ++ - "** State = ~p~n" ++ "** Callback mode = ~p~n" ++ - "** Queued/Postponed = ~w/~w~n" ++ + case Q of + [_,_|_] -> "** Queued = ~p~n"; + _ -> "" + end ++ + case P of + [] -> ""; + _ -> "** Postponed = ~p~n" + end ++ case FixedStacktrace of - [] -> - ""; - _ -> - "** Stacktrace =~n" - "** ~p~n" + [] -> ""; + _ -> "** Stacktrace =~n** ~p~n" end, [Name | case Q of - [] -> - []; - [Event|_] -> - [Event] + [] -> []; + [Event|_] -> [Event] end] ++ [FmtData,Class,FixedReason, - State,CallbackMode,length(Q),length(P)] ++ + CallbackMode] ++ + case Q of + [_|[_|_] = Events] -> [Events]; + _ -> [] + end ++ + case P of + [] -> []; + _ -> [P] + end ++ case FixedStacktrace of - [] -> - []; - _ -> - [FixedStacktrace] + [] -> []; + _ -> [FixedStacktrace] end), sys:print_log(Debug), ok. %% Call Module:format_status/2 or return a default value -format_status( - Opt, PDict, - #{module := Module, state := State, data := Data}) -> +format_status(Opt, PDict, #{module := Module}, State, Data) -> case erlang:function_exported(Module, format_status, 2) of true -> try Module:format_status(Opt, [PDict,State,Data]) diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index f070a7192d..ad98bc0420 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -112,14 +112,14 @@ -type format_spec() :: #{ - control_char => char(), - args => [any()], - width => 'none' | integer(), - adjust => 'left' | 'right', - precision => 'none' | integer(), - pad_char => char(), - encoding => 'unicode' | 'latin1', - strings => boolean() + control_char := char(), + args := [any()], + width := 'none' | integer(), + adjust := 'left' | 'right', + precision := 'none' | integer(), + pad_char := char(), + encoding := 'unicode' | 'latin1', + strings := boolean() }. %%---------------------------------------------------------------------- diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index 2b4472cdf7..af9d63ddd6 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -39,7 +39,8 @@ -export([all/2,any/2,map/2,flatmap/2,foldl/3,foldr/3,filter/2, partition/2,zf/2,filtermap/2, mapfoldl/3,mapfoldr/3,foreach/2,takewhile/2,dropwhile/2,splitwith/2, - split/2]). + split/2, + join/2]). %%% BIFs -export([keyfind/3, keymember/3, keysearch/3, member/2, reverse/2]). @@ -1439,6 +1440,18 @@ split(N, [H|T], R) -> split(_, [], _) -> badarg. +-spec join(Sep, List1) -> List2 when + Sep :: T, + List1 :: [T], + List2 :: [T], + T :: term(). + +join(_Sep, []) -> []; +join(Sep, [H|T]) -> [H|join_prepend(Sep, T)]. + +join_prepend(_Sep, []) -> []; +join_prepend(Sep, [H|T]) -> [Sep,H|join_prepend(Sep,T)]. + %%% ================================================================= %%% Here follows the implementation of the sort functions. %%% diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index a52928f77f..5dafdb282a 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -20,17 +20,18 @@ -module(maps). --export([get/3,filter/2,fold/3, map/2, - size/1, +-export([get/3, filter/2,fold/3, + map/2, size/1, + update_with/3, update_with/4, without/2, with/2]). - -%%% BIFs +%% BIFs -export([get/2, find/2, from_list/1, is_key/2, keys/1, merge/2, - new/0, put/3, remove/2, + new/0, put/3, remove/2, take/2, to_list/1, update/3, values/1]). +%% Shadowed by erl_bif_types: maps:get/2 -spec get(Key,Map) -> Value when Key :: term(), Map :: map(), @@ -46,7 +47,7 @@ get(_,_) -> erlang:nif_error(undef). find(_,_) -> erlang:nif_error(undef). - +%% Shadowed by erl_bif_types: maps:from_list/1 -spec from_list(List) -> Map when List :: [{Key,Value}], Key :: term(), @@ -56,6 +57,7 @@ find(_,_) -> erlang:nif_error(undef). from_list(_) -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:is_key/2 -spec is_key(Key,Map) -> boolean() when Key :: term(), Map :: map(). @@ -71,6 +73,7 @@ is_key(_,_) -> erlang:nif_error(undef). keys(_) -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:merge/2 -spec merge(Map1,Map2) -> Map3 when Map1 :: map(), Map2 :: map(), @@ -86,6 +89,7 @@ merge(_,_) -> erlang:nif_error(undef). new() -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:put/3 -spec put(Key,Value,Map1) -> Map2 when Key :: term(), Value :: term(), @@ -102,7 +106,15 @@ put(_,_,_) -> erlang:nif_error(undef). remove(_,_) -> erlang:nif_error(undef). +-spec take(Key,Map1) -> {Value,Map2} | error when + Key :: term(), + Map1 :: map(), + Value :: term(), + Map2 :: map(). + +take(_,_) -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:to_list/1 -spec to_list(Map) -> [{Key,Value}] when Map :: map(), Key :: term(), @@ -111,6 +123,7 @@ remove(_,_) -> erlang:nif_error(undef). to_list(_) -> erlang:nif_error(undef). +%% Shadowed by erl_bif_types: maps:update/3 -spec update(Key,Value,Map1) -> Map2 when Key :: term(), Value :: term(), @@ -127,8 +140,40 @@ update(_,_,_) -> erlang:nif_error(undef). values(_) -> erlang:nif_error(undef). +%% End of BIFs + +-spec update_with(Key,Fun,Map1) -> Map2 when + Key :: term(), + Map1 :: map(), + Map2 :: map(), + Fun :: fun((Value1 :: term()) -> Value2 :: term()). + +update_with(Key,Fun,Map) when is_function(Fun,1), is_map(Map) -> + try maps:get(Key,Map) of + Val -> maps:update(Key,Fun(Val),Map) + catch + error:{badkey,_} -> + erlang:error({badkey,Key},[Key,Fun,Map]) + end; +update_with(Key,Fun,Map) -> + erlang:error(error_type(Map),[Key,Fun,Map]). + + +-spec update_with(Key,Fun,Init,Map1) -> Map2 when + Key :: term(), + Map1 :: Map1, + Map2 :: Map2, + Fun :: fun((Value1 :: term()) -> Value2 :: term()), + Init :: term(). + +update_with(Key,Fun,Init,Map) when is_function(Fun,1), is_map(Map) -> + case maps:find(Key,Map) of + {ok,Val} -> maps:update(Key,Fun(Val),Map); + error -> maps:put(Key,Init,Map) + end; +update_with(Key,Fun,Init,Map) -> + erlang:error(error_type(Map),[Key,Fun,Init,Map]). -%%% End of BIFs -spec get(Key, Map, Default) -> Value | Default when Key :: term(), diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index 3f79ed0f87..fdc2ae4070 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -48,7 +48,9 @@ | {'priority', priority_level()} | {'min_heap_size', non_neg_integer()} | {'min_bin_vheap_size', non_neg_integer()} - | {'fullsweep_after', non_neg_integer()}. + | {'fullsweep_after', non_neg_integer()} + | {'message_queue_data', + 'off_heap' | 'on_heap' | 'mixed' }. -type dict_or_pid() :: pid() | (ProcInfo :: [_]) diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index d455abf7b0..93409d95df 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -44,11 +44,11 @@ %% This depends on the algorithm handler function -type alg_seed() :: exs64_state() | exsplus_state() | exs1024_state(). %% This is the algorithm handler function within this module --type alg_handler() :: #{type => alg(), - max => integer(), - next => fun(), - uniform => fun(), - uniform_n => fun()}. +-type alg_handler() :: #{type := alg(), + max := integer(), + next := fun(), + uniform := fun(), + uniform_n := fun()}. %% Internal state -opaque state() :: {alg_handler(), alg_seed()}. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 37c3927739..38b764541a 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -57,8 +57,8 @@ | {'global', Name :: atom()} | {'via', Module :: module(), Name :: any()} | pid(). --type child_spec() :: #{id => child_id(), % mandatory - start => mfargs(), % mandatory +-type child_spec() :: #{id := child_id(), % mandatory + start := mfargs(), % mandatory restart => restart(), % optional shutdown => shutdown(), % optional type => worker(), % optional diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index ef2c912c57..4078513e38 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -27,7 +27,8 @@ pmod/1, not_circular/1, skip_header/1, otp_6277/1, otp_7702/1, otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1, otp_8562/1, otp_8665/1, otp_8911/1, otp_10302/1, otp_10820/1, - otp_11728/1, encoding/1, extends/1, function_macro/1]). + otp_11728/1, encoding/1, extends/1, function_macro/1, + test_error/1, test_warning/1]). -export([epp_parse_erl_form/2]). @@ -67,7 +68,7 @@ all() -> not_circular, skip_header, otp_6277, otp_7702, otp_8130, overload_mac, otp_8388, otp_8470, otp_8562, otp_8665, otp_8911, otp_10302, otp_10820, otp_11728, - encoding, extends, function_macro]. + encoding, extends, function_macro, test_error, test_warning]. groups() -> [{upcase_mac, [], [upcase_mac_1, upcase_mac_2]}, @@ -1055,7 +1056,65 @@ ifdef(Config) -> ], [] = run(Config, Ts). +%% OTP-12847: Test the -error directive. +test_error(Config) -> + Cs = [{error_c1, + <<"-error(\"string and macro: \" ?MODULE_STRING).\n" + "-ifdef(NOT_DEFINED).\n" + " -error(\"this one will be skipped\").\n" + "-endif.\n">>, + {errors,[{1,epp,{error,"string and macro: epp_test"}}],[]}}, + + {error_c2, + <<"-ifdef(CONFIG_A).\n" + " t() -> a.\n" + "-else.\n" + "-ifdef(CONFIG_B).\n" + " t() -> b.\n" + "-else.\n" + "-error(\"Neither CONFIG_A nor CONFIG_B are available\").\n" + "-endif.\n" + "-endif.\n">>, + {errors,[{7,epp,{error,"Neither CONFIG_A nor CONFIG_B are available"}}],[]}}, + + {error_c3, + <<"-error(a b c).\n">>, + {errors,[{1,epp,{bad,error}}],[]}} + ], + + [] = compile(Config, Cs), + ok. + +%% OTP-12847: Test the -warning directive. +test_warning(Config) -> + Cs = [{warn_c1, + <<"-warning({a,term,?MODULE}).\n" + "-ifdef(NOT_DEFINED).\n" + "-warning(\"this one will be skipped\").\n" + "-endif.\n">>, + {warnings,[{1,epp,{warning,{a,term,epp_test}}}]}}, + + {warn_c2, + <<"-ifdef(CONFIG_A).\n" + " t() -> a.\n" + "-else.\n" + "-ifdef(CONFIG_B).\n" + " t() -> b.\n" + "-else.\n" + " t() -> c.\n" + "-warning(\"Using fallback\").\n" + "-endif.\n" + "-endif.\n">>, + {warnings,[{8,epp,{warning,"Using fallback"}}]}}, + + {warn_c3, + <<"-warning(a b c).\n">>, + {errors,[{1,epp,{bad,warning}}],[]}} + ], + + [] = compile(Config, Cs), + ok. %% Advanced test on overloading macros. overload_mac(Config) when is_list(Config) -> diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 6fea198af3..b0214e5238 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -33,47 +33,38 @@ -define(privdir, proplists:get_value(priv_dir, Conf)). -endif. --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2]). - --export([ - unused_vars_warn_basic/1, - unused_vars_warn_lc/1, - 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, - unused_function/1, - unsafe_vars/1,unsafe_vars2/1, - unsafe_vars_try/1, - unsized_binary_in_bin_gen_pattern/1, - guard/1, otp_4886/1, otp_4988/1, otp_5091/1, otp_5276/1, otp_5338/1, - otp_5362/1, otp_5371/1, otp_7227/1, otp_5494/1, otp_5644/1, otp_5878/1, - otp_5917/1, otp_6585/1, otp_6885/1, otp_10436/1, otp_11254/1, - otp_11772/1, otp_11771/1, otp_11872/1, - export_all/1, - bif_clash/1, - behaviour_basic/1, behaviour_multiple/1, otp_11861/1, - otp_7550/1, - otp_8051/1, - format_warn/1, - on_load_successful/1, on_load_failing/1, - too_many_arguments/1, - basic_errors/1,bin_syntax_errors/1, - predef/1, - maps/1,maps_type/1,otp_11851/1,otp_11879/1,otp_13230/1, - record_errors/1 - ]). - -init_per_testcase(_Case, Config) -> - Config. - -end_per_testcase(_Case, _Config) -> - ok. +-export([all/0, suite/0, groups/0]). + +-export([unused_vars_warn_basic/1, + unused_vars_warn_lc/1, + 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, + unused_function/1, + unsafe_vars/1,unsafe_vars2/1, + unsafe_vars_try/1, + unsized_binary_in_bin_gen_pattern/1, + guard/1, otp_4886/1, otp_4988/1, otp_5091/1, otp_5276/1, otp_5338/1, + otp_5362/1, otp_5371/1, otp_7227/1, otp_5494/1, otp_5644/1, otp_5878/1, + otp_5917/1, otp_6585/1, otp_6885/1, otp_10436/1, otp_11254/1, + otp_11772/1, otp_11771/1, otp_11872/1, + export_all/1, + bif_clash/1, + behaviour_basic/1, behaviour_multiple/1, otp_11861/1, + otp_7550/1, + otp_8051/1, + format_warn/1, + on_load_successful/1, on_load_failing/1, + too_many_arguments/1, + basic_errors/1,bin_syntax_errors/1, + predef/1, + maps/1,maps_type/1,maps_parallel_match/1, + otp_11851/1,otp_11879/1,otp_13230/1, + record_errors/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -91,7 +82,8 @@ all() -> 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, otp_11851, otp_11879, otp_13230, + maps, maps_type, maps_parallel_match, + otp_11851, otp_11879, otp_13230, record_errors]. groups() -> @@ -101,19 +93,6 @@ groups() -> unused_vars_OTP_4858, unused_unsafe_vars_warn]}, {on_load, [], [on_load_successful, on_load_failing]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - %% Warnings for unused variables in some simple cases. unused_vars_warn_basic(Config) when is_list(Config) -> @@ -3583,8 +3562,6 @@ predef(Config) when is_list(Config) -> ok. maps(Config) -> - %% TODO: test key patterns, not done because map patterns are going to be - %% changed a lot. Ts = [{illegal_map_construction, <<"t() -> #{ a := b, @@ -3626,6 +3603,26 @@ maps(Config) -> {errors,[{1,erl_lint,illegal_map_construction}, {1,erl_lint,{unbound_var,'X'}}], []}}, + {legal_map_pattern, + <<" + -record(mapkey, {a=1,b=2}). + t(M,K1) -> + #{ a := 1, + $a := 1, $z := 99, + #{a=>val} := 2, + K1 := 1337, + #mapkey{a = 10} := wat, + #{{a,val}=>val} := 2, + #{ \"hi\" => wazzup, hi => ho } := yep, + ok := 1.0, + [3+3] := nope, + 1.0 := yep, + {3.0+3} := nope, + {yep} := yep + } = M. + ">>, + [], + []}, {legal_map_construction, <<"t(V) -> #{ a => 1, #{a=>V} => 2, @@ -3692,6 +3689,51 @@ maps_type(Config) when is_list(Config) -> [] = run(Config, Ts), ok. +maps_parallel_match(Config) when is_list(Config) -> + Ts = [{parallel_map_patterns_unbound1, + <<" + t(#{} = M) -> + #{K := V} = #{k := K} = M, + V. + ">>, + [], + {errors,[{3,erl_lint,{unbound_var,'K'}}],[]}}, + {parallel_map_patterns_unbound2, + <<" + t(#{} = M) -> + #{K1 := V1} = + #{K2 := V2} = + #{k1 := K1,k2 := K2} = M, + [V1,V2]. + ">>, + [], + {errors,[{3,erl_lint,{unbound_var,'K1'}}, + {3,erl_lint,{unbound_var,'K1'}}, + {4,erl_lint,{unbound_var,'K2'}}, + {4,erl_lint,{unbound_var,'K2'}}],[]}}, + {parallel_map_patterns_bound, + <<" + t(#{} = M,K1,K2) -> + #{K1 := V1} = + #{K2 := V2} = + #{k1 := K1,k2 := K2} = M, + [V1,V2]. + ">>, + [], + []}, + {parallel_map_patterns_literal, + <<" + t(#{} = M) -> + #{k1 := V1} = + #{k2 := V2} = + #{k1 := V1,k2 := V2} = M, + [V1,V2]. + ">>, + [], + []}], + [] = run(Config, Ts), + ok. + %% OTP-11851: More atoms can be used as type names + bug fixes. otp_11851(Config) when is_list(Config) -> Ts = [ diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 6dc285e448..a48ba7b5b7 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -50,7 +50,7 @@ otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1, - otp_10302/1, otp_10820/1, otp_11100/1, otp_11861/1]). + otp_10302/1, otp_10820/1, otp_11100/1, otp_11861/1, pr_1014/1]). %% Internal export. -export([ehook/6]). @@ -79,7 +79,7 @@ groups() -> {tickets, [], [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, otp_8473, otp_8522, otp_8567, otp_8664, otp_9147, - otp_10302, otp_10820, otp_11100, otp_11861]}]. + otp_10302, otp_10820, otp_11100, otp_11861, pr_1014]}]. init_per_suite(Config) -> Config. @@ -902,6 +902,7 @@ maps_syntax(Config) when is_list(Config) -> "-compile(export_all).\n" "-type t1() :: map().\n" "-type t2() :: #{ atom() => integer(), atom() => float() }.\n" + "-type t3() :: #{ atom() := integer(), atom() := float() }.\n" "-type u() :: #{a => (I :: integer()) | (A :: atom()),\n" " (X :: atom()) | (Y :: atom()) =>\n" " (I :: integer()) | (A :: atom())}.\n" @@ -1106,6 +1107,24 @@ otp_11861(Config) when is_list(Config) -> pf(Form) -> lists:flatten(erl_pp:form(Form, none)). +pr_1014(Config) -> + ok = pp_forms(<<"-type t() :: #{_ => _}. ">>), + ok = pp_forms(<<"-type t() :: #{any() => _}. ">>), + ok = pp_forms(<<"-type t() :: #{_ => any()}. ">>), + ok = pp_forms(<<"-type t() :: #{any() => any()}. ">>), + ok = pp_forms(<<"-type t() :: #{...}. ">>), + ok = pp_forms(<<"-type t() :: #{atom() := integer(), ...}. ">>), + + FileName = filename('pr_1014.erl', Config), + C = <<"-module pr_1014.\n" + "-compile export_all.\n" + "-type m() :: #{..., a := integer()}.\n">>, + ok = file:write_file(FileName, C), + {error,[{_,[{3,erl_parse,["syntax error before: ","','"]}]}],_} = + compile:file(FileName, [return]), + + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% compile(Config, Tests) -> diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index 3deb5fd986..364314f91b 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -634,12 +634,14 @@ sys1(Config) -> stop_it(Pid). code_change(Config) -> + Mode = handle_event_function, {ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []), {idle,data} = sys:get_state(Pid), sys:suspend(Pid), - sys:change_code(Pid, ?MODULE, old_vsn, state_functions), + sys:change_code(Pid, ?MODULE, old_vsn, Mode), sys:resume(Pid), - {idle,{old_vsn,data,state_functions}} = sys:get_state(Pid), + {idle,{old_vsn,data,Mode}} = sys:get_state(Pid), + Mode = gen_statem:call(Pid, get_callback_mode), stop_it(Pid). call_format_status(Config) -> @@ -1478,6 +1480,8 @@ next_events(Type, Content, Data) -> end. +handle_common_events({call,From}, get_callback_mode, _, _) -> + {keep_state_and_data,{reply,From,state_functions}}; handle_common_events({call,From}, get, State, Data) -> {keep_state,Data, [{reply,From,{state,State,Data}}]}; @@ -1501,6 +1505,8 @@ handle_common_events(cast, {'alive?',Pid}, _, Data) -> handle_common_events(_, _, _, _) -> undefined. +handle_event({call,From}, get_callback_mode, _, _) -> + {keep_state_and_data,{reply,From,handle_event_function}}; %% Wrapper state machine that uses a map state machine spec handle_event( Type, Event, State, [Data|Machine]) diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl index 6f2a510f65..531e97e8d6 100644 --- a/lib/stdlib/test/lists_SUITE.erl +++ b/lib/stdlib/test/lists_SUITE.erl @@ -55,6 +55,7 @@ ufunsort_error/1, zip_unzip/1, zip_unzip3/1, zipwith/1, zipwith3/1, filter_partition/1, + join/1, otp_5939/1, otp_6023/1, otp_6606/1, otp_7230/1, suffix/1, subtract/1, droplast/1, hof/1]). @@ -119,7 +120,7 @@ groups() -> {tickets, [parallel], [otp_5939, otp_6023, otp_6606, otp_7230]}, {zip, [parallel], [zip_unzip, zip_unzip3, zipwith, zipwith3]}, {misc, [parallel], [reverse, member, dropwhile, takewhile, - filter_partition, suffix, subtract, + filter_partition, suffix, subtract, join, hof]} ]. @@ -2413,6 +2414,19 @@ zipwith3(Config) when is_list(Config) -> ok. +%% Test lists:join/2 +join(Config) when is_list(Config) -> + A = [a,b,c], + Sep = x, + [a,x,b,x,c] = lists:join(Sep, A), + + B = [b], + [b] = lists:join(Sep, B), + + C = [], + [] = lists:join(Sep, C), + ok. + %% Test lists:filter/2, lists:partition/2. filter_partition(Config) when is_list(Config) -> F = fun(I) -> I rem 2 =:= 0 end, diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl index 8b3a8d7ae2..42e669a799 100644 --- a/lib/stdlib/test/maps_SUITE.erl +++ b/lib/stdlib/test/maps_SUITE.erl @@ -25,15 +25,10 @@ -include_lib("common_test/include/ct.hrl"). -%% Test server specific exports --export([all/0]). --export([suite/0]). --export([init_per_suite/1]). --export([end_per_suite/1]). --export([init_per_testcase/2]). --export([end_per_testcase/2]). - --export([t_get_3/1, t_filter_2/1, +-export([all/0, suite/0]). + +-export([t_update_with_3/1, t_update_with_4/1, + t_get_3/1, t_filter_2/1, t_fold_3/1,t_map_2/1,t_size_1/1, t_with_2/1,t_without_2/1]). @@ -41,29 +36,56 @@ %%-define(badarg(F,Args), {'EXIT', {badarg, [{maps,F,Args,_}|_]}}). %% silly broken hipe -define(badmap(V,F,_Args), {'EXIT', {{badmap,V}, [{maps,F,_,_}|_]}}). +-define(badkey(K,F,_Args), {'EXIT', {{badkey,K}, [{maps,F,_,_}|_]}}). -define(badarg(F,_Args), {'EXIT', {badarg, [{maps,F,_,_}|_]}}). suite() -> - [{ct_hooks, [ts_install_cth]}, + [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. all() -> - [t_get_3,t_filter_2, + [t_update_with_3,t_update_with_4, + t_get_3,t_filter_2, t_fold_3,t_map_2,t_size_1, t_with_2,t_without_2]. -init_per_suite(Config) -> - Config. +t_update_with_3(Config) when is_list(Config) -> + V1 = value1, + V2 = <<"value2">>, + V3 = "value3", + Map = #{ key1 => V1, key2 => V2, "key3" => V3 }, + Fun = fun(V) -> [V,V,{V,V}] end, + + #{ key1 := [V1,V1,{V1,V1}] } = maps:update_with(key1,Fun,Map), + #{ key2 := [V2,V2,{V2,V2}] } = maps:update_with(key2,Fun,Map), + #{ "key3" := [V3,V3,{V3,V3}] } = maps:update_with("key3",Fun,Map), -end_per_suite(_Config) -> + %% error case + ?badmap(b,update_with,[[a,b],a,b]) = (catch maps:update_with([a,b],id(a),b)), + ?badarg(update_with,[[a,b],a,#{}]) = (catch maps:update_with([a,b],id(a),#{})), + ?badkey([a,b],update_with,[[a,b],Fun,#{}]) = (catch maps:update_with([a,b],Fun,#{})), ok. -init_per_testcase(_Case, Config) -> - Config. +t_update_with_4(Config) when is_list(Config) -> + V1 = value1, + V2 = <<"value2">>, + V3 = "value3", + Map = #{ key1 => V1, key2 => V2, "key3" => V3 }, + Fun = fun(V) -> [V,V,{V,V}] end, + Init = 3, + + #{ key1 := [V1,V1,{V1,V1}] } = maps:update_with(key1,Fun,Init,Map), + #{ key2 := [V2,V2,{V2,V2}] } = maps:update_with(key2,Fun,Init,Map), + #{ "key3" := [V3,V3,{V3,V3}] } = maps:update_with("key3",Fun,Init,Map), -end_per_testcase(_Case, _Config) -> + #{ key3 := Init } = maps:update_with(key3,Fun,Init,Map), + + %% error case + ?badmap(b,update_with,[[a,b],a,b]) = (catch maps:update_with([a,b],id(a),b)), + ?badarg(update_with,[[a,b],a,#{}]) = (catch maps:update_with([a,b],id(a),#{})), ok. + t_get_3(Config) when is_list(Config) -> Map = #{ key1 => value1, key2 => value2 }, DefaultValue = "Default value", diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index 81272e62de..119d375746 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -38,7 +38,7 @@ follow/3, empty/0]). -import(erl_parse, [preop_prec/1, inop_prec/1, func_prec/0, - max_prec/0]). + max_prec/0, type_inop_prec/1, type_preop_prec/1]). -define(PADDING, 2). -define(PAPER, 80). @@ -50,7 +50,8 @@ | fun((erl_syntax:syntaxTree(), _, _) -> prettypr:document()). -type clause_t() :: 'case_expr' | 'cond_expr' | 'fun_expr' | 'if_expr' | 'receive_expr' | 'try_expr' - | {'function', prettypr:document()}. + | {'function', prettypr:document()} + | 'spec'. -record(ctxt, {prec = 0 :: integer(), sub_indent = 2 :: non_neg_integer(), @@ -535,9 +536,6 @@ lay_2(Node, Ctxt) -> As = seq(erl_syntax:application_arguments(Node), floating(text(",")), reset_prec(Ctxt), fun lay/2), -%% D1 = beside(D, beside(text("("), -%% beside(par(As), -%% floating(text(")"))))), D1 = beside(D, beside(text("("), beside(par(As), floating(text(")"))))), @@ -651,7 +649,7 @@ lay_2(Node, Ctxt) -> beside(D1, beside(text(":"), D2)); %% - %% The rest is in alphabetical order + %% The rest is in alphabetical order (except map and types) %% arity_qualifier -> @@ -666,18 +664,67 @@ lay_2(Node, Ctxt) -> %% a period. If the arguments is `none', we only output the %% attribute name, without following parentheses. Ctxt1 = reset_prec(Ctxt), - N = erl_syntax:attribute_name(Node), - D = case erl_syntax:attribute_arguments(Node) of - none -> + Args = erl_syntax:attribute_arguments(Node), + N = erl_syntax:attribute_name(Node), + D = case attribute_type(Node) of + spec -> + [SpecTuple] = Args, + [FuncName, FuncTypes] = + erl_syntax:tuple_elements(SpecTuple), + Name = + case erl_syntax:type(FuncName) of + tuple -> + case erl_syntax:tuple_elements(FuncName) of + [F0, _] -> + F0; + [M0, F0, _] -> + erl_syntax:module_qualifier(M0, + F0); + _ -> + FuncName + end; + _ -> + FuncName + end, + Types = dodge_macros(FuncTypes), + D1 = lay_clauses(erl_syntax:concrete(Types), + spec, Ctxt1), + beside(follow(lay(N, Ctxt1), + lay(Name, Ctxt1), + Ctxt1#ctxt.break_indent), + D1); + type -> + [TypeTuple] = Args, + [Name, Type0, Elements] = + erl_syntax:tuple_elements(TypeTuple), + TypeName = dodge_macros(Name), + Type = dodge_macros(Type0), + As0 = dodge_macros(Elements), + As = erl_syntax:concrete(As0), + D1 = lay_type_application(TypeName, As, Ctxt1), + D2 = lay(erl_syntax:concrete(Type), Ctxt1), + beside(follow(lay(N, Ctxt1), + beside(D1, floating(text(" :: "))), + Ctxt1#ctxt.break_indent), + D2); + Tag when Tag =:= export_type; + Tag =:= optional_callbacks -> + [FuncNs] = Args, + FuncNames = erl_syntax:concrete(dodge_macros(FuncNs)), + As = unfold_function_names(FuncNames), + beside(lay(N, Ctxt1), + beside(text("("), + beside(lay(As, Ctxt1), + floating(text(")"))))); + _ when Args =:= none -> lay(N, Ctxt1); - Args -> - As = seq(Args, floating(text(",")), Ctxt1, - fun lay/2), + _ -> + D1 = par(seq(Args, floating(text(",")), Ctxt1, + fun lay/2)), beside(lay(N, Ctxt1), beside(text("("), - beside(par(As), - floating(text(")"))))) - end, + beside(D1, floating(text(")"))))) + end, beside(floating(text("-")), beside(D, floating(text(".")))); binary -> @@ -928,6 +975,16 @@ lay_2(Node, Ctxt) -> text -> text(erl_syntax:text_string(Node)); + typed_record_field -> + {_, Prec, _} = type_inop_prec('::'), + Ctxt1 = reset_prec(Ctxt), + D1 = lay(erl_syntax:typed_record_field_body(Node), Ctxt1), + D2 = lay(erl_syntax:typed_record_field_type(Node), + set_prec(Ctxt, Prec)), + D3 = par([D1, floating(text(" ::")), D2], + Ctxt1#ctxt.break_indent), + maybe_parentheses(D3, Prec, Ctxt); + try_expr -> Ctxt1 = reset_prec(Ctxt), D1 = sep(seq(erl_syntax:try_expr_body(Node), @@ -965,9 +1022,236 @@ lay_2(Node, Ctxt) -> warning_marker -> E = erl_syntax:warning_marker_info(Node), beside(text("%% WARNING: "), - lay_error_info(E, reset_prec(Ctxt))) + lay_error_info(E, reset_prec(Ctxt))); + + %% + %% Types + %% + + annotated_type -> + {_, Prec, _} = type_inop_prec('::'), + D1 = lay(erl_syntax:annotated_type_name(Node), + reset_prec(Ctxt)), + D2 = lay(erl_syntax:annotated_type_body(Node), + set_prec(Ctxt, Prec)), + D3 = follow(beside(D1, floating(text(" ::"))), D2, + Ctxt#ctxt.break_indent), + maybe_parentheses(D3, Prec, Ctxt); + + type_application -> + Name = erl_syntax:type_application_name(Node), + Arguments = erl_syntax:type_application_arguments(Node), + %% Prefer shorthand notation. + case erl_syntax_lib:analyze_type_application(Node) of + {nil, 0} -> + text("[]"); + {list, 1} -> + [A] = Arguments, + D1 = lay(A, reset_prec(Ctxt)), + beside(text("["), beside(D1, text("]"))); + {nonempty_list, 1} -> + [A] = Arguments, + D1 = lay(A, reset_prec(Ctxt)), + beside(text("["), beside(D1, text(", ...]"))); + _ -> + lay_type_application(Name, Arguments, Ctxt) + end; + + bitstring_type -> + Ctxt1 = set_prec(Ctxt, max_prec()), + M = erl_syntax:bitstring_type_m(Node), + N = erl_syntax:bitstring_type_n(Node), + D1 = [beside(text("_:"), lay(M, Ctxt1)) || + (erl_syntax:type(M) =/= integer orelse + erl_syntax:integer_value(M) =/= 0)], + D2 = [beside(text("_:_*"), lay(N, Ctxt1)) || + (erl_syntax:type(N) =/= integer orelse + erl_syntax:integer_value(N) =/= 0)], + F = fun(D, _) -> D end, + D = seq(D1 ++ D2, floating(text(",")), Ctxt1, F), + beside(floating(text("<<")), + beside(par(D), floating(text(">>")))); + + fun_type -> + text("fun()"); + + constrained_function_type -> + Ctxt1 = reset_prec(Ctxt), + D1 = lay(erl_syntax:constrained_function_type_body(Node), + Ctxt1), + D2 = lay(erl_syntax:constrained_function_type_argument(Node), + Ctxt1), + beside(D1, + beside(floating(text(" when ")), D2)); + + function_type -> + {Before, After} = case Ctxt#ctxt.clause of + spec -> + {"", ""}; + _ -> + {"fun(", ")"} + end, + Ctxt1 = reset_prec(Ctxt), + D1 = case erl_syntax:function_type_arguments(Node) of + any_arity -> + text("(...)"); + Arguments -> + As = seq(Arguments, + floating(text(",")), Ctxt1, + fun lay/2), + beside(text("("), + beside(par(As), + floating(text(")")))) + end, + D2 = lay(erl_syntax:function_type_return(Node), Ctxt1), + beside(floating(text(Before)), + beside(D1, + beside(floating(text(" -> ")), + beside(D2, floating(text(After)))))); + + constraint -> + Name = erl_syntax:constraint_argument(Node), + Args = erl_syntax:constraint_body(Node), + case is_subtype(Name, Args) of + true -> + [Var, Type] = Args, + {PrecL, Prec, PrecR} = type_inop_prec('::'), + D1 = lay(Var, set_prec(Ctxt, PrecL)), + D2 = lay(Type, set_prec(Ctxt, PrecR)), + D3 = follow(beside(D1, floating(text(" ::"))), D2, + Ctxt#ctxt.break_indent), + maybe_parentheses(D3, Prec, Ctxt); + false -> + lay_type_application(Name, Args, Ctxt) + end; + + map_type -> + case erl_syntax:map_type_fields(Node) of + any_size -> + text("map()"); + Fs -> + {Prec, _PrecR} = type_preop_prec('#'), + Es = lay_map_fields(Fs, + floating(text(",")), + reset_prec(Ctxt)), + D = beside(floating(text("#{")), + beside(par(Es), + floating(text("}")))), + maybe_parentheses(D, Prec, Ctxt) + end; + + map_type_assoc -> + Name = erl_syntax:map_type_assoc_name(Node), + Value = erl_syntax:map_type_assoc_value(Node), + lay_type_assoc(Name, Value, Ctxt); + + map_type_exact -> + Ctxt1 = reset_prec(Ctxt), + D1 = lay(erl_syntax:map_type_exact_name(Node), Ctxt1), + D2 = lay(erl_syntax:map_type_exact_value(Node), Ctxt1), + par([D1, floating(text(":=")), D2], Ctxt1#ctxt.break_indent); + + integer_range_type -> + {PrecL, Prec, PrecR} = type_inop_prec('..'), + D1 = lay(erl_syntax:integer_range_type_low(Node), + set_prec(Ctxt, PrecL)), + D2 = lay(erl_syntax:integer_range_type_high(Node), + set_prec(Ctxt, PrecR)), + D3 = beside(D1, beside(text(".."), D2)), + maybe_parentheses(D3, Prec, Ctxt); + + record_type -> + {Prec, _PrecR} = type_preop_prec('#'), + D1 = beside(text("#"), + lay(erl_syntax:record_type_name(Node), + reset_prec(Ctxt))), + Es = seq(erl_syntax:record_type_fields(Node), + floating(text(",")), reset_prec(Ctxt), + fun lay/2), + D2 = beside(D1, + beside(text("{"), + beside(par(Es), + floating(text("}"))))), + maybe_parentheses(D2, Prec, Ctxt); + + record_type_field -> + Ctxt1 = reset_prec(Ctxt), + D1 = lay(erl_syntax:record_type_field_name(Node), Ctxt1), + D2 = lay(erl_syntax:record_type_field_type(Node), Ctxt1), + par([D1, floating(text("::")), D2], Ctxt1#ctxt.break_indent); + + tuple_type -> + case erl_syntax:tuple_type_elements(Node) of + any_size -> + text("tuple()"); + Elements -> + Es = seq(Elements, + floating(text(",")), reset_prec(Ctxt), + fun lay/2), + beside(floating(text("{")), + beside(par(Es), floating(text("}")))) + end; + + type_union -> + {_, Prec, PrecR} = type_inop_prec('|'), + Es = par(seq(erl_syntax:type_union_types(Node), + floating(text(" |")), set_prec(Ctxt, PrecR), + fun lay/2)), + maybe_parentheses(Es, Prec, Ctxt); + + user_type_application -> + lay_type_application(erl_syntax:user_type_application_name(Node), + erl_syntax:user_type_application_arguments(Node), + Ctxt) + + end. + +attribute_type(Node) -> + N = erl_syntax:attribute_name(Node), + case catch erl_syntax:concrete(N) of + opaque -> + type; + spec -> + spec; + callback -> + spec; + type -> + type; + export_type -> + export_type; + optional_callbacks -> + optional_callbacks; + _ -> + N end. +is_subtype(Name, [Var, _]) -> + (erl_syntax:is_atom(Name, is_subtype) andalso + erl_syntax:type(Var) =:= variable); +is_subtype(_, _) -> false. + +unfold_function_names(Ns) -> + F = fun ({Atom, Arity}) -> + erl_syntax:arity_qualifier(erl_syntax:atom(Atom), + erl_syntax:integer(Arity)) + end, + erl_syntax:list([F(N) || N <- Ns]). + +%% Macros are not handled well. +dodge_macros(Type) -> + F = fun (T) -> + case erl_syntax:type(T) of + macro -> + Var = erl_syntax:macro_name(T), + VarName0 = erl_syntax:variable_name(Var), + VarName = list_to_atom("?"++atom_to_list(VarName0)), + Atom = erl_syntax:atom(VarName), + Atom; + _ -> T + end + end, + erl_syntax_lib:map(F, Type). + lay_parentheses(D, _Ctxt) -> beside(floating(text("(")), beside(D, floating(text(")")))). @@ -1020,6 +1304,8 @@ split_string_1([], _N, _L, As) -> split_string_2([$^, X | Xs], N, L, As) -> split_string_1(Xs, N - 2, L - 2, [X, $^ | As]); +split_string_2([$x, ${ | Xs], N, L, As) -> + split_string_3(Xs, N - 2, L - 2, [${, $x | As]); split_string_2([X1, X2, X3 | Xs], N, L, As) when X1 >= $0, X1 =< $7, X2 >= $0, X2 =< $7, X3 >= $0, X3 =< $7 -> split_string_1(Xs, N - 3, L - 3, [X3, X2, X1 | As]); @@ -1029,6 +1315,15 @@ split_string_2([X1, X2 | Xs], N, L, As) when split_string_2([X | Xs], N, L, As) -> split_string_1(Xs, N - 1, L - 1, [X | As]). +split_string_3([$} | Xs], N, L, As) -> + split_string_1(Xs, N - 1, L - 1, [$} | As]); +split_string_3([X | Xs], N, L, As) when + X >= $0, X =< $9; X >= $a, X =< $z; X >= $A, X =< $Z -> + split_string_3(Xs, N - 1, L -1, [X | As]); +split_string_3([X | Xs], N, L, As) when + X >= $0, X =< $9 -> + split_string_1(Xs, N - 1, L -1, [X | As]). + %% Note that there is nothing in `lay_clauses' that actually requires %% that the elements have type `clause'; it just sets up the proper %% context and arranges the elements suitably for clauses. @@ -1105,6 +1400,53 @@ lay_error_info(T, Ctxt) -> lay_concrete(T, Ctxt) -> lay(erl_syntax:abstract(T), Ctxt). +lay_map_fields([H | T], Separator, Ctxt) -> + case T of + [] -> + [case erl_syntax:type(H) of + map_type_assoc -> + lay_last_type_assoc(H, Ctxt); + _ -> + lay(H, Ctxt) + end]; + _ -> + [maybe_append(Separator, lay(H, Ctxt)) + | lay_map_fields(T, Separator, Ctxt)] + end; +lay_map_fields([], _, _) -> + [empty()]. + +lay_last_type_assoc(Node, Ctxt) -> + Name = erl_syntax:map_type_assoc_name(Node), + Value = erl_syntax:map_type_assoc_value(Node), + IsAny = fun({type,_,any,[]}) -> true; + %% ({var,_,'_'}) -> true; + (_) -> false + end, + case IsAny(Name) andalso IsAny(Value) of + true -> + text("..."); + false -> + lay_type_assoc(Name, Value, Ctxt) + end. + +lay_type_assoc(Name, Value, Ctxt) -> + Ctxt1 = reset_prec(Ctxt), + D1 = lay(Name, Ctxt1), + D2 = lay(Value, Ctxt1), + par([D1, floating(text("=>")), D2], Ctxt1#ctxt.break_indent). + +lay_type_application(Name, Arguments, Ctxt) -> + {PrecL, Prec} = func_prec(), % + D1 = lay(Name, set_prec(Ctxt, PrecL)), + As = seq(Arguments, + floating(text(",")), reset_prec(Ctxt), + fun lay/2), + D = beside(D1, beside(text("("), + beside(par(As), + floating(text(")"))))), + maybe_parentheses(D, Prec, Ctxt). + seq([H | T], Separator, Ctxt, Fun) -> case T of [] -> diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 97b5797b06..f4cda814fc 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -120,6 +120,9 @@ normalize_list/1, compact_list/1, + annotated_type/2, + annotated_type_name/1, + annotated_type_body/1, application/2, application/3, application_arguments/1, @@ -150,6 +153,9 @@ binary_generator/2, binary_generator_body/1, binary_generator_pattern/1, + bitstring_type/2, + bitstring_type_m/1, + bitstring_type_n/1, block_expr/1, block_expr_body/1, case_expr/2, @@ -175,6 +181,12 @@ cond_expr_clauses/1, conjunction/1, conjunction_body/1, + constrained_function_type/2, + constrained_function_type_body/1, + constrained_function_type_argument/1, + constraint/2, + constraint_argument/1, + constraint_body/1, disjunction/1, disjunction_body/1, eof_marker/0, @@ -188,10 +200,15 @@ fun_expr/1, fun_expr_arity/1, fun_expr_clauses/1, + fun_type/0, function/2, function_arity/1, function_clauses/1, function_name/1, + function_type/1, + function_type/2, + function_type_arguments/1, + function_type_return/1, generator/2, generator_body/1, generator_pattern/1, @@ -209,6 +226,9 @@ is_integer/2, integer_value/1, integer_literal/1, + integer_range_type/2, + integer_range_type_low/1, + integer_range_type_high/1, list/1, list/2, list_comp/2, @@ -230,6 +250,15 @@ map_field_exact/2, map_field_exact_name/1, map_field_exact_value/1, + map_type/0, + map_type/1, + map_type_fields/1, + map_type_assoc/2, + map_type_assoc_name/1, + map_type_assoc_value/1, + map_type_exact/2, + map_type_exact_name/1, + map_type_exact_value/1, match_expr/2, match_expr_body/1, match_expr_pattern/1, @@ -270,6 +299,12 @@ record_index_expr/2, record_index_expr_field/1, record_index_expr_type/1, + record_type/2, + record_type_name/1, + record_type_fields/1, + record_type_field/2, + record_type_field_name/1, + record_type_field_type/1, size_qualifier/2, size_qualifier_argument/1, size_qualifier_body/1, @@ -288,6 +323,18 @@ try_expr_clauses/1, try_expr_handlers/1, try_expr_after/1, + tuple_type/0, + tuple_type/1, + tuple_type_elements/1, + type_application/2, + type_application/3, + type_application_name/1, + type_application_arguments/1, + type_union/1, + type_union_types/1, + typed_record_field/2, + typed_record_field_body/1, + typed_record_field_type/1, class_qualifier/2, class_qualifier_argument/1, class_qualifier_body/1, @@ -295,6 +342,9 @@ tuple_elements/1, tuple_size/1, underscore/0, + user_type_application/2, + user_type_application_name/1, + user_type_application_arguments/1, variable/1, variable_name/1, variable_literal/1, @@ -412,23 +462,28 @@ %% <center><table border="1"> %% <tr> %% <td>application</td> +%% <td>annotated_type</td> %% <td>arity_qualifier</td> %% <td>atom</td> -%% <td>attribute</td> %% </tr><tr> +%% <td>attribute</td> %% <td>binary</td> %% <td>binary_field</td> +%% <td>bitstring_type</td> +%% </tr><tr> %% <td>block_expr</td> %% <td>case_expr</td> -%% </tr><tr> %% <td>catch_expr</td> %% <td>char</td> +%% </tr><tr> %% <td>class_qualifier</td> %% <td>clause</td> -%% </tr><tr> %% <td>comment</td> %% <td>cond_expr</td> +%% </tr><tr> %% <td>conjunction</td> +%% <td>constrained_function_type</td> +%% <td>constraint</td> %% <td>disjunction</td> %% </tr><tr> %% <td>eof_marker</td> @@ -437,43 +492,58 @@ %% <td>form_list</td> %% </tr><tr> %% <td>fun_expr</td> +%% <td>fun_type</td> %% <td>function</td> +%% <td>function_type</td> +%% </tr><tr> %% <td>generator</td> %% <td>if_expr</td> -%% </tr><tr> %% <td>implicit_fun</td> %% <td>infix_expr</td> +%% </tr><tr> %% <td>integer</td> +%% <td>integer_range_type</td> %% <td>list</td> -%% </tr><tr> %% <td>list_comp</td> +%% </tr><tr> %% <td>macro</td> %% <td>map_expr</td> %% <td>map_field_assoc</td> -%% </tr><tr> %% <td>map_field_exact</td> +%% </tr><tr> +%% <td>map_type</td> +%% <td>map_type_assoc</td> +%% <td>map_type_exact</td> %% <td>match_expr</td> %% <td>module_qualifier</td> -%% <td>named_fun_expr</td> %% </tr><tr> +%% <td>named_fun_expr</td> %% <td>nil</td> %% <td>operator</td> %% <td>parentheses</td> -%% <td>prefix_expr</td> %% </tr><tr> +%% <td>prefix_expr</td> %% <td>receive_expr</td> %% <td>record_access</td> %% <td>record_expr</td> -%% <td>record_field</td> %% </tr><tr> +%% <td>record_field</td> %% <td>record_index_expr</td> +%% <td>record_type</td> +%% <td>record_type_field</td> +%% </tr><tr> %% <td>size_qualifier</td> %% <td>string</td> %% <td>text</td> -%% </tr><tr> %% <td>try_expr</td> +%% </tr><tr> %% <td>tuple</td> +%% <td>tuple_type</td> +%% <td>typed_record_field</td> +%% <td>type_application</td> +%% <td>type_union</td> %% <td>underscore</td> +%% <td>user_type_application</td> %% <td>variable</td> %% </tr><tr> %% <td>warning_marker</td> @@ -487,12 +557,14 @@ %% always have the same name as the node type itself. %% %% @see tree/2 +%% @see annotated_type/2 %% @see application/3 %% @see arity_qualifier/2 %% @see atom/1 %% @see attribute/2 %% @see binary/1 %% @see binary_field/2 +%% @see bitstring_type/2 %% @see block_expr/1 %% @see case_expr/2 %% @see catch_expr/1 @@ -502,24 +574,34 @@ %% @see comment/2 %% @see cond_expr/1 %% @see conjunction/1 +%% @see constrained_function_type/2 +%% @see constraint/2 %% @see disjunction/1 %% @see eof_marker/0 %% @see error_marker/1 %% @see float/1 %% @see form_list/1 %% @see fun_expr/1 +%% @see fun_type/0 %% @see function/2 +%% @see function_type/1 +%% @see function_type/2 %% @see generator/2 %% @see if_expr/1 %% @see implicit_fun/2 %% @see infix_expr/3 %% @see integer/1 +%% @see integer_range_type/2 %% @see list/2 %% @see list_comp/2 %% @see macro/2 %% @see map_expr/2 %% @see map_field_assoc/2 %% @see map_field_exact/2 +%% @see map_type/0 +%% @see map_type/1 +%% @see map_type_assoc/2 +%% @see map_type_exact/2 %% @see match_expr/2 %% @see module_qualifier/2 %% @see named_fun_expr/2 @@ -532,12 +614,20 @@ %% @see record_expr/2 %% @see record_field/2 %% @see record_index_expr/2 +%% @see record_type/2 +%% @see record_type_field/2 %% @see size_qualifier/2 %% @see string/1 %% @see text/1 %% @see try_expr/3 %% @see tuple/1 +%% @see tuple_type/0 +%% @see tuple_type/1 +%% @see typed_record_field/2 +%% @see type_application/2 +%% @see type_union/1 %% @see underscore/0 +%% @see user_type_application/2 %% @see variable/1 %% @see warning_marker/1 @@ -602,6 +692,25 @@ type(Node) -> {remote, _, _, _} -> module_qualifier; {'try', _, _, _, _, _} -> try_expr; {tuple, _, _} -> tuple; + + %% Type types + {ann_type, _, _} -> annotated_type; + {remote_type, _, _} -> type_application; + {type, _, binary, [_, _]} -> bitstring_type; + {type, _, bounded_fun, [_, _]} -> constrained_function_type; + {type, _, constraint, [_, _]} -> constraint; + {type, _, 'fun', []} -> fun_type; + {type, _, 'fun', [_, _]} -> function_type; + {type, _, map, _} -> map_type; + {type, _, map_field_assoc, _} -> map_type_assoc; + {type, _, map_field_exact, _} -> map_type_exact; + {type, _, record, _} -> record_type; + {type, _, field_type, _} -> record_type_field; + {type, _, range, _} -> integer_range_type; + {type, _, tuple, _} -> tuple_type; + {type, _, union, _} -> type_union; + {type, _, _, _} -> type_application; + {user_type, _, _, _} -> user_type_application; _ -> erlang:error({badarg, Node}) end. @@ -621,6 +730,7 @@ type(Node) -> %% <td>`error_marker'</td> %% </tr><tr> %% <td>`float'</td> +%% <td>`fun_type'</td> %% <td>`integer'</td> %% <td>`nil'</td> %% <td>`operator'</td> @@ -633,7 +743,13 @@ type(Node) -> %% </tr> %% </table></center> %% +%% A node of type `map_expr' is a leaf node if and only if it has no +%% argument and no fields. +%% A node of type `map_type' is a leaf node if and only if it has no +%% fields (`any_size'). %% A node of type `tuple' is a leaf node if and only if its arity is zero. +%% A node of type `tuple_type' is a leaf node if and only if it has no +%% elements (`any_size'). %% %% Note: not all literals are leaf nodes, and vice versa. E.g., %% tuples with nonzero arity and nonempty lists may be literals, but are @@ -653,6 +769,7 @@ is_leaf(Node) -> eof_marker -> true; error_marker -> true; float -> true; + fun_type -> true; integer -> true; nil -> true; operator -> true; % nonstandard type @@ -661,7 +778,9 @@ is_leaf(Node) -> map_expr -> map_expr_fields(Node) =:= [] andalso map_expr_argument(Node) =:= none; + map_type -> map_type_fields(Node) =:= any_size; tuple -> tuple_elements(Node) =:= []; + tuple_type -> tuple_type_elements(Node) =:= any_size; underscore -> true; variable -> true; warning_marker -> true; @@ -3114,6 +3233,39 @@ attribute(Name) -> %% `Imports' is `{Module, [{A1, N1}, ..., {Ak, Nk}]}', or %% `-import(A1.....An).', if `Imports' is `[A1, ..., An]'. %% +%% {attribute, Pos, export_type, ExportedTypes} +%% +%% ExportedTypes = [{atom(), integer()}] +%% +%% Representing `-export_type([N1/A1, ..., Nk/Ak]).', +%% if `ExportedTypes' is `[{N1, A1}, ..., {Nk, Ak}]'. +%% +%% {attribute, Pos, optional_callbacks, OptionalCallbacks} +%% +%% OptionalCallbacks = [{atom(), integer()}] +%% +%% Representing `-optional_callbacks([A1/N1, ..., Ak/Nk]).', +%% if `OptionalCallbacks' is `[{A1, N1}, ..., {Ak, Nk}]'. +%% +%% {attribute, Pos, SpecTag, {FuncSpec, FuncType}} +%% +%% SpecTag = spec | callback +%% FuncSpec = {module(), atom(), arity()} | {atom(), arity()} +%% FuncType = a (possibly constrained) function type +%% +%% Representing `-SpecTag M:F/A Ft1; ...; Ftk.' or +%% `-SpecTag F/A Ft1; ...; Ftk.', if `FuncTypes' is +%% `[Ft1, ..., Ftk]'. +%% +%% {attribute, Pos, TypeTag, {Name, Type, Parameters}} +%% +%% TypeTag = type | opaque +%% Type = a type +%% Parameters = [Variable] +%% +%% Representing `-TypeTag Name(V1, ..., Vk) :: Type .' +%% if `Parameters' is `[V1, ..., Vk]'. +%% %% {attribute, Pos, file, Position} %% %% Position = {filename(), integer()} @@ -3125,13 +3277,19 @@ attribute(Name) -> %% %% Info = {Name, [Entries]} %% Name = atom() -%% Entries = {record_field, Pos, atom()} -%% | {record_field, Pos, atom(), erl_parse()} %% -%% Representing `-record(Name, {<F1>, ..., <Fn>}).', if `Info' is +%% Entries = UntypedEntries +%% | {typed_record_field, UntypedEntries, Type} +%% UntypedEntries = {record_field, Pos, atom()} +%% | {record_field, Pos, atom(), erl_parse()} +%% +%% Representing `-record(Name, {<F1>, ..., <Fn>}).', if `Info' is %% `{Name, [D1, ..., D1]}', where each `Fi' is either `Ai = <Ei>', %% if the corresponding `Di' is `{record_field, Pos, Ai, Ei}', or -%% otherwise simply `Ai', if `Di' is `{record_field, Pos, Ai}'. +%% otherwise simply `Ai', if `Di' is `{record_field, Pos, Ai}', or +%% `Ai = <Ei> :: <Ti>', if `Di' is `{typed_record_field, +%% {record_field, Pos, Ai, Ei}, Ti}', or `Ai :: <Ti>', if `Di' is +%% `{typed_record_field, {record_field, Pos, Ai}, Ti}'. %% %% {attribute, L, Name, Term} %% @@ -3309,11 +3467,6 @@ 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), @@ -4183,7 +4336,8 @@ record_field(Name) -> %% type(Node) = record_field %% data(Node) = #record_field{name :: Name, value :: Value} %% -%% Name = Value = syntaxTree() +%% Name = syntaxTree() +%% Value = none | syntaxTree() -spec record_field(syntaxTree(), 'none' | syntaxTree()) -> syntaxTree(). @@ -4568,7 +4722,7 @@ application(Module, Name, Arguments) -> %% %% `erl_parse' representation: %% -%% {call, Pos, Fun, Args} +%% {call, Pos, Operator, Args} %% %% Operator = erl_parse() %% Arguments = [erl_parse()] @@ -4623,6 +4777,1095 @@ application_arguments(Node) -> (data(Node1))#application.arguments end. +%% ===================================================================== +%% @doc Creates an abstract annotated type expression. The result +%% represents "<code><em>Name</em> :: <em>Type</em></code>". +%% +%% @see annotated_type_name/1 +%% @see annotated_type_body/1 + +-record(annotated_type, {name :: syntaxTree(), body :: syntaxTree()}). + +%% type(Node) = annotated_type +%% data(Node) = #annotated_type{name :: Name, +%% body :: Type} +%% +%% Name = syntaxTree() +%% Type = syntaxTree() +%% +%% `erl_parse' representation: +%% +%% {ann_type, Pos, [Name, Type]} +%% +%% Name = erl_parse() +%% Type = erl_parse() + +-spec annotated_type(syntaxTree(), syntaxTree()) -> syntaxTree(). + +annotated_type(Name, Type) -> + tree(annotated_type, #annotated_type{name = Name, body = Type}). + +revert_annotated_type(Node) -> + Pos = get_pos(Node), + Name = annotated_type_name(Node), + Type = annotated_type_body(Node), + {ann_type, Pos, [Name, Type]}. + + +%% ===================================================================== +%% @doc Returns the name subtree of an `annotated_type' node. +%% +%% @see annotated_type/2 + +-spec annotated_type_name(syntaxTree()) -> syntaxTree(). + +annotated_type_name(Node) -> + case unwrap(Node) of + {ann_type, _, [Name, _]} -> + Name; + Node1 -> + (data(Node1))#annotated_type.name + end. + + +%% ===================================================================== +%% @doc Returns the type subtrees of an `annotated_type' node. +%% +%% @see annotated_type/2 + +-spec annotated_type_body(syntaxTree()) -> syntaxTree(). + +annotated_type_body(Node) -> + case unwrap(Node) of + {ann_type, _, [_, Type]} -> + Type; + Node1 -> + (data(Node1))#annotated_type.body + end. + + +%% ===================================================================== +%% @doc Creates an abstract fun of any type. The result represents +%% "<code>fun()</code>". + +%% type(Node) = fun_type +%% +%% `erl_parse' representation: +%% +%% {type, Pos, 'fun', []} + +-spec fun_type() -> syntaxTree(). + +fun_type() -> + tree(fun_type). + +revert_fun_type(Node) -> + Pos = get_pos(Node), + {type, Pos, 'fun', []}. + + +%% ===================================================================== +%% @doc Creates an abstract type application expression. If +%% `Module' is `none', this is call is equivalent +%% to `type_application(TypeName, Arguments)', otherwise it is +%% equivalent to `type_application(module_qualifier(Module, TypeName), +%% Arguments)'. +%% +%% (This is a utility function.) +%% +%% @see type_application/2 +%% @see module_qualifier/2 + +-spec type_application('none' | syntaxTree(), syntaxTree(), [syntaxTree()]) -> + syntaxTree(). + +type_application(none, TypeName, Arguments) -> + type_application(TypeName, Arguments); +type_application(Module, TypeName, Arguments) -> + type_application(module_qualifier(Module, TypeName), Arguments). + + +%% ===================================================================== +%% @doc Creates an abstract type application expression. If `Arguments' is +%% `[T1, ..., Tn]', the result represents +%% "<code><em>TypeName</em>(<em>T1</em>, ...<em>Tn</em>)</code>". +%% +%% @see user_type_application/2 +%% @see type_application/3 +%% @see type_application_name/1 +%% @see type_application_arguments/1 + +-record(type_application, {type_name :: syntaxTree(), + arguments :: [syntaxTree()]}). + +%% type(Node) = type_application +%% data(Node) = #type_application{type_name :: TypeName, +%% arguments :: Arguments} +%% +%% TypeName = syntaxTree() +%% Arguments = [syntaxTree()] +%% +%% `erl_parse' representation: +%% +%% {remote, Pos, [Module, Name, Arguments]} | +%% {type, Pos, Name, Arguments} +%% +%% Module = erl_parse() +%% Name = atom() +%% Arguments = [erl_parse()] + +-spec type_application(syntaxTree(), [syntaxTree()]) -> syntaxTree(). + +type_application(TypeName, Arguments) -> + tree(type_application, + #type_application{type_name = TypeName, arguments = Arguments}). + +revert_type_application(Node) -> + Pos = get_pos(Node), + TypeName = type_application_name(Node), + Arguments = type_application_arguments(Node), + case type(TypeName) of + module_qualifier -> + Module = module_qualifier_argument(TypeName), + Name = module_qualifier_body(TypeName), + {remote_type, Pos, [Module, Name, Arguments]}; + atom -> + {type, Pos, atom_value(TypeName), Arguments} + end. + + +%% ===================================================================== +%% @doc Returns the type name subtree of a `type_application' node. +%% +%% @see type_application/2 + +-spec type_application_name(syntaxTree()) -> syntaxTree(). + +type_application_name(Node) -> + case unwrap(Node) of + {remote_type, _, [Module, Name, _]} -> + module_qualifier(Module, Name); + {type, Pos, Name, _} -> + set_pos(atom(Name), Pos); + Node1 -> + (data(Node1))#type_application.type_name + end. + + +%% ===================================================================== +%% @doc Returns the arguments subtrees of a `type_application' node. +%% +%% @see type_application/2 + +-spec type_application_arguments(syntaxTree()) -> [syntaxTree()]. + +type_application_arguments(Node) -> + case unwrap(Node) of + {remote_type, _, [_, _, Arguments]} -> + Arguments; + {type, _, _, Arguments} -> + Arguments; + Node1 -> + (data(Node1))#type_application.arguments + end. + + +%% ===================================================================== +%% @doc Creates an abstract bitstring type. The result represents +%% "<code><em><<_:M, _:_*N>></em></code>". +%% +%% @see bitstring_type_m/1 +%% @see bitstring_type_n/1 + +-record(bitstring_type, {m :: syntaxTree(), n :: syntaxTree()}). + +%% type(Node) = bitstring_type +%% data(Node) = #bitstring_type{m :: M, n :: N} +%% +%% M = syntaxTree() +%% N = syntaxTree() +%% + +-spec bitstring_type(syntaxTree(), syntaxTree()) -> syntaxTree(). + +bitstring_type(M, N) -> + tree(bitstring_type, #bitstring_type{m = M, n =N}). + +revert_bitstring_type(Node) -> + Pos = get_pos(Node), + M = bitstring_type_m(Node), + N = bitstring_type_n(Node), + {type, Pos, binary, [M, N]}. + +%% ===================================================================== +%% @doc Returns the number of start bits, `M', of a `bitstring_type' node. +%% +%% @see bitstring_type/2 + +-spec bitstring_type_m(syntaxTree()) -> syntaxTree(). + +bitstring_type_m(Node) -> + case unwrap(Node) of + {type, _, binary, [M, _]} -> + M; + Node1 -> + (data(Node1))#bitstring_type.m + end. + +%% ===================================================================== +%% @doc Returns the segment size, `N', of a `bitstring_type' node. +%% +%% @see bitstring_type/2 + +-spec bitstring_type_n(syntaxTree()) -> syntaxTree(). + +bitstring_type_n(Node) -> + case unwrap(Node) of + {type, _, binary, [_, N]} -> + N; + Node1 -> + (data(Node1))#bitstring_type.n + end. + + +%% ===================================================================== +%% @doc Creates an abstract constrained function type. +%% If `FunctionConstraint' is `[C1, ..., Cn]', the result represents +%% "<code><em>FunctionType</em> when <em>C1</em>, ...<em>Cn</em></code>". +%% +%% @see constrained_function_type_body/1 +%% @see constrained_function_type_argument/1 + +-record(constrained_function_type, {body :: syntaxTree(), + argument :: syntaxTree()}). + +%% type(Node) = constrained_function_type +%% data(Node) = #constrained_function_type{body :: FunctionType, +%% argument :: FunctionConstraint} +%% +%% FunctionType = syntaxTree() +%% FunctionConstraint = syntaxTree() +%% +%% `erl_parse' representation: +%% +%% {type, Pos, bounded_fun, [FunctionType, FunctionConstraint]} +%% +%% FunctionType = erl_parse() +%% FunctionConstraint = [erl_parse()] + +-spec constrained_function_type(syntaxTree(), [syntaxTree()]) -> syntaxTree(). + +constrained_function_type(FunctionType, FunctionConstraint) -> + Conj = conjunction(FunctionConstraint), + tree(constrained_function_type, + #constrained_function_type{body = FunctionType, + argument = Conj}). + +revert_constrained_function_type(Node) -> + Pos = get_pos(Node), + FunctionType = constrained_function_type_body(Node), + FunctionConstraint = + conjunction_body(constrained_function_type_argument(Node)), + {type, Pos, bounded_fun, [FunctionType, FunctionConstraint]}. + + +%% ===================================================================== +%% @doc Returns the function type subtree of a +%% `constrained_function_type' node. +%% +%% @see constrained_function_type/2 + +-spec constrained_function_type_body(syntaxTree()) -> syntaxTree(). + +constrained_function_type_body(Node) -> + case unwrap(Node) of + {type, _, bounded_fun, [FunctionType, _]} -> + FunctionType; + Node1 -> + (data(Node1))#constrained_function_type.body + end. + +%% ===================================================================== +%% @doc Returns the function constraint subtree of a +%% `constrained_function_type' node. +%% +%% @see constrained_function_type/2 + +-spec constrained_function_type_argument(syntaxTree()) -> syntaxTree(). + +constrained_function_type_argument(Node) -> + case unwrap(Node) of + {type, _, bounded_fun, [_, FunctionConstraint]} -> + conjunction(FunctionConstraint); + Node1 -> + (data(Node1))#constrained_function_type.argument + end. + + +%% ===================================================================== +%% @equiv function_type(any_arity, Type) + +function_type(Type) -> + function_type(any_arity, Type). + +%% ===================================================================== +%% @doc Creates an abstract function type. If `Arguments' is +%% `[T1, ..., Tn]', then if it occurs within a function +%% specification, the result represents +%% "<code>(<em>T1</em>, ...<em>Tn</em>) -> <em>Return</em></code>"; otherwise +%% it represents +%% "<code>fun((<em>T1</em>, ...<em>Tn</em>) -> <em>Return</em>)</code>". +%% If `Arguments' is `any_arity', it represents +%% "<code>fun((...) -> <em>Return</em>)</code>". +%% +%% Note that the `erl_parse' representation is identical for +%% "<code><em>FunctionType</em></code>" and +%% "<code>fun(<em>FunctionType</em>)</code>". +%% +%% @see function_type_arguments/1 +%% @see function_type_return/1 + +-record(function_type, {arguments :: any_arity | [syntaxTree()], + return :: syntaxTree()}). + +%% type(Node) = function_type +%% data(Node) = #function_type{arguments :: any | Arguments, +%% return :: Type} +%% +%% Arguments = [syntaxTree()] +%% Type = syntaxTree() +%% +%% `erl_parse' representation: +%% +%% {type, Pos, 'fun', [{type, Pos, product, Arguments}, Type]} +%% {type, Pos, 'fun', [{type, Pos, any}, Type]} +%% +%% Arguments = [erl_parse()] +%% Type = erl_parse() + +-spec function_type('any_arity' | syntaxTree(), syntaxTree()) -> syntaxTree(). + +function_type(Arguments, Return) -> + tree(function_type, + #function_type{arguments = Arguments, return = Return}). + +revert_function_type(Node) -> + Pos = get_pos(Node), + Type = function_type_return(Node), + case function_type_arguments(Node) of + any_arity -> + {type, Pos, 'fun', [{type, Pos, any}, Type]}; + Arguments -> + {type, Pos, 'fun', [{type, Pos, product, Arguments}, Type]} + end. + + +%% ===================================================================== +%% @doc Returns the argument types subtrees of a `function_type' node. +%% If `Node' represents "<code>fun((...) -> <em>Return</em>)</code>", +%% `any_arity' is returned; otherwise, if `Node' represents +%% "<code>(<em>T1</em>, ...<em>Tn</em>) -> <em>Return</em></code>" or +%% "<code>fun((<em>T1</em>, ...<em>Tn</em>) -> <em>Return</em>)</code>", +%% `[T1, ..., Tn]' is returned. + +%% +%% @see function_type/1 +%% @see function_type/2 + +-spec function_type_arguments(syntaxTree()) -> any_arity | [syntaxTree()]. + +function_type_arguments(Node) -> + case unwrap(Node) of + {type, _, 'fun', [{type, _, any}, _]} -> + any_arity; + {type, _, 'fun', [{type, _, product, Arguments}, _]} -> + Arguments; + Node1 -> + (data(Node1))#function_type.arguments + end. + +%% ===================================================================== +%% @doc Returns the return type subtrees of a `function_type' node. +%% +%% @see function_type/1 +%% @see function_type/2 + +-spec function_type_return(syntaxTree()) -> syntaxTree(). + +function_type_return(Node) -> + case unwrap(Node) of + {type, _, 'fun', [_, Type]} -> + Type; + Node1 -> + (data(Node1))#function_type.return + end. + + +%% ===================================================================== +%% @doc Creates an abstract (subtype) constraint. The result represents +%% "<code><em>Name</em> :: <em>Type</em></code>". +%% +%% @see constraint_argument/1 +%% @see constraint_body/1 + +-record(constraint, {name :: syntaxTree(), + types :: [syntaxTree()]}). + +%% type(Node) = constraint +%% data(Node) = #constraint{name :: Name, +%% types :: [Type]} +%% +%% Name = syntaxTree() +%% Type = syntaxTree() +%% +%% `erl_parse' representation: +%% +%% {type, Pos, constraint, [Name, [Var, Type]]} +%% +%% Name = {atom, Pos, is_subtype} +%% Var = erl_parse() +%% Type = erl_parse() + +-spec constraint(syntaxTree(), [syntaxTree()]) -> syntaxTree(). + +constraint(Name, Types) -> + tree(constraint, + #constraint{name = Name, types = Types}). + +revert_constraint(Node) -> + Pos = get_pos(Node), + Name = constraint_argument(Node), + Types = constraint_body(Node), + {type, Pos, constraint, [Name, Types]}. + + +%% ===================================================================== +%% @doc Returns the name subtree of a `constraint' node. +%% +%% @see constraint/2 + +-spec constraint_argument(syntaxTree()) -> syntaxTree(). + +constraint_argument(Node) -> + case unwrap(Node) of + {type, _, constraint, [Name, _]} -> + Name; + Node1 -> + (data(Node1))#constraint.name + end. + +%% ===================================================================== +%% @doc Returns the type subtree of a `constraint' node. +%% +%% @see constraint/2 + +-spec constraint_body(syntaxTree()) -> [syntaxTree()]. + +constraint_body(Node) -> + case unwrap(Node) of + {type, _, constraint, [_, Types]} -> + Types; + Node1 -> + (data(Node1))#constraint.types + end. + + +%% ===================================================================== +%% @doc Creates an abstract map type assoc field. The result represents +%% "<code><em>Name</em> => <em>Value</em></code>". +%% +%% @see map_type_assoc_name/1 +%% @see map_type_assoc_value/1 +%% @see map_type/1 + +-record(map_type_assoc, {name :: syntaxTree(), value :: syntaxTree()}). + +%% `erl_parse' representation: +%% +%% {type, Pos, map_field_assoc, [Name, Value]} + +-spec map_type_assoc(syntaxTree(), syntaxTree()) -> syntaxTree(). + +map_type_assoc(Name, Value) -> + tree(map_type_assoc, #map_type_assoc{name = Name, value = Value}). + +revert_map_type_assoc(Node) -> + Pos = get_pos(Node), + Name = map_type_assoc_name(Node), + Value = map_type_assoc_value(Node), + {type, Pos, map_type_assoc, [Name, Value]}. + + +%% ===================================================================== +%% @doc Returns the name subtree of a `map_type_assoc' node. +%% +%% @see map_type_assoc/2 + +-spec map_type_assoc_name(syntaxTree()) -> syntaxTree(). + +map_type_assoc_name(Node) -> + case Node of + {type, _, map_field_assoc, [Name, _]} -> + Name; + _ -> + (data(Node))#map_type_assoc.name + end. + + +%% ===================================================================== +%% @doc Returns the value subtree of a `map_type_assoc' node. +%% +%% @see map_type_assoc/2 + +-spec map_type_assoc_value(syntaxTree()) -> syntaxTree(). + +map_type_assoc_value(Node) -> + case Node of + {type, _, map_field_assoc, [_, Value]} -> + Value; + _ -> + (data(Node))#map_type_assoc.value + end. + + +%% ===================================================================== +%% @doc Creates an abstract map type exact field. The result represents +%% "<code><em>Name</em> := <em>Value</em></code>". +%% +%% @see map_type_exact_name/1 +%% @see map_type_exact_value/1 +%% @see map_type/1 + +-record(map_type_exact, {name :: syntaxTree(), value :: syntaxTree()}). + +%% `erl_parse' representation: +%% +%% {type, Pos, map_field_exact, [Name, Value]} + +-spec map_type_exact(syntaxTree(), syntaxTree()) -> syntaxTree(). + +map_type_exact(Name, Value) -> + tree(map_type_exact, #map_type_exact{name = Name, value = Value}). + +revert_map_type_exact(Node) -> + Pos = get_pos(Node), + Name = map_type_exact_name(Node), + Value = map_type_exact_value(Node), + {type, Pos, map_type_exact, [Name, Value]}. + + +%% ===================================================================== +%% @doc Returns the name subtree of a `map_type_exact' node. +%% +%% @see map_type_exact/2 + +-spec map_type_exact_name(syntaxTree()) -> syntaxTree(). + +map_type_exact_name(Node) -> + case Node of + {type, _, map_field_exact, [Name, _]} -> + Name; + _ -> + (data(Node))#map_type_exact.name + end. + + +%% ===================================================================== +%% @doc Returns the value subtree of a `map_type_exact' node. +%% +%% @see map_type_exact/2 + +-spec map_type_exact_value(syntaxTree()) -> syntaxTree(). + +map_type_exact_value(Node) -> + case Node of + {type, _, map_field_exact, [_, Value]} -> + Value; + _ -> + (data(Node))#map_type_exact.value + end. + + +%% ===================================================================== +%% @equiv map_type(any_size) + +map_type() -> + map_type(any_size). + +%% ===================================================================== +%% @doc Creates an abstract type map. If `Fields' is +%% `[F1, ..., Fn]', the result represents +%% "<code>#{<em>F1</em>, ..., <em>Fn</em>}</code>"; +%% otherwise, if `Fields' is `any_size', it represents +%% "<code>map()</code>". +%% +%% @see map_type_fields/1 + +%% type(Node) = map_type +%% data(Node) = Fields +%% +%% Fields = any_size | [syntaxTree()] +%% +%% `erl_parse' representation: +%% +%% {type, Pos, map, [Field]} +%% {type, Pos, map, any} +%% +%% Field = erl_parse() + +-spec map_type('any_size' | [syntaxTree()]) -> syntaxTree(). + +map_type(Fields) -> + tree(map_type, Fields). + +revert_map_type(Node) -> + Pos = get_pos(Node), + {type, Pos, map, map_type_fields(Node)}. + + +%% ===================================================================== +%% @doc Returns the list of field subtrees of a `map_type' node. +%% If `Node' represents "<code>map()</code>", `any_size' is returned; +%% otherwise, if `Node' represents +%% "<code>#{<em>F1</em>, ..., <em>Fn</em>}</code>", +%% `[F1, ..., Fn]' is returned. +%% +%% @see map_type/0 +%% @see map_type/1 + +-spec map_type_fields(syntaxTree()) -> 'any_size' | [syntaxTree()]. + +map_type_fields(Node) -> + case unwrap(Node) of + {type, _, map, Fields} when is_list(Fields) -> + Fields; + {type, _, map, any} -> + any_size; + Node1 -> + data(Node1) + end. + + +%% ===================================================================== +%% @doc Creates an abstract range type. The result represents +%% "<code><em>Low</em> .. <em>High</em></code>". +%% +%% @see integer_range_type_low/1 +%% @see integer_range_type_high/1 + +-record(integer_range_type, {low :: syntaxTree(), + high :: syntaxTree()}). + +%% type(Node) = integer_range_type +%% data(Node) = #integer_range_type{low :: Low, high :: High} +%% +%% Low = syntaxTree() +%% High = syntaxTree() +%% +%% `erl_parse' representation: +%% +%% {type, Pos, range, [Low, High]} +%% +%% Low = erl_parse() +%% High = erl_parse() + +-spec integer_range_type(syntaxTree(), syntaxTree()) -> syntaxTree(). + +integer_range_type(Low, High) -> + tree(integer_range_type, #integer_range_type{low = Low, high = High}). + +revert_integer_range_type(Node) -> + Pos = get_pos(Node), + Low = integer_range_type_low(Node), + High = integer_range_type_high(Node), + {type, Pos, range, [Low, High]}. + + +%% ===================================================================== +%% @doc Returns the low limit of an `integer_range_type' node. +%% +%% @see integer_range_type/2 + +-spec integer_range_type_low(syntaxTree()) -> syntaxTree(). + +integer_range_type_low(Node) -> + case unwrap(Node) of + {type, _, range, [Low, _]} -> + Low; + Node1 -> + (data(Node1))#integer_range_type.low + end. + +%% ===================================================================== +%% @doc Returns the high limit of an `integer_range_type' node. +%% +%% @see integer_range_type/2 + +-spec integer_range_type_high(syntaxTree()) -> syntaxTree(). + +integer_range_type_high(Node) -> + case unwrap(Node) of + {type, _, range, [_, High]} -> + High; + Node1 -> + (data(Node1))#integer_range_type.high + end. + + +%% ===================================================================== +%% @doc Creates an abstract record type. If `Fields' is +%% `[F1, ..., Fn]', the result represents +%% "<code>#<em>Name</em>{<em>F1</em>, ..., <em>Fn</em>}</code>". +%% +%% @see record_type_name/1 +%% @see record_type_fields/1 + +-record(record_type, {name :: syntaxTree(), + fields :: [syntaxTree()]}). + +%% type(Node) = record_type +%% data(Node) = #record_type{name = Name, fields = Fields} +%% +%% Name = syntaxTree() +%% Fields = [syntaxTree()] +%% +%% `erl_parse' representation: +%% +%% {type, Pos, record, [Name|Fields]} +%% +%% Name = erl_parse() +%% Fields = [erl_parse()] + +-spec record_type(syntaxTree(), [syntaxTree()]) -> syntaxTree(). + +record_type(Name, Fields) -> + tree(record_type, #record_type{name = Name, fields = Fields}). + +revert_record_type(Node) -> + Pos = get_pos(Node), + Name = record_type_name(Node), + Fields = record_type_fields(Node), + {type, Pos, record, [Name | Fields]}. + + +%% ===================================================================== +%% @doc Returns the name subtree of a `record_type' node. +%% +%% @see record_type/2 + +-spec record_type_name(syntaxTree()) -> syntaxTree(). + +record_type_name(Node) -> + case unwrap(Node) of + {type, _, record, [Name|_]} -> + Name; + Node1 -> + (data(Node1))#record_type.name + end. + +%% ===================================================================== +%% @doc Returns the fields subtree of a `record_type' node. +%% +%% @see record_type/2 + +-spec record_type_fields(syntaxTree()) -> [syntaxTree()]. + +record_type_fields(Node) -> + case unwrap(Node) of + {type, _, record, [_|Fields]} -> + Fields; + Node1 -> + (data(Node1))#record_type.fields + end. + + +%% ===================================================================== +%% @doc Creates an abstract record type field. The result represents +%% "<code><em>Name</em> :: <em>Type</em></code>". +%% +%% @see record_type_field_name/1 +%% @see record_type_field_type/1 + +-record(record_type_field, {name :: syntaxTree(), + type :: syntaxTree()}). + +%% type(Node) = record_type_field +%% data(Node) = #record_type_field{name = Name, type = Type} +%% +%% Name = syntaxTree() +%% Type = syntaxTree() +%% +%% `erl_parse' representation: +%% +%% {type, Pos, field_type, [Name, Type]} +%% +%% Name = erl_parse() +%% Type = erl_parse() + +-spec record_type_field(syntaxTree(), syntaxTree()) -> syntaxTree(). + +record_type_field(Name, Type) -> + tree(record_type_field, #record_type_field{name = Name, type = Type}). + +revert_record_type_field(Node) -> + Pos = get_pos(Node), + Name = record_type_field_name(Node), + Type = record_type_field_type(Node), + {type, Pos, field_type, [Name, Type]}. + + +%% ===================================================================== +%% @doc Returns the name subtree of a `record_type_field' node. +%% +%% @see record_type_field/2 + +-spec record_type_field_name(syntaxTree()) -> syntaxTree(). + +record_type_field_name(Node) -> + case unwrap(Node) of + {type, _, field_type, [Name, _]} -> + Name; + Node1 -> + (data(Node1))#record_type_field.name + end. + +%% ===================================================================== +%% @doc Returns the type subtree of a `record_type_field' node. +%% +%% @see record_type_field/2 + +-spec record_type_field_type(syntaxTree()) -> syntaxTree(). + +record_type_field_type(Node) -> + case unwrap(Node) of + {type, _, field_type, [_, Type]} -> + Type; + Node1 -> + (data(Node1))#record_type_field.type + end. + + +%% ===================================================================== +%% @equiv tuple_type(any_size) + +tuple_type() -> + tuple_type(any_size). + +%% ===================================================================== +%% @doc Creates an abstract type tuple. If `Elements' is +%% `[T1, ..., Tn]', the result represents +%% "<code>{<em>T1</em>, ..., <em>Tn</em>}</code>"; +%% otherwise, if `Elements' is `any_size', it represents +%% "<code>tuple()</code>". +%% +%% @see tuple_type_elements/1 + +%% type(Node) = tuple_type +%% data(Node) = Elements +%% +%% Elements = any_size | [syntaxTree()] +%% +%% `erl_parse' representation: +%% +%% {type, Pos, tuple, [Element]} +%% {type, Pos, tuple, any} +%% +%% Element = erl_parse() + +-spec tuple_type(any_size | [syntaxTree()]) -> syntaxTree(). + +tuple_type(Elements) -> + tree(tuple_type, Elements). + +revert_tuple_type(Node) -> + Pos = get_pos(Node), + {type, Pos, tuple, tuple_type_elements(Node)}. + + +%% ===================================================================== +%% @doc Returns the list of type element subtrees of a `tuple_type' node. +%% If `Node' represents "<code>tuple()</code>", `any_size' is returned; +%% otherwise, if `Node' represents +%% "<code>{<em>T1</em>, ..., <em>Tn</em>}</code>", +%% `[T1, ..., Tn]' is returned. +%% +%% @see tuple_type/0 +%% @see tuple_type/1 + +-spec tuple_type_elements(syntaxTree()) -> 'any_size' | [syntaxTree()]. + +tuple_type_elements(Node) -> + case unwrap(Node) of + {type, _, tuple, Elements} when is_list(Elements) -> + Elements; + {type, _, tuple, any} -> + any_size; + Node1 -> + data(Node1) + end. + + +%% ===================================================================== +%% @doc Creates an abstract type union. If `Types' is +%% `[T1, ..., Tn]', the result represents +%% "<code><em>T1</em> | ... | <em>Tn</em></code>". +%% +%% @see type_union_types/1 + +%% type(Node) = type_union +%% data(Node) = Types +%% +%% Types = [syntaxTree()] +%% +%% `erl_parse' representation: +%% +%% {type, Pos, union, Elements} +%% +%% Elements = [erl_parse()] + +-spec type_union([syntaxTree()]) -> syntaxTree(). + +type_union(Types) -> + tree(type_union, Types). + +revert_type_union(Node) -> + Pos = get_pos(Node), + {type, Pos, union, type_union_types(Node)}. + + +%% ===================================================================== +%% @doc Returns the list of type subtrees of a `type_union' node. +%% +%% @see type_union/1 + +-spec type_union_types(syntaxTree()) -> [syntaxTree()]. + +type_union_types(Node) -> + case unwrap(Node) of + {type, _, union, Types} when is_list(Types) -> + Types; + Node1 -> + data(Node1) + end. + + +%% ===================================================================== +%% @doc Creates an abstract user type. If `Arguments' is +%% `[T1, ..., Tn]', the result represents +%% "<code><em>TypeName</em>(<em>T1</em>, ...<em>Tn</em>)</code>". +%% +%% @see type_application/2 +%% @see user_type_application_name/1 +%% @see user_type_application_arguments/1 + +-record(user_type_application, {type_name :: syntaxTree(), + arguments :: [syntaxTree()]}). + +%% type(Node) = user_type_application +%% data(Node) = #user_type_application{type_name :: TypeName, +%% arguments :: Arguments} +%% +%% TypeName = syntaxTree() +%% Arguments = [syntaxTree()] +%% +%% `erl_parse' representation: +%% +%% {user_type, Pos, Name, Arguments} +%% +%% Name = erl_parse() +%% Arguments = [Type] +%% Type = erl_parse() + +-spec user_type_application(syntaxTree(), [syntaxTree()]) -> syntaxTree(). + +user_type_application(TypeName, Arguments) -> + tree(user_type_application, + #user_type_application{type_name = TypeName, arguments = Arguments}). + +revert_user_type_application(Node) -> + Pos = get_pos(Node), + TypeName = user_type_application_name(Node), + Arguments = user_type_application_arguments(Node), + {user_type, Pos, atom_value(TypeName), Arguments}. + + +%% ===================================================================== +%% @doc Returns the type name subtree of a `user_type_application' node. +%% +%% @see user_type_application/2 + +-spec user_type_application_name(syntaxTree()) -> syntaxTree(). + +user_type_application_name(Node) -> + case unwrap(Node) of + {user_type, Pos, Name, _} -> + set_pos(atom(Name), Pos); + Node1 -> + (data(Node1))#user_type_application.type_name + end. + + +%% ===================================================================== +%% @doc Returns the arguments subtrees of a `user_type_application' node. +%% +%% @see user_type_application/2 + +-spec user_type_application_arguments(syntaxTree()) -> [syntaxTree()]. + +user_type_application_arguments(Node) -> + case unwrap(Node) of + {user_type, _, _, Arguments} -> + Arguments; + Node1 -> + (data(Node1))#user_type_application.arguments + end. + + +%% ===================================================================== +%% @doc Creates an abstract typed record field specification. The +%% result represents "<code><em>Field</em> :: <em>Type</em></code>". +%% +%% @see typed_record_field_body/1 +%% @see typed_record_field_type/1 + +-record(typed_record_field, {body :: syntaxTree(), + type :: syntaxTree()}). + +%% type(Node) = typed_record_field +%% data(Node) = #typed_record_field{body :: Field +%% type = Type} +%% +%% Field = syntaxTree() +%% Type = syntaxTree() + +-spec typed_record_field(syntaxTree(), syntaxTree()) -> syntaxTree(). + +typed_record_field(Field, Type) -> + tree(typed_record_field, + #typed_record_field{body = Field, type = Type}). + + +%% ===================================================================== +%% @doc Returns the field subtree of a `typed_record_field' node. +%% +%% @see typed_record_field/2 + +-spec typed_record_field_body(syntaxTree()) -> syntaxTree(). + +typed_record_field_body(Node) -> + (data(Node))#typed_record_field.body. + + +%% ===================================================================== +%% @doc Returns the type subtree of a `typed_record_field' node. +%% +%% @see typed_record_field/2 + +-spec typed_record_field_type(syntaxTree()) -> syntaxTree(). + +typed_record_field_type(Node) -> + (data(Node))#typed_record_field.type. + %% ===================================================================== %% @doc Creates an abstract list comprehension. If `Body' is @@ -6168,6 +7411,8 @@ revert(Node) -> revert_root(Node) -> case type(Node) of + annotated_type -> + revert_annotated_type(Node); application -> revert_application(Node); atom -> @@ -6182,6 +7427,8 @@ revert_root(Node) -> revert_binary_field(Node); binary_generator -> revert_binary_generator(Node); + bitstring_type -> + revert_bitstring_type(Node); block_expr -> revert_block_expr(Node); case_expr -> @@ -6194,6 +7441,10 @@ revert_root(Node) -> revert_clause(Node); cond_expr -> revert_cond_expr(Node); + constrained_function_type -> + revert_constrained_function_type(Node); + constraint -> + revert_constraint(Node); eof_marker -> revert_eof_marker(Node); error_marker -> @@ -6202,8 +7453,12 @@ revert_root(Node) -> revert_float(Node); fun_expr -> revert_fun_expr(Node); + fun_type -> + revert_fun_type(Node); function -> revert_function(Node); + function_type -> + revert_function_type(Node); generator -> revert_generator(Node); if_expr -> @@ -6214,6 +7469,8 @@ revert_root(Node) -> revert_infix_expr(Node); integer -> revert_integer(Node); + integer_range_type -> + revert_integer_range_type(Node); list -> revert_list(Node); list_comp -> @@ -6224,6 +7481,12 @@ revert_root(Node) -> revert_map_field_assoc(Node); map_field_exact -> revert_map_field_exact(Node); + map_type -> + revert_map_type(Node); + map_type_assoc -> + revert_map_type_assoc(Node); + map_type_exact -> + revert_map_type_exact(Node); match_expr -> revert_match_expr(Node); module_qualifier -> @@ -6244,14 +7507,26 @@ revert_root(Node) -> revert_record_expr(Node); record_index_expr -> revert_record_index_expr(Node); + record_type -> + revert_record_type(Node); + record_type_field -> + revert_record_type_field(Node); + type_application -> + revert_type_application(Node); + type_union -> + revert_type_union(Node); string -> revert_string(Node); try_expr -> revert_try_expr(Node); tuple -> revert_tuple(Node); + tuple_type -> + revert_tuple_type(Node); underscore -> revert_underscore(Node); + user_type_application -> + revert_user_type_application(Node); variable -> revert_variable(Node); warning_marker -> @@ -6379,6 +7654,9 @@ subtrees(T) -> []; false -> case type(T) of + annotated_type -> + [[annotated_type_name(T)], + [annotated_type_body(T)]]; application -> [[application_operator(T)], application_arguments(T)]; @@ -6407,6 +7685,9 @@ subtrees(T) -> binary_generator -> [[binary_generator_pattern(T)], [binary_generator_body(T)]]; + bitstring_type -> + [[bitstring_type_m(T)], + [bitstring_type_n(T)]]; block_expr -> [block_expr_body(T)]; case_expr -> @@ -6429,14 +7710,30 @@ subtrees(T) -> [cond_expr_clauses(T)]; conjunction -> [conjunction_body(T)]; + constrained_function_type -> + C = constrained_function_type_argument(T), + [[constrained_function_type_body(T)], + conjunction_body(C)]; + constraint -> + [[constraint_argument(T)], + constraint_body(T)]; disjunction -> [disjunction_body(T)]; form_list -> [form_list_elements(T)]; fun_expr -> [fun_expr_clauses(T)]; + fun_type -> + []; function -> [[function_name(T)], function_clauses(T)]; + function_type -> + case function_type_arguments(T) of + any_arity -> + [[function_type_return(T)]]; + As -> + [As,[function_type_return(T)]] + end; generator -> [[generator_pattern(T)], [generator_body(T)]]; if_expr -> @@ -6447,6 +7744,9 @@ subtrees(T) -> [[infix_expr_left(T)], [infix_expr_operator(T)], [infix_expr_right(T)]]; + integer_range_type -> + [[integer_range_type_low(T)], + [integer_range_type_high(T)]]; list -> case list_suffix(T) of none -> @@ -6476,6 +7776,14 @@ subtrees(T) -> map_field_exact -> [[map_field_exact_name(T)], [map_field_exact_value(T)]]; + map_type -> + [map_type_fields(T)]; + map_type_assoc -> + [[map_type_assoc_name(T)], + [map_type_assoc_value(T)]]; + map_type_exact -> + [[map_type_exact_name(T)], + [map_type_exact_value(T)]]; match_expr -> [[match_expr_pattern(T)], [match_expr_body(T)]]; @@ -6523,6 +7831,12 @@ subtrees(T) -> record_index_expr -> [[record_index_expr_type(T)], [record_index_expr_field(T)]]; + record_type -> + [[record_type_name(T)], + record_type_fields(T)]; + record_type_field -> + [[record_type_field_name(T)], + [record_type_field_type(T)]]; size_qualifier -> [[size_qualifier_body(T)], [size_qualifier_argument(T)]]; @@ -6532,7 +7846,20 @@ subtrees(T) -> try_expr_handlers(T), try_expr_after(T)]; tuple -> - [tuple_elements(T)] + [tuple_elements(T)]; + tuple_type -> + [tuple_type_elements(T)]; + type_application -> + [[type_application_name(T)], + type_application_arguments(T)]; + type_union -> + [type_union_types(T)]; + typed_record_field -> + [[typed_record_field_body(T)], + [typed_record_field_type(T)]]; + user_type_application -> + [[user_type_application_name(T)], + user_type_application_arguments(T)] end end. @@ -6576,6 +7903,7 @@ update_tree(Node, Groups) -> -spec make_tree(atom(), [[syntaxTree()]]) -> syntaxTree(). +make_tree(annotated_type, [[N], [T]]) -> annotated_type(N, T); make_tree(application, [[F], A]) -> application(F, A); make_tree(arity_qualifier, [[N], [A]]) -> arity_qualifier(N, A); make_tree(attribute, [[N]]) -> attribute(N); @@ -6585,6 +7913,7 @@ make_tree(binary_comp, [[T], B]) -> binary_comp(T, B); make_tree(binary_field, [[B]]) -> binary_field(B); make_tree(binary_field, [[B], Ts]) -> binary_field(B, Ts); make_tree(binary_generator, [[P], [E]]) -> binary_generator(P, E); +make_tree(bitstring_type, [[M], [N]]) -> bitstring_type(M, N); make_tree(block_expr, [B]) -> block_expr(B); make_tree(case_expr, [[A], C]) -> case_expr(A, C); make_tree(catch_expr, [[B]]) -> catch_expr(B); @@ -6593,14 +7922,20 @@ make_tree(clause, [P, B]) -> clause(P, none, B); make_tree(clause, [P, [G], B]) -> clause(P, G, B); make_tree(cond_expr, [C]) -> cond_expr(C); make_tree(conjunction, [E]) -> conjunction(E); +make_tree(constrained_function_type, [[F],C]) -> + constrained_function_type(F, C); +make_tree(constraint, [[N], Ts]) -> constraint(N, Ts); make_tree(disjunction, [E]) -> disjunction(E); make_tree(form_list, [E]) -> form_list(E); make_tree(fun_expr, [C]) -> fun_expr(C); make_tree(function, [[N], C]) -> function(N, C); +make_tree(function_type, [[T]]) -> function_type(T); +make_tree(function_type, [A,[T]]) -> function_type(A, T); make_tree(generator, [[P], [E]]) -> generator(P, E); make_tree(if_expr, [C]) -> if_expr(C); make_tree(implicit_fun, [[N]]) -> implicit_fun(N); make_tree(infix_expr, [[L], [F], [R]]) -> infix_expr(L, F, R); +make_tree(integer_range_type, [[L],[H]]) -> integer_range_type(L, H); make_tree(list, [P]) -> list(P); make_tree(list, [P, [S]]) -> list(P, S); make_tree(list_comp, [[T], B]) -> list_comp(T, B); @@ -6610,6 +7945,9 @@ make_tree(map_expr, [Fs]) -> map_expr(Fs); make_tree(map_expr, [[E], Fs]) -> map_expr(E, Fs); make_tree(map_field_assoc, [[K], [V]]) -> map_field_assoc(K, V); make_tree(map_field_exact, [[K], [V]]) -> map_field_exact(K, V); +make_tree(map_type, [Fs]) -> map_type(Fs); +make_tree(map_type_assoc, [[N],[V]]) -> map_type_assoc(N, V); +make_tree(map_type_exact, [[N],[V]]) -> map_type_exact(N, V); make_tree(match_expr, [[P], [E]]) -> match_expr(P, E); make_tree(named_fun_expr, [[N], C]) -> named_fun_expr(N, C); make_tree(module_qualifier, [[M], [N]]) -> module_qualifier(M, N); @@ -6625,9 +7963,16 @@ make_tree(record_field, [[N]]) -> record_field(N); make_tree(record_field, [[N], [E]]) -> record_field(N, E); make_tree(record_index_expr, [[T], [F]]) -> record_index_expr(T, F); +make_tree(record_type, [[N],Fs]) -> record_type(N, Fs); +make_tree(record_type_field, [[N],[T]]) -> record_type_field(N, T); make_tree(size_qualifier, [[N], [A]]) -> size_qualifier(N, A); make_tree(try_expr, [B, C, H, A]) -> try_expr(B, C, H, A); -make_tree(tuple, [E]) -> tuple(E). +make_tree(tuple, [E]) -> tuple(E); +make_tree(tuple_type, [Es]) -> tuple_type(Es); +make_tree(type_application, [[N], Ts]) -> type_application(N, Ts); +make_tree(type_union, [Es]) -> type_union(Es); +make_tree(typed_record_field, [[F],[T]]) -> typed_record_field(F, T); +make_tree(user_type_application, [[N], Ts]) -> user_type_application(N, Ts). %% ===================================================================== @@ -6954,6 +8299,7 @@ fold_variable_names(Vs) -> unfold_variable_names(Vs, Pos) -> [set_pos(variable(V), Pos) || V <- Vs]. + %% Support functions for transforming lists of record field definitions. %% %% There is no unique representation for field definitions in the @@ -6968,6 +8314,16 @@ fold_record_fields(Fs) -> [fold_record_field(F) || F <- Fs]. fold_record_field(F) -> + case type(F) of + typed_record_field -> + Field = fold_record_field_1(typed_record_field_body(F)), + Type = typed_record_field_type(F), + {typed_record_field, Field, Type}; + record_field -> + fold_record_field_1(F) + end. + +fold_record_field_1(F) -> Pos = get_pos(F), Name = record_field_name(F), case record_field_value(F) of @@ -6980,10 +8336,11 @@ fold_record_field(F) -> unfold_record_fields(Fs) -> [unfold_record_field(F) || F <- Fs]. -unfold_record_field({typed_record_field, Field, _Type}) -> - unfold_record_field_1(Field); +unfold_record_field({typed_record_field, Field, Type}) -> + F = unfold_record_field_1(Field), + set_pos(typed_record_field(F, Type), get_pos(F)); unfold_record_field(Field) -> - unfold_record_field_1(Field). + unfold_record_field_1(Field). unfold_record_field_1({record_field, Pos, Name}) -> set_pos(record_field(Name), Pos); @@ -7010,5 +8367,4 @@ unfold_binary_field_type({Type, Size}, Pos) -> unfold_binary_field_type(Type, Pos) -> set_pos(atom(Type), Pos). - %% ===================================================================== diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl index 58c4cc5244..9815559779 100644 --- a/lib/syntax_tools/src/erl_syntax_lib.erl +++ b/lib/syntax_tools/src/erl_syntax_lib.erl @@ -36,6 +36,7 @@ analyze_import_attribute/1, analyze_module_attribute/1, analyze_record_attribute/1, analyze_record_expr/1, analyze_record_field/1, analyze_wild_attribute/1, annotate_bindings/1, + analyze_type_application/1, analyze_type_name/1, annotate_bindings/2, fold/3, fold_subtrees/3, foldl_listlist/3, function_name_expansions/1, is_fail_expr/1, limit/2, limit/3, map/2, map_subtrees/2, mapfold/3, mapfold_subtrees/3, @@ -1029,14 +1030,17 @@ is_fail_expr(E) -> %% <dt>`{records, Records}'</dt> %% <dd><ul> %% <li>`Records = [{atom(), Fields}]'</li> -%% <li>`Fields = [{atom(), Default}]'</li> +%% <li>`Fields = [{atom(), {Default, Type}}]'</li> %% <li>`Default = none | syntaxTree()'</li> +%% <li>`Type = none | syntaxTree()'</li> %% </ul> %% `Records' is a list of pairs representing the names %% and corresponding field declarations of all record declaration %% attributes occurring in `Forms'. For fields declared %% without a default value, the corresponding value for -%% `Default' is the atom `none' (cf. +%% `Default' is the atom `none'. Similarly, for fields declared +%% without a type, the corresponding value for `Type' is the +%% atom `none' (cf. %% `analyze_record_attribute/1'). We do not guarantee %% that each record name occurs at most once in the list. The %% order of listing is not defined.</dd> @@ -1055,9 +1059,9 @@ is_fail_expr(E) -> %% %% @see analyze_wild_attribute/1 %% @see analyze_export_attribute/1 +%% @see analyze_function/1 %% @see analyze_import_attribute/1 %% @see analyze_record_attribute/1 -%% @see analyze_function/1 %% @see erl_syntax:error_marker_info/1 %% @see erl_syntax:warning_marker_info/1 @@ -1102,8 +1106,6 @@ collect_attribute(file, _, Info) -> Info; collect_attribute(record, {R, L}, Info) -> finfo_add_record(R, L, Info); -collect_attribute(spec, _, Info) -> - Info; collect_attribute(_, {N, V}, Info) -> finfo_add_attribute(N, V, Info). @@ -1114,12 +1116,15 @@ collect_attribute(_, {N, V}, Info) -> module_imports = [] :: [atom()], imports = [] :: [{atom(), [{atom(), arity()}]}], attributes = [] :: [{atom(), term()}], - records = [] :: [{atom(), [{atom(), field_default()}]}], + records = [] :: [{atom(), [{atom(), + field_default(), + field_type()}]}], errors = [] :: [term()], warnings = [] :: [term()], functions = [] :: [{atom(), arity()}]}). -type field_default() :: 'none' | erl_syntax:syntaxTree(). +-type field_type() :: 'none' | erl_syntax:syntaxTree(). new_finfo() -> #forms{}. @@ -1326,8 +1331,6 @@ analyze_attribute(file, Node) -> analyze_file_attribute(Node); analyze_attribute(record, Node) -> analyze_record_attribute(Node); -analyze_attribute(spec, _Node) -> - spec; analyze_attribute(_, Node) -> %% A "wild" attribute (such as e.g. a `compile' directive). analyze_wild_attribute(Node). @@ -1523,6 +1526,55 @@ analyze_import_attribute(Node) -> %% ===================================================================== +%% @spec analyze_type_name(Node::syntaxTree()) -> TypeName +%% +%% TypeName = atom() +%% | {atom(), integer()} +%% | {ModuleName, {atom(), integer()}} +%% ModuleName = atom() +%% +%% @doc Returns the type name represented by a syntax tree. If +%% `Node' represents a type name, such as +%% "`foo/1'" or "`bloggs:fred/2'", a uniform +%% representation of that name is returned. +%% +%% The evaluation throws `syntax_error' if +%% `Node' does not represent a well-formed type name. + +-spec analyze_type_name(erl_syntax:syntaxTree()) -> typeName(). + +analyze_type_name(Node) -> + case erl_syntax:type(Node) of + atom -> + erl_syntax:atom_value(Node); + arity_qualifier -> + A = erl_syntax:arity_qualifier_argument(Node), + N = erl_syntax:arity_qualifier_body(Node), + + case ((erl_syntax:type(A) =:= integer) + and (erl_syntax:type(N) =:= atom)) + of + true -> + append_arity(erl_syntax:integer_value(A), + erl_syntax:atom_value(N)); + _ -> + throw(syntax_error) + end; + module_qualifier -> + M = erl_syntax:module_qualifier_argument(Node), + case erl_syntax:type(M) of + atom -> + N = erl_syntax:module_qualifier_body(Node), + N1 = analyze_type_name(N), + {erl_syntax:atom_value(M), N1}; + _ -> + throw(syntax_error) + end; + _ -> + throw(syntax_error) + end. + +%% ===================================================================== %% @spec analyze_wild_attribute(Node::syntaxTree()) -> {atom(), term()} %% %% @doc Returns the name and value of a "wild" attribute. The result is @@ -1547,6 +1599,7 @@ analyze_wild_attribute(Node) -> atom -> case erl_syntax:attribute_arguments(Node) of [V] -> + %% Note: does not work well with macros. case catch {ok, erl_syntax:concrete(V)} of {ok, Val} -> {erl_syntax:atom_value(N), Val}; @@ -1568,17 +1621,22 @@ analyze_wild_attribute(Node) -> %% @spec analyze_record_attribute(Node::syntaxTree()) -> %% {atom(), Fields} %% -%% Fields = [{atom(), none | syntaxTree()}] +%% Fields = [{atom(), {Default, Type}}] +%% Default = none | syntaxTree() +%% Type = none | syntaxTree() %% %% @doc Returns the name and the list of fields of a record declaration %% attribute. The result is a pair `{Name, Fields}', if %% `Node' represents "`-record(Name, {...}).'", %% where `Fields' is a list of pairs `{Label, -%% Default}' for each field "`Label'" or "`Label = -%% <em>Default</em>'" in the declaration, listed in left-to-right +%% {Default, Type}}' for each field "`Label'", "`Label = +%% <em>Default</em>'", "`Label :: <em>Type</em>'", or +%% "`Label = <em>Default</em> :: <em>Type</em>'" in the declaration, +%% listed in left-to-right %% order. If the field has no default-value declaration, the value for -%% `Default' will be the atom `none'. We do not -%% guarantee that each label occurs at most one in the list. +%% `Default' will be the atom `none'. If the field has no type declaration, +%% the value for `Type' will be the atom `none'. We do not +%% guarantee that each label occurs at most once in the list. %% %% The evaluation throws `syntax_error' if %% `Node' does not represent a well-formed record declaration @@ -1587,7 +1645,9 @@ analyze_wild_attribute(Node) -> %% @see analyze_attribute/1 %% @see analyze_record_field/1 --type fields() :: [{atom(), 'none' | erl_syntax:syntaxTree()}]. +-type field() :: {atom(), {field_default(), field_type()}}. + +-type fields() :: [field()]. -spec analyze_record_attribute(erl_syntax:syntaxTree()) -> {atom(), fields()}. @@ -1625,7 +1685,7 @@ analyze_record_attribute_tuple(Node) -> %% {atom(), Info} | atom() %% %% Info = {atom(), [{atom(), Value}]} | {atom(), atom()} | atom() -%% Value = none | syntaxTree() +%% Value = syntaxTree() %% %% @doc Returns the record name and field name/names of a record %% expression. If `Node' has type `record_expr', @@ -1645,9 +1705,9 @@ analyze_record_attribute_tuple(Node) -> %% %% For a `record_expr' node, `Info' represents %% the record name and the list of descriptors for the involved fields, -%% listed in the order they appear. (See -%% `analyze_record_field/1' for details on the field -%% descriptors). For a `record_access' node, +%% listed in the order they appear. A field descriptor is a pair +%% `{Label, Value}', if `Node' represents "`Label = <em>Value</em>'". +%% For a `record_access' node, %% `Info' represents the record name and the field name. For a %% `record_index_expr' node, `Info' represents the %% record name and the name field name. @@ -1659,7 +1719,7 @@ analyze_record_attribute_tuple(Node) -> %% @see analyze_record_attribute/1 %% @see analyze_record_field/1 --type info() :: {atom(), [{atom(), 'none' | erl_syntax:syntaxTree()}]} +-type info() :: {atom(), [{atom(), erl_syntax:syntaxTree()}]} | {atom(), atom()} | atom(). -spec analyze_record_expr(erl_syntax:syntaxTree()) -> {atom(), info()} | atom(). @@ -1670,8 +1730,9 @@ analyze_record_expr(Node) -> A = erl_syntax:record_expr_type(Node), case erl_syntax:type(A) of atom -> - Fs = [analyze_record_field(F) - || F <- erl_syntax:record_expr_fields(Node)], + Fs0 = [analyze_record_field(F) + || F <- erl_syntax:record_expr_fields(Node)], + Fs = [{N, D} || {N, {D, _T}} <- Fs0], {record_expr, {erl_syntax:atom_value(A), Fs}}; _ -> throw(syntax_error) @@ -1713,16 +1774,19 @@ analyze_record_expr(Node) -> end. %% ===================================================================== -%% @spec analyze_record_field(Node::syntaxTree()) -> {atom(), Value} +%% @spec analyze_record_field(Node::syntaxTree()) -> {atom(), {Default, Type}} %% -%% Value = none | syntaxTree() +%% Default = none | syntaxTree() +%% Type = none | syntaxTree() %% -%% @doc Returns the label and value-expression of a record field -%% specifier. The result is a pair `{Label, Value}', if -%% `Node' represents "`Label = <em>Value</em>'" or -%% "`Label'", where in the first case, `Value' is -%% a syntax tree, and in the second case `Value' is -%% `none'. +%% @doc Returns the label, value-expression, and type of a record field +%% specifier. The result is a pair `{Label, {Default, Type}}', if +%% `Node' represents "`Label'", "`Label = <em>Default</em>'", +%% "`Label :: <em>Type</em>'", or +%% "`Label = <em>Default</em> :: <em>Type</em>'". +%% If the field has no value-expression, the value for +%% `Default' will be the atom `none'. If the field has no type, +%% the value for `Type' will be the atom `none'. %% %% The evaluation throws `syntax_error' if %% `Node' does not represent a well-formed record field @@ -1731,8 +1795,7 @@ analyze_record_expr(Node) -> %% @see analyze_record_attribute/1 %% @see analyze_record_expr/1 --spec analyze_record_field(erl_syntax:syntaxTree()) -> - {atom(), 'none' | erl_syntax:syntaxTree()}. +-spec analyze_record_field(erl_syntax:syntaxTree()) -> field(). analyze_record_field(Node) -> case erl_syntax:type(Node) of @@ -1741,10 +1804,15 @@ analyze_record_field(Node) -> case erl_syntax:type(A) of atom -> T = erl_syntax:record_field_value(Node), - {erl_syntax:atom_value(A), T}; + {erl_syntax:atom_value(A), {T, none}}; _ -> throw(syntax_error) end; + typed_record_field -> + F = erl_syntax:typed_record_field_body(Node), + {N, {V, _none}} = analyze_record_field(F), + T = erl_syntax:typed_record_field_type(Node), + {N, {V, T}}; _ -> throw(syntax_error) end. @@ -1887,6 +1955,55 @@ analyze_application(Node) -> %% ===================================================================== +%% @spec analyze_type_application(Node::syntaxTree()) -> typeName() +%% +%% TypeName = {atom(), integer()} +%% | {ModuleName, {atom(), integer()}} +%% ModuleName = atom() +%% +%% @doc Returns the name of a used type. The result is a +%% representation of the name of the used pre-defined or local type `N/A', +%% if `Node' represents a local (user) type application +%% "`<em>N</em>(<em>T_1</em>, ..., <em>T_A</em>)'", or +%% a representation of the name of the used remote type `M:N/A' +%% if `Node' represents a remote user type application +%% "`<em>M</em>:<em>N</em>(<em>T_1</em>, ..., <em>T_A</em>)'". +%% +%% The evaluation throws `syntax_error' if `Node' does not represent a +%% well-formed (user) type application expression. +%% +%% @see analyze_type_name/1 + +-type typeName() :: atom() | {module(), atom(), arity()} | {atom(), arity()}. + +-spec analyze_type_application(erl_syntax:syntaxTree()) -> typeName(). + +analyze_type_application(Node) -> + case erl_syntax:type(Node) of + type_application -> + A = length(erl_syntax:type_application_arguments(Node)), + N = erl_syntax:type_application_name(Node), + case catch {ok, analyze_type_name(N)} of + {ok, TypeName} -> + append_arity(A, TypeName); + _ -> + throw(syntax_error) + end; + user_type_application -> + A = length(erl_syntax:user_type_application_arguments(Node)), + N = erl_syntax:user_type_application_name(Node), + case catch {ok, analyze_type_name(N)} of + {ok, TypeName} -> + append_arity(A, TypeName); + _ -> + throw(syntax_error) + end; + _ -> + throw(syntax_error) + end. + + +%% ===================================================================== %% @spec function_name_expansions(Names::[Name]) -> [{ShortName, Name}] %% %% Name = ShortName | {atom(), Name} diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl index 4557678f9d..1d14bd7c3a 100644 --- a/lib/syntax_tools/src/igor.erl +++ b/lib/syntax_tools/src/igor.erl @@ -2612,6 +2612,19 @@ get_module_info(Forms) -> fold_record_fields(Rs) -> [{N, [fold_record_field(F) || F <- Fs]} || {N, Fs} <- Rs]. +fold_record_field({_Name, {none, _Type}} = None) -> + None; +fold_record_field({Name, {F, Type}}) -> + case erl_syntax:is_literal(F) of + true -> + {Name, {value, erl_syntax:concrete(F)}, Type}; + false -> + %% The default value for the field is not a constant, so we + %% represent it by a hash value instead. (We don't want to + %% do this in the general case.) + {Name, {hash, erlang:phash(F, 16#ffffff)}, Type} + end; +%% The following two clauses handle code before Erlang/OTP 19.0. fold_record_field({_Name, none} = None) -> None; fold_record_field({Name, F}) -> diff --git a/lib/syntax_tools/src/syntax_tools.app.src b/lib/syntax_tools/src/syntax_tools.app.src index dd4ac46055..5c6008a5f0 100644 --- a/lib/syntax_tools/src/syntax_tools.app.src +++ b/lib/syntax_tools/src/syntax_tools.app.src @@ -18,4 +18,4 @@ {applications, [stdlib]}, {env, []}, {runtime_dependencies, - ["compiler-6.0","erts-6.0","kernel-3.0","stdlib-2.5"]}]}. + ["compiler-7.0","erts-8.0","kernel-5.0","stdlib-3.0"]}]}. diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index eb52cce6af..b935d42bb7 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -61,7 +61,7 @@ appup_test(Config) when is_list(Config) -> smoke_test(Config) when is_list(Config) -> Dog = ?t:timetrap(?t:minutes(12)), Wc = filename:join([code:lib_dir(),"*","src","*.erl"]), - Fs = filelib:wildcard(Wc), + Fs = filelib:wildcard(Wc) ++ test_files(Config), io:format("~p files\n", [length(Fs)]), case p_run(fun smoke_test_file/1, Fs) of 0 -> ok; @@ -93,7 +93,7 @@ print_error_markers(F, File) -> revert(Config) when is_list(Config) -> Dog = ?t:timetrap(?t:minutes(12)), Wc = filename:join([code:lib_dir("stdlib"),"src","*.erl"]), - Fs = filelib:wildcard(Wc), + Fs = filelib:wildcard(Wc) ++ test_files(Config), Path = [filename:join(code:lib_dir(stdlib), "include"), filename:join(code:lib_dir(kernel), "include")], io:format("~p files\n", [length(Fs)]), @@ -203,18 +203,25 @@ t_erl_parse_type(Config) when is_list(Config) -> t_epp_dodger(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), - Filenames = ["syntax_tools_SUITE_test_module.erl", - "syntax_tools_test.erl"], + Filenames = test_files(), ok = test_epp_dodger(Filenames,DataDir,PrivDir), ok. t_comment_scan(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), - Filenames = ["syntax_tools_SUITE_test_module.erl", - "syntax_tools_test.erl"], + Filenames = test_files(), ok = test_comment_scan(Filenames,DataDir), ok. +test_files(Config) -> + DataDir = ?config(data_dir, Config), + [ filename:join(DataDir,Filename) || Filename <- test_files() ]. + +test_files() -> + ["syntax_tools_SUITE_test_module.erl", + "syntax_tools_test.erl", + "type_specs.erl"]. + t_igor(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), @@ -222,6 +229,12 @@ t_igor(Config) when is_list(Config) -> FileM2 = filename:join(DataDir,"m2.erl"), ["m.erl",_]=R = igor:merge(m,[FileM1,FileM2],[{outdir,PrivDir}]), io:format("igor:merge/3 = ~p~n", [R]), + + FileTypeSpecs = filename:join(DataDir,"igor_type_specs.erl"), + Empty = filename:join(DataDir,"empty.erl"), + ["n.erl",_]=R2 = igor:merge(n,[FileTypeSpecs,Empty],[{outdir,PrivDir}]), + io:format("igor:merge/3 = ~p~n", [R2]), + ok. test_comment_scan([],_) -> ok; diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/empty.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/empty.erl new file mode 100644 index 0000000000..877ff66013 --- /dev/null +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/empty.erl @@ -0,0 +1 @@ +-module(empty). diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/igor_type_specs.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/igor_type_specs.erl new file mode 100644 index 0000000000..5a156c7fa3 --- /dev/null +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/igor_type_specs.erl @@ -0,0 +1,80 @@ +%% Same as ./type_specs.erl, but without macros. +-module(igor_type_specs). + +-include_lib("syntax_tools/include/merl.hrl"). + +-export([f/1, b/0, c/2]). + +-export_type([t/0, ot/2, ff2/0]). + +-type aa() :: _. + +-type t() :: integer(). + +-type ff(A) :: ot(A, A) | tuple() | 1..3 | map() | {}. +-type ff1() :: ff(bin()) | foo:bar(). +-type ff2() :: {list(), [_], list(integer()), + nonempty_list(), nonempty_list(atom()), [ff1(), ...], + nil(), []}. +-type bin() :: <<>> + | <<_:(+4)>> + | <<_:_*8>> + | <<_:12, _:_*16>> + | <<_:16, _:_*(0)>> % same as "<<_:16>>" + | <<_:16, _:_*(+0)>>. + +-callback cb() -> t(). + +-optional_callbacks([cb/0]). + +-opaque ot(A, B) :: {A, B}. + +-type f1() :: fun(). +-type f2() :: fun((...) -> t()). +-type f3() :: fun(() -> t()). +-type f4() :: fun((t(), t()) -> t()). + +-wild(attribute). + +-record(par, {a :: undefined | igor_type_specs}). + +-record(r0, {}). + +-record(r, + {f1 :: integer(), + f2 = a :: atom(), + f3 :: fun(), + f4 = 7}). + +-type r0() :: #r0{} | #r{f1 :: 3} | #r{f1 :: 3, f2 :: 'sju'}. + +-type m1() :: #{}. +-type m2() :: #{a => m1(), b => #{} | fy:m2()}. +-type b1() :: B1 :: binary() | (BitString :: bitstring()). + +-define(PAIR(A, B), {(A), (B)}). + +-spec igor_type_specs:f({r0(), r0()}) -> {t(), t()}. + +f({R, R}) -> + _ = "igor_type_specs" ++ "hej", + _ = <<"foo">>, + _ = R#r.f1, + _ = R#r{f1 = 17, f2 = b}, + {1, 1}. + +-spec igor_type_specs:b() -> integer() | fun(). + +b() -> + case foo:bar() of + #{a := 2} -> 19 + end. + +-spec c(Atom :: atom(), Integer :: integer()) -> {atom(), integer()}; + (X, Y) -> {atom(), float()} when X :: atom(), + is_subtype(Y, float()); + (integer(), atom()) -> {integer(), atom()}. + +c(A, B) -> + _ = integer, + {A, B}. diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl new file mode 100644 index 0000000000..5621d3a293 --- /dev/null +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/type_specs.erl @@ -0,0 +1,84 @@ +-module(type_specs). + +-include_lib("syntax_tools/include/merl.hrl"). + +-export([f/1, b/0, c/2]). + +-export_type([t/0, ot/2, ff2/0]). + +-type aa() :: _. + +-type t() :: integer(). + +-type ff(A) :: ot(A, A) | tuple() | 1..3 | map() | {}. +-type ff1() :: ff(bin()) | foo:bar(). +-type ff2() :: {list(), [_], list(integer()), + nonempty_list(), nonempty_list(atom()), [ff1(), ...], + nil(), []}. +-type bin() :: <<>> + | <<_:(+4)>> + | <<_:_*8>> + | <<_:12, _:_*16>> + | <<_:16, _:_*(0)>> % same as "<<_:16>>" + | <<_:16, _:_*(+0)>>. + +-callback cb() -> t(). + +-optional_callbacks([cb/0]). + +-opaque ot(A, B) :: {A, B}. + +-type f1() :: fun(). +-type f2() :: fun((...) -> t()). +-type f3() :: fun(() -> t()). +-type f4() :: fun((t(), t()) -> t()). + +-wild(attribute). + +-record(par, {a :: undefined | ?MODULE}). + +-record(r0, {}). + +-record(r, + {f1 :: integer(), + f2 = a :: atom(), + f3 :: fun(), + f4 = 7}). + +-type r0() :: #r0{} | #r{f1 :: 3} | #r{f1 :: 3, f2 :: 'sju'}. + +-type m1() :: #{} | map(). +-type m2() :: #{a := m1(), b => #{} | fy:m2()}. +-type m3() :: #{...}. +-type m4() :: #{_ => _, ...}. +-type m5() :: #{any() => any(), ...}. % Currently printed as `#{..., ...}'. +-type b1() :: B1 :: binary() | (BitString :: bitstring()). + +-define(PAIR(A, B), {(A), (B)}). + +-spec ?MODULE:f(?PAIR(r0(), r0())) -> ?PAIR(t(), t()). + +f({R, R}) -> + _ = ?MODULE_STRING ++ "hej", + _ = <<"foo">>, + _ = R#r.f1, + _ = R#r{f1 = 17, f2 = b}, + {1, 1}. + +-spec ?MODULE:b() -> integer() | fun(). + +b() -> + case foo:bar() of + #{a := 2} -> 19 + end. + +-define(I, integer). + +-spec c(Atom :: atom(), Integer :: ?I()) -> {atom(), integer()}; + (X, Y) -> {atom(), float()} when X :: atom(), + is_subtype(Y, float()); + (integer(), atom()) -> {integer(), atom()}. + +c(A, B) -> + _ = ?I, + {A, B}. diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 17a156ff00..0a3fc0ddff 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -1345,7 +1345,7 @@ Lock syntax table. The effect is that `apply' in the atom ;;;###autoload -(defun erlang-mode () +(define-derived-mode erlang-mode prog-mode "Erlang" "Major mode for editing Erlang source files in Emacs. It knows about syntax and comment, it can indent code, it is capable of fontifying the source file, the TAGS commands are aware of Erlang @@ -1404,12 +1404,9 @@ and examples of hooks. Other commands: \\{erlang-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'erlang-mode) - (setq mode-name "Erlang") + ;; Use our own syntax table function + :syntax-table nil (erlang-syntax-table-init) - (use-local-map erlang-mode-map) (erlang-electric-init) (erlang-menu-init) (erlang-mode-variables) @@ -1419,12 +1416,8 @@ Other commands: (erlang-font-lock-init) (erlang-skel-init) (tempo-use-tag-list 'erlang-tempo-tags) - (run-hooks 'erlang-mode-hook) (if (zerop (buffer-size)) - (run-hooks 'erlang-new-file-hook)) - ;; Doesn't exist in Emacs v21.4; required by Emacs v23. - (if (boundp 'after-change-major-mode-hook) - (run-hooks 'after-change-major-mode-hook))) + (run-hooks 'erlang-new-file-hook))) ;;;###autoload (dolist (r '("\\.erl$" "\\.app\\.src$" "\\.escript" diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl index f9da748fef..b21eedc625 100644 --- a/lib/tools/src/fprof.erl +++ b/lib/tools/src/fprof.erl @@ -1629,15 +1629,24 @@ trace_handler({trace_ts, Pid, in, {_M, _F, Args} = MFArgs, TS} = Trace, TS; %% %% gc_start -trace_handler({trace_ts, Pid, gc_start, _Func, TS} = Trace, - Table, _, Dump) -> +trace_handler({trace_ts, Pid, gc_minor_start, _Func, TS} = Trace, Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + trace_gc_start(Table, Pid, TS), + TS; + +trace_handler({trace_ts, Pid, gc_major_start, _Func, TS} = Trace, Table, _, Dump) -> dump_stack(Dump, get(Pid), Trace), trace_gc_start(Table, Pid, TS), TS; + %% %% gc_end -trace_handler({trace_ts, Pid, gc_end, _Func, TS} = Trace, - Table, _, Dump) -> +trace_handler({trace_ts, Pid, gc_minor_end, _Func, TS} = Trace, Table, _, Dump) -> + dump_stack(Dump, get(Pid), Trace), + trace_gc_end(Table, Pid, TS), + TS; + +trace_handler({trace_ts, Pid, gc_major_end, _Func, TS} = Trace, Table, _, Dump) -> dump_stack(Dump, get(Pid), Trace), trace_gc_end(Table, Pid, TS), TS; diff --git a/lib/tools/test/fprof_SUITE.erl b/lib/tools/test/fprof_SUITE.erl index e18d384b52..affb45b7a6 100644 --- a/lib/tools/test/fprof_SUITE.erl +++ b/lib/tools/test/fprof_SUITE.erl @@ -949,8 +949,8 @@ handle_trace({trace_ts,Pid,return_to,MFA,TS},P) -> end, put({Pid,last_ts},TS), P; -handle_trace({trace_ts,Pid,gc_start,_,TS},P) -> - ?dbg("~p",[{{gc_start,Pid},get(Pid)}]), +handle_trace({trace_ts,Pid,gc_minor_start,_,TS},P) -> + ?dbg("~p",[{{gc_minor_start,Pid},get(Pid)}]), case get(Pid) of [suspend|_] = Stack -> T = ts_sub(TS,get({Pid,last_ts})), @@ -970,8 +970,40 @@ handle_trace({trace_ts,Pid,gc_start,_,TS},P) -> end, put({Pid,last_ts},TS), P; -handle_trace({trace_ts,Pid,gc_end,_,TS},P) -> - ?dbg("~p",[{{gc_end,Pid},get(Pid)}]), +handle_trace({trace_ts,Pid,gc_major_start,_,TS},P) -> + ?dbg("~p",[{{gc_minor_start,Pid},get(Pid)}]), + case get(Pid) of + [suspend|_] = Stack -> + T = ts_sub(TS,get({Pid,last_ts})), + insert(Pid,garbage_collect), + update_acc(Pid,Stack,T), + put(Pid,[garbage_collect|Stack]); + [CallingMFA|_] = Stack -> + T = ts_sub(TS,get({Pid,last_ts})), + insert(Pid,garbage_collect), + update_own(Pid,CallingMFA,T), + update_acc(Pid,Stack,T), + put(Pid,[garbage_collect|Stack]); + undefined -> + put(first_ts,TS), + put(Pid,[garbage_collect]), + insert(Pid,garbage_collect) + end, + put({Pid,last_ts},TS), + P; +handle_trace({trace_ts,Pid,gc_minor_end,_,TS},P) -> + ?dbg("~p",[{{gc_minor_end,Pid},get(Pid)}]), + T = ts_sub(TS,get({Pid,last_ts})), + case get(Pid) of + [garbage_collect|RestOfStack] = Stack -> + update_own(Pid,garbage_collect,T), + update_acc(Pid,Stack,T), + put(Pid,RestOfStack) + end, + put({Pid,last_ts},TS), + P; +handle_trace({trace_ts,Pid,gc_major_end,_,TS},P) -> + ?dbg("~p",[{{gc_major_end,Pid},get(Pid)}]), T = ts_sub(TS,get({Pid,last_ts})), case get(Pid) of [garbage_collect|RestOfStack] = Stack -> diff --git a/otp_versions.table b/otp_versions.table index 79e1c14c49..f68986d831 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,4 @@ +OTP-18.3.3 : common_test-1.12.1 inets-6.2.3 ssl-7.3.2 # asn1-4.0.2 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 : OTP-18.3.2 : inets-6.2.2 ssl-7.3.1 # asn1-4.0.2 common_test-1.12 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 : OTP-18.3.1 : erts-7.3.1 inets-6.2.1 mnesia-4.13.4 # asn1-4.0.2 common_test-1.12 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2 ssl-7.3 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 : OTP-18.3 : asn1-4.0.2 common_test-1.12 compiler-6.0.3 cosNotification-1.2.1 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3 eunit-2.2.13 hipe-3.15 inets-6.2 kernel-4.2 mnesia-4.13.3 observer-2.1.2 orber-3.8.1 public_key-1.1.1 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2 ssl-7.3 stdlib-2.8 test_server-3.10 tools-2.8.3 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 # cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosProperty-1.2 et-1.5.1 gs-1.6 ic-4.4 jinterface-1.6.1 megaco-3.18 odbc-2.11.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 reltool-0.7 syntax_tools-1.7 typer-0.9.10 : diff --git a/system/doc/design_principles/code_lock.dia b/system/doc/design_principles/code_lock.dia Binary files differindex bed6d8ee86..8e6ff8a898 100644 --- a/system/doc/design_principles/code_lock.dia +++ b/system/doc/design_principles/code_lock.dia diff --git a/system/doc/design_principles/code_lock.png b/system/doc/design_principles/code_lock.png Binary files differindex e40f0320aa..745fd91920 100644 --- a/system/doc/design_principles/code_lock.png +++ b/system/doc/design_principles/code_lock.png diff --git a/system/doc/design_principles/code_lock_2.dia b/system/doc/design_principles/code_lock_2.dia Binary files differindex 4e82a9e1d6..142909a2f5 100644 --- a/system/doc/design_principles/code_lock_2.dia +++ b/system/doc/design_principles/code_lock_2.dia diff --git a/system/doc/design_principles/code_lock_2.png b/system/doc/design_principles/code_lock_2.png Binary files differindex 138fbdef6c..ecf7b0d799 100644 --- a/system/doc/design_principles/code_lock_2.png +++ b/system/doc/design_principles/code_lock_2.png diff --git a/system/doc/design_principles/fsm.xml b/system/doc/design_principles/fsm.xml index 3468f93ae0..4f2b75e6e8 100644 --- a/system/doc/design_principles/fsm.xml +++ b/system/doc/design_principles/fsm.xml @@ -33,7 +33,7 @@ <note> <p> There is a new behaviour - <seealso marker="gen_statem"><c>gen_statem</c></seealso> + <seealso marker="statem"><c>gen_statem</c></seealso> that is intended to replace <c>gen_fsm</c> for new code. It has the same features and add some really useful. This module will not be removed for the foreseeable future diff --git a/system/doc/reference_manual/code_loading.xml b/system/doc/reference_manual/code_loading.xml index e9da40e02f..f6fd2911fa 100644 --- a/system/doc/reference_manual/code_loading.xml +++ b/system/doc/reference_manual/code_loading.xml @@ -130,26 +130,6 @@ loop() -> <marker id="on_load"></marker> <title>Running a Function When a Module is Loaded</title> - <warning> - <p>The <c>on_load</c> feature is to be considered experimental - as there are a number of known weak points in current semantics, - which therefore might change in future Erlang/OTP releases:</p> - <list> - <item><p>Doing external call in <c>on_load</c> to the module itself - leads to deadlock.</p></item> - <item><p>At module upgrade, other processes calling the module - get suspended waiting for <c>on_load</c> to finish. This can be very bad - for applications with demands on realtime characteristics.</p></item> - <item><p>At module upgrade, no rollback is done if the - <c>on_load</c> function fails. - The system is left in a bad limbo state without any working - and reachable instance of the module.</p></item> - </list> - <p>The problems with module upgrade described above can be fixed in future - Erlang/OTP releases by changing the behaviour to not make the module reachable until - after the <c>on_load</c> function has successfully returned.</p> - </warning> - <p>The <c>-on_load()</c> directive names a function that is to be run automatically when a module is loaded.</p> <p>Its syntax is as follows:</p> @@ -159,20 +139,35 @@ loop() -> <p>It is not necessary to export the function. It is called in a freshly spawned process (which terminates as soon as the function - returns). The function must return <c>ok</c> if the module is to - remain loaded and become callable, or any other value if the module - is to be unloaded. Generating an exception also causes the - module to be unloaded. If the return value is not an atom, - a warning error report is sent to the error logger.</p> - - <p>A process that calls any function in a module whose <c>on_load</c> - function has not yet returned, is suspended until the <c>on_load</c> - function has returned.</p> + returns).</p> + + <p>The function must return <c>ok</c> if the module is to + become the new current code for the module and become + callable.</p> + + <p>Returning any other value or generating an exception + causes the new code to be unloaded. If the return value is not an + atom, a warning error report is sent to the error logger.</p> + + <p>If there already is current code for the module, that code will + remain current and can be called until the <c>on_load</c> function + has returned. If the <c>on_load</c> function fails, the current + code (if any) will remain current. If there is no current code for + a module, any process that makes an external call to the module + before the <c>on_load</c> function has finished will be suspended + until the <c>on_load</c> function have finished.</p> + + <note> + <p>Before OTP 19, if the <c>on_load</c> function failed, any + previously current code would become old, essentially leaving + the system without any working and reachable instance of the + module. That problem has been eliminated in OTP 19.</p> + </note> <p>In embedded mode, first all modules are loaded. Then all <c>on_load</c> functions are called. The system is terminated unless all of the <c>on_load</c> functions return - <c>ok</c></p>. + <c>ok</c>.</p> <p><em>Example:</em></p> diff --git a/system/doc/reference_manual/macros.xml b/system/doc/reference_manual/macros.xml index 42ea639b54..350bb1d123 100644 --- a/system/doc/reference_manual/macros.xml +++ b/system/doc/reference_manual/macros.xml @@ -234,6 +234,53 @@ or </section> <section> + <title>-error() and -warning() directives</title> + + <p>The directive <c>-error(Term)</c> causes a compilation error.</p> + + <p><em>Example:</em></p> + <code type="none"> +-module(t). +-export([version/0]). + +-ifdef(VERSION). +version() -> ?VERSION. +-else. +-error("Macro VERSION must be defined."). +version() -> "". +-endif.</code> + + <p>The error message will look like this:</p> + + <pre> +% <input>erlc t.erl</input> +t.erl:7: -error("Macro VERSION must be defined.").</pre> + + <p>The directive <c>-warning(Term)</c> causes a compilation warning.</p> + + <p><em>Example:</em></p> + <code type="none"> +-module(t). +-export([version/0]). + +-ifndef(VERSION). +-warning("Macro VERSION not defined -- using default version."). +-define(VERSION, "0"). +-endif. +version() -> ?VERSION.</code> + + <p>The warning message will look like this:</p> + + <pre> +% <input>erlc t.erl</input> +t.erl:5: Warning: -warning("Macro VERSION not defined -- using default version.").</pre> + + <p>The <c>-error()</c> and <c>-warning()</c> directives were added + in OTP 19.</p> + + </section> + + <section> <title>Stringifying Macro Arguments</title> <p>The construction <c>??Arg</c>, where <c>Arg</c> is a macro argument, is expanded to a string containing the tokens of @@ -253,5 +300,6 @@ io:format("Call ~s: ~w~n",["you : function ( 2 , 1 )",you:function(2,1)]).</code <p>That is, a trace output, with both the function called and the resulting value.</p> </section> + </chapter> diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml index c5d24a96b5..9e26e9058d 100644 --- a/system/doc/reference_manual/typespec.xml +++ b/system/doc/reference_manual/typespec.xml @@ -132,15 +132,18 @@ | nonempty_list(Type) %% Proper non-empty list Map :: map() %% stands for a map of any size - | #{} %% stands for a map of any size + | #{} %% stands for the empty map | #{PairList} Tuple :: tuple() %% stands for a tuple of any size | {} | {TList} - PairList :: Type => Type - | Type => Type, PairList + PairList :: Pair + | Pair, PairList + + Pair :: Type := Type %% notes a pair that must be present + | Type => Type TList :: Type | Type, TList @@ -170,6 +173,23 @@ The notation <c>[]</c> specifies the singleton type for the empty list. </p> <p> + The general form of maps is <c>#{PairList}</c>. The key types in + <c>PairList</c> are allowed to overlap, and if they do, the leftmost pair + takes precedence. A map value does not belong to this type if contains a key + that is not in <c>PairList</c>. + </p> + <p> + Because it is common to end a map type with <c>any() => any()</c> to denote + that keys that do not belong to any other pair in <c>PairList</c> are + allowed, and may map to any value, the shorthand notation <c>...</c> is + allowed as the last pair of a map type. + </p> + <p> + Notice that the syntactic representation of <c>map()</c> is <c>#{...}</c> + (or <c>#{_ => _}</c>, or <c>#{any() => any()}</c>), not <c>#{}</c>. + The notation <c>#{}</c> specifies the singleton type for the empty map. + </p> + <p> For convenience, the following types are also built-in. They can be thought as predefined aliases for the type unions also shown in the table. @@ -302,12 +322,6 @@ This is described in <seealso marker="#typeinrecords"> Type Information in Record Declarations</seealso>. </p> - <note> - <p>Map types, both <c>map()</c> and <c>#{...}</c>, - are considered experimental during OTP 17.</p> - <p>No type information of maps pairs, only the containing map types, - are used by Dialyzer in OTP 17.</p> - </note> </section> <section> |
