diff options
Diffstat (limited to 'lib')
670 files changed, 24493 insertions, 11215 deletions
diff --git a/lib/asn1/doc/src/notes.xml b/lib/asn1/doc/src/notes.xml index cf87c01658..9feb673c04 100644 --- a/lib/asn1/doc/src/notes.xml +++ b/lib/asn1/doc/src/notes.xml @@ -31,6 +31,21 @@ <p>This document describes the changes made to the asn1 application.</p> +<section><title>Asn1 3.0.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>The ASN.1 compiler would crash if a SEQUENCE ended + with a double set of ellipses (<c>...</c>).</p> + <p> + Own Id: OTP-12546 Aux Id: seq12815 </p> + </item> + </list> + </section> + +</section> + <section><title>Asn1 3.0.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/asn1/src/asn1.app.src b/lib/asn1/src/asn1.app.src index 02cbba0f10..1f8805ff5e 100644 --- a/lib/asn1/src/asn1.app.src +++ b/lib/asn1/src/asn1.app.src @@ -11,5 +11,5 @@ ]}, {env, []}, {applications, [kernel, stdlib]}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]} + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-7.0"]} ]}. diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 91820e08de..5297d5291c 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1922,16 +1922,7 @@ enc_opt(nil, St) -> enc_opt({seq,H0,T0}, St0) -> {H,St1} = enc_opt(H0, St0), {T,St} = enc_opt(T0, St1), - case {H,T} of - {none,_} -> - {T,St}; - {{list,Imm,Data}, - {seq,{call,per,complete,[Data],_},_}} -> - %% Get rid of any explicit 'align' added by per_enc_open_type/2. - {{seq,{list,remove_trailing_align(Imm),Data},T},St}; - {_,_} -> - {{seq,H,T},St} - end; + {enc_opt_seq(H, T),St}; enc_opt({set,_,_}=Imm, St) -> {Imm,St#ost{t=undefined}}; enc_opt({sub,Src0,Int,Dst}, St0) -> @@ -1965,6 +1956,28 @@ remove_trailing_align({seq,H,T}) -> {seq,H,remove_trailing_align(T)}; remove_trailing_align(Imm) -> Imm. +enc_opt_seq(none, T) -> + T; +enc_opt_seq({list,Imm,Data}, {seq,{call,per,complete,[Data],_},_}=T) -> + %% Get rid of any explicit 'align' added by per_enc_open_type/2. + {seq,{list,remove_trailing_align(Imm),Data},T}; +enc_opt_seq({call,_,_,_,{var,_}=Dst}=H, T) -> + case is_var_unused(Dst, T) of + false -> {seq,H,T}; + true -> T + end; +enc_opt_seq(H, T) -> + {seq,H,T}. + +is_var_unused(_, align) -> + true; +is_var_unused(V, {call,_,_,Args}) -> + not lists:member(V, Args); +is_var_unused(V, {cons,H,T}) -> + is_var_unused(V, H) andalso is_var_unused(V, T); +is_var_unused(_, _) -> + false. + bit_size_propagate(Bin, Type, St) -> case t_range(Type) of any -> @@ -2426,7 +2439,8 @@ bit_string_name2pos_fun(NNL, Src) -> gen_name2pos(Fd, Name, Names) -> Cs0 = gen_name2pos_cs(Names, Name), Cs = Cs0 ++ [bit_clause(Name),nil_clause(),invalid_clause()], - F = {function,1,Name,1,Cs}, + F0 = {function,1,Name,1,Cs}, + F = erl_parse:new_anno(F0), file:write(Fd, [erl_pp:function(F)]). gen_name2pos_cs([{K,V}|T], Name) -> diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 221cd991a7..c5901d5489 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -352,8 +352,9 @@ random_unnamed_bit_string(M, C) -> %% end. random(Upper) -> - {A1,A2,A3} = erlang:now(), - _ = random:seed(A1, A2, A3), + _ = random:seed(erlang:phash2([erlang:node()]), + erlang:monotonic_time(), + erlang:unique_integer()), random:uniform(Upper). size_random(C) -> diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index 155d6f6ff5..43835728e8 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -232,7 +232,8 @@ bit_string(Rules, Opts) -> end. random_bits(N) -> - Seed = integer_to_list(erlang:phash2(erlang:now())), + Seed0 = {erlang:monotonic_time(),erlang:unique_integer()}, + Seed = integer_to_list(erlang:phash2(Seed0)), random_bits(<<>>, N, Seed). random_bits(Bin, N, Seed) -> diff --git a/lib/asn1/vsn.mk b/lib/asn1/vsn.mk index daaf26a17f..c909c908d6 100644 --- a/lib/asn1/vsn.mk +++ b/lib/asn1/vsn.mk @@ -1,2 +1 @@ -#next version number to use is 2.0 -ASN1_VSN = 3.0.3 +ASN1_VSN = 3.0.4 diff --git a/lib/common_test/doc/src/event_handler_chapter.xml b/lib/common_test/doc/src/event_handler_chapter.xml index 45f01c12ec..f39f391818 100644 --- a/lib/common_test/doc/src/event_handler_chapter.xml +++ b/lib/common_test/doc/src/event_handler_chapter.xml @@ -59,6 +59,15 @@ Event handlers plugged into this manager will receive the events from all the test nodes as well as information from the CT Master server itself.</p> + + <p>User specific event handlers may be plugged into a Common Test event + manager, either by telling Common Test to install them before the test + run (see below), or by adding the handlers dynamically during the test + run by means of + <c>gen_event:add_handler/3</c> or <c>gen_event:add_sup_handler/3</c>. + In the latter scenario, the reference of the Common Test event manager is + required. To get it, call <c>ct:get_event_mgr_ref/0</c> or (on the CT + Master node) <c>ct_master:get_event_mgr_ref/0</c>.</p> </section> <section> <marker id="usage"></marker> diff --git a/lib/common_test/doc/src/install_chapter.xml b/lib/common_test/doc/src/install_chapter.xml index 7f8c606324..31125b945c 100644 --- a/lib/common_test/doc/src/install_chapter.xml +++ b/lib/common_test/doc/src/install_chapter.xml @@ -34,7 +34,7 @@ <title>General information</title> <p>The two main interfaces for running tests with Common Test - are an executable program named ct_run and an + are an executable program named <c>ct_run</c> and an erlang module named <c>ct</c>. The ct_run program is compiled for the underlying operating system (e.g. Unix/Linux or Windows) during the build of the Erlang/OTP system, and is @@ -43,67 +43,10 @@ The <c>ct</c> interface functions can be called from the Erlang shell, or from any Erlang function, on any supported platform.</p> - <p>A legacy Bourne shell script - named run_test - exists, - which may be manually generated and installed. This script may be used - instead of the ct_run program mentioned above, e.g. if the user - wishes to modify or customize the Common Test start flags in a simpler - way than making changes to the ct_run C program.</p> - <p>The Common Test application is installed with the Erlang/OTP system and no additional installation step is required to start using - Common Test by means of the ct_run executable program, and/or the interface - functions in the <c>ct</c> module. If you wish to use the legacy Bourne - shell script version run_test, however, this script needs to be - generated first, according to the instructions below.</p> - - <note><p>Before reading on, please note that since Common Test version - 1.5, the run_test shell script is no longer required for starting - tests with Common Test from the OS command line. The ct_run - program (descibed above) is the new recommended command line interface - for Common Test. The shell script exists mainly for legacy reasons and - may not be updated in future releases of Common Test. It may even be removed. - </p></note> - - <p>Optional step to generate a shell script for starting Common Test:</p> - <p>To generate the run_test shell script, navigate to the - <c><![CDATA[common_test-<vsn>]]></c> directory, located among the other - OTP applications (under the OTP lib directory). Here execute the - <c>install.sh</c> script with argument <c>local</c>:</p> - - <p><c> - $ ./install.sh local - </c></p> - - <p>This generates the executable run_test script in the - <c><![CDATA[common_test-<vsn>/priv/bin]]></c> directory. The script - will include absolute paths to the Common Test and Test Server - application directories, so it's possible to copy or move the script to - a different location on the file system, if desired, without having to - update it. It's of course possible to leave the script under the - <c>priv/bin</c> directory and update the PATH variable accordingly (or - create a link or alias to it).</p> - - <p>If you, for any reason, have copied Common Test and Test Server - to a different location than the default OTP lib directory, you can - generate a run_test script with a different top level directory, - simply by specifying the directory, instead of <c>local</c>, when running - <c>install.sh</c>. Example:</p> - - <p><c> - $ install.sh /usr/local/test_tools - </c></p> - - <p>Note that the <c><![CDATA[common_test-<vsn>]]></c> and - <c><![CDATA[test_server-<vsn>]]></c> directories must be located under the - same top directory. Note also that the install script does not copy files - or update environment variables. It only generates the run_test - script.</p> - - <p>Whenever you install a new version of Erlang/OTP, the run_test - script needs to be regenerated, or updated manually with new directory names - (new version numbers), for it to "see" the latest Common Test and Test Server - versions.</p> - + Common Test by means of the <c>ct_run</c> executable program, and/or + the interface functions in the <c>ct</c> module.</p> </section> </chapter> diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index 94738d2eff..472e3b7833 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -32,6 +32,226 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.10.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A fault in the Common Test logger process, that caused + the application to crash when running on a long name + node, has been corrected.</p> + <p> + Own Id: OTP-12643</p> + </item> + <item> + <p> + A 'wait_for_prompt' option in ct_telnet:expect/3 has been + introduced which forces the function to not return until + a prompt string has been received, even if other expect + patterns have already been found.</p> + <p> + Own Id: OTP-12688 Aux Id: seq12818 </p> + </item> + <item> + <p> + If the last expression in a test case causes a timetrap + timeout, the stack trace is ignored and not printed to + the test case log file. This happens because the + {Suite,TestCase,Line} info is not available in the stack + trace in this scenario, due to tail call elimination. + Common Test has been modified to handle this situation by + inserting a {Suite,TestCase,last_expr} tuple in the + correct place and printing the stack trace as expected.</p> + <p> + Own Id: OTP-12697 Aux Id: seq12848 </p> + </item> + <item> + <p> + Fixed a buffer problem in ct_netconfc which could cause + that some messages where buffered forever.</p> + <p> + Own Id: OTP-12698 Aux Id: seq12844 </p> + </item> + <item> + <p> + The VTS mode in Common Test has been modified to use a + private version of the Webtool application (ct_webtool).</p> + <p> + Own Id: OTP-12704 Aux Id: OTP-10922 </p> + </item> + <item> + <p> + Add possibility to add user capabilities in + <c>ct_netconfc:hello/3</c>.</p> + <p> + Own Id: OTP-12707 Aux Id: seq12846 </p> + </item> + </list> + </section> + +</section> + +<section><title>Common_Test 1.10</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The tests overview file, index.html, did not always get + updated correctly after a new test run. This was because + of a bug in the Common Test log cache mechanism which has + now been corrected.</p> + <p> + Own Id: OTP-11400</p> + </item> + <item> + <p> + When a successful test case returns, Common Test should, + according to the documentation, send a tc_done event to + the event handlers with Result = ok in the data field. + However, Common Test sets Result to the return value of + the test case instead. Common Test has been modified now + to comply with the documentation.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-12279 Aux Id: seq12737, OTP-12531 </p> + </item> + <item> + <p> + A ct_telnet:expect/3 call could never be aborted before + an idle_timeout, even if total_timeout had been set to a + lower value (i.e. a shorter time). This problem has been + fixed.</p> + <p> + Own Id: OTP-12335</p> + </item> + <item> + <p> + The undocumented return value {skipped,Reason} from + config functions and test cases was handled + inconsistently. Test cases were e.g. reported as + "skipped" to CT Hook functions, but "successful" to event + handlers. Now, the above return value is consistently + handled the same way as {skip,Reason} and this has also + been documented.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-12359 Aux Id: seq12760 </p> + </item> + <item> + <p> + The Erlang source code to HTML generator would sometimes + fail because epp:parse_erl_form/1 could not find and + expand required macros in included header files. The + problem has been solved by making sure common_test always + passes the full include path to epp. Also, a bug that + could cause erl_syntax:revert/1 to fail because of a + badly formed syntax tree has been corrected.</p> + <p> + Own Id: OTP-12419</p> + </item> + <item> + <p> + A missing group option in the ct_run help text has been + added.</p> + <p> + Own Id: OTP-12433 Aux Id: seq12788 </p> + </item> + <item> + <p> + Printouts by means of ct:log/2/3 or ct:pal/2/3 from the + hook functions on_tc_fail/2 and on_tc_skip/2 would (quite + unexpectedly) end up in the "unexpected i/o" log file + instead of in the test case log file. This behaviour has + been changed so that now, all printouts (including stdio + printouts) from these hook functions will be routed to + the test case log file.</p> + <p> + Own Id: OTP-12468</p> + </item> + <item> + <p> + ct_netconfc:action/3 will now - if the return type is + void - accept an RPC reply on the form + {ok,[simple_xml()]}, and in this event return only the + atom ok.</p> + <p> + Own Id: OTP-12491 Aux Id: seq12797 </p> + </item> + <item> + <p> + OTP-11971 erroneously changed the handling of relative + paths for incl_dirs specified in the cover spec file. + This is now corrected so these are expected to be + relative to the directory where the cover spec file + itself is stored</p> + <p> + Own Id: OTP-12498 Aux Id: OTP-11971 </p> + </item> + <item> + <p> + Some test cases have been updated to use ct:sleep/1 + instead of timer:sleep/1. The reason being that the sleep + times need to be scaled to compensate for slow execution + (e.g. when cover is running).</p> + <p> + Own Id: OTP-12574</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Common Test now exports a function, + ct:get_event_mgr_ref/0, that returns the name of the + Common Test event manager. This makes it possible to plug + in event handlers to the event manager while tests are + running (using the gen_event API).</p> + <p> + Own Id: OTP-12506 Aux Id: seq12802 </p> + </item> + <item> + <p> + When a test case (or configuration function) fails + because of an exit signal from a linked process, Common + Test previously passed only the reason for process + termination to the CT post hook functions and the event + handlers (in the tc_done event). This has been changed so + that now the tuple {'EXIT',ReasonForProcessTermination} + is passed instead. This makes it much easier in the CT + post hook functions to distinguish a failure of this sort + from other types of errors and from the return value of a + successful test case.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-12531 Aux Id: OTP-12279 </p> + </item> + <item> + <p> + A new feature has been introduced in ct_telnet:get_data/1 + that makes it possible to automatically poll the telnet + connection in case an incomplete string (one that has not + yet been terminated by a newline) remains in the receive + buffer. The polling is controlled by two new telnet + config values, which are documented in the ct_telnet + reference manual. The polling mechanism is disabled by + default (making the get_data/1 function backwards + compatible).</p> + <p> + Own Id: OTP-12627</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.9</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 864f82cb63..df60e5f7f2 100644 --- a/lib/common_test/doc/src/run_test_chapter.xml +++ b/lib/common_test/doc/src/run_test_chapter.xml @@ -1005,6 +1005,31 @@ for starting the tests, the relaxed scanner mode is enabled by means of the tuple: <c>{allow_user_terms,true}</c></p> </section> + <section> + <title>Reading test specification terms</title> + <p>It's possible to look up terms in the current test specification + (i.e. the spec that's been used to configure and run the current test). + The function <c>get_testspec_terms()</c> returns a list of all test spec + terms (both config- and test terms) and <c>get_testspec_terms(Tags)</c> + returns the term (or a list of terms) matching the tag (or tags) in + <c>Tags</c>.</p> + <p>For example, in the test specification:</p> + <pre> + ... + {label, my_server_smoke_test}. + {config, "../../my_server_setup.cfg"}. + {config, "../../my_server_interface.cfg"}. + ...</pre> + <p>And in e.g. a test suite or a CT hook function:</p> + <pre> + ... + [{label,[{_Node,TestType}]}, {config,CfgFiles}] = + ct:get_testspec_terms([label,config]), + + [verify_my_server_cfg(TestType, CfgFile) || {Node,CfgFile} <- CfgFiles, + Node == node()]; + ...</pre> + </section> </section> <section> diff --git a/lib/common_test/install.sh.in b/lib/common_test/install.sh.in deleted file mode 100644 index 5108c7a259..0000000000 --- a/lib/common_test/install.sh.in +++ /dev/null @@ -1,53 +0,0 @@ -#!/bin/sh - -CT_ROOT=$1 -CT_VSN=@CT_VSN@ -TS_VSN=@TS_VSN@ - -if [ -z "$CT_ROOT" ] -then - echo "install.sh: need CT_ROOT (absolute) directory or 'local' as argument" - exit 1 -fi - -if [ $CT_ROOT = "local" ] -then - CT_DIR=`pwd` - cd priv - sed -e "s,@CTPATH@,$CT_DIR/ebin," \ - -e "s,@TSPATH@,$CT_DIR/../test_server/ebin," \ - run_test.in > bin/run_test - chmod 775 bin/run_test - echo "install successful, start script created in " $CT_ROOT/common_test-$CT_VSN/priv/bin -else - - if [ ! -d "$CT_ROOT" ] - then - echo "install.sh: CT_ROOT argument must be a valid directory" - exit 1 - fi - - if [ `echo $CT_ROOT | awk '{ print substr($1,1,1) }'` != "/" ] - then - echo "install.sh: need an absolute path to CT_ROOT" - exit 1 - fi - - if [ ! -d $CT_ROOT/common_test-$CT_VSN ] - then - echo "install.sh: The directory $CT_ROOT/common_test-$CT_VSN does not exist" - exit 1 - fi - - if [ -d $CT_ROOT/common_test-$CT_VSN/priv ] - then - cd $CT_ROOT/common_test-$CT_VSN/priv - sed -e "s;@CTPATH@;$CT_ROOT/common_test-$CT_VSN/ebin;" \ - -e "s;@TSPATH@;$CT_ROOT/test_server-$TS_VSN/ebin;" \ - run_test.in > bin/run_test - chmod 775 bin/run_test - echo "install successful, start script created in " $CT_ROOT/common_test-$CT_VSN/priv/bin - fi -fi - - diff --git a/lib/common_test/priv/Makefile.in b/lib/common_test/priv/Makefile.in index 1bc6b82ebb..7765b06f95 100644 --- a/lib/common_test/priv/Makefile.in +++ b/lib/common_test/priv/Makefile.in @@ -66,12 +66,7 @@ JS = jquery-latest.js jquery.tablesorter.min.js # Rules # -include ../../test_server/vsn.mk debug opt: - $(V_at)sed -e 's;@CT_VSN@;$(VSN);' \ - -e 's;@TS_VSN@;$(TEST_SERVER_VSN);' \ - ../install.sh.in > install.sh - - $(V_at)chmod -f 775 install.sh docs: diff --git a/lib/common_test/priv/bin/.gitignore b/lib/common_test/priv/bin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/common_test/priv/bin/.gitignore +++ /dev/null diff --git a/lib/common_test/priv/run_test.in b/lib/common_test/priv/run_test.in deleted file mode 100644 index 1508751e4f..0000000000 --- a/lib/common_test/priv/run_test.in +++ /dev/null @@ -1,63 +0,0 @@ -#!/bin/sh - -args="" - -while [ $1 ]; do - if [ $1 = "-config" ]; then - args="$args -ct_config"; - elif [ $1 = "-decrypt_key" ]; then - args="$args -ct_decrypt_key"; - elif [ $1 = "-decrypt_file" ]; then - args="$args -ct_decrypt_file"; - elif [ $1 = "-vts" ]; then - vts=1; - args="$args $1"; - elif [ $1 = "-browser" ]; then - browser=$2; - args="$args $1"; - elif [ $1 = "-shell" ]; then - shell=1; - args="$args $1"; - elif [ $1 = "-ctname" ]; then - ctname=$2; - args="$args"; - elif [ $1 = "-ctmaster" ]; then - master=1; - args="$args"; - else - args="$args $1" - fi - shift -done - -if [ $vts ]; then - erl -sname ct \ - -pa @CTPATH@ \ - -pa @TSPATH@ \ - -s webtool script_start vts $browser \ - -s ct_run script_start \ - $args; -elif [ $shell ]; then - erl -sname ct \ - -pa @CTPATH@ \ - -pa @TSPATH@ \ - -s ct_run script_start \ - $args; -elif [ $ctname ]; then - erl -sname $ctname \ - -pa @CTPATH@ \ - -pa @TSPATH@ \ - $args; -elif [ $master ]; then - erl -sname ct_master \ - -pa @CTPATH@ \ - -pa @TSPATH@ \ - $args; -else - erl -sname ct \ - -pa @CTPATH@ \ - -pa @TSPATH@ \ - -s ct_run script_start \ - -s erlang halt \ - $args -fi diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 2723b066f0..e3d5102db8 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -62,6 +62,8 @@ MODULES= \ ct_telnet_client \ ct_make \ vts \ + ct_webtool \ + ct_webtool_sup \ unix_telnet \ ct_config \ ct_config_plain \ diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index 85afdc7834..5ed1346f1e 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -52,6 +52,7 @@ -module(ct). -include("ct.hrl"). +-include("ct_util.hrl"). %% Command line user interface for running tests -export([install/1, run/1, run/2, run/3, @@ -77,6 +78,8 @@ %% Other interface functions -export([get_status/0, abort_current_testcase/1, + get_event_mgr_ref/0, + get_testspec_terms/0, get_testspec_terms/1, encrypt_config_file/2, encrypt_config_file/3, decrypt_config_file/2, decrypt_config_file/3]). @@ -461,6 +464,50 @@ reload_config(Required)-> ct_config:reload_config(Required). %%%----------------------------------------------------------------- +%%% @spec get_testspec_terms() -> TestSpecTerms | undefined +%%% TestSpecTerms = [{Tag,Value}] +%%% Value = [term()] +%%% +%%% @doc Get a list of all test specification terms used to +%%% configure and run this test. +%%% +get_testspec_terms() -> + case ct_util:get_testdata(testspec) of + undefined -> + undefined; + CurrSpecRec -> + ct_testspec:testspec_rec2list(CurrSpecRec) + end. + +%%%----------------------------------------------------------------- +%%% @spec get_testspec_terms(Tags) -> TestSpecTerms | undefined +%%% Tags = [Tag] | Tag +%%% Tag = atom() +%%% TestSpecTerms = [{Tag,Value}] | {Tag,Value} +%%% Value = [{Node,term()}] | [term()] +%%% Node = atom() +%%% +%%% @doc Read one or more terms from the test specification used +%%% to configure and run this test. Tag is any valid test specification +%%% tag, such as e.g. <c>label</c>, <c>config</c>, <c>logdir</c>. +%%% User specific terms are also available to read if the +%%% <c>allow_user_terms</c> option has been set. Note that all value tuples +%%% returned, except user terms, will have the node name as first element. +%%% Note also that in order to read test terms, use <c>Tag = tests</c> +%%% (rather than <c>suites</c>, <c>groups</c> or <c>cases</c>). Value is +%%% then the list of *all* tests on the form: +%%% <c>[{Node,Dir,[{TestSpec,GroupsAndCases1},...]},...], where +%%% GroupsAndCases = [{Group,[Case]}] | [Case]</c>. +get_testspec_terms(Tags) -> + case ct_util:get_testdata(testspec) of + undefined -> + undefined; + CurrSpecRec -> + ct_testspec:testspec_rec2list(Tags, CurrSpecRec) + end. + + +%%%----------------------------------------------------------------- %%% @spec log(Format) -> ok %%% @equiv log(default,50,Format,[]) log(Format) -> @@ -1005,6 +1052,18 @@ abort_current_testcase(Reason) -> test_server_ctrl:abort_current_testcase(Reason). %%%----------------------------------------------------------------- +%%% @spec get_event_mgr_ref() -> EvMgrRef +%%% EvMgrRef = atom() +%%% +%%% @doc <p>Call this function in order to get a reference to the +%%% CT event manager. The reference can be used to e.g. add +%%% a user specific event handler while tests are running. +%%% Example: +%%% <c>gen_event:add_handler(ct:get_event_mgr_ref(), my_ev_h, [])</c></p> +get_event_mgr_ref() -> + ?CT_EVMGR_REF. + +%%%----------------------------------------------------------------- %%% @spec encrypt_config_file(SrcFileName, EncryptFileName) -> %%% ok | {error,Reason} %%% SrcFileName = string() diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl index 5c80a299f8..4b92ca6f8f 100644 --- a/lib/common_test/src/ct_config.erl +++ b/lib/common_test/src/ct_config.erl @@ -693,8 +693,7 @@ make_crypto_key(String) -> {[K1,K2,K3],IVec}. random_bytes(N) -> - {A,B,C} = now(), - random:seed(A, B, C), + random:seed(os:timestamp()), random_bytes_1(N, []). random_bytes_1(0, Acc) -> Acc; diff --git a/lib/common_test/src/ct_conn_log_h.erl b/lib/common_test/src/ct_conn_log_h.erl index cff02a46d9..2d15035cd8 100644 --- a/lib/common_test/src/ct_conn_log_h.erl +++ b/lib/common_test/src/ct_conn_log_h.erl @@ -34,6 +34,8 @@ -define(WIDTH,80). +-define(now, os:timestamp()). + %%%----------------------------------------------------------------- %%% Callbacks init({GL,ConnLogs}) -> @@ -72,14 +74,14 @@ handle_event({_Type, GL, _Msg}, State) when node(GL) /= node() -> handle_event({_Type,GL,{Pid,{ct_connection,Mod,Action,ConnName},Report}}, State) -> Info = conn_info(Pid,#conn_log{name=ConnName,action=Action,module=Mod}), - write_report(now(),Info,Report,GL,State), + write_report(?now,Info,Report,GL,State), {ok, State}; handle_event({_Type,GL,{Pid,Info=#conn_log{},Report}}, State) -> - write_report(now(),conn_info(Pid,Info),Report,GL,State), + write_report(?now,conn_info(Pid,Info),Report,GL,State), {ok, State}; handle_event({error_report,GL,{Pid,_,[{ct_connection,ConnName}|R]}}, State) -> %% Error reports from connection - write_error(now(),conn_info(Pid,#conn_log{name=ConnName}),R,GL,State), + write_error(?now,conn_info(Pid,#conn_log{name=ConnName}),R,GL,State), {ok, State}; handle_event(_What, State) -> {ok, State}. diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index ec525784ec..91368d3137 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -113,6 +113,7 @@ init_tc1(?MODULE,_,error_in_suite,[Config0]) when is_list(Config0) -> ct_event:notify(#event{name=tc_start, node=node(), data={?MODULE,error_in_suite}}), + ct_suite_init(?MODULE, error_in_suite, [], Config0), case ?val(error, Config0) of undefined -> {fail,"unknown_error_in_suite"}; @@ -635,7 +636,20 @@ try_set_default(Name,Key,Info,Where) -> end_tc(Mod, Fun, Args) -> %% Have to keep end_tc/3 for backwards compatibility issues end_tc(Mod, Fun, Args, '$end_tc_dummy'). -end_tc(?MODULE,error_in_suite,_, _) -> % bad start! +end_tc(?MODULE,error_in_suite,{Result,[Args]},Return) -> + %% this clause gets called if CT has encountered a suite that + %% can't be executed + FinalNotify = + case ct_hooks:end_tc(?MODULE, error_in_suite, Args, Result, Return) of + '$ct_no_change' -> + Result; + HookResult -> + HookResult + end, + Event = #event{name=tc_done, + node=node(), + data={?MODULE,error_in_suite,tag(FinalNotify)}}, + ct_event:sync_notify(Event), ok; end_tc(Mod,Func,{TCPid,Result,[Args]}, Return) when is_pid(TCPid) -> end_tc(Mod,Func,TCPid,Result,Args,Return); @@ -686,18 +700,21 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) -> undefined -> %% send sync notification so that event handlers may print %% in the log file before it gets closed - ct_event:sync_notify(#event{name=tc_done, - node=node(), - data={Mod,FuncSpec, - tag_cth(FinalNotify)}}), + Event = #event{name=tc_done, + node=node(), + data={Mod,FuncSpec, + tag(FinalNotify)}}, + ct_event:sync_notify(Event), Result1; Fun -> %% send sync notification so that event handlers may print %% in the log file before it gets closed - ct_event:sync_notify(#event{name=tc_done, - node=node(), - data={Mod,FuncSpec, - tag(FinalNotify)}}), + Event = #event{name=tc_done, + node=node(), + data={Mod,FuncSpec, + tag({'$test_server_framework_test', + FinalNotify})}}, + ct_event:sync_notify(Event), Fun(end_tc, Return) end, @@ -770,44 +787,37 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) -> %% {error,Reason} | {skip,Reason} | {timetrap_timeout,TVal} | %% {testcase_aborted,Reason} | testcase_aborted_or_killed | -%% {'EXIT',Reason} | Other (ignored return value, e.g. 'ok') -tag({STag,Reason}) when STag == skip; STag == skipped -> - case Reason of - {failed,{_,init_per_testcase,_}} -> {auto_skipped,Reason}; - _ -> {skipped,Reason} - end; -tag({auto_skip,Reason}) -> +%% {'EXIT',Reason} | {fail,Reason} | {failed,Reason} | +%% {user_timetrap_error,Reason} | +%% Other (ignored return value, e.g. 'ok') +tag({'$test_server_framework_test',Result}) -> + case tag(Result) of + ok -> Result; + Failure -> Failure + end; +tag({skipped,Reason={failed,{_,init_per_testcase,_}}}) -> {auto_skipped,Reason}; -tag(E = {ETag,_}) when ETag == error; ETag == 'EXIT'; - ETag == timetrap_timeout; - ETag == testcase_aborted -> - {failed,E}; -tag(E = testcase_aborted_or_killed) -> - {failed,E}; -tag(Other) -> - Other. - -tag_cth({skipped,Reason={failed,{_,init_per_testcase,_}}}) -> - {auto_skipped,Reason}; -tag_cth({STag,Reason}) when STag == skip; STag == skipped -> +tag({STag,Reason}) when STag == skip; STag == skipped -> case Reason of {failed,{_,init_per_testcase,_}} -> {auto_skipped,Reason}; _ -> {skipped,Reason} end; -tag_cth({auto_skip,Reason}) -> +tag({auto_skip,Reason}) -> {auto_skipped,Reason}; -tag_cth({fail,Reason}) -> +tag({fail,Reason}) -> {failed,{error,Reason}}; -tag_cth(E = {ETag,_}) when ETag == error; ETag == 'EXIT'; +tag(Failed = {failed,_Reason}) -> + Failed; +tag(E = {ETag,_}) when ETag == error; ETag == 'EXIT'; ETag == timetrap_timeout; ETag == testcase_aborted -> {failed,E}; -tag_cth(E = testcase_aborted_or_killed) -> +tag(E = testcase_aborted_or_killed) -> {failed,E}; -tag_cth(List) when is_list(List) -> - ok; -tag_cth(Other) -> - Other. +tag(UserTimetrap = {user_timetrap_error,_Reason}) -> + UserTimetrap; +tag(_Other) -> + ok. %%%----------------------------------------------------------------- %%% @spec error_notification(Mod,Func,Args,Error) -> ok @@ -841,6 +851,8 @@ error_notification(Mod,Func,_Args,{Error,Loc}) -> io_lib:format("{test_case_failed,~p}", [Reason]); Result -> Result end; + {'EXIT',_Reason} = EXIT -> + io_lib:format("~P", [EXIT,5]); {Spec,_Reason} when is_atom(Spec) -> io_lib:format("~w", [Spec]); Other -> @@ -875,8 +887,8 @@ error_notification(Mod,Func,_Args,{Error,Loc}) -> end, PrintErr = fun(ErrFormat, ErrArgs) -> - Div = "~n- - - - - - - - - - - - - - - - " - "- - - - - - - - - -~n", + Div = "~n- - - - - - - - - - - - - - - - - - - " + "- - - - - - - - - - - - - - - - - - - - -~n", io:format(user, lists:concat([Div,ErrFormat,Div,"~n"]), ErrArgs), Link = @@ -1064,9 +1076,32 @@ get_all_cases1(_, []) -> get_all(Mod, ConfTests) -> case catch apply(Mod, all, []) of - {'EXIT',_} -> - Reason = - list_to_atom(atom_to_list(Mod)++":all/0 is missing"), + {'EXIT',{undef,[{Mod,all,[],_} | _]}} -> + Reason = + case code:which(Mod) of + non_existing -> + list_to_atom(atom_to_list(Mod)++ + " can not be compiled or loaded"); + _ -> + list_to_atom(atom_to_list(Mod)++":all/0 is missing") + end, + %% this makes test_server call error_in_suite as first + %% (and only) test case so we can report Reason properly + [{?MODULE,error_in_suite,[[{error,Reason}]]}]; + {'EXIT',ExitReason} -> + case ct_util:get_testdata({error_in_suite,Mod}) of + undefined -> + ErrStr = io_lib:format("~n*** ERROR *** " + "~w:all/0 failed: ~p~n", + [Mod,ExitReason]), + io:format(user, ErrStr, []), + %% save the error info so it doesn't get printed twice + ct_util:set_testdata_async({{error_in_suite,Mod}, + ExitReason}); + _ExitReason -> + ct_util:delete_testdata({error_in_suite,Mod}) + end, + Reason = list_to_atom(atom_to_list(Mod)++":all/0 failed"), %% this makes test_server call error_in_suite as first %% (and only) test case so we can report Reason properly [{?MODULE,error_in_suite,[[{error,Reason}]]}]; @@ -1289,6 +1324,8 @@ report(What,Data) -> end, ct_logs:unregister_groupleader(ReportingPid), case {Func,Result} of + {error_in_suite,_} when Suite == ?MODULE -> + ok; {init_per_suite,_} -> ok; {end_per_suite,_} -> diff --git a/lib/common_test/src/ct_gen_conn.erl b/lib/common_test/src/ct_gen_conn.erl index 56082086f6..8da10ee0f3 100644 --- a/lib/common_test/src/ct_gen_conn.erl +++ b/lib/common_test/src/ct_gen_conn.erl @@ -24,10 +24,9 @@ -module(ct_gen_conn). --compile(export_all). - --export([start/4, stop/1, get_conn_pid/1]). +-export([start/4, stop/1, get_conn_pid/1, check_opts/1]). -export([call/2, call/3, return/2, do_within_time/2]). +-export([log/3, start_log/1, cont_log/2, end_log/0]). %%---------------------------------------------------------------------- %% Exported types diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 23332ad268..7c8c720e13 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -73,6 +73,8 @@ -define(abs(Name), filename:absname(Name)). +-define(now, os:timestamp()). + -record(log_cache, {version, all_runs = [], tests = []}). @@ -311,7 +313,7 @@ unregister_groupleader(Pid) -> %%% data to log (as in <code>io:format(Format,Args)</code>).</p> log(Heading,Format,Args) -> cast({log,sync,self(),group_leader(),ct_internal,?MAX_IMPORTANCE, - [{int_header(),[log_timestamp(now()),Heading]}, + [{int_header(),[log_timestamp(?now),Heading]}, {Format,Args}, {int_footer(),[]}]}), ok. @@ -333,7 +335,7 @@ log(Heading,Format,Args) -> %%% @see end_log/0 start_log(Heading) -> cast({log,sync,self(),group_leader(),ct_internal,?MAX_IMPORTANCE, - [{int_header(),[log_timestamp(now()),Heading]}]}), + [{int_header(),[log_timestamp(?now),Heading]}]}), ok. %%%----------------------------------------------------------------- @@ -491,11 +493,11 @@ tc_print(Category,Importance,Format,Args) -> get_heading(default) -> io_lib:format("\n-----------------------------" "-----------------------\n~s\n", - [log_timestamp(now())]); + [log_timestamp(?now)]); get_heading(Category) -> io_lib:format("\n-----------------------------" "-----------------------\n~s ~w\n", - [log_timestamp(now()),Category]). + [log_timestamp(?now),Category]). %%%----------------------------------------------------------------- @@ -553,13 +555,13 @@ div_header(Class) -> div_header(Class,"User"). div_header(Class,Printer) -> "\n<div class=\"" ++ atom_to_list(Class) ++ "\"><b>*** " ++ Printer ++ - " " ++ log_timestamp(now()) ++ " ***</b>". + " " ++ log_timestamp(?now) ++ " ***</b>". div_footer() -> "</div>". maybe_log_timestamp() -> - {MS,S,US} = now(), + {MS,S,US} = ?now, case get(log_timestamp) of {MS,S,_} -> ok; @@ -686,7 +688,7 @@ logger(Parent, Mode, Verbosity) -> make_last_run_index(Time), CtLogFd = open_ctlog(?misc_io_log), io:format(CtLogFd,int_header()++int_footer(), - [log_timestamp(now()),"Common Test Logger started"]), + [log_timestamp(?now),"Common Test Logger started"]), Parent ! {started,self(),{Time,filename:absname("")}}, set_evmgr_gl(CtLogFd), @@ -835,7 +837,7 @@ logger_loop(State) -> stop -> io:format(State#logger_state.ct_log_fd, int_header()++int_footer(), - [log_timestamp(now()),"Common Test Logger finished"]), + [log_timestamp(?now),"Common Test Logger finished"]), close_ctlog(State#logger_state.ct_log_fd), ok end. @@ -1905,6 +1907,18 @@ sort_all_runs(Dirs) -> {Date1,HH1,MM1,SS1} > {Date2,HH2,MM2,SS2} end, Dirs). +sort_ct_runs(Dirs) -> + %% Directory naming: <Prefix>.NodeName.Date_Time[/...] + %% Sort on Date_Time string: "YYYY-MM-DD_HH.MM.SS" + lists:sort( + fun(Dir1,Dir2) -> + [SS1,MM1,DateHH1 | _] = + lists:reverse(string:tokens(filename:dirname(Dir1),[$.])), + [SS2,MM2,DateHH2 | _] = + lists:reverse(string:tokens(filename:dirname(Dir2),[$.])), + {DateHH1,MM1,SS1} =< {DateHH2,MM2,SS2} + end, Dirs). + dir_diff_all_runs(Dirs, LogCache) -> case LogCache#log_cache.all_runs of [] -> @@ -2040,6 +2054,13 @@ runentry(Dir, Totals={Node,Label,Logs, ?testname_width-3)), lists:flatten(io_lib:format("~ts...",[Trunc])) end, + TotMissingStr = + if NotBuilt > 0 -> + ["<font color=\"red\">", + integer_to_list(NotBuilt),"</font>"]; + true -> + integer_to_list(NotBuilt) + end, Total = TotSucc+TotFail+AllSkip, A = xhtml(["<td align=center><font size=\"-1\">",Node, "</font></td>\n", @@ -2059,7 +2080,7 @@ runentry(Dir, Totals={Node,Label,Logs, "<td align=right>",TotFailStr,"</td>\n", "<td align=right>",integer_to_list(AllSkip), " (",UserSkipStr,"/",AutoSkipStr,")</td>\n", - "<td align=right>",integer_to_list(NotBuilt),"</td>\n"], + "<td align=right>",TotMissingStr,"</td>\n"], TotalsStr = A++B++C, XHTML = [xhtml("<tr>\n", ["<tr class=\"",odd_or_even(),"\">\n"]), @@ -2217,7 +2238,8 @@ make_all_suites_index(When) when is_atom(When) -> end end, - LogDirs = filelib:wildcard(logdir_prefix()++".*/*"++?logdir_ext), + Wildcard = logdir_prefix()++".*/*"++?logdir_ext, + LogDirs = sort_ct_runs(filelib:wildcard(Wildcard)), LogCacheInfo = get_cache_data(UseCache), diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index b42ff73846..2cdb259899 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -25,6 +25,7 @@ -export([run/1,run/3,run/4]). -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([abort/0,abort/1,progress/0]). @@ -292,6 +293,18 @@ progress() -> call(progress). %%%----------------------------------------------------------------- +%%% @spec get_event_mgr_ref() -> MasterEvMgrRef +%%% MasterEvMgrRef = atom() +%%% +%%% @doc <p>Call this function in order to get a reference to the +%%% CT master event manager. The reference can be used to e.g. +%%% add a user specific event handler while tests are running. +%%% Example: +%%% <c>gen_event:add_handler(ct_master:get_event_mgr_ref(), my_ev_h, [])</c></p> +get_event_mgr_ref() -> + ?CT_MEVMGR_REF. + +%%%----------------------------------------------------------------- %%% @spec basic_html(Bool) -> ok %%% Bool = true | false %%% diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl index 5393097f57..384c1f6863 100644 --- a/lib/common_test/src/ct_master_logs.erl +++ b/lib/common_test/src/ct_master_logs.erl @@ -37,6 +37,8 @@ -define(details_file_name,"details.info"). -define(table_color,"lightblue"). +-define(now, os:timestamp()). + %%%-------------------------------------------------------------------- %%% API %%%-------------------------------------------------------------------- @@ -54,7 +56,7 @@ start(LogDir,Nodes) -> end. log(Heading,Format,Args) -> - cast({log,self(),[{int_header(),[log_timestamp(now()),Heading]}, + cast({log,self(),[{int_header(),[log_timestamp(?now),Heading]}, {Format,Args}, {int_footer(),[]}]}), ok. @@ -132,7 +134,7 @@ init(Parent,LogDir,Nodes) -> atom_to_list(N) ++ " " end,Nodes)), - io:format(CtLogFd,int_header(),[log_timestamp(now()),"Test Nodes\n"]), + io:format(CtLogFd,int_header(),[log_timestamp(?now),"Test Nodes\n"]), io:format(CtLogFd,"~ts\n",[NodeStr]), io:put_chars(CtLogFd,[int_footer(),"\n"]), @@ -189,7 +191,7 @@ loop(State) -> make_all_runs_index(State#state.logdir), io:format(State#state.log_fd, int_header()++int_footer(), - [log_timestamp(now()),"Finished!"]), + [log_timestamp(?now),"Finished!"]), close_ct_master_log(State#state.log_fd), close_nodedir_index(State#state.nodedir_ix_fd), ok diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index 14ee55703f..cca08bd063 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -172,6 +172,7 @@ only_open/2, hello/1, hello/2, + hello/3, close_session/1, close_session/2, kill_session/2, @@ -457,23 +458,35 @@ only_open(KeyOrName, ExtraOpts) -> %%---------------------------------------------------------------------- %% @spec hello(Client) -> Result -%% @equiv hello(Client, infinity) +%% @equiv hello(Client, [], infinity) hello(Client) -> - hello(Client,?DEFAULT_TIMEOUT). + hello(Client,[],?DEFAULT_TIMEOUT). %%---------------------------------------------------------------------- -spec hello(Client,Timeout) -> Result when Client :: handle(), Timeout :: timeout(), Result :: ok | {error,error_reason()}. +%% @spec hello(Client, Timeout) -> Result +%% @equiv hello(Client, [], Timeout) +hello(Client,Timeout) -> + hello(Client,[],Timeout). + +%%---------------------------------------------------------------------- +-spec hello(Client,Options,Timeout) -> Result when + Client :: handle(), + Options :: [{capability, [string()]}], + Timeout :: timeout(), + Result :: ok | {error,error_reason()}. %% @doc Exchange `hello' messages with the server. %% -%% Sends a `hello' message to the server and waits for the return. -%% +%% Adds optional capabilities and sends a `hello' message to the +%% server and waits for the return. %% @end %%---------------------------------------------------------------------- -hello(Client,Timeout) -> - call(Client, {hello, Timeout}). +hello(Client,Options,Timeout) -> + call(Client, {hello, Options, Timeout}). + %%---------------------------------------------------------------------- %% @spec get_session_id(Client) -> Result @@ -794,8 +807,9 @@ action(Client,Action) -> Client :: client(), Action :: simple_xml(), Timeout :: timeout(), - Result :: {ok,[simple_xml()]} | {error,error_reason()}. -%% @doc Execute an action. + Result :: ok | {ok,[simple_xml()]} | {error,error_reason()}. +%% @doc Execute an action. If the return type is void, <c>ok</c> will +%% be returned instead of <c>{ok,[simple_xml()]}</c>. %% %% @end %%---------------------------------------------------------------------- @@ -1074,9 +1088,9 @@ terminate(_, #state{connection=Connection}) -> ok. %% @private -handle_msg({hello,Timeout}, From, +handle_msg({hello, Options, Timeout}, From, #state{connection=Connection,hello_status=HelloStatus} = State) -> - case do_send(Connection, client_hello()) of + case do_send(Connection, client_hello(Options)) of ok -> case HelloStatus of undefined -> @@ -1153,7 +1167,9 @@ handle_msg({Ref,timeout},#state{pending=Pending} = State) -> close_session -> stop; _ -> noreply end, - {R,State#state{pending=Pending1}}. + %% Halfhearted try to get in correct state, this matches + %% the implementation before this patch + {R,State#state{pending=Pending1, buff= <<>>}}. %% @private %% Called by ct_util_server to close registered connections before terminate. @@ -1257,10 +1273,14 @@ set_request_timer(T) -> %%%----------------------------------------------------------------- -client_hello() -> +client_hello(Options) when is_list(Options) -> + UserCaps = [{capability, UserCap} || + {capability, UserCap} <- Options, + is_list(hd(UserCap))], {hello, ?NETCONF_NAMESPACE_ATTR, [{capabilities, - [{capability,[?NETCONF_BASE_CAP++?NETCONF_BASE_CAP_VSN]}]}]}. + [{capability,[?NETCONF_BASE_CAP++?NETCONF_BASE_CAP_VSN]}| + UserCaps]}]}. %%%----------------------------------------------------------------- @@ -1343,72 +1363,54 @@ to_xml_doc(Simple) -> %%%----------------------------------------------------------------- %%% Parse and handle received XML data -handle_data(NewData,#state{connection=Connection,buff=Buff} = State) -> +handle_data(NewData,#state{connection=Connection,buff=Buff0} = State0) -> log(Connection,recv,NewData), - Data = <<Buff/binary,NewData/binary>>, - case xmerl_sax_parser:stream(<<>>, - [{continuation_fun,fun sax_cont/1}, - {continuation_state,{Data,Connection,false}}, - {event_fun,fun sax_event/3}, - {event_state,[]}]) of - {ok, Simple, Rest} -> - decode(Simple,State#state{buff=Rest}); - {fatal_error,_Loc,Reason,_EndTags,_EventState} -> - ?error(Connection#connection.name,[{parse_error,Reason}, - {buffer,Buff}, - {new_data,NewData}]), - case Reason of - {could_not_fetch_data,Msg} -> - handle_msg(Msg,State#state{buff = <<>>}); - _Other -> - Pending1 = - case State#state.pending of - [] -> - []; - Pending -> - %% Assuming the first request gets the - %% first answer - P=#pending{tref=TRef,caller=Caller} = - lists:last(Pending), - _ = timer:cancel(TRef), - Reason1 = {failed_to_parse_received_data,Reason}, - ct_gen_conn:return(Caller,{error,Reason1}), - lists:delete(P,Pending) - end, - {noreply,State#state{pending=Pending1,buff = <<>>}} - end - end. - -%%%----------------------------------------------------------------- -%%% Parsing of XML data -%% Contiuation function for the sax parser -sax_cont(done) -> - {<<>>,done}; -sax_cont({Data,Connection,false}) -> + Data = append_wo_initial_nl(Buff0,NewData), case binary:split(Data,[?END_TAG],[]) of - [All] -> - %% No end tag found. Remove what could be a part - %% of an end tag from the data and save for next - %% iteration - SafeSize = size(All)-5, - <<New:SafeSize/binary,Save:5/binary>> = All, - {New,{Save,Connection,true}}; - [_Msg,_Rest]=Msgs -> - %% We have at least one full message. Any excess data will - %% be returned from xmerl_sax_parser:stream/2 in the Rest - %% parameter. - {list_to_binary(Msgs),done} - end; -sax_cont({Data,Connection,true}) -> - case ssh_receive_data() of - {ok,Bin} -> - log(Connection,recv,Bin), - sax_cont({<<Data/binary,Bin/binary>>,Connection,false}); - {error,Reason} -> - throw({could_not_fetch_data,Reason}) + [_NoEndTagFound] -> + {noreply, State0#state{buff=Data}}; + [FirstMsg,Buff1] -> + SaxArgs = [{event_fun,fun sax_event/3}, {event_state,[]}], + case xmerl_sax_parser:stream(FirstMsg, SaxArgs) of + {ok, Simple, _Thrash} -> + case decode(Simple, State0#state{buff=Buff1}) of + {noreply, #state{buff=Buff} = State} when Buff =/= <<>> -> + %% Recurse if we have more data in buffer + handle_data(<<>>, State); + Other -> + Other + end; + {fatal_error,_Loc,Reason,_EndTags,_EventState} -> + ?error(Connection#connection.name, + [{parse_error,Reason}, + {buffer, Buff0}, + {new_data,NewData}]), + handle_error(Reason, State0#state{buff= <<>>}) + end end. - +%% xml does not accept a leading nl and some netconf server add a nl after +%% each ?END_TAG, ignore them +append_wo_initial_nl(<<>>,NewData) -> NewData; +append_wo_initial_nl(<<"\n", Data/binary>>, NewData) -> + append_wo_initial_nl(Data, NewData); +append_wo_initial_nl(Data, NewData) -> + <<Data/binary, NewData/binary>>. + +handle_error(Reason, State) -> + Pending1 = case State#state.pending of + [] -> []; + Pending -> + %% Assuming the first request gets the + %% first answer + P=#pending{tref=TRef,caller=Caller} = + lists:last(Pending), + _ = timer:cancel(TRef), + Reason1 = {failed_to_parse_received_data,Reason}, + ct_gen_conn:return(Caller,{error,Reason1}), + lists:delete(P,Pending) + end, + {noreply, State#state{pending=Pending1}}. %% Event function for the sax parser. It builds a simple XML structure. %% Care is taken to keep namespace attributes and prefixes as in the original XML. @@ -1606,6 +1608,9 @@ decode_ok(Other) -> decode_data([{Tag,Attrs,Content}]) -> case get_local_name_atom(Tag) of + ok -> + %% when action has return type void + ok; data -> %% Since content of data has nothing from the netconf %% namespace, we remove the parent's xmlns attribute here @@ -1869,16 +1874,6 @@ get_tag([]) -> %%%----------------------------------------------------------------- %%% SSH stuff -ssh_receive_data() -> - receive - {ssh_cm, CM, {data, Ch, _Type, Data}} -> - ssh_connection:adjust_window(CM,Ch,size(Data)), - {ok, Data}; - {ssh_cm, _CM, {Closed, _Ch}} = X when Closed == closed; Closed == eof -> - {error,X}; - {_Ref,timeout} = X -> - {error,X} - end. ssh_open(#options{host=Host,timeout=Timeout,port=Port,ssh=SshOpts,name=Name}) -> case ssh:connect(Host, Port, diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 4a12481214..b37baa9f3e 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -77,7 +77,8 @@ multiply_timetraps = 1, scale_timetraps = false, create_priv_dir, - testspecs = [], + testspec_files = [], + current_testspec, tests, starter}). @@ -225,18 +226,24 @@ finish(Tracing, ExitStatus, Args) -> if ExitStatus == interactive_mode -> interactive_mode; true -> - %% it's possible to tell CT to finish execution with a call - %% to a different function than the normal halt/1 BIF - %% (meant to be used mainly for reading the CT exit status) - case get_start_opt(halt_with, - fun([HaltMod,HaltFunc]) -> - {list_to_atom(HaltMod), - list_to_atom(HaltFunc)} end, - Args) of - undefined -> - halt(ExitStatus); - {M,F} -> - apply(M, F, [ExitStatus]) + case get_start_opt(vts, true, Args) of + true -> + %% VTS mode, don't halt the node + ok; + _ -> + %% it's possible to tell CT to finish execution with a call + %% to a different function than the normal halt/1 BIF + %% (meant to be used mainly for reading the CT exit status) + case get_start_opt(halt_with, + fun([HaltMod,HaltFunc]) -> + {list_to_atom(HaltMod), + list_to_atom(HaltFunc)} end, + Args) of + undefined -> + halt(ExitStatus); + {M,F} -> + apply(M, F, [ExitStatus]) + end end end. @@ -244,7 +251,7 @@ script_start1(Parent, Args) -> %% read general start flags Label = get_start_opt(label, fun([Lbl]) -> Lbl end, Args), Profile = get_start_opt(profile, fun([Prof]) -> Prof end, Args), - Vts = get_start_opt(vts, true, Args), + Vts = get_start_opt(vts, true, undefined, Args), Shell = get_start_opt(shell, true, Args), Cover = get_start_opt(cover, fun([CoverFile]) -> ?abs(CoverFile) end, Args), CoverStop = get_start_opt(cover_stop, @@ -330,8 +337,8 @@ script_start1(Parent, Args) -> Stylesheet = get_start_opt(stylesheet, fun([SS]) -> ?abs(SS) end, Args), %% basic_html - used by ct_logs - BasicHtml = case proplists:get_value(basic_html, Args) of - undefined -> + BasicHtml = case {Vts,proplists:get_value(basic_html, Args)} of + {undefined,undefined} -> application:set_env(common_test, basic_html, false), undefined; _ -> @@ -364,9 +371,10 @@ script_start1(Parent, Args) -> scale_timetraps = ScaleTT, create_priv_dir = CreatePrivDir, starter = script}, - + %% check if log files should be refreshed or go on to run tests... Result = run_or_refresh(Opts, Args), + %% send final results to starting process waiting in script_start/0 Parent ! {self(), Result}. @@ -485,8 +493,11 @@ execute_one_spec(TS, Opts, Args) -> case check_and_install_configfiles(AllConfig, TheLogDir, Opts) of ok -> % read tests from spec {Run,Skip} = ct_testspec:prepare_tests(TS, node()), - do_run(Run, Skip, Opts#opts{config=AllConfig, - logdir=TheLogDir}, Args); + Result = do_run(Run, Skip, Opts#opts{config=AllConfig, + logdir=TheLogDir, + current_testspec=TS}, Args), + ct_util:delete_testdata(testspec), + Result; Error -> Error end. @@ -577,7 +588,7 @@ combine_test_opts(TS, Specs, Opts) -> Opts#opts{label = Label, profile = Profile, - testspecs = Specs, + testspec_files = Specs, cover = Cover, cover_stop = CoverStop, logdir = which(logdir, LogDir), @@ -702,7 +713,7 @@ script_start4(#opts{label = Label, profile = Profile, logopts = LogOpts, verbosity = Verbosity, enable_builtin_hooks = EnableBuiltinHooks, - logdir = LogDir, testspecs = Specs}, _Args) -> + logdir = LogDir, testspec_files = Specs}, _Args) -> %% label - used by ct_logs application:set_env(common_test, test_label, Label), @@ -757,21 +768,6 @@ script_start4(Opts = #opts{tests = Tests}, Args) -> %%% @doc Print usage information for <code>ct_run</code>. script_usage() -> io:format("\n\nUsage:\n\n"), - io:format("Run tests in web based GUI:\n\n" - "\tct_run -vts [-browser Browser]" - "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" - "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]" - "\n\t[-dir TestDir1 TestDir2 .. TestDirN] |" - "\n\t[-suite Suite [-case Case]]" - "\n\t[-logopts LogOpt1 LogOpt2 .. LogOptN]" - "\n\t[-verbosity GenVLvl | [CategoryVLvl1 .. CategoryVLvlN]]" - "\n\t[-include InclDir1 InclDir2 .. InclDirN]" - "\n\t[-no_auto_compile]" - "\n\t[-abort_if_missing_suites]" - "\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"), io:format("Run tests from command line:\n\n" "\tct_run [-dir TestDir1 TestDir2 .. TestDirN] |" "\n\t[[-dir TestDir] -suite Suite1 Suite2 .. SuiteN" @@ -831,7 +827,22 @@ script_usage() -> io:format("Run CT in interactive mode:\n\n" "\tct_run -shell" "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" - "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]\n\n"). + "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]\n\n"), + io:format("Run tests in web based GUI:\n\n" + "\tct_run -vts [-browser Browser]" + "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" + "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]" + "\n\t[-dir TestDir1 TestDir2 .. TestDirN] |" + "\n\t[-suite Suite [-case Case]]" + "\n\t[-logopts LogOpt1 LogOpt2 .. LogOptN]" + "\n\t[-verbosity GenVLvl | [CategoryVLvl1 .. CategoryVLvlN]]" + "\n\t[-include InclDir1 InclDir2 .. InclDirN]" + "\n\t[-no_auto_compile]" + "\n\t[-abort_if_missing_suites]" + "\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"). %%%----------------------------------------------------------------- %%% @hidden @@ -1103,7 +1114,7 @@ run_test2(StartOpts) -> undefined -> case lists:keysearch(prepared_tests, 1, StartOpts) of {value,{_,{Run,Skip},Specs}} -> % use prepared tests - run_prepared(Run, Skip, Opts#opts{testspecs = Specs}, + run_prepared(Run, Skip, Opts#opts{testspec_files = Specs}, StartOpts); false -> run_dir(Opts, StartOpts) @@ -1111,11 +1122,11 @@ run_test2(StartOpts) -> Specs -> Relaxed = get_start_opt(allow_user_terms, value, false, StartOpts), %% using testspec(s) as input for test - run_spec_file(Relaxed, Opts#opts{testspecs = Specs}, StartOpts) + run_spec_file(Relaxed, Opts#opts{testspec_files = Specs}, StartOpts) end. run_spec_file(Relaxed, - Opts = #opts{testspecs = Specs}, + Opts = #opts{testspec_files = Specs}, StartOpts) -> Specs1 = case Specs of [X|_] when is_integer(X) -> [Specs]; @@ -1154,7 +1165,10 @@ run_all_specs([{Specs,TS} | TSs], Opts, StartOpts, TotResult) -> log_ts_names(Specs), Combined = #opts{config = TSConfig} = combine_test_opts(TS, Specs, Opts), AllConfig = merge_vals([Opts#opts.config, TSConfig]), - try run_one_spec(TS, Combined#opts{config = AllConfig}, StartOpts) of + try run_one_spec(TS, + Combined#opts{config = AllConfig, + current_testspec=TS}, + StartOpts) of Result -> run_all_specs(TSs, Opts, StartOpts, [Result | TotResult]) catch @@ -1399,7 +1413,7 @@ run_testspec2(TestSpec) -> case check_and_install_configfiles( Opts#opts.config, LogDir1, Opts) of ok -> - Opts1 = Opts#opts{testspecs = [], + Opts1 = Opts#opts{testspec_files = [], logdir = LogDir1, include = AllInclude}, {Run,Skip} = ct_testspec:prepare_tests(TS, node()), @@ -1706,6 +1720,9 @@ compile_and_run(Tests, Skip, Opts, Args) -> ct_util:set_testdata({stylesheet,Opts#opts.stylesheet}), %% save logopts ct_util:set_testdata({logopts,Opts#opts.logopts}), + %% save info about current testspec (testspec record or undefined) + ct_util:set_testdata({testspec,Opts#opts.current_testspec}), + %% enable silent connections case Opts#opts.silent_connections of [] -> @@ -1720,7 +1737,7 @@ compile_and_run(Tests, Skip, Opts, Args) -> ct_logs:log("Silent connections", "~p", [Conns]) end end, - log_ts_names(Opts#opts.testspecs), + log_ts_names(Opts#opts.testspec_files), TestSuites = suite_tuples(Tests), {_TestSuites1,SuiteMakeErrors,AllMakeErrors} = @@ -1969,22 +1986,7 @@ final_tests(Tests, Skip, Bad) -> final_tests1([{TestDir,Suites,_}|Tests], Final, Skip, Bad) when is_list(Suites), is_atom(hd(Suites)) -> -% Separate = -% fun(S,{DoSuite,Dont}) -> -% case lists:keymember({TestDir,S},1,Bad) of -% false -> -% {[S|DoSuite],Dont}; -% true -> -% SkipIt = {TestDir,S,"Make failed"}, -% {DoSuite,Dont++[SkipIt]} -% end -% end, - -% {DoSuites,Skip1} = -% lists:foldl(Separate,{[],Skip},Suites), -% Do = {TestDir,lists:reverse(DoSuites),all}, - - Skip1 = [{TD,S,"Make failed"} || {{TD,S},_} <- Bad, S1 <- Suites, + Skip1 = [{TD,S,make_failed} || {{TD,S},_} <- Bad, S1 <- Suites, S == S1, TD == TestDir], Final1 = [{TestDir,S,all} || S <- Suites], final_tests1(Tests, lists:reverse(Final1)++Final, Skip++Skip1, Bad); @@ -1997,7 +1999,7 @@ final_tests1([{TestDir,all,all}|Tests], Final, Skip, Bad) -> false -> [] end, - Missing = [{TestDir,S,"Make failed"} || S <- MissingSuites], + Missing = [{TestDir,S,make_failed} || S <- MissingSuites], Final1 = [{TestDir,all,all}|Final], final_tests1(Tests, Final1, Skip++Missing, Bad); @@ -2009,7 +2011,7 @@ final_tests1([{TestDir,Suite,GrsOrCs}|Tests], Final, Skip, Bad) when is_list(GrsOrCs) -> case lists:keymember({TestDir,Suite}, 1, Bad) of true -> - Skip1 = Skip ++ [{TestDir,Suite,all,"Make failed"}], + Skip1 = Skip ++ [{TestDir,Suite,all,make_failed}], final_tests1(Tests, [{TestDir,Suite,all}|Final], Skip1, Bad); false -> GrsOrCs1 = diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index 4e03bf8630..b14731e74f 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -29,7 +29,9 @@ %% Command timeout = 10 sec (time to wait for a command to return) %% Max no of reconnection attempts = 3 %% Reconnection interval = 5 sek (time to wait in between reconnection attempts) -%% Keep alive = true (will send NOP to the server every 10 sec if connection is idle)</pre> +%% Keep alive = true (will send NOP to the server every 8 sec if connection is idle) +%% Polling limit = 0 (max number of times to poll to get a remaining string terminated) +%% Polling interval = 1 sec (sleep time between polls)</pre> %% <p>These parameters can be altered by the user with the following %% configuration term:</p> %% <pre> @@ -37,7 +39,9 @@ %% {command_timeout,Millisec}, %% {reconnection_attempts,N}, %% {reconnection_interval,Millisec}, -%% {keep_alive,Bool}]}.</pre> +%% {keep_alive,Bool}, +%% {poll_limit,N}, +%% {poll_interval,Millisec}]}.</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 @@ -156,6 +160,8 @@ -define(RECONN_TIMEOUT,5000). -define(DEFAULT_TIMEOUT,10000). -define(DEFAULT_PORT,23). +-define(POLL_LIMIT,0). +-define(POLL_INTERVAL,1000). -include("ct_util.hrl"). @@ -169,6 +175,8 @@ type, target_mod, keep_alive, + poll_limit=?POLL_LIMIT, + poll_interval=?POLL_INTERVAL, extra, conn_to=?DEFAULT_TIMEOUT, com_to=?DEFAULT_TIMEOUT, @@ -379,8 +387,15 @@ cmdf(Connection,CmdFormat,Args,Opts) when is_list(Args) -> %%% Connection = ct_telnet:connection() %%% Data = [string()] %%% Reason = term() -%%% @doc Get all data which has been received by the telnet client -%%% since last command was sent. +%%% @doc Get all data that has been received by the telnet client +%%% since the last command was sent. Note that only newline terminated +%%% strings are returned. If the last string received has not yet +%%% been terminated, the connection may be polled automatically until +%%% the string is complete. The polling feature is controlled +%%% by the `poll_limit' and `poll_interval' config values and is +%%% by default disabled (meaning the function will immediately +%%% return all complete strings received and save a remaining +%%% non-terminated string for a later `get_data' call). get_data(Connection) -> case get_handle(Connection) of {ok,Pid} -> @@ -471,7 +486,8 @@ expect(Connection,Patterns) -> %%% Opts = [Opt] %%% Opt = {idle_timeout,IdleTimeout} | {total_timeout,TotalTimeout} | %%% repeat | {repeat,N} | sequence | {halt,HaltPatterns} | -%%% ignore_prompt | no_prompt_check +%%% ignore_prompt | no_prompt_check | wait_for_prompt | +%%% {wait_for_prompt,Prompt} %%% IdleTimeout = infinity | integer() %%% TotalTimeout = infinity | integer() %%% N = integer() @@ -484,9 +500,9 @@ expect(Connection,Patterns) -> %%% %%% @doc Get data from telnet and wait for the expected pattern. %%% -%%% <p><code>Pattern</code> can be a POSIX regular expression. If more -%%% than one pattern is given, the function returns when the first -%%% match is found.</p> +%%% <p><code>Pattern</code> can be a POSIX regular expression. The function +%%% returns as soon as a pattern has been successfully matched (at least one, +%%% in the case of multiple patterns).</p> %%% %%% <p><code>RxMatch</code> is a list of matched strings. It looks %%% like this: <code>[FullMatch, SubMatch1, SubMatch2, ...]</code> @@ -509,10 +525,13 @@ expect(Connection,Patterns) -> %%% milliseconds, <code>{error,timeout}</code> is returned. The default %%% value is <code>infinity</code> (i.e. no time limit).</p> %%% -%%% <p>The function will always return when a prompt is found, unless -%%% any of the <code>ignore_prompt</code> or -%%% <code>no_prompt_check</code> options are used, in which case it -%%% will return when a match is found or after a timeout.</p> +%%% <p>The function will return when a prompt is received, even if no +%%% pattern has yet been matched. In this event, +%%% <code>{error,{prompt,Prompt}}</code> is returned. +%%% However, this behaviour may be modified with the +%%% <code>ignore_prompt</code> or <code>no_prompt_check</code> option, which +%%% tells <code>expect</code> to return only when a match is found or after a +%%% timeout.</p> %%% %%% <p>If the <code>ignore_prompt</code> option is used, %%% <code>ct_telnet</code> will ignore any prompt found. This option @@ -526,6 +545,13 @@ expect(Connection,Patterns) -> %%% is useful if, for instance, the <code>Pattern</code> itself %%% matches the prompt.</p> %%% +%%% <p>The <code>wait_for_prompt</code> option forces <code>ct_telnet</code> +%%% to wait until the prompt string has been received before returning +%%% (even if a pattern has already been matched). This is equal to calling: +%%% <code>expect(Conn, Patterns++[{prompt,Prompt}], [sequence|Opts])</code>. +%%% Note that <code>idle_timeout</code> and <code>total_timeout</code> +%%% may abort the operation of waiting for prompt.</p> +%%% %%% <p>The <code>repeat</code> option indicates that the pattern(s) %%% shall be matched multiple times. If <code>N</code> is given, the %%% pattern(s) will be matched <code>N</code> times, and the function @@ -596,9 +622,12 @@ init(Name,{Ip,Port,Type},{TargetMod,KeepAlive,Extra}) -> "Reconnection attempts: ~p\n" "Reconnection interval: ~p\n" "Connection timeout: ~p\n" - "Keep alive: ~w", + "Keep alive: ~w\n" + "Poll limit: ~w\n" + "Poll interval: ~w", [Ip,Port,S1#state.com_to,S1#state.reconns, - S1#state.reconn_int,S1#state.conn_to,KeepAlive]), + S1#state.reconn_int,S1#state.conn_to,KeepAlive, + S1#state.poll_limit,S1#state.poll_interval]), {ok,TelnPid,S1}; {'EXIT',Reason} -> {error,Reason}; @@ -619,6 +648,10 @@ set_telnet_defaults([{reconnection_interval,RInt}|Ss],S) -> set_telnet_defaults(Ss,S#state{reconn_int=RInt}); set_telnet_defaults([{keep_alive,_}|Ss],S) -> set_telnet_defaults(Ss,S); +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([Unknown|Ss],S) -> force_log(S,error, "Bad element in telnet_settings: ~p",[Unknown]), @@ -631,18 +664,21 @@ handle_msg({cmd,Cmd,Opts},State) -> start_gen_log(heading(cmd,State#state.name)), log(State,cmd,"Cmd: ~p",[Cmd]), + %% whatever is in the buffer from previous operations + %% will be ignored as we go ahead with this telnet cmd + debug_cont_gen_log("Throwing Buffer:",[]), debug_log_lines(State#state.buffer), case {State#state.type,State#state.prompt} of - {ts,_} -> + {ts,_} -> silent_teln_expect(State#state.name, State#state.teln_pid, State#state.buffer, prompt, State#state.prx, [{idle_timeout,2000}]); - {ip,false} -> + {ip,false} -> silent_teln_expect(State#state.name, State#state.teln_pid, State#state.buffer, @@ -706,10 +742,8 @@ handle_msg({send,Cmd,Opts},State) -> handle_msg(get_data,State) -> start_gen_log(heading(get_data,State#state.name)), log(State,cmd,"Reading data...",[]), - {ok,Data,Buffer} = teln_get_all_data(State#state.teln_pid, - State#state.prx, - State#state.buffer, - [],[]), + {ok,Data,Buffer} = teln_get_all_data(State,State#state.buffer,[],[], + State#state.poll_limit), log(State,recv,"Return: ~p",[{ok,Data}]), end_gen_log(), {{ok,Data},State#state{buffer=Buffer}}; @@ -944,16 +978,25 @@ teln_cmd(Pid,Cmd,Prx,Newline,Timeout) -> ct_telnet_client:send_data(Pid,Cmd,Newline), teln_receive_until_prompt(Pid,Prx,Timeout). -teln_get_all_data(Pid,Prx,Data,Acc,LastLine) -> +teln_get_all_data(State=#state{teln_pid=Pid,prx=Prx},Data,Acc,LastLine,Polls) -> case check_for_prompt(Prx,LastLine++Data) of {prompt,Lines,_PromptType,Rest} -> - teln_get_all_data(Pid,Prx,Rest,[Lines|Acc],[]); + teln_get_all_data(State,Rest,[Lines|Acc],[],State#state.poll_limit); {noprompt,Lines,LastLine1} -> case ct_telnet_client:get_data(Pid) of + {ok,[]} when LastLine1 /= [], Polls > 0 -> + %% No more data from server but the last string is not + %% a complete line (maybe because of a slow connection), + timer:sleep(State#state.poll_interval), + NewPolls = if Polls == infinity -> infinity; + true -> Polls-1 + end, + teln_get_all_data(State,[],[Lines|Acc],LastLine1,NewPolls); {ok,[]} -> {ok,lists:reverse(lists:append([Lines|Acc])),LastLine1}; {ok,Data1} -> - teln_get_all_data(Pid,Prx,Data1,[Lines|Acc],LastLine1) + teln_get_all_data(State,Data1,[Lines|Acc],LastLine1, + State#state.poll_limit) end end. @@ -978,7 +1021,7 @@ silent_teln_expect(Name,Pid,Data,Pattern,Prx,Opts) -> put(silent,Old), Result. -%% teln_expect/5 +%% teln_expect/6 %% %% This function implements the expect functionality over telnet. In %% general there are three possible ways to go: @@ -1000,10 +1043,12 @@ teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) -> end, PromptCheck = get_prompt_check(Opts), - Seq = get_seq(Opts), - Pattern = convert_pattern(Pattern0,Seq), - {IdleTimeout,TotalTimeout} = get_timeouts(Opts), + {WaitForPrompt,Pattern1,Opts1} = wait_for_prompt(Pattern0,Opts), + + Seq = get_seq(Opts1), + Pattern2 = convert_pattern(Pattern1,Seq), + {IdleTimeout,TotalTimeout} = get_timeouts(Opts1), EO = #eo{teln_pid=Pid, prx=Prx, @@ -1013,9 +1058,16 @@ teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) -> haltpatterns=HaltPatterns, prompt_check=PromptCheck}, - case get_repeat(Opts) of + case get_repeat(Opts1) of false -> - case teln_expect1(Name,Pid,Data,Pattern,[],EO) of + case teln_expect1(Name,Pid,Data,Pattern2,[],EO) of + {ok,Matched,Rest} when WaitForPrompt -> + case lists:reverse(Matched) of + [{prompt,_},Matched1] -> + {ok,Matched1,Rest}; + [{prompt,_}|Matched1] -> + {ok,lists:reverse(Matched1),Rest} + end; {ok,Matched,Rest} -> {ok,Matched,Rest}; {halt,Why,Rest} -> @@ -1025,7 +1077,7 @@ teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) -> end; N -> EO1 = EO#eo{repeat=N}, - repeat_expect(Name,Pid,Data,Pattern,[],EO1) + repeat_expect(Name,Pid,Data,Pattern2,[],EO1) end. convert_pattern(Pattern,Seq) @@ -1089,6 +1141,40 @@ get_ignore_prompt(Opts) -> get_prompt_check(Opts) -> not lists:member(no_prompt_check,Opts). +wait_for_prompt(Pattern, Opts) -> + case lists:member(wait_for_prompt, Opts) of + true -> + wait_for_prompt1(prompt, Pattern, + lists:delete(wait_for_prompt,Opts)); + false -> + case proplists:get_value(wait_for_prompt, Opts) of + undefined -> + {false,Pattern,Opts}; + PromptStr -> + wait_for_prompt1({prompt,PromptStr}, Pattern, + proplists:delete(wait_for_prompt,Opts)) + end + end. + +wait_for_prompt1(Prompt, [Ch|_] = Pattern, Opts) when is_integer(Ch) -> + wait_for_prompt2(Prompt, [Pattern], Opts); +wait_for_prompt1(Prompt, Pattern, Opts) when is_list(Pattern) -> + wait_for_prompt2(Prompt, Pattern, Opts); +wait_for_prompt1(Prompt, Pattern, Opts) -> + wait_for_prompt2(Prompt, [Pattern], Opts). + +wait_for_prompt2(Prompt, Pattern, Opts) -> + Pattern1 = case lists:reverse(Pattern) of + [prompt|_] -> Pattern; + [{prompt,_}|_] -> Pattern; + _ -> Pattern ++ [Prompt] + end, + Opts1 = case lists:member(sequence, Opts) of + true -> Opts; + false -> [sequence|Opts] + end, + {true,Pattern1,Opts1}. + %% Repeat either single or sequence. All match results are accumulated %% and returned when a halt condition is fulllfilled. repeat_expect(_Name,_Pid,Rest,_Pattern,Acc,#eo{repeat=0}) -> @@ -1106,12 +1192,18 @@ repeat_expect(Name,Pid,Data,Pattern,Acc,EO) -> teln_expect1(Name,Pid,Data,Pattern,Acc,EO=#eo{idle_timeout=IdleTO, total_timeout=TotalTO}) -> - ExpectFun = case EO#eo.seq of + %% TotalTO is a float value in this loop (unless it's 'infinity'), + %% but an integer value will be passed to the other functions + EOMod = if TotalTO /= infinity -> EO#eo{total_timeout=trunc(TotalTO)}; + true -> EO + end, + + ExpectFun = case EOMod#eo.seq of true -> fun() -> - seq_expect(Name,Pid,Data,Pattern,Acc,EO) + seq_expect(Name,Pid,Data,Pattern,Acc,EOMod) end; false -> fun() -> - one_expect(Name,Pid,Data,Pattern,EO) + one_expect(Name,Pid,Data,Pattern,EOMod) end end, case ExpectFun() of @@ -1121,9 +1213,14 @@ teln_expect1(Name,Pid,Data,Pattern,Acc,EO=#eo{idle_timeout=IdleTO, {halt,Why,Rest}; NotFinished -> %% Get more data - Fun = fun() -> get_data1(EO#eo.teln_pid) end, - BreakAfter = if TotalTO < IdleTO -> TotalTO; true -> IdleTO end, - case timer:tc(ct_gen_conn, do_within_time, [Fun, BreakAfter]) of + Fun = fun() -> get_data1(EOMod#eo.teln_pid) end, + BreakAfter = if TotalTO < IdleTO -> + %% use the integer value + EOMod#eo.total_timeout; + true -> + IdleTO + end, + case timer:tc(ct_gen_conn, do_within_time, [Fun,BreakAfter]) of {_,{error,Reason}} -> %% A timeout will occur when the telnet connection %% is idle for EO#eo.idle_timeout milliseconds. @@ -1132,13 +1229,15 @@ teln_expect1(Name,Pid,Data,Pattern,Acc,EO=#eo{idle_timeout=IdleTO, case NotFinished of {nomatch,Rest} -> %% One expect - teln_expect1(Name,Pid,Rest++Data1,Pattern,[],EO); + teln_expect1(Name,Pid,Rest++Data1, + Pattern,[],EOMod); {continue,Patterns1,Acc1,Rest} -> %% Sequence - teln_expect1(Name,Pid,Rest++Data1,Patterns1,Acc1,EO) + teln_expect1(Name,Pid,Rest++Data1, + Patterns1,Acc1,EOMod) end; {Elapsed,{ok,Data1}} -> - TVal = trunc(TotalTO - (Elapsed/1000)), + TVal = TotalTO - (Elapsed/1000), if TVal =< 0 -> {error,timeout}; true -> @@ -1146,10 +1245,12 @@ teln_expect1(Name,Pid,Data,Pattern,Acc,EO=#eo{idle_timeout=IdleTO, case NotFinished of {nomatch,Rest} -> %% One expect - teln_expect1(Name,Pid,Rest++Data1,Pattern,[],EO1); + teln_expect1(Name,Pid,Rest++Data1, + Pattern,[],EO1); {continue,Patterns1,Acc1,Rest} -> %% Sequence - teln_expect1(Name,Pid,Rest++Data1,Patterns1,Acc1,EO1) + teln_expect1(Name,Pid,Rest++Data1, + Patterns1,Acc1,EO1) end end end @@ -1166,7 +1267,7 @@ get_data1(Pid) -> %% 1) Single expect. %% First the whole data chunk is searched for a prompt (to avoid doing %% a regexp match for the prompt at each line). -%% If we are searching for anyting else, the datachunk is split into +%% If we are searching for anything else, the datachunk is split into %% lines and each line is matched against each pattern. %% one_expect: split data chunk at prompts @@ -1183,7 +1284,7 @@ one_expect(Name,Pid,Data,Pattern,EO) -> log(name_or_pid(Name,Pid),"PROMPT: ~ts",[PromptType]), {match,{prompt,PromptType},Rest}; [{prompt,_OtherPromptType}] -> - %% Only searching for one specific prompt, not thisone + %% Only searching for one specific prompt, not this one log_lines(Name,Pid,UptoPrompt), {nomatch,Rest}; _ -> @@ -1430,8 +1531,10 @@ check_for_prompt(Prx,Data) -> split_lines(String) -> split_lines(String,[],[]). -split_lines([$\n|Rest],Line,Lines) -> +split_lines([$\n|Rest],Line,Lines) when Line /= [] -> split_lines(Rest,[],[lists:reverse(Line)|Lines]); +split_lines([$\n|Rest],[],Lines) -> + split_lines(Rest,[],Lines); split_lines([$\r|Rest],Line,Lines) -> split_lines(Rest,Line,Lines); split_lines([0|Rest],Line,Lines) -> diff --git a/lib/common_test/src/ct_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl index 36d33522a3..757ccc0aae 100644 --- a/lib/common_test/src/ct_telnet_client.erl +++ b/lib/common_test/src/ct_telnet_client.erl @@ -32,14 +32,14 @@ -module(ct_telnet_client). -%% -define(debug, true). +%%-define(debug, true). -export([open/2, open/3, open/4, open/5, close/1]). -export([send_data/2, send_data/3, get_data/1]). -define(TELNET_PORT, 23). -define(OPEN_TIMEOUT,10000). --define(IDLE_TIMEOUT,10000). +-define(IDLE_TIMEOUT,8000). %% telnet control characters -define(SE, 240). @@ -111,11 +111,10 @@ get_data(Pid) -> {ok,Data} end. - %%%----------------------------------------------------------------- %%% Internal functions init(Parent, Server, Port, Timeout, KeepAlive, ConnName) -> - case gen_tcp:connect(Server, Port, [list,{packet,0}], Timeout) of + case gen_tcp:connect(Server, Port, [list,{packet,0},{nodelay,true}], Timeout) of {ok,Sock} -> dbg("~p connected to: ~p (port: ~w, keep_alive: ~w)\n", [ConnName,Server,Port,KeepAlive]), @@ -146,7 +145,7 @@ loop(State, Sock, Acc) -> ok end; {tcp,_,Msg0} -> - dbg("tcp msg: ~tp~n",[Msg0]), + dbg("rcv tcp msg: ~tp~n",[Msg0]), Msg = check_msg(Sock,Msg0,[]), loop(State, Sock, [Msg | Acc]); {send_data,Data} -> @@ -180,6 +179,7 @@ loop(State, Sock, Acc) -> NewState = case State of #state{keep_alive = true, get_data = 0} -> + dbg("sending NOP\n",[]), if Acc == [] -> send([?IAC,?NOP], Sock, State#state.conn_name); true -> ok @@ -225,15 +225,17 @@ loop(State, Sock, Acc) -> gen_tcp:close(Sock), Pid ! closed after wait(State#state.keep_alive,?IDLE_TIMEOUT) -> + dbg("idle timeout\n",[]), Data = lists:reverse(lists:append(Acc)), case Data of [] -> + dbg("sending NOP\n",[]), send([?IAC,?NOP], Sock, State#state.conn_name), loop(State, Sock, Acc); _ when State#state.log_pos == length(Data)+1 -> loop(State, Sock, Acc); _ -> - dbg("Idle timeout, printing ~tp\n",[Data]), + dbg("idle timeout, printing ~tp\n",[Data]), Len = length(Data), ct_telnet:log(State#state.conn_name, general_io, "~ts", @@ -391,7 +393,7 @@ cmd_dbg(Prefix,Cmd) -> end. timestamp() -> - {MS,S,US} = now(), + {MS,S,US} = os:timestamp(), {{Year,Month,Day}, {Hour,Min,Sec}} = calendar:now_to_local_time({MS,S,US}), MilliSec = trunc(US/1000), diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index 10a9bdac67..10c3f2a938 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -27,6 +27,8 @@ collect_tests_from_list/2, collect_tests_from_list/3, collect_tests_from_file/2, collect_tests_from_file/3]). +-export([testspec_rec2list/1, testspec_rec2list/2]). + -include("ct_util.hrl"). -define(testspec_fields, record_info(fields, testspec)). @@ -973,7 +975,8 @@ add_tests([Term={Tag,all_nodes,Data}|Ts],Spec) -> should_be_added(Tag,Node,Data,Spec)], add_tests(Tests++Ts,Spec); invalid -> % ignore term - add_tests(Ts,Spec) + Unknown = Spec#testspec.unknown, + add_tests(Ts,Spec#testspec{unknown=Unknown++[Term]}) end; %% create one test entry per node in Nodes and reinsert add_tests([{Tag,[],Data}|Ts],Spec) -> @@ -1001,7 +1004,8 @@ add_tests([Term={Tag,NodeOrOther,Data}|Ts],Spec) -> handle_data(Tag,Node,Data,Spec), add_tests(Ts,mod_field(Spec,Tag,NodeIxData)); invalid -> % ignore term - add_tests(Ts,Spec) + Unknown = Spec#testspec.unknown, + add_tests(Ts,Spec#testspec{unknown=Unknown++[Term]}) end; false -> add_tests([{Tag,all_nodes,{NodeOrOther,Data}}|Ts],Spec) @@ -1012,13 +1016,15 @@ add_tests([Term={Tag,Data}|Ts],Spec) -> valid -> add_tests([{Tag,all_nodes,Data}|Ts],Spec); invalid -> - add_tests(Ts,Spec) + Unknown = Spec#testspec.unknown, + add_tests(Ts,Spec#testspec{unknown=Unknown++[Term]}) end; %% some other data than a tuple add_tests([Other|Ts],Spec) -> case get(relaxed) of - true -> - add_tests(Ts,Spec); + true -> + Unknown = Spec#testspec.unknown, + add_tests(Ts,Spec#testspec{unknown=Unknown++[Other]}); false -> throw({error,{undefined_term_in_spec,Other}}) end; @@ -1149,6 +1155,24 @@ per_node([N|Ns],Tag,Data,Refs) -> per_node([],_,_,_) -> []. +%% Change the testspec record "back" to a list of tuples +testspec_rec2list(Rec) -> + {Terms,_} = lists:mapfoldl(fun(unknown, Pos) -> + {element(Pos, Rec),Pos+1}; + (F, Pos) -> + {{F,element(Pos, Rec)},Pos+1} + end,2,?testspec_fields), + lists:flatten(Terms). + +%% Extract one or more values from a testspec record and +%% return the result as a list of tuples +testspec_rec2list(Field, Rec) when is_atom(Field) -> + [Term] = testspec_rec2list([Field], Rec), + Term; +testspec_rec2list(Fields, Rec) -> + Terms = testspec_rec2list(Rec), + [{Field,proplists:get_value(Field, Terms)} || Field <- Fields]. + %% read the value for FieldName in record Rec#testspec read_field(Rec, FieldName) -> catch lists:foldl(fun(F, Pos) when F == FieldName -> diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index 845bb55486..f4cf407856 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -55,6 +55,7 @@ create_priv_dir=[], alias=[], tests=[], + unknown=[], merge_tests=true}). -record(cover, {app=none, diff --git a/lib/common_test/src/ct_webtool.erl b/lib/common_test/src/ct_webtool.erl new file mode 100644 index 0000000000..b67a7c2a92 --- /dev/null +++ b/lib/common_test/src/ct_webtool.erl @@ -0,0 +1,1207 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(ct_webtool). +-behaviour(gen_server). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% The general idea is: %% +%% %% +%% %% +%% 1. Scan through the path for *.tool files and find all the web %% +%% based tools. Query each tool for configuration data. %% +%% 2. Add Alias for Erlscript and html for each tool to %% +%% the webserver configuration data. %% +%% 3. Start the webserver. %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% API functions +-export([start/0, start/2, stop/0]). + +%% Starting Webtool from a shell script +-export([script_start/0, script_start/1]). + +%% Web api +-export([started_tools/2, toolbar/2, start_tools/2, stop_tools/2]). + +%% API against other tools +-export([is_localhost/0]). + +%% Debug export s +-export([get_tools1/1]). +-export([debug/1, stop_debug/0, debug_app/1]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-include_lib("kernel/include/file.hrl"). +-include_lib("stdlib/include/ms_transform.hrl"). + +-record(state,{priv_dir,app_data,supvis,web_data,started=[]}). + +-define(MAX_NUMBER_OF_WEBTOOLS,256). +-define(DEFAULT_PORT,8888).% must be >1024 or the user must be root on unix +-define(DEFAULT_ADDR,{127,0,0,1}). + +-define(WEBTOOL_ALIAS,{ct_webtool,[{alias,{erl_alias,"/ct_webtool",[ct_webtool]}}]}). +-define(HEADER,"Pragma:no-cache\r\n Content-type: text/html\r\n\r\n"). +-define(HTML_HEADER,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool</TITLE>\r\n</HEAD>\r\n<BODY BGCOLOR=\"#FFFFFF\">\r\n"). +-define(HTML_HEADER_RELOAD,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool + </TITLE>\r\n</HEAD>\r\n + <BODY BGCOLOR=\"#FFFFFF\" onLoad=reloadCompiledList()>\r\n"). + +-define(HTML_END,"</BODY></HTML>"). + +-define(SEND_URL_TIMEOUT,5000). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% For debugging only. %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Start tracing with +%% debug(Functions). +%% Functions = local | global | FunctionList +%% FunctionList = [Function] +%% Function = {FunctionName,Arity} | FunctionName | +%% {Module, FunctionName, Arity} | {Module,FunctionName} +debug(F) -> + ttb:tracer(all,[{file,"webtool.trc"}]), % tracing all nodes + ttb:p(all,[call,timestamp]), + MS = [{'_',[],[{return_trace},{message,{caller}}]}], + tp(F,MS), + ttb:ctp(?MODULE,stop_debug), % don't want tracing of the stop_debug func + ok. +tp(local,MS) -> % all functions + ttb:tpl(?MODULE,MS); +tp(global,MS) -> % all exported functions + ttb:tp(?MODULE,MS); +tp([{M,F,A}|T],MS) -> % Other module + ttb:tpl(M,F,A,MS), + tp(T,MS); +tp([{M,F}|T],MS) when is_atom(F) -> % Other module + ttb:tpl(M,F,MS), + tp(T,MS); +tp([{F,A}|T],MS) -> % function/arity + ttb:tpl(?MODULE,F,A,MS), + tp(T,MS); +tp([F|T],MS) -> % function + ttb:tpl(?MODULE,F,MS), + tp(T,MS); +tp([],_MS) -> + ok. +stop_debug() -> + ttb:stop([format]). + +debug_app(Mod) -> + ttb:tracer(all,[{file,"webtool_app.trc"},{handler,{fun out/4,true}}]), + ttb:p(all,[call,timestamp]), + MS = [{'_',[],[{return_trace},{message,{caller}}]}], + ttb:tp(Mod,MS), + ok. + +out(_,{trace_ts,Pid,call,MFA={M,F,A},{W,_,_},TS},_,S) + when W==webtool;W==mod_esi-> + io:format("~w: (~p)~ncall ~s~n", [TS,Pid,ffunc(MFA)]), + [{M,F,length(A)}|S]; +out(_,{trace_ts,Pid,return_from,MFA,R,TS},_,[MFA|S]) -> + io:format("~w: (~p)~nreturned from ~s -> ~p~n", [TS,Pid,ffunc(MFA),R]), + S; +out(_,_,_,_) -> + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Functions called via script. %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +script_start() -> + usage(), + halt(). +script_start([App]) -> + DefaultBrowser = + case os:type() of + {win32,_} -> iexplore; + _ -> firefox + end, + script_start([App,DefaultBrowser]); +script_start([App,Browser]) -> + io:format("Starting webtool...\n"), + start(), + AvailableApps = get_applications(), + {OSType,_} = os:type(), + case lists:keysearch(App,1,AvailableApps) of + {value,{App,StartPage}} -> + io:format("Starting ~w...\n",[App]), + start_tools([],"app=" ++ atom_to_list(App)), + PortStr = integer_to_list(get_port()), + Url = case StartPage of + "/" ++ Page -> + "http://localhost:" ++ PortStr ++ "/" ++ Page; + _ -> + "http://localhost:" ++ PortStr ++ "/" ++ StartPage + end, + case Browser of + none -> + ok; + iexplore when OSType == win32-> + io:format("Starting internet explorer...\n"), + {ok,R} = win32reg:open(""), + Key="\\local_machine\\SOFTWARE\\Microsoft\\IE Setup\\Setup", + win32reg:change_key(R,Key), + {ok,Val} = win32reg:value(R,"Path"), + IExplore=filename:join(win32reg:expand(Val),"iexplore.exe"), + os:cmd("\"" ++ IExplore ++ "\" " ++ Url); + _ when OSType == win32 -> + io:format("Starting ~w...\n",[Browser]), + os:cmd("\"" ++ atom_to_list(Browser) ++ "\" " ++ Url); + B when B==firefox; B==mozilla -> + io:format("Sending URL to ~w...",[Browser]), + BStr = atom_to_list(Browser), + SendCmd = BStr ++ " -raise -remote \'openUrl(" ++ + Url ++ ")\'", + Port = open_port({spawn,SendCmd},[exit_status]), + receive + {Port,{exit_status,0}} -> + io:format("done\n"), + ok; + {Port,{exit_status,_Error}} -> + io:format(" not running, starting ~w...\n", + [Browser]), + os:cmd(BStr ++ " " ++ Url), + ok + after ?SEND_URL_TIMEOUT -> + io:format(" failed, starting ~w...\n",[Browser]), + erlang:port_close(Port), + os:cmd(BStr ++ " " ++ Url) + end; + _ -> + io:format("Starting ~w...\n",[Browser]), + os:cmd(atom_to_list(Browser) ++ " " ++ Url) + end, + ok; + false -> + stop(), + io:format("\n{error,{unknown_app,~p}}\n",[App]), + halt() + end. + +usage() -> + io:format("Starting webtool...\n"), + start(), + Apps = lists:map(fun({A,_}) -> A end,get_applications()), + io:format( + "\nUsage: start_webtool application [ browser ]\n" + "\nAvailable applications are: ~p\n" + "Default browser is \'iexplore\' (Internet Explorer) on Windows " + "or else \'firefox\'\n", + [Apps]), + stop(). + + +get_applications() -> + gen_server:call(ct_web_tool,get_applications). + +get_port() -> + gen_server:call(ct_web_tool,get_port). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Api functions to the genserver. %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%---------------------------------------------------------------------- +% +%---------------------------------------------------------------------- + +start()-> + start(standard_path,standard_data). + +start(Path,standard_data)-> + case get_standard_data() of + {error,Reason} -> + {error,Reason}; + Data -> + start(Path,Data) + end; + +start(standard_path,Data)-> + Path=get_path(), + start(Path,Data); + +start(Path,Port) when is_integer(Port)-> + Data = get_standard_data(Port), + start(Path,Data); + +start(Path,Data0)-> + Data = Data0 ++ rest_of_standard_data(), + gen_server:start({local,ct_web_tool},ct_webtool,{Path,Data},[]). + +stop()-> + gen_server:call(ct_web_tool,stoppit). + +%---------------------------------------------------------------------- +%Web Api functions called by the web +%---------------------------------------------------------------------- +started_tools(Env,Input)-> + gen_server:call(ct_web_tool,{started_tools,Env,Input}). + +toolbar(Env,Input)-> + gen_server:call(ct_web_tool,{toolbar,Env,Input}). + +start_tools(Env,Input)-> + gen_server:call(ct_web_tool,{start_tools,Env,Input}). + +stop_tools(Env,Input)-> + gen_server:call(ct_web_tool,{stop_tools,Env,Input}). +%---------------------------------------------------------------------- +%Support API for other tools +%---------------------------------------------------------------------- + +is_localhost()-> + gen_server:call(ct_web_tool,is_localhost). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%%The gen_server callback functions that builds the webbpages %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +handle_call(get_applications,_,State)-> + MS = ets:fun2ms(fun({Tool,{web_data,{_,Start}}}) -> {Tool,Start} end), + Tools = ets:select(State#state.app_data,MS), + {reply,Tools,State}; + +handle_call(get_port,_,State)-> + {value,{port,Port}}=lists:keysearch(port,1,State#state.web_data), + {reply,Port,State}; + +handle_call({started_tools,_Env,_Input},_,State)-> + {reply,started_tools_page(State),State}; + +handle_call({toolbar,_Env,_Input},_,State)-> + {reply,toolbar(),State}; + +handle_call({start_tools,Env,Input},_,State)-> + {NewState,Page}=start_tools_page(Env,Input,State), + {reply,Page,NewState}; + +handle_call({stop_tools,Env,Input},_,State)-> + {NewState,Page}=stop_tools_page(Env,Input,State), + {reply,Page,NewState}; + +handle_call(stoppit,_From,Data)-> + {stop,normal,ok,Data}; + +handle_call(is_localhost,_From,Data)-> + Result=case proplists:get_value(bind_address, Data#state.web_data) of + ?DEFAULT_ADDR -> + true; + _IpNumber -> + false + end, + {reply,Result,Data}. + + +handle_info(_Message,State)-> + {noreply,State}. + +handle_cast(_Request,State)-> + {noreply,State}. + +code_change(_,State,_)-> + {ok,State}. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% The other functions needed by the gen_server behaviour +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%---------------------------------------------------------------------- +% Start the gen_server +%---------------------------------------------------------------------- +init({Path,Config})-> + case filelib:is_dir(Path) of + true -> + {ok, Table} = get_tool_files_data(), + insert_app(?WEBTOOL_ALIAS, Table), + case ct_webtool_sup:start_link() of + {ok, Pid} -> + case start_webserver(Table, Path, Config) of + {ok, _} -> + print_url(Config), + {ok,#state{priv_dir=Path, + app_data=Table, + supvis=Pid, + web_data=Config}}; + {error, Error} -> + {stop, {error, Error}} + end; + Error -> + {stop,Error} + end; + false -> + {stop, {error, error_dir}} + end. + +terminate(_Reason,Data)-> + %%shut down the webbserver + shutdown_server(Data), + %%Shutdown the different tools that are started with application:start + shutdown_apps(Data), + %%Shutdown the supervisor and its children will die + shutdown_supervisor(Data), + ok. + +print_url(ConfigData)-> + Server=proplists:get_value(server_name,ConfigData,"undefined"), + Port=proplists:get_value(port,ConfigData,"undefined"), + {A,B,C,D}=proplists:get_value(bind_address,ConfigData,"undefined"), + io:format("WebTool is available at http://~s:~w/~n",[Server,Port]), + io:format("Or http://~w.~w.~w.~w:~w/~n",[A,B,C,D,Port]). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% begin build the pages +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%---------------------------------------------------------------------- +%The page that shows the started tools +%---------------------------------------------------------------------- +started_tools_page(State)-> + [?HEADER,?HTML_HEADER,started_tools(State),?HTML_END]. + +toolbar()-> + [?HEADER,?HTML_HEADER,toolbar_page(),?HTML_END]. + + +start_tools_page(_Env,Input,State)-> + %%io:format("~n======= ~n ~p ~n============~n",[Input]), + case get_tools(Input) of + {tools,Tools}-> + %%io:format("~n======= ~n ~p ~n============~n",[Tools]), + {ok,NewState}=handle_apps(Tools,State,start), + {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), + show_unstarted_apps(NewState),?HTML_END]}; + _ -> + {State,[?HEADER,?HTML_HEADER,show_unstarted_apps(State),?HTML_END]} + end. + +stop_tools_page(_Env,Input,State)-> + case get_tools(Input) of + {tools,Tools}-> + {ok,NewState}=handle_apps(Tools,State,stop), + {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(), + show_started_apps(NewState),?HTML_END]}; + _ -> + {State,[?HEADER,?HTML_HEADER,show_started_apps(State),?HTML_END]} + end. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Functions that start and config the webserver +%% 1. Collect the config data +%% 2. Start webserver +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%---------------------------------------------------------------------- +% Start the webserver +%---------------------------------------------------------------------- +start_webserver(Data,Path,Config)-> + case get_conf_data(Data,Path,Config) of + {ok,Conf_data}-> + %%io:format("Conf_data: ~p~n",[Conf_data]), + start_server(Conf_data); + {error,Error} -> + {error,{error_server_conf_file,Error}} + end. + +start_server(Conf_data)-> + case inets:start(httpd, Conf_data, stand_alone) of + {ok,Pid}-> + {ok,Pid}; + Error-> + {error,{server_error,Error}} + end. + +%---------------------------------------------------------------------- +% Create config data for the webserver +%---------------------------------------------------------------------- +get_conf_data(Data,Path,Config)-> + Aliases=get_aliases(Data), + ServerRoot = filename:join([Path,"root"]), + MimeTypesFile = filename:join([ServerRoot,"conf","mime.types"]), + case httpd_conf:load_mime_types(MimeTypesFile) of + {ok,MimeTypes} -> + Config1 = Config ++ Aliases, + Config2 = [{server_root,ServerRoot}, + {document_root,filename:join([Path,"root/doc"])}, + {mime_types,MimeTypes} | + Config1], + {ok,Config2}; + Error -> + Error + end. + +%---------------------------------------------------------------------- +% Control the path for *.tools files +%---------------------------------------------------------------------- +get_tool_files_data()-> + Tools=get_tools1(code:get_path()), + %%io:format("Data : ~p ~n",[Tools]), + get_file_content(Tools). + +%---------------------------------------------------------------------- +%Control that the data in the file really is erlang terms +%---------------------------------------------------------------------- +get_file_content(Tools)-> + Get_data=fun({tool,ToolData}) -> + %%io:format("Data : ~p ~n",[ToolData]), + case proplists:get_value(config_func,ToolData) of + {M,F,A}-> + case catch apply(M,F,A) of + {'EXIT',_} -> + bad_data; + Data when is_tuple(Data) -> + Data; + _-> + bad_data + end; + _ -> + bad_data + end + end, + insert_file_content([X ||X<-lists:map(Get_data,Tools),X/=bad_data]). + +%---------------------------------------------------------------------- +%Insert the data from the file in to the ets:table +%---------------------------------------------------------------------- +insert_file_content(Content)-> + Table=ets:new(app_data,[bag]), + lists:foreach(fun(X)-> + insert_app(X,Table) + end,Content), + {ok,Table}. + +%---------------------------------------------------------------------- +%Control that we got a a tuple of a atom and a list if so add the +%elements in the list to the ets:table +%---------------------------------------------------------------------- +insert_app({Name,Key_val_list},Table) when is_list(Key_val_list),is_atom(Name)-> + %%io:format("ToolData: ~p: ~p~n",[Name,Key_val_list]), + lists:foreach( + fun({alias,{erl_alias,Alias,Mods}}) -> + Key_val = {erl_script_alias,{Alias,Mods}}, + %%io:format("Insert: ~p~n",[Key_val]), + ets:insert(Table,{Name,Key_val}); + (Key_val_pair)-> + %%io:format("Insert: ~p~n",[Key_val_pair]), + ets:insert(Table,{Name,Key_val_pair}) + end, + Key_val_list); + +insert_app(_,_)-> + ok. + +%---------------------------------------------------------------------- +% Select all the alias in the database +%---------------------------------------------------------------------- +get_aliases(Data)-> + MS = ets:fun2ms(fun({_,{erl_script_alias,Alias}}) -> + {erl_script_alias,Alias}; + ({_,{alias,Alias}}) -> + {alias,Alias} + end), + ets:select(Data,MS). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Helper functions %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +get_standard_data(Port)-> + [ + {port,Port}, + {bind_address,?DEFAULT_ADDR}, + {server_name,"localhost"} + ]. + +get_standard_data()-> + case get_free_port(?DEFAULT_PORT,?MAX_NUMBER_OF_WEBTOOLS) of + {error,Reason} -> {error,Reason}; + Port -> + [ + {port,Port}, + {bind_address,?DEFAULT_ADDR}, + {server_name,"localhost"} + ] + end. + +get_free_port(_Port,0) -> + {error,no_free_port_found}; +get_free_port(Port,N) -> + case gen_tcp:connect("localhost",Port,[]) of + {error, _Reason} -> + Port; + {ok,Sock} -> + gen_tcp:close(Sock), + get_free_port(Port+1,N-1) + end. + +rest_of_standard_data() -> + [ + %% Do not allow the server to be crashed by malformed http-request + {max_header_siz,1024}, + {max_header_action,reply414}, + %% Go on a straight ip-socket + {com_type,ip_comm}, + %% Do not change the order of these module names!! + {modules,[mod_alias, + mod_auth, + mod_esi, + mod_actions, + mod_cgi, + mod_include, + mod_dir, + mod_get, + mod_head, + mod_log, + mod_disk_log]}, + {directory_index,["index.html"]}, + {default_type,"text/plain"} + ]. + + +get_path()-> + code:priv_dir(webtool). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% These functions is used to shutdown the webserver +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%---------------------------------------------------------------------- +% Shut down the webbserver +%---------------------------------------------------------------------- +shutdown_server(State)-> + {Addr,Port} = get_addr_and_port(State#state.web_data), + inets:stop(httpd,{Addr,Port}). + +get_addr_and_port(Config) -> + Addr = proplists:get_value(bind_address,Config,?DEFAULT_ADDR), + Port = proplists:get_value(port,Config,?DEFAULT_PORT), + {Addr,Port}. + +%---------------------------------------------------------------------- +% Select all apps in the table and close them +%---------------------------------------------------------------------- +shutdown_apps(State)-> + Data=State#state.app_data, + MS = ets:fun2ms(fun({_,{start,HowToStart}}) -> HowToStart end), + lists:foreach(fun(Start_app)-> + stop_app(Start_app) + end, + ets:select(Data,MS)). + +%---------------------------------------------------------------------- +%Shuts down the supervisor that supervises tools that is not +%Designed as applications +%---------------------------------------------------------------------- +shutdown_supervisor(State)-> + %io:format("~n==================~n"), + ct_webtool_sup:stop(State#state.supvis). + %io:format("~n==================~n"). + +%---------------------------------------------------------------------- +%close the individual apps. +%---------------------------------------------------------------------- +stop_app({child,_Real_name})-> + ok; + +stop_app({app,Real_name})-> + application:stop(Real_name); + +stop_app({func,_Start,Stop})-> + case Stop of + {M,F,A} -> + catch apply(M,F,A); + _NoStop -> + ok + end. + + + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% These functions creates the webpage where the user can select if +%% to start apps or to stop apps +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +toolbar_page()-> + "<TABLE> + <TR> + <TD> + <B>Select Action</B> + </TD> + </TR> + <TR> + <TD> + <A HREF=\"./start_tools\" TARGET=right> Start Tools</A> + </TD> + </TR> + <TR> + <TD> + <A HREF=\"./stop_tools\" TARGET=right> Stop Tools</A> + </TD> + </TR> + </TABLE>". +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% These functions creates the webbpage that shows the started apps +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%---------------------------------------------------------------------- +% started_tools(State)->String (html table) +% State is a record of type state +%---------------------------------------------------------------------- +started_tools(State)-> + Names=get_started_apps(State#state.app_data,State#state.started), + "<TABLE BORDER=1 WIDTH=100%> + "++ make_rows(Names,[],0) ++" + </TABLE>". +%---------------------------------------------------------------------- +%get_started_apps(Data,Started)-> [{web_name,link}] +%selects the started apps from the ets table of apps. +%---------------------------------------------------------------------- + +get_started_apps(Data,Started)-> + SelectData=fun({Name,Link}) -> + {Name,Link} + end, + MS = lists:map(fun(A) -> {{A,{web_data,'$1'}},[],['$1']} end,Started), + + [{"WebTool","/tool_management.html"} | + [SelectData(X) || X <- ets:select(Data,MS)]]. + +%---------------------------------------------------------------------- +% make_rows(List,Result,Fields)-> String (The rows of a htmltable +% List a list of tupler discibed above +% Result an accumulator for the result +% Field, counter that counts the number of cols in each row. +%---------------------------------------------------------------------- +make_rows([],Result,Fields)-> + Result ++ fill_out(Fields); +make_rows([Data|Paths],Result,Field)when Field==0-> + make_rows(Paths,Result ++ "<TR>" ++ make_field(Data),Field+1); + +make_rows([Path|Paths],Result,Field)when Field==4-> + make_rows(Paths,Result ++ make_field(Path) ++ "</TR>",0); + +make_rows([Path|Paths],Result,Field)-> + make_rows(Paths,Result ++ make_field(Path),Field+1). + +%---------------------------------------------------------------------- +% make_fields(Path)-> String that is a field i a html table +% Path is a name url tuple {Name,url} +%---------------------------------------------------------------------- +make_field(Path)-> + "<TD WIDTH=20%>" ++ get_name(Path) ++ "</TD>". + + +%---------------------------------------------------------------------- +%get_name({Nae,Url})->String that represents a <A> tag in html. +%---------------------------------------------------------------------- +get_name({Name,Url})-> + "<A HREF=\"" ++ Url ++ "\" TARGET=app_frame>" ++ Name ++ "</A>". + + +%---------------------------------------------------------------------- +% fill_out(Nr)-> String, that represent Nr fields in a html-table. +%---------------------------------------------------------------------- +fill_out(Nr)when Nr==0-> + []; +fill_out(Nr)when Nr==4-> + "<TD WIDTH=\"20%\" > </TD></TR>"; + +fill_out(Nr)-> + "<TD WIDTH=\"20%\"> </TD>" ++ fill_out(Nr+1). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%%These functions starts applicatons and builds the page showing tools +%%to start +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%---------------------------------------------------------------------- +%Controls whether the user selected a tool to start +%---------------------------------------------------------------------- +get_tools(Input)-> + case httpd:parse_query(Input) of + []-> + no_tools; + Tools-> + FormatData=fun({_Name,Data}) -> list_to_atom(Data) end, + SelectData= + fun({Name,_Data}) -> string:equal(Name,"app") end, + {tools,[FormatData(X)||X<-Tools,SelectData(X)]} + end. + +%---------------------------------------------------------------------- +% Selects the data to start the applications the user has ordered +% starting of +%---------------------------------------------------------------------- +handle_apps([],State,_Cmd)-> + {ok,State}; + +handle_apps([Tool|Tools],State,Cmd)-> + case ets:match_object(State#state.app_data,{Tool,{start,'_'}}) of + []-> + Started = case Cmd of + start -> + [Tool|State#state.started]; + stop -> + lists:delete(Tool,State#state.started) + end, + {ok,#state{priv_dir=State#state.priv_dir, + app_data=State#state.app_data, + supvis=State#state.supvis, + web_data=State#state.web_data, + started=Started}}; + ToStart -> + case handle_apps2(ToStart,State,Cmd) of + {ok,NewState}-> + handle_apps(Tools,NewState,Cmd); + _-> + handle_apps(Tools,State,Cmd) + end + end. + +%---------------------------------------------------------------------- +%execute every start or stop data about a tool. +%---------------------------------------------------------------------- +handle_apps2([{Name,Start_data}],State,Cmd)-> + case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd) of + ok-> + Started = case Cmd of + start -> + [Name|State#state.started]; + stop -> + + lists:delete(Name,State#state.started) + end, + {ok,#state{priv_dir=State#state.priv_dir, + app_data=State#state.app_data, + supvis=State#state.supvis, + web_data=State#state.web_data, + started=Started}}; + _-> + error + end; + +handle_apps2([{Name,Start_data}|Rest],State,Cmd)-> + case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd)of + ok-> + handle_apps2(Rest,State,Cmd); + _-> + error + end. + + +%---------------------------------------------------------------------- +% Handle start and stop of applications +%---------------------------------------------------------------------- + +handle_app({Name,{start,{func,Start,Stop}}},Data,_Pid,Cmd)-> + Action = case Cmd of + start -> + Start; + _ -> + Stop + end, + case Action of + {M,F,A} -> + case catch apply(M,F,A) of + {'EXIT',_} = Exit-> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not start application \'~p\'\n\n" + "~w:~w(~s) ->\n" + "~p\n\n", + [?LINE,Name,M,F,format_args(A),Exit]), + ets:delete(Data,Name); + _OK-> + ok + end; + _NoStart -> + ok + end; + + +handle_app({Name,{start,{child,ChildSpec}}},Data,Pid,Cmd)-> + case Cmd of + start -> + case catch supervisor:start_child(Pid,ChildSpec) of + {ok,_}-> + ok; + {ok,_,_}-> + ok; + {error,Reason}-> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not start application \'~p\'\n\n" + "supervisor:start_child(~p,~p) ->\n" + "~p\n\n", + [?LINE,Name,Pid,ChildSpec,{error,Reason}]), + ets:delete(Data,Name); + Error -> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not start application \'~p\'\n\n" + "supervisor:start_child(~p,~p) ->\n" + "~p\n\n", + [?LINE,Name,Pid,ChildSpec,Error]), + ets:delete(Data,Name) + end; + stop -> + case catch supervisor:terminate_child(websup,element(1,ChildSpec)) of + ok -> + supervisor:delete_child(websup,element(1,ChildSpec)); + _ -> + error + end + end; + + + +handle_app({Name,{start,{app,Real_name}}},Data,_Pid,Cmd)-> + case Cmd of + start -> + case application:start(Real_name,temporary) of + ok-> + io:write(Name), + ok; + {error,{already_started,_}}-> + %% Remove it from the database so we dont start + %% anything already started + ets:match_delete(Data,{Name,{start,{app,Real_name}}}), + ok; + {error,_Reason}=Error-> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not start application \'~p\'\n\n" + "application:start(~p,~p) ->\n" + "~p\n\n", + [?LINE,Name,Real_name,temporary,Error]), + ets:delete(Data,Name) + end; + + stop -> + application:stop(Real_name) + end; + +%---------------------------------------------------------------------- +% If the data is incorrect delete the app +%---------------------------------------------------------------------- +handle_app({Name,Incorrect},Data,_Pid,Cmd)-> + %%! Here the tool disappears from the webtool interface!! + io:format("\n=======ERROR (webtool, line ~w) =======\n" + "Could not ~w application \'~p\'\n\n" + "Incorrect data: ~p\n\n", + [?LINE,Cmd,Name,Incorrect]), + ets:delete(Data,Name). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% this functions creates the page that shows the unstarted tools %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +reload_started_apps()-> + "<script> + function reloadCompiledList() + { + parent.parent.top1.document.location.href=\"/webtool/webtool/started_tools\"; + } + </script>". + +show_unstarted_apps(State)-> + "<TABLE HEIGHT=100% WIDTH=100% BORDER=0> + <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\"> + <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/start_tools\" > + <TABLE BORDER=1 WIDTH=60%> + <TR BGCOLOR=\"#8899AA\"> + <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Available Tools<FONT></TD> + </TR> + <TR> + <TD WIDTH=50%> + <TABLE BORDER=0> + "++ list_available_apps(State)++" + <TR><TD COLSPAN=2> </TD></TR> + <TR> + <TD COLSPAN=2 ALIGN=\"center\"> + <INPUT TYPE=submit VALUE=\"Start\"> + </TD> + </TR> + </TABLE> + </TD> + <TD> + To Start a Tool: + <UL> + <LI>Select the + checkbox for each tool to + start.</LI> + <LI>Click on the + button marked <EM>Start</EM>.</LI></UL> + </TD> + </TR> + </TABLE> + </FORM> + </TD></TR> + <TR><TD> </TD></TR> + </TABLE>". + + + +list_available_apps(State)-> + MS = ets:fun2ms(fun({Tool,{web_data,{Name,_}}}) -> {Tool,Name} end), + Unstarted_apps= + lists:filter( + fun({Tool,_})-> + false==lists:member(Tool,State#state.started) + end, + ets:select(State#state.app_data,MS)), + case Unstarted_apps of + []-> + "<TR><TD>All tools are started</TD></TR>"; + _-> + list_apps(Unstarted_apps) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% these functions creates the page that shows the started apps %% +%% the user can select to shutdown %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +show_started_apps(State)-> + "<TABLE HEIGHT=100% WIDTH=100% BORDER=0> + <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\"> + <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/stop_tools\" > + <TABLE BORDER=1 WIDTH=60%> + <TR BGCOLOR=\"#8899AA\"> + <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Started Tools<FONT></TD> + </TR> + <TR> + <TD WIDTH=50%> + <TABLE BORDER=0> + "++ list_started_apps(State)++" + <TR><TD COLSPAN=2> </TD></TR> + <TR> + <TD COLSPAN=2 ALIGN=\"center\"> + <INPUT TYPE=submit VALUE=\"Stop\"> + </TD> + </TR> + </TABLE> + </TD> + <TD> + Stop a Tool: + <UL> + <LI>Select the + checkbox for each tool to + stop.</LI> + <LI>Click on the + button marked <EM>Stop</EM>.</LI></UL> + </TD> + </TR> + </TABLE> + </FORM> + </TD></TR> + <TR><TD> </TD></TR> + </TABLE>". + +list_started_apps(State)-> + MS = lists:map(fun(A) -> {{A,{web_data,{'$1','_'}}},[],[{{A,'$1'}}]} end, + State#state.started), + Started_apps= ets:select(State#state.app_data,MS), + case Started_apps of + []-> + "<TR><TD>No tool is started yet.</TD></TR>"; + _-> + list_apps(Started_apps) + end. + + +list_apps(Apps) -> + lists:map(fun({Tool,Name})-> + "<TR><TD> + <INPUT TYPE=\"checkbox\" NAME=\"app\" VALUE=\"" + ++ atom_to_list(Tool) ++ "\"> + " ++ Name ++ " + </TD></TR>" + end, + Apps). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Collecting the data from the *.tool files %% +%% %% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%---------------------------------------- +% get_tools(Dirs) => [{M,F,A},{M,F,A}...{M,F,A}] +% Dirs - [string()] Directory names +% Calls get_tools2/2 recursively for a number of directories +% to retireve the configuration data for the web based tools. +%---------------------------------------- +get_tools1(Dirs)-> + get_tools1(Dirs,[]). + +get_tools1([Dir|Rest],Data) when is_list(Dir) -> + Tools=case filename:basename(Dir) of + %% Dir is an 'ebin' directory, check in '../priv' as well + "ebin" -> + [get_tools2(filename:join(filename:dirname(Dir),"priv")) | + get_tools2(Dir)]; + _ -> + get_tools2(Dir) + end, + get_tools1(Rest,[Tools|Data]); + +get_tools1([],Data) -> + lists:flatten(Data). + +%---------------------------------------- +% get_tools2(Directory) => DataList +% DataList : [WebTuple]|[] +% WebTuple: {tool,[{web,M,F,A}]} +% +%---------------------------------------- +get_tools2(Dir)-> + get_tools2(tool_files(Dir),[]). + +get_tools2([ToolFile|Rest],Data) -> + case get_tools3(ToolFile) of + {tool,WebData} -> + get_tools2(Rest,[{tool,WebData}|Data]); + {error,_Reason} -> + get_tools2(Rest,Data); + nodata -> + get_tools2(Rest,Data) + end; + +get_tools2([],Data) -> + Data. + +%---------------------------------------- +% get_tools3(ToolFile) => {ok,Tool}|{error,Reason}|nodata +% Tool: {tool,[KeyValTuple]} +% ToolFile - string() A .tool file +% Now we have the file get the data and sort it out +%---------------------------------------- +get_tools3(ToolFile) -> + case file:consult(ToolFile) of + {error,open} -> + {error,nofile}; + {error,read} -> + {error,format}; + {ok,[{version,"1.2"},ToolInfo]} when is_list(ToolInfo)-> + webdata(ToolInfo); + {ok,[{version,_Vsn},_Info]} -> + {error,old_version}; + {ok,_Other} -> + {error,format} + end. + + +%---------------------------------------------------------------------- +% webdata(TupleList)-> ToolTuple| nodata +% ToolTuple: {tool,[{config_func,{M,F,A}}]} +% +% There are a little unneccesary work in this format but it is extendable +%---------------------------------------------------------------------- +webdata(TupleList)-> + case proplists:get_value(config_func,TupleList,nodata) of + {M,F,A} -> + {tool,[{config_func,{M,F,A}}]}; + _ -> + nodata + end. + + +%============================================================================= +% Functions for getting *.tool configuration files +%============================================================================= + +%---------------------------------------- +% tool_files(Dir) => ToolFiles +% Dir - string() Directory name +% ToolFiles - [string()] +% Return the list of all files in Dir ending with .tool (appended to Dir) +%---------------------------------------- +tool_files(Dir) -> + case file:list_dir(Dir) of + {ok,Files} -> + filter_tool_files(Dir,Files); + {error,_Reason} -> + [] + end. + +%---------------------------------------- +% filter_tool_files(Dir,Files) => ToolFiles +% Dir - string() Directory name +% Files, ToolFiles - [string()] File names +% Filters out the files in Files ending with .tool and append them to Dir +%---------------------------------------- +filter_tool_files(_Dir,[]) -> + []; +filter_tool_files(Dir,[File|Rest]) -> + case filename:extension(File) of + ".tool" -> + [filename:join(Dir,File)|filter_tool_files(Dir,Rest)]; + _ -> + filter_tool_files(Dir,Rest) + end. + + +%%%----------------------------------------------------------------- +%%% format functions +ffunc({M,F,A}) when is_list(A) -> + io_lib:format("~w:~w(~s)\n",[M,F,format_args(A)]); +ffunc({M,F,A}) when is_integer(A) -> + io_lib:format("~w:~w/~w\n",[M,F,A]). + +format_args([]) -> + ""; +format_args(Args) -> + Str = lists:append(["~p"|lists:duplicate(length(Args)-1,",~p")]), + io_lib:format(Str,Args). diff --git a/lib/common_test/src/ct_webtool_sup.erl b/lib/common_test/src/ct_webtool_sup.erl new file mode 100644 index 0000000000..1d612a2d18 --- /dev/null +++ b/lib/common_test/src/ct_webtool_sup.erl @@ -0,0 +1,74 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(ct_webtool_sup). + +-behaviour(supervisor). + +%% External exports +-export([start_link/0,stop/1]). + +%% supervisor callbacks +-export([init/1]). + +%%%---------------------------------------------------------------------- +%%% API +%%%---------------------------------------------------------------------- +start_link() -> + supervisor:start_link({local,ct_websup},ct_webtool_sup, []). + +stop(Pid)-> + exit(Pid,normal). +%%%---------------------------------------------------------------------- +%%% Callback functions from supervisor +%%%---------------------------------------------------------------------- + +%%---------------------------------------------------------------------- +%% Func: init/1 +%% Returns: {ok, {SupFlags, [ChildSpec]}} | +%% ignore | +%% {error, Reason} +%%---------------------------------------------------------------------- +init(_StartArgs) -> + %%Child1 = + %%Child2 ={webcover_backend,{webcover_backend,start_link,[]},permanent,2000,worker,[webcover_backend]}, + %%{ok,{{simple_one_for_one,5,10},[Child1]}}. + {ok,{{one_for_one,100,10},[]}}. + +%%%---------------------------------------------------------------------- +%%% Internal functions +%%%---------------------------------------------------------------------- + + + + + + + + + + + + + + + + + + + diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl index bb12171ea7..3deaefe0e9 100644 --- a/lib/common_test/src/cth_surefire.erl +++ b/lib/common_test/src/cth_surefire.erl @@ -59,6 +59,8 @@ -define(default_report,"junit_report.xml"). -define(suite_log,"suite.log.html"). +-define(now, os:timestamp()). + %% Number of dirs from log root to testcase log file. %% ct_run.<node>.<timestamp>/<test_name>/run.<timestamp>/<tc_log>.html -define(log_depth,3). @@ -77,11 +79,11 @@ init(Path, Opts) -> axis = proplists:get_value(axis,Opts,[]), properties = proplists:get_value(properties,Opts,[]), url_base = proplists:get_value(url_base,Opts), - timer = now() }. + timer = ?now }. pre_init_per_suite(Suite,SkipOrFail,State) when is_tuple(SkipOrFail) -> {SkipOrFail, init_tc(State#state{curr_suite = Suite, - curr_suite_ts = now()}, + curr_suite_ts = ?now}, SkipOrFail) }; pre_init_per_suite(Suite,Config,#state{ test_cases = [] } = State) -> TcLog = proplists:get_value(tc_logfile,Config), @@ -96,7 +98,7 @@ pre_init_per_suite(Suite,Config,#state{ test_cases = [] } = State) -> end, {Config, init_tc(State#state{ filepath = Path, curr_suite = Suite, - curr_suite_ts = now(), + curr_suite_ts = ?now, curr_log_dir = CurrLogDir}, Config) }; pre_init_per_suite(Suite,Config,State) -> @@ -169,9 +171,9 @@ do_tc_skip(Res, State) -> State#state{ test_cases = [NewTC | tl(TCs)]}. init_tc(State, Config) when is_list(Config) == false -> - State#state{ timer = now(), tc_log = "" }; + State#state{ timer = ?now, tc_log = "" }; init_tc(State, Config) -> - State#state{ timer = now(), + State#state{ timer = ?now, tc_log = proplists:get_value(tc_logfile, Config, [])}. end_tc(Func, Config, Res, State) when is_atom(Func) -> @@ -194,7 +196,7 @@ end_tc(Name, _Config, _Res, State = #state{ curr_suite = Suite, ClassName = atom_to_list(Suite), PGroup = string:join([ atom_to_list(Group)|| Group <- lists:reverse(Groups)],"."), - TimeTakes = io_lib:format("~f",[timer:now_diff(now(),TS) / 1000000]), + TimeTakes = io_lib:format("~f",[timer:now_diff(?now,TS) / 1000000]), State#state{ test_cases = [#testcase{ log = Log, url = Url, timestamp = now_to_string(TS), @@ -209,7 +211,7 @@ close_suite(#state{ test_cases = [] } = State) -> State; close_suite(#state{ test_cases = TCs, url_base = UrlBase } = State) -> {Total,Fail,Skip} = count_tcs(TCs,0,0,0), - TimeTaken = timer:now_diff(now(),State#state.curr_suite_ts) / 1000000, + TimeTaken = timer:now_diff(?now,State#state.curr_suite_ts) / 1000000, SuiteLog = filename:join(State#state.curr_log_dir,?suite_log), SuiteUrl = make_url(UrlBase,SuiteLog), Suite = #testsuite{ name = atom_to_list(State#state.curr_suite), diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl index b340c6fdd1..ab13e7d0ee 100644 --- a/lib/common_test/src/vts.erl +++ b/lib/common_test/src/vts.erl @@ -63,21 +63,21 @@ %%%----------------------------------------------------------------- %%% User API start() -> - webtool:start(), - webtool:start_tools([],"app=vts"). + ct_webtool:start(), + ct_webtool:start_tools([],"app=vts"). init_data(ConfigFiles,EvHandlers,LogDir,LogOpts,Tests) -> call({init_data,ConfigFiles,EvHandlers,LogDir,LogOpts,Tests}). stop() -> - webtool:stop_tools([],"app=vts"), - webtool:stop(). + ct_webtool:stop_tools([],"app=vts"), + ct_webtool:stop(). report(What,Data) -> call({report,What,Data}). %%%----------------------------------------------------------------- -%%% Return config data used by webtool +%%% Return config data used by ct_webtool config_data() -> {ok,LogDir} = case lists:keysearch(logdir,1,init:get_arguments()) of diff --git a/lib/common_test/test/ct_auto_compile_SUITE.erl b/lib/common_test/test/ct_auto_compile_SUITE.erl index cc546ed30d..3e4da31ab4 100644 --- a/lib/common_test/test/ct_auto_compile_SUITE.erl +++ b/lib/common_test/test/ct_auto_compile_SUITE.erl @@ -108,6 +108,8 @@ ac_spec(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), file:copy(filename:join(DataDir, "bad_SUITE.erl"), filename:join(PrivDir, "bad_SUITE.erl")), + Suite = filename:join(DataDir, "dummy_SUITE"), + compile:file(Suite, [{outdir,PrivDir}]), TestSpec = [{label,ac_spec}, {auto_compile,false}, {suites,PrivDir,all}], @@ -160,28 +162,34 @@ events_to_check(Test, N) -> test_events(ac_flag) -> [ - {ct_test_support_eh,start_logging,{'DEF','RUNDIR'}}, - {ct_test_support_eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - {ct_test_support_eh,start_info,{1,1,3}}, - {ct_test_support_eh,tc_start,{dummy_SUITE,init_per_suite}}, - {ct_test_support_eh,tc_done,{dummy_SUITE,init_per_suite,ok}}, - {ct_test_support_eh,test_stats,{1,1,{1,0}}}, - {ct_test_support_eh,tc_start,{dummy_SUITE,end_per_suite}}, - {ct_test_support_eh,tc_done,{dummy_SUITE,end_per_suite,ok}}, - {ct_test_support_eh,test_done,{'DEF','STOP_TIME'}}, - {ct_test_support_eh,stop_logging,[]} + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,3}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done,{ct_framework,error_in_suite, + {failed,{error,'bad_SUITE can not be compiled or loaded'}}}}, + {?eh,tc_start,{dummy_SUITE,init_per_suite}}, + {?eh,tc_done,{dummy_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,1,{1,0}}}, + {?eh,tc_start,{dummy_SUITE,end_per_suite}}, + {?eh,tc_done,{dummy_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} ]; test_events(ac_spec) -> [ - {ct_test_support_eh,start_logging,{'DEF','RUNDIR'}}, - {ct_test_support_eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - {ct_test_support_eh,start_info,{1,1,3}}, - {ct_test_support_eh,tc_start,{dummy_SUITE,init_per_suite}}, - {ct_test_support_eh,tc_done,{dummy_SUITE,init_per_suite,ok}}, - {ct_test_support_eh,test_stats,{1,1,{1,0}}}, - {ct_test_support_eh,tc_start,{dummy_SUITE,end_per_suite}}, - {ct_test_support_eh,tc_done,{dummy_SUITE,end_per_suite,ok}}, - {ct_test_support_eh,test_done,{'DEF','STOP_TIME'}}, - {ct_test_support_eh,stop_logging,[]} + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,3}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done,{ct_framework,error_in_suite, + {failed,{error,'bad_SUITE can not be compiled or loaded'}}}}, + {?eh,tc_start,{dummy_SUITE,init_per_suite}}, + {?eh,tc_done,{dummy_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,1,{1,0}}}, + {?eh,tc_start,{dummy_SUITE,end_per_suite}}, + {?eh,tc_done,{dummy_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} ]. diff --git a/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl b/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl index 8ee12a2e4d..ef1fd63905 100644 --- a/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl +++ b/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl @@ -35,7 +35,7 @@ %% which will return the list with the following variables: %% localtime = the erlang:localtime() result in list [{date, Date}, {time, Time}] %% node = erlang:node() - can be compared in the testcase -%% now = erlang:now() - easier to compare than localtime() +%% now = os:timestamp() - easier to compare than localtime() %% config_server_pid - pid of the config server, should NOT change! %% config_server_vsn - .19 %% config_server_iteration - a number of iteration config_server's loop done @@ -73,7 +73,7 @@ test_get_known_variable(_)-> test_localtime_update(_)-> Seconds = 5, LT1 = ct:get_config(localtime), - timer:sleep(Seconds*1000), + ct:sleep(Seconds*1000), LT2 = ct:reload_config(localtime), case is_diff_ok(LT1, LT2, Seconds) of {false, Actual, Exp}-> diff --git a/lib/common_test/test/ct_config_SUITE_data/config/test/config_server.erl b/lib/common_test/test/ct_config_SUITE_data/config/test/config_server.erl index 8463fea645..e65d6584b1 100644 --- a/lib/common_test/test/ct_config_SUITE_data/config/test/config_server.erl +++ b/lib/common_test/test/ct_config_SUITE_data/config/test/config_server.erl @@ -73,7 +73,7 @@ loop(Iteration)-> [{localtime, [{date, D}, {time, T}]}, {node, erlang:node()}, {config_server_iteration, Iteration}, - {now, erlang:now()}, + {now, os:timestamp()}, {config_server_pid, self()}, {config_server_vsn, ?vsn}], Config2 = if Iteration rem 2 == 0-> diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl index ecf231529a..8464225284 100644 --- a/lib/common_test/test/ct_error_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE.erl @@ -1466,7 +1466,8 @@ test_events(misc_errors) -> {failed,{error,{suite_failed,this_is_expected}}}}}, {?eh,test_stats,{0,5,{0,0}}}, {?eh,tc_start,{misc_error_1_SUITE,killed_by_signal_1}}, - {?eh,tc_done,{misc_error_1_SUITE,killed_by_signal_1,i_die_now}}, + {?eh,tc_done,{misc_error_1_SUITE,killed_by_signal_1, + {failed,{'EXIT',i_die_now}}}}, {?eh,test_stats,{0,6,{0,0}}}, {?eh,tc_start,{misc_error_1_SUITE,killed_by_signal_2}}, {?eh,tc_done,{misc_error_1_SUITE,killed_by_signal_2, diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_12_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_12_SUITE.erl index 806d3caf72..0ff8659269 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_12_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_12_SUITE.erl @@ -26,10 +26,10 @@ init_per_testcase(_, Config) -> Config. end_per_testcase(tc2, _Config) -> - timer:sleep(2000), + ct:sleep(2000), exit(this_should_not_be_printed); end_per_testcase(tc4, _Config) -> - timer:sleep(2000), + ct:sleep(2000), exit(this_should_not_be_printed); end_per_testcase(_, _) -> ok. @@ -42,7 +42,7 @@ tc1() -> put('$test_server_framework_test', fun(init_tc, _Default) -> ct:pal("init_tc(~p): Night time...",[self()]), - timer:sleep(2000), + ct:sleep(2000), ct:pal("init_tc(~p): Day time!",[self()]), exit(this_should_not_be_printed); (_, Default) -> Default @@ -67,7 +67,7 @@ tc3(_) -> put('$test_server_framework_test', fun(end_tc, _Default) -> ct:pal("end_tc(~p): Night time...",[self()]), - timer:sleep(1000), + ct:sleep(1000), ct:pal("end_tc(~p): Day time!",[self()]); (_, Default) -> Default end), @@ -78,7 +78,7 @@ tc4() -> put('$test_server_framework_test', fun(end_tc, _Default) -> ct:pal("end_tc(~p): Night time...",[self()]), - timer:sleep(1000), + ct:sleep(1000), ct:pal("end_tc(~p): Day time!",[self()]); (_, Default) -> Default end), diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_13_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_13_SUITE.erl index c8a3c1d15e..cfc0babb68 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_13_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_13_SUITE.erl @@ -26,7 +26,7 @@ init_per_suite() -> put('$test_server_framework_test', fun(end_tc, _Default) -> ct:pal("end_tc(~p): Night time...",[self()]), - timer:sleep(1000), + ct:sleep(1000), ct:pal("end_tc(~p): Day time!",[self()]); (_, Default) -> Default end), diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_14_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_14_SUITE.erl index 960d0f61b0..54b09e78c6 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_14_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_14_SUITE.erl @@ -29,7 +29,7 @@ end_per_suite() -> put('$test_server_framework_test', fun(end_tc, _Default) -> ct:pal("end_tc(~p): Night time...",[self()]), - timer:sleep(1000), + ct:sleep(1000), ct:pal("end_tc(~p): Day time!",[self()]); (_, Default) -> Default end), diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_3_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_3_SUITE.erl index 08c57887ef..0d93e46501 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_3_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_3_SUITE.erl @@ -36,7 +36,7 @@ suite() -> %% Reason = term() %%-------------------------------------------------------------------- init_per_suite(Config) -> - timer:sleep(5000), + ct:sleep(5000), exit(shouldnt_happen). % Config. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_7_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_7_SUITE.erl index 9cd5b6ad29..d95f3b235b 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_7_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_7_SUITE.erl @@ -43,7 +43,7 @@ init_per_suite(Config) -> %% Config0 = Config1 = [tuple()] %%-------------------------------------------------------------------- end_per_suite(Config) -> - timer:sleep(5000), + ct:sleep(5000), ok. %%-------------------------------------------------------------------- diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_8_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_8_SUITE.erl index 25993833d7..d8f0c48034 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_8_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_8_SUITE.erl @@ -57,7 +57,7 @@ init_per_group(g1, Config) -> Config; init_per_group(g2, Config) -> ct:comment("init_per_group(g2) timeout"), - timer:sleep(5000), + ct:sleep(5000), Config; init_per_group(g3, _Config) -> badmatch = 42; @@ -80,7 +80,7 @@ end_per_group(g11, _Config) -> ok; end_per_group(g12, _Config) -> ct:comment("end_per_group(g6) timeout"), - timer:sleep(5000), + ct:sleep(5000), ok; end_per_group(_GroupName, _Config) -> ok. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_1_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_1_SUITE.erl index a98382965f..1451a4119e 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_1_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_1_SUITE.erl @@ -111,7 +111,7 @@ end_per_testcase1(tc2, Config) -> ct:pal("end_per_testcase(tc2): ~p", [Config]), tc2 = ?config(tc, Config), {failed,timetrap_timeout} = ?config(tc_status, Config), - timer:sleep(2000); + ct:sleep(2000); end_per_testcase1(tc3, Config) -> ct:pal("end_per_testcase(tc3): ~p", [Config]), @@ -123,7 +123,7 @@ end_per_testcase1(tc4, Config) -> ct:pal("end_per_testcase(tc4): ~p", [Config]), tc4 = ?config(tc, Config), {failed,{testcase_aborted,testing_end_conf}} = ?config(tc_status, Config), - timer:sleep(2000); + ct:sleep(2000); end_per_testcase1(tc5, Config) -> ct:pal("end_per_testcase(tc5): ~p", [Config]), @@ -182,29 +182,29 @@ all() -> [tc1, tc2, tc3, tc4, tc5, tc6, tc7, tc8, tc9]. tc1(_) -> - timer:sleep(2000), + ct:sleep(2000), ok. tc2(_) -> - timer:sleep(2000). + ct:sleep(2000). tc3(_) -> spawn(ct, abort_current_testcase, [testing_end_conf]), - timer:sleep(2000), + ct:sleep(2000), ok. tc4(_) -> spawn(ct, abort_current_testcase, [testing_end_conf]), - timer:sleep(2000), + ct:sleep(2000), ok. tc5(_) -> - timer:sleep(2000), + ct:sleep(2000), ok. tc6(_) -> spawn(ct, abort_current_testcase, [testing_end_conf]), - timer:sleep(2000). + ct:sleep(2000). tc7(_) -> sleep(2000), @@ -220,5 +220,5 @@ tc9(_) -> %%%----------------------------------------------------------------- sleep(T) -> - timer:sleep(T), + ct:sleep(T), ok. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl index a77d06815e..d926fc55a4 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl @@ -141,12 +141,13 @@ tc3() -> [{timetrap,{seconds,2}}]. tc3(_) -> - T0 = now(), + T0 = erlang:monotonic_time(), ct:timetrap(infinity), N = list_to_integer(ct:get_config(multiply)), ct:comment(io_lib:format("Sleeping for ~w sec...", [4*N])), ct:sleep(4000), - Diff = timer:now_diff(now(), T0), + T1 = erlang:monotonic_time(), + Diff = erlang:convert_time_unit(T1-T0, native, micro_seconds), if ((Diff < (N*4000000)) or (Diff > (N*4500000))) -> exit(not_expected); true -> diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_helper.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_helper.erl index 1389acca11..a9ea0be847 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_helper.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_helper.erl @@ -3,5 +3,5 @@ -export([sleep/1]). sleep(T) -> - timer:sleep(T), + ct:sleep(T), ok. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/verify_config.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/verify_config.erl index 446dd8bfdf..d5b3e0035a 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/verify_config.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/verify_config.erl @@ -81,7 +81,7 @@ init(Id, Opts) -> -spec id(Opts :: proplists:proplist()) -> Id :: term(). id(Opts) -> - now(). + os: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_event_handler_SUITE.erl b/lib/common_test/test/ct_event_handler_SUITE.erl index 30a5e650fe..b759424e46 100644 --- a/lib/common_test/test/ct_event_handler_SUITE.erl +++ b/lib/common_test/test/ct_event_handler_SUITE.erl @@ -29,6 +29,7 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/src/ct_util.hrl"). %-include_lib("common_test/include/ct_event.hrl"). @@ -59,7 +60,7 @@ end_per_testcase(TestCase, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [start_stop, results]. + [start_stop, results, event_mgrs]. groups() -> []. @@ -156,21 +157,28 @@ results(Config) when is_list(Config) -> TestEvents = [{eh_A,start_logging,{'DEF','RUNDIR'}}, {eh_A,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - {eh_A,start_info,{1,1,4}}, + {eh_A,start_info,{1,1,5}}, {eh_A,tc_start,{eh_11_SUITE,init_per_suite}}, {eh_A,tc_done,{eh_11_SUITE,init_per_suite,ok}}, - {eh_A,tc_start,{eh_11_SUITE,tc1}}, - {eh_A,tc_done,{eh_11_SUITE,tc1,ok}}, - {eh_A,test_stats,{1,0,{0,0}}}, - {eh_A,tc_start,{eh_11_SUITE,tc2}}, - {eh_A,tc_done,{eh_11_SUITE,tc2,{skipped,"Skip"}}}, - {eh_A,test_stats,{1,0,{1,0}}}, - {eh_A,tc_start,{eh_11_SUITE,tc3}}, - {eh_A,tc_done,{eh_11_SUITE,tc3,{skipped,"Skipped"}}}, - {eh_A,test_stats,{1,0,{2,0}}}, - {eh_A,tc_start,{eh_11_SUITE,tc4}}, - {eh_A,tc_done,{eh_11_SUITE,tc4,{failed,{error,'Failing'}}}}, - {eh_A,test_stats,{1,1,{2,0}}}, + [{eh_A,tc_start,{eh_11_SUITE,{init_per_group,g1,[]}}}, + {eh_A,tc_done,{eh_11_SUITE,{init_per_group,g1,[]},ok}}, + {eh_A,tc_start,{eh_11_SUITE,tc1}}, + {eh_A,tc_done,{eh_11_SUITE,tc1,ok}}, + {eh_A,test_stats,{1,0,{0,0}}}, + {eh_A,tc_start,{eh_11_SUITE,tc2}}, + {eh_A,tc_done,{eh_11_SUITE,tc2,ok}}, + {eh_A,test_stats,{2,0,{0,0}}}, + {eh_A,tc_start,{eh_11_SUITE,tc3}}, + {eh_A,tc_done,{eh_11_SUITE,tc3,{skipped,"Skip"}}}, + {eh_A,test_stats,{2,0,{1,0}}}, + {eh_A,tc_start,{eh_11_SUITE,tc4}}, + {eh_A,tc_done,{eh_11_SUITE,tc4,{skipped,"Skipped"}}}, + {eh_A,test_stats,{2,0,{2,0}}}, + {eh_A,tc_start,{eh_11_SUITE,tc5}}, + {eh_A,tc_done,{eh_11_SUITE,tc5,{failed,{error,'Failing'}}}}, + {eh_A,test_stats,{2,1,{2,0}}}, + {eh_A,tc_start,{eh_11_SUITE,{end_per_group,g1,[]}}}, + {eh_A,tc_done,{eh_11_SUITE,{end_per_group,g1,[]},ok}}], {eh_A,tc_start,{eh_11_SUITE,end_per_suite}}, {eh_A,tc_done,{eh_11_SUITE,end_per_suite,ok}}, {eh_A,test_done,{'DEF','STOP_TIME'}}, @@ -179,5 +187,10 @@ results(Config) when is_list(Config) -> ok = ct_test_support:verify_events(TestEvents++TestEvents, Events, Config). +event_mgrs(_) -> + ?CT_EVMGR_REF = ct:get_event_mgr_ref(), + ?CT_MEVMGR_REF = ct_master:get_event_mgr_ref(). + + %%%----------------------------------------------------------------- %%% HELP FUNCTIONS diff --git a/lib/common_test/test/ct_event_handler_SUITE_data/event_handling_1/test/eh_11_SUITE.erl b/lib/common_test/test/ct_event_handler_SUITE_data/event_handling_1/test/eh_11_SUITE.erl index a52fe96f30..14ea12d579 100644 --- a/lib/common_test/test/ct_event_handler_SUITE_data/event_handling_1/test/eh_11_SUITE.erl +++ b/lib/common_test/test/ct_event_handler_SUITE_data/event_handling_1/test/eh_11_SUITE.erl @@ -32,100 +32,36 @@ %% COMMON TEST CALLBACK FUNCTIONS %%-------------------------------------------------------------------- -%%-------------------------------------------------------------------- -%% Function: suite() -> Info -%% -%% Info = [tuple()] -%% List of key/value pairs. -%% -%% Description: Returns list of tuples to set default properties -%% for the suite. -%% -%% Note: The suite/0 function is only meant to be used to return -%% default data values, not perform any other operations. -%%-------------------------------------------------------------------- suite() -> [ {timetrap,{seconds,10}} ]. -%%-------------------------------------------------------------------- -%% Function: init_per_suite(Config0) -> -%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} -%% -%% Config0 = Config1 = [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Reason = term() -%% The reason for skipping the suite. -%% -%% Description: Initialization before the suite. -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- init_per_suite(Config) -> Config. -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config0) -> void() | {save_config,Config1} -%% -%% Config0 = Config1 = [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Cleanup after the suite. -%%-------------------------------------------------------------------- end_per_suite(_Config) -> - ok. + %% should report ok as result to event handler + done. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + %% should report ok as result to event handler + void. -%%-------------------------------------------------------------------- -%% Function: init_per_testcase(TestCase, Config0) -> -%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} -%% -%% TestCase = atom() -%% Name of the test case that is about to run. -%% Config0 = Config1 = [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Reason = term() -%% The reason for skipping the test case. -%% -%% Description: Initialization before each test case. -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- init_per_testcase(_TestCase, Config) -> Config. -%%-------------------------------------------------------------------- -%% Function: end_per_testcase(TestCase, Config0) -> -%% void() | {save_config,Config1} -%% -%% TestCase = atom() -%% Name of the test case that is finished. -%% Config0 = Config1 = [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Cleanup after each test case. -%%-------------------------------------------------------------------- end_per_testcase(_TestCase, _Config) -> - ok. + true. -%%-------------------------------------------------------------------- -%% Function: all() -> TestCases | {skip,Reason} -%% -%% TestCases = [TestCase | {sequence,SeqName}] -%% TestCase = atom() -%% Name of a test case. -%% SeqName = atom() -%% Name of a test case sequence. -%% Reason = term() -%% The reason for skipping all test cases. -%% -%% Description: Returns the list of test cases that are to be executed. -%%-------------------------------------------------------------------- -all() -> - [tc1, tc2, tc3, tc4]. +groups() -> + [{g1, [], [tc1, tc2, tc3, tc4, tc5]}]. +all() -> + [{group,g1}]. %%-------------------------------------------------------------------- %% TEST CASES @@ -134,11 +70,15 @@ all() -> tc1(_Config) -> ok. -tc2(_Config) -> - {skip,"Skip"}. +tc2(_Config) -> + %% should report ok as result to event handler + 42. tc3(_Config) -> + {skip,"Skip"}. + +tc4(_Config) -> {skipped,"Skipped"}. -tc4(_Config) -> +tc5(_Config) -> exit('Failing'). diff --git a/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl b/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl index 1344878675..96dd80e4e8 100644 --- a/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl +++ b/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl @@ -73,23 +73,23 @@ handles_to_multi_conn_pids(_Config) -> {true,true} = {is_process_alive(Handle3),is_process_alive(ConnPid3)}, ok = proto:close(Handle1), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle1),is_process_alive(ConnPid1)}, {true,true} = {is_process_alive(Handle2),is_process_alive(ConnPid2)}, ok = proto:kill_conn_proc(Handle2), - timer:sleep(100), + ct:sleep(100), {true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2)}, ConnPid2x = ct_gen_conn:get_conn_pid(Handle2), true = is_process_alive(ConnPid2x), ok = proto:close(Handle2), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2x)}, application:set_env(ct_test, reconnect, false), ok = proto:kill_conn_proc(Handle3), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle3),is_process_alive(ConnPid3)}, ok. @@ -116,23 +116,23 @@ handles_to_single_conn_pids(_Config) -> ct:pal("CONNS = ~n~p", [Conns]), ok = proto:close(Handle1), - timer:sleep(100), + ct:sleep(100), {false,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)}, ok = proto:kill_conn_proc(Handle2), - timer:sleep(100), + ct:sleep(100), NewConnPid = ct_gen_conn:get_conn_pid(Handle2), NewConnPid = ct_gen_conn:get_conn_pid(Handle3), true = is_process_alive(Handle2), true = is_process_alive(Handle3), ok = proto:close(Handle2), - timer:sleep(100), + ct:sleep(100), {false,true} = {is_process_alive(Handle2),is_process_alive(NewConnPid)}, application:set_env(ct_test, reconnect, false), ok = proto:kill_conn_proc(Handle3), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle3),is_process_alive(NewConnPid)}, ok. @@ -158,29 +158,29 @@ names_to_multi_conn_pids(_Config) -> Handle1 = proto:open(mconn1), ok = proto:close(mconn1), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle1),is_process_alive(ConnPid1)}, ok = proto:kill_conn_proc(Handle2), - timer:sleep(100), + ct:sleep(100), Handle2 = proto:open(mconn2), % should've been reconnected already {true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2)}, ConnPid2x = ct_gen_conn:get_conn_pid(Handle2), true = is_process_alive(ConnPid2x), ok = proto:close(mconn2), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2x)}, Handle2y = proto:open(mconn2), ConnPid2y = ct_gen_conn:get_conn_pid(Handle2y), {true,true} = {is_process_alive(Handle2y),is_process_alive(ConnPid2y)}, ok = proto:close(mconn2), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle2y),is_process_alive(ConnPid2y)}, application:set_env(ct_test, reconnect, false), ok = proto:kill_conn_proc(Handle3), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle3),is_process_alive(ConnPid3)}, ok. @@ -211,11 +211,11 @@ names_to_single_conn_pids(_Config) -> ct:pal("CONNS on ~p = ~n~p", [ConnPid,Conns]), ok = proto:close(sconn1), - timer:sleep(100), + ct:sleep(100), {false,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)}, ok = proto:kill_conn_proc(Handle2), - timer:sleep(100), + ct:sleep(100), {true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid)}, Handle2 = proto:open(sconn2), % should've been reconnected already NewConnPid = ct_gen_conn:get_conn_pid(Handle2), @@ -227,12 +227,12 @@ names_to_single_conn_pids(_Config) -> ct:pal("CONNS on ~p = ~n~p", [NewConnPid,Conns1]), ok = proto:close(sconn2), - timer:sleep(100), + ct:sleep(100), {false,true} = {is_process_alive(Handle2),is_process_alive(NewConnPid)}, application:set_env(ct_test, reconnect, false), ok = proto:kill_conn_proc(Handle3), - timer:sleep(100), + ct:sleep(100), {false,false} = {is_process_alive(Handle3),is_process_alive(NewConnPid)}, ok. diff --git a/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl b/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl index 804f722081..bfdc78639e 100644 --- a/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl +++ b/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl @@ -258,14 +258,14 @@ gen_io(Label, N, Acc) -> %% (via ct logging functions) from an external process which has a %% different group leader than the test cases. unexp1(Config) -> - timer:sleep(1000), + ct:sleep(1000), gen_unexp_io(), - timer:sleep(1000), + ct:sleep(1000), check_unexp_io(Config), ok. unexp2(_) -> - timer:sleep(2000), + ct:sleep(2000), ok. gen_unexp_io() -> diff --git a/lib/common_test/test/ct_groups_test_1_SUITE.erl b/lib/common_test/test/ct_groups_test_1_SUITE.erl index e520a72227..d5de949554 100644 --- a/lib/common_test/test/ct_groups_test_1_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_1_SUITE.erl @@ -302,7 +302,7 @@ test_events(groups_suite_1) -> {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]; @@ -410,7 +410,7 @@ test_events(groups_suite_2) -> {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_12_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]; @@ -505,7 +505,7 @@ test_events(groups_suites_1) -> {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, {?eh,tc_done,{groups_12_SUITE,init_per_suite,ok}}, @@ -596,7 +596,7 @@ test_events(groups_suites_1) -> {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_12_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]; @@ -691,7 +691,7 @@ test_events(groups_dir_1) -> {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, {?eh,tc_done,{groups_12_SUITE,init_per_suite,ok}}, @@ -782,7 +782,7 @@ test_events(groups_dir_1) -> {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_12_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]; @@ -878,7 +878,7 @@ test_events(groups_dirs_1) -> {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, {?eh,tc_done,{groups_12_SUITE,init_per_suite,ok}}, @@ -969,7 +969,7 @@ test_events(groups_dirs_1) -> {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_12_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}}, {?eh,tc_start,{groups_21_SUITE,init_per_suite}}, {?eh,tc_done,{groups_21_SUITE,init_per_suite,ok}}, @@ -1089,7 +1089,7 @@ test_events(groups_dirs_1) -> {groups_21_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_21_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_21_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_21_SUITE,end_per_suite,ok}}, {?eh,tc_start,{groups_22_SUITE,init_per_suite}}, {?eh,tc_done,{groups_22_SUITE,init_per_suite,ok}}, @@ -1223,6 +1223,6 @@ test_events(groups_dirs_1) -> {groups_22_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_22_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_22_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_22_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]. diff --git a/lib/common_test/test/ct_groups_test_1_SUITE_data/groups_1/test/groups_12_SUITE.erl b/lib/common_test/test/ct_groups_test_1_SUITE_data/groups_1/test/groups_12_SUITE.erl index ec90ef95d1..6f49f9a957 100644 --- a/lib/common_test/test/ct_groups_test_1_SUITE_data/groups_1/test/groups_12_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_1_SUITE_data/groups_1/test/groups_12_SUITE.erl @@ -278,7 +278,7 @@ testcase_5a(Config) -> %% increase chance the done event will come %% during execution of subgroup (could be %% tricky to handle) - timer:sleep(3), + ct:sleep(3), ok. testcase_5b() -> []. diff --git a/lib/common_test/test/ct_groups_test_2_SUITE.erl b/lib/common_test/test/ct_groups_test_2_SUITE.erl index 8b0de98709..f41395e028 100644 --- a/lib/common_test/test/ct_groups_test_2_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_2_SUITE.erl @@ -302,7 +302,7 @@ test_events(empty_group) -> {?eh,tc_done, {groups_22_SUITE,{end_per_group,test_group_8,[]},ok}}], {?eh,tc_start,{groups_22_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_22_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_22_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]. diff --git a/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl b/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl index 154c676d7e..80bb5ba69b 100644 --- a/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl @@ -293,7 +293,7 @@ testcase_5a(Config) -> %% increase chance the done event will come %% during execution of subgroup (could be %% tricky to handle) - timer:sleep(3), + ct:sleep(3), ok. testcase_5b() -> []. 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 3c1f5669e8..f8c8725602 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 @@ -26,21 +26,23 @@ -include("ct.hrl").
+-define(now, os:timestamp()).
+
%% Test server callback functions
init_per_suite(Config) ->
- [{init_per_suite,now()}|Config].
+ [{init_per_suite,?now}|Config].
end_per_suite(_Config) ->
ok.
init_per_testcase(_TestCase, Config) ->
- [{init_per_testcase,now()}|Config].
+ [{init_per_testcase,?now}|Config].
end_per_testcase(_TestCase, _Config) ->
ok.
init_per_group(GroupName, Config) ->
- [{init_per_group,now()}|Config].
+ [{init_per_group,?now}|Config].
end_per_group(GroupName, Config) ->
ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl index 18dd07e87e..80ce248418 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/cth_log_SUITE.erl @@ -50,7 +50,7 @@ init_per_suite(Config) -> end_per_suite(Config) -> Gen = proplists:get_value(gen, Config), exit(Gen, kill), - timer:sleep(100), + ct:sleep(100), 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 77783fccf5..5f8eae1f70 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 @@ -87,7 +87,7 @@ id(Opts) -> gen_event:notify(?CT_EVMGR_REF, #event{ name = cth, node = node(), data = {?MODULE, id, [Opts]}}), ct:log("~w:id called", [?MODULE]), - now(). + os: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 2ee0d7da9c..55a1b9a130 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 @@ -24,6 +24,7 @@ -include_lib("common_test/src/ct_util.hrl").
-include_lib("common_test/include/ct_event.hrl").
+-define(now, os:timestamp()).
%% CT Hooks
-compile(export_all).
@@ -33,44 +34,44 @@ init(Id, Opts) -> pre_init_per_suite(Suite, Config, State) ->
empty_cth:pre_init_per_suite(Suite,Config,State),
- {[{pre_init_per_suite,now()}|Config],State}.
+ {[{pre_init_per_suite,?now}|Config],State}.
post_init_per_suite(Suite,Config,Return,State) ->
empty_cth:post_init_per_suite(Suite,Config,Return,State),
- {[{post_init_per_suite,now()}|Return],State}.
+ {[{post_init_per_suite,?now}|Return],State}.
pre_end_per_suite(Suite,Config,State) ->
empty_cth:pre_end_per_suite(Suite,Config,State),
- {[{pre_end_per_suite,now()}|Config],State}.
+ {[{pre_end_per_suite,?now}|Config],State}.
post_end_per_suite(Suite,Config,Return,State) ->
empty_cth:post_end_per_suite(Suite,Config,Return,State),
- NewConfig = [{post_end_per_suite,now()}|Config],
+ NewConfig = [{post_end_per_suite,?now}|Config],
{NewConfig,NewConfig}.
pre_init_per_group(Group,Config,State) ->
empty_cth:pre_init_per_group(Group,Config,State),
- {[{pre_init_per_group,now()}|Config],State}.
+ {[{pre_init_per_group,?now}|Config],State}.
post_init_per_group(Group,Config,Return,State) ->
empty_cth:post_init_per_group(Group,Config,Return,State),
- {[{post_init_per_group,now()}|Return],State}.
+ {[{post_init_per_group,?now}|Return],State}.
pre_end_per_group(Group,Config,State) ->
empty_cth:pre_end_per_group(Group,Config,State),
- {[{pre_end_per_group,now()}|Config],State}.
+ {[{pre_end_per_group,?now}|Config],State}.
post_end_per_group(Group,Config,Return,State) ->
empty_cth:post_end_per_group(Group,Config,Return,State),
- {[{post_end_per_group,now()}|Config],State}.
+ {[{post_end_per_group,?now}|Config],State}.
pre_init_per_testcase(TC,Config,State) ->
empty_cth:pre_init_per_testcase(TC,Config,State),
- {[{pre_init_per_testcase,now()}|Config],State}.
+ {[{pre_init_per_testcase,?now}|Config],State}.
post_end_per_testcase(TC,Config,Return,State) ->
empty_cth:post_end_per_testcase(TC,Config,Return,State),
- {[{post_end_per_testcase,now()}|Config],State}.
+ {[{post_end_per_testcase,?now}|Config],State}.
on_tc_fail(TC, Reason, State) ->
empty_cth:on_tc_fail(TC,Reason,State).
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 332e54d1a7..e26ed4089a 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 @@ -150,7 +150,7 @@ hello_from_server_first(Config) -> {ok,Client} = ct_netconfc:only_open(?DEFAULT_SSH_OPTS(DataDir)), ct:sleep(500), ?NS:expect(hello), - ?ok = ct_netconfc:hello(Client), + ?ok = ct_netconfc:hello(Client, [{capability, ["urn:com:ericsson:ebase:1.1.0"]}], infinity), ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client), ok. @@ -204,7 +204,7 @@ hello_required_exists(Config) -> ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(my_named_connection), - timer:sleep(500), + ct:sleep(500), %% Then check that it can be used again after the first is closed {ok,_Client2} = open_configured_success(my_named_connection,DataDir), @@ -486,8 +486,18 @@ action(Config) -> DataDir = ?config(data_dir,Config), {ok,Client} = open_success(DataDir), Data = [{myactionreturn,[{xmlns,"myns"}],["value"]}], - ?NS:expect_reply(action,{data,Data}), - {ok,Data} = ct_netconfc:action(Client,{myaction,[{xmlns,"myns"}],[]}), + %% test either to receive {data,Data} or {ok,Data}, + %% both need to be handled + ct:log("Client will receive {~w,~p}", [data,Data]), + ct:log("Expecting ~p", [{ok, Data}]), + ?NS:expect_reply(action,{data, Data}), + {ok, Data} = ct_netconfc:action(Client,{myaction,[{xmlns,"myns"}],[]}), + + ct:log("Client will receive {~w,~p}", [ok,Data]), + ct:log("Expecting ~p", [ok]), + ?NS:expect_reply(action,{ok, Data}), + ok = ct_netconfc:action(Client,{myaction,[{xmlns,"myns"}],[]}), + ?NS:expect_do_reply('close-session',close,ok), ?ok = ct_netconfc:close_session(Client), ok. @@ -654,10 +664,10 @@ receive_chunked_data(Config) -> %% Spawn a process which will wait a bit for the client to send %% the request (below), then order the server to the chunks of the %% rpc-reply one by one. - spawn(fun() -> timer:sleep(500),?NS:hupp(send,Part1), - timer:sleep(100),?NS:hupp(send,Part2), - timer:sleep(100),?NS:hupp(send,Part3), - timer:sleep(100),?NS:hupp(send,Part4) + spawn(fun() -> ct:sleep(500),?NS:hupp(send,Part1), + ct:sleep(100),?NS:hupp(send,Part2), + ct:sleep(100),?NS:hupp(send,Part3), + ct:sleep(100),?NS:hupp(send,Part4) end), %% Order server to expect a get - then the process above will make @@ -702,8 +712,8 @@ timeout_receive_chunked_data(Config) -> %% Spawn a process which will wait a bit for the client to send %% the request (below), then order the server to the chunks of the %% rpc-reply one by one. - spawn(fun() -> timer:sleep(500),?NS:hupp(send,Part1), - timer:sleep(100),?NS:hupp(send,Part2) + spawn(fun() -> ct:sleep(500),?NS:hupp(send,Part1), + ct:sleep(100),?NS:hupp(send,Part2) end), %% Order server to expect a get - then the process above will make @@ -748,9 +758,9 @@ close_while_waiting_for_chunked_data(Config) -> %% Spawn a process which will wait a bit for the client to send %% the request (below), then order the server to the chunks of the %% rpc-reply one by one. - spawn(fun() -> timer:sleep(500),?NS:hupp(send,Part1), - timer:sleep(100),?NS:hupp(send,Part2), - timer:sleep(100),?NS:hupp(kill) + spawn(fun() -> ct:sleep(500),?NS:hupp(send,Part1), + ct:sleep(100),?NS:hupp(send,Part2), + ct:sleep(100),?NS:hupp(kill) end), %% Order server to expect a get - then the process above will make @@ -766,7 +776,7 @@ connection_crash(Config) -> %% Test that if the test survives killing the connection %% process. Earlier this caused ct_util_server to terminate, and %% this aborting the complete test run. - spawn(fun() -> timer:sleep(500),exit(Client,kill) end), + spawn(fun() -> ct:sleep(500),exit(Client,kill) end), ?NS:expect(get), {error,{closed,killed}}=ct_netconfc:get(Client,{server,[{xmlns,"myns"}],[]}), ok. diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl index f7c7b891bb..e4bc396536 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl @@ -351,7 +351,7 @@ check_expected(SessionId,ConnRef,Msg) -> do(ConnRef, Do), reply(ConnRef,Reply); error -> - timer:sleep(1000), + ct:sleep(1000), exit({error,{got_unexpected,SessionId,Msg,ets:tab2list(ns_tab)}}) end. @@ -548,8 +548,13 @@ make_msg({hello,SessionId,Stuff}) -> SessionIdXml/binary,"</hello>">>); make_msg(ok) -> xml(rpc_reply("<ok/>")); + +make_msg({ok,Data}) -> + xml(rpc_reply(from_simple({ok,Data}))); + make_msg({data,Data}) -> xml(rpc_reply(from_simple({data,Data}))); + make_msg(event) -> xml(<<"<notification xmlns=\"",?NETCONF_NOTIF_NAMESPACE,"\">" "<eventTime>2012-06-14T14:50:54+02:00</eventTime>" 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 5de1ecc2bd..1e6018f442 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 @@ -91,27 +91,27 @@ pre_post_io(Config) -> spawn(fun() -> ct:pal("CONTROLLER: Started!", []), %% --- test run 1 --- - timer:sleep(3000), + ct:sleep(3000), ct:pal("CONTROLLER: Handle remote events = true", []), ok = ct_test_support:ct_rpc({cth_log_redirect, handle_remote_events, [true]}, Config), - timer:sleep(2000), + ct:sleep(2000), ct:pal("CONTROLLER: Proceeding with test run #1!", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), - timer:sleep(6000), + ct:sleep(6000), ct:pal("CONTROLLER: Proceeding with shutdown #1!", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), %% --- test run 2 --- - timer:sleep(3000), + ct:sleep(3000), ct:pal("CONTROLLER: Handle remote events = true", []), ok = ct_test_support:ct_rpc({cth_log_redirect, handle_remote_events, [true]}, Config), - timer:sleep(2000), + ct:sleep(2000), ct:pal("CONTROLLER: Proceeding with test run #2!", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config), - timer:sleep(6000), + ct:sleep(6000), ct:pal("CONTROLLER: Proceeding with shutdown #2!", []), ok = ct_test_support:ct_rpc({cth_ctrl,proceed,[]}, Config) end), diff --git a/lib/common_test/test/ct_repeat_1_SUITE.erl b/lib/common_test/test/ct_repeat_1_SUITE.erl index e37aeb196c..50e07608f6 100644 --- a/lib/common_test/test/ct_repeat_1_SUITE.erl +++ b/lib/common_test/test/ct_repeat_1_SUITE.erl @@ -220,8 +220,7 @@ test_events(repeat_cs_and_grs) -> {?eh,test_stats,{1,1,{0,0}}}, [{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_result,[]},ok}}, {?eh,test_stats,{2,1,{0,0}}}, - {?eh,tc_done,{repeat_1_SUITE,{end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {?eh,tc_done,{repeat_1_SUITE,{end_per_group,gr_fail_result,[]},ok}}], {?eh,test_stats,{3,1,{0,0}}}, [{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_init,[]}, {failed,{error,fails_on_purpose}}}}, @@ -242,8 +241,7 @@ test_events(repeat_cs_and_grs) -> {?eh,test_stats,{5,2,{0,1}}}, [{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_result,[]},ok}}, {?eh,test_stats,{6,2,{0,1}}}, - {?eh,tc_done,{repeat_1_SUITE,{end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {?eh,tc_done,{repeat_1_SUITE,{end_per_group,gr_fail_result,[]},ok}}], {?eh,test_stats,{7,2,{0,1}}}, [{?eh,tc_done,{repeat_1_SUITE,{init_per_group,gr_fail_init,[]}, {failed,{error,fails_on_purpose}}}}, @@ -289,8 +287,7 @@ test_events(repeat_seq) -> {init_per_group,gr_fail_result,[]},ok}}, {?eh,test_stats,{4,2,{0,2}}}, {?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result,[]},ok}}], {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_2,repeat_seq_2}, {group_result,gr_fail_result,failed}}}, {?eh,test_stats,{4,2,{0,3}}}, @@ -402,8 +399,7 @@ test_events(repeat_gr_until_any_ok) -> [{?eh,tc_done,{repeat_1_SUITE, {init_per_group,gr_fail_result,[]},ok}}, {?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE,tc_fail_1, {failed,{error,{{badmatch,2},'_'}}}}}, {?eh,test_stats,{1,1,{0,0}}}, @@ -418,8 +414,7 @@ test_events(repeat_gr_until_any_ok) -> [{?eh,tc_done,{repeat_1_SUITE, {init_per_group,gr_fail_result_then_ok,[]},ok}}, {?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result_then_ok,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result_then_ok,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE, {end_per_group,repeat_gr_until_any_ok_1, [{repeat_until_any_ok,3}]},ok}}], @@ -441,8 +436,7 @@ test_events(repeat_gr_until_any_ok) -> {init_per_group,repeat_gr_until_any_ok_2, [{repeat_until_any_ok,3}]},ok}}, [{?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE,tc_fail_1, {failed,{error,{{badmatch,2},'_'}}}}}, {?eh,test_stats,{5,5,{0,2}}}, @@ -675,8 +669,7 @@ test_events(repeat_gr_until_any_fail) -> {repeat_1_SUITE,{end_per_group,gr_ok_then_fail_result,[]}}}, {?eh,tc_done, {repeat_1_SUITE, - {end_per_group,gr_ok_then_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_ok_then_fail_result,[]},ok}}], {?eh,tc_start,{repeat_1_SUITE,tc_ok_2}}, {?eh,tc_done,{repeat_1_SUITE,tc_ok_2,ok}}, {?eh,test_stats,{8,0,{0,0}}}, @@ -938,8 +931,7 @@ test_events(repeat_gr_until_all_ok) -> {?eh,tc_done,{repeat_1_SUITE,tc_ok_1,ok}}, {?eh,test_stats,{3,1,{0,0}}}, {?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result_then_ok,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result_then_ok,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE, {end_per_group,repeat_gr_until_all_ok_1, [{repeat_until_all_ok,3}]},ok}}], @@ -1113,8 +1105,7 @@ test_events(repeat_gr_until_all_fail) -> gr_ok_then_fail_result,[]},ok}}, {?eh,test_stats,{3,3,{0,2}}}, {?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_ok_then_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_ok_then_fail_result,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE, {end_per_group,repeat_gr_until_all_fail_1, [{repeat_until_all_fail,2}]},ok}}], @@ -1148,8 +1139,7 @@ test_events(repeat_gr_until_all_fail) -> {init_per_group,repeat_gr_until_all_fail_3, [{repeat_until_all_fail,3}]},ok}}, [{?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE,tc_ok_then_fail_1,ok}}, {?eh,test_stats,{6,5,{0,3}}}, {?eh,tc_done,{repeat_1_SUITE, @@ -1159,8 +1149,7 @@ test_events(repeat_gr_until_all_fail) -> {init_per_group,repeat_gr_until_all_fail_3, [{repeat_until_all_fail,2}]},ok}}, [{?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_fail_result,[]},ok}}], {?eh,tc_done,{repeat_1_SUITE,tc_ok_then_fail_1, {failed,{error,failing_this_time}}}}, {?eh,test_stats,{7,6,{0,3}}}, @@ -1263,8 +1252,7 @@ test_events(repeat_seq_until_any_fail) -> {init_per_group,repeat_seq_until_any_fail_4, [{repeat_until_any_fail,2},sequence]},ok}}, [{?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_ok_then_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_ok_then_fail_result,[]},ok}}], {?eh,tc_auto_skip,{repeat_1_SUITE,{tc_ok_1,gr_ok_1}, {group_result,gr_ok_then_fail_result,failed}}}, {?eh,test_stats,{19,1,{0,3}}}, @@ -1473,8 +1461,7 @@ test_events(repeat_shuffled_seq_until_any_fail) -> [{?eh,tc_start,{repeat_1_SUITE, {end_per_group,gr_ok_then_fail_result,[]}}}, {?eh,tc_done,{repeat_1_SUITE, - {end_per_group,gr_ok_then_fail_result,[]}, - {return_group_result,failed}}}], + {end_per_group,gr_ok_then_fail_result,[]},ok}}], {?eh,tc_start,{repeat_1_SUITE, {end_per_group,repeat_shuffled_seq_until_any_fail_4, [{shuffle,repeated},{repeat_until_any_fail,2},sequence]}}}, diff --git a/lib/common_test/test/ct_repeat_testrun_SUITE_data/a_test/r1_SUITE.erl b/lib/common_test/test/ct_repeat_testrun_SUITE_data/a_test/r1_SUITE.erl index 3fd5943691..3d7049a9c4 100644 --- a/lib/common_test/test/ct_repeat_testrun_SUITE_data/a_test/r1_SUITE.erl +++ b/lib/common_test/test/ct_repeat_testrun_SUITE_data/a_test/r1_SUITE.erl @@ -68,7 +68,7 @@ end_per_testcase(_Case, Config) -> %%%----------------------------------------------------------------- %%% Test cases tc1(_Config) -> - timer:sleep(10000), + ct:sleep(10000), ok. tc2(_Config) -> diff --git a/lib/common_test/test/ct_repeat_testrun_SUITE_data/b_test/r2_SUITE.erl b/lib/common_test/test/ct_repeat_testrun_SUITE_data/b_test/r2_SUITE.erl index dc9abc2863..e4f6e7dcc1 100644 --- a/lib/common_test/test/ct_repeat_testrun_SUITE_data/b_test/r2_SUITE.erl +++ b/lib/common_test/test/ct_repeat_testrun_SUITE_data/b_test/r2_SUITE.erl @@ -68,7 +68,7 @@ end_per_testcase(_Case, Config) -> %%%----------------------------------------------------------------- %%% Test cases tc1(_Config) -> - %% timer:sleep(3000), + %% ct:sleep(3000), ok. tc2(_Config) -> diff --git a/lib/common_test/test/ct_sequence_1_SUITE.erl b/lib/common_test/test/ct_sequence_1_SUITE.erl index 5a775a1117..4055cd789e 100644 --- a/lib/common_test/test/ct_sequence_1_SUITE.erl +++ b/lib/common_test/test/ct_sequence_1_SUITE.erl @@ -182,8 +182,7 @@ test_events(subgroup_return_fail) -> {?eh,test_stats,{0,1,{0,0}}}, {?eh,tc_start, {subgroups_1_SUITE,{end_per_group,return_fail,[]}}}, - {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]}, - {return_group_result,failed}}}], + {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]},ok}}], {?eh,tc_auto_skip, {subgroups_1_SUITE,{ok_tc,ok_group}, {group_result,return_fail,failed}}}, @@ -191,8 +190,7 @@ test_events(subgroup_return_fail) -> {?eh,tc_start, {subgroups_1_SUITE,{end_per_group,subgroup_return_fail,[sequence]}}}, {?eh,tc_done, - {subgroups_1_SUITE,{end_per_group,subgroup_return_fail,[sequence]}, - {return_group_result,failed}}}], + {subgroups_1_SUITE,{end_per_group,subgroup_return_fail,[sequence]},ok}}], {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -221,8 +219,7 @@ test_events(subgroup_init_fail) -> {?eh,test_stats,{0,0,{0,2}}}, {?eh,tc_start,{subgroups_1_SUITE,{end_per_group,subgroup_init_fail,[sequence]}}}, {?eh,tc_done,{subgroups_1_SUITE, - {end_per_group,subgroup_init_fail,[sequence]}, - {return_group_result,failed}}}], + {end_per_group,subgroup_init_fail,[sequence]},ok}}], {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -245,8 +242,7 @@ test_events(subgroup_after_failed_case) -> {?eh,tc_start,{subgroups_1_SUITE, {end_per_group,subgroup_after_failed_case,[sequence]}}}, {?eh,tc_done,{subgroups_1_SUITE, - {end_per_group,subgroup_after_failed_case,[sequence]}, - {return_group_result,failed}}}], + {end_per_group,subgroup_after_failed_case,[sequence]},ok}}], {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -266,16 +262,14 @@ test_events(case_after_subgroup_return_fail) -> {?eh,tc_done,{subgroups_1_SUITE,failing_tc,{failed,{error,{{badmatch,3},'_'}}}}}, {?eh,test_stats,{0,1,{0,0}}}, {?eh,tc_start,{subgroups_1_SUITE,{end_per_group,return_fail,[]}}}, - {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]}, - {return_group_result,failed}}}], + {?eh,tc_done,{subgroups_1_SUITE,{end_per_group,return_fail,[]},ok}}], {?eh,tc_auto_skip,{subgroups_1_SUITE,{ok_tc,case_after_subgroup_return_fail}, {group_result,return_fail,failed}}}, {?eh,test_stats,{0,1,{0,1}}}, {?eh,tc_start,{subgroups_1_SUITE, {end_per_group,case_after_subgroup_return_fail,[sequence]}}}, {?eh,tc_done,{subgroups_1_SUITE, - {end_per_group,case_after_subgroup_return_fail,[sequence]}, - {return_group_result,failed}}}], + {end_per_group,case_after_subgroup_return_fail,[sequence]},ok}}], {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -310,8 +304,7 @@ test_events(case_after_subgroup_fail_init) -> {?eh,tc_start,{subgroups_1_SUITE, {end_per_group,case_after_subgroup_fail_init,[sequence]}}}, {?eh,tc_done,{subgroups_1_SUITE, - {end_per_group,case_after_subgroup_fail_init,[sequence]}, - {return_group_result,failed}}}], + {end_per_group,case_after_subgroup_fail_init,[sequence]},ok}}], {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]. diff --git a/lib/common_test/test/ct_shell_SUITE.erl b/lib/common_test/test/ct_shell_SUITE.erl index 4b8c43d800..70c0ab8127 100644 --- a/lib/common_test/test/ct_shell_SUITE.erl +++ b/lib/common_test/test/ct_shell_SUITE.erl @@ -93,7 +93,7 @@ start_interactive(Config) -> test_server:format(Level, "ct_util_server not stopped on ~p yet, waiting 5 s...~n", [CTNode]), - timer:sleep(5000), + ct:sleep(5000), undefined = rpc:call(CTNode, erlang, whereis, [ct_util_server]) end, Events = ct_test_support:get_events(ERPid, Config), diff --git a/lib/common_test/test/ct_skip_SUITE_data/skip/test/auto_skip_4_SUITE.erl b/lib/common_test/test/ct_skip_SUITE_data/skip/test/auto_skip_4_SUITE.erl index 825846cd55..89e202a404 100644 --- a/lib/common_test/test/ct_skip_SUITE_data/skip/test/auto_skip_4_SUITE.erl +++ b/lib/common_test/test/ct_skip_SUITE_data/skip/test/auto_skip_4_SUITE.erl @@ -72,7 +72,7 @@ end_per_group(_GroupName, _Config) -> %% Reason = term() %%-------------------------------------------------------------------- init_per_testcase(tc1, Config) -> - timer:sleep(5000), + ct:sleep(5000), Config; init_per_testcase(_TestCase, Config) -> Config. diff --git a/lib/common_test/test/ct_smoke_test_SUITE.erl b/lib/common_test/test/ct_smoke_test_SUITE.erl index 49b38361e2..6077946c33 100644 --- a/lib/common_test/test/ct_smoke_test_SUITE.erl +++ b/lib/common_test/test/ct_smoke_test_SUITE.erl @@ -480,7 +480,7 @@ events(Test) when Test == dir1 ; Test == dir2 ; {Suite,tc4,{skipped,"Skipping this one"}}}, {?eh,test_stats,{7,0,{1,0}}}, {?eh,tc_start,{Suite,end_per_suite}}, - {?eh,tc_done,{Suite,end_per_suite,ips_data}}, + {?eh,tc_done,{Suite,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -517,7 +517,7 @@ events(Test) when Test == dir1_2 ; Test == suite11_21 -> {happy_11_SUITE,tc4,{skipped,"Skipping this one"}}}, {?eh,test_stats,{7,0,{1,0}}}, {?eh,tc_start,{happy_11_SUITE,end_per_suite}}, - {?eh,tc_done,{happy_11_SUITE,end_per_suite,ips_data}}, + {?eh,tc_done,{happy_11_SUITE,end_per_suite,ok}}, {?eh,tc_start,{happy_21_SUITE,init_per_suite}}, {?eh,tc_done,{happy_21_SUITE,init_per_suite,ok}}, {?eh,tc_start,{happy_21_SUITE,tc1}}, @@ -546,7 +546,7 @@ events(Test) when Test == dir1_2 ; Test == suite11_21 -> {happy_21_SUITE,tc4,{skipped,"Skipping this one"}}}, {?eh,test_stats,{14,0,{2,0}}}, {?eh,tc_start,{happy_21_SUITE,end_per_suite}}, - {?eh,tc_done,{happy_21_SUITE,end_per_suite,ips_data}}, + {?eh,tc_done,{happy_21_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -563,7 +563,7 @@ events(Test) when Test == tc111 ; Test == tc211 -> {?eh,tc_done,{Suite,tc1,ok}}, {?eh,test_stats,{1,0,{0,0}}}, {?eh,tc_start,{Suite,end_per_suite}}, - {?eh,tc_done,{Suite,end_per_suite,ips_data}}, + {?eh,tc_done,{Suite,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]; @@ -582,7 +582,7 @@ events(tc111_112) -> {?eh,tc_done,{happy_11_SUITE,tc2,ok}}, {?eh,test_stats,{2,0,{0,0}}}, {?eh,tc_start,{happy_11_SUITE,end_per_suite}}, - {?eh,tc_done,{happy_11_SUITE,end_per_suite,ips_data}}, + {?eh,tc_done,{happy_11_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} ]. diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl index e20832e1e7..07f7bf02e4 100644 --- a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl @@ -117,12 +117,12 @@ break(_Config) -> start_stop(Config) -> ok = ct_snmp:start(Config,snmp1,snmp_app1), - timer:sleep(1000), + ct:sleep(1000), {snmp,_,_} = lists:keyfind(snmp,1,application:which_applications()), [_|_] = filelib:wildcard("*/*.conf",?config(priv_dir,Config)), ok = ct_snmp:stop(Config), - timer:sleep(1000), + ct:sleep(1000), false = lists:keyfind(snmp,1,application:which_applications()), [] = filelib:wildcard("*/*.conf",?config(priv_dir,Config)), ok. diff --git a/lib/common_test/test/ct_telnet_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE.erl index 84e69c2b54..62cb821ede 100644 --- a/lib/common_test/test/ct_telnet_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE.erl @@ -203,7 +203,9 @@ telnet_config(_, LogType) -> {command_timeout,10000}, {reconnection_attempts,0}, {reconnection_interval,0}, - {keep_alive,true}]} | + {keep_alive,true}, + {poll_limit,10}, + {poll_interval,1000}]} | if LogType == legacy -> [{ct_conn_log,[]}]; true -> diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl index bd5d76266a..9dc9095f47 100644 --- a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl @@ -40,6 +40,7 @@ all() -> expect, expect_repeat, expect_sequence, + expect_wait_until_prompt, expect_error_prompt, expect_error_timeout1, expect_error_timeout2, @@ -81,6 +82,8 @@ end_per_group(_GroupName, Config) -> expect(_) -> {ok, Handle} = ct_telnet:open(telnet_server_conn1), ok = ct_telnet:send(Handle, "echo ayt"), + {ok,["ayt"]} = ct_telnet:expect(Handle, "ayt"), + ok = ct_telnet:send(Handle, "echo ayt"), {ok,["ayt"]} = ct_telnet:expect(Handle, ["ayt"]), ok = ct_telnet:close(Handle), ok. @@ -103,6 +106,21 @@ expect_sequence(_) -> ok = ct_telnet:close(Handle), ok. +%% Check that expect can wait for delayed prompt +expect_wait_until_prompt(_) -> + {ok, Handle} = ct_telnet:open(telnet_server_conn1), + Timeouts = [{idle_timeout,5000},{total_timeout,7000}], + + ok = ct_telnet:send(Handle, "echo_delayed_prompt 3000 xxx"), + {ok,["xxx"]} = + ct_telnet:expect(Handle, "xxx", + [wait_for_prompt|Timeouts]), + ok = ct_telnet:send(Handle, "echo_delayed_prompt 3000 yyy zzz"), + {ok,[["yyy"],["zzz"]]} = + ct_telnet:expect(Handle, ["yyy","zzz"], + [{wait_for_prompt,"> "}|Timeouts]), + ok. + %% Check that expect returns when a prompt is found, even if pattern %% is not matched. expect_error_prompt(_) -> @@ -283,14 +301,14 @@ large_string(_) -> %% yield the same result as the single request case. ok = ct_telnet:send(Handle, "echo_sep "++BigString), - timer:sleep(1000), + ct:sleep(1000), {ok,Data1} = ct_telnet:get_data(Handle), ct:log("[GET DATA #1] Received ~w chars: ~s", [length(lists:flatten(Data1)),Data1]), VerifyStr = [C || C <- lists:flatten(Data1), C/=$ , C/=$\r, C/=$\n, C/=$>], ok = ct_telnet:send(Handle, "echo_sep "++BigString), - timer:sleep(50), + ct:sleep(50), {ok,Data2} = ct_telnet:get_data(Handle), ct:log("[GET DATA #2] Received ~w chars: ~s", [length(lists:flatten(Data2)),Data2]), VerifyStr = [C || C <- lists:flatten(Data2), C/=$ , C/=$\r, C/=$\n, C/=$>], @@ -316,7 +334,7 @@ server_speaks(_) -> "echo_no_prompt This is the second message"), %% Let ct_telnet_client get an idle timeout. This should print the %% two messages to the log. Note that the buffers are not flushed here! - timer:sleep(15000), + ct:sleep(15000), ok = ct_telnet_client:send_data(Backdoor, "echo_no_prompt This is the third message"), {ok,_} = ct_telnet:expect(Handle, ["first.*second.*third"], @@ -326,7 +344,7 @@ server_speaks(_) -> ok = ct_telnet_client:send_data(Backdoor, "echo_no_prompt This is the fourth message"), %% give the server time to respond - timer:sleep(2000), + ct:sleep(2000), %% closing the connection should print last message in log ok = ct_telnet:close(Handle), ok. @@ -338,11 +356,11 @@ server_disconnects(_) -> ok = ct_telnet:send(Handle, "disconnect_after 1500"), %% wait until the get_data operation (triggered by send/2) times out %% before sending the msg - timer:sleep(500), + ct:sleep(500), ok = ct_telnet:send(Handle, "echo_no_prompt This is the message"), %% when the server closes the connection, the last message should be %% printed in the log - timer:sleep(3000), + ct:sleep(3000), _ = ct_telnet:close(Handle), ok. diff --git a/lib/common_test/test/ct_test_server_if_1_SUITE.erl b/lib/common_test/test/ct_test_server_if_1_SUITE.erl index b6ef3062d4..214cb60c0d 100644 --- a/lib/common_test/test/ct_test_server_if_1_SUITE.erl +++ b/lib/common_test/test/ct_test_server_if_1_SUITE.erl @@ -236,14 +236,13 @@ test_events(ts_if_1) -> {ts_if_2_SUITE,end_per_suite, {failed,{error,{suite0_failed,{exited,suite0_goes_boom}}}}}}, - {?eh,tc_start,{ct_framework,error_in_suite}}, - {?eh,test_stats,{2,6,{4,7}}}, - + {?eh,tc_done,{ct_framework,error_in_suite, + {failed,{error,'ts_if_3_SUITE:all/0 is missing'}}}}, {?eh,tc_start,{ct_framework,error_in_suite}}, - {?eh,test_stats,{2,7,{4,7}}}, - + {?eh,tc_done,{ct_framework,error_in_suite, + {failed,{error,'Bad return value from ts_if_4_SUITE:all/0'}}}}, {?eh,tc_start,{ts_if_5_SUITE,init_per_suite}}, {?eh,tc_done,{ts_if_5_SUITE,init_per_suite, @@ -252,7 +251,7 @@ test_events(ts_if_1) -> {?eh,tc_auto_skip, {ts_if_5_SUITE,my_test_case, {require_failed_in_suite0,{not_available,undef_variable}}}}, - {?eh,test_stats,{2,7,{4,8}}}, + {?eh,test_stats,{2,5,{4,8}}}, {?eh,tc_auto_skip, {ts_if_5_SUITE,end_per_suite, {require_failed_in_suite0,{not_available,undef_variable}}}}, @@ -264,7 +263,7 @@ test_events(ts_if_1) -> {?eh,tc_auto_skip, {ts_if_6_SUITE,tc1, {failed,{error,{suite0_failed,{exited,suite0_byebye}}}}}}, - {?eh,test_stats,{2,7,{4,9}}}, + {?eh,test_stats,{2,5,{4,9}}}, {?eh,tc_auto_skip, {ct_framework,end_per_suite, {failed,{error,{suite0_failed,{exited,suite0_byebye}}}}}}, @@ -274,13 +273,13 @@ test_events(ts_if_1) -> {?eh,tc_done,{ct_framework,init_per_suite,ok}}, {?eh,tc_done, {ts_if_7_SUITE,tc1,{auto_skipped,{testcase0_failed,bad_return_value}}}}, - {?eh,test_stats,{2,7,{4,10}}}, + {?eh,test_stats,{2,5,{4,10}}}, {?eh,tc_done,{ts_if_7_SUITE, {init_per_group,g1,[]}, {auto_skipped,{group0_failed,bad_return_value}}}}, {?eh,tc_auto_skip, {ts_if_7_SUITE,{tc2,g1},{group0_failed,bad_return_value}}}, - {?eh,test_stats,{2,7,{4,11}}}, + {?eh,test_stats,{2,5,{4,11}}}, {?eh,tc_auto_skip, {ts_if_7_SUITE,{end_per_group,g1},{group0_failed,bad_return_value}}}, @@ -288,7 +287,7 @@ test_events(ts_if_1) -> {?eh,tc_done,{ts_if_7_SUITE,{init_per_group,g2,[]},ok}}, {?eh,tc_done,{ts_if_7_SUITE,tc2, {auto_skipped,{testcase0_failed,bad_return_value}}}}, - {?eh,test_stats,{2,7,{4,12}}}, + {?eh,test_stats,{2,5,{4,12}}}, {?eh,tc_start,{ts_if_7_SUITE,{end_per_group,g2,[]}}}, {?eh,tc_done,{ts_if_7_SUITE,{end_per_group,g2,[]},ok}}], @@ -300,17 +299,17 @@ test_events(ts_if_1) -> {?eh,tc_done,{ct_framework,init_per_suite,ok}}, {?eh,tc_start,{ts_if_8_SUITE,tc1}}, {?eh,tc_done,{ts_if_8_SUITE,tc1,{failed,{error,failed_on_purpose}}}}, - {?eh,test_stats,{2,8,{4,12}}}, + {?eh,test_stats,{2,6,{4,12}}}, {?eh,tc_start,{ct_framework,end_per_suite}}, {?eh,tc_done,{ct_framework,end_per_suite,ok}}, {?eh,tc_user_skip,{skipped_by_spec_1_SUITE,all,"should be skipped"}}, - {?eh,test_stats,{2,8,{5,12}}}, + {?eh,test_stats,{2,6,{5,12}}}, {?eh,tc_start,{skipped_by_spec_2_SUITE,init_per_suite}}, {?eh,tc_done,{skipped_by_spec_2_SUITE,init_per_suite,ok}}, {?eh,tc_user_skip,{skipped_by_spec_2_SUITE,tc1,"should be skipped"}}, - {?eh,test_stats,{2,8,{6,12}}}, + {?eh,test_stats,{2,6,{6,12}}}, {?eh,tc_start,{skipped_by_spec_2_SUITE,end_per_suite}}, {?eh,tc_done,{skipped_by_spec_2_SUITE,end_per_suite,ok}}, diff --git a/lib/common_test/test/ct_test_server_if_1_SUITE_data/test_server_if/test/ts_if_1_SUITE.erl b/lib/common_test/test/ct_test_server_if_1_SUITE_data/test_server_if/test/ts_if_1_SUITE.erl index 06fa6ac638..d30feb0bd2 100644 --- a/lib/common_test/test/ct_test_server_if_1_SUITE_data/test_server_if/test/ts_if_1_SUITE.erl +++ b/lib/common_test/test/ct_test_server_if_1_SUITE_data/test_server_if/test/ts_if_1_SUITE.erl @@ -76,7 +76,7 @@ end_per_group(_GroupName, _Config) -> %% Reason = term() %%-------------------------------------------------------------------- init_per_testcase(tc1, Config) -> - timer:sleep(5000), + ct:sleep(5000), Config; init_per_testcase(tc8, _Config) -> {skip,"tc8 skipped"}; @@ -92,7 +92,7 @@ init_per_testcase(_TestCase, Config) -> %% Config0 = Config1 = [tuple()] %%-------------------------------------------------------------------- end_per_testcase(tc2, Config) -> - timer:sleep(5000); + ct:sleep(5000); end_per_testcase(tc12, Config) -> ct:comment("end_per_testcase(tc12) called!"), ct:pal("end_per_testcase(tc12) called!", []), @@ -146,7 +146,7 @@ tc2(_) -> timeout_in_end_per_testcase. tc3(_) -> - timer:sleep(5000). + ct:sleep(5000). tc4(_) -> exit(failed_on_purpose). @@ -186,7 +186,7 @@ gtc2(_) -> tc12(_) -> F = fun() -> ct:abort_current_testcase('stopping tc12') end, spawn(F), - timer:sleep(1000), + ct:sleep(1000), exit(should_have_been_aborted). tc13(_) -> diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 2c1f98d63b..ffef8187f3 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -51,12 +51,12 @@ init_per_suite(Config) -> init_per_suite(Config, 50). init_per_suite(Config, Level) -> + ScaleFactor = test_server:timetrap_scale_factor(), case os:type() of {win32, _} -> %% Extend timeout to 1 hour for windows as starting node %% can take a long time there - test_server:timetrap( 60*60*1000 * - test_server:timetrap_scale_factor()); + test_server:timetrap( 60*60*1000 * ScaleFactor ); _ -> ok end, @@ -67,6 +67,16 @@ init_per_suite(Config, Level) -> _ -> ok end, + + {Mult,Scale} = test_server_ctrl:get_timetrap_parameters(), + test_server:format(Level, "Timetrap multiplier: ~w~n", [Mult]), + if Scale == true -> + test_server:format(Level, "Timetrap scale factor: ~w~n", + [ScaleFactor]); + true -> + ok + end, + start_slave(Config, Level). start_slave(Config, Level) -> @@ -277,10 +287,13 @@ run_ct_run_test(Opts,Config) -> Level = proplists:get_value(trace_level, Config), test_server:format(Level, "~n[RUN #1] Calling ct:run_test(~p) on ~p~n", [Opts, CTNode]), - T0 = now(), + + T0 = erlang:monotonic_time(), CtRunTestResult = rpc:call(CTNode, ct, run_test, [Opts]), + T1 = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(T1-T0, native, milli_seconds), test_server:format(Level, "~n[RUN #1] Got return value ~p after ~p ms~n", - [CtRunTestResult,trunc(timer:now_diff(now(), T0)/1000)]), + [CtRunTestResult,Elapsed]), case rpc:call(CTNode, erlang, whereis, [ct_util_server]) of undefined -> ok; @@ -303,10 +316,12 @@ run_ct_script_start(Opts, Config) -> [common_test, run_test_start_opts, Opts1]), test_server:format(Level, "[RUN #2] Calling ct_run:script_start() on ~p~n", [CTNode]), - T0 = now(), + T0 = erlang:monotonic_time(), ExitStatus = rpc:call(CTNode, ct_run, script_start, []), + T1 = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(T1-T0, native, milli_seconds), test_server:format(Level, "[RUN #2] Got exit status value ~p after ~p ms~n", - [ExitStatus,trunc(timer:now_diff(now(), T0)/1000)]), + [ExitStatus,Elapsed]), ExitStatus. check_result({_Ok,Failed,{_UserSkipped,_AutoSkipped}},1,_Opts) @@ -398,7 +413,7 @@ ct_rpc({M,F,A}, Config) -> %%%----------------------------------------------------------------- %%% random_error/1 random_error(Config) when is_list(Config) -> - random:seed(now()), + random:seed(os:timestamp()), Gen = fun(0,_) -> ok; (N,Fun) -> Fun(N-1, Fun) end, Gen(random:uniform(100), Gen), diff --git a/lib/common_test/test/ct_testspec_1_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE.erl index c2670316b6..bc19283a47 100644 --- a/lib/common_test/test/ct_testspec_1_SUITE.erl +++ b/lib/common_test/test/ct_testspec_1_SUITE.erl @@ -795,7 +795,7 @@ test_events(skip_all_groups) -> {?eh,test_stats,{0,0,{12,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_4},"SKIPPED!"}}, {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} ]; @@ -840,7 +840,7 @@ test_events(skip_group) -> {?eh,test_stats,{2,0,{6,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_2}, "SKIPPED!"}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} ]; @@ -876,7 +876,7 @@ test_events(skip_group_all_testcases) -> {?eh,test_stats,{0,0,{4,0}}}, {?eh,tc_user_skip,{groups_11_SUITE,{end_per_group,test_group_1b}, "SKIPPED!"}}, - {?eh,tc_done,{groups_11_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,ok}}, {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} ]; @@ -1065,7 +1065,7 @@ test_events(skip_subgroup) -> {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}}], {?eh,tc_start,{groups_12_SUITE,end_per_suite}}, - {?eh,tc_done,{groups_12_SUITE,end_per_suite,init}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,ok}}, {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} ]; diff --git a/lib/common_test/test/ct_testspec_1_SUITE_data/groups_1/groups_12_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE_data/groups_1/groups_12_SUITE.erl index 69c06f9b83..e5de5df1a8 100644 --- a/lib/common_test/test/ct_testspec_1_SUITE_data/groups_1/groups_12_SUITE.erl +++ b/lib/common_test/test/ct_testspec_1_SUITE_data/groups_1/groups_12_SUITE.erl @@ -285,7 +285,7 @@ testcase_5a(Config) -> %% increase chance the done event will come %% during execution of subgroup (could be %% tricky to handle) - timer:sleep(3), + ct:sleep(3), ok. testcase_5b() -> []. diff --git a/lib/common_test/test/ct_testspec_1_SUITE_data/groups_2/groups_22_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE_data/groups_2/groups_22_SUITE.erl index cd517876df..dcd361d658 100644 --- a/lib/common_test/test/ct_testspec_1_SUITE_data/groups_2/groups_22_SUITE.erl +++ b/lib/common_test/test/ct_testspec_1_SUITE_data/groups_2/groups_22_SUITE.erl @@ -278,7 +278,7 @@ testcase_5a(Config) -> %% increase chance the done event will come %% during execution of subgroup (could be %% tricky to handle) - timer:sleep(3), + ct:sleep(3), ok. testcase_5b() -> []. diff --git a/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t11_SUITE.erl b/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t11_SUITE.erl index b8216c3596..cfc6fa93d7 100644 --- a/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t11_SUITE.erl +++ b/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t11_SUITE.erl @@ -41,8 +41,12 @@ suite() -> %% @end %%-------------------------------------------------------------------- init_per_suite(Config) -> + + TCName = ct:get_config(tcname), + CfgFiles = ct:get_config(file,undefined,[all]), + %% verify that expected config file can be read - case {ct:get_config(tcname),ct:get_config(file,undefined,[all])} of + case {TCName,CfgFiles} of {start_separate,[cfg11]} -> ok; {start_join,[cfg11,cfg21]} -> ok; {incl_separate1,[cfg11]} -> ok; @@ -56,6 +60,28 @@ init_per_suite(Config) -> _ -> ok end, + + %% test the get_testspec_terms functionality + if CfgFiles /= undefined -> + TSTerms = case ct:get_testspec_terms() of + undefined -> exit('testspec should not be undefined'); + Result -> Result + end, + true = lists:keymember(config, 1, TSTerms), + {config,TSCfgFiles} = ct:get_testspec_terms(config), + [{config,TSCfgFiles},{tests,Tests}] = + ct:get_testspec_terms([config,tests]), + CfgNames = [list_to_atom(filename:basename(TSCfgFile)) || + {Node,TSCfgFile} <- TSCfgFiles, Node == node()], + true = (length(CfgNames) == length(CfgFiles)), + [true = lists:member(CfgName,CfgFiles) || CfgName <- CfgNames], + true = lists:any(fun({{_Node,_Dir},Suites}) -> + lists:keymember(?MODULE, 1, Suites) + end, Tests); + true -> + ok + end, + Config. %%-------------------------------------------------------------------- diff --git a/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t12_SUITE.erl b/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t12_SUITE.erl index 7c51aca246..c3faebbd64 100644 --- a/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t12_SUITE.erl +++ b/lib/common_test/test/ct_testspec_3_SUITE_data/tests1/t12_SUITE.erl @@ -55,7 +55,7 @@ init_per_suite(Config) -> {incl_both2,[cfg11,cfg12,cfg21]} -> ok; {incl_both2,[cfg21]} -> ok; _ -> ok - end, + end, Config. %%-------------------------------------------------------------------- diff --git a/lib/common_test/test/ct_testspec_3_SUITE_data/tests2/t21_SUITE.erl b/lib/common_test/test/ct_testspec_3_SUITE_data/tests2/t21_SUITE.erl index 36c1b4279b..e189b168c7 100644 --- a/lib/common_test/test/ct_testspec_3_SUITE_data/tests2/t21_SUITE.erl +++ b/lib/common_test/test/ct_testspec_3_SUITE_data/tests2/t21_SUITE.erl @@ -41,8 +41,11 @@ suite() -> %% @end %%-------------------------------------------------------------------- init_per_suite(Config) -> + TCName = ct:get_config(tcname), + CfgFiles = ct:get_config(file,undefined,[all]), + %% verify that expected config file can be read - case {ct:get_config(tcname),ct:get_config(file,undefined,[all])} of + case {TCName,CfgFiles} of {start_separate,[cfg11]} -> ok; {start_join,[cfg11,cfg21]} -> ok; {incl_separate1,[cfg11]} -> ok; @@ -55,6 +58,28 @@ init_per_suite(Config) -> {incl_both2,[cfg11]} -> ok; _ -> ok end, + + %% test the get_testspec_terms functionality + if CfgFiles /= undefined -> + TSTerms = case ct:get_testspec_terms() of + undefined -> exit('testspec should not be undefined'); + Result -> Result + end, + true = lists:keymember(config, 1, TSTerms), + {config,TSCfgFiles} = ct:get_testspec_terms(config), + [{config,TSCfgFiles},{tests,Tests}] = + ct:get_testspec_terms([config,tests]), + CfgNames = [list_to_atom(filename:basename(TSCfgFile)) || + {Node,TSCfgFile} <- TSCfgFiles, Node == node()], + true = (length(CfgNames) == length(CfgFiles)), + [true = lists:member(CfgName,CfgFiles) || CfgName <- CfgNames], + true = lists:any(fun({{_Node,_Dir},Suites}) -> + lists:keymember(?MODULE, 1, Suites) + end, Tests); + true -> + ok + end, + Config. %%-------------------------------------------------------------------- diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl index d25ee62d38..107d98d72c 100644 --- a/lib/common_test/test/telnet_server.erl +++ b/lib/common_test/test/telnet_server.erl @@ -59,7 +59,7 @@ init(Opts) -> accept(State), ok = gen_tcp:close(LSock), dbg("telnet_server closed the listen socket ~p\n", [LSock]), - timer:sleep(1000), + ct:sleep(1000), ok. listen(0, _Port, _Opts) -> @@ -68,7 +68,7 @@ listen(Retries, Port, Opts) -> case gen_tcp:listen(Port, Opts) of {error,eaddrinuse} -> dbg("Listen port not released, trying again..."), - timer:sleep(5000), + ct:sleep(5000), listen(Retries-1, Port, Opts); Ok = {ok,_LSock} -> Ok; @@ -220,7 +220,7 @@ do_handle_data("echo_sep " ++ Data,State) -> Msgs = string:tokens(Data," "), lists:foreach(fun(Msg) -> send(Msg,State), - timer:sleep(10) + ct:sleep(10) end, Msgs), send("\r\n> ",State), {ok,State}; @@ -242,6 +242,12 @@ do_handle_data("echo_loop " ++ Data,State) -> ReturnData = string:join(Lines,"\n"), send_loop(list_to_integer(TStr),ReturnData,State), {ok,State}; +do_handle_data("echo_delayed_prompt "++Data,State) -> + [MsStr|EchoData] = string:tokens(Data, " "), + send(string:join(EchoData,"\n"),State), + ct:sleep(list_to_integer(MsStr)), + send("\r\n> ",State), + {ok,State}; do_handle_data("disconnect_after " ++WaitStr,State) -> Wait = list_to_integer(string:strip(WaitStr,right,$\n)), dbg("Server will close connection in ~w ms...", [Wait]), @@ -284,15 +290,15 @@ send(Data,State) -> send_loop(T,Data,State) -> dbg("Server sending ~p in loop for ~w ms...~n",[Data,T]), - send_loop(now(),T,Data,State). + send_loop(os:timestamp(),T,Data,State). send_loop(T0,T,Data,State) -> - ElapsedMS = trunc(timer:now_diff(now(),T0)/1000), + ElapsedMS = trunc(timer:now_diff(os:timestamp(),T0)/1000), if ElapsedMS >= T -> ok; true -> send(Data,State), - timer:sleep(500), + ct:sleep(500), send_loop(T0,T,Data,State) end. @@ -314,7 +320,7 @@ dbg(_F,_A) -> io:format("[telnet_server, ~s]\n" ++ _F,[TS|_A]). timestamp() -> - {MS,S,US} = now(), + {MS,S,US} = os:timestamp(), {{Year,Month,Day}, {Hour,Min,Sec}} = calendar:now_to_local_time({MS,S,US}), MilliSec = trunc(US/1000), diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index 849edc15e1..e2d921729c 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.9 +COMMON_TEST_VSN = 1.10.1 diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index 84ebd2f210..9b5b44f3e1 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -31,6 +31,58 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 5.0.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Matching out a map from a record and then updating the + record could cause a 'badarg' exception at run-time. + (Thanks to Dmitry Aleksandrov for reporting this bug.)</p> + <p> + Own Id: OTP-12402</p> + </item> + <item> + <p>The compiler would crash when compiling some complex, + nonsensical guards such as:</p> + <p> ... <c>when {{X}}, -X</c>...</p> + <p> + Own Id: OTP-12410</p> + </item> + <item> + <p> + In rare circumstances, using binary pattern in the value + part of a map pattern would cause the compiler to crash.</p> + <p> + Own Id: OTP-12414</p> + </item> + <item> + <p>Case expressions where a map was wrapped in a tuple or + list such as:</p> + <p><c>case {a,Map} of</c><br/> <c>{a,#{k:=_}}=Tuple -> + Tuple</c><br/> <c>end.</c></p> + <p>would be unsafely "optimized" to either cause an + exception at run-time or would return an empty map.</p> + <p> + Own Id: OTP-12451</p> + </item> + <item> + <p>When a variable was compared to a literal map using + the '<c>==</c>' operator, the compiler would change the + operator to '<c>=:=</c>' since it is more efficient. + However, this optimization is not safe if the map literal + has numeric keys or values. The compiler will now only do + the optimization if all keys and values are + non-numeric.</p> + <p> + Own Id: OTP-12456</p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 5.0.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 2032392821..7c4cebdc28 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -159,6 +159,10 @@ $(EBIN)/beam_asm.beam: $(ESRC)/beam_asm.erl $(EGEN)/beam_opcodes.hrl $(EBIN)/cerl_inline.beam: $(ESRC)/cerl_inline.erl $(V_ERLC) $(ERL_COMPILE_FLAGS) +nowarn_shadow_vars -o$(EBIN) $< +# Inlining core_parse is slow and has no benefit. +$(EBIN)/core_parse.beam: $(EGEN)/core_parse.erl + $(V_ERLC) $(subst +inline,,$(ERL_COMPILE_FLAGS)) -o$(EBIN) $< + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index dd7e03dd28..410f598665 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -91,6 +91,10 @@ rename_instr({bs_private_append=I,F,Sz,U,Src,Flags,Dst}) -> {bs_init,F,{I,U,Flags},none,[Sz,Src],Dst}; rename_instr(bs_init_writable=I) -> {bs_init,{f,0},I,1,[{x,0}],{x,0}}; +rename_instr({test,Op,F,[Ctx,Bits,{string,Str}]}) -> + %% When compiling from a .S file. + <<Bs:Bits/bits,_/bits>> = list_to_binary(Str), + {test,Op,F,[Ctx,Bs]}; rename_instr({put_map_assoc,Fail,S,D,R,L}) -> {put_map,Fail,assoc,S,D,R,L}; rename_instr({put_map_exact,Fail,S,D,R,L}) -> diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index f8cf178d2e..73694b96ce 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -132,10 +132,10 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> LiteralChunk = case beam_dict:literal_table(Dict) of {0,[]} -> []; {NumLiterals,LitTab0} -> - LitTab1 = iolist_to_binary(LitTab0), - LitTab2 = <<NumLiterals:32,LitTab1/binary>>, - LitTab = iolist_to_binary(zlib:compress(LitTab2)), - chunk(<<"LitT">>, <<(byte_size(LitTab2)):32>>, LitTab) + LitTab1 = [<<NumLiterals:32>>,LitTab0], + LitTab = zlib:compress(LitTab1), + chunk(<<"LitT">>, <<(iolist_size(LitTab1)):32>>, + LitTab) end, %% Create the line chunk. @@ -431,45 +431,35 @@ encode_alloc_list_1([], Dict, Acc) -> {iolist_to_binary(Acc),Dict}. encode(Tag, N) when N < 0 -> - encode1(Tag, negative_to_bytes(N, [])); + encode1(Tag, negative_to_bytes(N)); encode(Tag, N) when N < 16 -> (N bsl 4) bor Tag; encode(Tag, N) when N < 16#800 -> [((N bsr 3) band 2#11100000) bor Tag bor 2#00001000, N band 16#ff]; encode(Tag, N) -> - encode1(Tag, to_bytes(N, [])). + encode1(Tag, to_bytes(N)). encode1(Tag, Bytes) -> - case length(Bytes) of + case iolist_size(Bytes) of Num when 2 =< Num, Num =< 8 -> [((Num-2) bsl 5) bor 2#00011000 bor Tag| Bytes]; Num when 8 < Num -> [2#11111000 bor Tag, encode(?tag_u, Num-9)| Bytes] end. - -to_bytes(N0, Acc) -> - Bits = 3*128, - case N0 bsr Bits of - 0 -> - to_bytes_1(N0, Acc); - N -> - to_bytes(N, binary_to_list(<<N0:Bits>>) ++ Acc) - end. - -to_bytes_1(0, [B|_]=Done) when B < 128 -> Done; -to_bytes_1(N, Acc) -> to_bytes(N bsr 8, [N band 16#ff|Acc]). - -negative_to_bytes(N0, Acc) -> - Bits = 3*128, - case N0 bsr Bits of - -1 -> - negative_to_bytes_1(N0, Acc); - N -> - negative_to_bytes_1(N, binary_to_list(<<N0:Bits>>) ++ Acc) +to_bytes(N) -> + Bin = binary:encode_unsigned(N), + case Bin of + <<0:1,_/bits>> -> Bin; + <<1:1,_/bits>> -> [0,Bin] end. -negative_to_bytes_1(-1, [B1,_B2|_]=Done) when B1 > 127 -> - Done; -negative_to_bytes_1(N, Acc) -> - negative_to_bytes_1(N bsr 8, [N band 16#ff|Acc]). +negative_to_bytes(N) when N >= -16#8000 -> + <<N:16>>; +negative_to_bytes(N) -> + Bytes = byte_size(binary:encode_unsigned(-N)), + Bin = <<N:Bytes/unit:8>>, + case Bin of + <<0:1,_/bits>> -> [16#ff,Bin]; + <<1:1,_/bits>> -> Bin + end. diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 92f09e400c..e2639e9cac 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -61,15 +61,6 @@ blockify(Is) -> blockify([{loop_rec,{f,Fail},{x,0}},{loop_rec_end,_Lbl},{label,Fail}|Is], Acc) -> %% Useless instruction sequence. blockify(Is, Acc); - -%% New bit syntax matching. -blockify([{bs_save2,R,Point}=I,{bs_restore2,R,Point}|Is], Acc) -> - blockify([I|Is], Acc); -blockify([{bs_save2,R,Point}=I,{test,is_eq_exact,_,_}=Test, - {bs_restore2,R,Point}|Is], Acc) -> - blockify([I,Test|Is], Acc); - -%% Do other peep-hole optimizations. blockify([{test,is_atom,{f,Fail},[Reg]}=I| [{select,select_val,Reg,{f,Fail}, [{atom,false},{f,_}=BrFalse, @@ -252,13 +243,6 @@ combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) -> %% opt([Instruction]) -> [Instruction] %% Optimize the instruction stream inside a basic block. -opt([{set,[Dst],As,{bif,Bif,Fail}}=I1, - {set,[Dst],[Dst],{bif,'not',Fail}}=I2|Is]) -> - %% Get rid of the 'not' if the operation can be inverted. - case inverse_comp_op(Bif) of - none -> [I1,I2|opt(Is)]; - RevBif -> [{set,[Dst],As,{bif,RevBif,Fail}}|opt(Is)] - end; opt([{set,[X],[X],move}|Is]) -> opt(Is); opt([{set,_,_,{line,_}}=Line1, {set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1, @@ -428,18 +412,6 @@ x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N)); x_live([_|Rs], Regs) -> x_live(Rs, Regs); x_live([], Regs) -> Regs. -%% inverse_comp_op(Op) -> none|RevOp - -inverse_comp_op('=:=') -> '=/='; -inverse_comp_op('=/=') -> '=:='; -inverse_comp_op('==') -> '/='; -inverse_comp_op('/=') -> '=='; -inverse_comp_op('>') -> '=<'; -inverse_comp_op('<') -> '>='; -inverse_comp_op('>=') -> '<'; -inverse_comp_op('=<') -> '>'; -inverse_comp_op(_) -> none. - %%% %%% Evaluation of constant bit fields. %%% diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index a452d30b61..5ed9c16d61 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -787,6 +787,9 @@ is_not_used(R, Is, Label, #st{ll=Ll}) -> initialized_regs(Is) -> initialized_regs(Is, ordsets:new()). +initialized_regs([{set,Dst,_Src,{alloc,Live,_}}|_], Regs0) -> + Regs = add_init_regs(free_vars_regs(Live), Regs0), + add_init_regs(Dst, Regs); initialized_regs([{set,Dst,Src,_}|Is], Regs) -> initialized_regs(Is, add_init_regs(Dst, add_init_regs(Src, Regs))); initialized_regs([{test,_,_,Src}|Is], Regs) -> diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index d54c2a9fde..2a15c1ddf3 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -20,7 +20,7 @@ -module(beam_bsm). -export([module/2,format_error/1]). --import(lists, [member/2,foldl/3,reverse/1,sort/1,all/2,dropwhile/2]). +-import(lists, [member/2,foldl/3,reverse/1,sort/1,all/2]). %%% %%% We optimize bit syntax matching where the tail end of a binary is @@ -542,16 +542,13 @@ btb_context_regs_1(Regs, N, Tag, Acc) -> %% a binary. MustSave is true if the function may pass the match %% context to the bs_context_to_binary instruction (in which case %% the current position in the binary must have saved into the -%% start position using "bs_save_2 Ctx start". +%% start position using "bs_save_2 Ctx start"). btb_index(Fs) -> btb_index_1(Fs, []). btb_index_1([{function,_,_,Entry,Is0}|Fs], Acc0) -> - [{label,Entry}|Is] = - dropwhile(fun({label,L}) when L =:= Entry -> false; - (_) -> true - end, Is0), + Is = drop_to_label(Is0, Entry), Acc = btb_index_2(Is, Entry, false, Acc0), btb_index_1(Fs, Acc); btb_index_1([], Acc) -> gb_trees:from_orddict(sort(Acc)). @@ -566,6 +563,9 @@ btb_index_2(Is0, Entry, _, Acc) -> throw:none -> Acc end. +drop_to_label([{label,L}|Is], L) -> Is; +drop_to_label([_|Is], L) -> drop_to_label(Is, L). + btb_index_find_start_match([{test,_,{f,F},_},{bs_context_to_binary,_}|Is]) -> btb_index_find_label(Is, F); btb_index_find_start_match(_) -> @@ -615,7 +615,7 @@ collect_warnings_instr([_|Is], D, Acc) -> collect_warnings_instr([], _, Acc) -> Acc. add_warning(Term, Anno, Ws) -> - Line = abs(get_line(Anno)), + Line = get_line(Anno), File = get_file(Anno), [{File,[{Line,?MODULE,Term}]}|Ws]. diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index b68b8702e0..1d26993103 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -184,14 +184,6 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) -> function_replace(Fs, Dict, [{function,Name,Arity,Entry,Asm}|Acc]); function_replace([], _, Acc) -> Acc. -replace([{test,bs_match_string=Op,{f,Lbl},[Ctx,Bin0]}|Is], Acc, D) -> - Bits = bit_size(Bin0), - Bin = case Bits rem 8 of - 0 -> Bin0; - Rem -> <<Bin0/bitstring,0:(8-Rem)>> - end, - I = {test,Op,{f,label(Lbl, D)},[Ctx,Bits,{string,binary_to_list(Bin)}]}, - replace(Is, [I|Acc], D); replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) -> replace(Is, [{test,Test,{f,label(Lbl, D)},Ops}|Acc], D); replace([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D) -> diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 7cd07dc3be..5932d8ce1d 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -98,6 +98,12 @@ move_move_into_block([], Acc) -> reverse(Acc). forward(Is, Lc) -> forward(Is, gb_trees:empty(), Lc, []). +forward([{move,_,_}=Move|[{label,L}|_]=Is], D, Lc, Acc) -> + %% move/2 followed by jump/1 is optimized by backward/3. + forward([Move,{jump,{f,L}}|Is], D, Lc, Acc); +forward([{bif,_,_,_,_}=Bif|[{label,L}|_]=Is], D, Lc, Acc) -> + %% bif/4 followed by jump/1 is optimized by backward/3. + forward([Bif,{jump,{f,L}}|Is], D, Lc, Acc); forward([{block,[]}|Is], D, Lc, Acc) -> %% Empty blocks can prevent optimizations. forward(Is, D, Lc, Acc); @@ -124,6 +130,8 @@ forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) -> _ -> Is0 %Keep move instruction. end, forward(Is, D, Lc, [LblI|Acc]); +forward([{test,is_eq_exact,_,[Same,Same]}|Is], D, Lc, Acc) -> + forward(Is, D, Lc, Acc); forward([{test,is_eq_exact,_,[Dst,Src]}=I, {block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) -> forward([I,{block,Bl}|Is], D, Lc, Acc); @@ -234,10 +242,8 @@ backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) -> Fail = shortcut_bs_test(Fail1, Is, D), Sel = {select,select_val,Reg,{f,Fail},List}, backward(Is, D, [Sel|Acc]); -backward([{jump,{f,To0}},{move,Src0,Reg}|Is], D, Acc) -> - To1 = shortcut_select_label(To0, Reg, Src0, D), - {To,Src} = shortcut_boolean_label(To1, Reg, Src0, D), - Move = {move,Src,Reg}, +backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) -> + To = shortcut_select_label(To0, Reg, Src, D), Jump = {jump,{f,To}}, case beam_utils:is_killed_at(Reg, To, D) of false -> backward([Move|Is], D, [Jump|Acc]); @@ -249,6 +255,16 @@ backward([{jump,{f,To}}=J|[{bif,Op,_,Ops,Reg}|Is]=Is0], D, Acc) -> catch throw:not_possible -> backward(Is0, D, [J|Acc]) end; +backward([{test,bs_start_match2,F,_,[R,_],Ctxt}=I|Is], D, + [{test,bs_match_string,F,[Ctxt,Bs]}, + {test,bs_test_tail2,F,[Ctxt,0]}|Acc0]=Acc) -> + case beam_utils:is_killed(Ctxt, Acc0, D) of + true -> + Eq = {test,is_eq_exact,F,[R,{literal,Bs}]}, + backward(Is, D, [Eq|Acc0]); + false -> + backward(Is, D, [I|Acc]) + end; backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) -> To = shortcut_bs_start_match(To0, Src, D), I = {test,bs_start_match2,{f,To},Live,Info,Dst}, @@ -330,16 +346,6 @@ shortcut_label(To0, D) -> shortcut_select_label(To, Reg, Lit, D) -> shortcut_rel_op(To, is_ne_exact, [Reg,Lit], D). -shortcut_boolean_label(To0, Reg, {atom,Bool0}=Lit, D) when is_boolean(Bool0) -> - case beam_utils:code_at(To0, D) of - [{line,_},{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] -> - Bool = {atom,not Bool0}, - {shortcut_select_label(To, Reg, Bool, D),Bool}; - _ -> - {To0,Lit} - end; -shortcut_boolean_label(To, _, Bool, _) -> {To,Bool}. - %% Replace a comparison operator with a test instruction and a jump. %% For example, if we have this code: %% @@ -463,8 +469,8 @@ count_bits_matched([{test,_,_,_,[_,Sz,U,{field_flags,_}],_}|Is], SavePoint, Bits {integer,N} -> count_bits_matched(Is, SavePoint, Bits+N*U); _ -> count_bits_matched(Is, SavePoint, Bits) end; -count_bits_matched([{test,bs_match_string,_,[_,Bits,_]}|Is], SavePoint, Bits0) -> - count_bits_matched(Is, SavePoint, Bits0+Bits); +count_bits_matched([{test,bs_match_string,_,[_,Bs]}|Is], SavePoint, Bits) -> + count_bits_matched(Is, SavePoint, Bits+bit_size(Bs)); count_bits_matched([{test,_,_,_}|Is], SavePoint, Bits) -> count_bits_matched(Is, SavePoint, Bits); count_bits_matched([{bs_save2,Reg,SavePoint}|_], {Reg,SavePoint}, Bits) -> diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index ea51673fa3..68dc104dd3 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -65,7 +65,7 @@ new() -> %% Remember the highest opcode. -spec opcode(non_neg_integer(), bdict()) -> bdict(). -opcode(Op, Dict) when Dict#asm.highest_opcode > Op -> Dict; +opcode(Op, Dict) when Dict#asm.highest_opcode >= Op -> Dict; opcode(Op, Dict) -> Dict#asm{highest_opcode=Op}. %% Returns the highest opcode encountered. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index ba71d4efae..52b6464c7f 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -127,7 +127,7 @@ %%% on the program state. %%% --import(lists, [reverse/1,reverse/2,foldl/3,dropwhile/2]). +-import(lists, [reverse/1,reverse/2,foldl/3]). module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> Fs = [function(F) || F <- Fs0], @@ -509,10 +509,7 @@ rem_unused([{label,Lbl}=I|Is0], Used, [Prev|_]=Acc) -> case gb_sets:is_member(Lbl, Used) of false -> Is = case is_unreachable_after(Prev) of - true -> - dropwhile(fun({label,_}) -> false; - (_) -> true - end, Is0); + true -> drop_upto_label(Is0); false -> Is0 end, rem_unused(Is, Used, Acc); @@ -533,6 +530,10 @@ initial_labels([{label,Lbl}|Is], Acc) -> initial_labels([{func_info,_,_,_},{label,Lbl}|_], Acc) -> gb_sets:from_list([Lbl|Acc]). +drop_upto_label([{label,_}|_]=Is) -> Is; +drop_upto_label([_|Is]) -> drop_upto_label(Is); +drop_upto_label([]) -> []. + %% ulbl(Instruction, UsedGbSet) -> UsedGbSet' %% Update the gb_set UsedGbSet with any function-local labels %% (i.e. not with labels in call instructions) referenced by diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index 50d1f3cdb1..726bb7f5eb 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -46,8 +46,8 @@ module(Stream, {Mod,Exp,Attr,Code,NumLabels}) -> fun ({function,Name,Arity,Entry,Asm}) -> io:format(Stream, "\n\n{function, ~w, ~w, ~w}.\n", [Name, Arity, Entry]), - foreach(fun(Op) -> print_op(Stream, Op) end, Asm) end, - Code); + io:put_chars(Stream, format_asm(Asm)) + end, Code); module(Stream, {Mod,Exp,Inter}) -> %% Other kinds of intermediate formats. io:fwrite(Stream, "~w.~n~p.~n", [Mod,Exp]), @@ -56,10 +56,11 @@ module(Stream, [_|_]=Fs) -> %% Form-based abstract format. foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Fs). -print_op(Stream, Label) when element(1, Label) == label -> - io:format(Stream, " ~p.\n", [Label]); -print_op(Stream, Op) -> - io:format(Stream, " ~p.\n", [Op]). +format_asm([{label,L}|Is]) -> + [" {label,",integer_to_list(L),"}.\n"|format_asm(Is)]; +format_asm([I|Is]) -> + [io_lib:format(" ~p", [I]),".\n"|format_asm(Is)]; +format_asm([]) -> []. function(File, {function,Name,Arity,Args,Body,Vdb,_Anno}) -> io:nl(File), diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index 97a8c7ba70..5abacc8d5d 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -108,14 +108,14 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> %% has succeeded. peep(Is, gb_sets:empty(), [I|Acc]); true -> - Test = {Op,Ops}, - case gb_sets:is_element(Test, SeenTests0) of + case is_test_redundant(Op, Ops, SeenTests0) of true -> - %% This test has already succeeded and + %% This test or a similar test has already succeeded and %% is therefore redundant. peep(Is, SeenTests0, Acc); false -> %% Remember that we have seen this test. + Test = {Op,Ops}, SeenTests = gb_sets:insert(Test, SeenTests0), peep(Is, SeenTests, [I|Acc]) end @@ -136,6 +136,15 @@ peep([I|Is], _, Acc) -> peep(Is, gb_sets:empty(), [I|Acc]); peep([], _, Acc) -> reverse(Acc). +is_test_redundant(Op, Ops, Seen) -> + gb_sets:is_element({Op,Ops}, Seen) orelse + is_test_redundant_1(Op, Ops, Seen). + +is_test_redundant_1(is_boolean, [R], Seen) -> + gb_sets:is_element({is_eq_exact,[R,{atom,false}]}, Seen) orelse + gb_sets:is_element({is_eq_exact,[R,{atom,true}]}, Seen); +is_test_redundant_1(_, _, _) -> false. + kill_seen(Dst, Seen0) -> gb_sets:from_ordset(kill_seen_1(gb_sets:to_list(Seen0), Dst)). diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index fad9c42584..8181e555a1 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -172,6 +172,10 @@ remap([{bif,Name,Fail,Ss,D}|Is], Map, Acc) -> remap([{gc_bif,Name,Fail,Live,Ss,D}|Is], Map, Acc) -> I = {gc_bif,Name,Fail,Live,[Map(S) || S <- Ss],Map(D)}, remap(Is, Map, [I|Acc]); +remap([{get_map_elements,Fail,M,{list,L0}}|Is], Map, Acc) -> + L = [Map(E) || E <- L0], + I = {get_map_elements,Fail,Map(M),{list,L}}, + remap(Is, Map, [I|Acc]); remap([{bs_init,Fail,Info,Live,Ss0,Dst0}|Is], Map, Acc) -> Ss = [Map(Src) || Src <- Ss0], Dst = Map(Dst0), @@ -275,6 +279,8 @@ frame_size([{kill,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([{make_fun2,_,_,_,_}|Is], Safe) -> frame_size(Is, Safe); +frame_size([{get_map_elements,{f,L},_,_}|Is], Safe) -> + frame_size_branch(L, Is, Safe); frame_size([{deallocate,N}|_], _) -> N; frame_size([{line,_}|Is], Safe) -> frame_size(Is, Safe); diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 26c933481a..4731b5e78e 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -149,9 +149,10 @@ simplify_basic_1([], Ts, Acc) -> %% simplify_float(Is0, Ts0) -> {Is1,Ts} = simplify_float_1(Is0, Ts0, [], []), - Is2 = flt_need_heap(Is1), + Is2 = opt_fmoves(Is1, []), + Is3 = flt_need_heap(Is2), try - {flt_liveness(Is2),Ts} + {flt_liveness(Is3),Ts} catch throw:not_possible -> not_possible end. @@ -202,14 +203,15 @@ simplify_float_1([{set,_,_,{'catch',_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> simplify_float_1(Is, tdb_new(), Rs0, [I|Acc]); simplify_float_1([{set,_,_,{line,_}}=I|Is], Ts, Rs, Acc) -> simplify_float_1(Is, Ts, Rs, [I|Acc]); +simplify_float_1([I|Is], Ts0, [], Acc) -> + Ts = update(I, Ts0), + simplify_float_1(Is, Ts, [], [I|Acc]); simplify_float_1([I|Is]=Is0, Ts0, Rs0, Acc0) -> Ts = update(I, Ts0), {Rs,Acc} = flush(Rs0, Is0, Acc0), simplify_float_1(Is, Ts, Rs, [I|checkerror(Acc)]); -simplify_float_1([], Ts, Rs, Acc0) -> - Acc = checkerror(Acc0), - Is0 = reverse(flush_all(Rs, [], Acc)), - Is = opt_fmoves(Is0, []), +simplify_float_1([], Ts, [], Acc) -> + Is = reverse(Acc), {Is,Ts}. coerce_to_float({integer,I}=Int) -> diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 7704690f86..b82bcd0e95 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -128,8 +128,7 @@ empty_label_index() -> %% Add an index for a label. index_label(Lbl, Is0, Acc) -> - Is = lists:dropwhile(fun({label,_}) -> true; - (_) -> false end, Is0), + Is = drop_labels(Is0), gb_trees:enter(Lbl, Is, Acc). @@ -344,14 +343,10 @@ check_liveness(R, [{call_ext,Live,_}=I|Is], St) -> false -> check_liveness(R, Is, St); true -> - %% We must make sure we don't check beyond this instruction - %% or we will fall through into random unrelated code and - %% get stuck in a loop. - %% - %% We don't want to overwrite a 'catch', so consider this - %% register in use. - %% - {used,St} + %% We must make sure we don't check beyond this + %% instruction or we will fall through into random + %% unrelated code and get stuck in a loop. + {killed,St} end end; check_liveness(R, [{call_fun,Live}|Is], St) -> @@ -472,6 +467,22 @@ check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) -> check_liveness_at(R, Fail, St); check_liveness(R, [{line,_}|Is], St) -> check_liveness(R, Is, St); +check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> + {Ss,Ds} = split_even(L), + case member(R, [S|Ss]) of + true -> + {used,St0}; + false -> + case check_liveness_at(R, Fail, St0) of + {killed,St}=Killed -> + case member(R, Ds) of + true -> Killed; + false -> check_liveness(R, Is, St) + end; + Other -> + Other + end + end; check_liveness(_R, Is, St) when is_list(Is) -> %% case Is of %% [I|_] -> @@ -612,13 +623,15 @@ is_reg_used_at_1(R, Lbl, St0) -> end. index_labels_1([{label,Lbl}|Is0], Acc) -> - Is = lists:dropwhile(fun({label,_}) -> true; - (_) -> false end, Is0), + Is = drop_labels(Is0), index_labels_1(Is0, [{Lbl,Is}|Acc]); index_labels_1([_|Is], Acc) -> index_labels_1(Is, Acc); index_labels_1([], Acc) -> gb_trees:from_orddict(sort(Acc)). +drop_labels([{label,_}|Is]) -> drop_labels(Is); +drop_labels(Is) -> Is. + %% Help functions for combine_heap_needs. combine_alloc_lists(Al1, Al2) -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 4d4536b79c..780826b126 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -28,7 +28,7 @@ -include("beam_disasm.hrl"). --import(lists, [reverse/1,foldl/3,foreach/2,member/2,dropwhile/2]). +-import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]). -define(MAXREG, 1024). @@ -153,7 +153,6 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> hf=0, %Available heap size for floats. fls=undefined, %Floating point state. ct=[], %List of hot catch/try labels - bits=undefined, %Number of bits in bit syntax binary. setelem=false %Previous instruction was setelement/3. }). @@ -411,37 +410,33 @@ valfun_1({'try',Dst,{f,Fail}}, Vst0) -> Vst = #vst{current=#st{ct=Fails}=St} = set_type_y({trytag,[Fail]}, Dst, Vst0), Vst#vst{current=St#st{ct=[[Fail]|Fails]}}; -valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> +valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> case get_special_y_type(Reg, Vst0) of {catchtag,Fail} -> - Vst = #vst{current=St} = - set_type_y(initialized_ct, Reg, - Vst0#vst{current=St0#st{ct=Fails}}), + Vst = #vst{current=St} = set_catch_end(Reg, Vst0), Xs = gb_trees_from_list([{0,term}]), - Vst#vst{current=St#st{x=Xs,fls=undefined}}; + Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined}}; Type -> error({bad_type,Type}) end; -valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) -> +valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> case get_special_y_type(Reg, Vst0) of {trytag,Fail} -> Vst = case Fail of [FailLabel] -> branch_state(FailLabel, Vst0); _ -> Vst0 end, - set_type_reg(initialized_ct, Reg, - Vst#vst{current=St#st{ct=Fails,fls=undefined}}); + St = St0#st{ct=Fails,fls=undefined}, + set_catch_end(Reg, Vst#vst{current=St}); Type -> error({bad_type,Type}) end; -valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> +valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> case get_special_y_type(Reg, Vst0) of {trytag,Fail} -> - Vst = #vst{current=St} = - set_type_y(initialized_ct, Reg, - Vst0#vst{current=St0#st{ct=Fails}}), - Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), %XXX - Vst#vst{current=St#st{x=Xs,fls=undefined}}; + Vst = #vst{current=St} = set_catch_end(Reg, Vst0), + Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), + Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined}}; Type -> error({bad_type,Type}) end; @@ -667,7 +662,7 @@ valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> set_type_reg({tuple,Sz}, Tuple, branch_state(Lbl, Vst)); valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> assert_type(map, Src, Vst), - assert_strict_literal_termorder(List), + assert_unique_map_keys(List), branch_state(Lbl, Vst); valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) -> Vst = branch_state(Lbl, Vst0), @@ -700,8 +695,7 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - Vst = bs_zero_bits(Vst3), + Vst = prune_x_regs(Live, Vst2), set_type_reg(binary, Dst, Vst); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), @@ -713,8 +707,7 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - Vst = bs_zero_bits(Vst3), + Vst = prune_x_regs(Live, Vst2), set_type_reg(binary, Dst, Vst); valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), @@ -722,43 +715,35 @@ valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> assert_term(Bin, Vst0), Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - Vst = bs_zero_bits(Vst3), + Vst = prune_x_regs(Live, Vst2), set_type_reg(binary, Dst, Vst); valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst0) -> assert_term(Bits, Vst0), assert_term(Bin, Vst0), - Vst1 = branch_state(Fail, Vst0), - Vst = bs_zero_bits(Vst1), + Vst = branch_state(Fail, Vst0), set_type_reg(binary, Dst, Vst); valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; -valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}=I, Vst0) -> - assert_term(Sz, Vst0), - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}=I, Vst0) -> - assert_term(Sz, Vst0), - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}=I, Vst0) -> - assert_term(Sz, Vst0), - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_utf8,{f,Fail},_,Src}=I, Vst0) -> - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) -> + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_utf16,{f,Fail},_,Src}=I, Vst0) -> - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) -> + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_utf32,{f,Fail},_,Src}=I, Vst0) -> - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> + assert_term(Src, Vst), branch_state(Fail, Vst); %% Map instructions. valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> @@ -774,7 +759,7 @@ verify_get_map(Fail, Src, List, Vst0) -> assert_type(map, Src, Vst0), Vst1 = branch_state(Fail, Vst0), Keys = extract_map_keys(List), - assert_strict_literal_termorder(Keys), + assert_unique_map_keys(Keys), verify_get_map_pair(List,Vst0,Vst1). extract_map_keys([Key,_Val|T]) -> @@ -794,6 +779,8 @@ verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> Vst1 = heap_alloc(0, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), + Keys = extract_map_keys(List), + assert_unique_map_keys(Keys), set_type_reg(map, Dst, Vst). %% @@ -1007,29 +994,23 @@ assert_freg_set(Fr, _) -> error({bad_source,Fr}). %% A single item list may be either a list or a register. %% -%% A list with more than item must contain literals in -%% ascending term order. +%% A list with more than item must contain unique literals. %% %% An empty list is not allowed. -assert_strict_literal_termorder([]) -> +assert_unique_map_keys([]) -> %% There is no reason to use the get_map_elements and %% has_map_fields instructions with empty lists. error(empty_field_list); -assert_strict_literal_termorder([_]) -> +assert_unique_map_keys([_]) -> ok; -assert_strict_literal_termorder([_,_|_]=Ls) -> +assert_unique_map_keys([_,_|_]=Ls) -> Vs = [get_literal(L) || L <- Ls], - case check_strict_value_termorder(Vs) of - true -> ok; - false -> error(not_strict_order) + case length(Vs) =:= sets:size(sets:from_list(Vs)) of + true -> ok; + false -> error(keys_not_unique) end. -check_strict_value_termorder([V1|[V2|_]=Vs]) -> - erts_internal:cmp_term(V1, V2) < 0 andalso - check_strict_value_termorder(Vs); -check_strict_value_termorder([_]) -> true. - %%% %%% New binary matching instructions. %%% @@ -1075,56 +1056,8 @@ bsm_restore(Reg, SavePoint, Vst) -> end; _ -> error({illegal_restore,SavePoint,range}) end. - %%% -%%% Validation of alignment in the bit syntax. (Currently, construction only.) -%%% -%%% We make sure that the aligned flag is only set when we can be sure of the -%%% aligment. -%%% - -bs_zero_bits(#vst{current=St}=Vst) -> - Vst#vst{current=St#st{bits=0}}. - -bs_align_check({bs_put_utf8,_,Flags,_}, #vst{current=#st{}=St}=Vst) -> - bs_verify_flags(Flags, St), - Vst; -bs_align_check({bs_put_utf16,_,Flags,_}, #vst{current=#st{}=St}=Vst) -> - bs_verify_flags(Flags, St), - Vst; -bs_align_check({bs_put_utf32,_,Flags,_}, #vst{current=#st{}=St}=Vst) -> - bs_verify_flags(Flags, St), - Vst; -bs_align_check({_,_,Sz,U,Flags,_}, #vst{current=#st{bits=Bits}=St}=Vst) -> - bs_verify_flags(Flags, St), - bs_update_bits(Bits, Sz, U, St, Vst). - -bs_update_bits(undefined, _, _, _, Vst) -> Vst; -bs_update_bits(Bits0, {integer,Sz}, U, St, Vst) -> - Bits = Bits0 + U*Sz, - Vst#vst{current=St#st{bits=Bits}}; -bs_update_bits(_, {atom,all}, _, _, Vst) -> - %% A binary will not change the alignment. - Vst; -bs_update_bits(_, _, U, _, Vst) when U rem 8 =:= 0 -> - %% Units of 8, 16, and so on will not change the aligment. - Vst; -bs_update_bits(_, _, _, St, Vst) -> - %% We can no longer be sure about aligment. - Vst#vst{current=St#st{bits=undefined}}. - -bs_verify_flags({field_flags,Fl}, #st{bits=Bits}) -> - case bs_is_aligned(Fl) of - false -> ok; - true when is_integer(Bits), Bits rem 8 =:= 0 -> ok; - true -> error({aligned_flag_set,{bits,Bits}}) - end. - -bs_is_aligned(Fl) when is_integer(Fl) -> Fl band 1 =:= 1; -bs_is_aligned(Fl) when is_list(Fl) -> member(aligned, Fl). - -%%% %%% Keeping track of types. %%% @@ -1139,35 +1072,26 @@ set_type_reg(Type, {x,X}, #vst{current=#st{x=Xs}=St}=Vst) set_type_reg(Type, Reg, Vst) -> set_type_y(Type, Reg, Vst). -set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0,numy=NumY}=St}=Vst) +set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst) when is_integer(Y), 0 =< Y -> limit_check(Y), - case {Y,NumY} of - {_,none} -> - error({no_stack_frame,Reg}); - {_,_} when Y > NumY -> - error({y_reg_out_of_range,Reg,NumY}); - {_,_} -> - Ys = if Type =:= initialized_ct -> - gb_trees:enter(Y, initialized, Ys0); - true -> - case gb_trees:lookup(Y, Ys0) of - none -> - gb_trees:insert(Y, Type, Ys0); - {value,uinitialized} -> - gb_trees:insert(Y, Type, Ys0); - {value,{catchtag,_}=Tag} -> - error(Tag); - {value,{trytag,_}=Tag} -> - error(Tag); - {value,_} -> - gb_trees:update(Y, Type, Ys0) - end - end, - Vst#vst{current=St#st{y=Ys}} - end; + Ys = case gb_trees:lookup(Y, Ys0) of + none -> + error({invalid_store,Reg,Type}); + {value,{catchtag,_}=Tag} -> + error(Tag); + {value,{trytag,_}=Tag} -> + error(Tag); + {value,_} -> + gb_trees:update(Y, Type, Ys0) + end, + Vst#vst{current=St#st{y=Ys}}; set_type_y(Type, Reg, #vst{}) -> error({invalid_store,Reg,Type}). +set_catch_end({y,Y}, #vst{current=#st{y=Ys0}=St}=Vst) -> + Ys = gb_trees:update(Y, initialized, Ys0), + Vst#vst{current=St#st{y=Ys}}. + assert_term(Src, Vst) -> get_term_type(Src, Vst), ok. @@ -1366,13 +1290,13 @@ merge_states(L, St, Branched) when L =/= 0 -> {value,OtherSt} -> merge_states_1(St, OtherSt) end. -merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}=St, +merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}, #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1}) -> NumY = merge_stk(NumY0, NumY1), Xs = merge_regs(Xs0, Xs1), Ys = merge_y_regs(Ys0, Ys1), Ct = merge_ct(Ct0, Ct1), - St#st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}. + #st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}. merge_stk(S, S) -> S; merge_stk(_, _) -> undecided. @@ -1402,20 +1326,24 @@ merge_regs_1([], [_|_]) -> []; merge_regs_1([_|_], []) -> []. merge_y_regs(Rs0, Rs1) -> - Rs = merge_y_regs_1(gb_trees:to_list(Rs0), gb_trees:to_list(Rs1)), - gb_trees_from_list(Rs). + case {gb_trees:size(Rs0),gb_trees:size(Rs1)} of + {Sz0,Sz1} when Sz0 < Sz1 -> + merge_y_regs_1(Sz0-1, Rs1, Rs0); + {_,Sz1} -> + merge_y_regs_1(Sz1-1, Rs0, Rs1) + end. -merge_y_regs_1([Same|Rs1], [Same|Rs2]) -> - [Same|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([{R1,_}|Rs1], [{R2,_}|_]=Rs2) when R1 < R2 -> - [{R1,uninitialized}|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([{R1,_}|_]=Rs1, [{R2,_}|Rs2]) when R1 > R2 -> - [{R2,uninitialized}|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([{R,Type1}|Rs1], [{R,Type2}|Rs2]) -> - [{R,merge_types(Type1, Type2)}|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([], []) -> []; -merge_y_regs_1([], [_|_]=Rs) -> Rs; -merge_y_regs_1([_|_]=Rs, []) -> Rs. +merge_y_regs_1(Y, S, Regs0) when Y >= 0 -> + Type0 = gb_trees:get(Y, Regs0), + case gb_trees:get(Y, S) of + Type0 -> + merge_y_regs_1(Y-1, S, Regs0); + Type1 -> + Type = merge_types(Type0, Type1), + Regs = gb_trees:update(Y, Type, Regs0), + merge_y_regs_1(Y-1, S, Regs) + end; +merge_y_regs_1(_, _, Regs) -> Regs. %% merge_types(Type1, Type2) -> Type %% Return the most specific type possible. @@ -1634,8 +1562,6 @@ return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> return_type_erl(exit, 1) -> exception; return_type_erl(throw, 1) -> exception; -return_type_erl(fault, 1) -> exception; -return_type_erl(fault, 2) -> exception; return_type_erl(error, 1) -> exception; return_type_erl(error, 2) -> exception; return_type_erl(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 0c7bef9183..47e786034d 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -74,6 +74,13 @@ undo_rename({bs_init,F,{I,Extra,U,Flags},Live,[Sz,Src],Dst}) -> {I,F,Sz,Extra,Live,U,Src,Flags,Dst}; undo_rename({bs_init,_,bs_init_writable=I,_,_,_}) -> I; +undo_rename({test,bs_match_string=Op,F,[Ctx,Bin0]}) -> + Bits = bit_size(Bin0), + Bin = case Bits rem 8 of + 0 -> Bin0; + Rem -> <<Bin0/bitstring,0:(8-Rem)>> + end, + {test,Op,F,[Ctx,Bits,{string,binary_to_list(Bin)}]}; undo_rename({put_map,Fail,assoc,S,D,R,L}) -> {put_map_assoc,Fail,S,D,R,L}; undo_rename({put_map,Fail,exact,S,D,R,L}) -> diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 3d4b9ee0c6..ea960abc1a 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -138,7 +138,8 @@ ]). -export_type([c_binary/0, c_bitstr/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, - c_literal/0, c_map/0, c_map_pair/0, c_module/0, c_tuple/0, + c_let/0, c_literal/0, c_map/0, c_map_pair/0, + c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]). -include("core_parse.hrl"). @@ -255,7 +256,7 @@ %% @see c_primop/2 %% @see c_receive/1 %% @see c_seq/2 -%% @see c_try/3 +%% @see c_try/5 %% @see c_tuple/1 %% @see c_values/1 %% @see c_var/1 @@ -1455,7 +1456,7 @@ is_proper_list(_) -> %% X4]</code>. %% %% @see c_cons/2 -%% @see c_nil/1 +%% @see c_nil/0 %% @see is_c_list/1 %% @see list_length/1 %% @see make_list/2 @@ -1486,7 +1487,7 @@ abstract_list([]) -> %% efficient.</p> %% %% @see c_cons/2 -%% @see c_nil/1 +%% @see c_nil/0 %% @see is_c_list/1 %% @see list_elements/1 @@ -1991,7 +1992,7 @@ update_c_fname(Node, Atom, Arity) -> %% %% @see c_fname/2 %% @see c_var/1 -%% @see c_var_name/1 +%% @see var_name/1 -spec is_c_fname(cerl()) -> boolean(). @@ -3669,7 +3670,7 @@ c_try(Expr, Vs, Body, Evs, Handler) -> %% @spec ann_c_try(As::[term()], Expression::cerl(), %% Variables::[cerl()], Body::cerl(), %% EVars::[cerl()], Handler::cerl()) -> cerl() -%% @see c_try/3 +%% @see c_try/5 -spec ann_c_try([term()], cerl(), [cerl()], cerl(), [cerl()], cerl()) -> c_try(). @@ -3682,7 +3683,7 @@ ann_c_try(As, Expr, Vs, Body, Evs, Handler) -> %% @spec update_c_try(Old::cerl(), Expression::cerl(), %% Variables::[cerl()], Body::cerl(), %% EVars::[cerl()], Handler::cerl()) -> cerl() -%% @see c_try/3 +%% @see c_try/5 -spec update_c_try(c_try(), cerl(), [cerl()], cerl(), [cerl()], cerl()) -> c_try(). @@ -3697,7 +3698,7 @@ update_c_try(Node, Expr, Vs, Body, Evs, Handler) -> %% @doc Returns <code>true</code> if <code>Node</code> is an abstract %% try-expression, otherwise <code>false</code>. %% -%% @see c_try/3 +%% @see c_try/5 -spec is_c_try(cerl()) -> boolean(). @@ -3711,7 +3712,7 @@ is_c_try(_) -> %% %% @doc Returns the expression subtree of an abstract try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_arg(c_try()) -> cerl(). @@ -3724,7 +3725,7 @@ try_arg(Node) -> %% @doc Returns the list of success variable subtrees of an abstract %% try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_vars(c_try()) -> [cerl()]. @@ -3736,7 +3737,7 @@ try_vars(Node) -> %% %% @doc Returns the success body subtree of an abstract try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_body(c_try()) -> cerl(). @@ -3749,7 +3750,7 @@ try_body(Node) -> %% @doc Returns the list of exception variable subtrees of an abstract %% try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_evars(c_try()) -> [cerl()]. @@ -3762,7 +3763,7 @@ try_evars(Node) -> %% @doc Returns the exception body subtree of an abstract %% try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_handler(c_try()) -> cerl(). @@ -3784,7 +3785,7 @@ try_handler(Node) -> %% @see update_c_catch/2 %% @see is_c_catch/1 %% @see catch_body/1 -%% @see c_try/3 +%% @see c_try/5 -spec c_catch(cerl()) -> c_catch(). diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index f8489a800b..02cdb966ce 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -445,15 +445,14 @@ i_var_1(R, Opnd, Ctxt, Env, S) -> residualize_var(R, S); false -> S1 = st__mark_inner_pending(L, S), - case catch {ok, visit(Opnd, S1)} of - {ok, {E, S2}} -> + try visit(Opnd, S1) of + {E, S2} -> %% Note that we pass the current environment and %% context to `copy', but not the current renaming. S3 = st__clear_inner_pending(L, S2), - copy(R, Opnd, E, Ctxt, Env, S3); - {'EXIT', X} -> - exit(X); - X -> + copy(R, Opnd, E, Ctxt, Env, S3) + catch + throw:X -> %% If we use destructive update for the %% `inner-pending' flag, we must make sure to clear %% it also if we make a nonlocal return. @@ -1128,8 +1127,8 @@ i_call_3(M, F, As, E, Ctxt, Env, S) -> %% Note that we extract the results of argument expessions here; the %% expressions could still be sequences with side effects. Vs = [concrete(result(A)) || A <- As], - case catch {ok, apply(atom_val(M), atom_val(F), Vs)} of - {ok, V} -> + try apply(atom_val(M), atom_val(F), Vs) of + V -> %% Evaluation completed normally - try to turn the result %% back into a syntax tree (representing a literal). case is_literal_term(V) of @@ -1142,8 +1141,9 @@ i_call_3(M, F, As, E, Ctxt, Env, S) -> false -> %% The result could not be represented as a literal. i_call_4(M, F, As, E, Ctxt, Env, S) - end; - _ -> + end + catch + error:_ -> %% The evaluation attempt did not complete normally. i_call_4(M, F, As, E, Ctxt, Env, S) end. @@ -1736,12 +1736,11 @@ copy_1(R, Opnd, E, Ctxt, Env, S) -> copy_inline(R, Opnd, E, Ctxt, Env, S) -> S1 = st__mark_outer_pending(Opnd#opnd.loc, S), - case catch {ok, copy_inline_1(R, E, Ctxt, Env, S1)} of - {ok, {E1, S2}} -> - {E1, st__clear_outer_pending(Opnd#opnd.loc, S2)}; - {'EXIT', X} -> - exit(X); - X -> + try copy_inline_1(R, E, Ctxt, Env, S1) of + {E1, S2} -> + {E1, st__clear_outer_pending(Opnd#opnd.loc, S2)} + catch + throw:X -> %% If we use destructive update for the `outer-pending' %% flag, we must make sure to clear it upon a nonlocal %% return. @@ -1758,19 +1757,16 @@ copy_inline_1(R, E, Ctxt, Env, S) -> copy_inline_2(R, E, Ctxt, Env, S); false -> S1 = new_active_effort(get_effort_limit(S), S), - case catch {ok, copy_inline_2(R, E, Ctxt, Env, S1)} of - {ok, {E1, S2}} -> + try copy_inline_2(R, E, Ctxt, Env, S1) of + {E1, S2} -> %% Revert to the old effort counter. - {E1, revert_effort(S, S2)}; - {counter_exceeded, effort, _} -> + {E1, revert_effort(S, S2)} + catch + throw:{counter_exceeded, effort, _} -> %% Aborted this inlining attempt because too much %% effort was spent. Residualize the variable and %% revert to the previous state. - residualize_var(R, S); - {'EXIT', X} -> - exit(X); - X -> - throw(X) + residualize_var(R, S) end end. @@ -1796,11 +1792,12 @@ copy_inline_2(R, E, Ctxt, Env, S) -> %% close to zero at this point. (This is an extension to the %% original algorithm.) S1 = new_active_size(Limit + apply_size(length(Ctxt#app.opnds)), S), - case catch {ok, inline(E, Ctxt, ren__identity(), Env, S1)} of - {ok, {E1, S2}} -> + try inline(E, Ctxt, ren__identity(), Env, S1) of + {E1, S2} -> %% Revert to the old size counter. - {E1, revert_size(S, S2)}; - {counter_exceeded, size, S2} -> + {E1, revert_size(S, S2)} + catch + throw:{counter_exceeded, size, S2} -> %% Aborted this inlining attempt because it got too big. %% Residualize the variable and revert to the old size %% counter. (It is important that we do not also revert the @@ -1813,11 +1810,7 @@ copy_inline_2(R, E, Ctxt, Env, S) -> %% must make sure to clear the flags of any nested %% app-contexts upon aborting; see `inline' for details. S4 = reset_nested_apps(Ctxt, S3), % for effect - residualize_var(R, S4); - {'EXIT', X} -> - exit(X); - X -> - throw(X) + residualize_var(R, S4) end. reset_nested_apps(#app{ctxt = Ctxt, loc = L}, S) -> diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index b93da8e97f..f1bf0e02e7 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -19,7 +19,7 @@ %% @doc Basic functions on Core Erlang abstract syntax trees. %% %% <p>Syntax trees are defined in the module <a -%% href=""><code>cerl</code></a>.</p> +%% href="cerl"><code>cerl</code></a>.</p> %% %% @type cerl() = cerl:cerl() diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index f347438509..22810c910c 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -41,7 +41,7 @@ -type option() :: atom() | {atom(), term()} | {'d', atom(), term()}. --type err_info() :: {erl_scan:line() | 'none', +-type err_info() :: {erl_anno:line() | 'none', module(), term()}. %% ErrorDescriptor -type errors() :: [{file:filename(), [err_info()]}]. -type warnings() :: [{file:filename(), [err_info()]}]. @@ -132,7 +132,8 @@ env_default_opts() -> Str when is_list(Str) -> case erl_scan:string(Str) of {ok,Tokens,_} -> - case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of + Dot = {dot, erl_anno:new(1)}, + case erl_parse:parse_term(Tokens ++ [Dot]) of {ok,List} when is_list(List) -> List; {ok,Term} -> [Term]; {error,_Reason} -> @@ -285,11 +286,20 @@ internal_comp(Passes, File, Suffix, St0) -> St1 = St0#compile{filename=File, dir=Dir, base=Base, ifile=erlfile(Dir, Base, Suffix), ofile=objfile(Base, St0)}, - Run = case member(time, St1#compile.options) of - true -> - io:format("Compiling ~tp\n", [File]), - fun run_tc/2; - false -> fun({_Name,Fun}, St) -> catch Fun(St) end + Opts = St1#compile.options, + Run0 = case member(time, Opts) of + true -> + io:format("Compiling ~tp\n", [File]), + fun run_tc/2; + false -> fun({_Name,Fun}, St) -> catch Fun(St) end + end, + Run = case keyfind(eprof, 1, Opts) of + {eprof,EprofPass} -> + fun(P, St) -> + run_eprof(P, EprofPass, St) + end; + false -> + Run0 end, case fold_comp(Passes, Run, St1) of {ok,St2} -> comp_ret_ok(St2); @@ -320,17 +330,26 @@ fold_comp([{Name,Pass}|Ps], Run, St0) -> fold_comp([], _Run, St) -> {ok,St}. run_tc({Name,Fun}, St) -> - Before0 = statistics(runtime), + T1 = erlang:monotonic_time(), Val = (catch Fun(St)), - After0 = statistics(runtime), - {Before_c, _} = Before0, - {After_c, _} = After0, + T2 = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(T2 - T1, native, milli_seconds), Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize), Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])), - io:format(" ~-30s: ~10.2f s ~12s\n", - [Name,(After_c-Before_c) / 1000,Mem]), + io:format(" ~-30s: ~10.3f s ~12s\n", + [Name,Elapsed/1000,Mem]), Val. +run_eprof({Name,Fun}, Name, St) -> + io:format("~p: Running eprof\n", [Name]), + eprof:start_profiling([self()]), + Val = (catch Fun(St)), + eprof:stop_profiling(), + eprof:analyze(), + Val; +run_eprof({_,Fun}, _, St) -> + catch Fun(St). + comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) -> case werror(St) of true -> @@ -606,7 +625,7 @@ standard_passes() -> {iff,'to_exp',{done,"E"}}, %% Conversion to Core Erlang. - ?pass(core_module), + {pass,v3_core}, {iff,'dcore',{listing,"core"}}, {iff,'to_core0',{done,"core"}} | core_passes()]. @@ -618,7 +637,7 @@ core_passes() -> [{unless,no_copt, [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1}, {iff,doldinline,{listing,"oldinline"}}, - ?pass(core_fold_module), + {pass,sys_core_fold}, {iff,dcorefold,{listing,"corefold"}}, {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1}, {iff,dinline,{listing,"inline"}}, @@ -631,14 +650,14 @@ core_passes() -> kernel_passes() -> %% Destructive setelement/3 optimization and core lint. - [?pass(core_dsetel_module), + [{pass,sys_core_dsetel}, {iff,dsetel,{listing,"dsetel"}}, {iff,clint,?pass(core_lint_module)}, {iff,core,?pass(save_core_code)}, %% Kernel Erlang and code generation. - ?pass(kernel_module), + {pass,v3_kernel}, {iff,dkern,{listing,"kernel"}}, {iff,'to_kernel',{done,"kernel"}}, {pass,v3_life}, @@ -901,28 +920,35 @@ transform_module(#compile{options=Opt,code=Code0}=St0) -> foldl_transform(St, [T|Ts]) -> Name = "transform " ++ atom_to_list(T), - Fun = fun(S) -> T:parse_transform(S#compile.code, S#compile.options) end, - Run = case member(time, St#compile.options) of - true -> fun run_tc/2; - false -> fun({_Name,F}, S) -> catch F(S) end - end, - case Run({Name, Fun}, St) of - {error,Es,Ws} -> - {error,St#compile{warnings=St#compile.warnings ++ Ws, - errors=St#compile.errors ++ Es}}; - {'EXIT',{undef,_}} -> - Es = [{St#compile.ifile,[{none,compile, - {undef_parse_transform,T}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}}; - {'EXIT',R} -> - Es = [{St#compile.ifile,[{none,compile,{parse_transform,T,R}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}}; - {warning, Forms, Ws} -> - foldl_transform( - St#compile{code=Forms, - warnings=St#compile.warnings ++ Ws}, Ts); - Forms -> - foldl_transform(St#compile{code=Forms}, Ts) + case code:ensure_loaded(T) =:= {module,T} andalso + erlang:function_exported(T, parse_transform, 2) of + true -> + Fun = fun(S) -> + T:parse_transform(S#compile.code, S#compile.options) + end, + Run = case member(time, St#compile.options) of + true -> fun run_tc/2; + false -> fun({_Name,F}, S) -> catch F(S) end + end, + case Run({Name, Fun}, St) of + {error,Es,Ws} -> + {error,St#compile{warnings=St#compile.warnings ++ Ws, + errors=St#compile.errors ++ Es}}; + {'EXIT',R} -> + Es = [{St#compile.ifile,[{none,compile, + {parse_transform,T,R}}]}], + {error,St#compile{errors=St#compile.errors ++ Es}}; + {warning, Forms, Ws} -> + foldl_transform( + St#compile{code=Forms, + warnings=St#compile.warnings ++ Ws}, Ts); + Forms -> + foldl_transform(St#compile{code=Forms}, Ts) + end; + false -> + Es = [{St#compile.ifile,[{none,compile, + {undef_parse_transform,T}}]}], + {error,St#compile{errors=St#compile.errors ++ Es}} end; foldl_transform(St, []) -> {ok,St}. @@ -1176,14 +1202,6 @@ expand_module(#compile{code=Code,options=Opts0}=St0) -> Opts = expand_opts(Opts1), {ok,St0#compile{module=Mod,options=Opts,code={Mod,Exp,Forms}}}. -core_module(#compile{code=Code0,options=Opts}=St) -> - {ok,Code,Ws} = v3_core:module(Code0, Opts), - {ok,St#compile{code=Code,warnings=St#compile.warnings ++ Ws}}. - -core_fold_module(#compile{code=Code0,options=Opts,warnings=Warns}=St) -> - {ok,Code,Ws} = sys_core_fold:module(Code0, Opts), - {ok,St#compile{code=Code,warnings=Warns ++ Ws}}. - core_fold_module_after_inlining(#compile{code=Code0,options=Opts}=St) -> %% Inlining may produce code that generates spurious warnings. %% Ignore all warnings. @@ -1219,14 +1237,6 @@ core_inline_module(#compile{code=Code0,options=Opts}=St) -> Code = cerl_inline:core_transform(Code0, Opts), {ok,St#compile{code=Code}}. -core_dsetel_module(#compile{code=Code0,options=Opts}=St) -> - {ok,Code} = sys_core_dsetel:module(Code0, Opts), - {ok,St#compile{code=Code}}. - -kernel_module(#compile{code=Code0,options=Opts}=St) -> - {ok,Code,Ws} = v3_kernel:module(Code0, Opts), - {ok,St#compile{code=Code,warnings=St#compile.warnings ++ Ws}}. - save_abstract_code(#compile{ifile=File}=St) -> case abstract_code(St) of {ok,Code} -> @@ -1235,7 +1245,8 @@ save_abstract_code(#compile{ifile=File}=St) -> {error,St#compile{errors=St#compile.errors ++ [{File,Es}]}} end. -abstract_code(#compile{code=Code,options=Opts,ofile=OFile}) -> +abstract_code(#compile{code=Code0,options=Opts,ofile=OFile}) -> + Code = erl_parse:anno_to_term(Code0), Abstr = erlang:term_to_binary({raw_abstract_v1,Code}, [compressed]), case member(encrypt_debug_info, Opts) of true -> @@ -1295,8 +1306,9 @@ encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> list_to_binary([0,length(TypeString),TypeString,Bin]). random_bytes(N) -> - {A,B,C} = now(), - _ = random:seed(A, B, C), + _ = random:seed(erlang:time_offset(), + erlang:monotonic_time(), + erlang:unique_integer()), random_bytes_1(N, []). random_bytes_1(0, Acc) -> Acc; diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index fbaa7a96fe..2a40c1c379 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -69,5 +69,5 @@ {registered, []}, {applications, [kernel, stdlib]}, {env, []}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0", + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-7.0", "crypto-3.3"]}]}. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index ea1959d0f8..6f8279f65e 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -70,7 +70,8 @@ -export([module/2,format_error/1]). -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2, - reverse/1,reverse/2,member/2,nth/2,flatten/1,unzip/1]). + reverse/1,reverse/2,member/2,nth/2,flatten/1, + unzip/1,keyfind/3]). -import(cerl, [ann_c_cons/3,ann_c_map/3,ann_c_tuple/2]). @@ -96,7 +97,7 @@ t=[], %Types in_guard=false}). %In guard or not. --type type_info() :: cerl:cerl() | 'bool'. +-type type_info() :: cerl:cerl() | 'bool' | 'integer'. -type yes_no_maybe() :: 'yes' | 'no' | 'maybe'. -type sub() :: #sub{}. @@ -297,7 +298,8 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) -> false -> Seq0#c_seq{arg=Arg,body=B1} end end; -expr(#c_let{}=Let, Ctxt, Sub) -> +expr(#c_let{}=Let0, Ctxt, Sub) -> + Let = opt_case_in_let(Let0), case simplify_let(Let, Sub) of impossible -> %% The argument for the let is "simple", i.e. has no @@ -829,16 +831,16 @@ eval_rel_op(Call, '=:=', [Term,#c_literal{val=true}], Sub) -> maybe -> Call; no -> #c_literal{val=false} end; -eval_rel_op(Call, '==', Ops, _Sub) -> - case is_exact_eq_ok(Ops) of +eval_rel_op(Call, '==', Ops, Sub) -> + case is_exact_eq_ok(Ops, Sub) of true -> Name = #c_literal{anno=cerl:get_ann(Call),val='=:='}, Call#c_call{name=Name}; false -> Call end; -eval_rel_op(Call, '/=', Ops, _Sub) -> - case is_exact_eq_ok(Ops) of +eval_rel_op(Call, '/=', Ops, Sub) -> + case is_exact_eq_ok(Ops, Sub) of true -> Name = #c_literal{anno=cerl:get_ann(Call),val='=/='}, Call#c_call{name=Name}; @@ -847,11 +849,17 @@ eval_rel_op(Call, '/=', Ops, _Sub) -> end; eval_rel_op(Call, _, _, _) -> Call. -is_exact_eq_ok([#c_literal{val=Lit}|_]) -> +is_exact_eq_ok([A,B]=L, Sub) -> + case is_int_type(A, Sub) =:= yes andalso is_int_type(B, Sub) =:= yes of + true -> true; + false -> is_exact_eq_ok_1(L) + end. + +is_exact_eq_ok_1([#c_literal{val=Lit}|_]) -> is_non_numeric(Lit); -is_exact_eq_ok([_|T]) -> - is_exact_eq_ok(T); -is_exact_eq_ok([]) -> false. +is_exact_eq_ok_1([_|T]) -> + is_exact_eq_ok_1(T); +is_exact_eq_ok_1([]) -> false. is_non_numeric([H|T]) -> is_non_numeric(H) andalso is_non_numeric(T); @@ -963,7 +971,7 @@ eval_element(Call, #c_literal{val=Pos}, Tuple, Types) 1 =< Pos, Pos =< length(Es) -> El = lists:nth(Pos, Es), try - pat_to_expr(El) + cerl:set_ann(pat_to_expr(El), [compiler_generated]) catch throw:impossible -> Call @@ -1008,28 +1016,32 @@ eval_is_record(Call, _, _, _, _) -> Call. %% eval_setelement(Call, Pos, Tuple, NewVal) -> Core. %% Evaluates setelement/3 if position Pos is an integer -%% the shape of the tuple Tuple is known. +%% and the shape of the tuple Tuple is known. %% -eval_setelement(Call, Pos, Tuple, NewVal) -> - try - eval_setelement_1(Pos, Tuple, NewVal) - catch - error:_ -> - Call - end. - -eval_setelement_1(#c_literal{val=Pos}, #c_tuple{anno=A,es=Es}, NewVal) +eval_setelement(Call, #c_literal{val=Pos}, Tuple, NewVal) when is_integer(Pos) -> - ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal)); -eval_setelement_1(#c_literal{val=Pos}, #c_literal{anno=A,val=Es0}, NewVal) - when is_integer(Pos) -> - Es = [#c_literal{anno=A,val=E} || E <- tuple_to_list(Es0)], - ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal)). + case cerl:is_data(Tuple) of + false -> + Call; + true -> + Es0 = case cerl:is_c_tuple(Tuple) of + false -> []; + true -> cerl:tuple_es(Tuple) + end, + if + 1 =< Pos, Pos =< length(Es0) -> + Es = eval_setelement_1(Pos, Es0, NewVal), + cerl:update_c_tuple(Tuple, Es); + true -> + eval_failure(Call, badarg) + end + end; +eval_setelement(Call, _, _, _) -> Call. -eval_setelement_2(1, [_|T], NewVal) -> +eval_setelement_1(1, [_|T], NewVal) -> [NewVal|T]; -eval_setelement_2(Pos, [H|T], NewVal) when Pos > 1 -> - [H|eval_setelement_2(Pos-1, T, NewVal)]. +eval_setelement_1(Pos, [H|T], NewVal) when Pos > 1 -> + [H|eval_setelement_1(Pos-1, T, NewVal)]. %% eval_failure(Call, Reason) -> Core. %% Warn for a call that will fail and replace the call with @@ -1613,12 +1625,11 @@ eval_case(Case, _) -> Case. eval_case_warn(#c_primop{anno=Anno, name=#c_literal{val=match_fail}, - args=[#c_literal{val=Reason}]}=Core) - when is_atom(Reason) -> - case member(eval_failure, Anno) of + args=[_]}=Core) -> + case keyfind(eval_failure, 1, Anno) of false -> ok; - true -> + {eval_failure,Reason} -> %% Example: M = not_map, M#{k:=v} add_warning(Core, {eval_failure,Reason}) end; @@ -1955,46 +1966,125 @@ letify(Bs, Body) -> cerl:ann_c_let(Ann, [V], Val, B) end, Body, Bs). -%% opt_case_in_let(LetExpr) -> LetExpr' +%% opt_not_in_let(Let) -> Cerl +%% Try to optimize away a 'not' operator in a 'let'. -opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> - opt_case_in_let_0(Vs, Arg, B, Let, Sub). +-spec opt_not_in_let(cerl:c_let()) -> cerl:cerl(). -opt_case_in_let_0([#c_var{name=V}], Arg, - #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let, Sub) -> - case opt_case_in_let_1(V, Arg, Cs) of - impossible -> - case is_simple_case_arg(Arg) andalso - not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of - true -> - expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new(Sub)); - false -> - Let +opt_not_in_let(#c_let{vars=[_]=Vs0,arg=Arg0,body=Body0}=Let) -> + case opt_not_in_let(Vs0, Arg0, Body0) of + {[],#c_values{es=[]},Body} -> + Body; + {Vs,Arg,Body} -> + Let#c_let{vars=Vs,arg=Arg,body=Body} + end; +opt_not_in_let(Let) -> Let. + +%% opt_not_in_let(Vs, Arg, Body) -> {Vs',Arg',Body'} +%% Try to optimize away a 'not' operator in a 'let'. + +-spec opt_not_in_let([cerl:c_var()], cerl:cerl(), cerl:cerl()) -> + {[cerl:c_var()],cerl:cerl(),cerl:cerl()}. + +opt_not_in_let([#c_var{name=V}]=Vs0, Arg0, Body0) -> + case cerl:type(Body0) of + call -> + %% let <V> = Expr in not V ==> + %% let <> = <> in notExpr + case opt_not_in_let_1(V, Body0, Arg0) of + no -> + {Vs0,Arg0,Body0}; + {yes,Body} -> + {[],#c_values{es=[]},Body} end; - Expr -> Expr + 'let' -> + %% let <V> = Expr in let <Var> = not V in Body ==> + %% let <Var> = notExpr in Body + %% V must not be used in Body. + LetArg = cerl:let_arg(Body0), + case opt_not_in_let_1(V, LetArg, Arg0) of + no -> + {Vs0,Arg0,Body0}; + {yes,Arg} -> + LetBody = cerl:let_body(Body0), + case core_lib:is_var_used(V, LetBody) of + true -> + {Vs0,Arg0,Body0}; + false -> + LetVars = cerl:let_vars(Body0), + {LetVars,Arg,LetBody} + end + end; + _ -> + {Vs0,Arg0,Body0} end; -opt_case_in_let_0(_, _, _, Let, _) -> Let. - -opt_case_in_let_1(V, Arg, Cs) -> - try - opt_case_in_let_2(V, Arg, Cs) - catch - _:_ -> impossible +opt_not_in_let(Vs, Arg, Body) -> + {Vs,Arg,Body}. + +opt_not_in_let_1(V, Call, Body) -> + case Call of + #c_call{module=#c_literal{val=erlang}, + name=#c_literal{val='not'}, + args=[#c_var{name=V}]} -> + opt_not_in_let_2(Body); + _ -> + no end. -opt_case_in_let_2(V, Arg0, - [#c_clause{pats=[#c_tuple{es=Es}], - guard=#c_literal{val=true},body=B}|_]) -> +opt_not_in_let_2(#c_case{clauses=Cs0}=Case) -> + Vars = make_vars([], 1), + Body = #c_call{module=#c_literal{val=erlang}, + name=#c_literal{val='not'}, + args=Vars}, + Cs = [begin + Let = #c_let{vars=Vars,arg=B,body=Body}, + C#c_clause{body=opt_not_in_let(Let)} + end || #c_clause{body=B}=C <- Cs0], + {yes,Case#c_case{clauses=Cs}}; +opt_not_in_let_2(#c_call{}=Call0) -> + invert_call(Call0); +opt_not_in_let_2(_) -> no. + +invert_call(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=Name0}, + args=[_,_]}=Call) -> + case inverse_rel_op(Name0) of + no -> no; + Name -> {yes,Call#c_call{name=#c_literal{val=Name}}} + end; +invert_call(#c_call{}) -> no. + +%% inverse_rel_op(Op) -> no | RevOp + +inverse_rel_op('=:=') -> '=/='; +inverse_rel_op('=/=') -> '=:='; +inverse_rel_op('==') -> '/='; +inverse_rel_op('/=') -> '=='; +inverse_rel_op('>') -> '=<'; +inverse_rel_op('<') -> '>='; +inverse_rel_op('>=') -> '<'; +inverse_rel_op('=<') -> '>'; +inverse_rel_op(_) -> no. - %% In {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end. - %% avoid building tuples, by converting tuples to multiple values. - %% (The optimisation is not done if the built tuple is used or returned.) - true = all(fun (#c_var{}) -> true; - (_) -> false end, Es), %Only variables in tuple - false = core_lib:is_var_used(V, B), %Built tuple must not be used. - Arg1 = tuple_to_values(Arg0, length(Es)), %Might fail. - #c_let{vars=Es,arg=Arg1,body=B}. +%% opt_bool_case_in_let(LetExpr, Sub) -> Core + +opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> + opt_case_in_let_1(Vs, Arg, B, Let, Sub). + +opt_case_in_let_1([#c_var{name=V}], Arg, + #c_case{arg=#c_var{name=V}}=Case0, Let, Sub) -> + case is_simple_case_arg(Arg) of + true -> + Case = opt_bool_case(Case0#c_case{arg=Arg}), + case core_lib:is_var_used(V, Case) of + false -> expr(Case, sub_new(Sub)); + true -> Let + end; + false -> + Let + end; +opt_case_in_let_1(_, _, _, Let, _) -> Let. %% is_simple_case_arg(Expr) -> true|false %% Determine whether the Expr is simple enough to be worth @@ -2036,7 +2126,7 @@ is_bool_expr(#c_clause{body=B}, Sub) -> is_bool_expr(B, Sub); is_bool_expr(#c_let{vars=[V],arg=Arg,body=B}, Sub0) -> Sub = case is_bool_expr(Arg, Sub0) of - true -> update_types(V, [#c_literal{val=true}], Sub0); + true -> update_types(V, [bool], Sub0); false -> Sub0 end, is_bool_expr(B, Sub); @@ -2122,38 +2212,6 @@ is_safe_bool_expr_list([C|Cs], Sub, BoolVars) -> end; is_safe_bool_expr_list([], _, _) -> true. -%% tuple_to_values(Expr, TupleArity) -> Expr' -%% Convert tuples in return position of arity TupleArity to values. -%% Throws an exception for constructs that are not handled. - -tuple_to_values(#c_tuple{es=Es}, Arity) when length(Es) =:= Arity -> - core_lib:make_values(Es); -tuple_to_values(#c_literal{val=Tuple}=Lit, Arity) when tuple_size(Tuple) =:= Arity -> - Es = [Lit#c_literal{val=E} || E <- tuple_to_list(Tuple)], - core_lib:make_values(Es); -tuple_to_values(#c_case{clauses=Cs0}=Case, Arity) -> - Cs1 = [tuple_to_values(E, Arity) || E <- Cs0], - Case#c_case{clauses=Cs1}; -tuple_to_values(#c_seq{body=B0}=Seq, Arity) -> - Seq#c_seq{body=tuple_to_values(B0, Arity)}; -tuple_to_values(#c_let{body=B0}=Let, Arity) -> - Let#c_let{body=tuple_to_values(B0, Arity)}; -tuple_to_values(#c_receive{clauses=Cs0,timeout=Timeout,action=A0}=Rec, Arity) -> - Cs = [tuple_to_values(E, Arity) || E <- Cs0], - A = case Timeout of - #c_literal{val=infinity} -> A0; - _ -> tuple_to_values(A0, Arity) - end, - Rec#c_receive{clauses=Cs,action=A}; -tuple_to_values(#c_clause{body=B0}=Clause, Arity) -> - B = tuple_to_values(B0, Arity), - Clause#c_clause{body=B}; -tuple_to_values(Expr, _) -> - case will_fail(Expr) of - true -> Expr; - false -> erlang:error({not_handled,Expr}) - end. - %% simplify_let(Let, Sub) -> Expr | impossible %% If the argument part of an let contains a complex expression, such %% as a let or a sequence, move the original let body into the complex @@ -2180,7 +2238,7 @@ move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner, Arg = body(Arg0, Sub0), ScopeSub0 = sub_subst_scope(Sub0#sub{t=[]}), {OuterVs,ScopeSub} = pattern_list(OuterVs0, ScopeSub0), - + OuterBody = body(OuterBody0, ScopeSub), {InnerVs,Sub} = pattern_list(InnerVs0, Sub0), @@ -2258,50 +2316,179 @@ move_let_into_expr(_Let, _Expr, _Sub) -> impossible. is_failing_clause(#c_clause{body=B}) -> will_fail(B). +%% opt_case_in_let(Let) -> Let' +%% Try to avoid building tuples that are immediately matched. +%% A common pattern is: +%% +%% {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end +%% +%% In Core Erlang the pattern would look like this: +%% +%% let <V> = case E of +%% ... -> ... {Val1,Val2} +%% ... +%% end, +%% in case V of +%% {A,B} -> ... <use A and B> ... +%% end +%% +%% Rewrite this to: +%% +%% let <V1,V2> = case E of +%% ... -> ... <Val1,Val2> +%% ... +%% end, +%% in +%% let <V> = {V1,V2} +%% in case V of +%% {A,B} -> ... <use A and B> ... +%% end +%% +%% Note that the second 'case' is unchanged. The other optimizations +%% in this module will eliminate the building of the tuple and +%% rewrite the second case to: +%% +%% case <V1,V2> of +%% <A,B> -> ... <use A and B> ... +%% end +%% + +opt_case_in_let(#c_let{vars=Vs,arg=Arg0,body=B}=Let0) -> + case matches_data(Vs, B) of + {yes,TypeSig} -> + case delay_build(Arg0, TypeSig) of + no -> + Let0; + {yes,Vars,Arg,Data} -> + InnerLet = Let0#c_let{arg=Data}, + Let0#c_let{vars=Vars,arg=Arg,body=InnerLet} + end; + no -> + Let0 + end. + +matches_data([#c_var{name=V}], #c_case{arg=#c_var{name=V}, + clauses=[#c_clause{pats=[P]}|_]}) -> + case cerl:is_data(P) of + false -> + no; + true -> + case cerl:data_type(P) of + {atomic,_} -> + no; + Type -> + {yes,{Type,cerl:data_arity(P)}} + end + end; +matches_data(_, _) -> no. + +delay_build(Core, TypeSig) -> + case cerl:is_data(Core) of + true -> no; + false -> delay_build_1(Core, TypeSig) + end. + +delay_build_1(Core0, TypeSig) -> + try delay_build_expr(Core0, TypeSig) of + Core -> + {Type,Arity} = TypeSig, + Vars = make_vars([], Arity), + Data = cerl:ann_make_data([compiler_generated], Type, Vars), + {yes,Vars,Core,Data} + catch + throw:impossible -> + no + end. + +delay_build_cs([#c_clause{body=B0}=C0|Cs], TypeSig) -> + B = delay_build_expr(B0, TypeSig), + C = C0#c_clause{body=B}, + [C|delay_build_cs(Cs, TypeSig)]; +delay_build_cs([], _) -> []. + +delay_build_expr(Core, {Type,Arity}=TypeSig) -> + case cerl:is_data(Core) of + false -> + delay_build_expr_1(Core, TypeSig); + true -> + case {cerl:data_type(Core),cerl:data_arity(Core)} of + {Type,Arity} -> + core_lib:make_values(cerl:data_es(Core)); + {_,_} -> + throw(impossible) + end + end. + +delay_build_expr_1(#c_case{clauses=Cs0}=Case, TypeSig) -> + Cs = delay_build_cs(Cs0, TypeSig), + Case#c_case{clauses=Cs}; +delay_build_expr_1(#c_let{body=B0}=Let, TypeSig) -> + B = delay_build_expr(B0, TypeSig), + Let#c_let{body=B}; +delay_build_expr_1(#c_receive{clauses=Cs0, + timeout=Timeout, + action=A0}=Rec, TypeSig) -> + Cs = delay_build_cs(Cs0, TypeSig), + A = case Timeout of + #c_literal{val=infinity} -> A0; + _ -> delay_build_expr(A0, TypeSig) + end, + Rec#c_receive{clauses=Cs,action=A}; +delay_build_expr_1(#c_seq{body=B0}=Seq, TypeSig) -> + B = delay_build_expr(B0, TypeSig), + Seq#c_seq{body=B}; +delay_build_expr_1(Core, _TypeSig) -> + case will_fail(Core) of + true -> Core; + false -> throw(impossible) + end. + %% opt_simple_let(#c_let{}, Context, Sub) -> CoreTerm %% Optimize a let construct that does not contain any lets in %% in its argument. -opt_simple_let(#c_let{arg=Arg0}=Let, Ctxt, Sub0) -> - Arg = body(Arg0, value, Sub0), %This is a body +opt_simple_let(Let0, Ctxt, Sub) -> + case opt_not_in_let(Let0) of + #c_let{}=Let -> + opt_simple_let_0(Let, Ctxt, Sub); + Expr -> + expr(Expr, Ctxt, Sub) + end. + +opt_simple_let_0(#c_let{arg=Arg0}=Let, Ctxt, Sub) -> + Arg = body(Arg0, value, Sub), %This is a body case will_fail(Arg) of true -> Arg; - false -> opt_simple_let_1(Let, Arg, Ctxt, Sub0) + false -> opt_simple_let_1(Let, Arg, Ctxt, Sub) end. opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) -> %% Optimise let and add new substitutions. - {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), - BodySub = case {Vs,Args} of - {[V],[A]} -> - case is_bool_expr(A, Sub0) of - true -> - update_types(V, [#c_literal{val=true}], Sub1); - false -> - Sub1 - end; - {_,_} -> Sub1 - end, - B = body(B0, Ctxt, BodySub), - Arg = core_lib:make_values(Args), - opt_simple_let_2(Let, Vs, Arg, B, Ctxt, Sub1). - -opt_simple_let_2(Let0, Vs0, Arg0, Body, Ctxt, Sub) -> + {Vs1,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), + BodySub = update_let_types(Vs1, Args, Sub1), + B1 = body(B0, Ctxt, BodySub), + Arg1 = core_lib:make_values(Args), + {Vs,Arg,B} = opt_not_in_let(Vs1, Arg1, B1), + opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1). + +opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> case {Vs0,Arg0,Body} of - {[#c_var{name=N1}],Arg,#c_var{name=N2}} -> + {[#c_var{name=N1}],Arg1,#c_var{name=N2}} -> case N1 =:= N2 of true -> %% let <Var> = Arg in <Var> ==> Arg - Arg; + Arg1; false -> %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar + Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody, Ctxt), expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)) end; {[],#c_values{es=[]},_} -> %% No variables left. Body; - {_,Arg,#c_literal{}} -> + {Vs,Arg1,#c_literal{}} -> + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), E = case Ctxt of effect -> %% Throw away the literal body. @@ -2313,22 +2500,67 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, Ctxt, Sub) -> #c_seq{arg=Arg,body=Body} end, expr(E, Ctxt, sub_new_preserve_types(Sub)); - {Vs,Arg,Body} -> + {Vs,Arg1,Body} -> %% If none of the variables are used in the body, we can %% rewrite the let to a sequence: %% let <Var> = Arg in BodyWithoutVar ==> %% seq Arg BodyWithoutVar case is_any_var_used(Vs, Body) of false -> + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)); true -> - Let1 = Let0#c_let{vars=Vs,arg=Arg,body=Body}, - Let2 = opt_case_in_let(Let1, Sub), + Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body}, + Let2 = opt_bool_case_in_let(Let1, Sub), opt_case_in_let_arg(Let2, Ctxt, Sub) end end. +%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody, Context) -> Arg' +%% Try to suppress false warnings when a variable is not used. +%% For instance, we don't expect a warning for useless building in: +%% +%% R = #r{}, %No warning expected. +%% R#r.f %Optimization would remove the reference to R. +%% +%% To avoid false warnings, we will check whether the variables were +%% referenced in the original unoptimized code. If they were, we will +%% consider the warning false and suppress it. + +maybe_suppress_warnings(Arg, _, _, effect) -> + %% Don't suppress any warnings in effect context. + Arg; +maybe_suppress_warnings(Arg, Vs, PrevBody, value) -> + case should_suppress_warning(Arg) of + true -> + Arg; %Already suppressed. + false -> + case is_any_var_used(Vs, PrevBody) of + true -> + suppress_warning([Arg]); + false -> + Arg + end + end. + +%% Suppress warnings for a Core Erlang expression whose value will +%% be ignored. +suppress_warning([H|T]) -> + case cerl:is_literal(H) of + true -> + suppress_warning(T); + false -> + case cerl:is_data(H) of + true -> + suppress_warning(cerl:data_es(H) ++ T); + false -> + Arg = cerl:set_ann(H, [compiler_generated]), + cerl:c_seq(Arg, suppress_warning(T)) + end + end; +suppress_warning([]) -> void(). + move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg, body=InnerArg0}=Outer, clauses=InnerClauses}=Inner, Sub) -> @@ -2416,7 +2648,7 @@ move_case_into_arg(_, _) -> %% <> when 'true' -> %% let <Var> = Literal2 in LetBody %% end -%% +%% %% In the worst case, the size of the code could increase. %% In practice, though, substituting the literals into %% LetBody and doing constant folding will decrease the code @@ -2490,6 +2722,7 @@ is_boolean_type(Var, Sub) -> is_int_type(Var, Sub) -> case get_type(Var, Sub) of none -> maybe; + integer -> yes; C -> yes_no(cerl:is_c_int(C)) end. @@ -2504,8 +2737,58 @@ is_tuple_type(Var, Sub) -> yes_no(true) -> yes; yes_no(false) -> no. +%%% +%%% Update type information. +%%% + +update_let_types(Vs, Args, Sub) when is_list(Args) -> + update_let_types_1(Vs, Args, Sub); +update_let_types(_Vs, _Arg, Sub) -> + %% The argument is a complex expression (such as a 'case') + %% that returns multiple values. + Sub. + +update_let_types_1([#c_var{}=V|Vs], [A|As], Sub0) -> + Sub = update_types_from_expr(V, A, Sub0), + update_let_types_1(Vs, As, Sub); +update_let_types_1([], [], Sub) -> Sub. + +update_types_from_expr(V, Expr, Sub) -> + Type = extract_type(Expr, Sub), + update_types(V, [Type], Sub). + +extract_type(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=Name}, + args=Args}=Call, Sub) -> + case returns_integer(Name, Args) of + true -> integer; + false -> extract_type_1(Call, Sub) + end; +extract_type(Expr, Sub) -> + extract_type_1(Expr, Sub). + +extract_type_1(Expr, Sub) -> + case is_bool_expr(Expr, Sub) of + false -> Expr; + true -> bool + end. + +returns_integer(bit_size, [_]) -> true; +returns_integer('bsl', [_,_]) -> true; +returns_integer('bsr', [_,_]) -> true; +returns_integer(byte_size, [_]) -> true; +returns_integer(length, [_]) -> true; +returns_integer('rem', [_,_]) -> true; +returns_integer(size, [_]) -> true; +returns_integer(tuple_size, [_]) -> true; +returns_integer(trunc, [_]) -> true; +returns_integer(_, _) -> false. + %% update_types(Expr, Pattern, Sub) -> Sub' %% Update the type database. + +-spec update_types(cerl:cerl(), [type_info()], sub()) -> sub(). + update_types(Expr, Pat, #sub{t=Tdb0}=Sub) -> Tdb = update_types_1(Expr, Pat, Tdb0), Sub#sub{t=Tdb}. @@ -2525,6 +2808,8 @@ update_types_2(V, [#c_tuple{}=P], Types) -> orddict:store(V, P, Types); update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> orddict:store(V, bool, Types); +update_types_2(V, [Type], Types) when is_atom(Type) -> + orddict:store(V, Type, Types); update_types_2(_, _, Types) -> Types. %% kill_types(V, Tdb) -> Tdb' @@ -2791,7 +3076,7 @@ bsm_ensure_no_partition_after([#c_clause{pats=Ps}|Cs], Pos) -> bsm_problem(P, bin_partition) end; bsm_ensure_no_partition_after([], _) -> ok. - + bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P); bsm_could_match_binary(#c_cons{}) -> false; bsm_could_match_binary(#c_tuple{}) -> false; @@ -2825,7 +3110,7 @@ add_bin_opt_info(Core, Term) -> end. add_warning(Core, Term) -> - case suppress_warning(Core) of + case should_suppress_warning(Core) of true -> ok; false -> @@ -2850,7 +3135,7 @@ get_file([{file,File}|_]) -> File; get_file([_|T]) -> get_file(T); get_file([]) -> "no_file". % should not happen -suppress_warning(Core) -> +should_suppress_warning(Core) -> is_compiler_generated(Core) orelse is_result_unwanted(Core). diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index f99307c865..4c4628d580 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -38,7 +38,6 @@ -record(expand, {module=[], %Module name exports=[], %Exports imports=[], %Imports - compile=[], %Compile flags attributes=[], %Attributes callbacks=[], %Callbacks optional_callbacks=[] :: [fa()], %Optional callbacks @@ -46,9 +45,7 @@ vcount=0, %Variable counter func=[], %Current function arity=[], %Arity for current function - fcount=0, %Local fun count - bitdefault, - bittypes + fcount=0 %Local fun count }). %% module(Forms, CompileOptions) @@ -69,15 +66,12 @@ module(Fs0, Opts0) -> %% Build initial expand record. St0 = #expand{exports=PreExp, - compile=Opts, - defined=PreExp, - bitdefault = erl_bits:system_bitdefault(), - bittypes = erl_bits:system_bittypes() + defined=PreExp }, %% Expand the functions. {Tfs,St1} = forms(Fs, define_functions(Fs, St0)), %% Get the correct list of exported functions. - Exports = case member(export_all, St1#expand.compile) of + Exports = case member(export_all, Opts) of true -> gb_sets:to_list(St1#expand.defined); false -> St1#expand.exports end, @@ -85,7 +79,7 @@ module(Fs0, Opts0) -> {Ats,St3} = module_attrs(St1#expand{exports = Exports}), {Mfs,St4} = module_predef_funcs(St3), {St4#expand.module, St4#expand.exports, Ats ++ Tfs ++ Mfs, - St4#expand.compile}. + Opts}. compiler_options(Forms) -> lists:flatten([C || {attribute,_,compile,C} <- Forms]). @@ -121,7 +115,8 @@ is_fa_list(_) -> false. module_predef_funcs(St) -> {Mpf1,St1}=module_predef_func_beh_info(St), {Mpf2,St2}=module_predef_funcs_mod_info(St1), - {Mpf1++Mpf2,St2}. + Mpf = [erl_parse:new_anno(F) || F <- Mpf1++Mpf2], + {Mpf,St2}. module_predef_func_beh_info(#expand{callbacks=[]}=St) -> {[], St}; diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index cbe50b93b0..aa2ebc0f85 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -69,10 +69,8 @@ stk=[], %Stack table res=[]}). %Reserved regs: [{reserved,I,V}] -module({Mod,Exp,Attr,Forms}, Options) -> - put(?MODULE, Options), +module({Mod,Exp,Attr,Forms}, _Options) -> {Fs,St} = functions(Forms, {atom,Mod}), - erase(?MODULE), {ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}. functions(Forms, AtomMod) -> @@ -123,24 +121,15 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> put_reg(V, Reg) end, [], Hvs), stk=[]}, 0, Vdb), - {B0,_Aft,St} = cg_list(Les, 0, Vdb, Bef, + {B,_Aft,St} = cg_list(Les, 0, Vdb, Bef, St3#cg{bfail=0, ultimate_failure=UltimateMatchFail, is_top_block=true}), - B = fix_bs_match_strings(B0), {Name,Arity} = NameArity, Asm = [{label,Fi},line(Anno),{func_info,AtomMod,{atom,Name},Arity}, {label,Fl}|B++[{label,UltimateMatchFail},if_end]], {Asm,Fl,St}. -fix_bs_match_strings([{test,bs_match_string,F,[Ctx,BinList]}|Is]) - when is_list(BinList) -> - I = {test,bs_match_string,F,[Ctx,list_to_bitstring(BinList)]}, - [I|fix_bs_match_strings(Is)]; -fix_bs_match_strings([I|Is]) -> - [I|fix_bs_match_strings(Is)]; -fix_bs_match_strings([]) -> []. - %% cg(Lkexpr, Vdb, StackReg, State) -> {[Ainstr],StackReg,State}. %% Generate code for a kexpr. %% Split function into two steps for clarity, not efficiency. @@ -586,7 +575,7 @@ top_level_block(Keis, Bef, MaxRegs, _St) -> (return) -> [{deallocate,FrameSz},return]; (Tuple) when is_tuple(Tuple) -> - [turn_yregs(tuple_size(Tuple), Tuple, MaxY)]; + [turn_yregs(Tuple, MaxY)]; (Other) -> [Other] end, Keis), @@ -598,14 +587,49 @@ top_level_block(Keis, Bef, MaxRegs, _St) -> %% catches work. The code generation algorithm gives a lower register %% number to the outer catch, which is wrong. -turn_yregs(0, Tp, _) -> Tp; -turn_yregs(El, Tp, MaxY) -> - turn_yregs(El-1,setelement(El,Tp,turn_yreg(element(El,Tp),MaxY)),MaxY). - -turn_yreg({yy,YY},MaxY) -> {y,MaxY-YY}; -turn_yreg({list,Ls},MaxY) -> {list, turn_yreg(Ls,MaxY)}; -turn_yreg(Ts,MaxY) when is_list(Ts) -> [turn_yreg(T,MaxY)||T<-Ts]; -turn_yreg(Other,_MaxY) -> Other. +turn_yregs({call,_,_}=I, _MaxY) -> I; +turn_yregs({call_ext,_,_}=I, _MaxY) -> I; +turn_yregs({jump,_}=I, _MaxY) -> I; +turn_yregs({label,_}=I, _MaxY) -> I; +turn_yregs({line,_}=I, _MaxY) -> I; +turn_yregs({test_heap,_,_}=I, _MaxY) -> I; +turn_yregs({bif,Op,F,A,B}, MaxY) -> + {bif,Op,F,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; +turn_yregs({gc_bif,Op,F,Live,A,B}, MaxY) when is_integer(Live) -> + {gc_bif,Op,F,Live,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; +turn_yregs({get_tuple_element,S,N,D}, MaxY) -> + {get_tuple_element,turn_yreg(S, MaxY),N,turn_yreg(D, MaxY)}; +turn_yregs({put_tuple,Arity,D}, MaxY) -> + {put_tuple,Arity,turn_yreg(D, MaxY)}; +turn_yregs({select_val,R,F,L}, MaxY) -> + {select_val,turn_yreg(R, MaxY),F,L}; +turn_yregs({test,Op,F,L}, MaxY) -> + {test,Op,F,turn_yreg(L, MaxY)}; +turn_yregs({test,Op,F,Live,A,B}, MaxY) when is_integer(Live) -> + {test,Op,F,Live,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; +turn_yregs({Op,A}, MaxY) -> + {Op,turn_yreg(A, MaxY)}; +turn_yregs({Op,A,B}, MaxY) -> + {Op,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; +turn_yregs({Op,A,B,C}, MaxY) -> + {Op,turn_yreg(A, MaxY),turn_yreg(B, MaxY),turn_yreg(C, MaxY)}; +turn_yregs(Tuple, MaxY) -> + turn_yregs(tuple_size(Tuple), Tuple, MaxY). + +turn_yregs(1, Tp, _) -> + Tp; +turn_yregs(N, Tp, MaxY) -> + E = turn_yreg(element(N, Tp), MaxY), + turn_yregs(N-1, setelement(N, Tp, E), MaxY). + +turn_yreg({yy,YY}, MaxY) -> + {y,MaxY-YY}; +turn_yreg({list,Ls},MaxY) -> + {list,turn_yreg(Ls, MaxY)}; +turn_yreg([_|_]=Ts, MaxY) -> + [turn_yreg(T, MaxY) || T <- Ts]; +turn_yreg(Other, _MaxY) -> + Other. %% select_cg(Sclause, V, TypeFail, ValueFail, StackReg, State) -> %% {Is,StackReg,State}. @@ -684,22 +708,37 @@ select_nil(#l{ke={val_clause,nil,B}}, V, Tf, Vf, Bef, St0) -> select_binary(#l{ke={val_clause,{binary,{var,V}},B},i=I,vdb=Vdb}, V, Tf, Vf, Bef, St0) -> Int0 = clear_dead(Bef#sr{reg=Bef#sr.reg}, I, Vdb), - {Bis,Aft,St1} = match_cg(B, Vf, Int0, St0), + {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0), CtxReg = fetch_var(V, Int0), Live = max_reg(Bef#sr.reg), - {[{test,bs_start_match2,{f,Tf},Live,[CtxReg,V],CtxReg}, - {bs_save2,CtxReg,{V,V}}|Bis], - Aft,St1}; + Bis1 = [{test,bs_start_match2,{f,Tf},Live,[CtxReg,V],CtxReg}, + {bs_save2,CtxReg,{V,V}}|Bis0], + Bis = finish_select_binary(Bis1), + {Bis,Aft,St1}; select_binary(#l{ke={val_clause,{binary,{var,Ivar}},B},i=I,vdb=Vdb}, V, Tf, Vf, Bef, St0) -> Regs = put_reg(Ivar, Bef#sr.reg), Int0 = clear_dead(Bef#sr{reg=Regs}, I, Vdb), - {Bis,Aft,St1} = match_cg(B, Vf, Int0, St0), + {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0), CtxReg = fetch_var(Ivar, Int0), Live = max_reg(Bef#sr.reg), - {[{test,bs_start_match2,{f,Tf},Live,[fetch_var(V, Bef),Ivar],CtxReg}, - {bs_save2,CtxReg,{Ivar,Ivar}}|Bis], - Aft,St1}. + Bis1 = [{test,bs_start_match2,{f,Tf},Live,[fetch_var(V, Bef),Ivar],CtxReg}, + {bs_save2,CtxReg,{Ivar,Ivar}}|Bis0], + Bis = finish_select_binary(Bis1), + {Bis,Aft,St1}. + +finish_select_binary([{bs_save2,R,Point}=I,{bs_restore2,R,Point}|Is]) -> + [I|finish_select_binary(Is)]; +finish_select_binary([{bs_save2,R,Point}=I,{test,is_eq_exact,_,_}=Test, + {bs_restore2,R,Point}|Is]) -> + [I,Test|finish_select_binary(Is)]; +finish_select_binary([{test,bs_match_string,F,[Ctx,BinList]}|Is]) + when is_list(BinList) -> + I = {test,bs_match_string,F,[Ctx,list_to_bitstring(BinList)]}, + [I|finish_select_binary(Is)]; +finish_select_binary([I|Is]) -> + [I|finish_select_binary(Is)]; +finish_select_binary([]) -> []. %% New instructions for selection of binary segments. @@ -924,7 +963,7 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> select_map(Scs, V, Tf, Vf, Bef, St0) -> Reg = fetch_var(V, Bef), {Is,Aft,St1} = - match_fmf(fun(#l{ke={val_clause,{map,_,Es},B},i=I,vdb=Vdb}, Fail, St1) -> + match_fmf(fun(#l{ke={val_clause,{map,exact,_,Es},B},i=I,vdb=Vdb}, Fail, St1) -> select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1) end, Vf, St0, Scs), {[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}. @@ -1551,11 +1590,8 @@ set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, SrcReg = cg_reg_arg(Map,Int0), Line = line(Le#l.a), - %% The instruction needs to store keys in term sorted order - %% All keys has to be unique here - Pairs = map_pair_strip_and_termsort(Es), - %% fetch registers for values to be put into the map + Pairs = [{K,V} || {_,K,V} <- Es], List = flatmap(fun({K,V}) -> [K,cg_reg_arg(V,Int0)] end, Pairs), Live = max_reg(Bef#sr.reg), @@ -1582,16 +1618,6 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> end, {Ais,clear_dead(Int, Le#l.i, Vdb),St}. -map_pair_strip_and_termsort(Es) -> - %% format in - %% [{map_pair,K,V}] - %% where K is for example {integer, 1} and we want to sort on 1. - Ls = [{K,V}||{_,K,V}<-Es], - lists:sort(fun ({{_,A},_}, {{_,B},_}) -> erts_internal:cmp_term(A,B) =< 0; - ({nil,_}, {{_,B},_}) -> [] =< B; - ({{_,A},_}, {nil,_}) -> A =< [] - end, Ls). - %%% %%% Code generation for constructing binaries. %%% @@ -2114,9 +2140,11 @@ put_stack(Val, [free|Stk]) -> [{Val}|Stk]; put_stack(Val, [NotFree|Stk]) -> [NotFree|put_stack(Val, Stk)]. put_stack_carefully(Val, Stk0) -> - case catch put_stack_carefully1(Val, Stk0) of - error -> error; - Stk1 when is_list(Stk1) -> Stk1 + try + put_stack_carefully1(Val, Stk0) + catch + throw:error -> + error end. put_stack_carefully1(_, []) -> throw(error); diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 3c19a209c0..ecaecb0ff6 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -78,13 +78,11 @@ splitwith/2,keyfind/3,sort/1,foreach/2,droplast/1,last/1]). -import(ordsets, [add_element/2,del_element/2,is_element/2, union/1,union/2,intersection/2,subtract/2]). --import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1, +-import(cerl, [ann_c_cons/3,ann_c_tuple/2,c_tuple/1, ann_c_map/3]). -include("core_parse.hrl"). --define(REC_OFFSET, 100000000). % Also in erl_expand_records. - %% Internal core expressions and help functions. %% N.B. annotations fields in place as normal Core expressions. @@ -170,8 +168,10 @@ form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) -> form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) -> {Fs,[attribute(F)|As],Ws,File}. -attribute({attribute,Line,Name,Val}) -> - {#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}. +attribute(Attribute) -> + Fun = fun(A) -> [erl_anno:location(A)] end, + {attribute,Line,Name,Val} = erl_parse:map_anno(Fun, Attribute), + {#c_literal{val=Name, anno=Line}, #c_literal{val=Val, anno=Line}}. %% function_dump(module_info,_,_,_) -> ok; %% function_dump(Name,Arity,Format,Terms) -> @@ -538,19 +538,8 @@ expr({tuple,L,Es0}, St0) -> {annotate_tuple(A, Es1, St1),Eps,St1}; expr({map,L,Es0}, St0) -> map_build_pairs(#c_literal{val=#{}}, Es0, full_anno(L, St0), St0); -expr({map,L,M0,Es0}, St0) -> - try expr_map(M0,Es0,lineno_anno(L, St0),St0) of - {_,_,_}=Res -> Res - catch - throw:{bad_map,Warning} -> - St = add_warning(L, Warning, St0), - LineAnno = lineno_anno(L, St), - As = [#c_literal{anno=LineAnno,val=badarg}], - {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} - module=#c_literal{anno=LineAnno,val=erlang}, - name=#c_literal{anno=LineAnno,val=error}, - args=As},[],St} - end; +expr({map,L,M,Es}, St) -> + expr_map(M, Es, L, St); expr({bin,L,Es0}, St0) -> try expr_bin(Es0, full_anno(L, St0), St0) of {_,_,_}=Res -> Res @@ -740,7 +729,7 @@ make_bool_switch(L, E, V, T, F, #core{}) -> make_bool_switch_body(L, E, V, T, F). make_bool_switch_body(L, E, V, T, F) -> - NegL = neg_line(abs_line(L)), + NegL = no_compiler_warning(L), Error = {tuple,NegL,[{atom,NegL,badarg},V]}, {'case',NegL,E, [{clause,NegL,[{atom,NegL,true}],[],[T]}, @@ -751,18 +740,21 @@ make_bool_switch_body(L, E, V, T, F) -> make_bool_switch_guard(_, E, _, {atom,_,true}, {atom,_,false}) -> E; make_bool_switch_guard(L, E, V, T, F) -> - NegL = neg_line(abs_line(L)), + NegL = no_compiler_warning(L), {'case',NegL,E, [{clause,NegL,[{atom,NegL,true}],[],[T]}, {clause,NegL,[{atom,NegL,false}],[],[F]}, {clause,NegL,[V],[],[V]} ]}. -expr_map(M0, Es0, A, St0) -> +expr_map(M0, Es0, L, St0) -> {M1,Eps0,St1} = safe(M0, St0), + Badmap = badmap_term(M1, St1), + A = lineno_anno(L, St1), + Fc = fail_clause([], [{eval_failure,badmap}|A], Badmap), case is_valid_map_src(M1) of true -> - {M2,Eps1,St2} = map_build_pairs(M1, Es0, A, St1), + {M2,Eps1,St2} = map_build_pairs(M1, Es0, full_anno(L, St1), St1), M3 = case Es0 of [] -> M1; [_|_] -> M2 @@ -775,13 +767,23 @@ expr_map(M0, Es0, A, St0) -> name=#c_literal{anno=A,val=is_map}, args=[M1]}], body=[M3]}], - Fc = fail_clause([], [eval_failure|A], #c_literal{val=badarg}), Eps = Eps0 ++ Eps1, {#icase{anno=#a{anno=A},args=[],clauses=Cs,fc=Fc},Eps,St2}; false -> - throw({bad_map,bad_map}) + %% Not a map source. The update will always fail. + St2 = add_warning(L, badmap, St1), + #iclause{body=[Fail]} = Fc, + {Fail,Eps0,St2} end. +badmap_term(_Map, #core{in_guard=true}) -> + %% The code generator cannot handle complex error reasons + %% in guards. But the exact error reason does not matter anyway + %% since it is not user-visible. + #c_literal{val=badmap}; +badmap_term(Map, #core{in_guard=false}) -> + #c_tuple{es=[#c_literal{val=badmap},Map]}. + map_build_pairs(Map, Es0, Ann, St0) -> {Es,Pre,St1} = map_build_pairs_1(Es0, St0), {ann_c_map(Ann, Map, Es),Pre,St1}. @@ -867,10 +869,10 @@ constant_bin_1(Es) -> ({float,_,F}, B) -> {value,F,B}; ({atom,_,undefined}, B) -> {value,undefined,B} end, - case catch eval_bits:expr_grp(Es, EmptyBindings, EvalFun) of + try eval_bits:expr_grp(Es, EmptyBindings, EvalFun) of {value,Bin,EmptyBindings} -> - Bin; - _ -> + Bin + catch error:_ -> error end. @@ -917,7 +919,7 @@ verify_suitable_fields([]) -> ok. %% (We don't need an exact result for this purpose.) count_bits(Int) -> - count_bits_1(abs_line(Int), 64). + count_bits_1(abs(Int), 64). count_bits_1(0, Bits) -> Bits; count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64). @@ -1660,48 +1662,55 @@ pat_segment({bin_element,_,Val,Size,[Type,{unit,Unit}|Flags]}, St) -> %% pat_alias(CorePat, CorePat) -> AliasPat. %% Normalise aliases. Trap bad aliases by throwing 'nomatch'. -pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2}; -pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1}; - -%% alias cons -pat_alias(#c_cons{}=Cons, #c_literal{anno=A,val=[H|T]}=S) -> - pat_alias(Cons, ann_c_cons_skel(A, #c_literal{anno=A,val=H}, - S#c_literal{val=T})); -pat_alias(#c_literal{anno=A,val=[H|T]}=S, #c_cons{}=Cons) -> - pat_alias(ann_c_cons_skel(A, #c_literal{anno=A,val=H}, - S#c_literal{val=T}), Cons); -pat_alias(#c_cons{anno=Anno,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) -> - ann_c_cons(Anno, pat_alias(H1, H2), pat_alias(T1, T2)); - -%% alias tuples -pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_literal{val=T}) when is_tuple(T) -> - Es2 = [#c_literal{val=E} || E <- tuple_to_list(T)], - ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); -pat_alias(#c_literal{anno=Anno,val=T}, #c_tuple{es=Es2}) when is_tuple(T) -> - Es1 = [#c_literal{val=E} || E <- tuple_to_list(T)], - ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); -pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_tuple{es=Es2}) -> - ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); - -%% alias maps -%% There are no literals in maps patterns (patterns are always abstract) -pat_alias(#c_map{es=Es1}=M,#c_map{es=Es2}) -> - M#c_map{es=pat_alias_map_pairs(Es1++Es2)}; - -pat_alias(#c_alias{var=V1,pat=P1}, - #c_alias{var=V2,pat=P2}) -> - if V1 =:= V2 -> #c_alias{var=V1,pat=pat_alias(P1, P2)}; - true -> #c_alias{var=V1,pat=#c_alias{var=V2,pat=pat_alias(P1, P2)}} +pat_alias(#c_var{name=V1}=P, #c_var{name=V1}) -> P; +pat_alias(#c_var{name=V1}=Var, + #c_alias{var=#c_var{name=V2},pat=Pat}=Alias) -> + if + V1 =:= V2 -> + Alias; + true -> + Alias#c_alias{pat=pat_alias(Var, Pat)} + end; +pat_alias(#c_var{}=P1, P2) -> #c_alias{var=P1,pat=P2}; + +pat_alias(#c_alias{var=#c_var{name=V1}}=Alias, #c_var{name=V1}) -> + Alias; +pat_alias(#c_alias{var=#c_var{name=V1}=Var1,pat=P1}, + #c_alias{var=#c_var{name=V2}=Var2,pat=P2}) -> + Pat = pat_alias(P1, P2), + if + V1 =:= V2 -> + #c_alias{var=Var1,pat=Pat}; + true -> + pat_alias(Var1, pat_alias(Var2, Pat)) end; -pat_alias(#c_alias{var=V1,pat=P1}, P2) -> - #c_alias{var=V1,pat=pat_alias(P1, P2)}; -pat_alias(P1, #c_alias{var=V2,pat=P2}) -> - #c_alias{var=V2,pat=pat_alias(P1, P2)}; +pat_alias(#c_alias{var=#c_var{}=Var,pat=P1}, P2) -> + #c_alias{var=Var,pat=pat_alias(P1, P2)}; + +pat_alias(#c_map{es=Es1}=M, #c_map{es=Es2}) -> + M#c_map{es=pat_alias_map_pairs(Es1 ++ Es2)}; + +pat_alias(P1, #c_var{}=Var) -> + #c_alias{var=Var,pat=P1}; +pat_alias(P1, #c_alias{pat=P2}=Alias) -> + Alias#c_alias{pat=pat_alias(P1, P2)}; + pat_alias(P1, P2) -> - case {set_anno(P1, []),set_anno(P2, [])} of - {P,P} -> P; + %% Aliases between binaries are not allowed, so the only + %% legal patterns that remain are data patterns. + case cerl:is_data(P1) andalso cerl:is_data(P2) of + false -> throw(nomatch); + true -> ok + end, + Type = cerl:data_type(P1), + case cerl:data_type(P2) of + Type -> ok; _ -> throw(nomatch) - end. + end, + Es1 = cerl:data_es(P1), + Es2 = cerl:data_es(P2), + Es = pat_alias_list(Es1, Es2), + cerl:make_data(Type, Es). %% pat_alias_list([A1], [A2]) -> [A]. @@ -2302,22 +2311,15 @@ bitstr_vars(Segs, Vs) -> lit_vars(V, lit_vars(S, Vs0)) end, Vs, Segs). -record_anno(L, St) when L >= ?REC_OFFSET -> - case member(dialyzer, St#core.opts) of - true -> - [record | lineno_anno(L - ?REC_OFFSET, St)]; - false -> - full_anno(L, St) - end; -record_anno(L, St) when L < -?REC_OFFSET -> - case member(dialyzer, St#core.opts) of +record_anno(L, St) -> + case + erl_anno:record(L) andalso member(dialyzer, St#core.opts) + of true -> - [record | lineno_anno(L + ?REC_OFFSET, St)]; + [record | lineno_anno(L, St)]; false -> full_anno(L, St) - end; -record_anno(L, St) -> - full_anno(L, St). + end. full_anno(L, #core{wanted=false}=St) -> [result_not_wanted|lineno_anno(L, St)]; @@ -2325,13 +2327,10 @@ full_anno(L, #core{wanted=true}=St) -> lineno_anno(L, St). lineno_anno(L, St) -> - {line, Line} = erl_parse:get_attribute(L, line), - if - Line < 0 -> - [-Line] ++ St#core.file ++ [compiler_generated]; - true -> - [Line] ++ St#core.file - end. + Line = erl_anno:line(L), + Generated = erl_anno:generated(L), + CompilerGenerated = [compiler_generated || Generated], + [Line] ++ St#core.file ++ CompilerGenerated. get_lineno_anno(Ce) -> case get_anno(Ce) of @@ -2339,15 +2338,8 @@ get_lineno_anno(Ce) -> A when is_list(A) -> A end. -location(L) -> - {location,Location} = erl_parse:get_attribute(L, location), - Location. - -abs_line(L) -> - erl_parse:set_line(L, fun(Line) -> abs(Line) end). - -neg_line(L) -> - erl_parse:set_line(L, fun(Line) -> -abs(Line) end). +no_compiler_warning(Anno) -> + erl_anno:set_generated(true, Anno). %% %% The following three functions are used both with cerl:cerl() and with i()'s @@ -2388,9 +2380,13 @@ format_error(nomatch) -> "pattern cannot possibly match"; format_error(bad_binary) -> "binary construction will fail because of a type mismatch"; -format_error(bad_map) -> +format_error(badmap) -> "map construction will fail because of a type mismatch". -add_warning(Line, Term, #core{ws=Ws,file=[{file,File}]}=St) when Line >= 0 -> - St#core{ws=[{File,[{location(Line),?MODULE,Term}]}|Ws]}; -add_warning(_, _, St) -> St. +add_warning(Anno, Term, #core{ws=Ws,file=[{file,File}]}=St) -> + case erl_anno:generated(Anno) of + false -> + St#core{ws=[{File,[{erl_anno:location(Anno),?MODULE,Term}]}|Ws]}; + true -> + St + end. diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 0ac1aaf158..7dff58582e 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -836,12 +836,23 @@ get_vsub(V, Vsub) -> set_vsub(V, S, Vsub) -> orddict:store(V, S, Vsub). -subst_vsub(V, S, Vsub0) -> - %% Fold chained substitutions. - Vsub1 = orddict:map(fun (_, V1) when V1 =:= V -> S; - (_, V1) -> V1 - end, Vsub0), - orddict:store(V, S, Vsub1). +subst_vsub(Key, New, [{K,Key}|Dict]) -> + %% Fold chained substitution. + [{K,New}|subst_vsub(Key, New, Dict)]; +subst_vsub(Key, New, [{K,_}|_]=Dict) when Key < K -> + %% Insert the new substitution here, and continue + %% look for chained substitutions. + [{Key,New}|subst_vsub_1(Key, New, Dict)]; +subst_vsub(Key, New, [{K,_}=E|Dict]) when Key > K -> + [E|subst_vsub(Key, New, Dict)]; +subst_vsub(Key, New, []) -> [{Key,New}]. + +subst_vsub_1(V, S, [{K,V}|Dict]) -> + %% Fold chained substitution. + [{K,S}|subst_vsub_1(V, S, Dict)]; +subst_vsub_1(V, S, [E|Dict]) -> + [E|subst_vsub_1(V, S, Dict)]; +subst_vsub_1(_, _, []) -> []. get_fsub(F, A, Fsub) -> case orddict:find({F,A}, Fsub) of diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index cd4b5fd674..4b1f1c3f71 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -45,7 +45,7 @@ -export([vdb_find/2]). --import(lists, [member/2,map/2,foldl/3,reverse/1,sort/1]). +-import(lists, [member/2,map/2,reverse/1,sort/1]). -import(ordsets, [add_element/2,intersection/2,union/2]). -include("v3_kernel.hrl"). @@ -68,7 +68,7 @@ functions([], Acc) -> reverse(Acc). function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) -> try As = var_list(Vs), - Vdb0 = foldl(fun ({var,N}, Vdb) -> new_var(N, 0, Vdb) end, [], As), + Vdb0 = init_vars(As), %% Force a top-level match! B0 = case Kb of #k_match{} -> Kb; @@ -94,14 +94,14 @@ function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) -> body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) -> %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), A = get_kanno(Ke), - Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)), + Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), {Es,MaxI,Vdb2} = body(Kb, I+1, Vdb1), E = expr(Ke, I, Vdb2), {[E|Es],MaxI,Vdb2}; body(Ke, I, Vdb0) -> %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), A = get_kanno(Ke), - Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)), + Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), E = expr(Ke, I, Vdb1), {[E],I,Vdb1}. @@ -150,12 +150,12 @@ expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) - %% the body and handler. Add try tag 'variable'. Ab = get_kanno(Kb), Ah = get_kanno(Kh), - Tdb1 = use_vars(Ab#k.us, I+3, use_vars(Ah#k.us, I+3, Tdb0)), + Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), Tdb2 = vdb_sub(I, I+2, Tdb1), Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, 1000000, Tdb2)), - {Bes,_,Bdb} = body(Kb, I+4, new_vars(map(Vnames, Vs), I+3, Tdb2)), - {Hes,_,Hdb} = body(Kh, I+4, new_vars(map(Vnames, Evs), I+3, Tdb2)), + {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), + {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), #l{ke={try_enter,#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]}, var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]}, var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]}}, @@ -171,7 +171,7 @@ expr(#k_receive{anno=A,var=V,body=Kb,timeout=T,action=Ka,ret=Rs}, I, Vdb) -> %% Work out imported variables which need to be locked. Rdb = vdb_sub(I, I+1, Vdb), M = match(Kb, add_element(V#k_var.name, A#k.us), I+1, [], - new_var(V#k_var.name, I, Rdb)), + new_vars([V#k_var.name], I, Rdb)), {Tes,_,Adb} = body(Ka, I+1, Rdb), #l{ke={receive_loop,atomic(T),variable(V),M, #l{ke=Tes,i=I+1,vdb=Adb,a=[]},var_list(Rs)}, @@ -199,12 +199,12 @@ body_try(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs}, %% the body and handler. Add try tag 'variable'. Ab = get_kanno(Kb), Ah = get_kanno(Kh), - Tdb1 = use_vars(Ab#k.us, I+3, use_vars(Ah#k.us, I+3, Tdb0)), + Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), Tdb2 = vdb_sub(I, I+2, Tdb1), Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)), - {Bes,_,Bdb} = body(Kb, I+4, new_vars(map(Vnames, Vs), I+3, Tdb2)), - {Hes,_,Hdb} = body(Kh, I+4, new_vars(map(Vnames, Evs), I+3, Tdb2)), + {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), + {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), #l{ke={'try',#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]}, var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]}, var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]}, @@ -270,7 +270,7 @@ match(#k_select{anno=A,var=V,types=Kts}, Ls0, I, Ctxt, Vdb0) -> end, Vdb1 = use_vars(union(A#k.us, Ls1), I, Vdb0), Ts = [type_clause(Tc, Ls1, I+1, Ctxt, Vdb1) || Tc <- Kts], - #l{ke={select,literal2(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno}; + #l{ke={select,literal(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno}; match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Ctxt, Vdb0) -> Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), Cs = [guard_clause(G, Ls, I+1, Ctxt, Vdb1) || G <- Kcs], @@ -297,7 +297,7 @@ val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Ctxt0, Vdb0) -> _ -> Ctxt0 end, B = match(Kb, Ls1, I+1, Ctxt, Vdb1), - #l{ke={val_clause,literal2(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}. + #l{ke={val_clause,literal(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}. guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) -> Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0), @@ -350,6 +350,7 @@ atomic_list(Ks) -> [atomic(K) || K <- Ks]. %% literal_list([Klit]) -> [Lit]. literal(#k_var{name=N}, _) -> {var,N}; +literal(#k_literal{val=I}, _) -> {literal,I}; literal(#k_int{val=I}, _) -> {integer,I}; literal(#k_float{val=F}, _) -> {float,F}; literal(#k_atom{val=N}, _) -> {atom,N}; @@ -358,58 +359,29 @@ literal(#k_nil{}, _) -> nil; literal(#k_cons{hd=H,tl=T}, Ctxt) -> {cons,[literal(H, Ctxt),literal(T, Ctxt)]}; literal(#k_binary{segs=V}, Ctxt) -> - {binary,literal(V, Ctxt)}; + {binary,literal(V, Ctxt)}; +literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) -> + %% Only occurs in patterns. + {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,[literal(Seg, Ctxt)]}; literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) -> {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs, [literal(Seg, Ctxt),literal(N, Ctxt)]}; +literal(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) -> + %% Only occurs in patterns. + {bin_int,Ctxt,literal(S, Ctxt),U,Fs,Int, + [literal(N, Ctxt)]}; literal(#k_bin_end{}, Ctxt) -> {bin_end,Ctxt}; literal(#k_tuple{es=Es}, Ctxt) -> {tuple,literal_list(Es, Ctxt)}; -literal(#k_map{op=Op,var=Var,es=Es}, Ctxt) -> - {map,Op,literal(Var, Ctxt),literal_list(Es, Ctxt)}; +literal(#k_map{op=Op,var=Var,es=Es0}, Ctxt) -> + {map,Op,literal(Var, Ctxt),literal_list(Es0, Ctxt)}; literal(#k_map_pair{key=K,val=V}, Ctxt) -> - {map_pair,literal(K, Ctxt),literal(V, Ctxt)}; -literal(#k_literal{val=V}, _Ctxt) -> - {literal,V}. + {map_pair,literal(K, Ctxt),literal(V, Ctxt)}. literal_list(Ks, Ctxt) -> [literal(K, Ctxt) || K <- Ks]. -literal2(#k_var{name=N}, _) -> {var,N}; -literal2(#k_literal{val=I}, _) -> {literal,I}; -literal2(#k_int{val=I}, _) -> {integer,I}; -literal2(#k_float{val=F}, _) -> {float,F}; -literal2(#k_atom{val=N}, _) -> {atom,N}; -%%literal2(#k_char{val=C}, _) -> {char,C}; -literal2(#k_nil{}, _) -> nil; -literal2(#k_cons{hd=H,tl=T}, Ctxt) -> - {cons,[literal2(H, Ctxt),literal2(T, Ctxt)]}; -literal2(#k_binary{segs=V}, Ctxt) -> - {binary,literal2(V, Ctxt)}; -literal2(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) -> - {bin_seg,Ctxt,literal2(S, Ctxt),U,T,Fs,[literal2(Seg, Ctxt)]}; -literal2(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) -> - {bin_seg,Ctxt,literal2(S, Ctxt),U,T,Fs, - [literal2(Seg, Ctxt),literal2(N, Ctxt)]}; -literal2(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) -> - {bin_int,Ctxt,literal2(S, Ctxt),U,Fs,Int, - [literal2(N, Ctxt)]}; -literal2(#k_bin_end{}, Ctxt) -> - {bin_end,Ctxt}; -literal2(#k_tuple{es=Es}, Ctxt) -> - {tuple,literal_list2(Es, Ctxt)}; -literal2(#k_map{op=Op,es=Es}, Ctxt) -> - {map,Op,literal_list2(Es, Ctxt)}; -literal2(#k_map_pair{key=K,val=V}, Ctxt) -> - {map_pair,literal2(K, Ctxt),literal2(V, Ctxt)}. - -literal_list2(Ks, Ctxt) -> - [literal2(K, Ctxt) || K <- Ks]. - -%% literal_bin(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}) -> -%% {bin_seg,literal(S),U,T,Fs,[literal(Seg),literal(N)]} - %% is_gc_bif(Name, Arity) -> true|false %% Determines whether the BIF Name/Arity might do a GC. @@ -428,79 +400,68 @@ is_gc_bif(Bif, Arity) -> erl_internal:new_type_test(Bif, Arity) orelse erl_internal:comp_op(Bif, Arity)). -%% new_var(VarName, I, Vdb) -> Vdb. +%% Keep track of life time for variables. +%% +%% init_vars([{var,VarName}]) -> Vdb. %% new_vars([VarName], I, Vdb) -> Vdb. -%% use_var(VarName, I, Vdb) -> Vdb. %% use_vars([VarName], I, Vdb) -> Vdb. %% add_var(VarName, F, L, Vdb) -> Vdb. +%% +%% The list of variable names for new_vars/3 and use_vars/3 +%% must be sorted. -new_var(V, I, Vdb) -> - vdb_store_new(V, I, I, Vdb). +init_vars(Vs) -> + sort([{V,0,0} || {var,V} <- Vs]). -new_vars(Vs, I, Vdb0) -> - foldl(fun (V, Vdb) -> new_var(V, I, Vdb) end, Vdb0, Vs). +new_vars([], _, Vdb) -> Vdb; +new_vars([V], I, Vdb) -> vdb_store_new(V, {V,I,I}, Vdb); +new_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). -use_var(V, I, Vdb) -> +use_vars([], _, Vdb) -> + Vdb; +use_vars([V], I, Vdb) -> case vdb_find(V, Vdb) of - {V,F,L} when I > L -> vdb_update(V, F, I, Vdb); + {V,F,L} when I > L -> vdb_update(V, {V,F,I}, Vdb); {V,_,_} -> Vdb; - error -> vdb_store_new(V, I, I, Vdb) - end. - -use_vars([], _, Vdb) -> Vdb; -use_vars([V], I, Vdb) -> use_var(V, I, Vdb); -use_vars(Vs, I, Vdb) -> - Res = use_vars_1(sort(Vs), Vdb, I), - %% The following line can be used as an assertion. - %% Res = foldl(fun (V, Vdb) -> use_var(V, I, Vdb) end, Vdb, Vs), - Res. - -%% Measurements show that it is worthwhile having this special -%% function that updates/inserts several variables at once. - -use_vars_1([V|_]=Vs, [{V1,_,_}=Vd|Vdb], I) when V > V1 -> - [Vd|use_vars_1(Vs, Vdb, I)]; -use_vars_1([V|Vs], [{V1,_,_}|_]=Vdb, I) when V < V1 -> - %% New variable. - [{V,I,I}|use_vars_1(Vs, Vdb, I)]; -use_vars_1([V|Vs], [{_,F,L}=Vd|Vdb], I) -> - %% Existing variable. - if - I > L ->[{V,F,I}|use_vars_1(Vs, Vdb, I)]; - true -> [Vd|use_vars_1(Vs, Vdb, I)] + error -> vdb_store_new(V, {V,I,I}, Vdb) end; -use_vars_1([V|Vs], [], I) -> - %% New variable. - [{V,I,I}|use_vars_1(Vs, [], I)]; -use_vars_1([], Vdb, _) -> Vdb. +use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). add_var(V, F, L, Vdb) -> - vdb_store_new(V, F, L, Vdb). + vdb_store_new(V, {V,F,L}, Vdb). vdb_find(V, Vdb) -> - %% Performance note: Profiling shows that this function accounts for - %% a lot of the execution time when huge constant terms are built. - %% Using the BIF lists:keyfind/3 is a lot faster than the - %% original Erlang version. case lists:keyfind(V, 1, Vdb) of false -> error; Vd -> Vd end. -%vdb_find(V, [{V1,F,L}=Vd|Vdb]) when V < V1 -> error; -%vdb_find(V, [{V1,F,L}=Vd|Vdb]) when V == V1 -> Vd; -%vdb_find(V, [{V1,F,L}=Vd|Vdb]) when V > V1 -> vdb_find(V, Vdb); -%vdb_find(V, []) -> error. +vdb_update(V, Update, [{V,_,_}|Vdb]) -> + [Update|Vdb]; +vdb_update(V, Update, [Vd|Vdb]) -> + [Vd|vdb_update(V, Update, Vdb)]. -vdb_update(V, F, L, [{V1,_,_}=Vd|Vdb]) when V > V1 -> - [Vd|vdb_update(V, F, L, Vdb)]; -vdb_update(V, F, L, [{V1,_,_}|Vdb]) when V == V1 -> - [{V,F,L}|Vdb]. +vdb_store_new(V, New, [{V1,_,_}=Vd|Vdb]) when V > V1 -> + [Vd|vdb_store_new(V, New, Vdb)]; +vdb_store_new(V, New, [{V1,_,_}|_]=Vdb) when V < V1 -> + [New|Vdb]; +vdb_store_new(_, New, []) -> [New]. -vdb_store_new(V, F, L, [{V1,_,_}=Vd|Vdb]) when V > V1 -> - [Vd|vdb_store_new(V, F, L, Vdb)]; -vdb_store_new(V, F, L, [{V1,_,_}|_]=Vdb) when V < V1 -> [{V,F,L}|Vdb]; -vdb_store_new(V, F, L, []) -> [{V,F,L}]. +vdb_update_vars([V|_]=Vs, [{V1,_,_}=Vd|Vdb], I) when V > V1 -> + [Vd|vdb_update_vars(Vs, Vdb, I)]; +vdb_update_vars([V|Vs], [{V1,_,_}|_]=Vdb, I) when V < V1 -> + %% New variable. + [{V,I,I}|vdb_update_vars(Vs, Vdb, I)]; +vdb_update_vars([V|Vs], [{_,F,L}=Vd|Vdb], I) -> + %% Existing variable. + if + I > L -> [{V,F,I}|vdb_update_vars(Vs, Vdb, I)]; + true -> [Vd|vdb_update_vars(Vs, Vdb, I)] + end; +vdb_update_vars([V|Vs], [], I) -> + %% New variable. + [{V,I,I}|vdb_update_vars(Vs, [], I)]; +vdb_update_vars([], Vdb, _) -> Vdb. %% vdb_sub(Min, Max, Vdb) -> Vdb. %% Extract variables which are used before and after Min. Lock diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 73d52a48bc..98125fc84e 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -35,6 +35,7 @@ MODULES= \ record_SUITE \ trycatch_SUITE \ warnings_SUITE \ + z_SUITE \ test_lib NO_OPT= \ @@ -79,12 +80,6 @@ INLINE= \ receive \ record -CORE_MODULES = \ - bs_shadowed_size_var \ - unused_multiple_values_error \ - nested_call_in_case - - NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE) NO_OPT_ERL_FILES= $(NO_OPT_MODULES:%=%.erl) POST_OPT_MODULES= $(NO_OPT:%=%_post_opt_SUITE) @@ -94,8 +89,6 @@ INLINE_ERL_FILES= $(INLINE_MODULES:%=%.erl) ERL_FILES= $(MODULES:%=%.erl) -CORE_FILES= $(CORE_MODULES:%=%.core) - ##TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) ##INSTALL_PROGS= $(TARGET_FILES) @@ -162,7 +155,7 @@ release_spec: opt release_tests_spec: make_emakefile $(INSTALL_DIR) "$(RELSYSDIR)" $(INSTALL_DATA) compiler.spec compiler.cover \ - $(EMAKEFILE) $(ERL_FILES) $(CORE_FILES) "$(RELSYSDIR)" + $(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \ $(INLINE_ERL_FILES) "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index 3199440d84..4d7f444c4f 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -370,6 +370,11 @@ combined(Config) when is_list(Config) -> ?line true = ?COMB(false, blurf, true), ?line true = ?COMB(true, true, blurf), + false = simple_comb(false, false), + false = simple_comb(false, true), + false = simple_comb(true, false), + true = simple_comb(true, true), + ok. -undef(COMB). @@ -396,6 +401,13 @@ comb(A, B, C) -> end, id(Res). +simple_comb(A, B) -> + %% Use Res twice, to ensure that a careless optimization of 'not' + %% doesn't leave Res as a free variable. + Res = A andalso B, + _ = id(not Res), + Res. + %% Test that a boolean expression in a case expression is properly %% optimized (in particular, that the error behaviour is correct). in_case(Config) when is_list(Config) -> diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 1b1c7db0e8..e64dd6b9c3 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -28,7 +28,7 @@ overwrite_catchtag/1,overwrite_trytag/1,accessing_tags/1,bad_catch_try/1, cons_guard/1, freg_range/1,freg_uninit/1,freg_state/1, - bad_bin_match/1,bin_aligned/1,bad_dsetel/1, + bad_bin_match/1,bad_dsetel/1, state_after_fault_in_catch/1,no_exception_in_catch/1, undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1, map_field_lists/1]). @@ -57,7 +57,7 @@ groups() -> unsafe_catch,dead_code, overwrite_catchtag,overwrite_trytag,accessing_tags, bad_catch_try,cons_guard,freg_range,freg_uninit, - freg_state,bad_bin_match,bin_aligned,bad_dsetel, + freg_state,bad_bin_match,bad_dsetel, state_after_fault_in_catch,no_exception_in_catch, undef_label,illegal_instruction,failing_gc_guard_bif, map_field_lists]}]. @@ -178,7 +178,7 @@ unsafe_catch(Config) when is_list(Config) -> ?line [{{t,small,2}, {{bs_put_integer,{f,0},{integer,16},1, - {field_flags,[aligned,unsigned,big]},{y,0}}, + {field_flags,[unsigned,big]},{y,0}}, 20, {unassigned,{y,0}}}}] = Errors, ok. @@ -211,20 +211,21 @@ accessing_tags(Config) when is_list(Config) -> bad_catch_try(Config) when is_list(Config) -> Errors = do_val(bad_catch_try, Config), - ?line [{{bad_catch_try,bad_1,1}, - {{'catch',{x,0},{f,3}}, - 5,{invalid_store,{x,0},{catchtag,[3]}}}}, - {{bad_catch_try,bad_2,1}, - {{catch_end,{x,9}}, - 8,{source_not_y_reg,{x,9}}}}, - {{bad_catch_try,bad_3,1}, - {{catch_end,{y,1}},9,{bad_type,{atom,kalle}}}}, - {{bad_catch_try,bad_4,1}, - {{'try',{x,0},{f,15}},5,{invalid_store,{x,0},{trytag,[15]}}}}, - {{bad_catch_try,bad_5,1}, - {{try_case,{y,1}},12,{bad_type,term}}}, - {{bad_catch_try,bad_6,1}, - {{try_end,{y,1}},8,{bad_type,{integer,1}}}}] = Errors, + [{{bad_catch_try,bad_1,1}, + {{'catch',{x,0},{f,3}}, + 5,{invalid_store,{x,0},{catchtag,[3]}}}}, + {{bad_catch_try,bad_2,1}, + {{catch_end,{x,9}}, + 8,{source_not_y_reg,{x,9}}}}, + {{bad_catch_try,bad_3,1}, + {{catch_end,{y,1}},9,{bad_type,{atom,kalle}}}}, + {{bad_catch_try,bad_4,1}, + {{'try',{x,0},{f,15}},5,{invalid_store,{x,0},{trytag,[15]}}}}, + {{bad_catch_try,bad_5,1}, + {{try_case,{y,1}},12,{bad_type,term}}}, + {{bad_catch_try,bad_6,1}, + {{move,{integer,1},{y,1}},7, + {invalid_store,{y,1},{integer,1}}}}] = Errors, ok. cons_guard(Config) when is_list(Config) -> @@ -298,19 +299,6 @@ bad_bin_match(Config) when is_list(Config) -> do_val(bad_bin_match, Config), ok. -bin_aligned(Config) when is_list(Config) -> - Errors = do_val(bin_aligned, Config), - ?line - [{{t,decode,1}, - {{bs_put_integer,{f,0}, - {integer,5}, - 1, - {field_flags,[unsigned,big,aligned]}, - {integer,0}}, - 10, - {aligned_flag_set,{bits,3}}}}] = Errors, - ok. - bad_dsetel(Config) when is_list(Config) -> Errors = do_val(bad_dsetel, Config), ?line @@ -420,9 +408,9 @@ map_field_lists(Config) -> Errors = do_val(map_field_lists, Config), [{{map_field_lists,x,1}, {{test,has_map_fields,{f,1},{x,0}, - {list,[{atom,z},{atom,a}]}}, + {list,[{atom,a},{atom,a}]}}, 5, - not_strict_order}}, + keys_not_unique}}, {{map_field_lists,y,1}, {{test,has_map_fields,{f,3},{x,0},{list,[]}}, 5, diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_catch_try.S b/lib/compiler/test/beam_validator_SUITE_data/bad_catch_try.S index 2a53f0dd93..6035f23506 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/bad_catch_try.S +++ b/lib/compiler/test/beam_validator_SUITE_data/bad_catch_try.S @@ -63,11 +63,11 @@ {label,9}. {func_info,{atom,bad_catch_try},{atom,bad_3},1}. {label,10}. - {allocate,1,1}. + {allocate,2,1}. + {move,{atom,kalle},{y,1}}. {'catch',{y,0},{f,11}}. {call,1,{f,26}}. {label,11}. - {move,{atom,kalle},{y,1}}. {catch_end,{y,1}}. {test,is_tuple,{f,12},[{x,0}]}. {test,test_arity,{f,12},[{x,0},2]}. @@ -106,7 +106,7 @@ {label,17}. {func_info,{atom,bad_catch_try},{atom,bad_5},1}. {label,18}. - {allocate_zero,1,1}. + {allocate_zero,2,1}. {'try',{y,0},{f,19}}. {call,1,{f,26}}. {try_end,{y,0}}. @@ -131,7 +131,7 @@ {'try',{y,0},{f,23}}. {call,1,{f,26}}. {move,{integer,1},{y,1}}. - {try_end,{y,1}}. + {try_end,{y,0}}. {move,{atom,ok},{x,0}}. {jump,{f,24}}. {label,23}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S b/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S deleted file mode 100644 index a59f7ccc03..0000000000 --- a/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S +++ /dev/null @@ -1,47 +0,0 @@ -{module, bin_aligned}. %% version = 0 - -{exports, [{decode,1},{module_info,0},{module_info,1}]}. - -{attributes, []}. - -{labels, 7}. - - -{function, decode, 1, 2}. - {label,1}. - {func_info,{atom,t},{atom,decode},1}. - {label,2}. - {move,{integer,1},{x,1}}. - {bif,size,{f,0},[{x,0}],{x,2}}. - {bs_add,{f,0},[{x,1},{x,2},1],{x,1}}. - {bs_init2,{f,0},{x,1},0,1,{field_flags,[]},{x,1}}. - {bs_put_integer,{f,0}, - {integer,3}, - 1, - {field_flags,[aligned,unsigned,big]}, - {integer,0}}. - {bs_put_binary,{f,0},{atom,all},8,{field_flags,[unsigned,big]},{x,0}}. - {bs_put_integer,{f,0}, - {integer,5}, - 1, - {field_flags,[unsigned,big,aligned]}, - {integer,0}}. - {move,{x,1},{x,0}}. - return. - - -{function, module_info, 0, 4}. - {label,3}. - {func_info,{atom,t},{atom,module_info},0}. - {label,4}. - {move,{atom,t},{x,0}}. - {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. - - -{function, module_info, 1, 6}. - {label,5}. - {func_info,{atom,t},{atom,module_info},1}. - {label,6}. - {move,{x,0},{x,1}}. - {move,{atom,t},{x,0}}. - {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/map_field_lists.S b/lib/compiler/test/beam_validator_SUITE_data/map_field_lists.S index 9af68c82d4..5e7ccc1e5d 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/map_field_lists.S +++ b/lib/compiler/test/beam_validator_SUITE_data/map_field_lists.S @@ -13,7 +13,7 @@ {func_info,{atom,map_field_lists},{atom,x},1}. {label,2}. {test,is_map,{f,1},[{x,0}]}. - {test,has_map_fields,{f,1},{x,0},{list,[{atom,z},{atom,a}]}}. + {test,has_map_fields,{f,1},{x,0},{list,[{atom,a},{atom,a}]}}. {move,{atom,ok},{x,0}}. return. diff --git a/lib/compiler/test/beam_validator_SUITE_data/state_after_fault_in_catch.S b/lib/compiler/test/beam_validator_SUITE_data/state_after_fault_in_catch.S index 8e27347ed5..c3656d6218 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/state_after_fault_in_catch.S +++ b/lib/compiler/test/beam_validator_SUITE_data/state_after_fault_in_catch.S @@ -14,7 +14,7 @@ {allocate,1,0}. {'catch',{y,0},{f,3}}. {move,{atom,apa},{x,0}}. - {call_ext,1,{extfunc,erlang,fault,1}}. + {call_ext,1,{extfunc,erlang,error,1}}. {label,3}. {catch_end,{y,0}}. {move,{x,1},{x,0}}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/unsafe_catch.S b/lib/compiler/test/beam_validator_SUITE_data/unsafe_catch.S index 500ac11377..f7d3f805b3 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/unsafe_catch.S +++ b/lib/compiler/test/beam_validator_SUITE_data/unsafe_catch.S @@ -17,7 +17,7 @@ {bs_put_integer,{f,0}, {integer,8}, 1, - {field_flags,[aligned,unsigned,big]}, + {field_flags,[unsigned,big]}, {x,0}}. {move,{x,1},{y,0}}. {move,{x,2},{x,0}}. @@ -34,7 +34,7 @@ {bs_put_integer,{f,0}, {integer,16}, 1, - {field_flags,[aligned,unsigned,big]}, + {field_flags,[unsigned,big]}, {y,0}}. {move,{x,0},{y,0}}. {move,{x,1},{x,0}}. @@ -55,12 +55,12 @@ {bs_put_binary,{f,0}, {atom,all}, 8, - {field_flags,[aligned,unsigned,big]}, + {field_flags,[unsigned,big]}, {y,0}}. {bs_put_binary,{f,0}, {atom,all}, 8, - {field_flags,[aligned,unsigned,big]}, + {field_flags,[unsigned,big]}, {x,0}}. {move,{x,1},{x,0}}. {deallocate,2}. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index f7af56afcc..b54db06339 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -24,7 +24,7 @@ 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, - bin_tail/1,save_restore/1,shadowed_size_var/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, @@ -34,7 +34,8 @@ otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1, match_string/1,zero_width/1,bad_size/1,haystack/1, cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1, - no_partition/1,calling_a_binary/1,binary_in_map/1]). + no_partition/1,calling_a_binary/1,binary_in_map/1, + match_string_opt/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -50,7 +51,7 @@ all() -> groups() -> [{p,[parallel], [fun_shadow,int_float,otp_5269,null_fields,wiger, - bin_tail,save_restore,shadowed_size_var, + 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, @@ -59,7 +60,8 @@ groups() -> matching_and_andalso,otp_7188,otp_7233,otp_7240, otp_7498,match_string,zero_width,bad_size,haystack, cover_beam_bool,matched_out_size,follow_fail_branch, - no_partition,calling_a_binary,binary_in_map]}]. + no_partition,calling_a_binary,binary_in_map, + match_string_opt]}]. init_per_suite(Config) -> @@ -322,16 +324,6 @@ bad_float_unpack_match(<<F:64/float>>) -> F; bad_float_unpack_match(<<I:64/integer-signed>>) -> I. -shadowed_size_var(Config) when is_list(Config) -> - ?line PrivDir = ?config(priv_dir, Config), - ?line Dir = filename:dirname(code:which(?MODULE)), - ?line Core = filename:join(Dir, "bs_shadowed_size_var"), - ?line Opts = [from_core,{outdir,PrivDir}|test_lib:opt_opts(?MODULE)], - ?line io:format("~p", [Opts]), - ?line {ok,Mod} = c:c(Core, Opts), - ?line [42|<<"abcde">>] = Mod:filter_essentials([<<42:32>>|<<5:32,"abcde">>]), - ok. - partitioned_bs_match(Config) when is_list(Config) -> ?line <<1,2,3>> = partitioned_bs_match(blurf, <<42,1,2,3>>), ?line error = partitioned_bs_match(10, <<7,8,15,13>>), @@ -1224,6 +1216,14 @@ match_binary_in_map(Map) -> ok end. +match_string_opt(Config) when is_list(Config) -> + {x,<<1,2,3>>,{<<1>>,{v,<<1,2,3>>}}} = + do_match_string_opt({<<1>>,{v,<<1,2,3>>}}), + ok. + +do_match_string_opt({<<1>>,{v,V}}=T) -> + {x,V,T}. + check(F, R) -> R = F(). diff --git a/lib/compiler/test/bs_shadowed_size_var.core b/lib/compiler/test/bs_shadowed_size_var.core deleted file mode 100644 index d1d5ebba6d..0000000000 --- a/lib/compiler/test/bs_shadowed_size_var.core +++ /dev/null @@ -1,25 +0,0 @@ -module 'bs_shadowed_size_var' ['filter_essentials'/1] - attributes [] - -%% Reduced code from beam_asm inlined using the old inliner. - -'filter_essentials'/1 = - fun (_cor0) -> - case _cor0 of - <[#{#<Sz>(32,1,'integer',['unsigned','big']) }#|T]> when 'true' -> - let <_cor4> = - case T of - %% Variable 'Sz' repeated here. Should work. - <#{#<Sz>(32,1,'integer',['unsigned','big']), - #<Data>(Sz,8,'binary',['unsigned','big'])}#> when 'true' -> - Data - <_cor5> when 'true' -> - primop 'match_fail' - ({'case_clause',{_cor5}}) - end - in [Sz|_cor4] - <_cor5> when 'true' -> - primop 'match_fail' - ({'function_clause',_cor5}) - end -end diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 296774e083..f570d94f7d 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -309,8 +309,8 @@ load_and_call(Out, Module) -> %% Smoke-test of beam disassembler. ?line test_lib:smoke_disasm(Module), - ?line true = erlang:delete_module(Module), - ?line true = erlang:purge_module(Module), + _ = code:delete(Module), + _ = code:purge(Module), %% Restore state of trap_exit just in case. (Since the compiler %% uses a temporary process, we will get {'EXIT',Pid,normal} messages @@ -428,41 +428,35 @@ self_compile_old_inliner(Config) when is_list(Config) -> self_compile_1(Config, "old", [verbose,{inline,500}]). self_compile_1(Config, Prefix, Opts) -> - ?line Dog = test_server:timetrap(test_server:minutes(40)), + Dog = test_server:timetrap(test_server:minutes(40)), - ?line Priv = ?config(priv_dir,Config), - ?line Version = compiler_version(), + Priv = ?config(priv_dir,Config), + Version = compiler_version(), %% Compile the compiler. (In this node to get better coverage.) - ?line CompA = make_compiler_dir(Priv, Prefix++"compiler_a"), - ?line VsnA = Version ++ ".0", + CompA = make_compiler_dir(Priv, Prefix++"compiler_a"), + VsnA = Version ++ ".0", compile_compiler(compiler_src(), CompA, VsnA, [clint0,clint|Opts]), %% Compile the compiler again using the newly compiled compiler. %% (In another node because reloading the compiler would disturb cover.) CompilerB = Prefix++"compiler_b", CompB = make_compiler_dir(Priv, CompilerB), - ?line VsnB = VsnA ++ ".0", + VsnB = VsnA ++ ".0", self_compile_node(CompA, CompB, VsnB, Opts), - %% Compare compiler directories. - ?line compare_compilers(CompA, CompB), + %% Compare compiler directories. The compiler directories should + %% be equal (except for beam_asm that contains the compiler version). + compare_compilers(CompA, CompB), - %% Compile and compare compiler C. - ?line CompilerC = Prefix++"compiler_c", - ?line CompC = make_compiler_dir(Priv, CompilerC), - ?line VsnC = VsnB ++ ".0", - self_compile_node(CompB, CompC, VsnC, Opts), - ?line compare_compilers(CompB, CompC), - - ?line test_server:timetrap_cancel(Dog), + test_server:timetrap_cancel(Dog), ok. self_compile_node(CompilerDir, OutDir, Version, Opts) -> - ?line Dog = test_server:timetrap(test_server:minutes(15)), - ?line Pa = "-pa " ++ filename:dirname(code:which(?MODULE)) ++ + Dog = test_server:timetrap(test_server:minutes(15)), + Pa = "-pa " ++ filename:dirname(code:which(?MODULE)) ++ " -pa " ++ CompilerDir, - ?line Files = compiler_src(), + Files = compiler_src(), %% We don't want the cover server started on the other node, %% because it will load the same cover-compiled code as on this @@ -472,7 +466,7 @@ self_compile_node(CompilerDir, OutDir, Version, Opts) -> fun() -> compile_compiler(Files, OutDir, Version, Opts) end, Pa), - ?line test_server:timetrap_cancel(Dog), + test_server:timetrap_cancel(Dog), ok. compile_compiler(Files, OutDir, Version, InlineOpts) -> @@ -499,27 +493,22 @@ compiler_modules(Dir) -> [list_to_atom(filename:rootname(filename:basename(F))) || F <- Files]. make_compiler_dir(Priv, Dir0) -> - ?line Dir = filename:join(Priv, Dir0), - ?line ok = file:make_dir(Dir), + Dir = filename:join(Priv, Dir0), + ok = file:make_dir(Dir), Dir. -make_current(Dir) -> - true = code:add_patha(Dir), - lists:foreach(fun(File) -> - c:l(File) - end, compiler_modules(Dir)), - io:format("~p\n", [code:which(compile)]). - compiler_version() -> - {value,{version,Version}} = lists:keysearch(version, 1, - compile:module_info(compile)), + {version,Version} = lists:keyfind(version, 1, + compile:module_info(compile)), Version. compare_compilers(ADir, BDir) -> {[],[],D} = beam_lib:cmp_dirs(ADir, BDir), - [] = [T || {A,_}=T <- D, - filename:basename(A) =/= "beam_asm.beam"]. %Contains compiler version. + %% beam_asm.beam contains compiler version and therefore it *must* + %% compare unequal. + ["beam_asm.beam"] = [filename:basename(A) || {A,_} <- D], + ok. %%% %%% The only test of the following code is that it compiles. diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 1c96abe017..6b0369bf98 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -102,6 +102,8 @@ file_1(Config) when is_list(Config) -> ?line compile_and_verify(Simple, Target, [debug_info]), ?line {ok,simple} = compile:file(Simple, [no_line_info]), %Coverage + {ok,simple} = compile:file(Simple, [{eprof,beam_z}]), %Coverage + ?line ok = file:set_cwd(Cwd), ?line true = exists(Target), ?line passed = run(Target, test, []), @@ -124,7 +126,8 @@ file_1(Config) when is_list(Config) -> forms_2(Config) when is_list(Config) -> Src = "/foo/bar", AbsSrc = filename:absname(Src), - {ok,simple,Binary} = compile:forms([{attribute,1,module,simple}], + Anno = erl_anno:new(1), + {ok,simple,Binary} = compile:forms([{attribute,Anno,module,simple}], [binary,{source,Src}]), code:load_binary(simple, Src, Binary), Info = simple:module_info(compile), diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index 428ad65364..c4a7efbfc4 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -24,7 +24,9 @@ dehydrated_itracer/1,nested_tries/1, seq_in_guard/1,make_effect_seq/1,eval_is_boolean/1, unsafe_case/1,nomatch_shadow/1,reversed_annos/1, - map_core_test/1,eval_case/1,bad_boolean_guard/1]). + map_core_test/1,eval_case/1,bad_boolean_guard/1, + bs_shadowed_size_var/1 + ]). -include_lib("test_server/include/test_server.hrl"). @@ -50,7 +52,8 @@ groups() -> [{p,test_lib:parallel(), [dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq, eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos, - map_core_test,eval_case,bad_boolean_guard + map_core_test,eval_case,bad_boolean_guard, + bs_shadowed_size_var ]}]. @@ -78,6 +81,8 @@ end_per_group(_GroupName, Config) -> ?comp(map_core_test). ?comp(eval_case). ?comp(bad_boolean_guard). +?comp(bs_shadowed_size_var). + try_it(Mod, Conf) -> Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)), @@ -87,4 +92,7 @@ try_it(Mod, Conf) -> compile_and_load(Src, Opts) -> {ok,Mod,Bin} = compile:file(Src, [from_core,report,time,binary|Opts]), {module,Mod} = code:load_binary(Mod, Mod, Bin), - ok = Mod:Mod(). + ok = Mod:Mod(), + _ = code:delete(Mod), + _ = code:purge(Mod), + ok. diff --git a/lib/compiler/test/core_SUITE_data/bs_shadowed_size_var.core b/lib/compiler/test/core_SUITE_data/bs_shadowed_size_var.core new file mode 100644 index 0000000000..0ade037e05 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/bs_shadowed_size_var.core @@ -0,0 +1,66 @@ +module 'bs_shadowed_size_var' + ['filter_essentials'/1, + 'bs_shadowed_size_var'/0] + attributes [] + +%% bs_shadowed_size_var() -> +%% [42|<<"abcde">>] = Mod:filter_essentials([<<42:32>>|<<5:32,"abcde">>]), +%% ok. + +'bs_shadowed_size_var'/0 = + fun () -> + case <> of + <> when 'true' -> + case apply 'filter_essentials'/1 + ([#{#<0>(8,1,'integer',['unsigned'|['big']]), + #<0>(8,1,'integer',['unsigned'|['big']]), + #<0>(8,1,'integer',['unsigned'|['big']]), + #<42>(8,1,'integer',['unsigned'|['big']])}#|#{#<0>(8,1,'integer',['unsigned'|['big']]), + #<0>(8,1,'integer',['unsigned'|['big']]), + #<0>(8,1,'integer',['unsigned'|['big']]), + #<5>(8,1,'integer',['unsigned'|['big']]), + #<97>(8,1,'integer',['unsigned'|['big']]), + #<98>(8,1,'integer',['unsigned'|['big']]), + #<99>(8,1,'integer',['unsigned'|['big']]), + #<100>(8,1,'integer',['unsigned'|['big']]), + #<101>(8,1,'integer',['unsigned'|['big']])}#]) of + <[42|#{#<97>(8,1,'integer',['unsigned'|['big']]), + #<98>(8,1,'integer',['unsigned'|['big']]), + #<99>(8,1,'integer',['unsigned'|['big']]), + #<100>(8,1,'integer',['unsigned'|['big']]), + #<101>(8,1,'integer',['unsigned'|['big']])}#]> when 'true' -> + 'ok' + ( <_cor0> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor0}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'bs_shadowed_size_var',0}}] ) + -| ['compiler_generated'] ) + end + +%% Reduced code from beam_asm inlined using the old inliner. + +'filter_essentials'/1 = + fun (_cor0) -> + case _cor0 of + <[#{#<Sz>(32,1,'integer',['unsigned','big']) }#|T]> when 'true' -> + let <_cor4> = + case T of + %% Variable 'Sz' repeated here. Should work. + <#{#<Sz>(32,1,'integer',['unsigned','big']), + #<Data>(Sz,8,'binary',['unsigned','big'])}#> when 'true' -> + Data + <_cor5> when 'true' -> + primop 'match_fail' + ({'case_clause',{_cor5}}) + end + in [Sz|_cor4] + <_cor5> when 'true' -> + primop 'match_fail' + ({'function_clause',_cor5}) + end +end diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 512aada203..bff9806bdd 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -88,6 +88,7 @@ t_element(Config) when is_list(Config) -> {_,_,_}=Tup -> ?line {'EXIT',{badarg,_}} = (catch element(4, Tup)) end, + {'EXIT',{badarg,_}} = (catch element(1, tuple_size(Tuple))), ok. @@ -106,6 +107,7 @@ setelement(Config) when is_list(Config) -> ?line error = setelement_crash_2({a,b,c,d,e,f}, <<42>>), {'EXIT',{badarg,_}} = (catch setelement(1, not_a_tuple, New)), + {'EXIT',{badarg,_}} = (catch setelement(3, {a,b}, New)), ok. @@ -229,15 +231,17 @@ eq(Config) when is_list(Config) -> %% OTP-7117. nested_call_in_case(Config) when is_list(Config) -> - ?line PrivDir = ?config(priv_dir, Config), - ?line Dir = filename:dirname(code:which(?MODULE)), - ?line Core = filename:join(Dir, "nested_call_in_case"), - ?line Opts = [from_core,{outdir,PrivDir}|test_lib:opt_opts(?MODULE)], - ?line io:format("~p", [Opts]), - ?line {ok,Mod} = c:c(Core, Opts), - ?line yes = Mod:a([1,2,3], 2), - ?line no = Mod:a([1,2,3], 4), - ?line {'EXIT',_} = (catch Mod:a(not_a_list, 42)), + PrivDir = ?config(priv_dir, Config), + Dir = test_lib:get_data_dir(Config), + Core = filename:join(Dir, "nested_call_in_case"), + Opts = [from_core,{outdir,PrivDir}|test_lib:opt_opts(?MODULE)], + io:format("~p", [Opts]), + {ok,Mod} = c:c(Core, Opts), + yes = Mod:a([1,2,3], 2), + no = Mod:a([1,2,3], 4), + {'EXIT',_} = (catch Mod:a(not_a_list, 42)), + _ = code:delete(Mod), + _ = code:purge(Mod), ok. guard_try_catch(_Config) -> @@ -343,7 +347,7 @@ bsm_an_inlined(_, _) -> error. unused_multiple_values_error(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), - Dir = filename:dirname(code:which(?MODULE)), + Dir = test_lib:get_data_dir(Config), Core = filename:join(Dir, "unused_multiple_values_error"), Opts = [no_copt,clint,return,from_core,{outdir,PrivDir} |test_lib:opt_opts(?MODULE)], diff --git a/lib/compiler/test/nested_call_in_case.core b/lib/compiler/test/core_fold_SUITE_data/nested_call_in_case.core index 5c6b6909bd..c46906b2ed 100644 --- a/lib/compiler/test/nested_call_in_case.core +++ b/lib/compiler/test/core_fold_SUITE_data/nested_call_in_case.core @@ -16,6 +16,3 @@ module 'nested_call_in_case' ['a'/2] -| ['compiler_generated'] ) end end - - - diff --git a/lib/compiler/test/unused_multiple_values_error.core b/lib/compiler/test/core_fold_SUITE_data/unused_multiple_values_error.core index e06587c936..e06587c936 100644 --- a/lib/compiler/test/unused_multiple_values_error.core +++ b/lib/compiler/test/core_fold_SUITE_data/unused_multiple_values_error.core diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index 0d23f12fb5..acd785cc5a 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -235,10 +235,18 @@ transforms(Config) -> ">>, {error,[{none,compile,{parse_transform,?MODULE,{too_bad,_}}}],[]} = run_test(Ts2, test_filename(Config), [], dont_write_beam), + Ts3 = <<" + -compile({parse_transform,",?MODULE_STRING,"}). + ">>, + {error,[{none,compile,{parse_transform,?MODULE,{undef,_}}}],[]} = + run_test(Ts3, test_filename(Config), [call_undef], dont_write_beam), ok. -parse_transform(_, _) -> - error(too_bad). +parse_transform(_, Opts) -> + case lists:member(call_undef, Opts) of + false -> error(too_bad); + true -> camembert:délicieux() + end. maps_warnings(Config) when is_list(Config) -> diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 08279d9408..512207898e 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1373,10 +1373,11 @@ literal_type_tests_1(Config) -> [{is_function,L1,L2} || L1 <- literals(), L2 <- literals()]), ?line Mod = literal_test, - ?line Func = {function, 0, test, 0, [{clause,0,[],[],Tests}]}, - ?line Form = [{attribute,0,module,Mod}, - {attribute,0,compile,export_all}, - Func, {eof,0}], + Anno = erl_anno:new(0), + Func = {function, Anno, test, 0, [{clause,Anno,[],[],Tests}]}, + Form = [{attribute,Anno,module,Mod}, + {attribute,Anno,compile,export_all}, + Func, {eof,Anno}], %% Print generated code for inspection. ?line lists:foreach(fun (F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Form), @@ -1411,7 +1412,8 @@ test(T, L) -> {ok,Toks,_Line} = erl_scan:string(S), {ok,E} = erl_parse:parse_exprs(Toks), {value,Val,_Bs} = erl_eval:exprs(E, []), - {match,0,{atom,0,Val},hd(E)}. + Anno = erl_anno:new(0), + {match,Anno,{atom,Anno,Val},hd(E)}. test(T, L1, L2) -> S0 = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ", [T,L1,L2,T,L1,L2]), @@ -1419,7 +1421,8 @@ test(T, L1, L2) -> {ok,Toks,_Line} = erl_scan:string(S), {ok,E} = erl_parse:parse_exprs(Toks), {value,Val,_Bs} = erl_eval:exprs(E, []), - {match,0,{atom,0,Val},hd(E)}. + Anno = erl_anno:new(0), + {match,Anno,{atom,Anno,Val},hd(E)}. smoke_disasm(Config, Mod, Bin) -> Priv = ?config(priv_dir, Config), @@ -1614,6 +1617,8 @@ t_tuple_size(Config) when is_list(Config) -> ?line {ok,Mod,Code} = compile:file(File, [from_asm,binary]), ?line code:load_binary(Mod, File, Code), ?line 14 = Mod:t({1,2,3,4}), + _ = code:delete(Mod), + _ = code:purge(Mod), ok. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index cfa8262701..8768e47b65 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -22,16 +22,22 @@ -export([ %% literals - t_build_and_match_literals/1, - t_update_literals/1,t_match_and_update_literals/1, + 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_exact/1, - t_guard_bifs/1, t_guard_sequence/1, t_guard_update/1, - t_guard_receive/1, t_guard_fun/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_list_comprehension/1, t_map_sort_literals/1, t_map_size/1, t_build_and_match_aliasing/1, + t_is_map/1, %% variables t_build_and_match_variables/1, @@ -65,15 +71,21 @@ all() -> test_lib:recompile(?MODULE), [ %% literals - t_build_and_match_literals, - t_update_literals, t_match_and_update_literals, + 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_exact, - t_guard_bifs, t_guard_sequence, t_guard_update, - t_guard_receive,t_guard_fun, t_list_comprehension, + 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_map_sort_literals, t_map_size, t_build_and_match_aliasing, + t_is_map, %% variables t_build_and_match_variables, @@ -157,6 +169,461 @@ t_build_and_match_literals(Config) when is_list(Config) -> {'EXIT',{{badmatch,_},_}} = (catch (#{#{"a"=>42} := 3}=id(#{#{"a"=>3}=>42}))), ok. +t_build_and_match_literals_large(Config) when is_list(Config) -> + % normal non-repeating + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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 = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10", + 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11", + 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12", + 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13", + 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14", + + 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15", + 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16", + 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17", + 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18", + 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19", + + 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"), + 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"), + 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"), + 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"), + 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"), + + 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"), + 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"), + 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"), + 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"), + 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"), + + #{ one => small, map => key } => id("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" } => id("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_build_and_match_aliasing(Config) when is_list(Config) -> M1 = id(#{a=>1,b=>2,c=>3,d=>4}), @@ -202,14 +669,25 @@ t_map_size(Config) when is_list(Config) -> false = map_is_size(M#{ "c" => 2}, 2), %% Error cases. - {'EXIT',{badarg,_}} = (catch map_size([])), - {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)), - {'EXIT',{badarg,_}} = (catch map_size(1)), + {'EXIT',{{badmap,[]},_}} = (catch map_size([])), + {'EXIT',{{badmap,<<1,2,3>>},_}} = (catch map_size(<<1,2,3>>)), + {'EXIT',{{badmap,1},_}} = (catch map_size(1)), 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(Config) when is_list(Config) -> Map = #{x=>1,y=>2,z=>3,q=>4}, @@ -218,13 +696,75 @@ t_update_literals(Config) when is_list(Config) -> ]), ok. +t_update_literals_large(Config) when is_list(Config) -> + Map = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10", + 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11", + 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12", + 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13", + 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14", + + 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15", + 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16", + 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17", + 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18", + 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19", + + 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"), + 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"), + 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"), + 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"), + 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"), + + 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"), + 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"), + 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"), + 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"), + 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"), + + #{ one => small, map => key } => id("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" } => id("large map key 2") }), + + #{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}, + 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} ]), @@ -238,8 +778,77 @@ t_match_and_update_literals(Config) when is_list(Config) -> #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, ok. +t_match_and_update_literals_large(Config) when is_list(Config) -> + Map = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10", + 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11", + 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12", + 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13", + 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14", + + 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15", + 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16", + 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17", + 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18", + 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19", + + 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"), + 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"), + 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"), + 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"), + 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"), + + 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"), + 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"), + 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"), + 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"), + 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"), + + x=>0,y=>"untouched",z=>"also untouched",q=>1, + + #{ "one" => small, map => key } => id("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" } => id("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 = id(Map#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}), + M1 = id(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} = Map, [{X,Q}|Vs]) -> +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). @@ -265,9 +874,9 @@ t_update_map_expressions(Config) when is_list(Config) -> #{ "a" := b } = F(), - %% Error cases, FIXME: should be 'badmap'? - {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), - {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }), + %% Error cases. + {'EXIT',{{badmap,<<>>},_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), + {'EXIT',{{badmap,[]},_}} = (catch (id([]))#{ a := 42, b => 2 }), ok. @@ -288,10 +897,86 @@ t_update_assoc(Config) when is_list(Config) -> %% Errors cases. BadMap = id(badmap), - {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), - {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}), + {'EXIT',{{badmap,BadMap},_}} = (catch BadMap#{nonexisting=>val}), + {'EXIT',{{badmap,<<>>},_}} = (catch <<>>#{nonexisting=>val}), + + %% Evaluation order. + {'EXIT',{blurf,_}} = + (catch BadMap#{whatever=>id(error(blurf))}), + {'EXIT',{blurf,_}} = + (catch BadMap#{id(error(blurf))=>whatever}), ok. +t_update_assoc_large(Config) when is_list(Config) -> + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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}, + + %% Errors cases. + BadMap = id({no,map}), + {'EXIT',{{badmap,BadMap},_}} = (catch BadMap#{nonexisting=>M0}), + ok. + + + t_update_exact(Config) when is_list(Config) -> M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), @@ -312,19 +997,111 @@ t_update_exact(Config) when is_list(Config) -> 1.0 => new_val4 }, %% Errors cases. - {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })), - {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), - {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), - {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), - {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), - {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting:=val}), - {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation + {'EXIT',{{badmap,nil},_}} = (catch ((id(nil))#{ a := b })), + {'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}), + {'EXIT',{{badmap,<<>>},_}} = (catch <<>>#{nonexisting:=val}), + {'EXIT',{{badkey,<<0:257>>},_}} = + (catch M0#{<<0:257>> := val}), %limitation %% A workaround for a bug allowed an empty map to be updated. - {'EXIT',{badarg,_}} = (catch (id(#{}))#{a:=1}), - {'EXIT',{badarg,_}} = (catch #{}#{a:=1}), + {'EXIT',{{badkey,a},_}} = (catch (id(#{}))#{a:=1}), + {'EXIT',{{badkey,a},_}} = (catch #{}#{a:=1}), Empty = #{}, - {'EXIT',{badarg,_}} = (catch Empty#{a:=1}), + {'EXIT',{{badkey,a},_}} = (catch Empty#{a:=1}), + + %% Evaluation order. + BadMap = id([no,map]), + {'EXIT',{blurf,_}} = + (catch BadMap#{whatever:=id(error(blurf))}), + {'EXIT',{blurf,_}} = + (catch BadMap#{id(error(blurf)):=whatever}), + {'EXIT',{{badmap,BadMap},_}} = + (catch BadMap#{id(nonexisting):=whatever}), + ok. + +t_update_exact_large(Config) when is_list(Config) -> + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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_values(Config) when is_list(Config) -> @@ -411,6 +1188,75 @@ t_guard_sequence(Config) when is_list(Config) -> {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), ok. +t_guard_sequence_large(Config) when is_list(Config) -> + M0 = id(#{ 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=>id("a")}), + {2, "b"} = map_guard_sequence_1(M0#{seq=>2,val=>id("b")}), + {3, "c"} = map_guard_sequence_1(M0#{seq=>3,val=>id("c")}), + {4, "d"} = map_guard_sequence_1(M0#{seq=>4,val=>id("d")}), + {5, "e"} = map_guard_sequence_1(M0#{seq=>5,val=>id("e")}), + + {1,M1} = map_guard_sequence_2(M1 = id(M0#{a=>3})), + {2,M2} = map_guard_sequence_2(M2 = id(M0#{a=>4, b=>4})), + {3,gg,M3} = map_guard_sequence_2(M3 = id(M0#{a=>gg, b=>4})), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(M0#{a=>sc, b=>3, c=>sc2})), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(M0#{a=>kk, b=>other, c=>sc2})), + + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(M0#{seq=>6,val=>id("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}; @@ -431,6 +1277,65 @@ t_guard_update(Config) when is_list(Config) -> third = map_guard_update(#{x=>old,y=>old}, #{x=>third,y=>old}), ok. +t_guard_update_large(Config) when is_list(Config) -> + M0 = id(#{ 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(M1, M2) when M1#{x:=third} =:= M2 -> third; @@ -461,6 +1366,43 @@ t_guard_receive(Config) when is_list(Config) -> 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. @@ -494,6 +1436,11 @@ t_list_comprehension(Config) when is_list(Config) -> Ls = id([#{<<2:301>> => I, "wat" => I + 1} || I <- [1,2,3]]), [#{<<2:301>>:=1,"wat":=2},#{<<2:301>>:=2,"wat":=3},#{<<2:301>>:=3,"wat":=4}] = Ls, [{1,2},{2,3},{3,4}] = id([{I2,I1} || #{"wat" := I1, <<2:301>> := I2} <- Ls]), + + 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) -> @@ -543,7 +1490,7 @@ t_map_sort_literals(Config) when is_list(Config) -> true = id(#{ c => 1, b => 1, a => 1 }) < id(#{ b => 1, c => 1, d => 1}), true = id(#{ "a" => 1 }) < id(#{ <<"a">> => 1}), false = id(#{ <<"a">> => 1 }) < id(#{ "a" => 1}), - false = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}), + true = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}), false = id(#{ 1.0 => 1 }) < id(#{ 1 => 1}), %% value order @@ -735,8 +1682,8 @@ t_update_assoc_variables(Config) when is_list(Config) -> %% Errors cases. BadMap = id(badmap), - {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), - {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}), + {'EXIT',{{badmap,BadMap},_}} = (catch BadMap#{nonexisting=>val}), + {'EXIT',{{badmap,<<>>},_}} = (catch <<>>#{nonexisting=>val}), ok. t_update_exact_variables(Config) when is_list(Config) -> @@ -766,13 +1713,14 @@ t_update_exact_variables(Config) when is_list(Config) -> #{ "wat" := 3, 2 := a } = id(#{ "wat" => 1, K2 => 2 }#{ K2 := a, "wat" := 3 }), %% Errors cases. - {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })), - {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), - {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), - {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), - {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), - {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting:=val}), - {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation + {'EXIT',{{badmap,nil},_}} = (catch ((id(nil))#{ a := b })), + {'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}), + {'EXIT',{{badmap,<<>>},_}} = (catch <<>>#{nonexisting:=val}), + {'EXIT',{{badkey,<<0:257>>},_}} = + (catch M0#{<<0:257>> := val}), %limitation ok. t_nested_pattern_expressions(Config) when is_list(Config) -> diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 7522ee985f..9aec0b3d4e 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -141,6 +141,13 @@ aliases(Config) when is_list(Config) -> ?line {a,b} = list_alias2([a,b]), ?line {a,b} = list_alias3([a,b]), + %% Non-matching aliases. + none = mixed_aliases(<<42>>), + none = mixed_aliases([b]), + none = mixed_aliases([d]), + none = mixed_aliases({a,42}), + none = mixed_aliases(42), + ok. str_alias(V) -> @@ -244,6 +251,12 @@ list_alias2([X,Y]=[a,b]) -> list_alias3([X,b]=[a,Y]) -> {X,Y}. +mixed_aliases(<<X:8>> = x) -> {a,X}; +mixed_aliases([b] = <<X:8>>) -> {b,X}; +mixed_aliases(<<X:8>> = {a,X}) -> {c,X}; +mixed_aliases([X] = <<X:8>>) -> {d,X}; +mixed_aliases(_) -> none. + %% OTP-7018. match_in_call(Config) when is_list(Config) -> diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 68a31f14d5..f3b92aad5b 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -338,8 +338,16 @@ integer_encoding_1(Config) -> ?line do_integer_encoding(-(id(1) bsl 10000), Src, Data), ?line do_integer_encoding(id(1) bsl 10000, Src, Data), - ?line do_integer_encoding(2048, 0, Src, Data), - + do_integer_encoding(1024, 0, Src, Data), + _ = [begin + B = 1 bsl I, + do_integer_encoding(-B-1, Src, Data), + do_integer_encoding(-B, Src, Data), + do_integer_encoding(-B+1, Src, Data), + do_integer_encoding(B-1, Src, Data), + do_integer_encoding(B, Src, Data), + do_integer_encoding(B+1, Src, Data) + end || I <- lists:seq(1, 128)], io:put_chars(Src, "Last].\n\n"), ?line ok = file:close(Src), io:put_chars(Data, "0].\n\n"), @@ -372,11 +380,9 @@ do_integer_encoding(N, I0, Src, Data) -> do_integer_encoding(I, Src, Data) -> Str = integer_to_list(I), - io:put_chars(Src, Str), - io:put_chars(Src, ", \n"), - io:put_chars(Data, Str), - io:put_chars(Data, ", \n"). - + io:put_chars(Src, [Str,",\n"]), + io:put_chars(Data, [Str,",\n"]). + id(I) -> I. diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index a5e2855f8c..4ffac95489 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -57,10 +57,8 @@ parallel() -> end. uniq() -> - U0 = erlang:ref_to_list(make_ref()), - U1 = re:replace(U0, "^#Ref", ""), - U = re:replace(U1, "[^[A-Za-z0-9_]+", "_", [global]), - re:replace(U, "_*$", "", [{return,list}]). + U = erlang:unique_integer([positive]), + "_" ++ integer_to_list(U). %% Retrieve the "interesting" compiler options (options for optimization %% and compatibility) for the given module. diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index dcd3910926..f6ba75577d 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -39,7 +39,7 @@ guard/1,bad_arith/1,bool_cases/1,bad_apply/1, files/1,effect/1,bin_opt_info/1,bin_construction/1, comprehensions/1,maps/1,redundant_boolean_clauses/1, - latin1_fallback/1,underscore/1]). + latin1_fallback/1,underscore/1,no_warnings/1]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(2)). @@ -65,7 +65,7 @@ groups() -> bad_arith,bool_cases,bad_apply,files,effect, bin_opt_info,bin_construction,comprehensions,maps, redundant_boolean_clauses,latin1_fallback, - underscore]}]. + underscore,no_warnings]}]. init_per_suite(Config) -> Config. @@ -281,7 +281,6 @@ bad_arith(Config) when is_list(Config) -> {3,sys_core_fold,{eval_failure,badarith}}, {9,sys_core_fold,nomatch_guard}, {9,sys_core_fold,{eval_failure,badarith}}, - {9,sys_core_fold,{no_effect,{erlang,is_integer,1}}}, {10,sys_core_fold,nomatch_guard}, {10,sys_core_fold,{eval_failure,badarith}}, {15,sys_core_fold,{eval_failure,badarith}} @@ -584,7 +583,7 @@ maps(Config) when is_list(Config) -> ok. ">>, [], - {warnings,[{4,sys_core_fold,{eval_failure,badarg}}]}}, + {warnings,[{4,sys_core_fold,{eval_failure,badmap}}]}}, {bad_map_src2, <<" t() -> @@ -602,7 +601,7 @@ maps(Config) when is_list(Config) -> ok. ">>, [], - {warnings,[{3,v3_core,bad_map}]}}, + {warnings,[{3,v3_core,badmap}]}}, {ok_map_literal_key, <<" t() -> @@ -719,6 +718,33 @@ underscore(Config) when is_list(Config) -> ok. +no_warnings(Config) when is_list(Config) -> + Ts = [{no_warnings, + <<"-record(r, {s=ordsets:new(),a,b}). + + a() -> + R = #r{}, %No warning expected. + {R#r.a,R#r.b}. + + b(X) -> + T = true, + Var = [X], %No warning expected. + case T of + false -> Var; + true -> [] + end. + + c() -> + R0 = {r,\"abc\",undefined,os:timestamp()}, %No warning. + case R0 of + {r,V1,_V2,V3} -> {r,V1,\"def\",V3} + end. + ">>, + [], + []}], + run(Config, Ts), + ok. + %%% %%% End of test cases. %%% diff --git a/lib/compiler/test/z_SUITE.erl b/lib/compiler/test/z_SUITE.erl new file mode 100644 index 0000000000..eff8a1877f --- /dev/null +++ b/lib/compiler/test/z_SUITE.erl @@ -0,0 +1,62 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(z_SUITE). + +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + loaded/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [loaded]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +loaded(_Config) -> + 0 = do_loaded(code:all_loaded(), 0), + ok. + +do_loaded([{M,_}|Ms], E0) -> + E = try + _ = M:module_info(), + _ = M:module_info(functions), + E0 + catch + C:Error -> + Stk = erlang:get_stacktrace(), + io:format("~p:~p\n~p\n", [C,Error,Stk]), + E0 + 1 + end, + do_loaded(Ms, E); +do_loaded([], E) -> E. diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index b1a6c15ac9..05e682c893 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 5.0.3 +COMPILER_VSN = 5.0.4 diff --git a/lib/cosEvent/src/cosEvent.app.src b/lib/cosEvent/src/cosEvent.app.src index 66b0d2e168..5ffd12bc6b 100644 --- a/lib/cosEvent/src/cosEvent.app.src +++ b/lib/cosEvent/src/cosEvent.app.src @@ -39,7 +39,7 @@ {applications, [orber, stdlib, kernel]}, {env, []}, {mod, {cosEventApp, []}}, - {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0"]} + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0"]} ]}. diff --git a/lib/cosEvent/src/oe_CosEventComm_PullerS_impl.erl b/lib/cosEvent/src/oe_CosEventComm_PullerS_impl.erl index 5f2733e72d..9c22eafaab 100644 --- a/lib/cosEvent/src/oe_CosEventComm_PullerS_impl.erl +++ b/lib/cosEvent/src/oe_CosEventComm_PullerS_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -251,7 +251,8 @@ send_sync(_OE_This, _OE_From, State, Any) -> store_event(DB, Max, Event) -> case ets:info(DB, size) of CurrentSize when CurrentSize < Max -> - ets:insert(DB, {now(), Event}); + ets:insert(DB, {{erlang:system_time(), erlang:unique_integer([positive])}, + Event}); _ -> orber:dbg("[~p] oe_CosEventComm_PullerS:store_event(~p); DB full drop event.", [?LINE, Event], ?DEBUG_LEVEL), diff --git a/lib/cosEvent/vsn.mk b/lib/cosEvent/vsn.mk index 40bf1ba49d..3149020d7c 100644 --- a/lib/cosEvent/vsn.mk +++ b/lib/cosEvent/vsn.mk @@ -1,3 +1,2 @@ - -COSEVENT_VSN = 2.1.15 +COSEVENT_VSN = 2.2 diff --git a/lib/cosEventDomain/src/cosEventDomain.app.src b/lib/cosEventDomain/src/cosEventDomain.app.src index 60114b6a91..f218ac853e 100644 --- a/lib/cosEventDomain/src/cosEventDomain.app.src +++ b/lib/cosEventDomain/src/cosEventDomain.app.src @@ -28,6 +28,6 @@ {applications, [orber, stdlib, kernel]}, {env, []}, {mod, {cosEventDomainApp, []}}, - {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0", + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0", "cosNotification-1.1.21"]} ]}. diff --git a/lib/cosEventDomain/src/cosEventDomainApp.erl b/lib/cosEventDomain/src/cosEventDomainApp.erl index 734e4deccb..86069d9e09 100644 --- a/lib/cosEventDomain/src/cosEventDomainApp.erl +++ b/lib/cosEventDomain/src/cosEventDomainApp.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -36,9 +36,6 @@ %%--------------- EXPORTS ------------------------------------ %% External MISC -export([get_option/3, - create_name/2, - create_name/1, - create_id/0, create_id/1, is_debug_compiled/0, install/0, @@ -222,31 +219,10 @@ get_option(Key, OptionList, DefaultList) -> {error, "Invalid option"} end end. -%%-----------------------------------------------------------% -%% function : create_name/2 -%% Arguments: -%% Returns : -%% Exception: -%% Effect : -%%------------------------------------------------------------ -create_name(Name,Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',Name,'_',MSec, '_', Sec, '_', USec]). - -%%-----------------------------------------------------------% -%% function : create_name/1 -%% Arguments: -%% Returns : -%% Exception: -%% Effect : -%%------------------------------------------------------------ -create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',MSec, '_', Sec, '_', USec]). %%------------------------------------------------------------ -%% function : create_id/0 -%% Arguments: - +%% function : create_id/1 +%% Arguments: CosEventDomainAdmin::DomainID (long) %% Returns : CosEventDomainAdmin::DomainID (long) %% Exception: %% Purpose : @@ -256,10 +232,6 @@ create_id(2147483647) -> create_id(OldID) -> OldID+1. - -create_id() -> - {_A,_B,C}=now(), - C. %%------------------------------------------------------------ %% function : get_qos %% Arguments: diff --git a/lib/cosEventDomain/vsn.mk b/lib/cosEventDomain/vsn.mk index 6317ed3c22..bdde1f6ab2 100644 --- a/lib/cosEventDomain/vsn.mk +++ b/lib/cosEventDomain/vsn.mk @@ -1,3 +1,2 @@ - -COSEVENTDOMAIN_VSN = 1.1.14 +COSEVENTDOMAIN_VSN = 1.2 diff --git a/lib/cosFileTransfer/src/cosFileTransfer.app.src b/lib/cosFileTransfer/src/cosFileTransfer.app.src index 21226b0c6b..033eec9700 100644 --- a/lib/cosFileTransfer/src/cosFileTransfer.app.src +++ b/lib/cosFileTransfer/src/cosFileTransfer.app.src @@ -38,6 +38,6 @@ {env, []}, {mod, {cosFileTransferApp, []}}, {runtime_dependencies, ["stdlib-2.0","ssl-5.3.4","orber-3.6.27","kernel-3.0", - "inets-5.10","erts-6.0","cosProperty-1.1.17"]} + "inets-5.10","erts-7.0","cosProperty-1.1.17"]} ]}. diff --git a/lib/cosFileTransfer/src/cosFileTransferApp.erl b/lib/cosFileTransfer/src/cosFileTransferApp.erl index 443c917a97..bcc9f485a0 100644 --- a/lib/cosFileTransfer/src/cosFileTransferApp.erl +++ b/lib/cosFileTransfer/src/cosFileTransferApp.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -208,8 +208,9 @@ type_check(Obj, Mod) -> %% Effect : %%------------------------------------------------------------ create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]). %%-----------------------------------------------------------% diff --git a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl b/lib/cosFileTransfer/test/fileTransfer_SUITE.erl index dfe6fabfab..5e75a9919f 100644 --- a/lib/cosFileTransfer/test/fileTransfer_SUITE.erl +++ b/lib/cosFileTransfer/test/fileTransfer_SUITE.erl @@ -732,8 +732,9 @@ create_file_on_source_node({'NATIVE', _}, _Config, Host, FileName, Path, Data) - ?match(ok, file:write_file(FileName, list_to_binary(Data))). create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat([Type,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat([Type, '_', Time, '_', Unique]). diff --git a/lib/cosFileTransfer/vsn.mk b/lib/cosFileTransfer/vsn.mk index f52a1bd800..00bfdb3087 100644 --- a/lib/cosFileTransfer/vsn.mk +++ b/lib/cosFileTransfer/vsn.mk @@ -1 +1 @@ -COSFILETRANSFER_VSN = 1.1.16 +COSFILETRANSFER_VSN = 1.2 diff --git a/lib/cosNotification/src/CosNotification_Common.erl b/lib/cosNotification/src/CosNotification_Common.erl index af9b2d4368..cdaaeee7f8 100644 --- a/lib/cosNotification/src/CosNotification_Common.erl +++ b/lib/cosNotification/src/CosNotification_Common.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -39,8 +39,9 @@ %%--------------- EXPORTS ------------------------------------ %% External MISC -export([get_option/3, - create_name/2, + create_name/0, create_name/1, + create_name/2, create_id/0, create_id/1, is_debug_compiled/0, @@ -110,17 +111,20 @@ get_option(Key, OptionList, DefaultList) -> {error, "Invalid option"} end end. -%%-----------------------------------------------------------% -%% function : create_name/2 + +%%------------------------------------------------------------ +%% function : create_name %% Arguments: %% Returns : -%% Exception: -%% Effect : +%% Effect : Create a unique name to use when, for eaxmple, starting +%% a new server. %%------------------------------------------------------------ -create_name(Name,Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',Name,'_',MSec, '_', Sec, '_', USec]). - +create_name() -> + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Time,'_',Unique]). + + %%-----------------------------------------------------------% %% function : create_name/1 %% Arguments: @@ -129,8 +133,21 @@ create_name(Name,Type) -> %% Effect : %%------------------------------------------------------------ create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]). + +%%-----------------------------------------------------------% +%% function : create_name/2 +%% Arguments: +%% Returns : +%% Exception: +%% Effect : +%%------------------------------------------------------------ +create_name(Name,Type) -> + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Name,'_',Time,'_',Unique]). %%------------------------------------------------------------ %% function : create_id/0 @@ -146,16 +163,16 @@ create_name(Type) -> %%------------------------------------------------------------ create_id(-1) -> 1; -create_id( 2147483647) -> +create_id(2147483647) -> -2147483648; create_id(OldID) -> OldID+1. create_id() -> - {_A,_B,C}=now(), + {_A,_B,C}=erlang:timestamp(), C. -%%-----------------------------------------------------------% +%%------------------------------------------------------------ %% function : type_check %% Arguments: Obj - objectrefernce to test. %% Mod - Module which contains typeID/0. diff --git a/lib/cosNotification/src/CosNotification_Definitions.hrl b/lib/cosNotification/src/CosNotification_Definitions.hrl index 8325b5aa5e..5db081ec2e 100644 --- a/lib/cosNotification/src/CosNotification_Definitions.hrl +++ b/lib/cosNotification/src/CosNotification_Definitions.hrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -315,7 +315,9 @@ {tty, false}, {logfile, false}, {server_options, []}]). --define(not_CreateDBKey, term_to_binary({now(), node()})). +-define(not_CreateDBKey, term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()})). -define(DEBUG_LEVEL, 3). diff --git a/lib/cosNotification/src/PullerSupplier_impl.erl b/lib/cosNotification/src/PullerSupplier_impl.erl index 9f12f9c742..22e8355f3a 100644 --- a/lib/cosNotification/src/PullerSupplier_impl.erl +++ b/lib/cosNotification/src/PullerSupplier_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -887,7 +887,7 @@ callAny(_OE_THIS, OE_FROM, State, EventIn, Status) -> %% Start timers which send a message each time we should push events. Only used %% when this objects is defined to supply sequences. start_timer(State) -> - TS = now(), + TS = erlang:timestamp(), case catch timer:send_after(timer:seconds(?get_PacingInterval(State)), {pacing, TS}) of {ok,PacTRef} -> diff --git a/lib/cosNotification/src/cosNotification.app.src b/lib/cosNotification/src/cosNotification.app.src index ad02eb4421..09bf8f01fc 100644 --- a/lib/cosNotification/src/cosNotification.app.src +++ b/lib/cosNotification/src/cosNotification.app.src @@ -117,6 +117,6 @@ {applications, [orber, stdlib, kernel]}, {env, []}, {mod, {cosNotificationApp, []}}, - {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0", + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0", "cosTime-1.1.14","cosEvent-2.1.15"]} ]}. diff --git a/lib/cosNotification/src/cosNotificationApp.erl b/lib/cosNotification/src/cosNotificationApp.erl index ba44163272..251779c558 100644 --- a/lib/cosNotification/src/cosNotificationApp.erl +++ b/lib/cosNotification/src/cosNotificationApp.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -221,7 +221,7 @@ start_global_factory() -> start_global_factory(Args) when is_list(Args) -> SO = 'CosNotification_Common':get_option(server_options, Args, ?not_DEFAULT_SETTINGS), - Name = create_name(), + Name = 'CosNotification_Common':create_name(), SPEC = ['CosNotifyChannelAdmin_EventChannelFactory',Args, [{sup_child, true}, {regname, {global, Name}}|SO]], @@ -432,16 +432,4 @@ init(app_init) -> 'CosNotifyChannelAdmin_EventChannel_impl']}]}}. - -%%------------------------------------------------------------ -%% function : create_name -%% Arguments: -%% Returns : -%% Effect : Create a unique name to use when, for eaxmple, starting -%% a new server. -%%------------------------------------------------------------ -create_name() -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',MSec, '_', Sec, '_', USec]). - %%--------------- END OF MODULE ------------------------------ diff --git a/lib/cosNotification/src/cosNotification_eventDB.erl b/lib/cosNotification/src/cosNotification_eventDB.erl index 89332d53f2..f8e2384d15 100644 --- a/lib/cosNotification/src/cosNotification_eventDB.erl +++ b/lib/cosNotification/src/cosNotification_eventDB.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -71,10 +71,8 @@ %% that the first and last Key change place. {K1,K2}<->{K2,K1} and %% {K1,K2,K3}<->{K3,K2,K1}. %%---------------------------------------------------------------------- - -module(cosNotification_eventDB). - %%--------------- INCLUDES ----------------------------------- -include_lib("orber/include/corba.hrl"). -include_lib("orber/include/ifr_types.hrl"). @@ -221,16 +219,16 @@ gc_events(DBRef, _Priority) when ?is_TimeoutNotUsed(DBRef) -> gc_events(DBRef, _Priority) when ?is_StopTNotSupported(DBRef) -> ok; gc_events(DBRef, Priority) -> - {M,S,U} = now(), + TS = erlang:monotonic_time(), + {resolution, TR} = lists:keyfind(resolution, 1, erlang:system_info(os_monotonic_time_source)), case get(oe_GC_timestamp) of - Num when {M,S,U} > Num -> - put(oe_GC_timestamp, {M,S+?get_GCTime(DBRef),U}), + Num when TS > Num -> + put(oe_GC_timestamp, TS + ?get_GCTime(DBRef) * TR), spawn_link(?MODULE, gc_start, [DBRef, Priority]); _-> ok end. - %%------------------------------------------------------------ %% function : gc_start %% Arguments: @@ -266,13 +264,13 @@ gc_discard_DB({Key1, Key2, Key3}, DRef) -> %% Returns : %%------------------------------------------------------------ create_FIFO_Key() -> - {M, S, U} = erlang:now(), + {M, S, U} = erlang:timestamp(), -M*1000000000000 - S*1000000 - U. %%------------------------------------------------------------ %% function : convert_FIFO_Key %% Arguments: -%% Returns : A now tuple +%% Returns : A timestamp tuple %% Comment : Used when we must reuse a timestamp, i.e., only %% when we must reorder the DB. %%------------------------------------------------------------ @@ -322,7 +320,7 @@ extract_start_time(#'CosNotification_StructuredEvent' _ -> false end, - convert_time(ST, TRef, now()); + convert_time(ST, TRef, erlang:timestamp()); extract_start_time(_, _, _) -> false. @@ -337,12 +335,12 @@ extract_start_time(_, _, _) -> %% - undefined eq. value needed but no filter associated. %% Now - used when we want to reuse old TimeStamp which %% must be done when changing QoS. -%% Returns : A modified return from now(). +%% Returns : A modified return from erlang:timestamp(). %%------------------------------------------------------------ extract_deadline(_, _, _, _, false) -> false; extract_deadline(Event, DefaultT, StopTSupported, TRef, MappingVal) -> - extract_deadline(Event, DefaultT, StopTSupported, TRef, MappingVal, now()). + extract_deadline(Event, DefaultT, StopTSupported, TRef, MappingVal, erlang:timestamp()). extract_deadline(_, _, _, _, false, _) -> false; @@ -403,14 +401,14 @@ get_time_diff(UTC, TRef) -> UB-LB. check_deadline(DL) when is_tuple(DL) -> - {M,S,U} = now(), + {M,S,U} = erlang:timestamp(), DL >= {-M,-S,-U}; check_deadline(_DL) -> %% This case will cover if no timeout is set. false. check_start_time(ST) when is_tuple(ST) -> - {M,S,U} = now(), + {M,S,U} = erlang:timestamp(), ST >= {-M,-S,-U}; check_start_time(_ST) -> %% This case will cover if no earliest delivery time is set. @@ -1139,8 +1137,10 @@ create_db(QoS, GCTime, GCLimit, TimeRef) -> ?is_TimeoutNotUsed(DBRef), ?is_StopTNotSupported(DBRef) -> ok; true -> - {M,S,U} = now(), - put(oe_GC_timestamp, {M,S+GCTime,U}) + TS = erlang:monotonic_time(), + {resolution, TR} = lists:keyfind(resolution, 1, + erlang:system_info(os_monotonic_time_source)), + put(oe_GC_timestamp, TS+GCTime*TR) end, DBRef. diff --git a/lib/cosNotification/test/notify_test_impl.erl b/lib/cosNotification/test/notify_test_impl.erl index dae7777089..4fe246ef16 100644 --- a/lib/cosNotification/test/notify_test_impl.erl +++ b/lib/cosNotification/test/notify_test_impl.erl @@ -289,10 +289,10 @@ disconnect_pull_supplier(_Self, State) -> %%--------------- LOCAL FUNCTIONS ---------------------------- delay(Obj, Event, Time, Mod, F) -> - io:format("notify_test:delay(~p) TIME: ~p~n",[Event, now()]), + io:format("notify_test:delay(~p) TIME: ~p~n",[Event, erlang:timestamp()]), timer:sleep(Time), Mod:F(Obj, Event), - io:format("notify_test:delay() DONE: ~p~n",[now()]), + io:format("notify_test:delay() DONE: ~p~n",[erlang:timestamp()]), ok. %%--------------- END OF MODULE ------------------------------ diff --git a/lib/cosNotification/vsn.mk b/lib/cosNotification/vsn.mk index 28d6ec71bf..c1affdf0de 100644 --- a/lib/cosNotification/vsn.mk +++ b/lib/cosNotification/vsn.mk @@ -1,2 +1,2 @@ -COSNOTIFICATION_VSN = 1.1.21 +COSNOTIFICATION_VSN = 1.2 diff --git a/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl b/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl index 157b243c53..788518c7bb 100644 --- a/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl +++ b/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -128,7 +128,9 @@ %% {stop, Reason} %%---------------------------------------------------------------------- init({DefMode, AllowedTypes, AllowedProperties, InitProperties, MyType}) -> - Key = term_to_binary({now(), node()}), + Key = term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}), _F = ?write_function(#oe_CosPropertyService{key=Key, properties=InitProperties}), write_result(mnesia:transaction(_F)), diff --git a/lib/cosProperty/src/cosProperty.app.src b/lib/cosProperty/src/cosProperty.app.src index b977bb5984..7fad7a602a 100644 --- a/lib/cosProperty/src/cosProperty.app.src +++ b/lib/cosProperty/src/cosProperty.app.src @@ -43,5 +43,5 @@ {env, []}, {mod, {cosProperty, []}}, {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","mnesia-4.12", - "kernel-3.0","erts-6.0"]} + "kernel-3.0","erts-7.0"]} ]}. diff --git a/lib/cosProperty/src/cosProperty.erl b/lib/cosProperty/src/cosProperty.erl index 2368ee3db6..57c35dedf9 100644 --- a/lib/cosProperty/src/cosProperty.erl +++ b/lib/cosProperty/src/cosProperty.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -406,8 +406,9 @@ type_check(Obj, Mod) -> %% Effect : %%------------------------------------------------------------ create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]). %%--------------- END OF MODULE ------------------------------ diff --git a/lib/cosProperty/vsn.mk b/lib/cosProperty/vsn.mk index 0f546a2da8..d96508c2d2 100644 --- a/lib/cosProperty/vsn.mk +++ b/lib/cosProperty/vsn.mk @@ -1,2 +1,2 @@ -COSPROPERTY_VSN = 1.1.17 +COSPROPERTY_VSN = 1.2 diff --git a/lib/cosTime/src/CosTime_TimeService_impl.erl b/lib/cosTime/src/CosTime_TimeService_impl.erl index bac4ae087c..f44e7ba2f4 100644 --- a/lib/cosTime/src/CosTime_TimeService_impl.erl +++ b/lib/cosTime/src/CosTime_TimeService_impl.erl @@ -166,7 +166,7 @@ new_interval(_, _, _, _) -> create_universal_time() -> %% Time is supposed to be #100 nano-secs passed. %% We add micro secs for a greater precision. - {MS,S,US} = now(), + {MS,S,US} = erlang:timestamp(), case catch calendar:datetime_to_gregorian_seconds( calendar:now_to_universal_time({MS,S,US})) of Secs when is_integer(Secs) -> diff --git a/lib/cosTime/src/cosTime.app.src b/lib/cosTime/src/cosTime.app.src index cd01de35cb..ac71fe1b29 100644 --- a/lib/cosTime/src/cosTime.app.src +++ b/lib/cosTime/src/cosTime.app.src @@ -27,6 +27,6 @@ {applications, [orber, stdlib, kernel]}, {env, []}, {mod, {cosTime, []}}, - {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0", + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0", "cosEvent-2.1.15"]} ]}. diff --git a/lib/cosTime/src/cosTime.erl b/lib/cosTime/src/cosTime.erl index f7d03650af..45f305df39 100644 --- a/lib/cosTime/src/cosTime.erl +++ b/lib/cosTime/src/cosTime.erl @@ -333,8 +333,9 @@ type_check(Obj, Mod) -> %%------------------------------------------------------------ create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]). %%--------------- END OF MODULE ------------------------------ diff --git a/lib/cosTime/src/cosTimeApp.hrl b/lib/cosTime/src/cosTimeApp.hrl index f3082816f7..bdf0bf7278 100644 --- a/lib/cosTime/src/cosTimeApp.hrl +++ b/lib/cosTime/src/cosTimeApp.hrl @@ -41,7 +41,7 @@ -define(max_TimeT, 18446744073709551616). %% The calendar module uses year 0 as base for gregorian functions. -%% 'ABSOULTE_TIME_DIFF' is #seconfs from year 0 until 15 october 1582, 00:00. +%% 'ABSOULTE_TIME_DIFF' is #seconds from year 0 until 15 october 1582, 00:00. -define(ABSOLUTE_TIME_DIFF, 49947926400). %% As above but diff year 0 to 00:00 GMT, January 1, 1970 -define(STANDARD_TIME_DIFF, 62167219200). diff --git a/lib/cosTime/vsn.mk b/lib/cosTime/vsn.mk index 9e9e5c0250..32416f0087 100644 --- a/lib/cosTime/vsn.mk +++ b/lib/cosTime/vsn.mk @@ -1,3 +1,2 @@ -COSTIME_VSN = 1.1.14 - +COSTIME_VSN = 1.2 diff --git a/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl b/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl index 36e37e2d5f..3954f04ad3 100644 --- a/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl +++ b/lib/cosTransactions/src/CosTransactions_TransactionFactory_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -145,8 +145,8 @@ create(_Self, State, TimeOut) when is_integer(TimeOut) -> _ -> if TimeOut > 0 -> - {MegaSecs, Secs, _Microsecs} = erlang:now(), - EState2 = ?tr_set_alarm(EState, MegaSecs*1000000+Secs+TimeOut), + TimeStampSec = erlang:monotonic_time(seconds), + EState2 = ?tr_set_alarm(EState, TimeStampSec+TimeOut), EState3 = ?tr_set_timeout(EState2, TimeOut*1000), ETraP = ?tr_start_child(?SUP_ETRAP(EState3)), {reply, ETraP, State}; diff --git a/lib/cosTransactions/src/ETraP_Common.erl b/lib/cosTransactions/src/ETraP_Common.erl index dd68e9b038..dca1c1aaa9 100644 --- a/lib/cosTransactions/src/ETraP_Common.erl +++ b/lib/cosTransactions/src/ETraP_Common.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -86,8 +86,9 @@ get_option(Key, OptionList, DefaultList) -> %%------------------------------------------------------------ create_name(Name,Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',Name,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Name,'_',Time,'_',Unique]). %%------------------------------------------------------------ %% function : create_name/1 @@ -98,8 +99,9 @@ create_name(Name,Type) -> %%------------------------------------------------------------ create_name(Type) -> - {MSec, Sec, USec} = erlang:now(), - lists:concat(['oe_',node(),'_',Type,'_',MSec, '_', Sec, '_', USec]). + Time = erlang:system_time(), + Unique = erlang:unique_integer([positive]), + lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]). %%------------------------------------------------------------ %% function : try_timeout @@ -114,10 +116,9 @@ try_timeout(TimeoutAt) -> infinity -> false; _-> - {MegaSecs, Secs, _Microsecs} = erlang:now(), - Time = MegaSecs*1000000+Secs, + TimeSec = erlang:monotonic_time(seconds), if - Time < TimeoutAt -> + TimeSec < TimeoutAt -> false; true -> true diff --git a/lib/cosTransactions/src/ETraP_Server_impl.erl b/lib/cosTransactions/src/ETraP_Server_impl.erl index e2c5d88f9d..db23d6c166 100644 --- a/lib/cosTransactions/src/ETraP_Server_impl.erl +++ b/lib/cosTransactions/src/ETraP_Server_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -38,7 +38,8 @@ %% Log files are created in the current directory, which is why the %% application requires read/write rights for current directory. The %% file name looks like: -%% "oe_nonode@nohost_subc_939_383117_295538" (the last part is now()) +%% "oe_nonode@nohost_subc_1429872479809947099_438" (the two last parts are +%% erlang:system_time() and erlang:unique_integer([positive])) %% It is equal to what the object is started as, i.e., {regname, {global, X}}. %% %% If the application is unable to read the log it will exit and the diff --git a/lib/cosTransactions/src/cosTransactions.app.src b/lib/cosTransactions/src/cosTransactions.app.src index 6b99915ad6..074d82f487 100644 --- a/lib/cosTransactions/src/cosTransactions.app.src +++ b/lib/cosTransactions/src/cosTransactions.app.src @@ -40,5 +40,5 @@ {applications, [orber, stdlib, kernel]}, {env, []}, {mod, {cosTransactions, []}}, - {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-6.0"]} + {runtime_dependencies, ["stdlib-2.0","orber-3.6.27","kernel-3.0","erts-7.0"]} ]}. diff --git a/lib/cosTransactions/vsn.mk b/lib/cosTransactions/vsn.mk index 7aed212523..929f8c73d1 100644 --- a/lib/cosTransactions/vsn.mk +++ b/lib/cosTransactions/vsn.mk @@ -1 +1 @@ -COSTRANSACTIONS_VSN = 1.2.14 +COSTRANSACTIONS_VSN = 1.3 diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index aa99f2236e..22c430bcd3 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -2502,7 +2502,7 @@ static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a ErlNifBinary key_bin, ivec_bin, data_bin; unsigned char ivec[16]; int enc, i = 0, outlen = 0; - EVP_CIPHER_CTX *ctx = NULL; + EVP_CIPHER_CTX ctx; const EVP_CIPHER *cipher = NULL; unsigned char* ret_ptr; ERL_NIF_TERM ret; @@ -2524,8 +2524,7 @@ static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a else enc = 0; - if (!(ctx = EVP_CIPHER_CTX_new())) - return enif_make_badarg(env); + EVP_CIPHER_CTX_init(&ctx); if (key_bin.size == 16) cipher = EVP_aes_128_cbc(); @@ -2538,20 +2537,20 @@ static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a at the end of the buffer for EVP calls. let's be safe */ ret_ptr = enif_make_new_binary(env, data_bin.size + 16*3, &ret); - if (EVP_CipherInit_ex(ctx, cipher, NULL, key_bin.data, ivec, enc) != 1) + if (EVP_CipherInit_ex(&ctx, cipher, NULL, key_bin.data, ivec, enc) != 1) return enif_make_badarg(env); /* disable padding, we only handle whole blocks */ - EVP_CIPHER_CTX_set_padding(ctx, 0); + EVP_CIPHER_CTX_set_padding(&ctx, 0); - if (EVP_CipherUpdate(ctx, ret_ptr, &i, data_bin.data, data_bin.size) != 1) + if (EVP_CipherUpdate(&ctx, ret_ptr, &i, data_bin.data, data_bin.size) != 1) return enif_make_badarg(env); outlen += i; - if (EVP_CipherFinal_ex(ctx, ret_ptr + outlen, &i) != 1) + if (EVP_CipherFinal_ex(&ctx, ret_ptr + outlen, &i) != 1) return enif_make_badarg(env); outlen += i; - EVP_CIPHER_CTX_free(ctx); + EVP_CIPHER_CTX_cleanup(&ctx); CONSUME_REDS(env,data_bin); diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index 605d61e8e4..a0ebc4b3dd 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -30,6 +30,23 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 3.5</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Extend block_encrypt/decrypt for aes_cfb8 and aes_cfb128 + to accept keys of length 128, 192 and 256 bits. Before + only 128 bit keys were accepted.</p> + <p> + Own Id: OTP-12467</p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 3.4.2</title> <section><title>Improvements and New Features</title> diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index b87685cb3f..8489b59562 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 3.4.2 +CRYPTO_VSN = 3.5 diff --git a/lib/debugger/doc/src/notes.xml b/lib/debugger/doc/src/notes.xml index b4baa2a1cd..7384189a6f 100644 --- a/lib/debugger/doc/src/notes.xml +++ b/lib/debugger/doc/src/notes.xml @@ -32,6 +32,21 @@ <p>This document describes the changes made to the Debugger application.</p> +<section><title>Debugger 4.0.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix save state which did not work on Mac.</p> + <p> + Own Id: OTP-12378</p> + </item> + </list> + </section> + +</section> + <section><title>Debugger 4.0.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/debugger/src/dbg_icmd.erl b/lib/debugger/src/dbg_icmd.erl index ce12c1beb3..b9d7506cde 100644 --- a/lib/debugger/src/dbg_icmd.erl +++ b/lib/debugger/src/dbg_icmd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 96f9f91808..e6da8409d4 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -650,24 +650,19 @@ expr({tuple,Line,Es0}, Bs0, Ieval) -> {value,list_to_tuple(Vs),Bs}; %% Map -expr({map,Line,Fs0}, Bs0, Ieval) -> - {Fs,Bs} = eval_map_fields(Fs0, Bs0, Ieval#ieval{line=Line,top=false}), - Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi) end, - #{}, Fs), - {value,Value,Bs}; +expr({map,Line,Fs}, Bs0, Ieval) -> + {Map,Bs} = eval_new_map_fields(Fs, Bs0, Ieval#ieval{line=Line,top=false}, + fun expr/3), + {value,Map,Bs}; expr({map,Line,E0,Fs0}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line,top=false}, {value,E,Bs1} = expr(E0, Bs0, Ieval), - case E of - #{} -> - {Fs,Bs2} = eval_map_fields(Fs0, Bs0, Ieval), - Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi); - ({map_exact,K,V}, Mi) -> maps:update(K,V,Mi) - end, E, Fs), - {value,Value,merge_bindings(Bs2, Bs1, Ieval)}; - _ -> - exception(error, {badarg,E}, Bs1, Ieval) - end; + {Fs,Bs2} = eval_map_fields(Fs0, Bs0, Ieval), + _ = maps:put(k, v, E), %Validate map. + Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi); + ({map_exact,K,V}, Mi) -> maps:update(K,V,Mi) + end, E, Fs), + {value,Value,merge_bindings(Bs2, Bs1, Ieval)}; %% A block of statements expr({block,Line,Es},Bs,Ieval) -> seq(Es, Bs, Ieval#ieval{line=Line}); @@ -1477,11 +1472,13 @@ guard_expr({cons,_,H0,T0}, Bs) -> guard_expr({tuple,_,Es0}, Bs) -> {values,Es} = guard_exprs(Es0, Bs), {value,list_to_tuple(Es)}; -guard_expr({map,_,Fs0}, Bs) -> - Fs = eval_map_fields_guard(Fs0, Bs), - Value = lists:foldl(fun ({map_assoc,K,V}, Mi) -> maps:put(K,V,Mi) end, - #{}, Fs), - {value,Value}; +guard_expr({map,_,Fs}, Bs0) -> + F = fun (G0, B0, _) -> + {value,G} = guard_expr(G0, B0), + {value,G,B0} + end, + {Map,_} = eval_new_map_fields(Fs, Bs0, #ieval{top=false}, F), + {value,Map}; guard_expr({map,_,E0,Fs0}, Bs) -> {value,E} = guard_expr(E0, Bs), Fs = eval_map_fields_guard(Fs0, Bs), @@ -1530,6 +1527,17 @@ eval_map_fields([{map_field_exact,Line,K0,V0}|Fs], Bs0, Ieval0, F, Acc) -> eval_map_fields([], Bs, _Ieval, _F, Acc) -> {lists:reverse(Acc),Bs}. +eval_new_map_fields(Fs, Bs0, Ieval, F) -> + eval_new_map_fields(Fs, Bs0, Ieval, F, []). + +eval_new_map_fields([{Line,K0,V0}|Fs], Bs0, Ieval0, F, Acc) -> + Ieval = Ieval0#ieval{line=Line}, + {value,K,Bs1} = F(K0, Bs0, Ieval), + {value,V,Bs2} = F(V0, Bs1, Ieval), + eval_new_map_fields(Fs, Bs2, Ieval0, F, [{K,V}|Acc]); +eval_new_map_fields([], Bs, _, _, Acc) -> + {maps:from_list(lists:reverse(Acc)),Bs}. + %% match(Pattern,Term,Bs) -> {match,Bs} | nomatch match(Pat, Term, Bs) -> try match1(Pat, Term, Bs, Bs) diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index ad05a7c529..379ffe8ce4 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -163,11 +163,11 @@ clauses([C0|Cs]) -> [C1|clauses(Cs)]; clauses([]) -> []. -clause({clause,Line,H0,G0,B0}, Lc) -> +clause({clause,Anno,H0,G0,B0}, Lc) -> H1 = head(H0), G1 = guard(G0), B1 = exprs(B0, Lc), - {clause,Line,H1,G1,B1}. + {clause,ln(Anno),H1,G1,B1}. head(Ps) -> patterns(Ps). @@ -181,46 +181,46 @@ patterns([]) -> []. %% N.B. Only valid patterns are included here. -pattern({var,Line,V}) -> {var,Line,V}; -pattern({char,Line,I}) -> {value,Line,I}; -pattern({integer,Line,I}) -> {value,Line,I}; -pattern({match,Line,Pat1,Pat2}) -> - {match,Line,pattern(Pat1),pattern(Pat2)}; -pattern({float,Line,F}) -> {value,Line,F}; -pattern({atom,Line,A}) -> {value,Line,A}; -pattern({string,Line,S}) -> {value,Line,S}; -pattern({nil,Line}) -> {value,Line,[]}; -pattern({cons,Line,H0,T0}) -> +pattern({var,Anno,V}) -> {var,ln(Anno),V}; +pattern({char,Anno,I}) -> {value,ln(Anno),I}; +pattern({integer,Anno,I}) -> {value,ln(Anno),I}; +pattern({match,Anno,Pat1,Pat2}) -> + {match,ln(Anno),pattern(Pat1),pattern(Pat2)}; +pattern({float,Anno,F}) -> {value,ln(Anno),F}; +pattern({atom,Anno,A}) -> {value,ln(Anno),A}; +pattern({string,Anno,S}) -> {value,ln(Anno),S}; +pattern({nil,Anno}) -> {value,ln(Anno),[]}; +pattern({cons,Anno,H0,T0}) -> H1 = pattern(H0), T1 = pattern(T0), - {cons,Line,H1,T1}; -pattern({tuple,Line,Ps0}) -> + {cons,ln(Anno),H1,T1}; +pattern({tuple,Anno,Ps0}) -> Ps1 = pattern_list(Ps0), - {tuple,Line,Ps1}; -pattern({map,Line,Fs0}) -> + {tuple,ln(Anno),Ps1}; +pattern({map,Anno,Fs0}) -> Fs1 = lists:map(fun ({map_field_exact,L,K,V}) -> {map_field_exact,L,expr(K, false),pattern(V)} end, Fs0), - {map,Line,Fs1}; -pattern({op,_,'-',{integer,Line,I}}) -> - {value,Line,-I}; -pattern({op,_,'+',{integer,Line,I}}) -> - {value,Line,I}; -pattern({op,_,'-',{char,Line,I}}) -> - {value,Line,-I}; -pattern({op,_,'+',{char,Line,I}}) -> - {value,Line,I}; -pattern({op,_,'-',{float,Line,I}}) -> - {value,Line,-I}; -pattern({op,_,'+',{float,Line,I}}) -> - {value,Line,I}; -pattern({bin,Line,Grp}) -> + {map,ln(Anno),Fs1}; +pattern({op,_,'-',{integer,Anno,I}}) -> + {value,ln(Anno),-I}; +pattern({op,_,'+',{integer,Anno,I}}) -> + {value,ln(Anno),I}; +pattern({op,_,'-',{char,Anno,I}}) -> + {value,ln(Anno),-I}; +pattern({op,_,'+',{char,Anno,I}}) -> + {value,ln(Anno),I}; +pattern({op,_,'-',{float,Anno,I}}) -> + {value,ln(Anno),-I}; +pattern({op,_,'+',{float,Anno,I}}) -> + {value,ln(Anno),I}; +pattern({bin,Anno,Grp}) -> Grp1 = pattern_list(Grp), - {bin,Line,Grp1}; -pattern({bin_element,Line,Expr,Size,Type}) -> + {bin,ln(Anno),Grp1}; +pattern({bin_element,Anno,Expr,Size,Type}) -> Expr1 = pattern(Expr), Size1 = expr(Size, false), - {bin_element,Line,Expr1,Size1,Type}. + {bin_element,ln(Anno),Expr1,Size1,Type}. %% These patterns are processed "in parallel" for purposes of variable %% definition etc. @@ -240,90 +240,89 @@ and_guard([G0|Gs]) -> [G1|and_guard(Gs)]; and_guard([]) -> []. -guard_test({call,Line,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) -> +guard_test({call,Anno,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) -> As = gexpr_list(As0), - {safe_bif,Line,erlang,F,As}; -guard_test({op,Line,Op,L0}) -> + {safe_bif,ln(Anno),erlang,F,As}; +guard_test({op,Anno,Op,L0}) -> true = erl_internal:arith_op(Op, 1) orelse %Assertion. erl_internal:bool_op(Op, 1), L1 = gexpr(L0), - {safe_bif,Line,erlang,Op,[L1]}; -guard_test({op,Line,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' -> + {safe_bif,ln(Anno),erlang,Op,[L1]}; +guard_test({op,Anno,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' -> L1 = gexpr(L0), R1 = gexpr(R0), %They see the same variables - {Op,Line,L1,R1}; -guard_test({op,Line,Op,L0,R0}) -> + {Op,ln(Anno),L1,R1}; +guard_test({op,Anno,Op,L0,R0}) -> true = erl_internal:comp_op(Op, 2) orelse %Assertion. erl_internal:bool_op(Op, 2) orelse erl_internal:arith_op(Op, 2), L1 = gexpr(L0), R1 = gexpr(R0), %They see the same variables - {safe_bif,Line,erlang,Op,[L1,R1]}; + {safe_bif,ln(Anno),erlang,Op,[L1,R1]}; guard_test({var,_,_}=V) ->V; % Boolean var -guard_test({atom,Line,true}) -> {value,Line,true}; +guard_test({atom,Anno,true}) -> {value,ln(Anno),true}; %% All other constants at this level means false. -guard_test({atom,Line,_}) -> {value,Line,false}; -guard_test({integer,Line,_}) -> {value,Line,false}; -guard_test({char,Line,_}) -> {value,Line,false}; -guard_test({float,Line,_}) -> {value,Line,false}; -guard_test({string,Line,_}) -> {value,Line,false}; -guard_test({nil,Line}) -> {value,Line,false}; -guard_test({cons,Line,_,_}) -> {value,Line,false}; -guard_test({tuple,Line,_}) -> {value,Line,false}; -guard_test({map,Line,_}) -> {value,Line,false}; -guard_test({map,Line,_,_}) -> {value,Line,false}; -guard_test({bin,Line,_}) -> {value,Line,false}. - -gexpr({var,Line,V}) -> {var,Line,V}; -gexpr({integer,Line,I}) -> {value,Line,I}; -gexpr({char,Line,I}) -> {value,Line,I}; -gexpr({float,Line,F}) -> {value,Line,F}; -gexpr({atom,Line,A}) -> {value,Line,A}; -gexpr({string,Line,S}) -> {value,Line,S}; -gexpr({nil,Line}) -> {value,Line,[]}; -gexpr({cons,Line,H0,T0}) -> +guard_test({atom,Anno,_}) -> {value,ln(Anno),false}; +guard_test({integer,Anno,_}) -> {value,ln(Anno),false}; +guard_test({char,Anno,_}) -> {value,ln(Anno),false}; +guard_test({float,Anno,_}) -> {value,ln(Anno),false}; +guard_test({string,Anno,_}) -> {value,ln(Anno),false}; +guard_test({nil,Anno}) -> {value,ln(Anno),false}; +guard_test({cons,Anno,_,_}) -> {value,ln(Anno),false}; +guard_test({tuple,Anno,_}) -> {value,ln(Anno),false}; +guard_test({map,Anno,_}) -> {value,ln(Anno),false}; +guard_test({map,Anno,_,_}) -> {value,ln(Anno),false}; +guard_test({bin,Anno,_}) -> {value,ln(Anno),false}. + +gexpr({var,Anno,V}) -> {var,ln(Anno),V}; +gexpr({integer,Anno,I}) -> {value,ln(Anno),I}; +gexpr({char,Anno,I}) -> {value,ln(Anno),I}; +gexpr({float,Anno,F}) -> {value,ln(Anno),F}; +gexpr({atom,Anno,A}) -> {value,ln(Anno),A}; +gexpr({string,Anno,S}) -> {value,ln(Anno),S}; +gexpr({nil,Anno}) -> {value,ln(Anno),[]}; +gexpr({cons,Anno,H0,T0}) -> case {gexpr(H0),gexpr(T0)} of {{value,Line,H1},{value,Line,T1}} -> {value,Line,[H1|T1]}; - {H1,T1} -> {cons,Line,H1,T1} + {H1,T1} -> {cons,ln(Anno),H1,T1} end; -gexpr({tuple,Line,Es0}) -> +gexpr({tuple,Anno,Es0}) -> Es1 = gexpr_list(Es0), - {tuple,Line,Es1}; -gexpr({map,Line,Fs0}) -> - Fs1 = map_fields(Fs0, fun gexpr/1), - {map,Line,Fs1}; -gexpr({map,Line,E0,Fs0}) -> + {tuple,ln(Anno),Es1}; +gexpr({map,Anno,Fs0}) -> + new_map(Fs0, Anno, fun gexpr/1); +gexpr({map,Anno,E0,Fs0}) -> E1 = gexpr(E0), Fs1 = map_fields(Fs0, fun gexpr/1), - {map,Line,E1,Fs1}; -gexpr({bin,Line,Flds0}) -> + {map,ln(Anno),E1,Fs1}; +gexpr({bin,Anno,Flds0}) -> Flds = gexpr_list(Flds0), - {bin,Line,Flds}; -gexpr({bin_element,Line,Expr0,Size0,Type}) -> + {bin,ln(Anno),Flds}; +gexpr({bin_element,Anno,Expr0,Size0,Type}) -> Expr = gexpr(Expr0), Size = gexpr(Size0), - {bin_element,Line,Expr,Size,Type}; + {bin_element,ln(Anno),Expr,Size,Type}; %%% The previous passes have added the module name 'erlang' to %%% all BIF calls, even in guards. -gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,self}},[]}) -> - {dbg, Line, self, []}; -gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) -> +gexpr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,self}},[]}) -> + {dbg,ln(Anno),self,[]}; +gexpr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) -> As = gexpr_list(As0), - {safe_bif,Line,erlang,F,As}; -gexpr({op,Line,Op,A0}) -> + {safe_bif,ln(Anno),erlang,F,As}; +gexpr({op,Anno,Op,A0}) -> erl_internal:arith_op(Op, 1), A1 = gexpr(A0), - {safe_bif,Line,erlang,Op,[A1]}; -gexpr({op,Line,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' -> + {safe_bif,ln(Anno),erlang,Op,[A1]}; +gexpr({op,Anno,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' -> L1 = gexpr(L0), R1 = gexpr(R0), %They see the same variables - {Op,Line,L1,R1}; -gexpr({op,Line,Op,L0,R0}) -> + {Op,ln(Anno),L1,R1}; +gexpr({op,Anno,Op,L0,R0}) -> true = erl_internal:arith_op(Op, 2) orelse erl_internal:comp_op(Op, 2) orelse erl_internal:bool_op(Op, 2), L1 = gexpr(L0), R1 = gexpr(R0), %They see the same variables - {safe_bif,Line,erlang,Op,[L1,R1]}. + {safe_bif,ln(Anno),erlang,Op,[L1,R1]}. %% These expressions are processed "in parallel" for purposes of variable %% definition etc. @@ -343,175 +342,175 @@ exprs([E0|Es], Lc) -> [E1|exprs(Es, Lc)]; exprs([], _Lc) -> []. -expr({var,Line,V}, _Lc) -> {var,Line,V}; -expr({integer,Line,I}, _Lc) -> {value,Line,I}; -expr({char,Line,I}, _Lc) -> {value,Line,I}; -expr({float,Line,F}, _Lc) -> {value,Line,F}; -expr({atom,Line,A}, _Lc) -> {value,Line,A}; -expr({string,Line,S}, _Lc) -> {value,Line,S}; -expr({nil,Line}, _Lc) -> {value,Line,[]}; -expr({cons,Line,H0,T0}, _Lc) -> +expr({var,Anno,V}, _Lc) -> {var,ln(Anno),V}; +expr({integer,Anno,I}, _Lc) -> {value,ln(Anno),I}; +expr({char,Anno,I}, _Lc) -> {value,ln(Anno),I}; +expr({float,Anno,F}, _Lc) -> {value,ln(Anno),F}; +expr({atom,Anno,A}, _Lc) -> {value,ln(Anno),A}; +expr({string,Anno,S}, _Lc) -> {value,ln(Anno),S}; +expr({nil,Anno}, _Lc) -> {value,ln(Anno),[]}; +expr({cons,Anno,H0,T0}, _Lc) -> case {expr(H0, false),expr(T0, false)} of {{value,Line,H1},{value,Line,T1}} -> {value,Line,[H1|T1]}; - {H1,T1} -> {cons,Line,H1,T1} + {H1,T1} -> {cons,ln(Anno),H1,T1} end; -expr({tuple,Line,Es0}, _Lc) -> +expr({tuple,Anno,Es0}, _Lc) -> Es1 = expr_list(Es0), - {tuple,Line,Es1}; -expr({map,Line,Fs0}, _Lc) -> - Fs1 = map_fields(Fs0), - {map,Line,Fs1}; -expr({map,Line,E0,Fs0}, _Lc) -> + {tuple,ln(Anno),Es1}; +expr({map,Anno,Fs}, _Lc) -> + new_map(Fs, Anno, fun (E) -> expr(E, false) end); +expr({map,Anno,E0,Fs0}, _Lc) -> E1 = expr(E0, false), Fs1 = map_fields(Fs0), - {map,Line,E1,Fs1}; -expr({block,Line,Es0}, Lc) -> + {map,ln(Anno),E1,Fs1}; +expr({block,Anno,Es0}, Lc) -> %% Unfold block into a sequence. Es1 = exprs(Es0, Lc), - {block,Line,Es1}; -expr({'if',Line,Cs0}, Lc) -> + {block,ln(Anno),Es1}; +expr({'if',Anno,Cs0}, Lc) -> Cs1 = icr_clauses(Cs0, Lc), - {'if',Line,Cs1}; -expr({'case',Line,E0,Cs0}, Lc) -> + {'if',ln(Anno),Cs1}; +expr({'case',Anno,E0,Cs0}, Lc) -> E1 = expr(E0, false), Cs1 = icr_clauses(Cs0, Lc), - {'case',Line,E1,Cs1}; -expr({'receive',Line,Cs0}, Lc) -> + {'case',ln(Anno),E1,Cs1}; +expr({'receive',Anno,Cs0}, Lc) -> Cs1 = icr_clauses(Cs0, Lc), - {'receive',Line,Cs1}; -expr({'receive',Line,Cs0,To0,ToEs0}, Lc) -> + {'receive',ln(Anno),Cs1}; +expr({'receive',Anno,Cs0,To0,ToEs0}, Lc) -> To1 = expr(To0, false), ToEs1 = exprs(ToEs0, Lc), Cs1 = icr_clauses(Cs0, Lc), - {'receive',Line,Cs1,To1,ToEs1}; -expr({'fun',Line,{clauses,Cs0},{_,_,Name}}, _Lc) when is_atom(Name) -> + {'receive',ln(Anno),Cs1,To1,ToEs1}; +expr({'fun',Anno,{clauses,Cs0},{_,_,Name}}, _Lc) when is_atom(Name) -> %% New R10B-2 format (abstract_v2). Cs = fun_clauses(Cs0), - {make_fun,Line,Name,Cs}; -expr({'fun',Line,{function,F,A},{_Index,_OldUniq,Name}}, _Lc) -> + {make_fun,ln(Anno),Name,Cs}; +expr({'fun',Anno,{function,F,A},{_Index,_OldUniq,Name}}, _Lc) -> %% New R8 format (abstract_v2). + Line = ln(Anno), As = new_vars(A, Line), Cs = [{clause,Line,As,[],[{local_call,Line,F,As,true}]}], {make_fun,Line,Name,Cs}; -expr({named_fun,Line,FName,Cs0,{_,_,Name}}, _Lc) when is_atom(Name) -> +expr({named_fun,Anno,FName,Cs0,{_,_,Name}}, _Lc) when is_atom(Name) -> Cs = fun_clauses(Cs0), - {make_named_fun,Line,Name,FName,Cs}; -expr({'fun',Line,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Lc) + {make_named_fun,ln(Anno),Name,FName,Cs}; +expr({'fun',Anno,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Lc) when 0 =< A, A =< 255 -> %% New format in R15 for fun M:F/A (literal values). - {value,Line,erlang:make_fun(M, F, A)}; -expr({'fun',Line,{function,M,F,A}}, _Lc) -> + {value,ln(Anno),erlang:make_fun(M, F, A)}; +expr({'fun',Anno,{function,M,F,A}}, _Lc) -> %% New format in R15 for fun M:F/A (one or more variables). MFA = expr_list([M,F,A]), - {make_ext_fun,Line,MFA}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,self}},[]}, _Lc) -> - {dbg,Line,self,[]}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,get_stacktrace}},[]}, _Lc) -> - {dbg,Line,get_stacktrace,[]}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,throw}},[_]=As}, _Lc) -> - {dbg,Line,throw,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,error}},[_]=As}, _Lc) -> - {dbg,Line,error,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,exit}},[_]=As}, _Lc) -> - {dbg,Line,exit,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,raise}},[_,_,_]=As}, _Lc) -> - {dbg,Line,raise,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,apply}},[_,_,_]=As0}, Lc) -> + {make_ext_fun,ln(Anno),MFA}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,self}},[]}, _Lc) -> + {dbg,ln(Anno),self,[]}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,get_stacktrace}},[]}, _Lc) -> + {dbg,ln(Anno),get_stacktrace,[]}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,throw}},[_]=As}, _Lc) -> + {dbg,ln(Anno),throw,expr_list(As)}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,error}},[_]=As}, _Lc) -> + {dbg,ln(Anno),error,expr_list(As)}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,exit}},[_]=As}, _Lc) -> + {dbg,ln(Anno),exit,expr_list(As)}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,raise}},[_,_,_]=As}, _Lc) -> + {dbg,ln(Anno),raise,expr_list(As)}; +expr({call,Anno,{remote,_,{atom,_,erlang},{atom,_,apply}},[_,_,_]=As0}, Lc) -> As = expr_list(As0), - {apply,Line,As,Lc}; -expr({call,Line,{remote,_,{atom,_,Mod},{atom,_,Func}},As0}, Lc) -> + {apply,ln(Anno),As,Lc}; +expr({call,Anno,{remote,_,{atom,_,Mod},{atom,_,Func}},As0}, Lc) -> As = expr_list(As0), case erlang:is_builtin(Mod, Func, length(As)) of false -> - {call_remote,Line,Mod,Func,As,Lc}; + {call_remote,ln(Anno),Mod,Func,As,Lc}; true -> case bif_type(Mod, Func, length(As0)) of - safe -> {safe_bif,Line,Mod,Func,As}; - unsafe ->{bif,Line,Mod,Func,As} + safe -> {safe_bif,ln(Anno),Mod,Func,As}; + unsafe ->{bif,ln(Anno),Mod,Func,As} end end; -expr({call,Line,{remote,_,Mod0,Func0},As0}, Lc) -> +expr({call,Anno,{remote,_,Mod0,Func0},As0}, Lc) -> %% New R8 format (abstract_v2). Mod = expr(Mod0, false), Func = expr(Func0, false), As = consify(expr_list(As0)), - {apply,Line,[Mod,Func,As],Lc}; -expr({call,Line,{atom,_,Func},As0}, Lc) -> + {apply,ln(Anno),[Mod,Func,As],Lc}; +expr({call,Anno,{atom,_,Func},As0}, Lc) -> As = expr_list(As0), - {local_call,Line,Func,As,Lc}; -expr({call,Line,Fun0,As0}, Lc) -> + {local_call,ln(Anno),Func,As,Lc}; +expr({call,Anno,Fun0,As0}, Lc) -> Fun = expr(Fun0, false), As = expr_list(As0), - {apply_fun,Line,Fun,As,Lc}; -expr({'catch',Line,E0}, _Lc) -> + {apply_fun,ln(Anno),Fun,As,Lc}; +expr({'catch',Anno,E0}, _Lc) -> %% No new variables added. E1 = expr(E0, false), - {'catch',Line,E1}; -expr({'try',Line,Es0,CaseCs0,CatchCs0,As0}, Lc) -> + {'catch',ln(Anno),E1}; +expr({'try',Anno,Es0,CaseCs0,CatchCs0,As0}, Lc) -> %% No new variables added. Es = expr_list(Es0), CaseCs = icr_clauses(CaseCs0, Lc), CatchCs = icr_clauses(CatchCs0, Lc), As = expr_list(As0), - {'try',Line,Es,CaseCs,CatchCs,As}; -expr({lc,Line,E0,Gs0}, _Lc) -> %R8. + {'try',ln(Anno),Es,CaseCs,CatchCs,As}; +expr({lc,Anno,E0,Gs0}, _Lc) -> %R8. Gs = lists:map(fun ({generate,L,P0,Qs}) -> - {generate,L,expr(P0, false),expr(Qs, false)}; + {generate,L,pattern(P0),expr(Qs, false)}; ({b_generate,L,P0,Qs}) -> %R12. - {b_generate,L,expr(P0, false),expr(Qs, false)}; + {b_generate,L,pattern(P0),expr(Qs, false)}; (Expr) -> case erl_lint:is_guard_test(Expr) of true -> {guard,guard([[Expr]])}; false -> expr(Expr, false) end end, Gs0), - {lc,Line,expr(E0, false),Gs}; -expr({bc,Line,E0,Gs0}, _Lc) -> %R12. + {lc,ln(Anno),expr(E0, false),Gs}; +expr({bc,Anno,E0,Gs0}, _Lc) -> %R12. Gs = lists:map(fun ({generate,L,P0,Qs}) -> - {generate,L,expr(P0, false),expr(Qs, false)}; + {generate,L,pattern(P0),expr(Qs, false)}; ({b_generate,L,P0,Qs}) -> %R12. - {b_generate,L,expr(P0, false),expr(Qs, false)}; + {b_generate,L,pattern(P0),expr(Qs, false)}; (Expr) -> case erl_lint:is_guard_test(Expr) of true -> {guard,guard([[Expr]])}; false -> expr(Expr, false) end end, Gs0), - {bc,Line,expr(E0, false),Gs}; -expr({match,Line,P0,E0}, _Lc) -> + {bc,ln(Anno),expr(E0, false),Gs}; +expr({match,Anno,P0,E0}, _Lc) -> E1 = expr(E0, false), P1 = pattern(P0), - {match,Line,P1,E1}; -expr({op,Line,Op,A0}, _Lc) -> + {match,ln(Anno),P1,E1}; +expr({op,Anno,Op,A0}, _Lc) -> A1 = expr(A0, false), - {op,Line,Op,[A1]}; -expr({op,Line,'++',L0,R0}, _Lc) -> + {op,ln(Anno),Op,[A1]}; +expr({op,Anno,'++',L0,R0}, _Lc) -> L1 = expr(L0, false), R1 = expr(R0, false), %They see the same variables - {op,Line,append,[L1,R1]}; -expr({op,Line,'--',L0,R0}, _Lc) -> + {op,ln(Anno),append,[L1,R1]}; +expr({op,Anno,'--',L0,R0}, _Lc) -> L1 = expr(L0, false), R1 = expr(R0, false), %They see the same variables - {op,Line,subtract,[L1,R1]}; -expr({op,Line,'!',L0,R0}, _Lc) -> + {op,ln(Anno),subtract,[L1,R1]}; +expr({op,Anno,'!',L0,R0}, _Lc) -> L1 = expr(L0, false), R1 = expr(R0, false), %They see the same variables - {send,Line,L1,R1}; -expr({op,Line,Op,L0,R0}, _Lc) when Op =:= 'andalso'; Op =:= 'orelse' -> + {send,ln(Anno),L1,R1}; +expr({op,Anno,Op,L0,R0}, _Lc) when Op =:= 'andalso'; Op =:= 'orelse' -> L1 = expr(L0, false), R1 = expr(R0, false), %They see the same variables - {Op,Line,L1,R1}; -expr({op,Line,Op,L0,R0}, _Lc) -> + {Op,ln(Anno),L1,R1}; +expr({op,Anno,Op,L0,R0}, _Lc) -> L1 = expr(L0, false), R1 = expr(R0, false), %They see the same variables - {op,Line,Op,[L1,R1]}; -expr({bin,Line,Grp}, _Lc) -> + {op,ln(Anno),Op,[L1,R1]}; +expr({bin,Anno,Grp}, _Lc) -> Grp1 = expr_list(Grp), - {bin,Line,Grp1}; -expr({bin_element,Line,Expr,Size,Type}, _Lc) -> + {bin,ln(Anno),Grp1}; +expr({bin_element,Anno,Expr,Size,Type}, _Lc) -> Expr1 = expr(Expr, false), Size1 = expr(Size, false), - {bin_element,Line,Expr1,Size1,Type}; + {bin_element,ln(Anno),Expr1,Size1,Type}; expr(Other, _Lc) -> exit({?MODULE,{unknown_expr,Other}}). @@ -519,7 +518,6 @@ consify([A|As]) -> {cons,0,A,consify(As)}; consify([]) -> {value,0,[]}. - %% -type expr_list([Expression]) -> [Expression]. %% These expressions are processed "in parallel" for purposes of variable %% definition etc. @@ -534,17 +532,35 @@ icr_clauses([C0|Cs], Lc) -> [C1|icr_clauses(Cs, Lc)]; icr_clauses([], _) -> []. -fun_clauses([{clause,L,H,G,B}|Cs]) -> - [{clause,L,head(H),guard(G),exprs(B, true)}|fun_clauses(Cs)]; +fun_clauses([{clause,A,H,G,B}|Cs]) -> + [{clause,ln(A),head(H),guard(G),exprs(B, true)}|fun_clauses(Cs)]; fun_clauses([]) -> []. + +new_map(Fs0, Anno, F) -> + Line = ln(Anno), + Fs1 = map_fields(Fs0, F), + Fs2 = [{ln(A),K,V} || {map_field_assoc,A,K,V} <- Fs1], + try + {value,Line,map_literal(Fs2, #{})} + catch + throw:not_literal -> + {map,Line,Fs2} + end. + +map_literal([{_,{value,_,K},{value,_,V}}|T], M) -> + map_literal(T, maps:put(K, V, M)); +map_literal([_|_], _) -> + throw(not_literal); +map_literal([], M) -> M. + map_fields(Fs) -> map_fields(Fs, fun (E) -> expr(E, false) end). -map_fields([{map_field_assoc,L,N,V}|Fs], F) -> - [{map_field_assoc,L,F(N),F(V)}|map_fields(Fs)]; -map_fields([{map_field_exact,L,N,V}|Fs], F) -> - [{map_field_exact,L,F(N),F(V)}|map_fields(Fs)]; +map_fields([{map_field_assoc,A,N,V}|Fs], F) -> + [{map_field_assoc,ln(A),F(N),F(V)}|map_fields(Fs)]; +map_fields([{map_field_exact,A,N,V}|Fs], F) -> + [{map_field_exact,ln(A),F(N),F(V)}|map_fields(Fs)]; map_fields([], _) -> []. %% new_var_name() -> VarName. @@ -564,6 +580,9 @@ new_vars(N, L, Vs) when N > 0 -> new_vars(N-1, L, [V|Vs]); new_vars(0, _, Vs) -> Vs. +ln(Anno) -> + erl_anno:line(Anno). + bif_type(erlang, Name, Arity) -> case erl_internal:guard_bif(Name, Arity) of true -> diff --git a/lib/debugger/src/int.erl b/lib/debugger/src/int.erl index 908390ce50..33954ca82c 100644 --- a/lib/debugger/src/int.erl +++ b/lib/debugger/src/int.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl index 9d7ef238e3..cda5c97ec4 100644 --- a/lib/debugger/test/int_eval_SUITE.erl +++ b/lib/debugger/test/int_eval_SUITE.erl @@ -293,7 +293,7 @@ stacktrace(Config) when is_list(Config) -> maps(Config) when is_list(Config) -> Fun = fun () -> ?IM:empty_map_update([camembert]) end, - {'EXIT',{{badarg,[camembert]},_}} = spawn_eval(Fun), + {'EXIT',{{badmap,[camembert]},_}} = spawn_eval(Fun), [#{hello := 0, price := 0}] = spawn_eval(fun () -> ?IM:update_in_fun() end), ok. diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl index e525484a8e..12fdd184b8 100644 --- a/lib/debugger/test/map_SUITE.erl +++ b/lib/debugger/test/map_SUITE.erl @@ -24,12 +24,17 @@ ]). -export([ - t_build_and_match_literals/1, - t_update_literals/1,t_match_and_update_literals/1, + 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_exact/1, - t_guard_bifs/1, t_guard_sequence/1, t_guard_update/1, - t_guard_receive/1, t_guard_fun/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_list_comprehension/1, t_map_sort_literals/1, t_map_size/1, @@ -90,12 +95,17 @@ suite() -> []. all() -> [ - t_build_and_match_literals, - t_update_literals, t_match_and_update_literals, + 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_exact, - t_guard_bifs, t_guard_sequence, t_guard_update, - t_guard_receive,t_guard_fun, t_list_comprehension, + 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_map_sort_literals, t_build_and_match_aliasing, @@ -189,6 +199,462 @@ t_build_and_match_literals(Config) when is_list(Config) -> {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), ok. +t_build_and_match_literals_large(Config) when is_list(Config) -> + % normal non-repeating + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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 = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10", + 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11", + 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12", + 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13", + 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14", + + 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15", + 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16", + 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17", + 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18", + 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19", + + 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"), + 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"), + 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"), + 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"), + 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"), + + 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"), + 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"), + 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"), + 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"), + 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"), + + #{ one => small, map => key } => id("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" } => id("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(id(#{})), 1 = map_size(id(#{a=>1})), @@ -205,9 +671,10 @@ t_map_size(Config) when is_list(Config) -> false = map_is_size(M#{ "c" => 2}, 2), %% Error cases. - {'EXIT',{badarg,_}} = (catch map_size([])), - {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)), - {'EXIT',{badarg,_}} = (catch map_size(1)), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch map_size(T)) + end), ok. map_is_size(M,N) when map_size(M) =:= N -> true; @@ -221,13 +688,72 @@ t_update_literals(Config) when is_list(Config) -> ]), ok. +t_update_literals_large(Config) when is_list(Config) -> + Map = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10", + 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11", + 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12", + 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13", + 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14", + + 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15", + 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16", + 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17", + 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18", + 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19", + + 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"), + 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"), + 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"), + 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"), + 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"), + + 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"), + 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"), + 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"), + 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"), + 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"), + + #{ one => small, map => key } => id("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" } => id("large map key 2") }), + + #{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}, + 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} ]), @@ -241,8 +767,77 @@ t_match_and_update_literals(Config) when is_list(Config) -> #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, ok. +t_match_and_update_literals_large(Config) when is_list(Config) -> + Map = id(#{ 10=>id(a0),20=>b0,30=>id("c0"),"40"=>"d0",<<"50">>=>id("e0"),{["00"]}=>"10", + 11=>id(a1),21=>b1,31=>id("c1"),"41"=>"d1",<<"51">>=>id("e1"),{["01"]}=>"11", + 12=>id(a2),22=>b2,32=>id("c2"),"42"=>"d2",<<"52">>=>id("e2"),{["02"]}=>"12", + 13=>id(a3),23=>b3,33=>id("c3"),"43"=>"d3",<<"53">>=>id("e3"),{["03"]}=>"13", + 14=>id(a4),24=>b4,34=>id("c4"),"44"=>"d4",<<"54">>=>id("e4"),{["04"]}=>"14", + + 15=>id(a5),25=>b5,35=>id("c5"),"45"=>"d5",<<"55">>=>id("e5"),{["05"]}=>"15", + 16=>id(a6),26=>b6,36=>id("c6"),"46"=>"d6",<<"56">>=>id("e6"),{["06"]}=>"16", + 17=>id(a7),27=>b7,37=>id("c7"),"47"=>"d7",<<"57">>=>id("e7"),{["07"]}=>"17", + 18=>id(a8),28=>b8,38=>id("c8"),"48"=>"d8",<<"58">>=>id("e8"),{["08"]}=>"18", + 19=>id(a9),29=>b9,39=>id("c9"),"49"=>"d9",<<"59">>=>id("e9"),{["09"]}=>"19", + + 10.0=>fa0,20.0=>id(fb0),30.0=>id("fc0"), + 11.0=>fa1,21.0=>id(fb1),31.0=>id("fc1"), + 12.0=>fa2,22.0=>id(fb2),32.0=>id("fc2"), + 13.0=>fa3,23.0=>id(fb3),33.0=>id("fc3"), + 14.0=>fa4,24.0=>id(fb4),34.0=>id("fc4"), + + 15.0=>fa5,25.0=>id(fb5),35.0=>id("fc5"), + 16.0=>fa6,26.0=>id(fb6),36.0=>id("fc6"), + 17.0=>fa7,27.0=>id(fb7),37.0=>id("fc7"), + 18.0=>fa8,28.0=>id(fb8),38.0=>id("fc8"), + 19.0=>fa9,29.0=>id(fb9),39.0=>id("fc9"), + + x=>0,y=>"untouched",z=>"also untouched",q=>1, + + #{ "one" => small, map => key } => id("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" } => id("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 = id(Map#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}), + M1 = id(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} = Map, [{X,Q}|Vs]) -> +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). @@ -255,9 +850,9 @@ t_update_map_expressions(Config) when is_list(Config) -> #{ 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 }, - %% Error cases, FIXME: should be 'badmap'? - {'EXIT',{{badarg,<<>>},_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), - {'EXIT',{{badarg,[]},_}} = (catch (id([]))#{ a := 42, b => 2 }), + %% Error cases. + {'EXIT',{{badmap,<<>>},_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), + {'EXIT',{{badmap,[]},_}} = (catch (id([]))#{ a := 42, b => 2 }), ok. @@ -273,11 +868,80 @@ t_update_assoc(Config) when is_list(Config) -> M2 = M0#{3.0:=wrong,3.0=>new}, %% Errors cases. - BadMap = id(badmap), - {'EXIT',{{badarg,BadMap},_}} = (catch BadMap#{nonexisting=>val}), + BadMap = id(not_a_good_map), + {'EXIT',{{badmap,BadMap},_}} = (catch BadMap#{nonexisting=>val}), ok. +t_update_assoc_large(Config) when is_list(Config) -> + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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}, + + %% Errors cases. + BadMap = id(a_bad_map), + {'EXIT',{{badmap,BadMap},_}} = (catch BadMap#{nonexisting=>M0}), + ok. + + t_update_exact(Config) when is_list(Config) -> M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), @@ -291,13 +955,110 @@ t_update_exact(Config) when is_list(Config) -> %% M2 = M0#{3=>wrong,3.0:=new}, %% FIXME %% Errors cases. - {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), - {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), - {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), - {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + do_badmap(fun(T) -> + {'EXIT',{{badmap,T},_}} = + (catch T#{nonexisting=>val}) + end), + Empty = id(#{}), + {'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,_},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,_},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + + %% Evaluation order. + BadMap = id([no,map]), + {'EXIT',{blurf,_}} = + (catch BadMap#{whatever:=id(error(blurf))}), + {'EXIT',{blurf,_}} = + (catch BadMap#{id(error(blurf)):=whatever}), + {'EXIT',{{badmap,BadMap},_}} = + (catch BadMap#{nonexisting:=whatever}), + ok. + +t_update_exact_large(Config) when is_list(Config) -> + M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00"]}=>"10", + 11=>a1,21=>b1,31=>"c1","41"=>"d1",<<"51">>=>"e1",{["01"]}=>"11", + 12=>a2,22=>b2,32=>"c2","42"=>"d2",<<"52">>=>"e2",{["02"]}=>"12", + 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,_},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,_},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), ok. + t_update_values(Config) when is_list(Config) -> V0 = id(1337), M0 = #{ a => 1, val => V0}, @@ -371,6 +1132,75 @@ t_guard_sequence(Config) when is_list(Config) -> {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), ok. +t_guard_sequence_large(Config) when is_list(Config) -> + M0 = id(#{ 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=>id("a")}), + {2, "b"} = map_guard_sequence_1(M0#{seq=>2,val=>id("b")}), + {3, "c"} = map_guard_sequence_1(M0#{seq=>3,val=>id("c")}), + {4, "d"} = map_guard_sequence_1(M0#{seq=>4,val=>id("d")}), + {5, "e"} = map_guard_sequence_1(M0#{seq=>5,val=>id("e")}), + + {1,M1} = map_guard_sequence_2(M1 = id(M0#{a=>3})), + {2,M2} = map_guard_sequence_2(M2 = id(M0#{a=>4, b=>4})), + {3,gg,M3} = map_guard_sequence_2(M3 = id(M0#{a=>gg, b=>4})), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(M0#{a=>sc, b=>3, c=>sc2})), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(M0#{a=>kk, b=>other, c=>sc2})), + + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(M0#{seq=>6,val=>id("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}; @@ -390,6 +1220,65 @@ t_guard_update(Config) when is_list(Config) -> second = map_guard_update(#{y=>old}, #{x=>second,y=>old}), ok. +t_guard_update_large(Config) when is_list(Config) -> + M0 = id(#{ 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. @@ -419,6 +1308,42 @@ t_guard_receive(Config) when is_list(Config) -> done = call(Pid, done), ok. +-define(t_guard_receive_large_procs, 150). + +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. @@ -449,6 +1374,14 @@ guard_receive_loop() -> t_list_comprehension(Config) when is_list(Config) -> [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + Ls = id([#{<<2:301>> => I, "wat" => I + 1} || I <- [1,2,3]]), + [#{<<2:301>>:=1,"wat":=2},#{<<2:301>>:=2,"wat":=3},#{<<2:301>>:=3,"wat":=4}] = Ls, + [{1,2},{2,3},{3,4}] = id([{I2,I1} || #{"wat" := I1, <<2:301>> := I2} <- Ls]), + + 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) -> @@ -494,7 +1427,7 @@ t_map_sort_literals(Config) when is_list(Config) -> true = #{ c => 1, b => 1, a => 1 } < id(#{ b => 1, c => 1, d => 1}), true = #{ "a" => 1 } < id(#{ <<"a">> => 1}), false = #{ <<"a">> => 1 } < id(#{ "a" => 1}), - false = #{ 1 => 1 } < id(#{ 1.0 => 1}), + true = #{ 1 => 1 } < id(#{ 1.0 => 1}), false = #{ 1.0 => 1 } < id(#{ 1 => 1}), %% value order @@ -526,11 +1459,11 @@ t_bif_map_get(Config) when is_list(Config) -> "v4" = maps:get(<<"k2">>, M#{ <<"k2">> => "v4" }), %% error case - {'EXIT',{badarg, [{maps,get,_,_}|_]}} = (catch maps:get(a,[])), - {'EXIT',{badarg, [{maps,get,_,_}|_]}} = (catch maps:get(a,<<>>)), - {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get({1,1}, #{{1,1.0} => "tuple"})), - {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get(a,#{})), - {'EXIT',{bad_key,[{maps,get,_,_}|_]}} = (catch maps:get(a,#{ b=>1, c=>2})), + {'EXIT',{{badmap,[]},[{maps,get,_,_}|_]}} = (catch maps:get(a, [])), + {'EXIT',{{badmap,<<>>},[{maps,get,_,_}|_]}} = (catch maps:get(a, <<>>)), + {'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) -> @@ -554,8 +1487,10 @@ t_bif_map_find(Config) when is_list(Config) -> error = maps:find({1.0,1}, #{ a=>a, {1,1.0} => "tuple hi"}), % reverse types in tuple key - {'EXIT',{badarg,[{maps,find,_,_}|_]}} = (catch maps:find(a,id([]))), - {'EXIT',{badarg,[{maps,find,_,_}|_]}} = (catch maps:find(a,id(<<>>))), + {'EXIT',{{badmap,[]},[{maps,find,_,_}|_]}} = + (catch maps:find(a, id([]))), + {'EXIT',{{badmap,<<>>},[{maps,find,_,_}|_]}} = + (catch maps:find(a, id(<<>>))), ok. @@ -580,26 +1515,26 @@ t_bif_map_is_key(Config) when is_list(Config) -> false = maps:is_key(1.0, maps:put(1, "number", M1)), %% error case - {'EXIT',{badarg,[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a,id([]))), - {'EXIT',{badarg,[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a,id(<<>>))), + {'EXIT',{{badmap,[]},[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a, id([]))), + {'EXIT',{{badmap,<<>>},[{maps,is_key,_,_}|_]}} = (catch maps:is_key(a, id(<<>>))), ok. t_bif_map_keys(Config) when is_list(Config) -> [] = maps:keys(#{}), - [1,2,3,4,5] = maps:keys(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}), - [1,2,3,4,5] = maps:keys(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}), + [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">>] = maps:keys(M1), + [4,int,"hi",<<"key">>] = lists:sort(maps:keys(M1)), %% error case - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(1 bsl 65 + 3)), - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(154)), - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(atom)), - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys([])), - {'EXIT',{badarg,[{maps,keys,_,_}|_]}} = (catch maps:keys(<<>>)), + BigNum = 1 bsl 65 + 3, + {'EXIT',{{badmap,BigNum},[{maps,keys,_,_}|_]}} = (catch maps:keys(BigNum)), + {'EXIT',{{badmap,154},[{maps,keys,_,_}|_]}} = (catch maps:keys(154)), + {'EXIT',{{badmap,atom},[{maps,keys,_,_}|_]}} = (catch maps:keys(atom)), + {'EXIT',{{badmap,[]},[{maps,keys,_,_}|_]}} = (catch maps:keys([])), + {'EXIT',{{badmap,<<>>},[{maps,keys,_,_}|_]}} = (catch maps:keys(<<>>)), ok. t_bif_map_new(Config) when is_list(Config) -> @@ -628,93 +1563,64 @@ t_bif_map_merge(Config) when is_list(Config) -> {1,2} := "tuple", "hi" := "hello again", <<"key">> := <<"value">>} = maps:merge(M0,M1), %% error case - {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge((1 bsl 65 + 3), <<>>)), - {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge(<<>>, id(#{ a => 1}))), - {'EXIT',{badarg,[{maps,merge,_,_}|_]}} = (catch maps:merge(id(#{ a => 2}), <<>> )), + BigNum = 1 bsl 65 + 3, + {'EXIT',{{badmap,BigNum},[{maps,merge,_,_}|_]}} = (catch maps:merge(BigNum, <<>>)), + {'EXIT',{{badmap,<<>>},[{maps,merge,_,_}|_]}} = (catch maps:merge(<<>>, id(#{ a => 1}))), + {'EXIT',{{badmap,<<>>},[{maps,merge,_,_}|_]}} = (catch maps:merge(id(#{ a => 2}), <<>> )), 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", #{}), - ["hi"] = maps:keys(M1), - ["hello"] = maps:values(M1), + true = is_members(["hi"],maps:keys(M1)), + true = is_members(["hello"],maps:values(M1)), M2 = #{ int := 3 } = maps:put(int, 3, M1), - [int,"hi"] = maps:keys(M2), - [3,"hello"] = maps:values(M2), + true = is_members([int,"hi"],maps:keys(M2)), + true = is_members([3,"hello"],maps:values(M2)), M3 = #{ <<"key">> := <<"value">> } = maps:put(<<"key">>, <<"value">>, M2), - [int,"hi",<<"key">>] = maps:keys(M3), - [3,"hello",<<"value">>] = maps:values(M3), + 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), - [18446744073709551629,int,"hi",<<"key">>] = maps:keys(M4), - [wat,3,"hello",<<"value">>] = maps:values(M4), + 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), - [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M5), - [number,wat,3,"hello",<<"value">>] = maps:values(M5), + 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), - [4,18446744073709551629,int,"hi",<<"key">>] = maps:keys(M6), - [number,wat,3,"hello",<<"other value">>] = maps:values(M6), + 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 - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,1 bsl 65 + 3)), - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,154)), - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,atom)), - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,[])), - {'EXIT',{badarg,[{maps,put,_,_}|_]}} = (catch maps:put(1,a,<<>>)), - ok. - -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), - [4,18446744073709551629,int,<<"key">>] = maps:keys(M1), - [number,wat,3,<<"value">>] = maps:values(M1), - - M2 = maps:remove(int, M1), - [4,18446744073709551629,<<"key">>] = maps:keys(M2), - [number,wat,<<"value">>] = maps:values(M2), - - M3 = maps:remove(<<"key">>, M2), - [4,18446744073709551629] = maps:keys(M3), - [number,wat] = maps:values(M3), - - M4 = maps:remove(18446744073709551629, M3), - [4] = maps:keys(M4), - [number] = maps:values(M4), - - M5 = maps:remove(4, M4), - [] = maps:keys(M5), - [] = maps:values(M5), + BigNum = 1 bsl 65 + 3, + {'EXIT',{{badmap,BigNum},[{maps,put,_,_}|_]}} = (catch maps:put(1, a, BigNum)), + {'EXIT',{{badmap,154},[{maps,put,_,_}|_]}} = (catch maps:put(1, a, 154)), + {'EXIT',{{badmap,atom},[{maps,put,_,_}|_]}} = (catch maps:put(1, a, atom)), + {'EXIT',{{badmap,[]},[{maps,put,_,_}|_]}} = (catch maps:put(1, a, [])), + {'EXIT',{{badmap,<<>>},[{maps,put,_,_}|_]}} = (catch maps:put(1, a, <<>>)), + ok. - M0 = maps:remove(5,M0), - M0 = maps:remove("hi there",M0), +is_members(Ks,Ls) when length(Ks) =/= length(Ls) -> false; +is_members(Ks,Ls) -> is_members_do(Ks,Ls). - #{ "hi" := "hello", int := 3, 4 := number} = maps:remove(18446744073709551629,maps:remove(<<"key">>,M0)), +is_members_do([],[]) -> true; +is_members_do([],_) -> false; +is_members_do([K|Ks],Ls) -> + is_members_do(Ks, lists:delete(K,Ls)). - %% error case - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,1 bsl 65 + 3)), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,154)), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,atom)), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(1,[])), - {'EXIT',{badarg,[{maps,remove,_,_}|_]}} = (catch maps:remove(a,<<>>)), - ok. t_bif_map_update(Config) when is_list(Config) -> M0 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, @@ -736,103 +1642,142 @@ t_bif_map_update(Config) when is_list(Config) -> 4 := number, 18446744073709551629 := wazzup} = maps:update(18446744073709551629, wazzup, M0), %% error case - {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(1,none,{})), - {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(1,none,<<"value">>)), - {'EXIT',{badarg,[{maps,update,_,_}|_]}} = (catch maps:update(5,none,M0)), + {'EXIT',{{badmap,{}},[{maps,update,_,_}|_]}} = (catch maps:update(1, none, {})), + {'EXIT',{{badmap,<<"value">>},[{maps,update,_,_}|_]}} = + (catch maps:update(1, none, <<"value">>)), + {'EXIT',{{badkey,5},[{maps,update,_,_}|_]}} = (catch maps:update(5, none, M0)), ok. +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 + BigNum = 1 bsl 65 + 3, + {'EXIT',{{badmap,BigNum},[{maps,remove,_,_}|_]}} = (catch maps:remove(a, BigNum)), + {'EXIT',{{badmap,154},[{maps,remove,_,_}|_]}} = (catch maps:remove(1, 154)), + {'EXIT',{{badmap,atom},[{maps,remove,_,_}|_]}} = (catch maps:remove(a, atom)), + {'EXIT',{{badmap,[]},[{maps,remove,_,_}|_]}} = (catch maps:remove(1, [])), + {'EXIT',{{badmap,<<>>},[{maps,remove,_,_}|_]}} = (catch maps:remove(a, <<>>)), + ok. t_bif_map_values(Config) when is_list(Config) -> [] = maps:values(#{}), + [1] = maps:values(#{a=>1}), - [a,b,c,d,e] = maps:values(#{ 1 => a, 2 => b, 3 => c, 4 => d, 5 => e}), - [a,b,c,d,e] = maps:values(#{ 4 => d, 5 => e, 1 => a, 2 => b, 3 => c}), + 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})), - % values in key order: [4,int,"hi",<<"key">>] M1 = #{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, 4 => number}, M2 = M1#{ "hi" => "hello2", <<"key">> => <<"value2">> }, - [number,3,"hello2",<<"value2">>] = maps:values(M2), - [number,3,"hello",<<"value">>] = maps:values(M1), + true = is_members([number,3,"hello2",<<"value2">>],maps:values(M2)), + true = is_members([number,3,"hello",<<"value">>],maps:values(M1)), %% error case - {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(1 bsl 65 + 3)), - {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(atom)), - {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values([])), - {'EXIT',{badarg,[{maps,values,_,_}|_]}} = (catch maps:values(<<>>)), + BigNum = 1 bsl 65 + 3, + {'EXIT',{{badmap,BigNum},[{maps,values,_,_}|_]}} = (catch maps:values(BigNum)), + {'EXIT',{{badmap,atom},[{maps,values,_,_}|_]}} = (catch maps:values(atom)), + {'EXIT',{{badmap,[]},[{maps,values,_,_}|_]}} = (catch maps:values([])), + {'EXIT',{{badmap,<<>>},[{maps,values,_,_}|_]}} = (catch maps:values(<<>>)), 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(#{}), - 78942764 = erlang:phash2(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 }), - 37338230 = erlang:phash2(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} }), - 14363616 = erlang:phash2(#{ 1 => a }), - 51612236 = erlang:phash2(#{ a => 1 }), + 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 - 37468437 = erlang:phash2(#{{} => <<>>}), - 44049159 = erlang:phash2(#{<<>> => {}}), + 42770201 = erlang:phash2(#{{} => <<>>}), % 37468437 + 71687700 = erlang:phash2(#{<<>> => {}}), % 44049159 M0 = #{ a => 1, "key" => <<"value">> }, M1 = maps:remove("key",M0), M2 = M1#{ "key" => <<"value">> }, - 118679416 = erlang:phash2(M0), - 51612236 = erlang:phash2(M1), - 118679416 = erlang:phash2(M2), + 70249457 = erlang:phash2(M0), % 118679416 + 59617982 = erlang:phash2(M1), % 51612236 + 70249457 = erlang:phash2(M2), % 118679416 ok. t_bif_erlang_phash() -> Sz = 1 bsl 32, - 268440612 = erlang:phash(#{},Sz), - 1196461908 = erlang:phash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), - 3944426064 = erlang:phash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), - 1394238263 = erlang:phash(#{ 1 => a },Sz), - 4066388227 = erlang:phash(#{ a => 1 },Sz), + 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 - 1578050717 = erlang:phash(#{{} => <<>>},Sz), - 1578050717 = erlang:phash(#{<<>> => {}},Sz), % yep, broken + 3935089469 = erlang:phash(#{{} => <<>>},Sz), % 1578050717 + 71692856 = erlang:phash(#{<<>> => {}},Sz), % 1578050717 M0 = #{ a => 1, "key" => <<"value">> }, M1 = maps:remove("key",M0), M2 = M1#{ "key" => <<"value">> }, - 3590546636 = erlang:phash(M0,Sz), - 4066388227 = erlang:phash(M1,Sz), - 3590546636 = erlang:phash(M2,Sz), + 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, - 5158 = erlang:hash(#{},Sz), - 71555838 = erlang:hash(#{ a => 1, "a" => 2, <<"a">> => 3, {a,b} => 4 },Sz), - 5497225 = erlang:hash(#{ 1 => a, 2 => "a", 3 => <<"a">>, 4 => {a,b} },Sz), - 126071654 = erlang:hash(#{ 1 => a },Sz), - 126426236 = erlang:hash(#{ a => 1 },Sz), + 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 - 101655720 = erlang:hash(#{{} => <<>>},Sz), - 101655720 = erlang:hash(#{<<>> => {}},Sz), % yep, broken + 42775386 = erlang:hash(#{{} => <<>>},Sz), % 101655720 + 71692856 = erlang:hash(#{<<>> => {}},Sz), % 101655720 M0 = #{ a => 1, "key" => <<"value">> }, M1 = maps:remove("key",M0), M2 = M1#{ "key" => <<"value">> }, - 38260486 = erlang:hash(M0,Sz), - 126426236 = erlang:hash(M1,Sz), - 38260486 = erlang:hash(M2,Sz), + 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 = [ @@ -895,43 +1840,46 @@ t_map_encode_decode(Config) when is_list(Config) -> map_encode_decode_and_match([{K,V}|Pairs], EncodedPairs, M0) -> M1 = maps:put(K,V,M0), B0 = erlang:term_to_binary(M1), - Ls = lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, [{K, erlang:term_to_binary(K), erlang:term_to_binary(V)}|EncodedPairs]), - %% sort Ks and Vs according to term spec, then match it - KVbins = lists:foldr(fun({_,Kbin,Vbin}, Acc) -> [Kbin,Vbin | Acc] end, [], Ls), - ok = match_encoded_map(B0, length(Ls), KVbins), + 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(Encoded,Items); + match_encoded_map_stripped_size(Encoded,Items,Items); match_encoded_map(_,_,_) -> no_match_size. -match_encoded_map(<<>>,[]) -> ok; -match_encoded_map(Bin,[<<131,Item/binary>>|Items]) -> - Size = erlang:byte_size(Item), - <<EncodedTerm:Size/binary, Bin1/binary>> = Bin, - EncodedTerm = Item, %% Asssert - match_encoded_map(Bin1,Items). +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}] = maps:to_list(#{a=>1,b=>2}), - [{a,1},{b,2},{c,3}] = maps:to_list(#{c=>3,a=>1,b=>2}), - [{a,1},{b,2},{g,3}] = maps:to_list(#{g=>3,a=>1,b=>2}), - [{a,1},{b,2},{g,3},{"c",4}] = maps:to_list(#{g=>3,a=>1,b=>2,"c"=>4}), - [{3,v2},{hi,v4},{{hi,3},v5},{"hi",v3},{<<"hi">>,v1}] = maps:to_list(#{ - <<"hi">>=>v1,3=>v2,"hi"=>v3,hi=>v4,{hi,3}=>v5}), + [{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}] = 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}), + [{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 - {'EXIT', {badarg,_}} = (catch maps:to_list(id(a))), - {'EXIT', {badarg,_}} = (catch maps:to_list(id(42))), + {'EXIT', {{badmap,a},_}} = (catch maps:to_list(id(a))), + {'EXIT', {{badmap,42},_}} = (catch maps:to_list(id(42))), ok. @@ -1147,9 +2095,9 @@ t_update_assoc_variables(Config) when is_list(Config) -> #{ <<0:258>> := val } = id(M0#{<<0:258>> => val}), %% binary limitation %% Errors cases. - BadMap = id(badmap), - {'EXIT',{{badarg,_},_}} = (catch BadMap#{nonexisting=>val}), - {'EXIT',{{badarg,_},_}} = (catch <<>>#{nonexisting=>val}), + BadMap = id(a_bad_map), + {'EXIT',{{badmap,BadMap},_}} = (catch BadMap#{nonexisting=>val}), + {'EXIT',{{badmap,<<>>},_}} = (catch <<>>#{nonexisting=>val}), ok. t_update_exact_variables(Config) when is_list(Config) -> @@ -1177,14 +2125,14 @@ t_update_exact_variables(Config) when is_list(Config) -> 1.0 => new_val4 }, %% Errors cases. - {'EXIT',{{badarg,_},_}} = (catch ((id(nil))#{ a := b })), - {'EXIT',{{badarg,_},_}} = (catch <<>>#{nonexisting:=val}), - - {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), - {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), - {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), - {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), - {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation + {'EXIT',{{badmap,_},_}} = (catch ((id(nil))#{ a := b })), + {'EXIT',{{badmap,_},_}} = (catch <<>>#{nonexisting:=val}), + + {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{{badkey,1.0},_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{{badkey,_},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,_},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + {'EXIT',{{badkey,_},_}} = (catch M0#{<<0:257>> := val}), %% limitation ok. t_nested_pattern_expressions(Config) when is_list(Config) -> @@ -1271,7 +2219,7 @@ map_guard_sequence_mixed(K1,K2,M) -> t_frequency_table(Config) when is_list(Config) -> random:seed({13,1337,54}), % pseudo random - N = 100000, + N = 1000, Ts = rand_terms(N), #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}), ok = check_frequency(Ts,Tf), @@ -1435,6 +2383,11 @@ t_build_and_match_structure(Config) when is_list(Config) -> ok. +do_badmap(Test) -> + Terms = [Test,fun erlang:abs/1,make_ref(),self(),0.0/id(-1), + <<1:1>>,<<>>,<<1,2,3>>, + [],{a,b,c},[a,b],atom,10.0,42,(1 bsl 65) + 3], + [Test(T) || T <- Terms]. %% Use this function to avoid compile-time evaluation of an expression. id(I) -> I. diff --git a/lib/debugger/vsn.mk b/lib/debugger/vsn.mk index 38c19be93e..b82f0f4e37 100644 --- a/lib/debugger/vsn.mk +++ b/lib/debugger/vsn.mk @@ -1 +1 @@ -DEBUGGER_VSN = 4.0.2 +DEBUGGER_VSN = 4.0.3 diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index b52c1edebf..2a8bf6edcc 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2006</year><year>2014</year> + <year>2006</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -231,6 +231,8 @@ <tag><c><![CDATA[-Wno_behaviours]]></c></tag> <item>Suppress warnings about behaviour callbacks which drift from the published recommended interfaces.</item> + <tag><c><![CDATA[-Wno_missing_calls]]></c></tag> + <item>Suppress warnings about calls to missing functions.</item> <tag><c><![CDATA[-Wno_undefined_callbacks]]></c></tag> <item>Suppress warnings about behaviours that have no <c>-callback</c> attributes for their callbacks.</item> @@ -246,9 +248,16 @@ analysis that finds data races performs intra-procedural data flow analysis and can sometimes explode in time. Enable it at your own risk. </item> - <tag><c><![CDATA[-Wunderspecs]]></c>***</tag> +i <tag><c><![CDATA[-Wunderspecs]]></c>***</tag> <item>Warn about underspecified functions (the -spec is strictly more allowing than the success typing).</item> + <tag><c><![CDATA[-Wunknown]]></c>***</tag> + <item>Let warnings about unknown functions and types affect the + exit status of the command line version. The default is to ignore + warnings about unknown functions and types when setting the exit + status. When using the Dialyzer from Erlang, warnings about unknown + functions and types are returned; the default is not to return + these warnings.</item> </taglist> <p>The following options are also available but their use is not recommended: (they are mostly for Dialyzer developers and internal @@ -382,7 +391,8 @@ WarnOpts :: no_return | race_conditions | overspecs | underspecs - | specdiffs</code> + | specdiffs + | unknown</code> </desc> </func> <func> @@ -416,6 +426,7 @@ Tag :: 'warn_behaviour' | 'warn_return_only_exit' | 'warn_umatched_return' | 'warn_undefined_callbacks' + | 'warn_unknown' Id = {File :: string(), Line :: integer()} Msg = msg() -- Undefined</code> </desc> diff --git a/lib/dialyzer/doc/src/notes.xml b/lib/dialyzer/doc/src/notes.xml index 4020165697..8976679c1d 100644 --- a/lib/dialyzer/doc/src/notes.xml +++ b/lib/dialyzer/doc/src/notes.xml @@ -31,6 +31,21 @@ <p>This document describes the changes made to the Dialyzer application.</p> +<section><title>Dialyzer 2.7.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> A bug concerning <c>map()</c> types has been fixed. + </p> + <p> + Own Id: OTP-12472</p> + </item> + </list> + </section> + +</section> + <section><title>Dialyzer 2.7.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index 1756800c4f..7b2e1d4a9d 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -46,5 +46,5 @@ {applications, [compiler, gs, hipe, kernel, stdlib, wx]}, {env, []}, {runtime_dependencies, ["wx-1.2","syntax_tools-1.6.14","stdlib-2.0", - "kernel-3.0","hipe-3.10.3","erts-6.0", + "kernel-3.0","hipe-3.10.3","erts-7.0", "compiler-5.0"]}]}. diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index 5ff7ad9c6f..dbfe680345 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -586,7 +586,8 @@ send_codeserver_plt(Parent, CServer, Plt ) -> send_bad_calls(Parent, BadCalls, CodeServer) -> FormatedBadCalls = format_bad_calls(BadCalls, CodeServer, []), - send_warnings(Parent, FormatedBadCalls). + Warnings = filter_warnings(FormatedBadCalls, CodeServer), + send_warnings(Parent, Warnings). send_mod_deps(Parent, ModuleDeps) -> Parent ! {self(), mod_deps, ModuleDeps}, diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index debb78bd0b..4386a8d52a 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -2,7 +2,7 @@ %%------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -469,7 +469,7 @@ expand_dependent_modules(Md5, DiffMd5, ModDeps) -> Mod = list_to_atom(filename:basename(File, ".beam")), sets:is_element(Mod, AnalyzeMods) end, - {[F || {F, _} <- Md5, FilterFun(F)], RemovedMods, NewModDeps}. + {[F || {F, _} <- Md5, FilterFun(F)], BigSet, NewModDeps}. expand_dependent_modules_1([Mod|Mods], Included, ModDeps) -> case dict:find(Mod, ModDeps) of @@ -656,15 +656,15 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, mod_deps = ModDeps, output_plt = OutputPlt, plt_info = PltInfo, - stored_warnings = StoredWarnings, - legal_warnings = LegalWarnings}, + stored_warnings = StoredWarnings}, Plt) -> case OutputPlt =:= none of true -> ok; false -> dialyzer_plt:to_file(OutputPlt, Plt, ModDeps, PltInfo) end, + UnknownWarnings = unknown_warnings(State), RetValue = - case StoredWarnings =:= [] of + case StoredWarnings =:= [] andalso UnknownWarnings =:= [] of true -> ?RET_NOTHING_SUSPICIOUS; false -> ?RET_DISCREPANCIES end, @@ -677,22 +677,22 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, maybe_close_output_file(State), {RetValue, []}; true -> - Unknown = - case ordsets:is_element(?WARN_UNKNOWN, LegalWarnings) of - true -> - unknown_functions(State) ++ - unknown_types(State) ++ - unknown_behaviours(State); - false -> [] - end, - WarningInfo = {_Filename = "", _Line = 0, _MorMFA = ''}, - UnknownWarnings = - [{?WARN_UNKNOWN, WarningInfo, W} || W <- Unknown], AllWarnings = UnknownWarnings ++ process_warnings(StoredWarnings), {RetValue, set_warning_id(AllWarnings)} end. +unknown_warnings(State = #cl_state{legal_warnings = LegalWarnings}) -> + Unknown = case ordsets:is_element(?WARN_UNKNOWN, LegalWarnings) of + true -> + unknown_functions(State) ++ + unknown_types(State) ++ + unknown_behaviours(State); + false -> [] + end, + WarningInfo = {_Filename = "", _Line = 0, _MorMFA = ''}, + [{?WARN_UNKNOWN, WarningInfo, W} || W <- Unknown]. + unknown_functions(#cl_state{external_calls = Calls}) -> [{unknown_function, MFA} || MFA <- Calls]. @@ -706,10 +706,8 @@ print_ext_calls(#cl_state{report_mode = quiet}) -> print_ext_calls(#cl_state{output = Output, external_calls = Calls, stored_warnings = Warnings, - output_format = Format, - legal_warnings = LegalWarnings}) -> - case not ordsets:is_element(?WARN_UNKNOWN, LegalWarnings) - orelse Calls =:= [] of + output_format = Format}) -> + case Calls =:= [] of true -> ok; false -> case Warnings =:= [] of @@ -741,10 +739,8 @@ print_ext_types(#cl_state{output = Output, external_calls = Calls, external_types = Types, stored_warnings = Warnings, - output_format = Format, - legal_warnings = LegalWarnings}) -> - case not ordsets:is_element(?WARN_UNKNOWN, LegalWarnings) - orelse Types =:= [] of + output_format = Format}) -> + case Types =:= [] of true -> ok; false -> case Warnings =:= [] andalso Calls =:= [] of diff --git a/lib/dialyzer/src/dialyzer_cl_parse.erl b/lib/dialyzer/src/dialyzer_cl_parse.erl index 04ce0e8bc3..21fc424a1b 100644 --- a/lib/dialyzer/src/dialyzer_cl_parse.erl +++ b/lib/dialyzer/src/dialyzer_cl_parse.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -509,6 +509,8 @@ warning_options_msg() -> -Wno_behaviours Suppress warnings about behaviour callbacks which drift from the published recommended interfaces. + -Wno_missing_calls + Suppress warnings about calls to missing functions. -Wno_undefined_callbacks Suppress warnings about behaviours that have no -callback attributes for their callbacks. @@ -522,6 +524,13 @@ warning_options_msg() -> -Wunderspecs *** Warn about underspecified functions (those whose -spec is strictly more allowing than the success typing). + -Wunknown *** + Let warnings about unknown functions and types affect the + exit status of the command line version. The default is to ignore + warnings about unknown functions and types when setting the exit + status. When using the Dialyzer from Erlang, warnings about unknown + functions and types are returned; the default is not to return + such warnings. The following options are also available but their use is not recommended: (they are mostly for Dialyzer developers and internal debugging) diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 336b4641d4..48d1ab9ebc 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -3519,6 +3519,7 @@ find_terminals(Tree) -> 'let' -> find_terminals(cerl:let_body(Tree)); letrec -> find_terminals(cerl:letrec_body(Tree)); literal -> {false, true}; + map -> {false, true}; primop -> {false, false}; %% match_fail, etc. are not explicit exits. 'receive' -> Timeout = cerl:receive_timeout(Tree), diff --git a/lib/dialyzer/src/dialyzer_options.erl b/lib/dialyzer/src/dialyzer_options.erl index 20971f1407..81907f7995 100644 --- a/lib/dialyzer/src/dialyzer_options.erl +++ b/lib/dialyzer/src/dialyzer_options.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -46,13 +46,11 @@ build(Opts) -> ?WARN_CALLGRAPH, ?WARN_FAILING_CALL, ?WARN_BIN_CONSTRUCTION, - ?WARN_CALLGRAPH, ?WARN_CONTRACT_RANGE, ?WARN_CONTRACT_TYPES, ?WARN_CONTRACT_SYNTAX, ?WARN_BEHAVIOUR, - ?WARN_UNDEFINED_CALLBACK, - ?WARN_UNKNOWN], + ?WARN_UNDEFINED_CALLBACK], DefaultWarns1 = ordsets:from_list(DefaultWarns), InitPlt = dialyzer_plt:get_default_plt(), DefaultOpts = #options{}, @@ -302,6 +300,8 @@ build_warnings([Opt|Opts], Warnings) -> ordsets:add_element(?WARN_RETURN_ONLY_EXIT, Warnings); race_conditions -> ordsets:add_element(?WARN_RACE_CONDITION, Warnings); + no_missing_calls -> + ordsets:del_element(?WARN_CALLGRAPH, Warnings); specdiffs -> S = ordsets:from_list([?WARN_CONTRACT_SUBTYPE, ?WARN_CONTRACT_SUPERTYPE, @@ -311,8 +311,8 @@ build_warnings([Opt|Opts], Warnings) -> ordsets:add_element(?WARN_CONTRACT_SUBTYPE, Warnings); underspecs -> ordsets:add_element(?WARN_CONTRACT_SUPERTYPE, Warnings); - no_unknown -> - ordsets:del_element(?WARN_UNKNOWN, Warnings); + unknown -> + ordsets:add_element(?WARN_UNKNOWN, Warnings); OtherAtom -> bad_option("Unknown dialyzer warning option", OtherAtom) end, diff --git a/lib/dialyzer/src/dialyzer_timing.erl b/lib/dialyzer/src/dialyzer_timing.erl index b1a4bdc07c..759d49abc8 100644 --- a/lib/dialyzer/src/dialyzer_timing.erl +++ b/lib/dialyzer/src/dialyzer_timing.erl @@ -38,7 +38,7 @@ init(Active) -> case Active of true -> io:format("\n"), - spawn_link(fun() -> loop(now(), 0, "") end); + spawn_link(fun() -> loop(erlang:monotonic_time(), 0, "") end); debug -> io:format("\n"), spawn_link(fun() -> debug_loop("") end); @@ -105,14 +105,14 @@ debug_loop(Phase) -> start_stamp(none, _) -> ok; start_stamp(Pid, Msg) -> - Pid ! {stamp, Msg, now()}, + Pid ! {stamp, Msg, erlang:monotonic_time()}, ok. -spec end_stamp(timing_server()) -> ok. end_stamp(none) -> ok; end_stamp(Pid) -> - Pid ! {stamp, now()}, + Pid ! {stamp, erlang:monotonic_time()}, ok. -spec send_size_info(timing_server(), integer(), string()) -> ok. @@ -126,8 +126,8 @@ send_size_info(Pid, Size, Unit) -> stop(none) -> ok; stop(Pid) -> - Pid ! {self(), stop, now()}, + Pid ! {self(), stop, erlang:monotonic_time()}, receive ok -> ok end. diff(T2, T1) -> - timer:now_diff(T2,T1) / 1000000. + (T2-T1) / erlang:convert_time_unit(1, seconds, native). diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 1737bfd3a9..6c14860d7d 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -1579,11 +1579,11 @@ get_bif_constr({M, F, A} = _BIF, Dst, Args, _State) -> eval_inv_arith('+', _Pos, Dst, Arg) -> bif_return(erlang, '-', 2, [Dst, Arg]); eval_inv_arith('*', _Pos, Dst, Arg) -> - case t_number_vals(Arg) of - [0] -> t_integer(); - _ -> + Zero = t_from_term(0), + case t_is_none(t_inf(Arg, Zero)) of + false -> t_integer(); + true -> TmpRet = bif_return(erlang, 'div', 2, [Dst, Arg]), - Zero = t_from_term(0), %% If 0 is not part of the result, it cannot be part of the argument. case t_is_subtype(Zero, Dst) of false -> t_subtract(TmpRet, Zero); diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 1cc9528fed..e29fc3ba8b 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -385,10 +385,11 @@ get_optional_callbacks(Abs) -> %% - Constraint is of the form {subtype, T1, T2} where T1 and T2 %% are erl_types:erl_type() -get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left], +get_spec_info([{attribute, Attr, Contract, {Id, TypeSpec}}|Left], SpecDict, CallbackDict, RecordsDict, ModName, OptCb, File) when ((Contract =:= 'spec') or (Contract =:= 'callback')), is_list(TypeSpec) -> + Ln = erl_anno:line(Attr), MFA = case Id of {_, _, _} = T -> T; {F, A} -> {ModName, F, A} @@ -519,7 +520,7 @@ get_options1([], Warnings) -> Warnings. -type collected_attribute() :: - {Args :: term(), erl_scan:line(), file:filename()}. + {Args :: term(), erl_anno:line(), file:filename()}. collect_attribute(Abs, Tag) -> collect_attribute(Abs, Tag, "nofile"). @@ -643,7 +644,7 @@ get_options_with_tag(Tag, Abs) -> %% Check F/A, and collect (unchecked) warning tags with line and file. -spec check_fa_list([collected_attribute()], atom(), [fa()]) -> - [{{atom(), erl_scan:line(), file:filename()},fa()}]. + [{{atom(), erl_anno:line(), file:filename()},fa()}]. check_fa_list(AttrFile, Tag, Functions) -> FuncTab = gb_sets:from_list(Functions), diff --git a/lib/dialyzer/test/dialyzer_SUITE.erl b/lib/dialyzer/test/dialyzer_SUITE.erl index 8507525597..f625d12b45 100644 --- a/lib/dialyzer/test/dialyzer_SUITE.erl +++ b/lib/dialyzer/test/dialyzer_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014. All Rights Reserved. +%% Copyright Ericsson AB 2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -30,12 +30,12 @@ -export([init_per_testcase/2, end_per_testcase/2]). %% Test cases must be exported. --export([app_test/1, appup_test/1, beam_tests/1]). +-export([app_test/1, appup_test/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app_test, appup_test, beam_tests]. + [app_test, appup_test]. groups() -> []. @@ -75,38 +75,3 @@ app_test(Config) when is_list(Config) -> %% Test that the .appup file does not contain any `basic' errors appup_test(Config) when is_list(Config) -> ok = ?t:appup_test(dialyzer). - -beam_tests(Config) when is_list(Config) -> - Prog = <<" - -module(no_auto_import). - - %% Copied from erl_lint_SUITE.erl, clash6 - - -export([size/1]). - - size([]) -> - 0; - size({N,_}) -> - N; - size([_|T]) -> - 1+size(T). - ">>, - Opts = [no_auto_import], - {ok, BeamFile} = compile(Config, Prog, no_auto_import, Opts), - [] = run_dialyzer([BeamFile]), - ok. - -compile(Config, Prog, Module, CompileOpts) -> - Source = lists:concat([Module, ".erl"]), - PrivDir = ?config(priv_dir,Config), - Filename = filename:join([PrivDir, Source]), - ok = file:write_file(Filename, Prog), - Opts = [{outdir, PrivDir}, debug_info | CompileOpts], - {ok, Module} = compile:file(Filename, Opts), - {ok, filename:join([PrivDir, lists:concat([Module, ".beam"])])}. - -run_dialyzer(Files) -> - dialyzer:run([{analysis_type, plt_build}, - {files, Files}, - {from, byte_code}, - {check_plt, false}]). diff --git a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options index 44a65f6e90..3ff26b87db 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, [{warnings, [no_unused, no_return, no_unknown]}]}. +{dialyzer_options, [{warnings, [no_unused, no_return]}]}. diff --git a/lib/dialyzer/test/options1_SUITE_data/dialyzer_options b/lib/dialyzer/test/options1_SUITE_data/dialyzer_options index 65d233ac0d..c612e77d3e 100644 --- a/lib/dialyzer/test/options1_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/options1_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ -{dialyzer_options, [{include_dirs, ["my_include"]}, {defines, [{'COMPILER_VSN', 42}]}, {warnings, [no_improper_lists, no_unknown]}]}. +{dialyzer_options, [{include_dirs, ["my_include"]}, {defines, [{'COMPILER_VSN', 42}]}, {warnings, [no_improper_lists]}]}. {time_limit, 30}. diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl index aee9f449a6..ef4cdc57f0 100644 --- a/lib/dialyzer/test/plt_SUITE.erl +++ b/lib/dialyzer/test/plt_SUITE.erl @@ -1,17 +1,17 @@ %% This suite is the only hand made and simply -%% checks if we can build a plt. +%% checks if we can build and update a plt. -module(plt_SUITE). -include_lib("common_test/include/ct.hrl"). -include("dialyzer_test_constants.hrl"). --export([suite/0, all/0, build_plt/1]). +-export([suite/0, all/0, build_plt/1, beam_tests/1, update_plt/1]). suite() -> [{timetrap, ?plt_timeout}]. -all() -> [build_plt]. +all() -> [build_plt, beam_tests, update_plt]. build_plt(Config) -> OutDir = ?config(priv_dir, Config), @@ -19,3 +19,87 @@ build_plt(Config) -> ok -> ok; fail -> ct:fail(plt_build_fail) end. + +beam_tests(Config) when is_list(Config) -> + Prog = <<" + -module(no_auto_import). + + %% Copied from erl_lint_SUITE.erl, clash6 + + -export([size/1]). + + size([]) -> + 0; + size({N,_}) -> + N; + size([_|T]) -> + 1+size(T). + ">>, + Opts = [no_auto_import], + {ok, BeamFile} = compile(Config, Prog, no_auto_import, Opts), + [] = run_dialyzer([BeamFile]), + ok. + +run_dialyzer(Files) -> + dialyzer:run([{analysis_type, plt_build}, + {files, Files}, + {from, byte_code}, + {check_plt, false}]). + +%%% [James Fish:] +%%% If a function is removed from a module and the module has previously +%%% been added to a PLT, the function will not be removed from PLT when +%%% the PLT is checked. This results in dialyzer failing to produce a +%%% callgraph warning when doing success typings analysis if the remove +%%% function is still called in another module +%%% As the function is not removed from the PLT a prior warning, such as a +%%% contract types warning, might be emitted when the removed function +%%% nolonger exists. +update_plt(Config) -> + PrivDir = ?config(priv_dir, Config), + Prog1 = <<"-module(plt_gc). + -export([one/0]). + one() -> + one.">>, + {ok, Beam} = compile(Config, Prog1, plt_gc, []), + + ErlangBeam = case code:where_is_file("erlang.beam") of + non_existing -> + filename:join([code:root_dir(), + "erts", "preloaded", "ebin", + "erlang.beam"]); + EBeam -> + EBeam + end, + Plt = filename:join(PrivDir, "plt_gc.plt"), + Opts = [{check_plt, true}, {from, byte_code}], + [] = dialyzer:run([{analysis_type, plt_build}, + {files, [Beam, ErlangBeam]}, + {output_plt, Plt}] ++ Opts), + + Prog2 = <<"-module(plt_gc). + -export([two/0]). + two() -> + two.">>, + {ok, Beam} = compile(Config, Prog2, plt_gc, []), + + Test = <<"-module(test). + -export([test/0]). + -spec test() -> test. + test() -> + plt_gc:one().">>, + {ok, TestBeam} = compile(Config, Test, test, []), + [{warn_callgraph, _, {call_to_missing, [plt_gc, one, 0]}}] = + dialyzer:run([{analysis_type, succ_typings}, + {files, [TestBeam]}, + {init_plt, Plt}] ++ Opts), + ok. + +compile(Config, Prog, Module, CompileOpts) -> + Source = lists:concat([Module, ".erl"]), + PrivDir = ?config(priv_dir,Config), + Filename = filename:join([PrivDir, Source]), + ok = file:write_file(Filename, Prog), + Opts = [{outdir, PrivDir}, debug_info | CompileOpts], + {ok, Module} = compile:file(Filename, Opts), + {ok, filename:join([PrivDir, lists:concat([Module, ".beam"])])}. diff --git a/lib/dialyzer/test/r9c_SUITE_data/dialyzer_options b/lib/dialyzer/test/r9c_SUITE_data/dialyzer_options index ba0e6b1ad7..e00e23bb66 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/r9c_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ -{dialyzer_options, [{defines, [{vsn, 42}]}, {warnings, [no_unknown]}]}. +{dialyzer_options, [{defines, [{vsn, 42}]}]}. {time_limit, 20}. diff --git a/lib/dialyzer/test/race_SUITE_data/dialyzer_options b/lib/dialyzer/test/race_SUITE_data/dialyzer_options index 6992fc6c40..44e1720715 100644 --- a/lib/dialyzer/test/race_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/race_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, [{warnings, [race_conditions, no_unknown]}]}. +{dialyzer_options, [{warnings, [race_conditions]}]}. diff --git a/lib/dialyzer/test/small_SUITE_data/dialyzer_options b/lib/dialyzer/test/small_SUITE_data/dialyzer_options index 0d91699e4d..50991c9bc5 100644 --- a/lib/dialyzer/test/small_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/small_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, [{warnings, [no_unknown]}]}. +{dialyzer_options, []}. diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps_sum b/lib/dialyzer/test/small_SUITE_data/results/maps_sum new file mode 100644 index 0000000000..a19c0bba96 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/maps_sum @@ -0,0 +1,4 @@ + +maps_sum.erl:15: Invalid type specification for function maps_sum:wrong1/1. The success typing is (#{}) -> 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/inv_mult.erl b/lib/dialyzer/test/small_SUITE_data/src/inv_mult.erl new file mode 100644 index 0000000000..3413556813 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/inv_mult.erl @@ -0,0 +1,15 @@ +%% Dialyzer was too constraining when checking the relation between the +%% arguments and result of a multiplication. We should not constrain an argument +%% if the other operand *may* be zero. +%% +%% Bug found by Kostis Sagonas, fixed by Stavros Aronis + +-module(inv_mult). +-compile(export_all). + +main(L) -> + N = -1 * length(L), + fact(N). + +fact(0) -> 1; +fact(N) -> N * fact(N-1). diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps_sum.erl b/lib/dialyzer/test/small_SUITE_data/src/maps_sum.erl new file mode 100644 index 0000000000..a73ac555c9 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/maps_sum.erl @@ -0,0 +1,31 @@ +-module(maps_sum). +-export([correct1/1, + wrong1/1, + wrong2/1]). + +-spec correct1(#{atom() => term()}) -> integer(). + +correct1(Data) -> + maps:fold(fun (_Key, Value, Acc) when is_integer(Value) -> + Acc + Value; + (_Key, _Value, Acc) -> + Acc + end, 0, Data). + +-spec wrong1([{atom(),term()}]) -> integer(). + +wrong1(Data) -> + maps:fold(fun (_Key, Value, Acc) when is_integer(Value) -> + Acc + Value; + (_Key, _Value, Acc) -> + Acc + end, 0, Data). + +-spec wrong2(#{atom() => term()}) -> integer(). + +wrong2(Data) -> + lists:foldl(fun (_Key, Value, Acc) when is_integer(Value) -> + Acc + Value; + (_Key, _Value, Acc) -> + Acc + end, 0, Data). diff --git a/lib/dialyzer/test/small_SUITE_data/src/suppression3.erl b/lib/dialyzer/test/small_SUITE_data/src/suppression3.erl new file mode 100644 index 0000000000..4a745cffc2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/suppression3.erl @@ -0,0 +1,17 @@ +-module(suppression3). + +-export([a/1, b/1]). + +-dialyzer({nowarn_function, a/1}). + +-spec a(_) -> integer(). + +a(A) -> + ?MODULE:missing(A). + +-dialyzer({no_missing_calls, b/1}). + +-spec b(_) -> integer(). + +b(A) -> + ?MODULE:missing(A). diff --git a/lib/dialyzer/test/underspecs_SUITE_data/dialyzer_options b/lib/dialyzer/test/underspecs_SUITE_data/dialyzer_options index 6843119b9d..f7197ac30f 100644 --- a/lib/dialyzer/test/underspecs_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/underspecs_SUITE_data/dialyzer_options @@ -1 +1 @@ -{dialyzer_options, [{warnings, [underspecs, no_unknown]}]}. +{dialyzer_options, [{warnings, [underspecs]}]}. diff --git a/lib/dialyzer/test/user_SUITE_data/dialyzer_options b/lib/dialyzer/test/user_SUITE_data/dialyzer_options index d20ecd389f..513ed7752b 100644 --- a/lib/dialyzer/test/user_SUITE_data/dialyzer_options +++ b/lib/dialyzer/test/user_SUITE_data/dialyzer_options @@ -1,2 +1,2 @@ -{dialyzer_options, [{warnings, [no_unknown]}]}. +{dialyzer_options, []}. {time_limit, 3}.
\ No newline at end of file diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk index e7c13f04ad..527afaf4ef 100644 --- a/lib/dialyzer/vsn.mk +++ b/lib/dialyzer/vsn.mk @@ -1 +1 @@ -DIALYZER_VSN = 2.7.3 +DIALYZER_VSN = 2.7.4 diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 638c1c4c2b..ea175a58b8 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -303,7 +303,7 @@ Defaults to <c>none</c>.</p> <tag><c>{timeout, &dict_Unsigned32;}</c></tag> <item> <p> -The number of milliseconds after which the request should +Number of milliseconds after which the request should timeout. Defaults to 5000.</p> </item> @@ -674,7 +674,7 @@ connection establishment.</p> <tag><c>{'CEA', Result, Caps, Pkt}</c></tag> <item> <pre> -Result = integer() | atom() | {capabilities_cb, CB, ResultCode|discard} +Result = ResultCode | atom() | {capabilities_cb, CB, ResultCode|discard} Caps = #diameter_caps{} Pkt = #diameter_packet{} ResultCode = integer() @@ -742,7 +742,7 @@ info fields of forms other than the above.</p> <tag><c>service_name() = term()</c></tag> <item> <p> -The name of a service as passed to &start_service; and with which the +Name of a service as passed to &start_service; and with which the service is identified. There can be at most one service with a given name on a given node. Note that &make_ref; @@ -754,7 +754,7 @@ can be used to generate a service name that is somewhat unique.</p> <tag><c>service_opt()</c></tag> <item> <p> -An option passed to &start_service;. +Option passed to &start_service;. Can be any <c>&capability;</c> as well as the following.</p> <taglist> @@ -762,7 +762,7 @@ Can be any <c>&capability;</c> as well as the following.</p> <tag><c>{application, [&application_opt;]}</c></tag> <item> <p> -Defines a Diameter application supported by the service.</p> +A Diameter application supported by the service.</p> <p> A service must configure one tuple for each Diameter @@ -783,6 +783,27 @@ be matched by corresponding &capability; configuration, of </item> +<marker id="incoming_maxlen"/> +<tag><c>{incoming_maxlen, 0..16777215}</c></tag> +<item> +<p> +Bound on the expected size of incoming Diameter messages. +Messages larger than the specified number of bytes are discarded.</p> + +<p> +Defaults to <c>16777215</c>, the maximum value of the 24-bit Message +Length field in a Diameter Header.</p> + +<warning> +<p> +This option should be set to as low a value as is sufficient for the +Diameter applications and peers in question, since decoding incoming +messages from a malicious peer can otherwise generate significant +load.</p> +</warning> + +</item> + <tag><c>{restrict_connections, false | node | nodes @@ -790,7 +811,7 @@ be matched by corresponding &capability; configuration, of | evaluable()}</c></tag> <item> <p> -Specifies the degree to which the service allows multiple transport +The degree to which the service allows multiple transport connections to the same peer, as identified by its Origin-Host at capabilities exchange.</p> @@ -816,7 +837,7 @@ Defaults to <c>nodes</c>.</p> <tag><c>{sequence, {H,N} | &evaluable;}</c></tag> <item> <p> -Specifies a constant value <c>H</c> for the topmost <c>32-N</c> bits of +A constant value <c>H</c> for the topmost <c>32-N</c> bits of of 32-bit End-to-End and Hop-by-Hop Identifiers generated by the service, either explicitly or as a return value of a function to be evaluated at &start_service;. @@ -851,7 +872,7 @@ outgoing requests.</p> <tag><c>{share_peers, boolean() | [node()] | evaluable()}</c></tag> <item> <p> -Specifies nodes to which peer connections established on the local +Nodes to which peer connections established on the local Erlang node are communicated. Shared peers become available in the remote candidates list passed to &app_pick_peer; callbacks on remote nodes whose services are @@ -890,7 +911,7 @@ of a single Diameter node across multiple Erlang nodes.</p> <tag><c>{spawn_opt, [term()]}</c></tag> <item> <p> -An options list passed to &spawn_opt; when spawning a process for an +Options list passed to &spawn_opt; when spawning a process for an incoming Diameter request, unless the transport in question specifies another value. Options <c>monitor</c> and <c>link</c> are ignored.</p> @@ -899,10 +920,34 @@ Options <c>monitor</c> and <c>link</c> are ignored.</p> Defaults to the empty list.</p> </item> +<marker id="string_decode"/> +<tag><c>{string_decode, boolean()}</c></tag> +<item> +<p> +Whether or not to decode AVPs of type &dict_OctetString; and its +derived types &dict_DiameterIdentity;, &dict_DiameterURI;, +&dict_IPFilterRule;, &dict_QoSFilterRule;, and &dict_UTF8String;. +If <c>true</c> then AVPs of these types are decoded to string(). +If <c>false</c> then values are retained as binary().</p> + +<p> +Defaults to <c>true</c>.</p> + +<warning> +<p> +This option should be set to <c>false</c> +since a sufficiently malicious peer can otherwise cause large amounts +of memory to be consumed when decoded Diameter messages are passed +between processes. +The default value is for backwards compatibility.</p> +</warning> + +</item> + <tag><c>{use_shared_peers, boolean() | [node()] | evaluable()}</c></tag> <item> <p> -Specifies nodes from which communicated peers are made available in +Nodes from which communicated peers are made available in the remote candidates list of &app_pick_peer; callbacks.</p> <p> @@ -942,7 +987,7 @@ each node from which requests are sent.</p> <tag><c>transport_opt()</c></tag> <item> <p> -An option passed to &add_transport;. +Option passed to &add_transport;. Has one of the following types.</p> <taglist> @@ -950,8 +995,7 @@ Has one of the following types.</p> <tag><c>{applications, [&application_alias;]}</c></tag> <item> <p> -The list of Diameter applications to which the transport should be -restricted. +Diameter applications to which the transport should be restricted. Defaults to all applications configured on the service in question. Applications not configured on the service in question are ignored.</p> @@ -984,7 +1028,7 @@ TLS is desired over TCP as implemented by &man_tcp;.</p> <tag><c>{capabilities_cb, &evaluable;}</c></tag> <item> <p> -A callback invoked upon reception of CER/CEA during capabilities +Callback invoked upon reception of CER/CEA during capabilities exchange in order to ask whether or not the connection should be accepted. Applied to the <c>&transport_ref;</c> and @@ -1115,7 +1159,7 @@ Defaults to <c>rebooting</c> for <c>Reason=service|application</c> and <p> Number of milliseconds after which the transport process is terminated if DPA has not been received. -Defaults to 1000.</p> +Defaults to the value of &dpa_timeout;.</p> </item> </taglist> </item> @@ -1152,6 +1196,29 @@ configured them.</p> Defaults to a single callback returning <c>dpr</c>.</p> </item> +<marker id="dpa_timeout"/> +<tag><c>{dpa_timeout, &dict_Unsigned32;}</c></tag> +<item> +<p> +Number of milliseconds after which a transport connection is +terminated following an outgoing DPR if DPA is not received.</p> + +<p> +Defaults to 1000.</p> +</item> + +<marker id="dpr_timeout"/> +<tag><c>{dpr_timeout, &dict_Unsigned32;}</c></tag> +<item> +<p> +Number of milliseconds after which a transport connection is +terminated following an incoming DPR if the peer does not close the +connection.</p> + +<p> +Defaults to 5000.</p> +</item> + <marker id="length_errors"/> <tag><c>{length_errors, exit|handle|discard}</c></tag> <item> @@ -1207,7 +1274,7 @@ the same peer.</p> <tag><c>{spawn_opt, [term()]}</c></tag> <item> <p> -Options list passed to &spawn_opt; when spawning a process for an +Options passed to &spawn_opt; when spawning a process for an incoming Diameter request. Options <c>monitor</c> and <c>link</c> are ignored.</p> @@ -1753,7 +1820,8 @@ The information presented here is as in the <c>connect</c> case except that the client connections are grouped under an <c>accept</c> tuple.</p> <p> -Whether or not the &transport_opt; <c>pool_size</c> affects the format +Whether or not the &transport_opt; <c>pool_size</c> has been +configured affects the format of the listing in the case of a connecting transport, since a value greater than 1 implies multiple transport processes for the same <c>&transport_ref;</c>, as in the listening case. diff --git a/lib/diameter/doc/src/diameter_dict.xml b/lib/diameter/doc/src/diameter_dict.xml index 810a146b88..5cf1b174a0 100644 --- a/lib/diameter/doc/src/diameter_dict.xml +++ b/lib/diameter/doc/src/diameter_dict.xml @@ -529,6 +529,11 @@ answer record and passed to a &app_handle_request; callback upon reception of an incoming request.</p> <p> +In cases in which there is a choice between string() and binary() types +for OctetString() and derived types, the representation is determined +by the value of &mod_string_decode;.</p> + +<p> <em>Basic AVP Data Formats</em></p> <marker id="OctetString"/> @@ -541,7 +546,7 @@ callback upon reception of an incoming request.</p> <marker id="Grouped"/> <pre> -OctetString() = [0..255] +OctetString() = string() | binary() Integer32() = -2147483647..2147483647 Integer64() = -9223372036854775807..9223372036854775807 Unsigned32() = 0..4294967295 @@ -603,7 +608,7 @@ and <c>{{2104,2,26},{9,42,23}}</c> (both inclusive) can be encoded.</p> <marker id="UTF8String"/> <pre> -UTF8String() = [integer()] +UTF8String() = [integer()] | binary() </pre> <p> diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index e6ac332c10..6931788c83 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -42,6 +42,230 @@ first.</p> <!-- ===================================================================== --> +<section><title>diameter 1.9.1</title> + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + Don't leave extra bit in decoded AVP data.</p> + <p> + OTP-12074 in OTP 17.3 missed one case: a length error on + a trailing AVP unknown to the dictionary in question.</p> + <p> + Own Id: OTP-12642</p> + </item> + <item> + <p> + Don't confuse Result-Code and Experimental-Result</p> + <p> + The errors field of a decoded diameter_packet record was + populated with a Result-Code AVP when an + Experimental-Result containing a 3xxx Result-Code was + received in an answer not setting the E-bit. The correct + AVP is now extracted from the incoming message.</p> + <p> + Own Id: OTP-12654 Aux Id: seq12851 </p> + </item> + <item> + <p> + Don't count on unknown Application Id.</p> + <p> + OTP-11721 in OTP 17.1 missed the case of an Application + Id not agreeing with that of the dictionary in question, + causing counters to be accumulated on keys containing the + unknown id.</p> + <p> + Own Id: OTP-12701</p> + </item> + </list> + </section> + +</section> + +<section><title>diameter 1.9</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Don't discard outgoing answers unnecessarily.</p> + <p> + Answers missing a Result-Code AVP or setting an E-bit + inappropriately were discarded even if encode was + successful.</p> + <p> + Own Id: OTP-11492</p> + </item> + <item> + <p> + Increase supervision timeouts.</p> + <p> + At diameter application shutdown, DPR could be omitted on + open peer connections because of short supervision + timeouts.</p> + <p> + Own Id: OTP-12412</p> + </item> + <item> + <p> + Fix retransmission of messages sent as header/avps list.</p> + <p> + Extracting End-to-End and Hop-by-Hop Identifiers resulted + in a function clause error, resulting in a handle_error + callback.</p> + <p> + Own Id: OTP-12415</p> + </item> + <item> + <p> + Fix diameter_avp decode of Grouped AVPs having decode + errors.</p> + <p> + Components of such an AVP were not extracted, causing it + to be represented by a single diameter_avp record instead + of the intended list.</p> + <p> + Dictionary files must be recompiled for the fix to have + effect.</p> + <p> + Own Id: OTP-12475</p> + </item> + <item> + <p> + Fix ordering of AVPs in relayed messages.</p> + <p> + The order was reversed relative to the received order, + with a Route-Record AVP prepended.</p> + <p> + Thanks to Andrzej Trawiński.</p> + <p> + Own Id: OTP-12551</p> + </item> + <item> + <p> + Fix issues with DiameterURI encode/decode.</p> + <p> + RFC 6773 changed the default port and transport, but the + RFC 3588 defaults were used even if the RFC 6733 common + dictionary was in use. The RFC 3588 defaults are now only + used when the common dictionary is + diameter_gen_base_rfc3588.</p> + <p> + Both RFC 3588 and 6733 disallow + transport=udp;protocol=diameter. Encode of the + combination now fails.</p> + <p> + Decode of ports numbers outside the range 0-65535 and + fully qualified domain names longer than 255 octets now + fails.</p> + <p> + Note that RFC 3588 is obsolete, and that there is a + diameter_gen_base_rfc6733. The change in defaults is a + potential interoperability problem when moving to RFC + 6733 with peers that do not send all URI components. The + fact that 6733 allows 5xxx result codes in answer + messages setting the E-bit, which RFC 3588 doesn't, is + another.</p> + <p> + Own Id: OTP-12589</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add service_opt() string_decode.</p> + <p> + To disable the decode of potentially large binaries to + string. This prevents large strings from being copied + when incoming Diameter messages are passed between + processes, a vulnerability that can lead to memory being + exhausted given sufficiently malicious peers.</p> + <p> + The value is a boolean(), true being the default for + backwards compatibility. Setting false causes both + diameter_caps records and decoded messages to contain + binary() in relevant places that previously had string(): + diameter_app(3) callbacks need to be prepared for the + change.</p> + <p> + The Diameter types affected are OctetString and the + derived types UTF8String, DiameterIdentity, DiameterURI, + IPFilterRule, and QoSFilterRule. Time and Address are + unaffected.</p> + <p> + Own Id: OTP-11952</p> + </item> + <item> + <p> + Add transport_opt() pool_size.</p> + <p> + To allow for pools of accepting transport processes, + which can better service multiple simultaneous peer + connections. The option can also be used with connecting + transports, to establish multiple connections to the same + peer without having to configure multiple transports.</p> + <p> + Own Id: OTP-12428</p> + </item> + <item> + <p> + Allow DPR to be sent with diameter:call/4.</p> + <p> + It has been possible to send, but the answer was regarded + as unsolicited and discarded. DPA now causes the + transport process in question to be terminated, as for + DPR that diameter itself sends.</p> + <p> + Own Id: OTP-12542</p> + </item> + <item> + <p> + Discard requests after DPR.</p> + <p> + RFC 6733 is imprecise, but the tone is that messages + received after DPR are an exception to be dealt with only + because of the possibility of unordered delivery over + SCTP. As a consequence, and because a request following + DPR is unlikely to be answered due to the impending loss + of the peer connection, discard outgoing requests + following an outgoing or incoming DPR. Incoming requests + are also discarded, with the exception of DPR itself. + Answers are sent and received as usual.</p> + <p> + Own Id: OTP-12543</p> + </item> + <item> + <p> + Add transport_opt() dpr_timeout.</p> + <p> + To cause a peer connection to be closed following an + outgoing DPA when the peer fails to do so. It is the + recipient of DPA that should close the connection + according to RFC 6733.</p> + <p> + Own Id: OTP-12609</p> + </item> + <item> + <p> + Add service_opt() incoming_maxlen.</p> + <p> + To bound the expected size of incoming Diameter messages. + Messages larger than the specified number of bytes are + discarded, to prevent a malicious peer from generating + excessive load.</p> + <p> + Own Id: OTP-12628</p> + </item> + </list> + </section> + +</section> + <section><title>diameter 1.8</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/diameter/doc/src/seealso.ent b/lib/diameter/doc/src/seealso.ent index 44541afb9b..4e205ffad7 100644 --- a/lib/diameter/doc/src/seealso.ent +++ b/lib/diameter/doc/src/seealso.ent @@ -4,7 +4,7 @@ %CopyrightBegin% -Copyright Ericsson AB 2012-2014. All Rights Reserved. +Copyright Ericsson AB 2012-2015. All Rights Reserved. The contents of this file are subject to the Erlang Public License, Version 1.1, (the "License"); you may not use this file except in @@ -64,11 +64,14 @@ significant. <!ENTITY capabilities_cb '<seealso marker="#capabilities_cb">capabilities_cb</seealso>'> <!ENTITY capx_timeout '<seealso marker="#capx_timeout">capx_timeout</seealso>'> <!ENTITY disconnect_cb '<seealso marker="#disconnect_cb">disconnect_cb</seealso>'> +<!ENTITY dpa_timeout '<seealso marker="#dpa_timeout">dpa_timeout</seealso>'> <!ENTITY transport_config '<seealso marker="#transport_config">transport_config</seealso>'> <!ENTITY transport_module '<seealso marker="#transport_module">transport_module</seealso>'> <!ENTITY connect_timer '<seealso marker="#connect_timer">connect_timer</seealso>'> <!ENTITY watchdog_timer '<seealso marker="#watchdog_timer">watchdog_timer</seealso>'> +<!ENTITY mod_string_decode '<seealso marker="diameter#service_opt">diameter:service_opt()</seealso> <seealso marker="diameter#string_decode">string_decode</seealso>'> + <!-- diameter_app --> <!ENTITY app_handle_answer '<seealso marker="diameter_app#Mod:handle_answer-4">handle_answer/4</seealso>'> @@ -102,6 +105,9 @@ significant. <!ENTITY dict_Address '<seealso marker="diameter_dict#DATA_TYPES">Address()</seealso>'> <!ENTITY dict_DiameterIdentity '<seealso marker="diameter_dict#DATA_TYPES">DiameterIdentity()</seealso>'> +<!ENTITY dict_DiameterURI '<seealso marker="diameter_dict#DATA_TYPES">DiameterURI()</seealso>'> +<!ENTITY dict_IPFilterRule '<seealso marker="diameter_dict#DATA_TYPES">IPFilterRule()</seealso>'> +<!ENTITY dict_QoSFilterRule '<seealso marker="diameter_dict#DATA_TYPES">QoSFilterRule()</seealso>'> <!ENTITY dict_Grouped '<seealso marker="diameter_dict#DATA_TYPES">Grouped()</seealso>'> <!ENTITY dict_OctetString '<seealso marker="diameter_dict#DATA_TYPES">OctetString()</seealso>'> <!ENTITY dict_Time '<seealso marker="diameter_dict#DATA_TYPES">Time()</seealso>'> diff --git a/lib/diameter/examples/code/client.erl b/lib/diameter/examples/code/client.erl index be5b4cbba5..844c9cdbdd 100644 --- a/lib/diameter/examples/code/client.erl +++ b/lib/diameter/examples/code/client.erl @@ -41,6 +41,7 @@ -include_lib("diameter/include/diameter_gen_base_rfc6733.hrl"). -export([start/1, %% start a service + start/2, %% connect/2, %% add a connecting transport call/1, %% send using the record encoding cast/1, %% send using the list encoding and detached @@ -68,6 +69,7 @@ {'Vendor-Id', 0}, {'Product-Name', "Client"}, {'Auth-Application-Id', [0]}, + {string_decode, false}, {application, [{alias, common}, {dictionary, diameter_gen_base_rfc6733}, {module, client_cb}]}]). @@ -76,11 +78,23 @@ start(Name) when is_atom(Name) -> - node:start(Name, ?SERVICE(Name)). + start(Name, []); + +start(Opts) + when is_list(Opts) -> + start(?DEF_SVC_NAME, Opts). + +%% start/0 start() -> start(?DEF_SVC_NAME). +%% start/2 + +start(Name, Opts) -> + node:start(Name, Opts ++ [T || {K,_} = T <- ?SERVICE(Name), + false == lists:keymember(K, 1, Opts)]). + %% connect/2 connect(Name, T) -> diff --git a/lib/diameter/examples/code/relay.erl b/lib/diameter/examples/code/relay.erl index 0aa3cd06d3..7bc46dc68d 100644 --- a/lib/diameter/examples/code/relay.erl +++ b/lib/diameter/examples/code/relay.erl @@ -32,6 +32,7 @@ -module(relay). -export([start/1, + start/2, listen/2, connect/2, stop/1]). @@ -49,6 +50,7 @@ {'Vendor-Id', 193}, {'Product-Name', "RelayAgent"}, {'Auth-Application-Id', [16#FFFFFFFF]}, + {string_decode, false}, {application, [{alias, relay}, {dictionary, diameter_relay}, {module, relay_cb}]}]). @@ -57,11 +59,19 @@ start(Name) when is_atom(Name) -> - node:start(Name, ?SERVICE(Name)). + start(Name, []). + +%% start/1 start() -> start(?DEF_SVC_NAME). +%% start/2 + +start(Name, Opts) -> + node:start(Name, Opts ++ [T || {K,_} = T <- ?SERVICE(Name), + false == lists:keymember(K, 1, Opts)]). + %% listen/2 listen(Name, T) -> diff --git a/lib/diameter/examples/code/server.erl b/lib/diameter/examples/code/server.erl index 8c91e68895..f32cec594c 100644 --- a/lib/diameter/examples/code/server.erl +++ b/lib/diameter/examples/code/server.erl @@ -35,6 +35,7 @@ -module(server). -export([start/1, %% start a service + start/2, %% listen/2, %% add a listening transport stop/1]). %% stop a service @@ -53,6 +54,8 @@ {'Vendor-Id', 193}, {'Product-Name', "Server"}, {'Auth-Application-Id', [0]}, + {restrict_connections, false}, + {string_decode, false}, {application, [{alias, common}, {dictionary, diameter_gen_base_rfc6733}, {module, server_cb}]}]). @@ -61,11 +64,23 @@ start(Name) when is_atom(Name) -> - node:start(Name, ?SERVICE(Name)). + start(Name, []); + +start(Opts) + when is_list(Opts) -> + start(?DEF_SVC_NAME, Opts). + +%% start/0 start() -> start(?DEF_SVC_NAME). +%% start/2 + +start(Name, Opts) -> + node:start(Name, Opts ++ [T || {K,_} = T <- ?SERVICE(Name), + false == lists:keymember(K, 1, Opts)]). + %% listen/2 listen(Name, T) -> diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl index 8272904856..e8ffe7f92c 100644 --- a/lib/diameter/include/diameter_gen.hrl +++ b/lib/diameter/include/diameter_gen.hrl @@ -395,7 +395,7 @@ d(false, Reason, Name, Avp, {Avps, Acc}) -> diameter_lib:log(decode_error, ?MODULE, ?LINE, - {Reason, Name, Avp#diameter_avp.name, Stack}), + {Name, Avp#diameter_avp.name, Stack}), {Rec, Failed} = Acc, {[Avp|Avps], {Rec, [rc(Reason, Avp) | Failed]}}. @@ -445,7 +445,7 @@ reset(_, _) -> %% undecoded. Note that the type field is 'undefined' in this case. decode_AVP(Name, Avp, {Avps, Acc}) -> - {[Avp | Avps], pack_AVP(Name, Avp, Acc)}. + {[trim(Avp) | Avps], pack_AVP(Name, Avp, Acc)}. %% rc/1 diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl index 1bbdf6e34d..010f977b97 100644 --- a/lib/diameter/src/base/diameter.erl +++ b/lib/diameter/src/base/diameter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -45,6 +45,7 @@ -export_type([evaluable/0, restriction/0, + message_length/0, remotes/0, sequence/0, app_alias/0, @@ -298,6 +299,9 @@ call(SvcName, App, Message) -> | [node()] | evaluable(). +-type message_length() + :: 0..16#FFFFFF. + %% Options passed to start_service/2 -type service_opt() @@ -306,6 +310,8 @@ call(SvcName, App, Message) -> | {restrict_connections, restriction()} | {sequence, sequence() | evaluable()} | {share_peers, remotes()} + | {string_decode, boolean()} + | {incoming_maxlen, message_length()} | {use_shared_peers, remotes()} | {spawn_opt, list()}. @@ -343,6 +349,8 @@ call(SvcName, App, Message) -> | {capabilities_cb, evaluable()} | {capx_timeout, 'Unsigned32'()} | {disconnect_cb, evaluable()} + | {dpr_timeout, 'Unsigned32'()} + | {dpa_timeout, 'Unsigned32'()} | {length_errors, exit | handle | discard} | {connect_timer, 'Unsigned32'()} | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl index 93548ecafd..7dc61f229f 100644 --- a/lib/diameter/src/base/diameter_capx.erl +++ b/lib/diameter/src/base/diameter_capx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -50,7 +50,8 @@ -export([build_CER/2, recv_CER/3, recv_CEA/3, - make_caps/2]). + make_caps/2, + binary_caps/1]). -include_lib("diameter/include/diameter.hrl"). -include("diameter_internal.hrl"). @@ -115,7 +116,8 @@ mk_caps(Caps0, Opts) -> -define(SC(K,F), set_cap({K, Val}, {Caps, #diameter_caps{F = false} = C}) -> - {Caps#diameter_caps{F = cap(K, Val)}, C#diameter_caps{F = true}}). + {Caps#diameter_caps{F = cap(K, copy(Val))}, + C#diameter_caps{F = true}}). ?SC('Origin-Host', origin_host); ?SC('Origin-Realm', origin_realm); @@ -375,10 +377,10 @@ capx_to_caps(CEX, Dict) -> 'Firmware-Revision', 'AVP'], CEX), - #diameter_caps{origin_host = OH, - origin_realm = OR, + #diameter_caps{origin_host = copy(OH), + origin_realm = copy(OR), vendor_id = VId, - product_name = PN, + product_name = copy(PN), origin_state_id = OSI, host_ip_address = IP, supported_vendor_id = SV, @@ -389,6 +391,32 @@ capx_to_caps(CEX, Dict) -> firmware_revision = FR, avp = X}. +%% Copy binaries to avoid retaining a reference to a large binary +%% containing AVPs we aren't interested in. +copy(B) + when is_binary(B) -> + binary:copy(B); + +copy(T) -> + T. + +%% binary_caps/1 +%% +%% Encode stringish capabilities with {string_decode, false}. + +binary_caps(Caps) -> + lists:foldl(fun bcaps/2, Caps, [#diameter_caps.origin_host, + #diameter_caps.origin_realm, + #diameter_caps.product_name]). + +bcaps(N, Caps) -> + case element(N, Caps) of + undefined -> + Caps; + V -> + setelement(N, Caps, iolist_to_binary(V)) + end. + %% --------------------------------------------------------------------------- %% --------------------------------------------------------------------------- diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index b4ecb63961..bf2fe8e7ca 100644 --- a/lib/diameter/src/base/diameter_codec.erl +++ b/lib/diameter/src/base/diameter_codec.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -22,6 +22,8 @@ -export([encode/2, decode/2, decode/3, + setopts/1, + getopt/1, collect_avps/1, decode_header/1, sequence_numbers/1, @@ -59,6 +61,50 @@ %% +-+-+-+-+-+-+-+-+-+-+-+-+- %%% --------------------------------------------------------------------------- +%%% # setopts/1 +%%% # getopt/1 +%%% --------------------------------------------------------------------------- + +%% These functions are a compromise in the same vein as the use of the +%% process dictionary in diameter_gen.hrl in generated codec modules. +%% Instead of rewriting the entire dictionary generation to pass +%% encode/decode options around, the calling process sets them by +%% calling setopts/1. At current, the only option is whether or not to +%% decode binaries as strings, which is used by diameter_types. + +setopts(Opts) + when is_list(Opts) -> + lists:foreach(fun setopt/1, Opts). + +%% Decode stringish types to string()? The default true is for +%% backwards compatibility. +setopt({string_decode = K, false = B}) -> + setopt(K, B); + +%% Regard anything but the generated RFC 3588 dictionary as modern. +%% This affects the interpretation of defaults during the decode +%% of values of type DiameterURI, this having changed from RFC 3588. +%% (So much for backwards compatibility.) +setopt({common_dictionary, diameter_gen_base_rfc3588}) -> + setopt(rfc, 3588); + +setopt(_) -> + ok. + +setopt(Key, Value) -> + put({diameter, Key}, Value). + +getopt(Key) -> + case get({diameter, Key}) of + undefined when Key == string_decode -> + true; + undefined when Key == rfc -> + 6733; + V -> + V + end. + +%%% --------------------------------------------------------------------------- %%% # encode/2 %%% --------------------------------------------------------------------------- @@ -90,7 +136,7 @@ encode(Mod, Msg) -> msg = Msg}). e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) -> - try encode_avps(As) of + try encode_avps(reorder(As)) of Avps -> Length = size(Avps) + 20, @@ -183,26 +229,50 @@ values(Avps) -> %% Message as a list of #diameter_avp{} ... encode_avps(_, _, [#diameter_avp{} | _] = Avps) -> - encode_avps(reorder(Avps, [], Avps)); + encode_avps(reorder(Avps)); %% ... or as a tuple list or record. encode_avps(Mod, MsgName, Values) -> Mod:encode_avps(MsgName, Values). %% reorder/1 +%% +%% Reorder AVPs for the relay case using the index field of +%% diameter_avp records. Decode populates this field in collect_avps +%% and presents AVPs in reverse order. A relay then sends the reversed +%% list with a Route-Record AVP prepended. The goal here is just to do +%% lists:reverse/1 in Grouped AVPs and the outer list, but only in the +%% case there are indexed AVPs at all, so as not to reverse lists that +%% have been explicilty sent (unindexed, in the desired order) as a +%% diameter_avp list. The effect is the same as lists:keysort/2, but +%% only on the cases we expect, not a general sort. + +reorder(Avps) -> + case reorder(Avps, []) of + false -> + Avps; + Sorted -> + Sorted + end. -reorder([#diameter_avp{index = 0} | _] = Avps, Acc, _) -> +%% reorder/3 + +%% In case someone has reversed the list already. (Not likely.) +reorder([#diameter_avp{index = 0} | _] = Avps, Acc) -> Avps ++ Acc; -reorder([#diameter_avp{index = N} = A | Avps], Acc, _) +%% Assume indexed AVPs are in reverse order. +reorder([#diameter_avp{index = N} = A | Avps], Acc) when is_integer(N) -> lists:reverse(Avps, [A | Acc]); -reorder([H | T], Acc, Avps) -> - reorder(T, [H | Acc], Avps); +%% An unindexed AVP. +reorder([H | T], Acc) -> + reorder(T, [H | Acc]); -reorder([], Acc, _) -> - Acc. +%% No indexed members. +reorder([], _) -> + false. %% encode_avps/1 @@ -570,8 +640,12 @@ split_data(Bin, Len) -> %% payload if this is a request. Do this (in cases that we %% know the type) by inducing a decode failure and letting %% the dictionary's decode (in diameter_gen) deal with it. - %% Here we don't know type. If the type isn't known, then - %% the decode just strips the extra bit. + %% + %% Note that the extra bit can only occur in the trailing + %% AVP of a message or Grouped AVP, since a faulty AVP + %% Length is otherwise indistinguishable from a correct + %% one here, since we don't know the types of the AVPs + %% being extracted. {<<0:1, Bin/binary>>, <<>>} end. @@ -620,8 +694,8 @@ pack_avp(#diameter_avp{code = undefined, data = B}) Len = size(<<H:5/binary, _:24, T/binary>> = <<B/binary, 0:Pad>>), <<H/binary, Len:24, T/binary>>; -%% ... from a dictionary compiled against old code in diameter_gen ... %% ... when ignoring errors in Failed-AVP ... +%% ... during a relay encode ... pack_avp(#diameter_avp{data = <<0:1, B/binary>>} = A) -> pack_avp(A#diameter_avp{data = B}); diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl index c0a4f7df69..8ac3b9d6ca 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -159,7 +159,8 @@ stop_service(SvcName) -> %% # add_transport/2 %% -------------------------------------------------------------------------- --spec add_transport(diameter:service_name(), {connect|listen, [diameter:transport_opt()]}) +-spec add_transport(diameter:service_name(), + {connect|listen, [diameter:transport_opt()]}) -> {ok, diameter:transport_ref()} | {error, term()}. @@ -532,7 +533,10 @@ opt({applications, As}) -> opt({capabilities, Os}) -> is_list(Os) andalso ok == encode_CER(Os); -opt({capx_timeout, Tmo}) -> +opt({K, Tmo}) + when K == capx_timeout; + K == dpr_timeout; + K == dpa_timeout -> ?IS_UINT32(Tmo); opt({length_errors, T}) -> @@ -642,13 +646,24 @@ make_config(SvcName, Opts) -> {false, monitor}, {?NOMASK, sequence}, {nodes, restrict_connections}, + {16#FFFFFF, incoming_maxlen}, + {true, string_decode}, {[], spawn_opt}]), + D = proplists:get_value(string_decode, SvcOpts, true), + #service{name = SvcName, rec = #diameter_service{applications = Apps, - capabilities = Caps}, + capabilities = binary_caps(Caps, D)}, options = SvcOpts}. +binary_caps(Caps, true) -> + Caps; +binary_caps(Caps, false) -> + diameter_capx:binary_caps(Caps). + +%% make_opts/2 + make_opts(Opts, Defs) -> Known = [{K, get_opt(K, Opts, D)} || {D,K} <- Defs], Unknown = Opts -- Known, @@ -657,17 +672,26 @@ make_opts(Opts, Defs) -> [{K, opt(K,V)} || {K,V} <- Known]. +opt(incoming_maxlen, N) + when 0 =< N, N < 1 bsl 24 -> + N; + opt(spawn_opt, L) when is_list(L) -> L; opt(K, false = B) - when K /= sequence -> + when K == share_peers; + K == use_shared_peers; + K == monitor; + K == restrict_connections; + K == string_decode -> B; opt(K, true = B) when K == share_peers; - K == use_shared_peers -> + K == use_shared_peers; + K == string_decode -> B; opt(restrict_connections, T) diff --git a/lib/diameter/src/base/diameter_lib.erl b/lib/diameter/src/base/diameter_lib.erl index d0d730f47c..51d203d722 100644 --- a/lib/diameter/src/base/diameter_lib.erl +++ b/lib/diameter/src/base/diameter_lib.erl @@ -19,6 +19,7 @@ -module(diameter_lib). -compile({no_auto_import, [now/0]}). +-compile({nowarn_deprecated_function, [{erlang, now, 0}]}). -export([info_report/2, error_report/2, @@ -129,12 +130,13 @@ timestamp({_,_,_} = T) -> %% erlang:now() T; timestamp(MonoT) -> %% monotonic time - MicroSecs = erlang:convert_time_resolution(MonoT + erlang:time_offset(), - erlang:time_resolution(), - 1000000), + MicroSecs = monotonic_to_microseconds(MonoT + erlang:time_offset()), Secs = MicroSecs div 1000000, {Secs div 1000000, Secs rem 1000000, MicroSecs rem 1000000}. +monotonic_to_microseconds(MonoT) -> + erlang:convert_time_unit(MonoT, native, micro_seconds). + %% --------------------------------------------------------------------------- %% # now_diff/1 %% --------------------------------------------------------------------------- @@ -164,9 +166,7 @@ micro_diff({_,_,_} = T0) -> timer:now_diff(erlang:now(), T0); micro_diff(T0) -> %% monotonic time - erlang:convert_time_resolution(erlang:monotonic_time() - T0, - erlang:time_resolution(), - 1000000). + monotonic_to_microseconds(erlang:monotonic_time() - T0). %% --------------------------------------------------------------------------- %% # micro_diff/2 @@ -178,9 +178,7 @@ micro_diff(T0) -> %% monotonic time micro_diff(T1, T0) when is_integer(T1), is_integer(T0) -> %% monotonic time - erlang:convert_time_resolution(T1 - T0, - erlang:time_resolution(), - 1000000); + monotonic_to_microseconds(T1 - T0); micro_diff(T1, T0) -> %% at least one erlang:now() timer:now_diff(timestamp(T1), timestamp(T0)). diff --git a/lib/diameter/src/base/diameter_peer.erl b/lib/diameter/src/base/diameter_peer.erl index ea326dd03e..89b63c8a92 100644 --- a/lib/diameter/src/base/diameter_peer.erl +++ b/lib/diameter/src/base/diameter_peer.erl @@ -232,12 +232,22 @@ recv(Pid, Pkt) -> %% # send/2 %% --------------------------------------------------------------------------- -send(Pid, #diameter_packet{transport_data = undefined, - bin = Bin}) -> - send(Pid, Bin); +send(Pid, Msg) -> + ifc_send(Pid, {send, strip(Msg)}). -send(Pid, Pkt) -> - ifc_send(Pid, {send, Pkt}). +%% Send only binary when possible. +strip(#diameter_packet{transport_data = undefined, + bin = Bin}) -> + Bin; + +%% Strip potentially large message terms. +strip(#diameter_packet{transport_data = T, + bin = Bin}) -> + #diameter_packet{transport_data = T, + bin = Bin}; + +strip(Msg) -> + Msg. %% --------------------------------------------------------------------------- %% # close/1 @@ -326,7 +336,6 @@ code_change(_OldVsn, State, _Extra) -> {ok, State}. %% --------------------------------------------------------- -%% INTERNAL FUNCTIONS %% --------------------------------------------------------- %% ifc_send/2 diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index ee6e7dd89e..2255d0a76b 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -63,6 +63,8 @@ %% Keys in process dictionary. -define(CB_KEY, cb). %% capabilities callback -define(DPR_KEY, dpr). %% disconnect callback +-define(DPA_KEY, dpa). %% timeout for incoming DPA, or shutdown after + %% outgoing DPA -define(REF_KEY, ref). %% transport_ref() -define(Q_KEY, q). %% transport start queue -define(START_KEY, start). %% start of connected transport @@ -82,18 +84,26 @@ N == ?GOAWAY; N == goaway; N == ?BUSY; N == busy). -%% RFC 3588: +%% RFC 6733: %% %% Timeout An application-defined timer has expired while waiting %% for some event. %% --define(EVENT_TIMEOUT, 10000). + %% Default timeout for reception of CER/CEA. +-define(CAPX_TIMEOUT, 10000). -%% Default timeout for DPA in response to DPR. A bit short but the -%% timeout used to be hardcoded. (So it could be worse.) +%% Default timeout for DPA to be received in response to an outgoing +%% DPR. A bit short but the timeout used to be hardcoded. (So it could +%% be worse.) -define(DPA_TIMEOUT, 1000). +%% Default timeout for the connection to be closed by the peer +%% following an outgoing DPA in response to an incoming DPR. It's the +%% recipient of DPA that should close the connection according to the +%% RFC. +-define(DPR_TIMEOUT, 5000). + -type uint32() :: diameter:'Unsigned32'(). -record(state, @@ -107,9 +117,16 @@ transport :: pid(), %% transport process dictionary :: module(), %% common dictionary service :: #diameter_service{}, - dpr = false :: false | {uint32(), uint32()}, - %% | hop by hop and end to end identifiers - length_errors :: exit | handle | discard}). + dpr = false :: false + | true %% DPR received, DPA sent + | {uint32(), uint32()} %% set in old code + | {boolean(), uint32(), uint32()}, + %% hop by hop and end to end identifiers in + %% outgoing DPR; boolean says whether or not + %% the request was sent explicitly with + %% diameter:call/4. + length_errors :: exit | handle | discard, + incoming_maxlen :: integer() | infinity}). %% There are non-3588 states possible as a consequence of 5.6.1 of the %% standard and the corresponding problem for incoming CEA's: we don't @@ -138,7 +155,8 @@ %% # start/3 %% --------------------------------------------------------------------------- --spec start(T, [Opt], {diameter:sequence(), +-spec start(T, [Opt], {[diameter:service_opt()] + | diameter:sequence(), %% from old code [node()], module(), #diameter_service{}}) @@ -177,18 +195,26 @@ init(T) -> proc_lib:init_ack({ok, self()}), gen_server:enter_loop(?MODULE, [], i(T)). -i({Ack, WPid, {M, Ref} = T, Opts, {Mask, Nodes, Dict0, Svc}}) -> +i({Ack, WPid, T, Opts, {{_,_} = Mask, Nodes, Dict0, Svc}}) -> %% from old code + i({Ack, WPid, T, Opts, {[{sequence, Mask}], Nodes, Dict0, Svc}}); + +i({Ack, WPid, {M, Ref} = T, Opts, {SvcOpts, Nodes, Dict0, Svc}}) -> erlang:monitor(process, WPid), wait(Ack, WPid), diameter_stats:reg(Ref), + diameter_codec:setopts([{common_dictionary, Dict0} | SvcOpts]), + {_,_} = Mask = proplists:get_value(sequence, SvcOpts), + Maxlen = proplists:get_value(incoming_maxlen, SvcOpts, 16#FFFFFF), {[Cs,Ds], Rest} = proplists:split(Opts, [capabilities_cb, disconnect_cb]), putr(?CB_KEY, {Ref, [F || {_,F} <- Cs]}), putr(?DPR_KEY, [F || {_, F} <- Ds]), putr(?REF_KEY, Ref), putr(?SEQUENCE_KEY, Mask), putr(?RESTRICT_KEY, Nodes), + putr(?DPA_KEY, {proplists:get_value(dpr_timeout, Opts, ?DPR_TIMEOUT), + proplists:get_value(dpa_timeout, Opts, ?DPA_TIMEOUT)}), - Tmo = proplists:get_value(capx_timeout, Opts, ?EVENT_TIMEOUT), + Tmo = proplists:get_value(capx_timeout, Opts, ?CAPX_TIMEOUT), OnLengthErr = proplists:get_value(length_errors, Opts, exit), {TPid, Addrs} = start_transport(T, Rest, Svc), @@ -199,7 +225,8 @@ i({Ack, WPid, {M, Ref} = T, Opts, {Mask, Nodes, Dict0, Svc}}) -> dictionary = Dict0, mode = M, service = svc(Svc, Addrs), - length_errors = OnLengthErr}. + length_errors = OnLengthErr, + incoming_maxlen = Maxlen}. %% The transport returns its local ip addresses so that different %% transports on the same service can use different local addresses. %% The local addresses are put into Host-IP-Address avps here when @@ -212,9 +239,12 @@ wait(Ref, Pid) -> Ref -> ok; {'DOWN', _, process, Pid, _} = D -> - exit({shutdown, D}) + x(D) end. +x(T) -> + exit({shutdown, T}). + start_transport(T, Opts, #diameter_service{capabilities = LCaps} = Svc) -> Addrs0 = LCaps#diameter_caps.host_ip_address, start_transport(Addrs0, {T, Opts, Svc}). @@ -226,7 +256,7 @@ start_transport(Addrs0, T) -> q_next(TPid, Addrs0, Tmo, Data), {TPid, Addrs}; {error, No} -> - exit({shutdown, {no_connection, No}}) + x({no_connection, No}) end. svc(#diameter_service{capabilities = LCaps0} = Svc, Addrs) -> @@ -299,11 +329,14 @@ handle_info(T, #state{} = State) -> {?MODULE, Tag, Reason} -> ?LOG(stop, Tag), {stop, {shutdown, Reason}, State} - end. + end; %% The form of the throw caught here is historical. It's %% significant that it's not a 2-tuple, as in ?FAILURE(Reason), %% since these are caught elsewhere. +handle_info(T, S) -> %% started in old code + handle_info(T, #state{} = erlang:append_element(S, infinity)). + %% Note that there's no guarantee that the service and transport %% capabilities are good enough to build a CER/CEA that can be %% succesfully encoded. It's not checked at diameter:add_transport/2 @@ -333,6 +366,9 @@ eraser(Key) -> %% transition/2 +transition(T, #state{dpr = {Hid, Eid}} = S) -> %% DPR sent from old code + transition(T, S#state{dpr = {false, Hid, Eid}}); + %% Connection to peer. transition({diameter, {TPid, connected, Remote}}, #state{transport = TPid, @@ -397,9 +433,8 @@ transition({timeout, _}, _) -> ok; %% Outgoing message. -transition({send, Msg}, #state{transport = TPid}) -> - send(TPid, Msg), - ok; +transition({send, Msg}, S) -> + outgoing(Msg, S); %% Request for graceful shutdown at remove_transport, stop_service of %% application shutdown. @@ -408,7 +443,8 @@ transition({shutdown, Pid, Reason}, #state{parent = Pid, dpr = false} = S) -> transition({shutdown, Pid, _}, #state{parent = Pid}) -> ok; -%% DPA reception has timed out. +%% DPA reception has timed out, or peer has not closed the connection +%% as a result of outgoing DPA. transition(dpa_timeout, _) -> stop; @@ -516,12 +552,9 @@ encode(Rec, Dict) -> recv(#diameter_packet{header = #diameter_header{} = Hdr} = Pkt, - #state{parent = Pid, - dictionary = Dict0} + #state{dictionary = Dict0} = S) -> - Name = diameter_codec:msg_name(Dict0, Hdr), - Pid ! {recv, self(), Name, Pkt}, - rcv(Name, Pkt, S); + recv1(diameter_codec:msg_name(Dict0, Hdr), Pkt, S); recv(#diameter_packet{header = undefined, bin = Bin} @@ -532,6 +565,47 @@ recv(#diameter_packet{header = undefined, recv(Bin, S) -> recv(#diameter_packet{bin = Bin}, S). +%% recv1/3 + +recv1(_, + #diameter_packet{header = H, bin = Bin}, + #state{incoming_maxlen = M}) + when M < size(Bin) -> + invalid(false, incoming_maxlen_exceeded, {size(Bin), H}); + +%% Incoming request after outgoing DPR: discard. Don't discard DPR, so +%% both ends don't do so when sending simultaneously. +recv1(Name, + #diameter_packet{header = #diameter_header{is_request = true} = H}, + #state{dpr = {_,_,_}}) + when Name /= 'DPR' -> + invalid(false, recv_after_outgoing_dpr, H); + +%% Incoming request after incoming DPR: discard. +recv1(_, + #diameter_packet{header = #diameter_header{is_request = true} = H}, + #state{dpr = true}) -> + invalid(false, recv_after_incoming_dpr, H); + +%% DPA with identifier mismatch, or in response to a DPR initiated by +%% the service. +recv1('DPA' = N, + #diameter_packet{header = #diameter_header{hop_by_hop_id = Hid, + end_to_end_id = Eid}} + = Pkt, + #state{dpr = {X,H,E}} + = S) + when H /= Hid; + E /= Eid; + not X -> + rcv(N, Pkt, S); + +%% Any other message with a header and no length errors: send to the +%% parent. +recv1(Name, Pkt, #state{parent = Pid} = S) -> + Pid ! {recv, self(), Name, Pkt}, + rcv(Name, Pkt, S). + %% recv/3 recv(#diameter_header{length = Len} @@ -588,7 +662,7 @@ rcv(Name, _, #state{state = PS}) rcv('DPR' = N, Pkt, S) -> handle_request(N, Pkt, S); -%% DPA in response to DPR and with the expected identifiers. +%% DPA in response to DPR, with the expected identifiers. rcv('DPA' = N, #diameter_packet{header = #diameter_header{end_to_end_id = Eid, hop_by_hop_id = Hid} @@ -596,14 +670,21 @@ rcv('DPA' = N, = Pkt, #state{dictionary = Dict0, transport = TPid, - dpr = {Hid, Eid}}) -> + dpr = {X, Hid, Eid}}) -> ?LOG(recv, N), - incr(recv, H, Dict0), - incr_rc(recv, diameter_codec:decode(Dict0, Pkt), Dict0), + X orelse begin + %% Only count DPA in response to a DPR sent by the + %% service: explicit DPR is counted in the same way + %% as other explicitly sent requests. + incr(recv, H, Dict0), + incr_rc(recv, diameter_codec:decode(Dict0, Pkt), Dict0) + end, diameter_peer:close(TPid), {stop, N}; -%% Ignore anything else, an unsolicited DPA in particular. +%% Ignore anything else, an unsolicited DPA in particular. Note that +%% dpa_timeout deals with the case in which the peer sends the wrong +%% identifiers in DPA. rcv(N, #diameter_packet{header = H}, _) when N == 'CER'; N == 'CEA'; @@ -637,9 +718,61 @@ incr_error(Dir, Pkt, Dict0) -> %% Msg here could be a #diameter_packet or a binary depending on who's %% sending. In particular, the watchdog will send DWR as a binary %% while messages coming from clients will be in a #diameter_packet. + send(Pid, Msg) -> diameter_peer:send(Pid, Msg). +%% outgoing/2 + +%% Explicit DPR. +outgoing(#diameter_packet{header = #diameter_header{application_id = 0, + cmd_code = 282, + is_request = true} + = H} + = Pkt, + #state{dpr = T, + parent = Pid} + = S) -> + if T == false -> + inform_dpr(Pid), + send_dpr(true, Pkt, dpa_timeout(), S); + T == true -> + invalid(false, dpr_after_dpa, H); %% DPA sent: discard + true -> + invalid(false, dpr_after_dpr, H) %% DPR sent: discard + end; + +%% Explict CER or DWR: discard. These are sent by us. +outgoing(#diameter_packet{header = #diameter_header{application_id = 0, + cmd_code = C, + is_request = true} + = H}, + _) + when 257 == C; %% CER + 280 == C -> %% DWR + invalid(false, invalid_request, H); + +%% DPR not sent: send. +outgoing(Msg, #state{transport = TPid, dpr = false}) -> + send(TPid, Msg), + ok; + +%% Outgoing answer: send. +outgoing(#diameter_packet{header = #diameter_header{is_request = false}} + = Pkt, + #state{transport = TPid}) -> + send(TPid, Pkt), + ok; + +%% Outgoing request: discard. +outgoing(Msg, #state{dpr = {_,_,_}}) -> + invalid(false, send_after_dpr, header(Msg)). + +header(#diameter_packet{header = H}) -> + H; +header(Bin) -> %% DWR + diameter_codec:decode_header(Bin). + %% handle_request/3 %% %% Incoming CER or DPR. @@ -699,6 +832,8 @@ build_answer('CER', = Pkt, #state{dictionary = Dict0} = S) -> + diameter_codec:setopts([{string_decode, false}]), + {SupportedApps, RCaps, CEA} = recv_CER(CER, S), [RC, IS] = Dict0:'#get-'(['Result-Code', 'Inband-Security-Id'], CEA), @@ -731,7 +866,7 @@ build_answer(Type, errors = Es} = Pkt, S) -> - {RC, FailedAVP} = result_code(H, Es), + {RC, FailedAVP} = result_code(Type, H, Es), {answer(Type, RC, FailedAVP, S), post(Type, RC, Pkt, S)}. inband_security([]) -> @@ -748,8 +883,16 @@ cea(CEA, RC, Dict0) -> post('CER' = T, RC, Pkt, S) -> {T, caps(S), {RC, Pkt}}; -post('DPR' = T, _, _, #state{parent = Pid}) -> - [fun(S) -> Pid ! {T, self()}, S end]. +post('DPR', _, _, #state{parent = Pid}) -> + [fun(S) -> dpr_timer(), inform_dpr(Pid), dpr(S) end]. + +dpr(#state{dpr = false} = S) -> %% not awaiting DPA + S#state{dpr = true}; %% DPR received +dpr(S) -> %% DPR already sent or received + S. + +inform_dpr(Pid) -> + Pid ! {'DPR', self()}. %% tell watchdog to die with us rejected({capabilities_cb, _F, Reason}, T, S) -> rejected(Reason, T, S); @@ -798,6 +941,19 @@ set(['answer-message' | _] = Ans, FailedAvp) -> set([_|_] = Ans, FailedAvp) -> Ans ++ FailedAvp. +%% result_code/3 + +%% Be lenient with errors in DPR since there's no reason to be +%% otherwise. Rejecting may cause the peer to missinterpret the error +%% as meaning that the connection should not be closed, which may well +%% lead to more problems than any errors in the DPR. + +result_code('DPR', _, _) -> + {2001, []}; + +result_code('CER', H, Es) -> + result_code(H, Es). + %% result_code/2 result_code(#diameter_header{is_error = true}, _) -> @@ -886,6 +1042,8 @@ handle_CEA(#diameter_packet{header = H} = DPkt = diameter_codec:decode(Dict0, Pkt), + diameter_codec:setopts([{string_decode, false}]), + RC = result_code(incr_rc(recv, DPkt, Dict0)), {SApps, IS, RCaps} = recv_CEA(DPkt, S), @@ -1026,7 +1184,7 @@ close(Reason) -> %% dpr/2 %% -%% The RFC isn't clear on whether DPR should be send in a non-Open +%% The RFC isn't clear on whether DPR should be sent in a non-Open %% state. The Peer State Machine transitions it documents aren't %% exhaustive (no Stop in Wait-I-CEA for example) so assume it's up to %% the implementation and transition to Closed (ie. die) if we haven't @@ -1042,7 +1200,7 @@ dpr(Reason, #state{state = 'Open', Peer = {self(), Caps}, dpr(CBs, [Reason, Ref, Peer], S); -%% Connection is open, DPR already sent. +%% Connection is open, DPR already sent or received. dpr(_, #state{state = 'Open'}) -> ok; @@ -1073,10 +1231,9 @@ dpr([CB|Rest], [Reason | _] = Args, S) -> dpr([], [Reason | _], S) -> send_dpr(Reason, [], S). --record(opts, {cause, timeout = ?DPA_TIMEOUT}). +-record(opts, {cause, timeout}). -send_dpr(Reason, Opts, #state{transport = TPid, - dictionary = Dict, +send_dpr(Reason, Opts, #state{dictionary = Dict, service = #diameter_service{capabilities = Caps}} = S) -> #opts{cause = Cause, timeout = Tmo} @@ -1085,24 +1242,37 @@ send_dpr(Reason, Opts, #state{transport = TPid, transport -> ?GOAWAY; _ -> ?REBOOT end, - timeout = ?DPA_TIMEOUT}, + timeout = dpa_timeout()}, Opts), #diameter_caps{origin_host = {OH, _}, origin_realm = {OR, _}} = Caps, - #diameter_packet{header = #diameter_header{end_to_end_id = Eid, - hop_by_hop_id = Hid}} - = Pkt - = encode(['DPR', {'Origin-Host', OH}, + Pkt = encode(['DPR', {'Origin-Host', OH}, {'Origin-Realm', OR}, {'Disconnect-Cause', Cause}], Dict), - incr(send, Pkt, Dict), + send_dpr(false, Pkt, Tmo, S). + +%% send_dpr/4 + +send_dpr(X, + #diameter_packet{header = #diameter_header{end_to_end_id = Eid, + hop_by_hop_id = Hid}} + = Pkt, + Tmo, + #state{transport = TPid, + dictionary = Dict} + = S) -> + %% Only count DPR sent by the service: explicit DPR is counted in + %% the same way as other explicitly sent requests. + X orelse incr(send, Pkt, Dict), send(TPid, Pkt), dpa_timer(Tmo), ?LOG(send, 'DPR'), - S#state{dpr = {Hid, Eid}}. + S#state{dpr = {X, Hid, Eid}}. + +%% opt/2 opt({timeout, Tmo}, Rec) when ?IS_TIMEOUT(Tmo) -> @@ -1125,6 +1295,27 @@ cause(N) -> dpa_timer(Tmo) -> erlang:send_after(Tmo, self(), dpa_timeout). +dpa_timeout() -> + dpa_timeout(getr(?DPA_KEY)). + +dpa_timeout({_, Tmo}) -> + Tmo; +dpa_timeout(undefined) -> %% set in old code + ?DPA_TIMEOUT; +dpa_timeout(Tmo) -> %% ditto + Tmo. + +dpr_timer() -> + dpa_timer(dpr_timeout()). + +dpr_timeout() -> + dpr_timeout(getr(?DPA_KEY)). + +dpr_timeout({Tmo, _}) -> + Tmo; +dpr_timeout(_) -> %% set in old code + ?DPR_TIMEOUT. + %% register_everywhere/1 %% %% Register a term and ensure it's not registered elsewhere. Note that diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 04401a3d87..86e744dfbe 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -130,7 +130,9 @@ :: [{sequence, diameter:sequence()} %% sequence mask | {share_peers, diameter:remotes()} %% broadcast to | {use_shared_peers, diameter:remotes()} %% use from - | {restrict_connections, diameter:restriction()}]}). + | {restrict_connections, diameter:restriction()} + | {string_decode, boolean()} + | {incoming_maxlen, diameter:message_length()}]}). %% shared_peers reflects the peers broadcast from remote nodes. %% Record representing an RFC 3539 watchdog process implemented by @@ -261,16 +263,22 @@ whois(SvcName) -> %% --------------------------------------------------------------------------- -spec pick_peer(SvcName, AppOrAlias, Opts) - -> {{TPid, Caps, App}, Mask} - | false - | {error, term()} + -> {{TPid, Caps, App}, Mask, SvcOpts} + | false %% no selection + | {error, no_service} when SvcName :: diameter:service_name(), - AppOrAlias :: {alias, diameter:app_alias()} | #diameter_app{}, - Opts :: tuple(), + AppOrAlias :: #diameter_app{} + | {alias, diameter:app_alias()}, + Opts :: {fun((Dict :: module()) -> [term()]), + diameter:peer_filter(), + Xtra :: list()}, TPid :: pid(), Caps :: #diameter_caps{}, App :: #diameter_app{}, - Mask :: diameter:sequence(). + Mask :: diameter:sequence(), + SvcOpts :: [diameter:service_opt()]. +%% Extract Mask in the returned tuple so that diameter_traffic doesn't +%% need to know about the ordering of SvcOpts used here. pick_peer(SvcName, App, Opts) -> pick(lookup_state(SvcName), App, Opts). @@ -287,10 +295,10 @@ pick(#state{service = #diameter_service{applications = Apps}} Opts) -> %% initial call from diameter:call/4 pick(S, find_outgoing_app(Alias, Apps), Opts); -pick(_, false, _) -> - false; +pick(_, false = No, _) -> + No; -pick(#state{options = [{_, Mask} | _]} +pick(#state{options = [{_, Mask} | SvcOpts]} = S, #diameter_app{module = ModX, dictionary = Dict} = App0, @@ -299,7 +307,7 @@ pick(#state{options = [{_, Mask} | _]} [_,_] = RealmAndHost = diameter_lib:eval([DestF, Dict]), case pick_peer(App, RealmAndHost, Filter, S) of {TPid, Caps} -> - {{TPid, Caps, App}, Mask}; + {{TPid, Caps, App}, Mask, SvcOpts}; false = No -> No end. @@ -690,7 +698,9 @@ service_options(Opts) -> {restrict_connections, proplists:get_value(restrict_connections, Opts, ?RESTRICT)}, - {spawn_opt, proplists:get_value(spawn_opt, Opts, [])}]. + {spawn_opt, proplists:get_value(spawn_opt, Opts, [])}, + {string_decode, proplists:get_value(string_decode, Opts, true)}, + {incoming_maxlen, proplists:get_value(incoming_maxlen, Opts, 16#FFFFFF)}]. %% The order of options is significant since we match against the list. mref(false = No) -> @@ -802,10 +812,13 @@ start(Ref, Type, Opts, N, #state{watchdogT = WatchdogT, when Type == connect; Type == accept -> #diameter_service{applications = Apps} - = Svc + = Svc1 = merge_service(Opts, Svc0), - {_,_} = Mask = proplists:get_value(sequence, SvcOpts), - RecvData = diameter_traffic:make_recvdata([SvcName, PeerT, Apps, Mask]), + Svc = binary_caps(Svc1, proplists:get_value(string_decode, SvcOpts, true)), + RecvData = diameter_traffic:make_recvdata([SvcName, + PeerT, + Apps, + SvcOpts]), T = {{spawn_opts([Opts, SvcOpts]), RecvData}, Opts, SvcOpts, Svc}, Rec = #watchdog{type = Type, ref = Ref, @@ -816,8 +829,13 @@ start(Ref, Type, Opts, N, #state{watchdogT = WatchdogT, [], N). +binary_caps(Svc, true) -> + Svc; +binary_caps(#diameter_service{capabilities = Caps} = Svc, false) -> + Svc#diameter_service{capabilities = diameter_capx:binary_caps(Caps)}. + wd(Type, Ref, T, WatchdogT, Rec) -> - Pid = wd(Type, Ref, T), + Pid = start_watchdog(Type, Ref, T), insert(WatchdogT, Rec#watchdog{pid = Pid}), Pid. @@ -831,7 +849,7 @@ spawn_opts(Optss) -> T /= link, T /= monitor]. -wd(Type, Ref, T) -> +start_watchdog(Type, Ref, T) -> {_MRef, Pid} = diameter_watchdog:start({Type, Ref}, T), Pid. @@ -852,7 +870,7 @@ ms({applications, As}, #diameter_service{applications = Apps} = S) %% The fact that all capabilities can be configured on the transports %% means that the service doesn't necessarily represent a single -%% locally implemented Diameter peer as identified by Origin-Host: a +%% locally implemented Diameter node as identified by Origin-Host: a %% transport can configure its own Origin-Host. This means that the %% service little more than a placeholder for default capabilities %% plus a list of applications that individual transports can choose diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index 0b503338a6..ffd2c0afa2 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -77,7 +77,12 @@ {peerT :: ets:tid(), service_name :: diameter:service_name(), apps :: [#diameter_app{}], - sequence :: diameter:sequence()}). + sequence :: diameter:sequence(), + codec :: [{string_decode, boolean()} + | {incoming_maxlen, diameter:message_length()}]}). +%% Note that incoming_maxlen is currently handled in diameter_peer_fsm, +%% so that any message exceeding the maximum is discarded. Retain the +%% option in case we want to extend the values and semantics. %% Record stored in diameter_request for each outgoing request. -record(request, @@ -92,11 +97,18 @@ %% # make_recvdata/1 %% --------------------------------------------------------------------------- -make_recvdata([SvcName, PeerT, Apps, Mask | _]) -> +make_recvdata([SvcName, PeerT, Apps, {_,_} = Mask | _]) -> %% from old code + make_recvdata([SvcName, PeerT, Apps, [{sequence, Mask}]]); + +make_recvdata([SvcName, PeerT, Apps, SvcOpts | _]) -> + {_,_} = Mask = proplists:get_value(sequence, SvcOpts), #recvdata{service_name = SvcName, peerT = PeerT, apps = Apps, - sequence = Mask}. + sequence = Mask, + codec = [T || {K,_} = T <- SvcOpts, + lists:member(K, [string_decode, + incoming_maxlen])]}. %% --------------------------------------------------------------------------- %% peer_up/1 @@ -227,6 +239,8 @@ receive_message(TPid, Pkt, Dict0, RecvData) Dict0, RecvData). +%% recv/6 + %% Incoming request ... recv(true, false, TPid, Pkt, Dict0, T) -> spawn_request(TPid, Pkt, Dict0, T); @@ -234,6 +248,7 @@ recv(true, false, TPid, Pkt, Dict0, T) -> %% ... answer to known request ... recv(false, #request{ref = Ref, handler = Pid} = Req, _, Pkt, Dict0, _) -> Pid ! {answer, Ref, Req, Dict0, Pkt}; + %% Note that failover could have happened prior to this message being %% received and triggering failback. That is, both a failover message %% and answer may be on their way to the handler process. In the worst @@ -270,8 +285,11 @@ recv_request(TPid, #diameter_packet{header = #diameter_header{application_id = Id}} = Pkt, Dict0, - #recvdata{peerT = PeerT, apps = Apps} + #recvdata{peerT = PeerT, + apps = Apps, + codec = Opts} = RecvData) -> + diameter_codec:setopts([{common_dictionary, Dict0} | Opts]), send_A(recv_R(diameter_service:find_incoming_app(PeerT, TPid, Id, Apps), TPid, Pkt, @@ -279,7 +297,13 @@ recv_request(TPid, RecvData), TPid, Dict0, - RecvData). + RecvData); + +recv_request(TPid, Pkt, Dict0, RecvData) -> %% from old code + recv_request(TPid, + Pkt, + Dict0, + #recvdata{} = erlang:append_element(RecvData, [])). %% recv_R/5 @@ -596,7 +620,7 @@ resend(false, Route = #diameter_avp{data = {Dict0, 'Route-Record', OH}}, Seq = diameter_session:sequence(Mask), Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, - Msg = [Hdr, Route | Avps], + Msg = [Hdr, Route | Avps], %% reordered at encode resend(send_request(SvcName, App, Msg, Opts), Caps, Dict0, Pkt). %% The incoming request is relayed with the addition of a %% Route-Record. Note the requirement on the return from call/4 below, @@ -956,8 +980,8 @@ answer_message(OH, OR, RC, Dict0, #diameter_packet{avps = Avps, session_id(Code, Vid, Dict0, Avps) when is_list(Avps) -> try - {value, #diameter_avp{data = D}} = find_avp(Code, Vid, Avps), - [{'Session-Id', [Dict0:avp(decode, D, 'Session-Id')]}] + #diameter_avp{data = Bin} = find_avp(Code, Vid, Avps), + [{'Session-Id', [Dict0:avp(decode, Bin, 'Session-Id')]}] catch error: _ -> [] @@ -974,26 +998,17 @@ failed_avp(_, [] = No) -> %% find_avp/3 -find_avp(Code, Vid, Avps) - when is_integer(Code), (undefined == Vid orelse is_integer(Vid)) -> - find(fun(A) -> is_avp(Code, Vid, A) end, Avps). +%% Grouped ... +find_avp(Code, VId, [[#diameter_avp{code = Code, vendor_id = VId} | _] = As + | _]) -> + As; -%% The final argument here could be a list of AVP's, depending on the case, -%% but we're only searching at the top level. -is_avp(Code, Vid, #diameter_avp{code = Code, vendor_id = Vid}) -> - true; -is_avp(_, _, _) -> - false. +%% ... or not. +find_avp(Code, VId, [#diameter_avp{code = Code, vendor_id = VId} = A | _]) -> + A; -find(_, []) -> - false; -find(Pred, [H|T]) -> - case Pred(H) of - true -> - {value, H}; - false -> - find(Pred, T) - end. +find_avp(Code, VId, [_ | Avps]) -> + find_avp(Code, VId, Avps). %% 7. Error Handling %% @@ -1062,7 +1077,6 @@ incr_result(_, #diameter_packet{msg = undefined = No}, _, _) -> incr_result(Dir, Pkt, TPid, {Dict, AppDict, Dict0}) -> #diameter_packet{header = #diameter_header{is_error = E} = Hdr, - msg = Msg, errors = Es} = Pkt, @@ -1072,13 +1086,13 @@ incr_result(Dir, Pkt, TPid, {Dict, AppDict, Dict0}) -> recv /= Dir orelse [] == Es orelse incr_error(Dir, Id, TPid, AppDict), %% Exit on a missing result code. - T = rc_counter(Dict, Msg), + T = rc_counter(Dict, Dir, Pkt), T == false andalso ?LOGX(no_result_code, {Dict, Dir, Hdr}), - {Ctr, RC} = T, + {Ctr, RC, Avp} = T, %% Or on an inappropriate value. is_result(RC, E, Dict0) - orelse ?LOGX(invalid_error_bit, {Dict, Dir, Hdr, RC}), + orelse ?LOGX(invalid_error_bit, {Dict, Dir, Hdr, Avp}), incr(TPid, {Id, Dir, Ctr}), Ctr. @@ -1092,19 +1106,15 @@ msg_id(#diameter_packet{header = H}, Dict) -> %% there are 2^32 (application ids) * 2^24 (command codes) = 2^56 %% pairs for an attacker to choose from. msg_id(Hdr, Dict) -> - {_ApplId, Code, R} = Id = diameter_codec:msg_id(Hdr), - case Dict:msg_name(Code, 0 == R) of - '' -> - unknown(Dict:id(), R); - _ -> - Id + {Aid, Code, R} = Id = diameter_codec:msg_id(Hdr), + if Aid == ?APP_ID_RELAY -> + {relay, R}; + true -> + choose(Aid /= Dict:id() orelse '' == Dict:msg_name(Code, 0 == R), + unknown, + Id) end. -unknown(?APP_ID_RELAY, R) -> - {relay, R}; -unknown(_, _) -> - unknown. - %% No E-bit: can't be 3xxx. is_result(RC, false, _Dict0) -> RC < 3000 orelse 4000 =< RC; @@ -1124,7 +1134,7 @@ is_result(RC, true, _) -> incr(TPid, Counter) -> diameter_stats:incr(Counter, TPid, 1). -%% rc_counter/2 +%% rc_counter/3 %% RFC 3588, 7.6: %% @@ -1132,39 +1142,45 @@ incr(TPid, Counter) -> %% applications MUST include either one Result-Code AVP or one %% Experimental-Result AVP. -rc_counter(Dict, Msg) -> - rcc(Dict, Msg, int(get_avp_value(Dict, 'Result-Code', Msg))). +rc_counter(Dict, recv, #diameter_packet{header = H, avps = As}) -> + rc_counter(Dict, [H|As]); + +rc_counter(Dict, _, #diameter_packet{msg = Msg}) -> + rc_counter(Dict, Msg). -rcc(Dict, Msg, undefined) -> - rcc(get_avp_value(Dict, 'Experimental-Result', Msg)); +rc_counter(Dict, Msg) -> + rcc(get_result(Dict, Msg)). -rcc(_, _, N) +rcc(#diameter_avp{name = 'Result-Code' = Name, value = N} = A) when is_integer(N) -> - {{'Result-Code', N}, N}. + {{Name, N}, N, A}; -%% Outgoing answers may be in any of the forms messages can be sent -%% in. Incoming messages will be records. We're assuming here that the -%% arity of the result code AVP's is 0 or 1. +rcc(#diameter_avp{name = 'Result-Code' = Name, value = [N|_]} = A) + when is_integer(N) -> + {{Name, N}, N, A}; -rcc([{_,_,N} = T | _]) +rcc(#diameter_avp{name = 'Experimental-Result', value = {_,_,N} = T} = A) when is_integer(N) -> - {T,N}; -rcc({_,_,N} = T) + {T, N, A}; + +rcc(#diameter_avp{name = 'Experimental-Result', value = [{_,_,N} = T|_]} = A) when is_integer(N) -> - {T,N}; + {T, N, A}; + rcc(_) -> false. -%% Extract the first good looking integer. There's no guarantee -%% that what we're looking for has arity 1. -int([N|_]) - when is_integer(N) -> - N; -int(N) - when is_integer(N) -> - N; -int(_) -> - undefined. +%% get_result/2 + +get_result(Dict, Msg) -> + try + [throw(A) || N <- ['Result-Code', 'Experimental-Result'], + #diameter_avp{} = A <- [get_avp(Dict, N, Msg)]] + of + [] -> false + catch + #diameter_avp{} = A -> A + end. x(T) -> exit(T). @@ -1225,10 +1241,9 @@ answer_rc(_, _, Sent) -> send_R(SvcName, AppOrAlias, Msg, Opts, Caller) -> case pick_peer(SvcName, AppOrAlias, Msg, Opts) of - {{_,_,_} = Transport, Mask} -> + {Transport, Mask, SvcOpts} -> + diameter_codec:setopts(SvcOpts), send_request(Transport, Mask, Msg, Opts, Caller, SvcName); - false -> - {error, no_connection}; {error, _} = No -> No end. @@ -1290,6 +1305,8 @@ send_request({TPid, Caps, App} SvcName, []). +%% send_R/7 + send_R({send, Msg}, Pkt, Transport, Opts, Caller, SvcName, Fs) -> send_R(make_request_packet(Msg, Pkt), Transport, @@ -1503,10 +1520,10 @@ handle_A(Pkt, SvcName, Dict, Dict0, App, #request{transport = TPid} = Req) -> %% a missing AVP. If both are optional in the dictionary %% then this isn't a decode error: just continue on. answer(Pkt, SvcName, App, Req); - exit: {invalid_error_bit, {_, _, _, RC}} -> + exit: {invalid_error_bit, {_, _, _, Avp}} -> #diameter_packet{errors = Es} = Pkt, - E = {5004, #diameter_avp{name = 'Result-Code', value = RC}}, + E = {5004, Avp}, answer(Pkt#diameter_packet{errors = [E|Es]}, SvcName, App, Req) end. @@ -1550,7 +1567,9 @@ a(Hdr, SvcName, discard) -> %% timer value is ignored. This means that an answer could be accepted %% from a peer after timeout in the case of failover. -retransmit({{_,_,App} = Transport, _Mask}, Req, Opts, SvcName, Timeout) -> +%% retransmit/5 + +retransmit({{_,_,App} = Transport, _, _}, Req, Opts, SvcName, Timeout) -> try retransmit(Transport, Req, SvcName, Timeout) of T -> recv_A(Timeout, SvcName, App, Opts, T) catch @@ -1571,17 +1590,26 @@ pick_peer(SvcName, pick_peer(SvcName, App, Msg, Opts#options{extra = []}); pick_peer(_, _, undefined, _) -> - false; + {error, no_connection}; pick_peer(SvcName, AppOrAlias, Msg, #options{filter = Filter, extra = Xtra}) -> - diameter_service:pick_peer(SvcName, - AppOrAlias, - {fun(D) -> get_destination(D, Msg) end, - Filter, - Xtra}). + pick(diameter_service:pick_peer(SvcName, + AppOrAlias, + {fun(D) -> get_destination(D, Msg) end, + Filter, + Xtra})). + +pick({{_,_,_} = Transport, Mask}) -> %% from old code; dialyzer complains + {Transport, Mask, []}; %% about this + +pick(false) -> + {error, no_connection}; + +pick(T) -> + T. %% handle_error/4 @@ -1666,6 +1694,8 @@ send({TPid, Pkt, #request{handler = Pid} = Req0, SvcName, Timeout, TRef}) -> end. %% recv/4 +%% +%% Relay an answer from a remote node. recv(TPid, Pid, TRef, Ref) -> receive @@ -1679,8 +1709,14 @@ recv(TPid, Pid, TRef, Ref) -> %% send/2 -send(Pid, Pkt) -> - Pid ! {send, Pkt}. +send(Pid, Pkt) -> %% Strip potentially large message terms. + #diameter_packet{header = H, + bin = Bin, + transport_data = T} + = Pkt, + Pid ! {send, #diameter_packet{header = H, + bin = Bin, + transport_data = T}}. %% retransmit/4 @@ -1824,7 +1860,7 @@ str([]) -> str(T) -> T. -%% get_avp_value/3 +%% get_avp/3 %% %% Find an AVP in a message of one of three forms: %% @@ -1841,47 +1877,71 @@ str(T) -> %% look for are in the common dictionary. This is required since the %% relay dictionary doesn't inherit the common dictionary (which maybe %% it should). -get_avp_value(?RELAY, Name, Msg) -> - get_avp_value(?BASE, Name, Msg); +get_avp(?RELAY, Name, Msg) -> + get_avp(?BASE, Name, Msg); -%% Message sent as a header/avps list, probably a relay case but not -%% necessarily. -get_avp_value(Dict, Name, [#diameter_header{} | Avps]) -> +%% Message as a header/avps list. +get_avp(Dict, Name, [#diameter_header{} | Avps]) -> try {Code, _, VId} = Dict:avp_header(Name), - [A|_] = lists:dropwhile(fun(#diameter_avp{code = C, vendor_id = V}) -> - C /= Code orelse V /= VId - end, - Avps), - avp_decode(Dict, Name, A) + find_avp(Code, VId, Avps) + of + A -> + avp_decode(Dict, Name, ungroup(A)) catch error: _ -> undefined end; %% Outgoing message as a name/values list. -get_avp_value(_, Name, [_MsgName | Avps]) -> +get_avp(_, Name, [_MsgName | Avps]) -> case lists:keyfind(Name, 1, Avps) of {_, V} -> - V; + #diameter_avp{name = Name, value = V}; _ -> undefined end; %% Message is typically a record but not necessarily. -get_avp_value(Dict, Name, Rec) -> +get_avp(Dict, Name, Rec) -> try - Dict:'#get-'(Name, Rec) + #diameter_avp{name = Name, value = Dict:'#get-'(Name, Rec)} catch error:_ -> undefined end. +%% get_avp_value/3 + +get_avp_value(Dict, Name, Msg) -> + case get_avp(Dict, Name, Msg) of + #diameter_avp{value = V} -> + V; + undefined = No -> + No + end. + +%% ungroup/1 + +ungroup([Avp|_]) -> + Avp; +ungroup(Avp) -> + Avp. + +%% avp_decode/3 + avp_decode(Dict, Name, #diameter_avp{value = undefined, - data = Bin}) -> - Dict:avp(decode, Bin, Name); -avp_decode(_, _, #diameter_avp{value = V}) -> - V. + data = Bin} + = Avp) -> + try Dict:avp(decode, Bin, Name) of + V -> + Avp#diameter_avp{value = V} + catch + error:_ -> + Avp + end; +avp_decode(_, _, #diameter_avp{} = Avp) -> + Avp. cb(#diameter_app{module = [_|_] = M}, F, A) -> eval(M, F, A); diff --git a/lib/diameter/src/base/diameter_types.erl b/lib/diameter/src/base/diameter_types.erl index 442d90c98b..87a0f0663d 100644 --- a/lib/diameter/src/base/diameter_types.erl +++ b/lib/diameter/src/base/diameter_types.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -90,7 +90,12 @@ 'OctetString'(decode, Bin) when is_binary(Bin) -> - binary_to_list(Bin); + case diameter_codec:getopt(string_decode) of + true -> + binary_to_list(Bin); + false -> + Bin + end; 'OctetString'(decode, B) -> ?INVALID_LENGTH(B); @@ -298,21 +303,29 @@ 'OctetString'(M, lists:duplicate(0,7)); 'DiameterURI'(encode, #diameter_uri{type = Type, - fqdn = D, - port = P, + fqdn = DN, + port = PN, transport = T, - protocol = Prot} - = U) -> - S = lists:append([atom_to_list(Type), "://", D, - ":", integer_to_list(P), + protocol = P}) + when (Type == 'aaa' orelse Type == 'aaas'), + is_integer(PN), + 0 =< PN, + (T == tcp orelse T == sctp orelse T == udp), + (P == diameter orelse P == radius orelse P == 'tacacs+'), + (P /= diameter orelse T /= udp) -> + iolist_to_binary([atom_to_list(Type), "://", DN, + ":", integer_to_list(PN), ";transport=", atom_to_list(T), - ";protocol=", atom_to_list(Prot)]), - U = scan_uri(S), %% assert - list_to_binary(S); + ";protocol=", atom_to_list(P)]); +%% Don't omit defaults since they're dependent on whether RFC 3588 or +%% 6733 is being followed. For one, we don't know this at encode; for +%% two (more importantly), we don't know how the peer will interpret +%% defaults, so it's best to be explicit. Interpret defaults on decode +%% since there's no choice. 'DiameterURI'(encode, Str) -> Bin = iolist_to_binary(Str), - #diameter_uri{} = scan_uri(Bin), %% type check + #diameter_uri{} = scan_uri(Bin), %% assert Bin. %% -------------------- @@ -321,7 +334,6 @@ 'IPFilterRule'(encode = M, zero) -> 'OctetString'(M, lists:duplicate(0,33)); -%% TODO: parse grammar. 'IPFilterRule'(M, X) -> 'OctetString'(M, X). @@ -331,7 +343,6 @@ 'QoSFilterRule'(encode = M, zero = X) -> 'IPFilterRule'(M, X); -%% TODO: parse grammar. 'QoSFilterRule'(M, X) -> 'OctetString'(M, X). @@ -339,7 +350,13 @@ 'UTF8String'(decode, Bin) when is_binary(Bin) -> - tl([0|_] = unicode:characters_to_list([0, Bin])); %% assert list return + case diameter_codec:getopt(string_decode) of + true -> + %% assert list return + tl([0|_] = unicode:characters_to_list([0, Bin])); + false -> + <<_/binary>> = unicode:characters_to_binary(Bin) + end; 'UTF8String'(decode, B) -> ?INVALID_LENGTH(B); @@ -507,55 +524,90 @@ msb(false) -> ?TIME_2036. %% %% aaa-protocol = ( "diameter" / "radius" / "tacacs+" ) -scan_uri(Bin) - when is_binary(Bin) -> - scan_uri(binary_to_list(Bin)); -scan_uri("aaa://" ++ Rest) -> - scan_fqdn(Rest, #diameter_uri{type = aaa}); -scan_uri("aaas://" ++ Rest) -> - scan_fqdn(Rest, #diameter_uri{type = aaas}). - -scan_fqdn(S, U) -> - {[_|_] = F, Rest} = lists:splitwith(fun is_fqdn/1, S), - scan_opt_port(Rest, U#diameter_uri{fqdn = F}). - -scan_opt_port(":" ++ S, U) -> - {[_|_] = P, Rest} = lists:splitwith(fun is_digit/1, S), - scan_opt_transport(Rest, U#diameter_uri{port = list_to_integer(P)}); -scan_opt_port(S, U) -> - scan_opt_transport(S, U). - -scan_opt_transport(";transport=" ++ S, U) -> - {P, Rest} = transport(S), - scan_opt_protocol(Rest, U#diameter_uri{transport = P}); -scan_opt_transport(S, U) -> - scan_opt_protocol(S, U). - -scan_opt_protocol(";protocol=" ++ S, U) -> - {P, ""} = protocol(S), - U#diameter_uri{protocol = P}; -scan_opt_protocol("", U) -> - U. - -transport("tcp" ++ S) -> - {tcp, S}; -transport("sctp" ++ S) -> - {sctp, S}; -transport("udp" ++ S) -> - {udp, S}. - -protocol("diameter" ++ S) -> - {diameter, S}; -protocol("radius" ++ S) -> - {radius, S}; -protocol("tacacs+" ++ S) -> - {'tacacs+', S}. - -is_fqdn(C) -> - is_digit(C) orelse is_alpha(C) orelse C == $. orelse C == $-. - -is_alpha(C) -> - ($a =< C andalso C =< $z) orelse ($A =< C andalso C =< $Z). - -is_digit(C) -> - $0 =< C andalso C =< $9. +%% RFC 6733, 4.3.1, changes the defaults: +%% +%% "aaa://" FQDN [ port ] [ transport ] [ protocol ] +%% +%% ; No transport security +%% +%% "aaas://" FQDN [ port ] [ transport ] [ protocol ] +%% +%% ; Transport security used +%% +%% FQDN = < Fully Qualified Domain Name > +%% +%% port = ":" 1*DIGIT +%% +%% ; One of the ports used to listen for +%% ; incoming connections. +%% ; If absent, the default Diameter port +%% ; (3868) is assumed if no transport +%% ; security is used and port 5658 when +%% ; transport security (TLS/TCP and DTLS/SCTP) +%% ; is used. +%% +%% transport = ";transport=" transport-protocol +%% +%% ; One of the transports used to listen +%% ; for incoming connections. If absent, +%% ; the default protocol is assumed to be TCP. +%% ; UDP MUST NOT be used when the aaa-protocol +%% ; field is set to diameter. +%% +%% transport-protocol = ( "tcp" / "sctp" / "udp" ) +%% +%% protocol = ";protocol=" aaa-protocol +%% +%% ; If absent, the default AAA protocol +%% ; is Diameter. +%% +%% aaa-protocol = ( "diameter" / "radius" / "tacacs+" ) + +scan_uri(Bin) -> + RE = "^(aaas?)://" + "([-a-zA-Z0-9.]{1,255})" + "(:0{0,5}([0-9]{1,5}))?" + "(;transport=(tcp|sctp|udp))?" + "(;protocol=(diameter|radius|tacacs\\+))?$", + %% A port number is 16-bit, so an arbitrary number of digits is + %% just a vulnerability, but provide a little slack with leading + %% zeros in a port number just because the regexp was previously + %% [0-9]+ and it's not inconceivable that a value might be padded. + %% Don't fantasize about this padding being more than the number + %% of digits in the port number proper. + %% + %% Similarly, a FQDN can't be arbitrarily long: at most 255 + %% octets. + {match, [A, DN, PN, T, P]} = re:run(Bin, + RE, + [{capture, [1,2,4,6,8], binary}]), + Type = to_atom(A), + {PN0, T0} = defaults(diameter_codec:getopt(rfc), Type), + PortNr = to_int(PN, PN0), + 0 = PortNr bsr 16, %% assert + #diameter_uri{type = Type, + fqdn = 'OctetString'(decode, DN), + port = PortNr, + transport = to_atom(T, T0), + protocol = to_atom(P, diameter)}. + +%% Choose defaults based on the RFC, since 6733 has changed them. +defaults(3588, _) -> + {3868, sctp}; +defaults(6733, aaa) -> + {3868, tcp}; +defaults(6733, aaas) -> + {5658, tcp}. + +to_int(<<>>, N) -> + N; +to_int(B, _) -> + binary_to_integer(B). + +to_atom(<<>>, A) -> + A; +to_atom(B, _) -> + to_atom(B). + +to_atom(B) -> + binary_to_atom(B, latin1). diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index 67715906e8..de9c4bca33 100644 --- a/lib/diameter/src/base/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -124,14 +124,16 @@ i({Ack, T, Pid, {RecvData, wait(Ack, Pid), {_, Seed} = diameter_lib:seed(), random:seed(Seed), - putr(restart, {T, Opts, Svc}), %% save seeing it in trace - putr(dwr, dwr(Caps)), %% + putr(restart, {T, Opts, Svc, SvcOpts}), %% save seeing it in trace + putr(dwr, dwr(Caps)), %% {_,_} = Mask = proplists:get_value(sequence, SvcOpts), Restrict = proplists:get_value(restrict_connections, SvcOpts), Nodes = restrict_nodes(Restrict), Dict0 = common_dictionary(Apps), + diameter_codec:setopts([{common_dictionary, Dict0}, + {string_decode, false}]), #watchdog{parent = Pid, - transport = start(T, Opts, Mask, Nodes, Dict0, Svc), + transport = start(T, Opts, SvcOpts, Nodes, Dict0, Svc), tw = proplists:get_value(watchdog_timer, Opts, ?DEFAULT_TW_INIT), @@ -166,11 +168,11 @@ config({okay, N}, Rec) when ?IS_NATURAL(N) -> Rec#config{okay = N}. -%% start/5 +%% start/6 -start(T, Opts, Mask, Nodes, Dict0, Svc) -> +start(T, Opts, SvcOpts, Nodes, Dict0, Svc) -> {_MRef, Pid} - = diameter_peer_fsm:start(T, Opts, {Mask, Nodes, Dict0, Svc}), + = diameter_peer_fsm:start(T, Opts, {SvcOpts, Nodes, Dict0, Svc}), Pid. %% common_dictionary/1 @@ -320,7 +322,7 @@ code_change(_, State, _) -> %% expiry; or another watchdog is saying the same after reestablishing %% a connection previously had by this one. transition(close, #watchdog{}) -> - {{accept, _}, _, _} = getr(restart), %% assert + {accept, _} = role(), %% assert stop; %% Service is asking for the peer to be taken down gracefully. @@ -333,8 +335,9 @@ transition({shutdown = T, Pid, Reason}, #watchdog{parent = Pid, send(TPid, {T, self(), Reason}), S#watchdog{shutdown = true}; -%% Transport is telling us that DPA has been sent in response to DPR: -%% its death should lead to ours. +%% Transport is telling us that DPA has been sent in response to DPR, +%% or that DPR has been explicitly sent: transport death should lead +%% to ours. transition({'DPR', TPid}, #watchdog{transport = TPid} = S) -> S#watchdog{shutdown = true}; @@ -369,7 +372,7 @@ transition({open, TPid, Hosts, _} = Open, restrict = {_,R}, config = #config{suspect = OS}} = S) -> - case okay(getr(restart), Hosts, R) of + case okay(role(), Hosts, R) of okay -> set_watchdog(S#watchdog{status = okay, num_dwa = OS}); @@ -423,7 +426,7 @@ transition({'DOWN', _, process, TPid, _Reason} = D, = S0) -> S = S0#watchdog{pending = false, transport = undefined}, - {{M,_}, _, _} = getr(restart), + {M,_} = role(), %% Close an accepting watchdog immediately if there's no %% restriction on the number of connections to the same peer: the @@ -490,7 +493,7 @@ encode(dwa, Dict0, #diameter_packet{header = H, transport_data = TD} %% okay/3 -okay({{accept, Ref}, _, _}, Hosts, Restrict) -> +okay({accept, Ref}, Hosts, Restrict) -> T = {?MODULE, connection, Ref, Hosts}, diameter_reg:add(T), if Restrict -> @@ -501,7 +504,7 @@ okay({{accept, Ref}, _, _}, Hosts, Restrict) -> %% Register before matching so that at least one of two registering %% processes will match the other. -okay({{connect, _}, _, _}, _, _) -> +okay({connect, _}, _, _) -> okay. %% okay/2 @@ -516,6 +519,11 @@ okay(C) -> [_|_] = [send(P, close) || {_,P} <- C, self() /= P], reopen. +%% role/0 + +role() -> + element(1, getr(restart)). + %% set_watchdog/1 set_watchdog(#watchdog{tw = TwInit, @@ -550,7 +558,7 @@ send_watchdog(#watchdog{pending = false, ?LOG(send, 'DWR'), S#watchdog{pending = true}. -%% Dont' count encode errors since we don't expect any on DWR/DWA. +%% Don't count encode errors since we don't expect any on DWR/DWA. %% recv/3 @@ -572,11 +580,18 @@ rcv('DWR', Pkt, #watchdog{transport = TPid, DPkt = diameter_codec:decode(Dict0, Pkt), diameter_traffic:incr(recv, DPkt, TPid, Dict0), diameter_traffic:incr_error(recv, DPkt, TPid, Dict0), - EPkt = encode(dwa, Dict0, Pkt), + #diameter_packet{header = H, + transport_data = T, + bin = Bin} + = EPkt + = encode(dwa, Dict0, Pkt), diameter_traffic:incr(send, EPkt, TPid, Dict0), diameter_traffic:incr_rc(send, EPkt, TPid, Dict0), - send(TPid, {send, EPkt}), + %% Strip potentially large message terms. + send(TPid, {send, #diameter_packet{header = H, + transport_data = T, + bin = Bin}}), ?LOG(send, 'DWA'); rcv('DWA', Pkt, #watchdog{transport = TPid, @@ -591,9 +606,10 @@ rcv('DWA', Pkt, #watchdog{transport = TPid, rcv(N, _, _) when N == 'CER'; N == 'CEA'; - N == 'DPR'; - N == 'DPA' -> + N == 'DPR' -> false; +%% DPR can be sent explicitly with diameter:call/4. Only the +%% corresponding DPAs arrive here. rcv(_, Pkt, #watchdog{transport = TPid, dictionary = Dict0, @@ -794,26 +810,28 @@ restart(S) -> %% reconnect has won race with timeout %% state down rather then initial when receiving notification of an %% open connection. -restart({{connect, _} = T, Opts, Svc}, +restart({T, Opts, Svc}, S) -> %% put in old code + restart({T, Opts, Svc, []}, S); + +restart({{connect, _} = T, Opts, Svc, SvcOpts}, #watchdog{parent = Pid, - sequence = Mask, restrict = {R,_}, dictionary = Dict0} = S) -> send(Pid, {reconnect, self()}), Nodes = restrict_nodes(R), - S#watchdog{transport = start(T, Opts, Mask, Nodes, Dict0, Svc), + S#watchdog{transport = start(T, Opts, SvcOpts, Nodes, Dict0, Svc), restrict = {R, lists:member(node(), Nodes)}}; %% No restriction on the number of connections to the same peer: just %% die. Note that a state machine never enters state REOPEN in this %% case. -restart({{accept, _}, _, _}, #watchdog{restrict = {_, false}}) -> +restart({{accept, _}, _, _, _}, #watchdog{restrict = {_, false}}) -> stop; %% 'DOWN' was in old code: 'close' was not sent %% Otherwise hang around until told to die, either by the service or %% by another watchdog. -restart({{accept, _}, _, _}, S) -> +restart({{accept, _}, _, _, _}, S) -> S. %% Don't currently use Opts/Svc in the accept case. diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl index d91a776321..d5a9c81b09 100644 --- a/lib/diameter/src/compiler/diameter_codegen.erl +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -183,7 +183,7 @@ erl_forms(Mod, ParseD) -> f_enumerated_avp(ParseD), f_empty_value(ParseD), f_dict(ParseD), - {eof, ?LINE}]], + {eof, erl_anno:new(?LINE)}]], lists:append(Forms). diff --git a/lib/diameter/src/compiler/diameter_forms.hrl b/lib/diameter/src/compiler/diameter_forms.hrl index dd03401b9e..04d5834c88 100644 --- a/lib/diameter/src/compiler/diameter_forms.hrl +++ b/lib/diameter/src/compiler/diameter_forms.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -28,8 +28,10 @@ [], [?APPLY(erlang, error, [?ATOM(badarg)])]}). +-define(ANNO(L), erl_anno:new(L)). + %% Form tag with line number. --define(F(T), T, ?LINE). +-define(F(T), T, ?ANNO(?LINE)). %% Yes, that's right. The replacement is to the first unmatched ')'. -define(attribute, ?F(attribute)). @@ -47,10 +49,10 @@ -define(record_index, ?F(record_index)). -define(tuple, ?F(tuple)). --define(ATOM(T), {atom, ?LINE, T}). --define(INTEGER(N), {integer, ?LINE, N}). --define(VAR(V), {var, ?LINE, V}). --define(NIL, {nil, ?LINE}). +-define(ATOM(T), {atom, ?ANNO(?LINE), T}). +-define(INTEGER(N), {integer, ?ANNO(?LINE), N}). +-define(VAR(V), {var, ?ANNO(?LINE), V}). +-define(NIL, {nil, ?ANNO(?LINE)}). -define(CALL(F,A), {?call, ?ATOM(F), A}). -define(APPLY(M,F,A), {?call, {?remote, ?ATOM(M), ?ATOM(F)}, A}). diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index 881d25b5fb..0ef0fd35a9 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2014. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -35,31 +35,41 @@ {"1.4.3", [{restart_application, diameter}]}, %% R16B02 {"1.4.4", [{restart_application, diameter}]}, {"1.5", [{restart_application, diameter}]}, %% R16B03 - {"1.6", [{load_module, diameter_lib}, %% 17.0 + {"1.6", [{restart_application, diameter}]}, %% 17.0 + {"1.7", [{restart_application, diameter}]}, %% 17.[12] + {<<"^1\\.(7\\.1|8)$">>, %% 17.[34] + [{load_module, diameter_lib}, + {load_module, diameter_peer}, + {load_module, diameter_reg}, + {load_module, diameter_session}, + {load_module, diameter_stats}, + {load_module, diameter_sync}, + {load_module, diameter_capx}, + {load_module, diameter_codec}, + {load_module, diameter_types}, {load_module, diameter_traffic}, - {load_module, diameter_watchdog}, - {load_module, diameter_peer_fsm}, {load_module, diameter_service}, + {load_module, diameter_peer_fsm}, + {load_module, diameter_watchdog}, + {load_module, diameter_tcp}, + {load_module, diameter_sctp}, + {load_module, diameter_config}, + {load_module, diameter}, {load_module, diameter_gen_base_rfc6733}, {load_module, diameter_gen_acct_rfc6733}, {load_module, diameter_gen_base_rfc3588}, {load_module, diameter_gen_base_accounting}, {load_module, diameter_gen_relay}, - {load_module, diameter_codec}, - {load_module, diameter_sctp}]}, - {"1.7", [{load_module, diameter_service}, %% 17.1 - {load_module, diameter_codec}, + {update, diameter_transport_sup, supervisor}, + {update, diameter_service_sup, supervisor}, + {update, diameter_sup, supervisor}]}, + {"1.9", [{load_module, diameter_codec}, %% 17.5 + {load_module, diameter_traffic}, {load_module, diameter_gen_base_rfc6733}, {load_module, diameter_gen_acct_rfc6733}, {load_module, diameter_gen_base_rfc3588}, {load_module, diameter_gen_base_accounting}, - {load_module, diameter_gen_relay}, - {load_module, diameter_traffic}, - {load_module, diameter_peer_fsm}]}, - {"1.7.1", [{load_module, diameter_traffic}, %% 17.3 - {load_module, diameter_watchdog}, - {load_module, diameter_peer_fsm}, - {load_module, diameter_service}]} + {load_module, diameter_gen_relay}]} ], [ {"0.9", [{restart_application, diameter}]}, @@ -77,30 +87,40 @@ {"1.4.3", [{restart_application, diameter}]}, {"1.4.4", [{restart_application, diameter}]}, {"1.5", [{restart_application, diameter}]}, - {"1.6", [{load_module, diameter_sctp}, - {load_module, diameter_codec}, + {"1.6", [{restart_application, diameter}]}, + {"1.7", [{restart_application, diameter}]}, + {<<"^1\\.(7\\.1|8)$">>, + [{update, diameter_sup, supervisor}, + {update, diameter_service_sup, supervisor}, + {update, diameter_transport_sup, supervisor}, {load_module, diameter_gen_relay}, {load_module, diameter_gen_base_accounting}, {load_module, diameter_gen_base_rfc3588}, {load_module, diameter_gen_acct_rfc6733}, {load_module, diameter_gen_base_rfc6733}, - {load_module, diameter_service}, - {load_module, diameter_peer_fsm}, + {load_module, diameter}, + {load_module, diameter_config}, + {load_module, diameter_sctp}, + {load_module, diameter_tcp}, {load_module, diameter_watchdog}, + {load_module, diameter_peer_fsm}, + {load_module, diameter_service}, {load_module, diameter_traffic}, + {load_module, diameter_types}, + {load_module, diameter_codec}, + {load_module, diameter_capx}, + {load_module, diameter_sync}, + {load_module, diameter_stats}, + {load_module, diameter_session}, + {load_module, diameter_reg}, + {load_module, diameter_peer}, {load_module, diameter_lib}]}, - {"1.7", [{load_module, diameter_peer_fsm}, - {load_module, diameter_traffic}, - {load_module, diameter_gen_relay}, + {"1.9", [{load_module, diameter_gen_relay}, {load_module, diameter_gen_base_accounting}, {load_module, diameter_gen_base_rfc3588}, {load_module, diameter_gen_acct_rfc6733}, {load_module, diameter_gen_base_rfc6733}, - {load_module, diameter_codec}, - {load_module, diameter_service}]}, - {"1.7.1", [{load_module, diameter_service}, - {load_module, diameter_peer_fsm}, - {load_module, diameter_watchdog}, - {load_module, diameter_traffic}]} + {load_module, diameter_traffic}, + {load_module, diameter_codec}]} ] }. diff --git a/lib/diameter/test/diameter_3xxx_SUITE.erl b/lib/diameter/test/diameter_3xxx_SUITE.erl index 071b1a1177..44fc3a60aa 100644 --- a/lib/diameter/test/diameter_3xxx_SUITE.erl +++ b/lib/diameter/test/diameter_3xxx_SUITE.erl @@ -47,6 +47,7 @@ send_double_error/1, send_3xxx/1, send_5xxx/1, + counters/1, stop/1]). %% diameter callbacks @@ -111,7 +112,7 @@ all() -> groups() -> Tc = tc(), - [{?util:name([E,D]), [], [start] ++ Tc ++ [stop]} + [{?util:name([E,D]), [], [start] ++ Tc ++ [counters, stop]} || E <- ?ERRORS, D <- ?RFCS]. init_per_suite(Config) -> @@ -169,6 +170,203 @@ stop(_Config) -> ok = diameter:stop_service(?SERVER), ok = diameter:stop_service(?CLIENT). +%% counters/1 +%% +%% Check that counters are as expected. + +counters(Config) -> + Group = proplists:get_value(group, Config), + [_Errors, _Rfc] = G = ?util:name(Group), + [] = ?util:run([[fun counters/3, K, S, G] + || K <- [statistics, transport, connections], + S <- [?CLIENT, ?SERVER]]). + +counters(Key, Svc, Group) -> + counters(Key, Svc, Group, [_|_] = diameter:service_info(Svc, Key)). + +counters(statistics, Svc, [Errors, Rfc], L) -> + [{P, Stats}] = L, + true = is_pid(P), + stats(Svc, Errors, Rfc, lists:sort(Stats)); + +counters(_, _, _, _) -> + todo. + +stats(?CLIENT, E, rfc3588, L) + when E == answer; + E == answer_3xxx -> + [{{unknown,recv},2}, + {{{0,257,0},recv},1}, + {{{0,257,1},send},1}, + {{{0,275,0},recv},6}, + {{{0,275,1},send},10}, + {{unknown,recv,{'Result-Code',3001}},1}, + {{unknown,recv,{'Result-Code',3007}},1}, + {{{0,257,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',3008}},2}, + {{{0,275,0},recv,{'Result-Code',3999}},1}, + {{{0,275,0},recv,{'Result-Code',5002}},1}, + {{{0,275,0},recv,{'Result-Code',5005}},1}] + = L; + +stats(?SERVER, E, rfc3588, L) + when E == answer; + E == answer_3xxx -> + [{{unknown,recv},1}, + {{unknown,send},2}, + {{{0,257,0},send},1}, + {{{0,257,1},recv},1}, + {{{0,275,0},send},6}, + {{{0,275,1},recv},8}, + {{unknown,recv,error},1}, + {{unknown,send,{'Result-Code',3001}},1}, + {{unknown,send,{'Result-Code',3007}},1}, + {{{0,257,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',3008}},2}, + {{{0,275,0},send,{'Result-Code',3999}},1}, + {{{0,275,0},send,{'Result-Code',5002}},1}, + {{{0,275,0},send,{'Result-Code',5005}},1}, + {{{0,275,1},recv,error},5}] + = L; + +stats(?CLIENT, answer, rfc6733, L) -> + [{{unknown,recv},2}, + {{{0,257,0},recv},1}, + {{{0,257,1},send},1}, + {{{0,275,0},recv},8}, + {{{0,275,1},send},10}, + {{unknown,recv,{'Result-Code',3001}},1}, + {{unknown,recv,{'Result-Code',3007}},1}, + {{{0,257,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',3008}},2}, + {{{0,275,0},recv,{'Result-Code',3999}},1}, + {{{0,275,0},recv,{'Result-Code',5002}},1}, + {{{0,275,0},recv,{'Result-Code',5005}},3}, + {{{0,275,0},recv,{'Result-Code',5999}},1}] + = L; + +stats(?SERVER, answer, rfc6733, L) -> + [{{unknown,recv},1}, + {{unknown,send},2}, + {{{0,257,0},send},1}, + {{{0,257,1},recv},1}, + {{{0,275,0},send},8}, + {{{0,275,1},recv},8}, + {{unknown,recv,error},1}, + {{unknown,send,{'Result-Code',3001}},1}, + {{unknown,send,{'Result-Code',3007}},1}, + {{{0,257,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',3008}},2}, + {{{0,275,0},send,{'Result-Code',3999}},1}, + {{{0,275,0},send,{'Result-Code',5002}},1}, + {{{0,275,0},send,{'Result-Code',5005}},3}, + {{{0,275,0},send,{'Result-Code',5999}},1}, + {{{0,275,1},recv,error},5}] + = L; + +stats(?CLIENT, answer_3xxx, rfc6733, L) -> + [{{unknown,recv},2}, + {{{0,257,0},recv},1}, + {{{0,257,1},send},1}, + {{{0,275,0},recv},8}, + {{{0,275,1},send},10}, + {{unknown,recv,{'Result-Code',3001}},1}, + {{unknown,recv,{'Result-Code',3007}},1}, + {{{0,257,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',3008}},2}, + {{{0,275,0},recv,{'Result-Code',3999}},1}, + {{{0,275,0},recv,{'Result-Code',5002}},1}, + {{{0,275,0},recv,{'Result-Code',5005}},2}, + {{{0,275,0},recv,{'Result-Code',5999}},1}] + = L; + +stats(?SERVER, answer_3xxx, rfc6733, L) -> + [{{unknown,recv},1}, + {{unknown,send},2}, + {{{0,257,0},send},1}, + {{{0,257,1},recv},1}, + {{{0,275,0},send},8}, + {{{0,275,1},recv},8}, + {{unknown,recv,error},1}, + {{unknown,send,{'Result-Code',3001}},1}, + {{unknown,send,{'Result-Code',3007}},1}, + {{{0,257,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',3008}},2}, + {{{0,275,0},send,{'Result-Code',3999}},1}, + {{{0,275,0},send,{'Result-Code',5002}},1}, + {{{0,275,0},send,{'Result-Code',5005}},2}, + {{{0,275,0},send,{'Result-Code',5999}},1}, + {{{0,275,1},recv,error},5}] + = L; + +stats(?CLIENT, callback, rfc3588, L) -> + [{{unknown,recv},1}, + {{{0,257,0},recv},1}, + {{{0,257,1},send},1}, + {{{0,275,0},recv},6}, + {{{0,275,1},send},10}, + {{unknown,recv,{'Result-Code',3007}},1}, + {{{0,257,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',2001}},2}, + {{{0,275,0},recv,{'Result-Code',3999}},1}, + {{{0,275,0},recv,{'Result-Code',5002}},1}, + {{{0,275,0},recv,{'Result-Code',5005}},2}] + = L; + +stats(?SERVER, callback, rfc3588, L) -> + [{{unknown,recv},1}, + {{unknown,send},1}, + {{{0,257,0},send},1}, + {{{0,257,1},recv},1}, + {{{0,275,0},send},6}, + {{{0,275,1},recv},8}, + {{unknown,recv,error},1}, + {{unknown,send,{'Result-Code',3007}},1}, + {{{0,257,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',2001}},2}, + {{{0,275,0},send,{'Result-Code',3999}},1}, + {{{0,275,0},send,{'Result-Code',5002}},1}, + {{{0,275,0},send,{'Result-Code',5005}},2}, + {{{0,275,1},recv,error},5}] + = L; + +stats(?CLIENT, callback, rfc6733, L) -> + [{{unknown,recv},1}, + {{{0,257,0},recv},1}, + {{{0,257,1},send},1}, + {{{0,275,0},recv},8}, + {{{0,275,1},send},10}, + {{unknown,recv,{'Result-Code',3007}},1}, + {{{0,257,0},recv,{'Result-Code',2001}},1}, + {{{0,275,0},recv,{'Result-Code',2001}},2}, + {{{0,275,0},recv,{'Result-Code',3999}},1}, + {{{0,275,0},recv,{'Result-Code',5002}},1}, + {{{0,275,0},recv,{'Result-Code',5005}},3}, + {{{0,275,0},recv,{'Result-Code',5999}},1}] + = L; + +stats(?SERVER, callback, rfc6733, L) -> + [{{unknown,recv},1}, + {{unknown,send},1}, + {{{0,257,0},send},1}, + {{{0,257,1},recv},1}, + {{{0,275,0},send},8}, + {{{0,275,1},recv},8}, + {{unknown,recv,error},1}, + {{unknown,send,{'Result-Code',3007}},1}, + {{{0,257,0},send,{'Result-Code',2001}},1}, + {{{0,275,0},send,{'Result-Code',2001}},2}, + {{{0,275,0},send,{'Result-Code',3999}},1}, + {{{0,275,0},send,{'Result-Code',5002}},1}, + {{{0,275,0},send,{'Result-Code',5005}},3}, + {{{0,275,0},send,{'Result-Code',5999}},1}, + {{{0,275,1},recv,error},5}] + = L. + %% send_unknown_application/1 %% %% Send an unknown application that a callback (which shouldn't take diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl index cf34c762e1..84f8a66a8a 100644 --- a/lib/diameter/test/diameter_app_SUITE.erl +++ b/lib/diameter/test/diameter_app_SUITE.erl @@ -226,15 +226,18 @@ ignored({FromMod,_,_}, {ToMod,_,_} = To, Rel)-> %% New time api in OTP 18. time_api() -> - [{erlang, F, A} || {F,A} <- [{convert_time_resolution,3}, + [{erlang, F, A} || {F,A} <- [{convert_time_unit,3}, {monotonic_time,0}, {monotonic_time,1}, + {system_time,0}, + {system_time,1}, {time_offset,0}, {time_offset,1}, - {time_resolution,0}, {timestamp,0}, {unique_integer,0}, - {unique_integer,1}]]. + {unique_integer,1}]] + ++ [{os, system_time, 0}, + {os, system_time, 1}]. release() -> Rel = erlang:system_info(otp_release), @@ -246,11 +249,10 @@ release() -> end. unversion(App) -> - T = lists:dropwhile(fun is_vsn_ch/1, lists:reverse(App)), - lists:reverse(case T of [$-|TT] -> TT; _ -> T end). - -is_vsn_ch(C) -> - $0 =< C andalso C =< $9 orelse $. == C. + {Name, [$-|Vsn]} = lists:splitwith(fun(C) -> C /= $- end, App), + true = is_app(Name), %% assert + Vsn = vsn_str(Vsn), %% + Name. app('$M_EXPR') -> %% could be anything but assume it's ok "erts"; @@ -319,11 +321,11 @@ acc_rel(Dir, Rel, {Vsn, _}, Acc) -> %% Write a rel file and return its name. write_rel(Dir, [Erts | Apps], Vsn) -> - true = is_vsn(Vsn), - Name = "diameter_test_" ++ Vsn, + VS = vsn_str(Vsn), + Name = "diameter_test_" ++ VS, ok = write_file(filename:join([Dir, Name ++ ".rel"]), {release, - {"diameter " ++ Vsn ++ " test release", Vsn}, + {"diameter " ++ VS ++ " test release", VS}, Erts, Apps}), Name. @@ -338,10 +340,34 @@ fetch(Key, List) -> write_file(Path, T) -> file:write_file(Path, io_lib:format("~p.", [T])). -%% Is a version string of the expected form? Return the argument -%% itself for 'false' for a useful badmatch. +%% Is a version string of the expected form? is_vsn(V) -> - is_list(V) - andalso length(V) == string:span(V, "0123456789.") - andalso V == string:join(string:tokens(V, [$.]), ".") %% no ".." - orelse {error, V}. + V = vsn_str(V), + true. + +%% Turn a from/to version in appup to a version string after ensuring +%% that it's valid version number of regexp. In the regexp case, the +%% regexp itself becomes the version string since there's no +%% requirement that a version in appup be anything but a string. The +%% restrictions placed on string-valued version numbers (that they be +%% '.'-separated integers) are our own. + +vsn_str(S) + when is_list(S) -> + {_, match} = {S, match(S, "^(0|[1-9][0-9]*)(\\.(0|[1-9][0-9]*))*$")}, + {_, nomatch} = {S, match(S, "\\.0\\.0$")}, + S; + +vsn_str(B) + when is_binary(B) -> + {ok, _} = re:compile(B), + binary_to_list(B). + +match(S, RE) -> + re:run(S, RE, [{capture, none}]). + +%% Is an application name of the expected form? +is_app(S) + when is_list(S) -> + {_, match} = {S, match(S, "^([a-z]([a-z_]*|[a-zA-Z]*))$")}, + true. diff --git a/lib/diameter/test/diameter_capx_SUITE.erl b/lib/diameter/test/diameter_capx_SUITE.erl index 02501ce779..1c0f25864c 100644 --- a/lib/diameter/test/diameter_capx_SUITE.erl +++ b/lib/diameter/test/diameter_capx_SUITE.erl @@ -378,10 +378,14 @@ dict(N) -> %% id's, failing with app_not_configured if it can't. load_dict(N) -> Mod = dict(N), - Forms = [{attribute, 1, module, Mod}, - {attribute, 2, compile, [export_all]}, - {function, 3, id, 0, - [{clause, 4, [], [], [{integer, 4, N}]}]}], + A1 = erl_anno:new(1), + A2 = erl_anno:new(2), + A3 = erl_anno:new(3), + A4 = erl_anno:new(4), + Forms = [{attribute, A1, module, Mod}, + {attribute, A2, compile, [export_all]}, + {function, A3, id, 0, + [{clause, A4, [], [], [{integer, A4, N}]}]}], {ok, Mod, Bin, []} = compile:forms(Forms, [return]), {module, Mod} = code:load_binary(Mod, Mod, Bin), N = Mod:id(). diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl index 472755c62a..5f1dbfbd61 100644 --- a/lib/diameter/test/diameter_codec_test.erl +++ b/lib/diameter/test/diameter_codec_test.erl @@ -352,12 +352,23 @@ values('DiameterURI') -> {[], ["aaa" ++ S ++ "://diameter.se" ++ P ++ Tr ++ Pr || S <- ["", "s"], - P <- ["", ":1234"], + P <- ["", ":1234", ":0", ":65535"], Tr <- ["" | [";transport=" ++ X || X <- ["tcp", "sctp", "udp"]]], Pr <- ["" | [";protocol=" ++ X - || X <- ["diameter","radius","tacacs+"]]]], - []}; + || X <- ["diameter","radius","tacacs+"]]], + Tr /= ";transport=udp" + orelse (Pr /= ";protocol=diameter" andalso Pr /= "")] + ++ ["aaa://" ++ lists:duplicate(255, $x)], + ["aaa://diameter.se:65536", + "aaa://diameter.se:-1", + "aaa://diameter.se;transport=udp;protocol=diameter", + "aaa://diameter.se;transport=udp", + "aaa://" ++ lists:duplicate(256, $x), + "aaa://:3868", + "aaax://diameter.se", + "aaa://diameter.se;transport=tcpx", + "aaa://diameter.se;transport=tcp;protocol=diameter "]}; values(T) when T == 'IPFilterRule'; diff --git a/lib/diameter/test/diameter_config_SUITE.erl b/lib/diameter/test/diameter_config_SUITE.erl index ad5b3f9420..bbdf672291 100644 --- a/lib/diameter/test/diameter_config_SUITE.erl +++ b/lib/diameter/test/diameter_config_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -82,6 +82,15 @@ [false], [[node(), node()]]], [[x]]}, + {string_decode, + [[true], [false]], + [[0], [x]]}, + {incoming_maxlen, + [[0], [65536], [16#FFFFFF]], + [[-1], [1 bsl 24], [infinity], [false]]}, + {spawn_opt, + [[[]], [[monitor, link]]], + [[false]]}, {invalid_option, %% invalid service options are rejected [], [[x], @@ -157,6 +166,12 @@ {length_errors, [[exit], [handle], [discard]], [[x]]}, + {dpr_timeout, + [[0], [3000], [16#FFFFFFFF]], + [[infinity], [-1], [1 bsl 32], [x]]}, + {dpa_timeout, + [[0], [3000], [16#FFFFFFFF]], + [[infinity], [-1], [1 bsl 32], [x]]}, {connect_timer, [[3000]], [[infinity]]}, @@ -171,9 +186,15 @@ [[{suspect, 2}]]], [[x], [[{open, 0}]]]}, + {pool_size, + [[1], [100]], + [[0], [infinity], [-1], [x]]}, {private, [[x]], []}, + {spawn_opt, + [[[]], [[monitor, link]]], + [[false]]}, {invalid_option, %% invalid transport options are silently ignored [[x], [x,x]], diff --git a/lib/diameter/test/diameter_dpr_SUITE.erl b/lib/diameter/test/diameter_dpr_SUITE.erl index f3f16b06e0..81178e2bda 100644 --- a/lib/diameter/test/diameter_dpr_SUITE.erl +++ b/lib/diameter/test/diameter_dpr_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2014. All Rights Reserved. +%% Copyright Ericsson AB 2012-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -32,6 +32,7 @@ %% testcases -export([start/1, connect/1, + send_dpr/1, remove_transport/1, stop_service/1, check/1, @@ -41,6 +42,7 @@ -export([disconnect/5]). -include("diameter.hrl"). +-include("diameter_gen_base_rfc6733.hrl"). %% =========================================================================== @@ -51,9 +53,6 @@ -define(CLIENT, "CLIENT"). -define(SERVER, "SERVER"). --define(DICT_COMMON, ?DIAMETER_DICT_COMMON). --define(APP_ID, ?DICT_COMMON:id()). - %% Config for diameter:start_service/2. -define(SERVICE(Host), [{'Origin-Host', Host}, @@ -61,9 +60,10 @@ {'Host-IP-Address', [?ADDR]}, {'Vendor-Id', hd(Host)}, %% match this in disconnect/5 {'Product-Name', "OTP/diameter"}, - {'Acct-Application-Id', [?APP_ID]}, + {'Acct-Application-Id', [0]}, {restrict_connections, false}, - {application, [{dictionary, ?DICT_COMMON}, + {application, [{dictionary, diameter_gen_base_rfc6733}, + {alias, common}, {module, #diameter_callback{_ = false}}]}]). %% Disconnect reasons that diameter passes as the first argument of a @@ -74,10 +74,12 @@ -define(CAUSES, [0, rebooting, 1, busy, 2, goaway]). %% Establish one client connection for each element of this list, -%% configured with disconnect/5 as disconnect_cb and returning the -%% specified value. +%% configured with disconnect/5, disconnect_cb returning the specified +%% value. -define(RETURNS, - [[close, {dpr, [{cause, invalid}]}], [ignore, close], []] + [[close, {dpr, [{cause, invalid}]}], + [ignore, close], + []] ++ [[{dpr, [{timeout, 5000}, {cause, T}]}] || T <- ?CAUSES]). %% =========================================================================== @@ -86,7 +88,7 @@ suite() -> [{timetrap, {seconds, 60}}]. all() -> - [{group, R} || R <- ?REASONS]. + [start, send_dpr, stop | [{group, R} || R <- ?REASONS]]. %% The group determines how transports are terminated: by remove_transport, %% stop_service or application stop. @@ -111,6 +113,22 @@ start(_Config) -> ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)), ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)). +send_dpr(_Config) -> + LRef = ?util:listen(?SERVER, tcp), + Ref = ?util:connect(?CLIENT, tcp, LRef, [{dpa_timeout, 10000}]), + #diameter_base_DPA{'Result-Code' = 2001} + = diameter:call(?CLIENT, + common, + ['DPR', {'Origin-Host', "CLIENT.erlang.org"}, + {'Origin-Realm', "erlang.org"}, + {'Disconnect-Cause', 0}]), + ok = receive %% endure the transport dies on DPA + #diameter_event{service = ?CLIENT, info = {down, Ref, _, _}} -> + ok + after 5000 -> + erlang:process_info(self(), messages) + end. + connect(Config) -> Pid = spawn(fun init/0), %% process for disconnect_cb to bang Grp = group(Config), diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 9822b95301..7ff6ba7ab9 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -41,6 +41,7 @@ send_eval/1, send_bad_answer/1, send_protocol_error/1, + send_experimental_result/1, send_arbitrary/1, send_unknown/1, send_unknown_short/1, @@ -59,6 +60,7 @@ send_unexpected_mandatory_decode/1, send_unexpected_mandatory/1, send_long/1, + send_maxlen/1, send_nopeer/1, send_noapp/1, send_discard/1, @@ -122,8 +124,6 @@ -define(ADDR, {127,0,0,1}). --define(CLIENT, "CLIENT"). --define(SERVER, "SERVER"). -define(REALM, "erlang.org"). -define(HOST(Host, Realm), Host ++ [$.|Realm]). @@ -141,11 +141,19 @@ %% Which common dictionary to use in the clients. -define(RFCS, [rfc3588, rfc6733]). +%% Whether to decode stringish Diameter types to strings, or leave +%% them as binary. +-define(STRING_DECODES, [true, false]). + -record(group, - {client_encoding, + {client_service, + client_encoding, client_dict0, + client_strings, + server_service, server_encoding, - server_container}). + server_container, + server_strings}). %% Not really what we should be setting unless the message is sent in %% the common application but diameter doesn't care. @@ -166,7 +174,7 @@ ?answer_message(_, ResultCode)). %% Config for diameter:start_service/2. --define(SERVICE(Name), +-define(SERVICE(Name, Decode), [{'Origin-Host', Name ++ "." ++ ?REALM}, {'Origin-Realm', ?REALM}, {'Host-IP-Address', [?ADDR]}, @@ -175,6 +183,8 @@ {'Auth-Application-Id', [?DIAMETER_APP_ID_COMMON]}, {'Acct-Application-Id', [?DIAMETER_APP_ID_ACCOUNTING]}, {restrict_connections, false}, + {string_decode, Decode}, + {incoming_maxlen, 1 bsl 21}, {spawn_opt, [{min_heap_size, 5000}]} | [{application, [{dictionary, D}, {module, ?MODULE}, @@ -227,28 +237,53 @@ suite() -> [{timetrap, {seconds, 60}}]. all() -> - [start, start_services, add_transports, result_codes] - ++ [{group, ?util:name([R,D,A,C]), P} || R <- ?ENCODINGS, - D <- ?RFCS, - A <- ?ENCODINGS, - C <- ?CONTAINERS, - P <- [[], [parallel]]] - ++ [outstanding, remove_transports, empty, stop_services, stop]. + [start, result_codes, {group, traffic}, outstanding, empty, stop]. groups() -> Ts = tc(), - [{?util:name([R,D,A,C]), [], Ts} || R <- ?ENCODINGS, - D <- ?RFCS, - A <- ?ENCODINGS, - C <- ?CONTAINERS]. + [{?util:name([R,D,A,C]), [parallel], Ts} || R <- ?ENCODINGS, + D <- ?RFCS, + A <- ?ENCODINGS, + C <- ?CONTAINERS] + ++ + [{?util:name([R,D,A,C,SD,CD]), + [], + [start_services, + add_transports, + result_codes, + {group, ?util:name([R,D,A,C])}, + remove_transports, + stop_services]} + || R <- ?ENCODINGS, + D <- ?RFCS, + A <- ?ENCODINGS, + C <- ?CONTAINERS, + SD <- ?STRING_DECODES, + CD <- ?STRING_DECODES] + ++ + [{traffic, [parallel], [{group, ?util:name([R,D,A,C,SD,CD])} + || R <- ?ENCODINGS, + D <- ?RFCS, + A <- ?ENCODINGS, + C <- ?CONTAINERS, + SD <- ?STRING_DECODES, + CD <- ?STRING_DECODES]}]. init_per_group(Name, Config) -> - [R,D,A,C] = ?util:name(Name), - G = #group{client_encoding = R, - client_dict0 = dict0(D), - server_encoding = A, - server_container = C}, - [{group, G} | Config]. + case ?util:name(Name) of + [R,D,A,C,SD,CD] -> + G = #group{client_service = [$C|?util:unique_string()], + client_encoding = R, + client_dict0 = dict0(D), + client_strings = CD, + server_service = [$S|?util:unique_string()], + server_encoding = A, + server_container = C, + server_strings = SD}, + [{group, G} | Config]; + _ -> + Config + end. end_per_group(_, _) -> ok. @@ -267,6 +302,7 @@ tc() -> send_eval, send_bad_answer, send_protocol_error, + send_experimental_result, send_arbitrary, send_unknown, send_unknown_short, @@ -285,6 +321,7 @@ tc() -> send_unexpected_mandatory_decode, send_unexpected_mandatory, send_long, + send_maxlen, send_nopeer, send_noapp, send_discard, @@ -319,18 +356,26 @@ tc() -> start(_Config) -> ok = diameter:start(). -start_services(_Config) -> - ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)), - ok = diameter:start_service(?CLIENT, [{sequence, ?CLIENT_MASK} - | ?SERVICE(?CLIENT)]). +start_services(Config) -> + #group{client_service = CN, + client_strings = CD, + server_service = SN, + server_strings = SD} + = group(Config), + ok = diameter:start_service(SN, ?SERVICE(SN, SD)), + ok = diameter:start_service(CN, [{sequence, ?CLIENT_MASK} + | ?SERVICE(CN, CD)]). add_transports(Config) -> - LRef = ?util:listen(?SERVER, + #group{client_service = CN, + server_service = SN} + = group(Config), + LRef = ?util:listen(SN, tcp, [{capabilities_cb, fun capx/2}, {spawn_opt, [{min_heap_size, 8096}]}, {applications, apps(rfc3588)}]), - Cs = [?util:connect(?CLIENT, + Cs = [?util:connect(CN, tcp, LRef, [{id, Id}, @@ -354,12 +399,18 @@ outstanding(_Config) -> is_atom(element(1,T))]. remove_transports(Config) -> + #group{client_service = CN, + server_service = SN} + = group(Config), [LRef | Cs] = ?util:read_priv(Config, "transport"), - [?util:disconnect(?CLIENT, C, ?SERVER, LRef) || C <- Cs]. + [?util:disconnect(CN, C, SN, LRef) || C <- Cs]. -stop_services(_Config) -> - ok = diameter:stop_service(?CLIENT), - ok = diameter:stop_service(?SERVER). +stop_services(Config) -> + #group{client_service = CN, + server_service = SN} + = group(Config), + ok = diameter:stop_service(CN), + ok = diameter:stop_service(SN). %% Ensure even transports have been removed from request table. empty(_Config) -> @@ -394,7 +445,7 @@ send_ok(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 1}], - ['ACA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['ACA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, Req). %% Send an accounting ACR that the server answers badly to. @@ -410,7 +461,7 @@ send_eval(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 3}], - ['ACA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['ACA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, Req). %% Send an accounting ACR that the server tries to answer with an @@ -431,23 +482,32 @@ send_protocol_error(Config) -> ?answer_message(?TOO_BUSY) = call(Config, Req). +%% Send a 3xxx Experimental-Result in an answer not setting the E-bit +%% and missing a Result-Code. +send_experimental_result(Config) -> + Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, + {'Accounting-Record-Number', 5}], + ['ACA', {'Session-Id', _} | _] + = call(Config, Req). + %% Send an ASR with an arbitrary non-mandatory AVP and expect success %% and the same AVP in the reply. send_arbitrary(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{name = 'Product-Name', value = "XXX"}]}], - ['ASA', _SessionId, {'Result-Code', ?SUCCESS} | Avps] + ['ASA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | Avps] = call(Config, Req), {'AVP', [#diameter_avp{name = 'Product-Name', - value = "XXX"}]} - = lists:last(Avps). + value = V}]} + = lists:last(Avps), + "XXX" = string(V, Config). %% Send an unknown AVP (to some client) and check that it comes back. send_unknown(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, is_mandatory = false, data = <<17>>}]}], - ['ASA', _SessionId, {'Result-Code', ?SUCCESS} | Avps] + ['ASA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | Avps] = call(Config, Req), {'AVP', [#diameter_avp{code = 999, is_mandatory = false, @@ -463,7 +523,7 @@ send_unknown_short(Config, M, RC) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, is_mandatory = M, data = <<17>>}]}], - ['ASA', _SessionId, {'Result-Code', RC} | Avps] + ['ASA', {'Session-Id', _}, {'Result-Code', RC} | Avps] = call(Config, Req), [#'diameter_base_Failed-AVP'{'AVP' = As}] = proplists:get_value('Failed-AVP', Avps), @@ -477,7 +537,7 @@ send_unknown_mandatory(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 999, is_mandatory = true, data = <<17>>}]}], - ['ASA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] + ['ASA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] = call(Config, Req), [#'diameter_base_Failed-AVP'{'AVP' = As}] = proplists:get_value('Failed-AVP', Avps), @@ -497,7 +557,7 @@ send_unexpected_mandatory_decode(Config) -> Req = ['ASR', {'AVP', [#diameter_avp{code = 27, %% Session-Timeout is_mandatory = true, data = <<12:32>>}]}], - ['ASA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] + ['ASA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | Avps] = call(Config, Req), [#'diameter_base_Failed-AVP'{'AVP' = As}] = proplists:get_value('Failed-AVP', Avps), @@ -533,7 +593,7 @@ send_error_bit(Config) -> %% Send a bad version and check that we get 5011. send_unsupported_version(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - ['STA', _SessionId, {'Result-Code', ?UNSUPPORTED_VERSION} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?UNSUPPORTED_VERSION} | _] = call(Config, Req). %% Send a request containing an AVP length > data size. @@ -553,14 +613,14 @@ send_zero_avp_length(Config) -> send_invalid_avp_length(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - ['STA', _SessionId, + ['STA', {'Session-Id', _}, {'Result-Code', ?INVALID_AVP_LENGTH}, - _OriginHost, - _OriginRealm, - _UserName, - _Class, - _ErrorMessage, - _ErrorReportingHost, + {'Origin-Host', _}, + {'Origin-Realm', _}, + {'User-Name', _}, + {'Class', _}, + {'Error-Message', _}, + {'Error-Reporting-Host', _}, {'Failed-AVP', [#'diameter_base_Failed-AVP'{'AVP' = [_]}]} | _] = call(Config, Req). @@ -578,25 +638,33 @@ send_invalid_reject(Config) -> send_unexpected_mandatory(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - ['STA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?AVP_UNSUPPORTED} | _] = call(Config, Req). %% Send something long that will be fragmented by TCP. send_long(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'User-Name', [lists:duplicate(1 bsl 20, $X)]}], - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, Req). +%% Send something longer than the configure incoming_maxlen. +send_maxlen(Config) -> + Req = ['STR', {'Termination-Cause', ?LOGOUT}, + {'User-Name', [lists:duplicate(1 bsl 21, $X)]}], + {timeout, _} = call(Config, Req). + %% Send something for which pick_peer finds no suitable peer. send_nopeer(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], {error, no_connection} = call(Config, Req, [{extra, [?EXTRA]}]). %% Send something on an unconfigured application. -send_noapp(_Config) -> +send_noapp(Config) -> + #group{client_service = CN} + = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}], - {error, no_connection} = diameter:call(?CLIENT, unknown_alias, Req). + {error, no_connection} = diameter:call(CN, unknown_alias, Req). %% Send something that's discarded by prepare_request. send_discard(Config) -> @@ -608,8 +676,10 @@ send_any_1(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], {error, no_connection} = call(Config, Req, [{filter, {any, []}}]). send_any_2(Config) -> + #group{server_service = SN} + = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}, - {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}], + {'Destination-Host', [?HOST(SN, "unknown.org")]}], ?answer_message(?UNABLE_TO_DELIVER) = call(Config, Req, [{filter, {any, [host, realm]}}]). @@ -617,12 +687,14 @@ send_any_2(Config) -> send_all_1(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], Realm = lists:foldr(fun(C,A) -> [C,A] end, [], ?REALM), - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, Req, [{filter, {all, [{host, any}, {realm, Realm}]}}]). send_all_2(Config) -> + #group{server_service = SN} + = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}, - {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}], + {'Destination-Host', [?HOST(SN, "unknown.org")]}], {error, no_connection} = call(Config, Req, [{filter, {all, [host, realm]}}]). @@ -635,9 +707,8 @@ send_timeout(Config) -> %% received the Session-Id. send_error(Config) -> Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_AUTHENTICATE}], - ?answer_message(SId, ?TOO_BUSY) - = call(Config, Req), - true = undefined /= SId. + ?answer_message([_], ?TOO_BUSY) + = call(Config, Req). %% Send a request with the detached option and receive it as a message %% from handle_answer instead. @@ -646,7 +717,7 @@ send_detach(Config) -> Ref = make_ref(), ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]), Ans = receive {Ref, T} -> T end, - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = Ans. %% Send a request which can't be encoded and expect {error, encode}. @@ -655,13 +726,15 @@ send_encode_error(Config) -> %% Send with filtering and expect success. send_destination_1(Config) -> + #group{server_service = SN} + = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}, - {'Destination-Host', [?HOST(?SERVER, ?REALM)]}], - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + {'Destination-Host', [?HOST(SN, ?REALM)]}], + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, Req, [{filter, {all, [host, realm]}}]). send_destination_2(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, Req, [{filter, {all, [host, realm]}}]). %% Send with filtering on and expect failure when specifying an @@ -672,8 +745,10 @@ send_destination_3(Config) -> {error, no_connection} = call(Config, Req, [{filter, {all, [host, realm]}}]). send_destination_4(Config) -> + #group{server_service = SN} + = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}, - {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}], + {'Destination-Host', [?HOST(SN, "unknown.org")]}], {error, no_connection} = call(Config, Req, [{filter, {all, [host, realm]}}]). @@ -685,8 +760,10 @@ send_destination_5(Config) -> ?answer_message(?REALM_NOT_SERVED) = call(Config, Req). send_destination_6(Config) -> + #group{server_service = SN} + = group(Config), Req = ['STR', {'Termination-Cause', ?LOGOUT}, - {'Destination-Host', [?HOST(?SERVER, "unknown.org")]}], + {'Destination-Host', [?HOST(SN, "unknown.org")]}], ?answer_message(?UNABLE_TO_DELIVER) = call(Config, Req). @@ -721,7 +798,7 @@ send_bad_filter(Config, F) -> %% Specify multiple filter options and expect them be conjunctive. send_multiple_filters_1(Config) -> Fun = fun(#diameter_caps{}) -> true end, - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = send_multiple_filters(Config, [host, {eval, Fun}]). send_multiple_filters_2(Config) -> E = {erlang, is_tuple, []}, @@ -732,7 +809,7 @@ send_multiple_filters_3(Config) -> E2 = {erlang, is_tuple, []}, E3 = {erlang, is_record, [diameter_caps]}, E4 = [{erlang, is_record, []}, diameter_caps], - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = send_multiple_filters(Config, [{eval, E} || E <- [E1,E2,E3,E4]]). send_multiple_filters(Config, Fs) -> @@ -743,21 +820,36 @@ send_multiple_filters(Config, Fs) -> %% only the return value from the prepare_request callback being %% significant. send_anything(Config) -> - ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] + ['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _] = call(Config, anything). %% =========================================================================== +group(Config) -> + #group{} = proplists:get_value(group, Config). + +string(V, Config) -> + #group{client_strings = B} = group(Config), + decode(V,B). + +decode(S, true) + when is_list(S) -> + S; +decode(B, false) + when is_binary(B) -> + binary_to_list(B). + call(Config, Req) -> call(Config, Req, []). call(Config, Req, Opts) -> Name = proplists:get_value(testcase, Config), - #group{client_encoding = ReqEncoding, + #group{client_service = CN, + client_encoding = ReqEncoding, client_dict0 = Dict0} = Group - = proplists:get_value(group, Config), - diameter:call(?CLIENT, + = group(Config), + diameter:call(CN, dict(Req, Dict0), msg(Req, ReqEncoding, Dict0), [{extra, [{Name, Group}, diameter_lib:now()]} | Opts]). @@ -844,35 +936,38 @@ peer_down(_SvcName, _Peer, State) -> %% pick_peer/6-7 -pick_peer(Peers, _, ?CLIENT, _State, {Name, Group}, _) +pick_peer(Peers, _, [$C|_], _State, {Name, Group}, _) when Name /= send_detach -> find(Group, Peers). -pick_peer(_Peers, _, ?CLIENT, _State, {send_nopeer, _}, _, ?EXTRA) -> +pick_peer(_Peers, _, [$C|_], _State, {send_nopeer, _}, _, ?EXTRA) -> false; -pick_peer(Peers, _, ?CLIENT, _State, {send_detach, Group}, _, {_,_}) -> +pick_peer(Peers, _, [$C|_], _State, {send_detach, Group}, _, {_,_}) -> find(Group, Peers). -find(#group{server_encoding = A, server_container = C}, Peers) -> +find(#group{client_service = CN, + server_encoding = A, + server_container = C}, + Peers) -> Id = {A,C}, - [P] = [P || P <- Peers, id(Id, P)], + [P] = [P || P <- Peers, id(Id, P, CN)], {ok, P}. -id(Id, {Pid, _Caps}) -> +id(Id, {Pid, _Caps}, SvcName) -> [{ref, _}, {type, _}, {options, Opts} | _] - = diameter:service_info(?CLIENT, Pid), + = diameter:service_info(SvcName, Pid), lists:member({id, Id}, Opts). %% prepare_request/5-6 -prepare_request(_Pkt, ?CLIENT, {_Ref, _Caps}, {send_discard, _}, _) -> +prepare_request(_Pkt, [$C|_], {_Ref, _Caps}, {send_discard, _}, _) -> {discard, unprepared}; -prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, {Name, Group}, _) -> +prepare_request(Pkt, [$C|_], {_Ref, Caps}, {Name, Group}, _) -> {send, prepare(Pkt, Caps, Name, Group)}. -prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, {send_detach, Group}, _, _) -> +prepare_request(Pkt, [$C|_], {_Ref, Caps}, {send_detach, Group}, _, _) -> {eval_packet, {send, prepare(Pkt, Caps, Group)}, [fun log/2, detach]}. log(#diameter_packet{bin = Bin} = P, T) @@ -1043,10 +1138,10 @@ prepare_retransmit(_Pkt, false, _Peer, _Name, _Group) -> %% handle_answer/6-7 -handle_answer(Pkt, Req, ?CLIENT, Peer, {Name, Group}, _) -> +handle_answer(Pkt, Req, [$C|_], Peer, {Name, Group}, _) -> answer(Pkt, Req, Peer, Name, Group). -handle_answer(Pkt, Req, ?CLIENT, Peer, {send_detach = Name, Group}, _, X) -> +handle_answer(Pkt, Req, [$C|_], Peer, {send_detach = Name, Group}, _, X) -> {Pid, Ref} = X, Pid ! {Ref, answer(Pkt, Req, Peer, Name, Group)}. @@ -1058,6 +1153,13 @@ answer(Pkt, Req, _Peer, Name, #group{client_dict0 = Dict0}) -> [R | Vs] = Dict:'#get-'(answer(Ans, Es, Name)), [Dict:rec2msg(R) | Vs]. +%% Missing Result-Codec and inapproriate Experimental-Result-Code. +answer(Rec, Es, send_experimental_result) -> + [{5004, #diameter_avp{name = 'Experimental-Result'}}, + {5005, #diameter_avp{name = 'Result-Code'}}] + = Es, + Rec; + %% An inappropriate E-bit results in a decode error ... answer(Rec, Es, send_bad_answer) -> [{5004, #diameter_avp{name = 'Result-Code'}} | _] = Es, @@ -1075,13 +1177,13 @@ app(Req, _, Dict0) -> %% handle_error/6 -handle_error(timeout = Reason, _Req, ?CLIENT, _Peer, _, Time) -> +handle_error(timeout = Reason, _Req, [$C|_], _Peer, _, Time) -> Now = diameter_lib:now(), {Reason, {diameter_lib:timestamp(Time), diameter_lib:timestamp(Now), diameter_lib:micro_diff(Now, Time)}}; -handle_error(Reason, _Req, ?CLIENT, _Peer, _, _Time) -> +handle_error(Reason, _Req, [$C|_], _Peer, _, _Time) -> {error, Reason}. %% handle_request/3 @@ -1089,7 +1191,9 @@ handle_error(Reason, _Req, ?CLIENT, _Peer, _, _Time) -> %% Note that diameter will set Result-Code and Failed-AVPs if %% #diameter_packet.errors is non-null. -handle_request(#diameter_packet{header = H, msg = M}, ?SERVER, {_Ref, Caps}) -> +handle_request(#diameter_packet{header = H, msg = M, avps = As}, + _, + {_Ref, Caps}) -> #diameter_header{end_to_end_id = EI, hop_by_hop_id = HI} = H, @@ -1097,10 +1201,12 @@ handle_request(#diameter_packet{header = H, msg = M}, ?SERVER, {_Ref, Caps}) -> V = EI bsr B, %% assert V = HI bsr B, %% #diameter_caps{origin_state_id = {_,[Id]}} = Caps, - answer(origin(Id), request(M, Caps)). + answer(origin(Id), request(M, [H|As], Caps)). answer(T, {Tag, Action, Post}) -> {Tag, answer(T, Action), Post}; +answer(_, {reply, [#diameter_header{} | _]} = T) -> + T; answer({A,C}, {reply, Ans}) -> answer(C, {reply, msg(Ans, A, diameter_gen_base_rfc3588)}); answer(pkt, {reply, Ans}) @@ -1109,6 +1215,41 @@ answer(pkt, {reply, Ans}) answer(_, T) -> T. +%% request/3 + +%% send_experimental_result +request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 5}, + [Hdr | Avps], + #diameter_caps{origin_host = {OH, _}, + origin_realm = {OR, _}}) -> + [H,R|T] = [A || N <- ['Origin-Host', + 'Origin-Realm', + 'Session-Id', + 'Accounting-Record-Type', + 'Accounting-Record-Number'], + #diameter_avp{} = A + <- [lists:keyfind(N, #diameter_avp.name, Avps)]], + Ans = [Hdr#diameter_header{is_request = false}, + H#diameter_avp{data = OH}, + R#diameter_avp{data = OR}, + #diameter_avp{name = 'Experimental-Result', + code = 297, + need_encryption = false, + data = [#diameter_avp{data = {?DIAMETER_DICT_COMMON, + 'Vendor-Id', + 123}}, + #diameter_avp{data + = {?DIAMETER_DICT_COMMON, + 'Experimental-Result-Code', + 3987}}]} + | T], + {reply, Ans}; + +request(Msg, _Avps, Caps) -> + request(Msg, Caps). + +%% request/2 + %% send_nok request(#diameter_base_accounting_ACR{'Accounting-Record-Number' = 0}, _) -> diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index 587ae08b3d..db7f72c44e 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -1,8 +1,6 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2014. All Rights Reserved. +# Copyright Ericsson AB 2010-2015. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -18,5 +16,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.8 +DIAMETER_VSN = 1.9.1 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/edoc/doc/overview.edoc b/lib/edoc/doc/overview.edoc index 0ced8cab32..3639bb43a5 100644 --- a/lib/edoc/doc/overview.edoc +++ b/lib/edoc/doc/overview.edoc @@ -78,7 +78,7 @@ The following are the main functions for running EDoc: typical Erlang application.</li> <li>{@link edoc:files/2}: Creates documentation for a specified set of source files.</li> - <li>{@link edoc:run/3}: General interface function; the common + <li>{@link edoc:run/2}: General interface function; the common back-end for the above functions. Options are documented here.</li> </ul> diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index 78915e8943..90f1fc3071 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -313,7 +313,7 @@ opt_negations() -> %% INHERIT-OPTIONS: target_dir_info/5 %% INHERIT-OPTIONS: edoc_lib:find_sources/2 %% INHERIT-OPTIONS: edoc_lib:run_doclet/2 -%% INHERIT-OPTIONS: edoc_lib:get_doc_env/4 +%% INHERIT-OPTIONS: edoc_lib:get_doc_env/3 run(Files, Opts0) -> Opts = expand_opts(Opts0), @@ -421,7 +421,7 @@ toc(Dir, Opts) -> %% INHERIT-OPTIONS: init_context/1 %% INHERIT-OPTIONS: edoc_lib:run_doclet/2 -%% INHERIT-OPTIONS: edoc_lib:get_doc_env/4 +%% INHERIT-OPTIONS: edoc_lib:get_doc_env/3 toc(Dir, Paths, Opts0) -> Opts = expand_opts(Opts0 ++ [{dir, Dir}]), @@ -689,13 +689,12 @@ scan_and_parse(Epp) -> fix_last_line(Toks0) -> Toks1 = lists:reverse(Toks0), - {line, LastLine} = erl_scan:token_info(hd(Toks1), line), + LastLine = erl_scan:line(hd(Toks1)), fll(Toks1, LastLine, []). -fll([{Category, Attributes0, Symbol} | L], LastLine, Ts) -> - F = fun(_OldLine) -> LastLine end, - Attributes = erl_scan:set_attribute(line, Attributes0, F), - lists:reverse(L, [{Category, Attributes, Symbol} | Ts]); +fll([{Category, Anno0, Symbol} | L], LastLine, Ts) -> + Anno = erl_anno:set_line(LastLine, Anno0), + lists:reverse(L, [{Category, Anno, Symbol} | Ts]); fll([T | L], LastLine, Ts) -> fll(L, LastLine, [T | Ts]); fll(L, _LastLine, Ts) -> @@ -769,7 +768,7 @@ get_doc(File) -> %% </dl> %% %% See {@link read_source/2}, {@link read_comments/2} and {@link -%% edoc_lib:get_doc_env/4} for further options. +%% edoc_lib:get_doc_env/3} for further options. %% %% @see get_doc/3 %% @see run/2 @@ -778,7 +777,7 @@ get_doc(File) -> %% @see layout/2 %% INHERIT-OPTIONS: get_doc/3 -%% INHERIT-OPTIONS: edoc_lib:get_doc_env/4 +%% INHERIT-OPTIONS: edoc_lib:get_doc_env/3 get_doc(File, Opts) -> Env = edoc_lib:get_doc_env(Opts), @@ -790,7 +789,7 @@ get_doc(File, Opts) -> %% %% @doc Like {@link get_doc/2}, but for a given environment %% parameter. `Env' is an environment created by {@link -%% edoc_lib:get_doc_env/4}. +%% edoc_lib:get_doc_env/3}. %% INHERIT-OPTIONS: read_source/2, read_comments/2, edoc_extract:source/5 %% DEFER-OPTIONS: get_doc/2 diff --git a/lib/edoc/src/edoc_extract.erl b/lib/edoc/src/edoc_extract.erl index 6d34de3a85..758750083d 100644 --- a/lib/edoc/src/edoc_extract.erl +++ b/lib/edoc/src/edoc_extract.erl @@ -91,7 +91,7 @@ source(Forms, Comments, File, Env, Opts) -> %% type `form_list', or a list of syntax trees representing %% "program forms" (cf. {@link edoc:read_source/2}. %% `Env' is an environment created by {@link -%% edoc_lib:get_doc_env/4}. The `File' argument is used for +%% edoc_lib:get_doc_env/3}. The `File' argument is used for %% error reporting and output file name generation only. %% %% See {@link edoc:get_doc/2} for descriptions of the `def', @@ -222,7 +222,7 @@ add_macro_defs(Defs0, Opts, Env) -> %% %% @doc Reads a text file and returns the list of tags in the file. Any %% lines of text before the first tag are ignored. `Env' is an -%% environment created by {@link edoc_lib:get_doc_env/4}. Upon error, +%% environment created by {@link edoc_lib:get_doc_env/3}. Upon error, %% `Reason' is an atom returned from the call to {@link %% //kernel/file:read_file/1} or the atom 'invalid_unicode'. %% @@ -252,7 +252,7 @@ file(File, Context, Env, Opts) -> %% %% @doc Returns the list of tags in the text. Any lines of text before %% the first tag are ignored. `Env' is an environment created by {@link -%% edoc_lib:get_doc_env/4}. +%% edoc_lib:get_doc_env/3}. %% %% See {@link source/4} for a description of the `def' option. diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index 6309e88475..62d5eb9a18 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -535,7 +535,8 @@ t_clause(Name, Type) -> pp_clause(Pre, Type) -> Types = ot_utype([Type]), Atom = lists:duplicate(iolist_size(Pre), $a), - L1 = erl_pp:attribute({attribute,0,spec,{{list_to_atom(Atom),0},[Types]}}), + Attr = {attribute,0,spec,{{list_to_atom(Atom),0},[Types]}}, + L1 = erl_pp:attribute(erl_parse:new_anno(Attr)), "-spec " ++ L2 = lists:flatten(L1), L3 = Pre ++ lists:nthtail(length(Atom), L2), re:replace(L3, "\n ", "\n", [{return,list},global]). @@ -555,7 +556,8 @@ format_type(Prefix, _Name, Type, Last, _Opts) -> pp_type(Prefix, Type) -> Atom = list_to_atom(lists:duplicate(iolist_size(Prefix), $a)), - L1 = erl_pp:attribute({attribute,0,type,{Atom,ot_utype(Type),[]}}), + Attr = {attribute,0,type,{Atom,ot_utype(Type),[]}}, + L1 = erl_pp:attribute(erl_parse:new_anno(Attr)), {L2,N} = case lists:dropwhile(fun(C) -> C =/= $: end, lists:flatten(L1)) of ":: " ++ L3 -> {L3,9}; % compensation for extra "()" and ":" "::\n" ++ L3 -> {"\n"++L3,6} @@ -1085,8 +1087,8 @@ ot_var(E) -> {var,0,list_to_atom(get_attrval(name, E))}. ot_atom(E) -> - {ok, [Atom], _} = erl_scan:string(get_attrval(value, E), 0), - Atom. + {ok, [{atom,A,Name}], _} = erl_scan:string(get_attrval(value, E), 0), + {atom,erl_anno:line(A),Name}. ot_integer(E) -> {integer,0,list_to_integer(get_attrval(value, E))}. diff --git a/lib/edoc/src/edoc_lib.erl b/lib/edoc/src/edoc_lib.erl index 813fcf2476..dcc239f6b4 100644 --- a/lib/edoc/src/edoc_lib.erl +++ b/lib/edoc/src/edoc_lib.erl @@ -888,7 +888,7 @@ find_doc_dirs([]) -> %% implies that we use the default app-path. %% NEW-OPTIONS: doc_path -%% DEFER-OPTIONS: get_doc_env/4 +%% DEFER-OPTIONS: get_doc_env/3 get_doc_links(App, Modules, Opts) -> Path = proplists:append_values(doc_path, Opts) ++ find_doc_dirs(), @@ -924,7 +924,7 @@ add_new(K, V, D) -> end. %% @spec (Options::proplist()) -> edoc_env() -%% @equiv get_doc_env([], [], [], Opts) +%% @equiv get_doc_env([], [], Opts) %% @private get_doc_env(Opts) -> @@ -940,7 +940,7 @@ get_doc_env(Opts) -> %% generating references. The data representation is not documented. %% %% @doc Creates an environment data structure used by parts of EDoc for -%% generating references, etc. See {@link edoc:run/3} for a description +%% generating references, etc. See {@link edoc:run/2} for a description %% of the options `file_suffix', `app_default' and `doc_path'. %% %% @see edoc_extract:source/4 @@ -948,7 +948,7 @@ get_doc_env(Opts) -> %% NEW-OPTIONS: file_suffix, app_default %% INHERIT-OPTIONS: get_doc_links/4 -%% DEFER-OPTIONS: edoc:run/3 +%% DEFER-OPTIONS: edoc:run/2 get_doc_env(App, Modules, Opts) -> Suffix = proplists:get_value(file_suffix, Opts, @@ -967,10 +967,10 @@ get_doc_env(App, Modules, Opts) -> %% --------------------------------------------------------------------- %% Plug-in modules -%% @doc See {@link edoc:run/3} for a description of the `doclet' option. +%% @doc See {@link edoc:run/2} for a description of the `doclet' option. %% NEW-OPTIONS: doclet -%% DEFER-OPTIONS: edoc:run/3 +%% DEFER-OPTIONS: edoc:run/2 %% @private run_doclet(Fun, Opts) -> @@ -1012,7 +1012,7 @@ get_plugin(Key, Default, Opts) -> %% --------------------------------------------------------------------- %% Error handling --type line() :: erl_scan:line(). +-type line() :: erl_anno:line(). -type err() :: 'eof' | {'missing', char()} | {line(), atom(), string()} diff --git a/lib/edoc/src/edoc_macros.erl b/lib/edoc/src/edoc_macros.erl index bdcb3fe81f..e1a54d5090 100644 --- a/lib/edoc/src/edoc_macros.erl +++ b/lib/edoc/src/edoc_macros.erl @@ -311,7 +311,7 @@ macro_content([C | Cs], As, L, N) -> macro_content([], _As, _L, _N) -> throw('end'). --type line() :: erl_scan:line(). +-type line() :: erl_anno:line(). -type err() :: 'unterminated_macro' | 'macro_name' | {'macro_name', string()} diff --git a/lib/edoc/src/edoc_parser.yrl b/lib/edoc/src/edoc_parser.yrl index 48c01c8dce..835e7ccaa6 100644 --- a/lib/edoc/src/edoc_parser.yrl +++ b/lib/edoc/src/edoc_parser.yrl @@ -338,7 +338,7 @@ build_def(S, P, As, T) -> args = lists:reverse(As)}, type = T}; false -> - return_error(element(2, P), "variable expected after '('") + return_error(tok_line(P), "variable expected after '('") end. all_vars([#t_var{} | As]) -> @@ -452,7 +452,7 @@ parse_throws(S, L) -> %% --------------------------------------------------------------------- --spec throw_error(term(), erl_scan:line()) -> no_return(). +-spec throw_error(term(), erl_anno:line()) -> no_return(). throw_error({parse_spec, E}, L) -> throw_error({"specification", E}, L); diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index 3bf81c6503..59f6cb8ddf 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -58,7 +58,7 @@ type(Form, TypeDocs) -> end, {#t_name{name = N}, T, As, Doc0} end, - #tag{name = type, line = element(2, Type), + #tag{name = type, line = get_line(element(2, Type)), origin = code, data = {#t_typedef{name = TypeName, args = d2e(Args), @@ -71,7 +71,7 @@ type(Form, TypeDocs) -> spec(Form, Clause) -> {Name, _Arity, TypeSpecs} = get_spec(Form), TypeSpec = lists:nth(Clause, TypeSpecs), - #tag{name = spec, line = element(2, TypeSpec), + #tag{name = spec, line = get_line(element(2, TypeSpec)), origin = code, data = aspec(d2e(TypeSpec), Name)}. @@ -83,7 +83,7 @@ dummy_spec(Form) -> {#t_name{name = Name}, Arity, TypeSpecs} = get_spec(Form), As = string:join(lists:duplicate(Arity, "_X"), ","), S = lists:flatten(io_lib:format("~p(~s) -> true\n", [Name, As])), - #tag{name = spec, line = element(2, hd(TypeSpecs)), + #tag{name = spec, line = get_line(element(2, hd(TypeSpecs))), origin = code, data = S}. -spec docs(Forms::[syntaxTree()], @@ -140,7 +140,7 @@ find_type_docs([F | Fs], Cs, Fun) -> %% Postcomments before the dot after the typespec are ignored. C2 = [C1 | [C || C <- erl_syntax:get_postcomments(F), - get_line(erl_syntax:get_pos(C)) >= LastTypeLine]], + erl_syntax:get_pos(C) >= LastTypeLine]], C3 = collect_comments(Fs, LastTypeLine), #tag{data = Doc0} = Fun(lists:reverse(C2 ++ C3), LastTypeLine), case strip(Doc0) of % Strip away "f(). \n" @@ -157,7 +157,7 @@ find_type_docs([F | Fs], Cs, Fun) -> collect_comments([], _Line) -> []; collect_comments([F | Fs], Line) -> - L1 = get_line(erl_syntax:get_pos(F)), + L1 = erl_syntax:get_pos(F), if L1 =:= Line + 1; L1 =:= Line -> % a separate postcomment @@ -190,29 +190,26 @@ get_name_and_last_line(F) -> {Name, Data} = erl_syntax_lib:analyze_wild_attribute(F), type = edoc_specs:tag(Name), Attr = {attribute, erl_syntax:get_pos(F), Name, Data}, - Ref = make_ref(), - Fun = fun(L) -> {Ref, get_line(L)} end, + Fun = fun(A) -> + Line = get_line(A), + case get('$max_line') of + Max when Max < Line -> + _ = put('$max_line', Line); + _ -> + ok + end + end, + undefined = put('$max_line', 0), + _ = erl_parse:map_anno(Fun, Attr), + Line = erase('$max_line'), TypeName = case Data of {N, _T, As} when is_atom(N) -> % skip records {N, length(As)} end, - Line = gll(erl_lint:modify_line(Attr, Fun), Ref), {TypeName, Line}. -gll({Ref, Line}, Ref) -> - Line; -gll([], _Ref) -> - 0; -gll(List, Ref) when is_list(List) -> - lists:max([gll(E, Ref) || E <- List]); -gll(Tuple, Ref) when is_tuple(Tuple) -> - gll(tuple_to_list(Tuple), Ref); -gll(_, _) -> - 0. - -get_line(Pos) -> - {line, Line} = erl_scan:attributes_info(Pos, line), - Line. +get_line(Anno) -> + erl_anno:line(Anno). %% Collect all Erlang types. Types in comments (@type) shadow Erlang %% types (-spec/-opaque). @@ -348,7 +345,7 @@ d2e({type,_,constraint,[Sub,Ts0]}) -> Ts = [ST,T] = d2e([ST0,T0]), #t_def{name = ST, type = typevar_anno(T, Ts)}; _ -> - throw_error(element(2, Sub), "cannot handle guard", []) + throw_error(get_line(element(2, Sub)), "cannot handle guard", []) end; d2e({type,_,union,Ts0}) -> Ts = d2e(Ts0), diff --git a/lib/edoc/src/edoc_tags.erl b/lib/edoc/src/edoc_tags.erl index c1c453511a..9e2e41e902 100644 --- a/lib/edoc/src/edoc_tags.erl +++ b/lib/edoc/src/edoc_tags.erl @@ -342,7 +342,7 @@ parse_typedef(Data, Line, _Env, Where) -> Def end. --type line() :: erl_scan:line(). +-type line() :: erl_anno:line(). -spec parse_file(_, line(), _, _) -> no_return(). diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml index b68115cd82..ed35ee3a9c 100644 --- a/lib/eldap/doc/src/eldap.xml +++ b/lib/eldap/doc/src/eldap.xml @@ -103,7 +103,7 @@ filter() See present/1, substrings/2, <type> <v>Handle = handle()</v> <v>Options = ssl:ssl_options()</v> - <v>Timeout = inifinity | positive_integer()</v> + <v>Timeout = infinity | positive_integer()</v> </type> <desc> <p>Upgrade the connection associated with <c>Handle</c> to a tls connection if possible.</p> diff --git a/lib/eldap/doc/src/notes.xml b/lib/eldap/doc/src/notes.xml index e5cbcb26ff..e76101c30e 100644 --- a/lib/eldap/doc/src/notes.xml +++ b/lib/eldap/doc/src/notes.xml @@ -30,6 +30,42 @@ </header> <p>This document describes the changes made to the Eldap application.</p> +<section><title>Eldap 1.1.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Corrects that <c>eldap:close/1</c> returned a tuple + instead of the specified atom <c>ok</c>.</p> + <p> + Own Id: OTP-12349</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Clarification in the reference manual for + <c>eldap:modify_dn/5</c>, <c>eldap:search/2</c> and + <c>eldap:start_tls/3</c>.</p> + <p> + Own Id: OTP-12354</p> + </item> + <item> + <p> + The eldap test suites are extended and re-organized.</p> + <p> + Own Id: OTP-12355</p> + </item> + </list> + </section> + +</section> + <section><title>Eldap 1.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/eldap/vsn.mk b/lib/eldap/vsn.mk index 432ba2e742..105a2bcdbb 100644 --- a/lib/eldap/vsn.mk +++ b/lib/eldap/vsn.mk @@ -1 +1 @@ -ELDAP_VSN = 1.1 +ELDAP_VSN = 1.2 diff --git a/lib/erl_docgen/priv/css/otp_doc.css b/lib/erl_docgen/priv/css/otp_doc.css index c56de378f4..0b531db701 100644 --- a/lib/erl_docgen/priv/css/otp_doc.css +++ b/lib/erl_docgen/priv/css/otp_doc.css @@ -66,7 +66,7 @@ a:visited { color: blue; text-decoration: none } span.bold_code { font-family: Courier, monospace; font-weight: bold } span.code { font-family: Courier, monospace; font-weight: normal } -.note, .warning { +.note, .warning, .do, .dont { border: solid black 1px; margin: 1em 3em; } @@ -96,10 +96,41 @@ span.code { font-family: Courier, monospace; font-weight: normal } font-size: 90%; padding: 5px 10px; } +.do .label { + background: #30d42a; + color: white; + font-weight: bold; + padding: 5px 10px; +} +.do .content { + background: #eafeea; + color: black; + line-height: 120%; + font-size: 90%; + padding: 5px 10px; +} +.dont .label { + background: #C00; + color: white; + font-weight: bold; + padding: 5px 10px; +} +.dont .content { + background: #FFF0F0; + color: black; + line-height: 120%; + font-size: 90%; + padding: 5px 10px; +} .example { background-color:#eeeeff; padding: 0px 10px; } +.extrafrontpageinfo { + color: #C00; + font-weight: bold; + font-size: 120%; +} pre { font-family: Courier, monospace; font-weight: normal } diff --git a/lib/erl_docgen/priv/dtd/application.dtd b/lib/erl_docgen/priv/dtd/application.dtd index 8a1e8832ec..fcadaced72 100644 --- a/lib/erl_docgen/priv/dtd/application.dtd +++ b/lib/erl_docgen/priv/dtd/application.dtd @@ -24,6 +24,6 @@ %common.header; <!ELEMENT application (header,description?,include+) > -<!ELEMENT description (%block;|quote|br|marker|warning|note)* > +<!ELEMENT description (%block;|quote|br|marker|warning|note|dont|do)* > <!ELEMENT include EMPTY > <!ATTLIST include file CDATA #REQUIRED> diff --git a/lib/erl_docgen/priv/dtd/book.dtd b/lib/erl_docgen/priv/dtd/book.dtd index bb89a6d255..ef723a9eed 100644 --- a/lib/erl_docgen/priv/dtd/book.dtd +++ b/lib/erl_docgen/priv/dtd/book.dtd @@ -38,7 +38,7 @@ <!ELEMENT pagetext (#PCDATA) > <!ELEMENT preamble (contents?,preface?) > -<!ELEMENT preface (title?,(%block;|quote|br|marker|warning|note|table)*) > +<!ELEMENT preface (title?,(%block;|quote|br|marker|warning|note|dont|do|table)*) > <!ELEMENT insidecover (#PCDATA|br|theheader|vfill|vspace|tt|bold| include)* > @@ -67,7 +67,7 @@ <!ELEMENT onepart (title?,description?,include+) > <!ATTLIST onepart lift (yes|no) "no" > -<!ELEMENT description (%block;|quote|br|marker|warning|note)* > +<!ELEMENT description (%block;|quote|br|marker|warning|note|dont|do)* > <!ELEMENT include EMPTY > <!ATTLIST include file CDATA #REQUIRED> diff --git a/lib/erl_docgen/priv/dtd/chapter.dtd b/lib/erl_docgen/priv/dtd/chapter.dtd index eb2c96b04f..4beff6cc54 100644 --- a/lib/erl_docgen/priv/dtd/chapter.dtd +++ b/lib/erl_docgen/priv/dtd/chapter.dtd @@ -29,8 +29,8 @@ <!-- Structure --> -<!ELEMENT chapter (header,(%block;|quote|warning|note|br| +<!ELEMENT chapter (header,(%block;|quote|warning|note|dont|do|br| image|marker|table)*,section+) > <!ELEMENT section (marker*,title, - (%block;|quote|warning|note|br|image|marker| + (%block;|quote|warning|note|dont|do|br|image|marker| table|section)*) > diff --git a/lib/erl_docgen/priv/dtd/common.dtd b/lib/erl_docgen/priv/dtd/common.dtd index f999ef8ea4..92d814e0f1 100644 --- a/lib/erl_docgen/priv/dtd/common.dtd +++ b/lib/erl_docgen/priv/dtd/common.dtd @@ -34,6 +34,8 @@ <!ELEMENT quote (p)* > <!ELEMENT warning (%block;|quote|br|marker)* > <!ELEMENT note (%block;|quote|br|marker)* > +<!ELEMENT dont (%block;|quote|br|marker)* > +<!ELEMENT do (%block;|quote|br|marker)* > <!ELEMENT c (#PCDATA) > <!ELEMENT em (#PCDATA|c)* > diff --git a/lib/erl_docgen/priv/dtd/common.refs.dtd b/lib/erl_docgen/priv/dtd/common.refs.dtd index 93592607df..a08b9e89d4 100644 --- a/lib/erl_docgen/priv/dtd/common.refs.dtd +++ b/lib/erl_docgen/priv/dtd/common.refs.dtd @@ -24,7 +24,7 @@ <!ENTITY % common.header SYSTEM "common.header.dtd" > %common.header; -<!ELEMENT description (%block;|quote|br|marker|warning|note)* > +<!ELEMENT description (%block;|quote|br|marker|warning|note|dont|do)* > <!ELEMENT funcs (func)+ > <!ELEMENT func (name+,type_desc*,fsummary,type?,desc?) > <!-- ELEMENT name is defined in each ref dtd --> @@ -34,12 +34,12 @@ name_i CDATA #IMPLIED> <!ELEMENT v (#PCDATA) > <!ELEMENT d (#PCDATA|c|em)* > -<!ELEMENT desc (%block;|quote|br|marker|warning|note|anno)* > +<!ELEMENT desc (%block;|quote|br|marker|warning|note|dont|do|anno)* > <!ELEMENT authors (aname,email)+ > <!ELEMENT aname (#PCDATA) > <!ELEMENT email (#PCDATA) > <!ELEMENT section (marker*,title,(%block;|quote|br|marker| - warning|note)*) > + warning|note|dont|do)*) > <!ELEMENT datatypes (datatype)+ > <!ELEMENT datatype (name+,desc?) > <!ELEMENT type_desc (#PCDATA) > diff --git a/lib/erl_docgen/priv/dtd/part.dtd b/lib/erl_docgen/priv/dtd/part.dtd index 3f97199042..79f68c415d 100644 --- a/lib/erl_docgen/priv/dtd/part.dtd +++ b/lib/erl_docgen/priv/dtd/part.dtd @@ -24,6 +24,6 @@ %common.header; <!ELEMENT part (header,description?,include+) > -<!ELEMENT description (%block;|quote|br|marker|warning|note)* > +<!ELEMENT description (%block;|quote|br|marker|warning|note|dont|do)* > <!ELEMENT include EMPTY > <!ATTLIST include file CDATA #REQUIRED> diff --git a/lib/erl_docgen/priv/dtd/report.dtd b/lib/erl_docgen/priv/dtd/report.dtd index 3d07e6e5a7..eb463f8867 100644 --- a/lib/erl_docgen/priv/dtd/report.dtd +++ b/lib/erl_docgen/priv/dtd/report.dtd @@ -48,7 +48,7 @@ <!ELEMENT file (#PCDATA) > <!ELEMENT section (marker*,title, - (%block;|quote|warning|note|br|image|marker| + (%block;|quote|warning|note|dont|do|br|image|marker| table|section)*) > <!ELEMENT p (%inline;|index)* > <!ELEMENT pre (#PCDATA|seealso|url|input)* > @@ -58,6 +58,8 @@ <!ELEMENT quote (p)* > <!ELEMENT warning (%block;|quote|br|image|marker|table)* > <!ELEMENT note (%block;|quote|br|image|marker|table)* > +<!ELEMENT dont (%block;|quote|br|image|marker|table)* > +<!ELEMENT do (%block;|quote|br|image|marker|table)* > <!ELEMENT i (#PCDATA|b|c|em)* > <!ELEMENT b (#PCDATA|i|c|em)* > <!ELEMENT c (#PCDATA) > diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index ab5f24c406..3529924957 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -952,6 +952,36 @@ </div> </xsl:template> + <!-- Do --> + <xsl:template match="do"> + <xsl:param name="chapnum"/> + <div class="do"> + <div class="label">Do</div> + <div class="content"> + <p> + <xsl:apply-templates> + <xsl:with-param name="chapnum" select="$chapnum"/> + </xsl:apply-templates> + </p> + </div> + </div> + </xsl:template> + + <!-- Dont --> + <xsl:template match="dont"> + <xsl:param name="chapnum"/> + <div class="dont"> + <div class="label">Don't</div> + <div class="content"> + <p> + <xsl:apply-templates> + <xsl:with-param name="chapnum" select="$chapnum"/> + </xsl:apply-templates> + </p> + </div> + </div> + </xsl:template> + <!-- Paragraph --> <xsl:template match="p"> <p> @@ -1102,6 +1132,9 @@ <center><h4>Version <xsl:value-of select="$appver"/></h4></center> <center><h4><xsl:value-of select="$gendate"/></h4></center> + <div class="extrafrontpageinfo"> + <center><xsl:value-of select="$extra_front_page_info"/></center> + </div> <xsl:apply-templates select="chapter"/> @@ -1267,6 +1300,9 @@ <center><h4>Version <xsl:value-of select="$appver"/></h4></center> <center><h4><xsl:value-of select="$gendate"/></h4></center> + <div class="extrafrontpageinfo"> + <center><xsl:value-of select="$extra_front_page_info"/></center> + </div> <xsl:apply-templates select="erlref|cref|comref|fileref|appref"/> @@ -2089,6 +2125,9 @@ <center><h4>Version <xsl:value-of select="$appver"/></h4></center> <center><h4><xsl:value-of select="$gendate"/></h4></center> + <div class="extrafrontpageinfo"> + <center><xsl:value-of select="$extra_front_page_info"/></center> + </div> <xsl:apply-templates select="chapter"/> diff --git a/lib/erl_docgen/priv/xsl/db_man.xsl b/lib/erl_docgen/priv/xsl/db_man.xsl index 3bcdd11c35..0caaba560f 100644 --- a/lib/erl_docgen/priv/xsl/db_man.xsl +++ b/lib/erl_docgen/priv/xsl/db_man.xsl @@ -543,7 +543,29 @@ <xsl:text> </xsl:text> </xsl:template> - <xsl:template match="warning/p | note/p"> + <!-- Do --> + <xsl:template match="do"> + <xsl:text> .LP </xsl:text> + <xsl:text> .RS -4</xsl:text> + <xsl:text> .B </xsl:text> + <xsl:text>Do:</xsl:text> + <xsl:text> .RE</xsl:text> + <xsl:apply-templates/> + <xsl:text> </xsl:text> + </xsl:template> + + <!-- Dont --> + <xsl:template match="dont"> + <xsl:text> .LP </xsl:text> + <xsl:text> .RS -4</xsl:text> + <xsl:text> .B </xsl:text> + <xsl:text>Dont:</xsl:text> + <xsl:text> .RE</xsl:text> + <xsl:apply-templates/> + <xsl:text> </xsl:text> + </xsl:template> + + <xsl:template match="warning/p | note/p | dont/p | do/p"> <xsl:variable name="content"> <xsl:text> </xsl:text> <xsl:apply-templates/> diff --git a/lib/erl_docgen/priv/xsl/db_pdf.xsl b/lib/erl_docgen/priv/xsl/db_pdf.xsl index c15b16eb5b..ccf96053aa 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf.xsl @@ -671,6 +671,10 @@ <fo:block xsl:use-attribute-sets="cover.version"> <xsl:value-of select="$gendate"/> </fo:block> + <fo:block xsl:use-attribute-sets="cover.extrainfo"> + <xsl:value-of select="$extra_front_page_info"/> + </fo:block> + <!-- Inner cover (copyright notice) --> <fo:block break-before="page" @@ -1138,6 +1142,31 @@ </fo:block> </xsl:template> + <!-- Do --> + <xsl:template match="do"> + <xsl:param name="partnum"/> + <fo:block xsl:use-attribute-sets="do"> + <fo:block xsl:use-attribute-sets="note-warning-title"> + <xsl:text>Do:</xsl:text> + </fo:block> + <xsl:apply-templates> + <xsl:with-param name="partnum" select="$partnum"/> + </xsl:apply-templates> + </fo:block> + </xsl:template> + + <!-- Dont --> + <xsl:template match="dont"> + <xsl:param name="partnum"/> + <fo:block xsl:use-attribute-sets="dont"> + <fo:block xsl:use-attribute-sets="note-warning-title"> + <xsl:text>Don't:</xsl:text> + </fo:block> + <xsl:apply-templates> + <xsl:with-param name="partnum" select="$partnum"/> + </xsl:apply-templates> + </fo:block> + </xsl:template> <!-- Paragraph --> <xsl:template match="p"> diff --git a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl index 2e3b22acf4..a4814581c2 100644 --- a/lib/erl_docgen/priv/xsl/db_pdf_params.xsl +++ b/lib/erl_docgen/priv/xsl/db_pdf_params.xsl @@ -98,6 +98,14 @@ <xsl:attribute name="text-align">end</xsl:attribute> </xsl:attribute-set> + <xsl:attribute-set name="cover.extrainfo"> + <xsl:attribute name="padding-before">2.5em</xsl:attribute> + <xsl:attribute name="font-size">1.33em</xsl:attribute> + <xsl:attribute name="font-weight">bold</xsl:attribute> + <xsl:attribute name="color">#C00</xsl:attribute> + <xsl:attribute name="text-align">end</xsl:attribute> + </xsl:attribute-set> + <xsl:attribute-set name="cover.inner.copyright"> <xsl:attribute name="border-before-style">solid</xsl:attribute> <xsl:attribute name="border-before-width">1pt</xsl:attribute> @@ -289,6 +297,33 @@ <xsl:attribute name="keep-together.within-page">always</xsl:attribute> </xsl:attribute-set> +<xsl:attribute-set name="do"> + <xsl:attribute name="background-color">#d0fed0</xsl:attribute> + <xsl:attribute name="space-after">1em</xsl:attribute> + <xsl:attribute name="space-before">2em</xsl:attribute> + <xsl:attribute name="text-align">justify</xsl:attribute> + <xsl:attribute name="padding-before">1em</xsl:attribute> + <xsl:attribute name="padding-after">0.3em</xsl:attribute> + <xsl:attribute name="padding-left">0.5em</xsl:attribute> + <xsl:attribute name="padding-right">0.5em</xsl:attribute> + <xsl:attribute name="margin-left">0.5em</xsl:attribute> + <xsl:attribute name="margin-right">0.5em</xsl:attribute> + <xsl:attribute name="keep-together.within-page">always</xsl:attribute> + </xsl:attribute-set> + +<xsl:attribute-set name="dont"> + <xsl:attribute name="background-color">#ffd6d6</xsl:attribute> + <xsl:attribute name="space-after">1em</xsl:attribute> + <xsl:attribute name="space-before">2em</xsl:attribute> + <xsl:attribute name="text-align">justify</xsl:attribute> + <xsl:attribute name="padding-before">1em</xsl:attribute> + <xsl:attribute name="padding-after">0.3em</xsl:attribute> + <xsl:attribute name="padding-left">0.5em</xsl:attribute> + <xsl:attribute name="padding-right">0.5em</xsl:attribute> + <xsl:attribute name="margin-left">0.5em</xsl:attribute> + <xsl:attribute name="margin-right">0.5em</xsl:attribute> + <xsl:attribute name="keep-together.within-page">always</xsl:attribute> + </xsl:attribute-set> <xsl:attribute-set name="note-warning-title"> <xsl:attribute name="font-size">1.33em</xsl:attribute> diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl index e2eee2b3c0..b62e69529b 100644 --- a/lib/erl_docgen/src/docgen_otp_specs.erl +++ b/lib/erl_docgen/src/docgen_otp_specs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -202,7 +202,8 @@ t_clause(Name, Type) -> pp_clause(Pre, Type) -> Types = ot_utype([Type]), Atom = lists:duplicate(iolist_size(Pre), $a), - L1 = erl_pp:attribute({attribute,0,spec,{{list_to_atom(Atom),0},[Types]}}), + Attr = {attribute,0,spec,{{list_to_atom(Atom),0},[Types]}}, + L1 = erl_pp:attribute(erl_parse:new_anno(Attr)), "-spec " ++ L2 = lists:flatten(L1), L3 = Pre ++ lists:nthtail(length(Atom), L2), re:replace(L3, "\n ", "\n", [{return,list},global]). @@ -222,7 +223,8 @@ format_type(_Name, Type, _Opts) -> pp_type(Prefix, Type) -> Atom = list_to_atom(lists:duplicate(iolist_size(Prefix), $a)), - L1 = erl_pp:attribute({attribute,0,type,{Atom,ot_utype(Type),[]}}), + Attr = {attribute,0,type,{Atom,ot_utype(Type),[]}}, + L1 = erl_pp:attribute(erl_parse:new_anno(Attr)), {L2,N} = case lists:dropwhile(fun(C) -> C =/= $: end, lists:flatten(L1)) of ":: " ++ L3 -> {L3,9}; % compensation for extra "()" and ":" "::\n" ++ L3 -> {"\n"++L3,6} @@ -569,8 +571,8 @@ ot_var(E) -> {var,0,list_to_atom(get_attrval(name, E))}. ot_atom(E) -> - {ok, [Atom], _} = erl_scan:string(get_attrval(value, E), 0), - Atom. + {ok, [{atom,A,Name}], _} = erl_scan:string(get_attrval(value, E), 0), + {atom,erl_anno:line(A),Name}. ot_integer(E) -> {integer,0,list_to_integer(get_attrval(value, E))}. diff --git a/lib/erl_docgen/vsn.mk b/lib/erl_docgen/vsn.mk index 8957d6ac40..5823c96253 100644 --- a/lib/erl_docgen/vsn.mk +++ b/lib/erl_docgen/vsn.mk @@ -1 +1 @@ -ERL_DOCGEN_VSN = 0.3.7 +ERL_DOCGEN_VSN = 0.3.8 diff --git a/lib/eunit/src/eunit_autoexport.erl b/lib/eunit/src/eunit_autoexport.erl index 36ae3b71d7..7bb78f5ea8 100644 --- a/lib/eunit/src/eunit_autoexport.erl +++ b/lib/eunit/src/eunit_autoexport.erl @@ -79,11 +79,12 @@ rewrite([{function,_,test,0,_}=F | Fs], As, Module, _Test) -> rewrite([F | Fs], As, Module, Test) -> rewrite(Fs, [F | As], Module, Test); rewrite([], As, Module, Test) -> + L = erl_anno:new(0), {if Test -> - [{function,0,test,0, - [{clause,0,[],[], - [{call,0,{remote,0,{atom,0,eunit},{atom,0,test}}, - [{atom,0,Module}]}]}]} + [{function,L,test,0, + [{clause,L,[],[], + [{call,L,{remote,L,{atom,L,eunit},{atom,L,test}}, + [{atom,L,Module}]}]}]} | As]; true -> As @@ -96,4 +97,4 @@ module_decl(Name, M, Fs, Exports) -> Es = if Test -> [{test,0} | Exports]; true -> Exports end, - [M, {attribute,0,export,Es} | lists:reverse(Fs1)]. + [M, {attribute,erl_anno:new(0),export,Es} | lists:reverse(Fs1)]. diff --git a/lib/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl index 2645056be1..f98aaa12f3 100644 --- a/lib/hipe/cerl/cerl_to_icode.erl +++ b/lib/hipe/cerl/cerl_to_icode.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -110,7 +110,7 @@ effect = false :: boolean(), fail = [], % [] or fail-to label class = expr :: 'expr' | 'guard', - line = 0 :: erl_scan:line(), % current line number + line = 0 :: erl_anno:line(), % current line number 'receive' :: 'undefined' | #'receive'{} }). diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 09dffe1280..14335cf635 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -67,7 +67,6 @@ t_cons/2, t_cons_hd/1, t_cons_hd/2, t_cons_tl/1, t_cons_tl/2, - t_constant/0, t_contains_opaque/1, t_contains_opaque/2, t_decorate_with_opaque/3, t_elements/1, @@ -118,7 +117,6 @@ %% t_is_byte/1, %% t_is_char/1, t_is_cons/1, t_is_cons/2, - t_is_constant/1, t_is_equal/2, t_is_fixnum/1, t_is_float/1, t_is_float/2, @@ -1748,17 +1746,6 @@ is_tuple1(_) -> false. t_bitstrlist() -> t_iolist(1, t_bitstr()). -%% XXX. To be removed. --spec t_constant() -> erl_type(). - -t_constant() -> - t_sup([t_number(), t_identifier(), t_atom(), t_fun(), t_binary()]). - --spec t_is_constant(erl_type()) -> boolean(). - -t_is_constant(X) -> - t_is_subtype(X, t_constant()). - -spec t_arity() -> erl_type(). t_arity() -> @@ -2636,15 +2623,19 @@ inf_collect(_T1, [], _Opaques, OpL) -> combine(S, T1, T2) -> #opaque{mod = Mod1, name = Name1, args = Args1} = T1, #opaque{mod = Mod2, name = Name2, args = Args2} = T2, + Comb1 = comb(Mod1, Name1, Args1, S, T1), case is_same_type_name({Mod1, Name1, Args1}, {Mod2, Name2, Args2}) of - true -> [comb(Mod1, Name1, Args1, S, T1)]; - false -> [comb(Mod1, Name1, Args1, S, T1), comb(Mod2, Name2, Args2, S, T2)] + true -> Comb1; + false -> Comb1 ++ comb(Mod2, Name2, Args2, S, T2) end. comb(Mod, Name, Args, S, T) -> case is_same_name(Mod, Name, Args, S) of - true -> S; - false -> T#opaque{struct = S} + true -> + ?opaque(Set) = S, + Set; + false -> + [T#opaque{struct = S}] end. is_same_name(Mod1, Name1, Args1, diff --git a/lib/hipe/doc/src/notes.xml b/lib/hipe/doc/src/notes.xml index 2d6fd245f7..8d3358533b 100644 --- a/lib/hipe/doc/src/notes.xml +++ b/lib/hipe/doc/src/notes.xml @@ -30,6 +30,55 @@ </header> <p>This document describes the changes made to HiPE.</p> +<section><title>Hipe 3.11.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix HiPE for ARM when Erlang VM is compiled for Thumb + execution mode. This was a problem on e.g. Ubuntu which + configures its system GCC to generate Thumb by default.</p> + <p> + Own Id: OTP-12405</p> + </item> + <item> + <p> + Reduced lock contention of dynamic function lookups (like + apply) from hipe compiled code.</p> + <p> + Own Id: OTP-12557</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix two bugs in HiPE compiler regarding floating-points, + both leading to crash during compilation. The + target-specific code generators failed to handle integer + to floating-point conversion instructions with constant + operands. The middle-end could use an incorrect + representation for copies between floating-point + registers.</p> + <p> + Own Id: OTP-12413</p> + </item> + <item> + <p> + Improved error handling when memory allocation for HiPE + code fails.</p> + <p> + Own Id: OTP-12448</p> + </item> + </list> + </section> + +</section> + <section><title>Hipe 3.11.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 4691662f9f..3e099fcc25 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -1584,11 +1584,7 @@ gen_put_map_instrs(exists, Op, TempMapVar, Dst, FailLbl, Pairs, Env) -> end, {[IsMapCode, TrueLabel, PutInstructions, ReturnLbl], Env1}; gen_put_map_instrs(new, Op, TempMapVar, Dst, new, Pairs, Env) -> - TrueLabel = mk_label(new), FailLbl = mk_label(new), - IsMapCode = hipe_icode:mk_type([TempMapVar], map, - hipe_icode:label_name(TrueLabel), - hipe_icode:label_name(FailLbl)), DstMapVar = mk_var(Dst), {ReturnLbl, PutInstructions, Env1} = case Op of @@ -1596,10 +1592,10 @@ gen_put_map_instrs(new, Op, TempMapVar, Dst, new, Pairs, Env) -> trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []); exact -> trans_put_map_exact(TempMapVar, DstMapVar, - hipe_icode:label_name(FailLbl), Pairs, Env, []) + none, Pairs, Env, []) end, Fail = hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error), - {[IsMapCode, TrueLabel, PutInstructions, FailLbl, Fail, ReturnLbl], Env1}. + {[PutInstructions, FailLbl, Fail, ReturnLbl], Env1}. %%----------------------------------------------------------------------- %% This function generates the instructions needed to insert several @@ -1629,6 +1625,13 @@ trans_put_map_exact(MapVar, DestMapVar, _FLbl, [], Env, Acc) -> ReturnLbl = mk_label(new), GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)), {ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env}; +trans_put_map_exact(MapVar, DestMapVar, none, [Key, Value | Rest], Env, Acc) -> + {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env), + {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1), + BifCallPut = hipe_icode:mk_call([MapVar], maps, update, + [KeyVar, ValVar, MapVar], remote), + Acc1 = [BifCallPut, MoveVal, MoveKey | Acc], + trans_put_map_exact(MapVar, DestMapVar, none, Rest, Env2, Acc1); trans_put_map_exact(MapVar, DestMapVar, FLbl, [Key, Value | Rest], Env, Acc) -> SuccLbl = mk_label(new), {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env), diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src index e81212d4dc..22ea71b4e6 100644 --- a/lib/hipe/main/hipe.app.src +++ b/lib/hipe/main/hipe.app.src @@ -224,4 +224,4 @@ {applications, [kernel,stdlib]}, {env, []}, {runtime_dependencies, ["syntax_tools-1.6.14","stdlib-2.0","kernel-3.0", - "erts-6.0","compiler-5.0"]}]}. + "erts-7.0","compiler-5.0"]}]}. diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index af8903904b..a36a024980 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -697,13 +697,22 @@ get_binary_bytes(Binary, BinSize, Base, Offset, Orig, %%%%%%%%%%%%%%%%%%%%%%%%% UTILS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% get_base(Orig,Base) -> - [HeapLbl,REFCLbl,EndLbl] = create_lbls(3), + [HeapLbl,REFCLbl,WritableLbl,NotWritableLbl,EndLbl] = create_lbls(5), + Flags = hipe_rtl:mk_new_reg_gcsafe(), + [hipe_tagscheme:test_heap_binary(Orig, hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, hipe_rtl:mk_alu(Base, Orig, 'add', hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)), hipe_rtl:mk_goto(hipe_rtl:label_name(EndLbl)), REFCLbl, + get_field_from_term({proc_bin, flags}, Orig, Flags), + hipe_rtl:mk_branch(Flags, 'ne', hipe_rtl:mk_imm(0), + hipe_rtl:label_name(WritableLbl), + hipe_rtl:label_name(NotWritableLbl)), + WritableLbl, + hipe_rtl:mk_call([], emasculate_binary, [Orig], [], [], 'not_remote'), + NotWritableLbl, hipe_rtl:mk_load(Base, Orig, hipe_rtl:mk_imm(?PROC_BIN_BYTES-2)), EndLbl]. diff --git a/lib/hipe/test/bs_SUITE_data/bs_match.erl b/lib/hipe/test/bs_SUITE_data/bs_match.erl index 8194d878b8..7bc93a316b 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_match.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_match.erl @@ -12,7 +12,8 @@ test() -> Funs = [fun test_aligned/0, fun test_unaligned/0, - fun test_zero_tail/0, fun test_integer_matching/0], + fun test_zero_tail/0, fun test_integer_matching/0, + fun test_writable_bin/0], lists:foreach(fun (F) -> ok = F() end, Funs). %%------------------------------------------------------------------- @@ -173,3 +174,14 @@ test_dynamic_integer_matching(N) -> <<12:N/integer, 0:S>> = <<12:N/integer, 0:S>>, <<12:N/integer-little, 0:S>> = <<12:N/integer-little, 0:S>>, ok. + +test_writable_bin() -> + test_writable_bin(<<>>, 0), + ok. + +test_writable_bin(Bin, 128) -> + Bin; +test_writable_bin(Bin0, N) when N < 128 -> + Bin1 = <<Bin0/binary, N>>, + <<_/utf8, _/binary>> = Bin1, + test_writable_bin(Bin1, N+1). diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_size.erl b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl index 25c8e5d4c7..3cd2d90dfb 100644 --- a/lib/hipe/test/maps_SUITE_data/maps_map_size.erl +++ b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl @@ -17,9 +17,9 @@ test() -> false = map_is_size(M#{ "c" => 2}, 2), %% Error cases. - {'EXIT',{badarg,_}} = (catch map_size([])), - {'EXIT',{badarg,_}} = (catch map_size(<<1,2,3>>)), - {'EXIT',{badarg,_}} = (catch map_size(1)), + {'EXIT',{{badmap,[]},_}} = (catch map_size([])), + {'EXIT',{{badmap,<<1,2,3>>},_}} = (catch map_size(<<1,2,3>>)), + {'EXIT',{{badmap,1},_}} = (catch map_size(1)), ok. map_is_size(M,N) when map_size(M) =:= N -> true; diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl index 31abf15d49..ccacbfe5c8 100644 --- a/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl +++ b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl @@ -10,23 +10,25 @@ test() -> false = #{ c => 1, b => 1, a => 1} < id(#{ c => 1, a => 1}), %% key order - true = id(#{ a => 1 }) < id(#{ b => 1}), - false = id(#{ b => 1 }) < id(#{ a => 1}), - true = id(#{ a => 1, b => 1, c => 1 }) < id(#{ b => 1, c => 1, d => 1}), - true = id(#{ b => 1, c => 1, d => 1 }) > id(#{ a => 1, b => 1, c => 1}), - true = id(#{ c => 1, b => 1, a => 1 }) < id(#{ b => 1, c => 1, d => 1}), - true = id(#{ "a" => 1 }) < id(#{ <<"a">> => 1}), - false = id(#{ <<"a">> => 1 }) < id(#{ "a" => 1}), - false = id(#{ 1 => 1 }) < id(#{ 1.0 => 1}), - false = id(#{ 1.0 => 1 }) < id(#{ 1 => 1}), + true = #{ a => 1 } < id(#{ b => 1}), + false = #{ b => 1 } < id(#{ a => 1}), + true = #{ a => 1, b => 1, c => 1 } < id(#{ b => 1, c => 1, d => 1}), + true = #{ b => 1, c => 1, d => 1 } > id(#{ a => 1, b => 1, c => 1}), + true = #{ c => 1, b => 1, a => 1 } < id(#{ b => 1, c => 1, d => 1}), + true = #{ "a" => 1 } < id(#{ <<"a">> => 1}), + false = #{ <<"a">> => 1 } < id(#{ "a" => 1}), + true = #{ 1 => 1 } < id(#{ 1.0 => 1}), + false = #{ 1.0 => 1 } < id(#{ 1 => 1}), %% value order - true = id(#{ a => 1 }) < id(#{ a => 2}), - false = id(#{ a => 2 }) < id(#{ a => 1}), - false = id(#{ a => 2, b => 1 }) < id(#{ a => 1, b => 3}), - true = id(#{ a => 1, b => 1 }) < id(#{ a => 1, b => 3}), + true = #{ a => 1 } < id(#{ a => 2}), + false = #{ a => 2 } < id(#{ a => 1}), + false = #{ a => 2, b => 1 } < id(#{ a => 1, b => 3}), + true = #{ a => 1, b => 1 } < id(#{ a => 1, b => 3}), + false = #{ a => 1 } < id(#{ a => 1.0}), + false = #{ a => 1.0 } < id(#{ a => 1}), - true = id(#{ "a" => "hi", b => 134 }) == id(#{ b => 134,"a" => "hi"}), + true = #{ "a" => "hi", b => 134 } == id(#{ b => 134,"a" => "hi"}), %% lists:sort @@ -34,7 +36,6 @@ test() -> [#{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. %% Use this function to avoid compile-time evaluation of an expression. diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl index 72ac9ce078..2fe4f204d1 100644 --- a/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl +++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl @@ -8,7 +8,7 @@ test() -> true = assoc_guard(#{}), false = assoc_guard(not_a_map), #{a := true} = assoc_update(#{}), - {'EXIT', {badarg, [{?MODULE, assoc_update, 1, _}|_]}} + {'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, _, _}|_]}} diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl index 1cfcd80180..3c85289a36 100644 --- a/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl +++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl @@ -9,9 +9,9 @@ test() -> false = exact_guard(not_a_map), true = exact_guard(#{a => false}), #{a := true} = exact_update(#{a => false}), - {'EXIT', {badarg, [{?MODULE, exact_update, 1, _}|_]}} + {'EXIT', {{badmap, not_a_map}, [{?MODULE, exact_update, 1, _}|_]}} = (catch exact_update(not_a_map)), - {'EXIT', {badarg, [{?MODULE, exact_update, 1, _}|_]}} + {'EXIT', {{badkey, a}, [{?MODULE, exact_update, 1, _}|_]}} = (catch exact_update(#{})), ok = exact_guard_clause(#{a => yes}), {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}} diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl index cc7c1353de..99228a1927 100644 --- a/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl +++ b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl @@ -14,7 +14,7 @@ test() -> %% Errors cases. BadMap = id(badmap), - {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), + {'EXIT',{{badmap,badmap},_}} = (catch BadMap#{nonexisting=>val}), ok. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl index 6e5acb3283..1c38820a7c 100644 --- a/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl +++ b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl @@ -21,11 +21,11 @@ test() -> 1.0 => new_val4 }, %% Errors cases. - {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })), - {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), - {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), - {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), - {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + {'EXIT',{{badmap,nil},_}} = (catch ((id(nil))#{ a := b })), + {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{{badkey,_},_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{{badkey,_},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,_},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), ok. %% Use this function to avoid compile-time evaluation of an expression. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl index 181e3f18f7..213fc33d97 100644 --- a/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl +++ b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl @@ -23,9 +23,9 @@ test() -> #{ "a" := b } = F(), - %% Error cases, FIXME: should be 'badmap'? - {'EXIT',{badarg,_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), - {'EXIT',{badarg,_}} = (catch (id([]))#{ a := 42, b => 2 }), + %% Error cases. + {'EXIT',{{badmap,<<>>},_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), + {'EXIT',{{badmap,[]},_}} = (catch (id([]))#{ a := 42, b => 2 }), ok. %% Use this function to avoid compile-time evaluation of an expression. diff --git a/lib/hipe/tools/hipe_timer.erl b/lib/hipe/tools/hipe_timer.erl index 03cc358f17..5f44bc066d 100644 --- a/lib/hipe/tools/hipe_timer.erl +++ b/lib/hipe/tools/hipe_timer.erl @@ -46,27 +46,27 @@ tr(F) -> {R,{WT-EWT,(RT-ERT)/1000}}. empty_time() -> - {WT1,WT2,WT3} = erlang:now(), + WTA = erlang:monotonic_time(), {A,_} = erlang:statistics(runtime), - {WT12,WT22,WT32} = erlang:now(), + WTB = erlang:monotonic_time(), {B,_} = erlang:statistics(runtime), - {(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}. + {(WTB-WTA)/erlang:convert_time_unit(1, seconds, native),B-A}. time(F) -> - {WT1,WT2,WT3} = erlang:now(), + WTA = erlang:monotonic_time(), {A,_} = erlang:statistics(runtime), F(), - {WT12,WT22,WT32} = erlang:now(), + WTB = erlang:monotonic_time(), {B,_} = erlang:statistics(runtime), - {(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}. + {(WTB-WTA)/erlang:convert_time_unit(1, seconds, native),B-A}. timer(F) -> - {WT1,WT2,WT3} = erlang:now(), + WTA = erlang:monotonic_time(), {A,_} = erlang:statistics(runtime), R = F(), - {WT12,WT22,WT32} = erlang:now(), + WTB = erlang:monotonic_time(), {B,_} = erlang:statistics(runtime), - {R,{(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}}. + {R,{(WTB-WTA)/erlang:convert_time_unit(1, seconds, native),B-A}}. advanced(_Fun, I) when I < 2 -> false; advanced(Fun, Iterations) -> diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk index 4cf09830cb..60b4e0559b 100644 --- a/lib/hipe/vsn.mk +++ b/lib/hipe/vsn.mk @@ -1 +1 @@ -HIPE_VSN = 3.11.2 +HIPE_VSN = 3.11.3 diff --git a/lib/inets/doc/src/http_server.xml b/lib/inets/doc/src/http_server.xml index e3b763b4f3..65e89db391 100644 --- a/lib/inets/doc/src/http_server.xml +++ b/lib/inets/doc/src/http_server.xml @@ -46,8 +46,7 @@ Layer), ESI (Erlang Scripting Interface), CGI (Common Gateway Interface), User Authentication(using Mnesia, dets or plain text database), Common Logfile Format (with or without disk_log(3) - support), URL Aliasing, Action Mappings, Directory Listings and SSI - (Server-Side Includes).</p> + support), URL Aliasing, Action Mappings, and Directory Listings</p> <p>The configuration of the server is provided as an erlang property list, and for backwards compatibility also a configuration @@ -478,170 +477,9 @@ http://your.server.org/eval?httpd_example:print(atom_to_list(apply(erlang,halt,[ </p> <p><em>[date]</em> access to <em>path</em> failed for <em>remotehost</em>, reason: <em>reason</em></p> - - <marker id="ssi"></marker> </section> - + <section> - <title>Server Side Includes</title> - <p>Server Side Includes enables the server to run code embedded - in HTML pages to generate the response to the client.</p> - <note> - <p>Having the server parse HTML pages is a double edged sword! - It can be costly for a heavily loaded server to perform - parsing of HTML pages while sending them. Furthermore, it can - be considered a security risk to have average users executing - commands in the name of the Erlang node user. Carefully - consider these items before activating server-side includes.</p> - </note> - - <section> - <marker id="ssi_setup"></marker> - <title>SERVER-SIDE INCLUDES (SSI) SETUP</title> - <p>The server must be told which filename extensions to be used - for the parsed files. These files, while very similar to HTML, - are not HTML and are thus not treated the same. Internally, the - server uses the magic MIME type <c>text/x-server-parsed-html</c> - to identify parsed documents. It will then perform a format - conversion to change these files into HTML for the - client. Update the <c>mime.types</c> file, as described in the - Mime Type Settings, to tell the server which extension to use - for parsed files, for example: - </p> - <pre> - text/x-server-parsed-html shtml shtm - </pre> - <p>This makes files ending with <c>.shtml</c> and <c>.shtm</c> - into parsed files. Alternatively, if the performance hit is not a - problem, <em>all</em> HTML pages can be marked as parsed: - </p> - <pre> - text/x-server-parsed-html html htm - </pre> - </section> - - <section> - <marker id="ssi_format"></marker> - <title>Server-Side Includes (SSI) Format</title> - <p>All server-side include directives to the server are formatted - as SGML comments within the HTML page. This is in case the - document should ever find itself in the client's hands - unparsed. Each directive has the following format: - </p> - <pre> - <!--#command tag1="value1" tag2="value2" --> - </pre> - <p>Each command takes different arguments, most only accept one - tag at a time. Here is a breakdown of the commands and their - associated tags: - </p> - <p>The config directive controls various aspects of the - file parsing. There are two valid tags: - </p> - <taglist> - <tag><c>errmsg</c></tag> - <item> - <p>controls the message sent back to the client if an - error occurred while parsing the document. All errors are - logged in the server's error log.</p> - </item> - <tag><c>sizefmt</c></tag> - <item> - <p>determines the format used to display the size of - a file. Valid choices are <c>bytes</c> or - <c>abbrev</c>. <c>bytes</c> for a formatted byte count - or <c>abbrev</c> for an abbreviated version displaying - the number of kilobytes.</p> - </item> - </taglist> - <p>The include directory - will insert the text of a document into the parsed - document. This command accepts two tags:</p> - <taglist> - <tag><c>virtual</c></tag> - <item> - <p>gives a virtual path to a document on the - server. Only normal files and other parsed documents can - be accessed in this way.</p> - </item> - <tag><c>file</c></tag> - <item> - <p>gives a pathname relative to the current - directory. <c>../</c> cannot be used in this pathname, nor - can absolute paths. As above, you can send other parsed - documents, but you cannot send CGI scripts.</p> - </item> - </taglist> - <p>The echo directive prints the value of one of the include - variables (defined below). The only valid tag to this - command is <c>var</c>, whose value is the name of the - variable you wish to echo.</p> - <p>The fsize directive prints the size of the specified - file. Valid tags are the same as with the <c>include</c> - command. The resulting format of this command is subject - to the <c>sizefmt</c> parameter to the <c>config</c> - command.</p> - <p>The lastmod directive prints the last modification date of - the specified file. Valid tags are the same as with the - <c>include</c> command.</p> - <p>The exec directive executes a given shell command or CGI - script. Valid tags are:</p> - <taglist> - <tag><c>cmd</c></tag> - <item> - <p>executes the given string using <c>/bin/sh</c>. All - of the variables defined below are defined, and can be - used in the command.</p> - </item> - <tag><c>cgi</c></tag> - <item> - <p>executes the given virtual path to a CGI script and - includes its output. The server does not perform error - checking on the script output.</p> - </item> - </taglist> - </section> - - <section> - <marker id="ssi_environment_variables"></marker> - <title>Server-Side Includes (SSI) Environment Variables</title> - <p>A number of variables are made available to parsed - documents. In addition to the CGI variable set, the following - variables are made available: - </p> - <taglist> - <tag><c>DOCUMENT_NAME</c></tag> - <item> - <p>The current filename.</p> - </item> - <tag><c>DOCUMENT_URI</c></tag> - <item> - <p>The virtual path to this document (such as - <c>/docs/tutorials/foo.shtml</c>).</p> - </item> - <tag><c>QUERY_STRING_UNESCAPED</c></tag> - <item> - <p>The unescaped version of any search query the client - sent, with all shell-special characters escaped with - <c>\</c>.</p> - </item> - <tag><c>DATE_LOCAL</c></tag> - <item> - <p>The current date, local time zone.</p> - </item> - <tag><c>DATE_GMT</c></tag> - <item> - <p>Same as DATE_LOCAL but in Greenwich mean time.</p> - </item> - <tag><c>LAST_MODIFIED</c></tag> - <item> - <p>The last modification date of the current document.</p> - </item> - </taglist> - </section> - </section> - - <section> <title>The Erlang Web Server API</title> <p>The process of handling a HTTP request involves several steps such as:</p> @@ -907,28 +745,6 @@ start() -> </taglist> </section> - <section> - <title>mod_include - SSI</title> - <p>This module makes it possible to expand "macros" embedded in - HTML pages before they are delivered to the client, that is - Server-Side Includes (SSI). - </p> - <p>Uses the following Erlang Webserver API interaction data: - </p> - <list type="bulleted"> - <item>real_name - from mod_alias</item> - <item>remote_user - from mod_auth</item> - </list> - <p>Exports the following Erlang Webserver API interaction data: - </p> - <taglist> - <tag><c>{mime_type, MimeType}</c></tag> - <item>The file suffix of the incoming URL mapped into a - <c>MimeType</c> as defined in the Mime Type Settings - section.</item> - </taglist> - </section> - <section> <title>mod_log - Logging Using Text Files.</title> <p>Standard logging using the "Common Logfile Format" and text diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index 20c8a6b1b1..e40660ab39 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -315,7 +315,7 @@ text/plain asc txt </item> <marker id="prop_server_tokens"></marker> - <tag>{server_tokens, prod|major|minor|minimal|os|full|{private, string()}}</tag> + <tag>{server_tokens, none|prod|major|minor|minimal|os|full|{private, string()}}</tag> <item> <p>ServerTokens defines how the value of the server header should look. </p> @@ -323,6 +323,7 @@ text/plain asc txt here is what the server header string could look like for the different values of server-tokens: </p> <pre> +none "" % A Server: header will not be generated prod "inets" major "inets/5" minor "inets/5.8" diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 7f73aa5e7b..12bbc2b736 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,7 +32,68 @@ <file>notes.xml</file> </header> - <section><title>Inets 5.10.5</title> + <section><title>Inets 5.10.7</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + New value in <c>server_tokens</c> config for limiting + banner grabbing attempts. </p> + <p> + By setting <c>{server_tokens, none}</c> in + <c>ServiceConfig</c> for <c>inets:start(httpd, + ServiceConfig)</c>, the "Server:" header will not be set + in messages from the server.</p> + <p> + Own Id: OTP-12661 Aux Id: seq12840 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 5.10.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + inets: parse correctly 'Set-Cookie' header with empty + value</p> + <p> + httpc_cookie should parse cookies with empty values and + no attributes set in the 'Set-Cookie' headers.</p> + <p> + Own Id: OTP-12455</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add parsing of URI fragments to http_uri:parse</p> + <p> + This fixes a bug in httpc where redirection URIs could + lead to bad requests if they contained fragments.</p> + <p> + Own Id: OTP-12398</p> + </item> + <item> + <p> + httpc: http client now ignores invalid set-cookie headers</p> + <p> + Own Id: OTP-12430</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 5.10.5</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/examples/httpd_load_test/hdlt_random_html.erl b/lib/inets/examples/httpd_load_test/hdlt_random_html.erl index e3a572c61f..59073a3d23 100644 --- a/lib/inets/examples/httpd_load_test/hdlt_random_html.erl +++ b/lib/inets/examples/httpd_load_test/hdlt_random_html.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010. All Rights Reserved. +%% Copyright Ericsson AB 2010-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -48,7 +48,10 @@ stop() -> ". content(WorkSim, SzSim) -> - {A, B, C} = now(), + {A, B, C} = {erlang:phash2([node()]), + inets_time_compat:monotonic_time(), + inets_time_compat:unique_integer()}, + random:seed(A, B, C), lists:sort([random:uniform(X) || X <- lists:seq(1, WorkSim)]), lists:flatten(lists:duplicate(SzSim, "Dummy data ")). diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl index 8e51b1be5a..7eebe8d5bf 100644 --- a/lib/inets/src/ftp/ftp.erl +++ b/lib/inets/src/ftp/ftp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -2176,16 +2176,16 @@ handle_caller(#state{caller = {transfer_data, {Cmd, Bin, RemoteFile}}} = %% Connect to FTP server at Host (default is TCP port 21) %% in order to establish a control connection. setup_ctrl_connection(Host, Port, Timeout, State) -> - MsTime = millisec_time(), + MsTime = inets_time_compat:monotonic_time(), case connect(Host, Port, Timeout, State) of {ok, IpFam, CSock} -> NewState = State#state{csock = {tcp, CSock}, ipfamily = IpFam}, activate_ctrl_connection(NewState), - case Timeout - (millisec_time() - MsTime) of + case Timeout - inets_lib:millisec_passed(MsTime) of Timeout2 when (Timeout2 >= 0) -> {ok, NewState#state{caller = open}, Timeout2}; _ -> - %% Oups: Simulate timeout + %% Oups: Simulate timeout {ok, NewState#state{caller = open}, 0} end; Error -> @@ -2501,10 +2501,6 @@ progress_report(Report, #state{progress = ProgressPid}) -> ftp_progress:report(ProgressPid, Report). -millisec_time() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). - peername({tcp, Socket}) -> inet:peername(Socket); peername({ssl, Socket}) -> ssl:peername(Socket). diff --git a/lib/inets/src/http_client/httpc_cookie.erl b/lib/inets/src/http_client/httpc_cookie.erl index ed306a84f5..35778d3ed5 100644 --- a/lib/inets/src/http_client/httpc_cookie.erl +++ b/lib/inets/src/http_client/httpc_cookie.erl @@ -115,8 +115,8 @@ maybe_dets_close(Db) -> %%-------------------------------------------------------------------- -%% Func: insert(CookieDb) -> ok -%% Purpose: Close the cookie db +%% Func: insert(CookieDb, Cookie) -> ok +%% Purpose: insert cookies into the cookie db %%-------------------------------------------------------------------- %% If no persistent cookie database is defined we diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 7f7328f1d9..8f2f11ce8e 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2014. All Rights Reserved. +%% Copyright Ericsson AB 2002-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1122,7 +1122,7 @@ handle_http_body(Body, #state{headers = Headers, handle_response(State#state{headers = NewHeaders, body = NewBody}); _ -> - {NewBody2, NewRequest} = + {NewBody2, _NewRequest} = stream(NewBody, Request, Code), handle_response(State#state{headers = NewHeaders, body = NewBody2}) diff --git a/lib/inets/src/http_server/Makefile b/lib/inets/src/http_server/Makefile index 2660d04d16..51e3dd9212 100644 --- a/lib/inets/src/http_server/Makefile +++ b/lib/inets/src/http_server/Makefile @@ -75,7 +75,6 @@ MODULES = \ mod_get \ mod_head \ mod_htaccess \ - mod_include \ mod_log \ mod_range \ mod_responsecontrol \ diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index 78dda794db..dbdc1be272 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -219,14 +219,14 @@ load("ServerName " ++ ServerName, []) -> load("ServerTokens " ++ ServerTokens, []) -> %% These are the valid *plain* server tokens: - %% sprod, major, minor, minimum, os, full + %% none, prod, major, minor, minimum, os, full %% It can also be a "private" server token: private:<any string> case string:tokens(ServerTokens, [$:]) of ["private", Private] -> {ok,[], {server_tokens, clean(Private)}}; [TokStr] -> Tok = list_to_atom(clean(TokStr)), - case lists:member(Tok, [prod, major, minor, minimum, os, full]) of + case lists:member(Tok, [none, prod, major, minor, minimum, os, full]) of true -> {ok,[], {server_tokens, Tok}}; false -> @@ -850,6 +850,8 @@ server(full = _ServerTokens) -> OS = os_info(full), lists:flatten( io_lib:format("~s ~s OTP/~s", [?SERVER_SOFTWARE, OS, OTPRelease])); +server(none = _ServerTokens) -> + ""; server({private, Server} = _ServerTokens) when is_list(Server) -> %% The user provide its own Server; @@ -1299,7 +1301,7 @@ ssl_ca_certificate_file(ConfigDB) -> end. plain_server_tokens() -> - [prod, major, minor, minimum, os, full]. + [none, prod, major, minor, minimum, os, full]. error_report(Where,M,F,Error) -> error_logger:error_report([{?MODULE, Where}, diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl index 0895729d05..2fa91d47a0 100644 --- a/lib/inets/src/http_server/httpd_response.erl +++ b/lib/inets/src/http_server/httpd_response.erl @@ -287,8 +287,11 @@ create_header(ConfigDb, KeyValueTupleHeaders) -> ContentType = "text/html", Server = server(ConfigDb), NewHeaders = add_default_headers([{"date", Date}, - {"content-type", ContentType}, - {"server", Server}], + {"content-type", ContentType} + | if Server=="" -> []; + true -> [{"server", Server}] + end + ], KeyValueTupleHeaders), lists:map(fun fix_header/1, NewHeaders). diff --git a/lib/inets/src/http_server/mod_include.erl b/lib/inets/src/http_server/mod_include.erl deleted file mode 100644 index 35f45bdd33..0000000000 --- a/lib/inets/src/http_server/mod_include.erl +++ /dev/null @@ -1,598 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% -%% --module(mod_include). --export([do/1,parse/2,config/6,include/6,echo/6,fsize/6,flastmod/6,exec/6]). - --include("httpd.hrl"). --include("httpd_internal.hrl"). - --define(VMODULE,"INCLUDE"). - -%% do - -do(Info) -> - case Info#mod.method of - "GET" -> - case proplists:get_value(status, Info#mod.data) of - %% A status code has been generated! - {_StatusCode, _PhraseArgs, _Reason} -> - {proceed,Info#mod.data}; - %% No status code has been generated! - undefined -> - case proplists:get_value(response, Info#mod.data) of - %% No response has been generated! - undefined -> - do_include(Info); - %% A response has been generated or sent! - _Response -> - {proceed,Info#mod.data} - end - end; - %% Not a GET method! - _ -> - {proceed,Info#mod.data} - end. - -do_include(Info) -> - Path = mod_alias:path(Info#mod.data,Info#mod.config_db, - Info#mod.request_uri), - Suffix = httpd_util:suffix(Path), - case httpd_util:lookup_mime_default(Info#mod.config_db,Suffix) of - "text/x-server-parsed-html" -> - HeaderStart = [{content_type, "text/html"}], - case send_in(Info, Path, HeaderStart, file:read_file_info(Path)) of - {ok, ErrorLog, Size} -> - {proceed, [{response, {already_sent, 200, Size}}, - {mime_type, "text/html"} | - lists:append(ErrorLog, Info#mod.data)]}; - {error, Reason} -> - {proceed, - [{status,send_error(Reason,Info,Path)}|Info#mod.data]} - end; - _ -> %% Unknown mime type, ignore - {proceed,Info#mod.data} - end. - - -%% -%% config directive -%% - -config(_Info, Context, ErrorLog, TagList, ValueList, R) -> - case verify_tags("config",[errmsg,timefmt,sizefmt], - TagList,ValueList) of - ok -> - {ok,update_context(TagList,ValueList,Context),ErrorLog,"",R}; - {error,Reason} -> - {ok,Context,[{internal_info,Reason}|ErrorLog], - proplists:get_value(errmsg,Context,""),R} - end. - -update_context([],[],Context) -> - Context; -update_context([Tag|R1],[Value|R2],Context) -> - update_context(R1,R2,[{Tag,Value}|Context]). - -verify_tags(Command,ValidTags,TagList,ValueList) - when length(TagList) =:= length(ValueList) -> - verify_tags(Command, ValidTags, TagList); -verify_tags(Command, _ValidTags, _TagList, _ValueList) -> - {error, ?NICE(Command ++ " directive has spurious tags")}. - -verify_tags(_Command, _ValidTags, []) -> - ok; -verify_tags(Command, ValidTags, [Tag|Rest]) -> - case lists:member(Tag, ValidTags) of - true -> - verify_tags(Command, ValidTags, Rest); - false -> - {error, ?NICE(Command++" directive has a spurious tag ("++ - atom_to_list(Tag)++")")} - end. - -%% -%% include directive -%% - -include(Info,Context,ErrorLog,[virtual],[VirtualPath],R) -> - Aliases = httpd_util:multi_lookup(Info#mod.config_db,alias), - {_, Path, _AfterPath} = - mod_alias:real_name(Info#mod.config_db, VirtualPath, Aliases), - include(Info,Context,ErrorLog,R,Path); -include(Info, Context, ErrorLog, [file], [FileName], R) -> - Path = file(Info#mod.config_db, Info#mod.request_uri, FileName), - include(Info, Context, ErrorLog, R, Path); -include(_Info, Context, ErrorLog, _TagList, _ValueList, R) -> - {ok, Context, - [{internal_info,?NICE("include directive has a spurious tag")}| - ErrorLog], proplists:get_value(errmsg, Context, ""), R}. - -include(Info, Context, ErrorLog, R, Path) -> - case file:read_file(Path) of - {ok, Body} -> - {ok, NewContext, NewErrorLog, Result} = - parse(Info, binary_to_list(Body), Context, ErrorLog, []), - {ok, NewContext, NewErrorLog, Result, R}; - {error, _Reason} -> - {ok, Context, - [{internal_info, ?NICE("Can't open "++Path)}|ErrorLog], - proplists:get_value(errmsg, Context, ""), R} - end. - -file(ConfigDB, RequestURI, FileName) -> - Aliases = httpd_util:multi_lookup(ConfigDB, alias), - {_, Path, _AfterPath} - = mod_alias:real_name(ConfigDB, RequestURI, Aliases), - Pwd = filename:dirname(Path), - filename:join(Pwd, FileName). - -%% -%% echo directive -%% - -echo(Info,Context,ErrorLog,[var],["DOCUMENT_NAME"],R) -> - {ok,Context,ErrorLog,document_name(Info#mod.data,Info#mod.config_db, - Info#mod.request_uri),R}; -echo(Info,Context,ErrorLog,[var],["DOCUMENT_URI"],R) -> - {ok,Context,ErrorLog,document_uri(Info#mod.config_db, - Info#mod.request_uri),R}; -echo(Info,Context,ErrorLog,[var],["QUERY_STRING_UNESCAPED"],R) -> - {ok,Context,ErrorLog,query_string_unescaped(Info#mod.request_uri),R}; -echo(_Info,Context,ErrorLog,[var],["DATE_LOCAL"],R) -> - {ok,Context,ErrorLog,date_local(),R}; -echo(_Info,Context,ErrorLog,[var],["DATE_GMT"],R) -> - {ok,Context,ErrorLog,date_gmt(),R}; -echo(Info,Context,ErrorLog,[var],["LAST_MODIFIED"],R) -> - {ok,Context,ErrorLog,last_modified(Info#mod.data,Info#mod.config_db, - Info#mod.request_uri),R}; -echo(_Info, Context, ErrorLog, _TagList, _ValueList, R) -> - {ok,Context, - [{internal_info,?NICE("echo directive has a spurious tag")}| - ErrorLog],"(none)",R}. - -document_name(Data,ConfigDB,RequestURI) -> - Path = mod_alias:path(Data,ConfigDB,RequestURI), - case inets_regexp:match(Path,"[^/]*\$") of - {match,Start,Length} -> - string:substr(Path,Start,Length); - nomatch -> - "(none)" - end. - -document_uri(ConfigDB, RequestURI) -> - Aliases = httpd_util:multi_lookup(ConfigDB, alias), - - {_, Path, AfterPath} = mod_alias:real_name(ConfigDB, RequestURI, Aliases), - - VirtualPath = string:substr(RequestURI, 1, - length(RequestURI)-length(AfterPath)), - {match, Start, Length} = inets_regexp:match(Path,"[^/]*\$"), - FileName = string:substr(Path,Start,Length), - case inets_regexp:match(VirtualPath, FileName++"\$") of - {match, _, _} -> - http_uri:decode(VirtualPath)++AfterPath; - nomatch -> - string:strip(http_uri:decode(VirtualPath),right,$/)++ - "/"++FileName++AfterPath - end. - -query_string_unescaped(RequestURI) -> - case inets_regexp:match(RequestURI,"[\?].*\$") of - {match,Start,Length} -> - %% Escape all shell-special variables with \ - escape(string:substr(RequestURI,Start+1,Length-1)); - nomatch -> - "(none)" - end. - -escape([]) -> []; -escape([$;|R]) -> [$\\,$;|escape(R)]; -escape([$&|R]) -> [$\\,$&|escape(R)]; -escape([$(|R]) -> [$\\,$(|escape(R)]; -escape([$)|R]) -> [$\\,$)|escape(R)]; -escape([$||R]) -> [$\\,$||escape(R)]; -escape([$^|R]) -> [$\\,$^|escape(R)]; -escape([$<|R]) -> [$\\,$<|escape(R)]; -escape([$>|R]) -> [$\\,$>|escape(R)]; -escape([$\n|R]) -> [$\\,$\n|escape(R)]; -escape([$ |R]) -> [$\\,$ |escape(R)]; -escape([$\t|R]) -> [$\\,$\t|escape(R)]; -escape([C|R]) -> [C|escape(R)]. - -date_local() -> - {{Year,Month,Day},{Hour,Minute,Second}}=calendar:local_time(), - %% Time format hard-wired to: "%a %b %e %T %Y" according to strftime(3) - io_lib:format("~s ~s ~2w ~2.2.0w:~2.2.0w:~2.2.0w ~w", - [httpd_util:day(calendar:day_of_the_week(Year,Month,Day)), - httpd_util:month(Month),Day,Hour,Minute,Second,Year]). - -date_gmt() -> - {{Year,Month,Day},{Hour,Minute,Second}}=calendar:universal_time(), - %% Time format hard-wired to: "%a %b %e %T %Z %Y" according to strftime(3) - io_lib:format("~s ~s ~2w ~2.2.0w:~2.2.0w:~2.2.0w GMT ~w", - [httpd_util:day(calendar:day_of_the_week(Year,Month,Day)), - httpd_util:month(Month),Day,Hour,Minute,Second,Year]). - -last_modified(Data,ConfigDB,RequestURI) -> - {ok,FileInfo}=file:read_file_info(mod_alias:path(Data,ConfigDB,RequestURI)), - {{Year,Month,Day},{Hour,Minute,Second}}=FileInfo#file_info.mtime, - io_lib:format("~s ~s ~2w ~2.2.0w:~2.2.0w:~2.2.0w ~w", - [httpd_util:day(calendar:day_of_the_week(Year,Month,Day)), - httpd_util:month(Month),Day,Hour,Minute,Second,Year]). - -%% -%% fsize directive -%% - -fsize(Info,Context,ErrorLog,[virtual],[VirtualPath],R) -> - Aliases = httpd_util:multi_lookup(Info#mod.config_db,alias), - {_,Path, _AfterPath}= - mod_alias:real_name(Info#mod.config_db,VirtualPath,Aliases), - fsize(Info, Context, ErrorLog, R, Path); -fsize(Info,Context,ErrorLog,[file],[FileName],R) -> - Path = file(Info#mod.config_db,Info#mod.request_uri,FileName), - fsize(Info,Context,ErrorLog,R,Path); -fsize(_Info, Context, ErrorLog, _TagList, _ValueList, R) -> - {ok,Context,[{internal_info,?NICE("fsize directive has a spurious tag")}| - ErrorLog],proplists:get_value(errmsg,Context,""),R}. - -fsize(_Info, Context, ErrorLog, R, Path) -> - case file:read_file_info(Path) of - {ok,FileInfo} -> - case proplists:get_value(sizefmt,Context) of - "bytes" -> - {ok,Context,ErrorLog, - integer_to_list(FileInfo#file_info.size),R}; - "abbrev" -> - Size = integer_to_list(trunc(FileInfo#file_info.size/1024+1))++"k", - {ok,Context,ErrorLog,Size,R}; - Value-> - {ok,Context, - [{internal_info, - ?NICE("fsize directive has a spurious tag value ("++ - Value++")")}| - ErrorLog], - proplists:get_value(errmsg, Context, ""), R} - end; - {error, _Reason} -> - {ok,Context,[{internal_info,?NICE("Can't open "++Path)}|ErrorLog], - proplists:get_value(errmsg,Context,""),R} - end. - -%% -%% flastmod directive -%% - -flastmod(#mod{config_db = Db} = Info, - Context, ErrorLog, [virtual], [VirtualPath],R) -> - Aliases = httpd_util:multi_lookup(Db,alias), - {_,Path, _AfterPath} = mod_alias:real_name(Db, VirtualPath, Aliases), - flastmod(Info,Context,ErrorLog,R,Path); -flastmod(#mod{config_db = Db, request_uri = RequestUri} = Info, - Context, ErrorLog, [file], [FileName], R) -> - Path = file(Db, RequestUri, FileName), - flastmod(Info, Context, ErrorLog, R, Path); -flastmod(_Info, Context, ErrorLog, _TagList, _ValueList, R) -> - {ok,Context, - [{internal_info,?NICE("flastmod directive has a spurious tag")}| - ErrorLog],proplists:get_value(errmsg,Context,""),R}. - -flastmod(_Info, Context, ErrorLog, R, File) -> - case file:read_file_info(File) of - {ok, FileInfo} -> - {{Yr,Mon,Day},{Hour,Minute,Second}}=FileInfo#file_info.mtime, - Result = - io_lib:format("~s ~s ~2w ~w:~w:~w ~w", - [httpd_util:day( - calendar:day_of_the_week(Yr,Mon, Day)), - httpd_util:month(Mon),Day,Hour,Minute,Second, Yr]), - {ok, Context, ErrorLog, Result, R}; - {error, _Reason} -> - {ok,Context,[{internal_info,?NICE("Can't open "++File)}|ErrorLog], - proplists:get_value(errmsg,Context,""),R} - end. - -%% -%% exec directive -%% - -exec(Info,Context,ErrorLog,[cmd],[Command],R) -> - cmd(Info,Context,ErrorLog,R,Command); -exec(Info,Context,ErrorLog,[cgi],[RequestURI],R) -> - cgi(Info,Context,ErrorLog,R,RequestURI); -exec(_Info, Context, ErrorLog, _TagList, _ValueList, R) -> - {ok, Context, - [{internal_info,?NICE("exec directive has a spurious tag")}| - ErrorLog], proplists:get_value(errmsg,Context,""),R}. - -%% cmd - -cmd(Info, Context, ErrorLog, R, Command) -> - process_flag(trap_exit,true), - Env = env(Info), - Dir = filename:dirname(Command), - Port = (catch open_port({spawn,Command},[stream,{cd,Dir},{env,Env}])), - case Port of - P when is_port(P) -> - {NewErrorLog, Result} = proxy(Port, ErrorLog), - {ok, Context, NewErrorLog, Result, R}; - {'EXIT', Reason} -> - exit({open_port_failed,Reason, - [{uri,Info#mod.request_uri},{script,Command}, - {env,Env},{dir,Dir}]}); - O -> - exit({open_port_failed,O, - [{uri,Info#mod.request_uri},{script,Command}, - {env,Env},{dir,Dir}]}) - end. - -env(Info) -> - [{"DOCUMENT_NAME",document_name(Info#mod.data,Info#mod.config_db, - Info#mod.request_uri)}, - {"DOCUMENT_URI", document_uri(Info#mod.config_db, Info#mod.request_uri)}, - {"QUERY_STRING_UNESCAPED", query_string_unescaped(Info#mod.request_uri)}, - {"DATE_LOCAL", date_local()}, - {"DATE_GMT", date_gmt()}, - {"LAST_MODIFIED", last_modified(Info#mod.data, Info#mod.config_db, - Info#mod.request_uri)} - ]. - -%% cgi - -cgi(Info, Context, ErrorLog, R, RequestURI) -> - ScriptAliases = httpd_util:multi_lookup(Info#mod.config_db, script_alias), - case mod_alias:real_script_name(Info#mod.config_db, RequestURI, - ScriptAliases) of - {Script, AfterScript} -> - exec_script(Info,Script,AfterScript,ErrorLog,Context,R); - not_a_script -> - {ok, Context, - [{internal_info, ?NICE(RequestURI++" is not a script")}| - ErrorLog], proplists:get_value(errmsg, Context, ""),R} - end. - -remove_header([]) -> - []; -remove_header([$\n,$\n|Rest]) -> - Rest; -remove_header([_C|Rest]) -> - remove_header(Rest). - - -exec_script(#mod{config_db = Db, request_uri = RequestUri} = Info, - Script, _AfterScript, ErrorLog, Context, R) -> - process_flag(trap_exit,true), - Aliases = httpd_util:multi_lookup(Db, alias), - {_, Path, AfterPath} = mod_alias:real_name(Db, RequestUri, Aliases), - Env = env(Info) ++ mod_cgi:env(Info, Path, AfterPath), - Dir = filename:dirname(Path), - Port = (catch open_port({spawn,Script},[stream,{env, Env},{cd, Dir}])), - case Port of - P when is_port(P) -> - %% Send entity body to port. - Res = case Info#mod.entity_body of - [] -> - true; - EntityBody -> - (catch port_command(Port, EntityBody)) - end, - case Res of - {'EXIT', Reason} -> - exit({open_cmd_failed,Reason, - [{mod,?MODULE},{port,Port}, - {uri,RequestUri}, - {script,Script},{env,Env},{dir,Dir}, - {ebody_size,sz(Info#mod.entity_body)}]}); - true -> - {NewErrorLog, Result} = proxy(Port, ErrorLog), - {ok, Context, NewErrorLog, remove_header(Result), R} - end; - {'EXIT', Reason} -> - exit({open_port_failed,Reason, - [{mod,?MODULE},{uri,RequestUri},{script,Script}, - {env,Env},{dir,Dir}]}); - O -> - exit({open_port_failed,O, - [{mod,?MODULE},{uri,RequestUri},{script,Script}, - {env,Env},{dir,Dir}]}) - end. - - -%% -%% Port communication -%% - -proxy(Port, ErrorLog) -> - process_flag(trap_exit, true), - proxy(Port, ErrorLog, []). - -proxy(Port, ErrorLog, Result) -> - receive - {Port, {data, Response}} -> - proxy(Port, ErrorLog, lists:append(Result,Response)); - {'EXIT', Port, normal} when is_port(Port) -> - process_flag(trap_exit, false), - {ErrorLog, Result}; - {'EXIT', Port, _Reason} when is_port(Port) -> - process_flag(trap_exit, false), - {[{internal_info, - ?NICE("Scrambled output from CGI-script")}|ErrorLog], - Result}; - {'EXIT', Pid, Reason} when is_pid(Pid) -> - process_flag(trap_exit, false), - {'EXIT', Pid, Reason}; - %% This should not happen! - _WhatEver -> - process_flag(trap_exit, false), - {ErrorLog, Result} - end. - - -%% ------ -%% Temporary until I figure out a way to fix send_in_chunks -%% (comments and directives that start in one chunk but end -%% in another is not handled). -%% - -send_in(Info, Path, Head, {ok,FileInfo}) -> - case file:read_file(Path) of - {ok, Bin} -> - send_in1(Info, binary_to_list(Bin), Head, FileInfo); - {error, Reason} -> - {error, {read,Reason}} - end; -send_in(_Info , _Path, _Head,{error,Reason}) -> - {error, {open,Reason}}. - -send_in1(Info, Data, Head, FileInfo) -> - {ok, _Context, Err, ParsedBody} = parse(Info,Data,?DEFAULT_CONTEXT,[],[]), - Size = length(ParsedBody), - LastModified = case catch httpd_util:rfc1123_date(FileInfo#file_info.mtime) of - Date when is_list(Date) -> [{last_modified,Date}]; - _ -> [] - end, - Head1 = case Info#mod.http_version of - "HTTP/1.1"-> - Head ++ [{content_length, integer_to_list(Size)}, - {etag, httpd_util:create_etag(FileInfo,Size)}| - LastModified]; - _-> - %% i.e http/1.0 and http/0.9 - Head ++ [{content_length, integer_to_list(Size)}| - LastModified] - end, - httpd_response:send_header(Info, 200, Head1), - httpd_socket:deliver(Info#mod.socket_type,Info#mod.socket, ParsedBody), - {ok, Err, Size}. - - -parse(Info,Body) -> - parse(Info, Body, ?DEFAULT_CONTEXT, [], []). - -parse(_Info, [], Context, ErrorLog, Result) -> - {ok, Context, lists:reverse(ErrorLog), lists:reverse(Result)}; -parse(Info,[$<,$!,$-,$-,$#|R1],Context,ErrorLog,Result) -> - case catch parse0(R1,Context) of - {parse_error,Reason} -> - parse(Info,R1,Context,[{internal_info,?NICE(Reason)}|ErrorLog], - [$#,$-,$-,$!,$<|Result]); - {ok,Context,Command,TagList,ValueList,R2} -> - {ok,NewContext,NewErrorLog,MoreResult,R3}= - handle(Info,Context,ErrorLog,Command,TagList,ValueList,R2), - parse(Info,R3,NewContext,NewErrorLog, - lists:reverse(MoreResult)++Result) - end; -parse(Info,[$<,$!,$-,$-|R1],Context,ErrorLog,Result) -> - case catch parse5(R1,[],0) of - {parse_error,Reason} -> - parse(Info,R1,Context, - [{internal_info,?NICE(Reason)}|ErrorLog],Result); - {Comment,R2} -> - parse(Info,R2,Context,ErrorLog,Comment++Result) - end; -parse(Info,[C|R],Context,ErrorLog,Result) -> - parse(Info,R,Context,ErrorLog,[C|Result]). - -handle(Info,Context,ErrorLog,Command,TagList,ValueList,R) -> - case catch apply(?MODULE,Command,[Info,Context,ErrorLog,TagList,ValueList, - R]) of - {'EXIT',{undef,_}} -> - throw({parse_error,"Unknown command "++atom_to_list(Command)++ - " in parsed doc"}); - Result -> - Result - end. - -parse0([], _Context) -> - throw({parse_error,"Premature EOF in parsed file"}); -parse0([$-,$-,$>|_R], _Context) -> - throw({parse_error,"Premature EOF in parsed file"}); -parse0([$ |R], Context) -> - parse0(R,Context); -parse0(String, Context) -> - parse1(String, Context,""). - -parse1([], _Context, _Command) -> - throw({parse_error,"Premature EOF in parsed file"}); -parse1([$-,$-,$>|_R], _Context, _Command) -> - throw({parse_error,"Premature EOF in parsed file"}); -parse1([$ |R], Context, Command) -> - parse2(R,Context,list_to_atom(lists:reverse(Command)),[],[],""); -parse1([C|R], Context, Command) -> - parse1(R,Context,[C|Command]). - -parse2([], _Context, _Command, _TagList, _ValueList, _Tag) -> - throw({parse_error,"Premature EOF in parsed file"}); -parse2([$-,$-,$>|R], Context, Command, TagList, ValueList, _Tag) -> - {ok,Context,Command,TagList,ValueList,R}; -parse2([$ |R],Context,Command,TagList,ValueList,Tag) -> - parse2(R,Context,Command,TagList,ValueList,Tag); -parse2([$=|R],Context,Command,TagList,ValueList,Tag) -> - parse3(R,Context,Command,[list_to_atom(lists:reverse(Tag))|TagList], - ValueList); -parse2([C|R],Context,Command,TagList,ValueList,Tag) -> - parse2(R,Context,Command,TagList,ValueList,[C|Tag]). - -parse3([], _Context, _Command, _TagList, _ValueList) -> - throw({parse_error,"Premature EOF in parsed file"}); -parse3([$-,$-,$>|_R], _Context, _Command, _TagList, _ValueList) -> - throw({parse_error,"Premature EOF in parsed file"}); -parse3([$ |R], Context, Command, TagList, ValueList) -> - parse3(R, Context, Command, TagList, ValueList); -parse3([$"|R], Context, Command, TagList, ValueList) -> - parse4(R,Context,Command,TagList,ValueList,""); -parse3(_String, _Context, _Command, _TagList, _ValueList) -> - throw({parse_error,"Premature EOF in parsed file"}). - -parse4([], _Context, _Command, _TagList, _ValueList, _Value) -> - throw({parse_error,"Premature EOF in parsed file"}); -parse4([$-,$-,$>|_R], _Context, _Command, _TagList, _ValueList, _Value) -> - throw({parse_error,"Premature EOF in parsed file"}); -parse4([$"|R],Context,Command,TagList,ValueList,Value) -> - parse2(R,Context,Command,TagList,[lists:reverse(Value)|ValueList],""); -parse4([C|R],Context,Command,TagList,ValueList,Value) -> - parse4(R,Context,Command,TagList,ValueList,[C|Value]). - -parse5([], _Comment, _Depth) -> - throw({parse_error,"Premature EOF in parsed file"}); -parse5([$<,$!,$-,$-|R],Comment,Depth) -> - parse5(R,[$-,$-,$!,$<|Comment],Depth+1); -parse5([$-,$-,$>|R],Comment,0) -> - {">--"++Comment++"--!<",R}; -parse5([$-,$-,$>|R],Comment,Depth) -> - parse5(R,[$>,$-,$-|Comment],Depth-1); -parse5([C|R],Comment,Depth) -> - parse5(R,[C|Comment],Depth). - - -sz(B) when is_binary(B) -> {binary,size(B)}; -sz(L) when is_list(L) -> {list,length(L)}; -sz(_) -> undefined. - -%% send_error - Handle failure to send the file -%% -send_error({open,Reason},Info,Path) -> - httpd_file:handle_error(Reason, "open", Info, Path); -send_error({read,Reason},Info,Path) -> - httpd_file:handle_error(Reason, "read", Info, Path). - - - - diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile index 22426eee79..926585f198 100644 --- a/lib/inets/src/inets_app/Makefile +++ b/lib/inets/src/inets_app/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2012. All Rights Reserved. +# Copyright Ericsson AB 2005-2015. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -47,7 +47,9 @@ MODULES = \ inets_app \ inets_sup \ inets_regexp \ - inets_trace + inets_trace \ + inets_lib \ + inets_time_compat 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 9eae962d03..b7c3e341e8 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -1,7 +1,7 @@ %% This is an -*- erlang -*- file. %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -26,7 +26,9 @@ inets_app, inets_service, inets_regexp, - inets_trace, + inets_trace, + inets_lib, + inets_time_compat, %% FTP ftp, @@ -90,7 +92,6 @@ mod_get, mod_head, mod_htaccess, - mod_include, mod_log, mod_range, mod_responsecontrol, diff --git a/lib/inets/src/inets_app/inets_lib.erl b/lib/inets/src/inets_app/inets_lib.erl new file mode 100644 index 0000000000..fa6adaebd0 --- /dev/null +++ b/lib/inets/src/inets_app/inets_lib.erl @@ -0,0 +1,49 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(inets_lib). + +-export([millisec_passed/1, formated_timestamp/0, format_timestamp/1]). + + + +%% Help function, elapsed milliseconds since T0 +millisec_passed({_,_,_} = T0 ) -> + %% OTP 17 and earlier + timer:now_diff(inets_time_compat:timestamp(), T0) div 1000; + +millisec_passed(T0) -> + %% OTP 18 + erlang:convert_time_unit(erlang:monotonic_time() - T0, + native, + micro_seconds) div 1000. + +%% Return formated time stamp (e.g. 2015:03:16 10:05:23 1234) +formated_timestamp() -> + format_timestamp( os:timestamp() ). + +%% Return formated time stamp (e.g. 2015:03:16 10:05:23 1234) +format_timestamp({_N1, _N2, N3} = Tme) -> + {Date, Time} = calendar:now_to_datetime(Tme), + {YYYY,MM,DD} = Date, + {Hour,Min,Sec} = Time, + FormatDate = + io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w 4~w", + [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), + lists:flatten(FormatDate). diff --git a/lib/inets/src/inets_app/inets_time_compat.erl b/lib/inets/src/inets_app/inets_time_compat.erl new file mode 100644 index 0000000000..d6297d9caf --- /dev/null +++ b/lib/inets/src/inets_app/inets_time_compat.erl @@ -0,0 +1,71 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% This module is created to be able to execute on ERTS versions both +%% earlier and later than 7.0. + +-module(inets_time_compat). + +%% We don't want warnings about the use of erlang:now/0 in +%% this module. +-compile(nowarn_deprecated_function). + +-export([monotonic_time/0, + timestamp/0, + unique_integer/0, + unique_integer/1]). + +monotonic_time() -> + try + erlang:monotonic_time() + catch + error:undef -> + %% Use Erlang system time as monotonic time + erlang_system_time_fallback() + end. + +timestamp() -> + try + erlang:timestamp() + catch + error:undef -> + erlang:now() + end. + +unique_integer() -> + try + erlang:unique_integer() + catch + error:undef -> + erlang_system_time_fallback() + end. + +unique_integer(Modifiers) -> + try + erlang:unique_integer(Modifiers) + catch + error:badarg -> + erlang:error(badarg, [Modifiers]); + error:undef -> + erlang_system_time_fallback() + end. + +erlang_system_time_fallback() -> + {MS, S, US} = erlang:now(), + (MS*1000000+S)*1000000+US. diff --git a/lib/inets/src/inets_app/inets_trace.erl b/lib/inets/src/inets_app/inets_trace.erl index 8911f65897..cb6d6d8bdb 100644 --- a/lib/inets/src/inets_app/inets_trace.erl +++ b/lib/inets/src/inets_app/inets_trace.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% Copyright Ericsson AB 2011-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -228,21 +228,24 @@ handle_trace({trace_ts, _Who, call, [_Sev, "stop trace", stop_trace, [stop_trace]]}, Timestamp}, {_, standard_io} = Fd) -> - (catch io:format(standard_io, "stop trace at ~s~n", [format_timestamp(Timestamp)])), + (catch io:format(standard_io, "stop trace at ~s~n", + [inets_lib:format_timestamp(Timestamp)])), Fd; handle_trace({trace_ts, _Who, call, {?MODULE, report_event, [_Sev, "stop trace", stop_trace, [stop_trace]]}, Timestamp}, standard_io = Fd) -> - (catch io:format(Fd, "stop trace at ~s~n", [format_timestamp(Timestamp)])), + (catch io:format(Fd, "stop trace at ~s~n", + [inets_lib:format_timestamp(Timestamp)])), Fd; handle_trace({trace_ts, _Who, call, {?MODULE, report_event, [_Sev, "stop trace", stop_trace, [stop_trace]]}, Timestamp}, {_Service, Fd}) -> - (catch io:format(Fd, "stop trace at ~s~n", [format_timestamp(Timestamp)])), + (catch io:format(Fd, "stop trace at ~s~n", + [inets_lib:format_timestamp(Timestamp)])), (catch file:close(Fd)), closed_file; handle_trace({trace_ts, _Who, call, @@ -250,7 +253,8 @@ handle_trace({trace_ts, _Who, call, [_Sev, "stop trace", stop_trace, [stop_trace]]}, Timestamp}, Fd) -> - (catch io:format(Fd, "stop trace at ~s~n", [format_timestamp(Timestamp)])), + (catch io:format(Fd, "stop trace at ~s~n", + [inets_lib:format_timestamp(Timestamp)])), (catch file:close(Fd)), closed_file; handle_trace({trace_ts, Who, call, @@ -280,7 +284,7 @@ print_inets_trace(Fd, Sev, Timestamp, Who, Label, Service, Content) -> do_print_inets_trace(Fd, Sev, Timestamp, Who, Label, Service, Content). do_print_inets_trace(Fd, Sev, Timestamp, Who, Label, Service, Content) -> - Ts = format_timestamp(Timestamp), + Ts = inets_lib:format_timestamp(Timestamp), io:format(Fd, "[inets ~w trace ~w ~w ~s] ~s " "~n Content: ~p" "~n", @@ -307,7 +311,7 @@ do_print_trace(Fd, {trace, Who, What, Where, Extra}) -> "~n", [Who, What, Where, Extra]); do_print_trace(Fd, {trace_ts, Who, What, Where, When}) -> - Ts = format_timestamp(When), + Ts = inets_lib:format_timestamp(When), io:format(Fd, "[trace ~s]" "~n Who: ~p" "~n What: ~p" @@ -315,7 +319,7 @@ do_print_trace(Fd, {trace_ts, Who, What, Where, When}) -> "~n", [Ts, Who, What, Where]); do_print_trace(Fd, {trace_ts, Who, What, Where, Extra, When}) -> - Ts = format_timestamp(When), + Ts = inets_lib:format_timestamp(When), io:format(Fd, "[trace ~s]" "~n Who: ~p" "~n What: ~p" @@ -330,7 +334,7 @@ do_print_trace(Fd, {seq_trace, What, Where}) -> "~n", [What, Where]); do_print_trace(Fd, {seq_trace, What, Where, When}) -> - Ts = format_timestamp(When), + Ts = inets_lib:format_timestamp(When), io:format(Fd, "[seq trace ~s]" "~n What: ~p" "~n Where: ~p" @@ -345,13 +349,3 @@ do_print_trace(Fd, Trace) -> "~n", [Trace]). -format_timestamp({_N1, _N2, N3} = Now) -> - {Date, Time} = calendar:now_to_datetime(Now), - {YYYY,MM,DD} = Date, - {Hour,Min,Sec} = Time, - FormatDate = - io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w 4~w", - [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), - lists:flatten(FormatDate). - - diff --git a/lib/inets/src/tftp/tftp_logger.erl b/lib/inets/src/tftp/tftp_logger.erl index 0c3620e665..231a705371 100644 --- a/lib/inets/src/tftp/tftp_logger.erl +++ b/lib/inets/src/tftp/tftp_logger.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -84,8 +84,8 @@ info_msg(Format, Data) -> %%------------------------------------------------------------------- add_timestamp(Format, Data) -> - Now = {_MegaSecs, _Secs, _MicroSecs} = erlang:now(), - {{_Y, _Mo, _D}, {H, Mi, S}} = calendar:now_to_universal_time(Now), + Time = inets_time_compat:timestamp(), + {{_Y, _Mo, _D}, {H, Mi, S}} = calendar:now_to_universal_time(Time), %% {"~p-~s-~sT~s:~s:~sZ,~6.6.0w tftp: " ++ Format ++ "\n", %% [Y, t(Mo), t(D), t(H), t(Mi), t(S), MicroSecs | Data]}. {"~s:~s:~s tftp: " ++ Format, [t(H), t(Mi), t(S) | Data]}. diff --git a/lib/inets/src/tftp/tftp_sup.erl b/lib/inets/src/tftp/tftp_sup.erl index 1cafcc1069..7a0dcffc90 100644 --- a/lib/inets/src/tftp/tftp_sup.erl +++ b/lib/inets/src/tftp/tftp_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -93,7 +93,7 @@ unique_name(Options) -> {value, {_, Port}} when is_integer(Port), Port > 0 -> {tftpd, Port}; _ -> - {tftpd, erlang:now()} + {tftpd, inets_time_compat:unique_integer([positive])} end. default_kill_after() -> diff --git a/lib/inets/test/ftp_suite_lib.erl b/lib/inets/test/ftp_suite_lib.erl index daee1bdcdc..b637832101 100644 --- a/lib/inets/test/ftp_suite_lib.erl +++ b/lib/inets/test/ftp_suite_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1352,9 +1352,9 @@ do_delete(Pid, Config) -> ok. do_mkdir(Pid) -> - {A, B, C} = erlang:now(), - NewDir = "nisse_" ++ integer_to_list(A) ++ "_" ++ - integer_to_list(B) ++ "_" ++ integer_to_list(C), + NewDir = "earl_" ++ + integer_to_list(inets_time_compat:unique_integer([positive])), + ok = ftp:cd(Pid, "incoming"), {ok, CurrDir} = ftp:pwd(Pid), {error, efnamena} = ftp:mkdir(Pid, NewDir++"\r\nCWD ."), diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 0e89e831fb..0dfc65e8f7 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -1933,12 +1933,13 @@ run_clients(NumClients, ServerPort, SeqNumServer) -> wait4clients([], _Timeout) -> ok; wait4clients(Clients, Timeout) when Timeout > 0 -> - Time = now_ms(), + Time = inets_time_compat:monotonic_time(), + receive {'DOWN', _MRef, process, Pid, normal} -> {value, {Id, _, _}} = lists:keysearch(Pid, 2, Clients), NewClients = lists:keydelete(Id, 1, Clients), - wait4clients(NewClients, Timeout - (now_ms() - Time)); + wait4clients(NewClients, Timeout - inets_lib:millisec_passed(Time)); {'DOWN', _MRef, process, Pid, Reason} -> {value, {Id, _, _}} = lists:keysearch(Pid, 2, Clients), ct:fail({bad_client_termination, Id, Reason}) @@ -2031,14 +2032,10 @@ parse_connection_type(Request) -> "keep-alive" -> keep_alive end. -%% Time in milli seconds -now_ms() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). - set_random_seed() -> - {_, _, Micros} = now(), - A = erlang:phash2([make_ref(), self(), Micros]), + Unique = inets_time_compat:unique_integer(), + + A = erlang:phash2([make_ref(), self(), Unique]), random:seed(A, A, A). diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 342004f19b..11f2c6f298 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -127,7 +127,6 @@ http_get() -> get, %%actions, Add configuration so that this test mod_action esi, - ssi, content_length, bad_hex, missing_CR, @@ -552,22 +551,6 @@ ipv6(Config) when is_list(Config) -> end. %%------------------------------------------------------------------------- -ssi() -> - [{doc, "HTTP GET server side include test"}]. -ssi(Config) when is_list(Config) -> - Version = ?config(http_version, Config), - Host = ?config(host, Config), - Type = ?config(type, Config), - ok = httpd_test_lib:verify_request(?config(type, Config), Host, ?config(port, Config), - transport_opts(Type, Config), - ?config(node, Config), - http_request("GET /fsize.shtml ", Version, Host), - [{statuscode, 200}, - {header, "Content-Type", "text/html"}, - {header, "Date"}, - {header, "Server"}, - {version, Version}]). -%%------------------------------------------------------------------------- htaccess_1_1(Config) when is_list(Config) -> htaccess([{http_version, "HTTP/1.1"} | Config]). diff --git a/lib/inets/test/httpd_time_test.erl b/lib/inets/test/httpd_time_test.erl index 0bb457f9b9..7dd61a5517 100644 --- a/lib/inets/test/httpd_time_test.erl +++ b/lib/inets/test/httpd_time_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -116,13 +116,14 @@ main(N, SocketType, Host, Port, Time) loop(Pollers, Timeout) -> d("loop -> entry when" "~n Timeout: ~p", [Timeout]), - Start = t(), + Start = inets_time_compat:monotonic_time(), + receive {'EXIT', Pid, {poller_stat_failure, SocketType, Host, Port, Time, Reason}} -> case is_poller(Pid, Pollers) of true -> error_msg("received unexpected exit from poller ~p~n" - "befor completion of test " + "before completion of test " "after ~p micro sec" "~n SocketType: ~p" "~n Host: ~p" @@ -133,7 +134,7 @@ loop(Pollers, Timeout) -> false -> error_msg("received unexpected ~p from ~p" "befor completion of test", [Reason, Pid]), - loop(Pollers, to(Timeout, Start)) + loop(Pollers, Timeout - inets_lib:millisec_passed(Start)) end; {poller_stat_failure, Pid, {SocketType, Host, Port, Time, Reason}} -> @@ -412,35 +413,6 @@ validate(ExpStatusCode, _SocketType, _Socket, Response) -> end. -trash_the_rest(Socket, N) -> - receive - {ssl, Socket, Trash} -> - trash_the_rest(Socket, add(N,sz(Trash))); - {ssl_closed, Socket} -> - N; - {ssl_error, Socket, Error} -> - exit({connection_error, Error}); - - {tcp, Socket, Trash} -> - trash_the_rest(Socket, add(N,sz(Trash))); - {tcp_closed, Socket} -> - N; - {tcp_error, Socket, Error} -> - exit({connection_error, Error}) - - after 10000 -> - exit({connection_timed_out, N}) - end. - - -add(N1,N2) when is_integer(N1) andalso is_integer(N2) -> - N1 + N2; -add(N1,_) when is_integer(N1) -> - N1; -add(_,N2) when is_integer(N2) -> - N2. - - sz(L) when is_list(L) -> length(lists:flatten(L)); sz(B) when is_binary(B) -> @@ -505,17 +477,6 @@ status_to_message(Code) -> io_lib:format("Unknown status code: ~p",[Code]). %% ---------------------------------------------------------------- -to(To, Start) -> - To - (t() - Start). - -%% Time in milli seconds -t() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). - - -%% ---------------------------------------------------------------- - % close(Socket) -> diff --git a/lib/inets/test/inets_SUITE.erl b/lib/inets/test/inets_SUITE.erl index 6510c70d08..a07dc79c02 100644 --- a/lib/inets/test/inets_SUITE.erl +++ b/lib/inets/test/inets_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -549,25 +549,12 @@ tsf(Reason) -> tsp(F) -> tsp(F, []). tsp(F, A) -> - Timestamp = formated_timestamp(), + Timestamp = inets_lib:formated_timestamp(), test_server:format("** ~s ** ~p ~p:" ++ F ++ "~n", [Timestamp, self(), ?MODULE | A]). i(F) -> i(F, []). i(F, A) -> - Timestamp = formated_timestamp(), + Timestamp = inets_lib:formated_timestamp(), io:format("*** ~s ~w:" ++ F ++ "~n", [Timestamp, ?MODULE | A]). - -formated_timestamp() -> - format_timestamp( os:timestamp() ). - -format_timestamp({_N1, _N2, N3} = Now) -> - {Date, Time} = calendar:now_to_datetime(Now), - {YYYY,MM,DD} = Date, - {Hour,Min,Sec} = Time, - FormatDate = - io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w 4~w", - [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), - lists:flatten(FormatDate). - diff --git a/lib/inets/test/inets_app_test.erl b/lib/inets/test/inets_app_test.erl index eabfa69f7c..22d6e25c87 100644 --- a/lib/inets/test/inets_app_test.erl +++ b/lib/inets/test/inets_app_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. +%% Copyright Ericsson AB 2002-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -32,19 +32,6 @@ %% Test server callbacks -init_per_testcase(undef_funcs, Config) -> - NewConfig = lists:keydelete(watchdog, 1, Config), - Dog = test_server:timetrap(inets_test_lib:minutes(10)), - - %% We need to check if there is a point to run this test. - %% On some platforms, crypto will not build, which in turn - %% causes ssl to not build (at this time, this will - %% change in the future). - %% So, we first check if we can start crypto, and if not, - %% we skip this test case! - ?ENSURE_STARTED(crypto), - - [{watchdog, Dog}| NewConfig]; init_per_testcase(_, Config) -> Config. @@ -54,7 +41,7 @@ end_per_testcase(_Case, Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% all() -> - [fields, modules, exportall, app_depend, undef_funcs]. + [fields, modules, exportall, app_depend]. groups() -> []. @@ -244,56 +231,6 @@ check_apps([App|Apps]) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -undef_funcs(suite) -> - []; -undef_funcs(doc) -> - []; -undef_funcs(Config) when is_list(Config) -> - App = inets, - AppFile = key1search(app_file, Config), - Mods = key1search(modules, AppFile), - Root = code:root_dir(), - LibDir = code:lib_dir(App), - EbinDir = filename:join([LibDir,"ebin"]), - XRefTestName = undef_funcs_make_name(App, xref_test_name), - {ok, XRef} = xref:start(XRefTestName), - ok = xref:set_default(XRef, - [{verbose,false},{warnings,false}]), - XRefName = undef_funcs_make_name(App, xref_name), - {ok, XRefName} = xref:add_release(XRef, Root, {name, XRefName}), - {ok, App} = xref:replace_application(XRef, App, EbinDir), - {ok, Undefs} = xref:analyze(XRef, undefined_function_calls), - xref:stop(XRef), - analyze_undefined_function_calls(Undefs, Mods, []). - -analyze_undefined_function_calls([], _, []) -> - ok; -analyze_undefined_function_calls([], _, AppUndefs) -> - exit({suite_failed, {undefined_function_calls, AppUndefs}}); -analyze_undefined_function_calls([{{Mod, _F, _A}, _C} = AppUndef|Undefs], - AppModules, AppUndefs) -> - %% Check that this module is our's - case lists:member(Mod,AppModules) of - true -> - {Calling,Called} = AppUndef, - {Mod1,Func1,Ar1} = Calling, - {Mod2,Func2,Ar2} = Called, - io:format("undefined function call: " - "~n ~w:~w/~w calls ~w:~w/~w~n", - [Mod1,Func1,Ar1,Mod2,Func2,Ar2]), - analyze_undefined_function_calls(Undefs, AppModules, - [AppUndef|AppUndefs]); - false -> - io:format("dropping ~p~n", [Mod]), - analyze_undefined_function_calls(Undefs, AppModules, AppUndefs) - end. - -%% This function is used simply to avoid cut-and-paste errors later... -undef_funcs_make_name(App, PostFix) -> - list_to_atom(atom_to_list(App) ++ "_" ++ atom_to_list(PostFix)). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - fail(Reason) -> exit({suite_failed, Reason}). diff --git a/lib/inets/test/inets_test_lib.erl b/lib/inets/test/inets_test_lib.erl index 4be9d9c8b3..7485971d3e 100644 --- a/lib/inets/test/inets_test_lib.erl +++ b/lib/inets/test/inets_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -498,13 +498,6 @@ close(essl,Socket) -> close(ip_comm,Socket) -> catch gen_tcp:close(Socket). -millis() -> - erlang:now(). - -millis_diff(A,B) -> - T1 = (element(1,A)*1000000) + element(2,A) + (element(3,A)/1000000), - T2 = (element(1,B)*1000000) + element(2,B) + (element(3,B)/1000000), - T1 - T2. hours(N) -> trunc(N * 1000 * 60 * 60). minutes(N) -> trunc(N * 1000 * 60). @@ -546,7 +539,7 @@ flush() -> tsp(F) -> tsp(F, []). tsp(F, A) -> - Timestamp = formated_timestamp(), + Timestamp = inets_lib:formated_timestamp(), ct:pal("*** ~s ~p ~p " ++ F ++ "~n", [Timestamp, node(), self() | A]). @@ -559,18 +552,6 @@ tss(Time) -> timestamp() -> http_util:timestamp(). -formated_timestamp() -> - format_timestamp( os:timestamp() ). - -format_timestamp({_N1, _N2, N3} = Now) -> - {Date, Time} = calendar:now_to_datetime(Now), - {YYYY,MM,DD} = Date, - {Hour,Min,Sec} = Time, - FormatDate = - io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w 4~w", - [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), - lists:flatten(FormatDate). - start_apps(Apps) -> lists:foreach(fun(App) -> application:stop(App), diff --git a/lib/inets/test/old_httpd_SUITE.erl b/lib/inets/test/old_httpd_SUITE.erl index 74c11f71ba..39b0b08645 100644 --- a/lib/inets/test/old_httpd_SUITE.erl +++ b/lib/inets/test/old_httpd_SUITE.erl @@ -2072,13 +2072,13 @@ create_config(Config, Access, FileName) -> "Modules mod_alias mod_htaccess mod_auth " "mod_security " "mod_responsecontrol mod_trace mod_esi " - "mod_actions mod_cgi mod_include mod_dir " + "mod_actions mod_cgi mod_dir " "mod_range mod_get " "mod_head mod_log mod_disk_log"; _ -> "Modules mod_alias mod_auth mod_security " "mod_responsecontrol mod_trace mod_esi " - "mod_actions mod_cgi mod_include mod_dir " + "mod_actions mod_cgi mod_dir " "mod_range mod_get " "mod_head mod_log mod_disk_log" end, @@ -2436,7 +2436,7 @@ create_ipv6_config(Config, FileName, Ipv6Address) -> MaxHdrAct = io_lib:format("~p", [close]), Mod_order = "Modules mod_alias mod_auth mod_esi mod_actions mod_cgi" - " mod_include mod_dir mod_get mod_head" + " mod_dir mod_get mod_head" " mod_log mod_disk_log mod_trace", SSL = diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 7d11916454..e9ecb2632a 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.10.5 +INETS_VSN = 5.10.7 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/doc/src/jinterface_users_guide.xml b/lib/jinterface/doc/src/jinterface_users_guide.xml index 5dfe5c0c6d..238f90ce38 100644 --- a/lib/jinterface/doc/src/jinterface_users_guide.xml +++ b/lib/jinterface/doc/src/jinterface_users_guide.xml @@ -223,6 +223,14 @@ OtpNode node = new OtpNode("gurka"); </code> </section> <section> + <title>Transport Factory</title> + <p>All necessary connections are made using methods of + <seealso marker="java/com/ericsson/otp/erlang/OtpTransportFactory">OtpTransportFactory</seealso> + interface. Default OtpTransportFactory implementation is based on standard Socket class. + User may provide custom transport factory as needed. See java doc for details.</p> + </section> + + <section> <title>Sending and Receiving Messages</title> <p>Messages sent with this package must be instances of <seealso marker="java/com/ericsson/otp/erlang/OtpErlangObject">OtpErlangObject</seealso> diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java index 1b0fe3e2e6..ab8fa06c1b 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java @@ -20,7 +20,7 @@ package com.ericsson.otp.erlang; import java.io.IOException; -import java.net.Socket; +import java.io.OutputStream; import java.util.Random; /** @@ -84,7 +84,7 @@ public abstract class AbstractConnection extends Thread { private volatile boolean done = false; protected boolean connected = false; // connection status - protected Socket socket; // communication channel + protected OtpTransport socket; // communication channel protected OtpPeer peer; // who are we connected to protected OtpLocalNode localNode; // this nodes id String name; // local name of this connection @@ -126,7 +126,7 @@ public abstract class AbstractConnection extends Thread { * Accept an incoming connection from a remote node. Used by * {@link OtpSelf#accept() OtpSelf.accept()} to create a connection based on * data received when handshaking with the peer node, when the remote node - * is the connection intitiator. + * is the connection initiator. * * @exception java.io.IOException * if it was not possible to connect to the peer. @@ -134,20 +134,17 @@ public abstract class AbstractConnection extends Thread { * @exception OtpAuthException * if handshake resulted in an authentication error */ - protected AbstractConnection(final OtpLocalNode self, final Socket s) + protected AbstractConnection(final OtpLocalNode self, final OtpTransport s) throws IOException, OtpAuthException { localNode = self; - peer = new OtpPeer(); + peer = new OtpPeer(self.transportFactory); socket = s; - socket.setTcpNoDelay(true); - traceLevel = defaultLevel; setDaemon(true); if (traceLevel >= handshakeThreshold) { - System.out.println("<- ACCEPT FROM " + s.getInetAddress() + ":" - + s.getPort()); + System.out.println("<- ACCEPT FROM " + s); } // get his info @@ -189,6 +186,8 @@ public abstract class AbstractConnection extends Thread { // now get a connection between the two... port = OtpEpmd.lookupPort(peer); + if (port == 0) + throw new IOException("No remote node found - cannot connect"); // now find highest common dist value if (peer.proto != self.proto || self.distHigh < peer.distLow @@ -523,7 +522,9 @@ public abstract class AbstractConnection extends Thread { // received tick? send tock! if (len == 0) { synchronized (this) { - socket.getOutputStream().write(tock); + OutputStream out = socket.getOutputStream(); + out.write(tock); + out.flush(); } } @@ -837,8 +838,11 @@ public abstract class AbstractConnection extends Thread { } } - header.writeTo(socket.getOutputStream()); - payload.writeTo(socket.getOutputStream()); + // group flush op in favour of possible ssh-tunneled stream + OutputStream out = socket.getOutputStream(); + header.writeTo(out); + payload.writeTo(out); + out.flush(); } catch (final IOException e) { close(); throw e; @@ -859,7 +863,7 @@ public abstract class AbstractConnection extends Thread { + e); } } - header.writeTo(socket.getOutputStream()); + header.writeToAndFlush(socket.getOutputStream()); } catch (final IOException e) { close(); throw e; @@ -913,7 +917,8 @@ public abstract class AbstractConnection extends Thread { } /* this method now throws exception if we don't get full read */ - protected int readSock(final Socket s, final byte[] b) throws IOException { + protected int readSock(final OtpTransport s, final byte[] b) + throws IOException { int got = 0; final int len = b.length; int i; @@ -980,8 +985,7 @@ public abstract class AbstractConnection extends Thread { protected void doConnect(final int port) throws IOException, OtpAuthException { try { - socket = new Socket(peer.host(), port); - socket.setTcpNoDelay(true); + socket = peer.createTransport(peer.host(), port); if (traceLevel >= handshakeThreshold) { System.out.println("-> MD5 CONNECT TO " + peer.host() + ":" @@ -1077,7 +1081,7 @@ public abstract class AbstractConnection extends Thread { obuf.write4BE(aflags); obuf.write(str.getBytes()); - obuf.writeTo(socket.getOutputStream()); + obuf.writeToAndFlush(socket.getOutputStream()); if (traceLevel >= handshakeThreshold) { System.out.println("-> " + "HANDSHAKE sendName" + " flags=" @@ -1098,7 +1102,7 @@ public abstract class AbstractConnection extends Thread { obuf.write4BE(challenge); obuf.write(str.getBytes()); - obuf.writeTo(socket.getOutputStream()); + obuf.writeToAndFlush(socket.getOutputStream()); if (traceLevel >= handshakeThreshold) { System.out.println("-> " + "HANDSHAKE sendChallenge" + " flags=" @@ -1232,7 +1236,7 @@ public abstract class AbstractConnection extends Thread { obuf.write1(ChallengeReply); obuf.write4BE(challenge); obuf.write(digest); - obuf.writeTo(socket.getOutputStream()); + obuf.writeToAndFlush(socket.getOutputStream()); if (traceLevel >= handshakeThreshold) { System.out.println("-> " + "HANDSHAKE sendChallengeReply" @@ -1294,7 +1298,7 @@ public abstract class AbstractConnection extends Thread { obuf.write1(ChallengeAck); obuf.write(digest); - obuf.writeTo(socket.getOutputStream()); + obuf.writeToAndFlush(socket.getOutputStream()); if (traceLevel >= handshakeThreshold) { System.out.println("-> " + "HANDSHAKE sendChallengeAck" @@ -1341,7 +1345,7 @@ public abstract class AbstractConnection extends Thread { obuf.write1(ChallengeStatus); obuf.write(status.getBytes()); - obuf.writeTo(socket.getOutputStream()); + obuf.writeToAndFlush(socket.getOutputStream()); if (traceLevel >= handshakeThreshold) { System.out.println("-> " + "HANDSHAKE sendStatus" + " status=" diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java index 6f07d8171e..0a33984b31 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java @@ -64,13 +64,14 @@ import java.net.UnknownHostException; * instead. * </p> */ -public class AbstractNode { +public class AbstractNode implements OtpTransportFactory { static String localHost = null; String node; String host; String alive; String cookie; static String defaultCookie = null; + final OtpTransportFactory transportFactory; // Node types static final int NTYPE_R6 = 110; // 'n' post-r5, all nodes @@ -146,21 +147,41 @@ public class AbstractNode { } } - protected AbstractNode() { + protected AbstractNode(final OtpTransportFactory transportFactory) { + this.transportFactory = transportFactory; } /** - * Create a node with the given name and the default cookie. + * Create a node with the given name and default cookie and transport + * factory. */ protected AbstractNode(final String node) { - this(node, defaultCookie); + this(node, defaultCookie, new OtpSocketTransportFactory()); } /** - * Create a node with the given name and cookie. + * Create a node with the given name, transport factory and the default + * cookie. + */ + protected AbstractNode(final String node, + final OtpTransportFactory transportFactory) { + this(node, defaultCookie, transportFactory); + } + + /** + * Create a node with the given name, cookie and default transport factory. */ protected AbstractNode(final String name, final String cookie) { + this(name, cookie, new OtpSocketTransportFactory()); + } + + /** + * Create a node with the given name, cookie and transport factory. + */ + protected AbstractNode(final String name, final String cookie, + final OtpTransportFactory transportFactory) { this.cookie = cookie; + this.transportFactory = transportFactory; final int i = name.indexOf('@', 0); if (i < 0) { @@ -268,4 +289,19 @@ public class AbstractNode { } return home; } + + public OtpTransport createTransport(final String addr, final int port) + throws IOException { + return transportFactory.createTransport(addr, port); + } + + public OtpTransport createTransport(final InetAddress addr, final int port) + throws IOException { + return transportFactory.createTransport(addr, port); + } + + public OtpServerTransport createServerTransport(final int port) + throws IOException { + return transportFactory.createServerTransport(port); + } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpConnection.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpConnection.java index 2c9b7766bc..af0926f939 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpConnection.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpConnection.java @@ -19,7 +19,6 @@ package com.ericsson.otp.erlang; import java.io.IOException; -import java.net.Socket; /** * Maintains a connection between a Java process and a remote Erlang, Java or C @@ -63,8 +62,8 @@ public class OtpConnection extends AbstractConnection { * error */ // package scope - OtpConnection(final OtpSelf self, final Socket s) throws IOException, - OtpAuthException { + OtpConnection(final OtpSelf self, final OtpTransport s) + throws IOException, OtpAuthException { super(self, s); this.self = self; queue = new GenericQueue(); diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpCookedConnection.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpCookedConnection.java index 4d80f61d52..b0e3e81fca 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpCookedConnection.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpCookedConnection.java @@ -19,7 +19,6 @@ package com.ericsson.otp.erlang; import java.io.IOException; -import java.net.Socket; /** * <p> @@ -78,8 +77,8 @@ public class OtpCookedConnection extends AbstractConnection { * error */ // package scope - OtpCookedConnection(final OtpNode self, final Socket s) throws IOException, - OtpAuthException { + OtpCookedConnection(final OtpNode self, final OtpTransport s) + throws IOException, OtpAuthException { super(self, s); this.self = self; links = new Links(25); diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java index 796babee1b..6c7c8fe951 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java @@ -21,13 +21,12 @@ package com.ericsson.otp.erlang; import java.io.ByteArrayOutputStream; import java.io.IOException; import java.net.InetAddress; -import java.net.Socket; /** * Provides methods for registering, unregistering and looking up nodes with the * Erlang portmapper daemon (Epmd). For each registered node, Epmd maintains * information about the port on which incoming connections are accepted, as - * well as which versions of the Erlang communication protocolt the node + * well as which versions of the Erlang communication protocol the node * supports. * * <p> @@ -136,7 +135,7 @@ public class OtpEpmd { */ public static boolean publishPort(final OtpLocalNode node) throws IOException { - Socket s = null; + OtpTransport s = null; s = r4_publish(node); @@ -156,16 +155,16 @@ public class OtpEpmd { * This method does not report any failures. */ public static void unPublishPort(final OtpLocalNode node) { - Socket s = null; + OtpTransport s = null; try { - s = new Socket((String) null, EpmdPort.get()); + s = node.createTransport((String) null, EpmdPort.get()); @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); obuf.write2BE(node.alive().length() + 1); obuf.write1(stopReq); obuf.writeN(node.alive().getBytes()); - obuf.writeTo(s.getOutputStream()); + obuf.writeToAndFlush(s.getOutputStream()); // don't even wait for a response (is there one?) if (traceLevel >= traceThreshold) { System.out.println("-> UNPUBLISH " + node + " port=" @@ -187,12 +186,12 @@ public class OtpEpmd { private static int r4_lookupPort(final AbstractNode node) throws IOException { int port = 0; - Socket s = null; + OtpTransport s = null; try { @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); - s = new Socket(node.host(), EpmdPort.get()); + s = node.createTransport(node.host(), EpmdPort.get()); // build and send epmd request // length[2], tag[1], alivename[n] (length = n+1) @@ -201,7 +200,7 @@ public class OtpEpmd { obuf.writeN(node.alive().getBytes()); // send request - obuf.writeTo(s.getOutputStream()); + obuf.writeToAndFlush(s.getOutputStream()); if (traceLevel >= traceThreshold) { System.out.println("-> LOOKUP (r4) " + node); @@ -242,7 +241,7 @@ public class OtpEpmd { System.out.println("<- (no response)"); } throw new IOException("Nameserver not responding on " + node.host() - + " when looking up " + node.alive()); + + " when looking up " + node.alive(), e); } catch (final OtpErlangDecodeException e) { if (traceLevel >= traceThreshold) { System.out.println("<- (invalid response)"); @@ -276,14 +275,14 @@ public class OtpEpmd { * fatal. If we manage to successfully communicate with an r4 epmd, we * return either the socket, or null, depending on the result. */ - private static Socket r4_publish(final OtpLocalNode node) + private static OtpTransport r4_publish(final OtpLocalNode node) throws IOException { - Socket s = null; + OtpTransport s = null; try { @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); - s = new Socket((String) null, EpmdPort.get()); + s = node.createTransport((String) null, EpmdPort.get()); obuf.write2BE(node.alive().length() + 13); @@ -301,7 +300,7 @@ public class OtpEpmd { obuf.write2BE(0); // No extra // send request - obuf.writeTo(s.getOutputStream()); + obuf.writeToAndFlush(s.getOutputStream()); if (traceLevel >= traceThreshold) { System.out.println("-> PUBLISH (r4) " + node + " port=" @@ -356,23 +355,34 @@ public class OtpEpmd { } public static String[] lookupNames() throws IOException { - return lookupNames(InetAddress.getByName(null)); + return lookupNames(InetAddress.getByName(null), + new OtpSocketTransportFactory()); + } + + public static String[] lookupNames( + final OtpTransportFactory transportFactory) throws IOException { + return lookupNames(InetAddress.getByName(null), transportFactory); } public static String[] lookupNames(final InetAddress address) throws IOException { - Socket s = null; + return lookupNames(address, new OtpSocketTransportFactory()); + } + + public static String[] lookupNames(final InetAddress address, + final OtpTransportFactory transportFactory) throws IOException { + OtpTransport s = null; try { @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); try { - s = new Socket(address, EpmdPort.get()); + s = transportFactory.createTransport(address, EpmdPort.get()); obuf.write2BE(1); obuf.write1(names4req); // send request - obuf.writeTo(s.getOutputStream()); + obuf.writeToAndFlush(s.getOutputStream()); if (traceLevel >= traceThreshold) { System.out.println("-> NAMES (r4) "); diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangList.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangList.java index 990e50ddcd..268261ec10 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangList.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangList.java @@ -297,6 +297,54 @@ public class OtpErlangList extends OtpErlangObject implements return getLastTail().equals(l.getLastTail()); } + @Override + public <T> boolean match(final OtpErlangObject term, final T bindings) { + if (!(term instanceof OtpErlangList)) { + return false; + } + final OtpErlangList that = (OtpErlangList) term; + + final int thisArity = this.arity(); + final int thatArity = that.arity(); + final OtpErlangObject thisTail = this.getLastTail(); + final OtpErlangObject thatTail = that.getLastTail(); + + if (thisTail == null) { + if (thisArity != thatArity || thatTail != null) { + return false; + } + } else { + if (thisArity > thatArity) { + return false; + } + } + for (int i = 0; i < thisArity; i++) { + if (!elementAt(i).match(that.elementAt(i), bindings)) { + return false; + } + } + if (thisTail == null) { + return true; + } + return thisTail.match(that.getNthTail(thisArity), bindings); + } + + @Override + public <T> OtpErlangObject bind(final T binds) throws OtpErlangException { + final OtpErlangList list = (OtpErlangList) this.clone(); + + final int a = list.elems.length; + for (int i = 0; i < a; i++) { + list.elems[i] = list.elems[i].bind(binds); + } + + if (list.lastTail != null) { + list.lastTail = list.lastTail.bind(binds); + } + + return list; + } + public OtpErlangObject getLastTail() { return lastTail; } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java index 7f2621923a..a8cd9d5392 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java @@ -18,6 +18,11 @@ */ package com.ericsson.otp.erlang; +import java.util.HashMap; +import java.util.Map; +import java.util.Map.Entry; +import java.util.Set; + /** * Provides a Java representation of Erlang maps. Maps are created from one or * more arbitrary Erlang terms. @@ -31,10 +36,14 @@ public class OtpErlangMap extends OtpErlangObject { // don't change this! private static final long serialVersionUID = -6410770117696198497L; - private static final OtpErlangObject[] NO_ELEMENTS = new OtpErlangObject[0]; + private HashMap<OtpErlangObject, OtpErlangObject> map; - private OtpErlangObject[] keys = NO_ELEMENTS; - private OtpErlangObject[] values = NO_ELEMENTS; + /** + * Create an empty map. + */ + public OtpErlangMap() { + map = new HashMap<OtpErlangObject, OtpErlangObject>(); + } /** * Create a map from an array of keys and an array of values. @@ -82,30 +91,20 @@ public class OtpErlangMap extends OtpErlangObject { } else if (kcount != vcount) { throw new java.lang.IllegalArgumentException( "Map keys and values must have same arity"); - } else if (vcount < 1) { - this.keys = NO_ELEMENTS; - this.values = NO_ELEMENTS; - } else { - this.keys = new OtpErlangObject[vcount]; - for (int i = 0; i < vcount; i++) { - if (keys[kstart + i] != null) { - this.keys[i] = keys[kstart + i]; - } else { - throw new java.lang.IllegalArgumentException( - "Map key cannot be null (element" + (kstart + i) - + ")"); - } + } + map = new HashMap<OtpErlangObject, OtpErlangObject>(vcount); + OtpErlangObject key, val; + for (int i = 0; i < vcount; i++) { + if ((key = keys[kstart + i]) == null) { + throw new java.lang.IllegalArgumentException( + "Map key cannot be null (element" + (kstart + i) + ")"); } - this.values = new OtpErlangObject[vcount]; - for (int i = 0; i < vcount; i++) { - if (values[vstart + i] != null) { - this.values[i] = values[vstart + i]; - } else { - throw new java.lang.IllegalArgumentException( - "Map value cannot be null (element" + (vstart + i) - + ")"); - } + if ((val = values[vstart + i]) == null) { + throw new java.lang.IllegalArgumentException( + "Map value cannot be null (element" + (vstart + i) + + ")"); } + put(key, val); } } @@ -125,16 +124,15 @@ public class OtpErlangMap extends OtpErlangObject { final int arity = buf.read_map_head(); if (arity > 0) { - keys = new OtpErlangObject[arity]; - values = new OtpErlangObject[arity]; - + map = new HashMap<OtpErlangObject, OtpErlangObject>(arity); for (int i = 0; i < arity; i++) { - keys[i] = buf.read_any(); - values[i] = buf.read_any(); + OtpErlangObject key, val; + key = buf.read_any(); + val = buf.read_any(); + put(key, val); } } else { - keys = NO_ELEMENTS; - values = NO_ELEMENTS; + map = new HashMap<OtpErlangObject, OtpErlangObject>(); } } @@ -144,7 +142,33 @@ public class OtpErlangMap extends OtpErlangObject { * @return the number of elements contained in the map. */ public int arity() { - return keys.length; + return map.size(); + } + + /** + * Put value corresponding to key into the map. For detailed behavior + * description see {@link Map#put(Object, Object)}. + * + * @param key + * key to associate value with + * @param value + * value to associate with key + * @return previous value associated with key or null + */ + public OtpErlangObject put(final OtpErlangObject key, + final OtpErlangObject value) { + return map.put(key, value); + } + + /** + * removes mapping for the key if present. + * + * @param key + * key for which mapping is to be remove + * @return value associated with key or null + */ + public OtpErlangObject remove(final OtpErlangObject key) { + return map.remove(key); } /** @@ -156,15 +180,7 @@ public class OtpErlangMap extends OtpErlangObject { * @return the requested value, of null if key is not a valid key. */ public OtpErlangObject get(final OtpErlangObject key) { - if (key == null) { - return null; - } - for (int i = 0; i < keys.length; i++) { - if (key.equals(keys[i])) { - return values[i]; - } - } - return null; + return map.get(key); } /** @@ -173,9 +189,7 @@ public class OtpErlangMap extends OtpErlangObject { * @return an array containing all of the map's keys. */ public OtpErlangObject[] keys() { - final OtpErlangObject[] res = new OtpErlangObject[arity()]; - System.arraycopy(keys, 0, res, 0, res.length); - return res; + return map.keySet().toArray(new OtpErlangObject[arity()]); } /** @@ -184,9 +198,16 @@ public class OtpErlangMap extends OtpErlangObject { * @return an array containing all of the map's values. */ public OtpErlangObject[] values() { - final OtpErlangObject[] res = new OtpErlangObject[arity()]; - System.arraycopy(values, 0, res, 0, res.length); - return res; + return map.values().toArray(new OtpErlangObject[arity()]); + } + + /** + * make Set view of the map key-value pairs + * + * @return a set containing key-value pairs + */ + public Set<Entry<OtpErlangObject, OtpErlangObject>> entrySet() { + return map.entrySet(); } /** @@ -196,19 +217,20 @@ public class OtpErlangMap extends OtpErlangObject { */ @Override public String toString() { - int i; final StringBuffer s = new StringBuffer(); - final int arity = values.length; s.append("#{"); - for (i = 0; i < arity; i++) { - if (i > 0) { + boolean first = true; + for (final Map.Entry<OtpErlangObject, OtpErlangObject> e : entrySet()) { + if (first) { + first = false; + } else { s.append(","); } - s.append(keys[i].toString()); + s.append(e.getKey().toString()); s.append(" => "); - s.append(values[i].toString()); + s.append(e.getValue().toString()); } s.append("}"); @@ -224,13 +246,13 @@ public class OtpErlangMap extends OtpErlangObject { */ @Override public void encode(final OtpOutputStream buf) { - final int arity = values.length; + final int arity = arity(); buf.write_map_head(arity); - for (int i = 0; i < arity; i++) { - buf.write_any(keys[i]); - buf.write_any(values[i]); + for (final Map.Entry<OtpErlangObject, OtpErlangObject> e : entrySet()) { + buf.write_any(e.getKey()); + buf.write_any(e.getValue()); } } @@ -256,15 +278,46 @@ public class OtpErlangMap extends OtpErlangObject { if (a != t.arity()) { return false; } + if (a == 0) { + return true; + } - for (int i = 0; i < a; i++) { - if (!keys[i].equals(t.keys[i])) { - return false; // early exit + OtpErlangObject key, val; + for (final Map.Entry<OtpErlangObject, OtpErlangObject> e : entrySet()) { + key = e.getKey(); + val = e.getValue(); + final OtpErlangObject v = t.get(key); + if (v == null || !val.equals(v)) { + return false; } } - for (int i = 0; i < a; i++) { - if (!values[i].equals(t.values[i])) { - return false; // early exit + + return true; + } + + @Override + public <T> boolean match(final OtpErlangObject term, final T binds) { + if (!(term instanceof OtpErlangMap)) { + return false; + } + + final OtpErlangMap t = (OtpErlangMap) term; + final int a = arity(); + + if (a > t.arity()) { + return false; + } + if (a == 0) { + return true; + } + + OtpErlangObject key, val; + for (final Map.Entry<OtpErlangObject, OtpErlangObject> e : entrySet()) { + key = e.getKey(); + val = e.getValue(); + final OtpErlangObject v = t.get(key); + if (v == null || !val.match(v, binds)) { + return false; } } @@ -272,23 +325,31 @@ public class OtpErlangMap extends OtpErlangObject { } @Override + public <T> OtpErlangObject bind(final T binds) throws OtpErlangException { + final OtpErlangMap ret = new OtpErlangMap(); + + OtpErlangObject key, val; + for (final Map.Entry<OtpErlangObject, OtpErlangObject> e : entrySet()) { + key = e.getKey(); + val = e.getValue(); + ret.put(key, val.bind(binds)); + } + + return ret; + } + + @Override protected int doHashCode() { final OtpErlangObject.Hash hash = new OtpErlangObject.Hash(9); - final int a = arity(); - hash.combine(a); - for (int i = 0; i < a; i++) { - hash.combine(keys[i].hashCode()); - } - for (int i = 0; i < a; i++) { - hash.combine(values[i].hashCode()); - } + hash.combine(map.hashCode()); return hash.valueOf(); } @Override + @SuppressWarnings("unchecked") public Object clone() { final OtpErlangMap newMap = (OtpErlangMap) super.clone(); - newMap.values = values.clone(); + newMap.map = (HashMap<OtpErlangObject, OtpErlangObject>) map.clone(); return newMap; } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangObject.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangObject.java index 7ab160bcdd..9339d3749b 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangObject.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangObject.java @@ -80,6 +80,32 @@ public abstract class OtpErlangObject implements Serializable, Cloneable { @Override public abstract boolean equals(Object o); + /** + * Perform match operation against given term. + * + * @param term + * the object to match + * @param binds + * variable bindings + * @return true if match succeeded + */ + public <T> boolean match(final OtpErlangObject term, final T binds) { + return equals(term); + } + + /** + * Make new Erlang term replacing variables with the respective values from + * bindings argument(s). + * + * @param binds + * variable bindings + * @return new term + * @throws OtpErlangException + */ + public <T> OtpErlangObject bind(final T binds) throws OtpErlangException { + return this; + } + @Override public int hashCode() { if (hashCodeValue == 0) { diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java index af2559e62e..ef0a453de1 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java @@ -236,6 +236,35 @@ public class OtpErlangTuple extends OtpErlangObject { } @Override + public <T> boolean match(final OtpErlangObject term, final T bindings) { + if (!(term instanceof OtpErlangTuple)) { + return false; + } + final OtpErlangTuple t = (OtpErlangTuple) term; + final int a = elems.length; + if (a != t.elems.length) { + return false; + } + for (int i = 0; i < a; i++) { + if (!elems[i].match(t.elems[i], bindings)) { + return false; + } + } + return true; + } + + @Override + public <T> OtpErlangObject bind(final T binds) throws OtpErlangException { + final OtpErlangTuple tuple = (OtpErlangTuple) this.clone(); + final int a = tuple.elems.length; + for (int i = 0; i < a; i++) { + final OtpErlangObject e = tuple.elems[i]; + tuple.elems[i] = e.bind(binds); + } + return tuple; + } + + @Override protected int doHashCode() { final OtpErlangObject.Hash hash = new OtpErlangObject.Hash(9); final int a = arity(); diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpLocalNode.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpLocalNode.java index b996ba6f6c..dd1d299297 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpLocalNode.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpLocalNode.java @@ -29,12 +29,7 @@ public class OtpLocalNode extends AbstractNode { private int refId[]; protected int port; - protected java.net.Socket epmd; - - protected OtpLocalNode() { - super(); - init(); - } + protected OtpTransport epmd; /** * Create a node with the given name and the default cookie. @@ -45,6 +40,16 @@ public class OtpLocalNode extends AbstractNode { } /** + * Create a node with the given name, transport factory and the default + * cookie. + */ + protected OtpLocalNode(final String node, + final OtpTransportFactory transportFactory) { + super(node, transportFactory); + init(); + } + + /** * Create a node with the given name and cookie. */ protected OtpLocalNode(final String node, final String cookie) { @@ -52,6 +57,15 @@ public class OtpLocalNode extends AbstractNode { init(); } + /** + * Create a node with the given name, cookie and transport factory. + */ + protected OtpLocalNode(final String node, final String cookie, + final OtpTransportFactory transportFactory) { + super(node, cookie, transportFactory); + init(); + } + private void init() { serial = 0; pidCount = 1; @@ -77,7 +91,7 @@ public class OtpLocalNode extends AbstractNode { * @param s * The socket connecting this node to Epmd. */ - protected void setEpmd(final java.net.Socket s) { + protected void setEpmd(final OtpTransport s) { epmd = s; } @@ -86,7 +100,7 @@ public class OtpLocalNode extends AbstractNode { * * @return The socket connecting this node to Epmd. */ - protected java.net.Socket getEpmd() { + protected OtpTransport getEpmd() { return epmd; } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpNode.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpNode.java index d5edd135cf..7512d34c21 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpNode.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpNode.java @@ -20,8 +20,6 @@ package com.ericsson.otp.erlang; import java.io.IOException; import java.lang.ref.WeakReference; -import java.net.ServerSocket; -import java.net.Socket; import java.util.Collection; import java.util.Enumeration; import java.util.Hashtable; @@ -97,7 +95,39 @@ public class OtpNode extends OtpLocalNode { * */ public OtpNode(final String node) throws IOException { - this(node, defaultCookie, 0); + super(node); + + init(0); + } + + /** + * <p> + * Create a node using the default cookie. The default cookie is found by + * reading the first line of the .erlang.cookie file in the user's home + * directory. The home directory is obtained from the System property + * "user.home". + * </p> + * + * <p> + * If the file does not exist, an empty string is used. This method makes no + * attempt to create the file. + * </p> + * + * @param node + * the name of this node. + * + * @param transportFactory + * the transport factory to use when creating connections. + * + * @exception IOException + * if communication could not be initialized. + * + */ + public OtpNode(final String node, + final OtpTransportFactory transportFactory) throws IOException { + super(node, transportFactory); + + init(0); } /** @@ -128,6 +158,28 @@ public class OtpNode extends OtpLocalNode { * the authorization cookie that will be used by this node when * it communicates with other nodes. * + * @param transportFactory + * the transport factory to use when creating connections. + * + * @exception IOException + * if communication could not be initialized. + * + */ + public OtpNode(final String node, final String cookie, + final OtpTransportFactory transportFactory) throws IOException { + this(node, cookie, 0, transportFactory); + } + + /** + * Create a node. + * + * @param node + * the name of this node. + * + * @param cookie + * the authorization cookie that will be used by this node when + * it communicates with other nodes. + * * @param port * the port number you wish to use for incoming connections. * Specifying 0 lets the system choose an available port. @@ -143,6 +195,34 @@ public class OtpNode extends OtpLocalNode { init(port); } + /** + * Create a node. + * + * @param node + * the name of this node. + * + * @param cookie + * the authorization cookie that will be used by this node when + * it communicates with other nodes. + * + * @param port + * the port number you wish to use for incoming connections. + * Specifying 0 lets the system choose an available port. + * + * @param transportFactory + * the transport factory to use when creating connections. + * + * @exception IOException + * if communication could not be initialized. + * + */ + public OtpNode(final String node, final String cookie, final int port, + final OtpTransportFactory transportFactory) throws IOException { + super(node, cookie, transportFactory); + + init(port); + } + private synchronized void init(final int aport) throws IOException { if (!initDone) { connections = new Hashtable<String, OtpCookedConnection>(17, @@ -681,12 +761,12 @@ public class OtpNode extends OtpLocalNode { * this thread simply listens for incoming connections */ public class Acceptor extends Thread { - private final ServerSocket sock; + private final OtpServerTransport sock; private final int acceptorPort; private volatile boolean done = false; Acceptor(final int port) throws IOException { - sock = new ServerSocket(port); + sock = createServerTransport(port); acceptorPort = sock.getLocalPort(); OtpNode.this.port = acceptorPort; @@ -720,7 +800,7 @@ public class OtpNode extends OtpLocalNode { localStatus(node, false, null); } - private void closeSock(final ServerSocket s) { + private void closeSock(final OtpServerTransport s) { try { if (s != null) { s.close(); @@ -729,7 +809,7 @@ public class OtpNode extends OtpLocalNode { } } - private void closeSock(final Socket s) { + private void closeSock(final OtpTransport s) { try { if (s != null) { s.close(); @@ -744,7 +824,7 @@ public class OtpNode extends OtpLocalNode { @Override public void run() { - Socket newsock = null; + OtpTransport newsock = null; OtpCookedConnection conn = null; localStatus(node, true, null); diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java index b8493b57ff..2ec583ff5c 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java @@ -21,6 +21,7 @@ package com.ericsson.otp.erlang; // import java.io.OutputStream; import java.io.ByteArrayOutputStream; import java.io.IOException; +import java.io.OutputStream; import java.io.UnsupportedEncodingException; import java.math.BigDecimal; import java.math.BigInteger; @@ -202,6 +203,16 @@ public class OtpOutputStream extends ByteArrayOutputStream { super.count += len; } + @Override + public synchronized void writeTo(OutputStream out) throws IOException { + super.writeTo(out); + } + + public synchronized void writeToAndFlush(OutputStream out) throws IOException { + super.writeTo(out); + out.flush(); + } + /** * Write the low byte of a value to the stream. * @@ -887,7 +898,7 @@ public class OtpOutputStream extends ByteArrayOutputStream { if (oos.size() < 5) { // fast path for small terms try { - oos.writeTo(this); + oos.writeToAndFlush(this); // if the term is written as a compressed term, the output // stream is closed, so we do this here, too close(); diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpPeer.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpPeer.java index 2c79c04247..cb09b40f47 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpPeer.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpPeer.java @@ -32,8 +32,8 @@ public class OtpPeer extends AbstractNode { * common protocol version we both support */ - OtpPeer() { - super(); + OtpPeer(final OtpTransportFactory transportFactory) { + super(transportFactory); } /** @@ -47,6 +47,19 @@ public class OtpPeer extends AbstractNode { } /** + * Create a peer node with custom transport factory. + * + * @param node + * the name of the node. + * @param transportFactory + * custom transport factory + */ + public OtpPeer(final String node, final OtpTransportFactory + transportFactory) { + super(node, transportFactory); + } + + /** * Create a connection to a remote node. * * @param self diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSelf.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSelf.java index 166dac5701..5b9d13ad81 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSelf.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSelf.java @@ -19,8 +19,6 @@ package com.ericsson.otp.erlang; import java.io.IOException; -import java.net.ServerSocket; -import java.net.Socket; import java.net.UnknownHostException; /** @@ -48,7 +46,7 @@ import java.net.UnknownHostException; * */ public class OtpSelf extends OtpLocalNode { - private final ServerSocket sock; + private final OtpServerTransport sock; private final OtpErlangPid pid; /** @@ -67,12 +65,43 @@ public class OtpSelf extends OtpLocalNode { * @param node * the name of this node. * + * @exception IOException + * in case of server transport failure + * */ public OtpSelf(final String node) throws IOException { this(node, defaultCookie, 0); } /** + * <p> + * Create a self node using the default cookie and custom transport factory. + * The default cookie is found by reading the first line of the + * .erlang.cookie file in the user's home directory. The home directory is + * obtained from the System property "user.home". + * </p> + * + * <p> + * If the file does not exist, an empty string is used. This method makes no + * attempt to create the file. + * </p> + * + * @param node + * the name of this node. + * + * @param transportFactory + * the transport factory to use when creating connections. + * + * @exception IOException + * in case of server transport failure + * + */ + public OtpSelf(final String node, + final OtpTransportFactory transportFactory) throws IOException { + this(node, defaultCookie, 0, transportFactory); + } + + /** * Create a self node. * * @param node @@ -81,16 +110,95 @@ public class OtpSelf extends OtpLocalNode { * @param cookie * the authorization cookie that will be used by this node when * it communicates with other nodes. + * + * @exception IOException + * in case of server transport failure */ public OtpSelf(final String node, final String cookie) throws IOException { this(node, cookie, 0); } + /** + * Create a self node. + * + * @param node + * the name of this node. + * + * @param cookie + * the authorization cookie that will be used by this node when + * it communicates with other nodes. + * + * @param transportFactory + * the transport factory to use when creating connections. + * + * @exception IOException + * in case of server transport failure + */ + public OtpSelf(final String node, final String cookie, + final OtpTransportFactory transportFactory) throws IOException { + this(node, cookie, 0, transportFactory); + } + + /** + * Create a self node. + * + * @param node + * the name of this node. + * + * @param cookie + * the authorization cookie that will be used by this node when + * it communicates with other nodes. + * + * @param port + * the port number you wish to use for incoming connections. + * Specifying 0 lets the system choose an available port. + * + * @param transportFactory + * the transport factory to use when creating connections. + * + * @exception IOException + * in case of server transport failure + */ public OtpSelf(final String node, final String cookie, final int port) throws IOException { super(node, cookie); - sock = new ServerSocket(port); + sock = createServerTransport(port); + + if (port != 0) { + this.port = port; + } else { + this.port = sock.getLocalPort(); + } + + pid = createPid(); + } + + /** + * Create a self node. + * + * @param node + * the name of this node. + * + * @param cookie + * the authorization cookie that will be used by this node when + * it communicates with other nodes. + * + * @param port + * the port number you wish to use for incoming connections. + * Specifying 0 lets the system choose an available port. + * + * @param transportFactory + * the transport factory to use when creating connections. + * + * @exception IOException + * in case of server transport failure + */ + public OtpSelf(final String node, final String cookie, final int port, + final OtpTransportFactory transportFactory) throws IOException { + super(node, cookie, transportFactory); + + sock = createServerTransport(port); if (port != 0) { this.port = port; @@ -179,7 +287,7 @@ public class OtpSelf extends OtpLocalNode { * authorized to connect. */ public OtpConnection accept() throws IOException, OtpAuthException { - Socket newsock = null; + OtpTransport newsock = null; while (true) { try { diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpServerSocketTransport.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpServerSocketTransport.java new file mode 100644 index 0000000000..0e25b6bfb7 --- /dev/null +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpServerSocketTransport.java @@ -0,0 +1,68 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +package com.ericsson.otp.erlang; + +import java.io.IOException; +import java.net.ServerSocket; +import java.net.Socket; + +/** + * Default socket-based server transport + * + * @author Dmitriy Kargapolov + */ +public class OtpServerSocketTransport implements OtpServerTransport { + + /** + * Underlying server socket + */ + private final ServerSocket socket; + + /** + * @see ServerSocket#ServerSocket(int) + */ + public OtpServerSocketTransport(final int port) throws IOException { + socket = new ServerSocket(port); + } + + /** + * @see ServerSocket#getLocalPort() + */ + public int getLocalPort() { + return socket.getLocalPort(); + } + + /** + * @see ServerSocket#accept() + */ + public OtpTransport accept() throws IOException { + final Socket sock = socket.accept(); + sock.setTcpNoDelay(true); + return new OtpSocketTransport(sock); + } + + /** + * @see ServerSocket#close() + */ + public void close() throws IOException { + socket.close(); + } + +} diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpServerTransport.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpServerTransport.java new file mode 100644 index 0000000000..4d31380bee --- /dev/null +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpServerTransport.java @@ -0,0 +1,46 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +package com.ericsson.otp.erlang; + +import java.io.IOException; +import java.net.ServerSocket; + +/** + * Server-side connection-oriented transport interface. + * + * @author Dmitriy Kargapolov + */ +public interface OtpServerTransport { + + /** + * @see ServerSocket#getLocalPort() + */ + int getLocalPort(); + + /** + * @see ServerSocket#accept() + */ + OtpTransport accept() throws IOException; + + /** + * @see ServerSocket#close() + */ + void close() throws IOException; +} diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSocketTransport.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSocketTransport.java new file mode 100644 index 0000000000..f690ab59ed --- /dev/null +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSocketTransport.java @@ -0,0 +1,89 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +package com.ericsson.otp.erlang; + +import java.io.IOException; +import java.io.InputStream; +import java.io.OutputStream; +import java.net.InetAddress; +import java.net.Socket; +import java.net.UnknownHostException; + +/** + * Default socket-based client transport + * + * @author Dmitriy Kargapolov + */ +public class OtpSocketTransport implements OtpTransport { + + /** + * Underlying socket + */ + private final Socket socket; + + /** + * @see Socket#Socket(String, int) + */ + public OtpSocketTransport(final String addr, final int port) + throws UnknownHostException, IOException { + socket = new Socket(addr, port); + socket.setTcpNoDelay(true); + } + + /** + * @see Socket#Socket(InetAddress, int) + */ + public OtpSocketTransport(final InetAddress addr, final int port) + throws UnknownHostException, IOException { + socket = new Socket(addr, port); + socket.setTcpNoDelay(true); + } + + /** + * Socket wrapping constructor + * + * @param s + * socket to wrap + */ + public OtpSocketTransport(final Socket s) { + socket = s; + } + + /** + * @see Socket#getInputStream() + */ + public InputStream getInputStream() throws IOException { + return socket.getInputStream(); + } + + /** + * @see Socket#getOutputStream() + */ + public OutputStream getOutputStream() throws IOException { + return socket.getOutputStream(); + } + + /** + * @see Socket#close() + */ + public void close() throws IOException { + socket.close(); + } +} diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSocketTransportFactory.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSocketTransportFactory.java new file mode 100644 index 0000000000..f6b5bfc86d --- /dev/null +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpSocketTransportFactory.java @@ -0,0 +1,56 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +package com.ericsson.otp.erlang; + +import java.io.IOException; +import java.net.InetAddress; + +/** + * Default socket-based transport factory + * + * @author Dmitriy Kargapolov + */ +public class OtpSocketTransportFactory implements OtpTransportFactory { + + /** + * @see OtpTransportFactory#createTransport(String, int) + */ + public OtpTransport createTransport(final String addr, final int port) + throws IOException { + return new OtpSocketTransport(addr, port); + } + + /** + * @see OtpTransportFactory#createTransport(InetAddress, int) + */ + public OtpTransport createTransport(final InetAddress addr, final int port) + throws IOException { + return new OtpSocketTransport(addr, port); + } + + /** + * @see OtpTransportFactory#createServerTransport(int) + */ + public OtpServerTransport createServerTransport(final int port) + throws IOException { + return new OtpServerSocketTransport(port); + } + +} diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpTransport.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpTransport.java new file mode 100644 index 0000000000..51c62d9ef0 --- /dev/null +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpTransport.java @@ -0,0 +1,49 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +package com.ericsson.otp.erlang; + +import java.io.IOException; +import java.io.InputStream; +import java.io.OutputStream; +import java.net.Socket; + +/** + * Client-side connection-oriented transport interface. + * + * @author Dmitriy Kargapolov + */ +public interface OtpTransport { + + /** + * @see Socket#getInputStream() + */ + public abstract InputStream getInputStream() throws IOException; + + /** + * @see Socket#getOutputStream() + */ + public abstract OutputStream getOutputStream() throws IOException; + + /** + * @see Socket#close() + */ + public abstract void close() throws IOException; + +} diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpTransportFactory.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpTransportFactory.java new file mode 100644 index 0000000000..bd404daea5 --- /dev/null +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpTransportFactory.java @@ -0,0 +1,124 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +package com.ericsson.otp.erlang; + +import java.io.IOException; +import java.net.InetAddress; + +/** + * Factory class used to create client- and server-side transport instances. One + * static instance of class implementing this interface is created when program + * loaded. Default implementation used is {@link OtpSocketTransportFactory}. + * JInterface user can specify custom transport factory implementing this + * interface in the following ways: + * <dl> + * <dt>defining static class as internal to class holding main() method</dt> + * <dd>In the systems, where main class can be retrieved with + * <code>System.getProperty("sun.java.command")</code>, user can define static + * class <b>OtpErlangSystemTuner</b> internal to the main class, providing at + * least one static method with the name <b>getOtpTransportFactory</b>, with no + * parameters, returning object of class implementing + * <b>OtpTransportFactory</b>, for example: + * + * <pre> + * + * public class MyMainClass { + * + * public static class OtpErlangSystemTuner { + * ... + * public static OtpTransportFactory getOtpTransportFactory() { + * return new MyTransportFactory(); + * } + * } + * + * public static class MyTransportFactory implements OtpTransportFactory { + * ... + * } + * + * public static void main(String[] args) { + * ... + * } + * } + * + * + * </pre> + * + * </dd> + * + * <dt>specifying factory class in the system properties</dt> + * <dd>User-defined transport factory class may be specified via system property + * <b>OtpTransportFactory</b>, for example: + * + * <pre> + * + * package com.my.company; + * + * public static class MyTransportFactory implements OtpTransportFactory { + * ... + * } + * </pre> + * + * In such case program may be run with + * -DOtpTransportFactory=com.my.company.MyTransportFactory, or other way of + * setting system property <i>before execution of static initializers</i> may be + * used.</dd> + * </dl> + * + * @author Dmitriy Kargapolov + */ +public interface OtpTransportFactory { + + /** + * Create instance of {@link OtpTransport} + * + * @param addr + * host name or IP address string + * @param port + * port number + * @return new socket object + * @throws IOException + */ + public abstract OtpTransport createTransport(String addr, int port) + throws IOException; + + /** + * Create instance of {@link OtpTransport} + * + * @param addr + * peer address + * @param port + * port number + * @return new socket object + * @throws IOException + */ + public abstract OtpTransport createTransport(InetAddress addr, int port) + throws IOException; + + /** + * Create instance of {@link OtpServerTransport} + * + * @param port + * port number to listen on + * @return new socket object + * @throws IOException + */ + public OtpServerTransport createServerTransport(int port) + throws IOException; +} diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/java_files b/lib/jinterface/java_src/com/ericsson/otp/erlang/java_files index 62fa7f990e..a0f19bc1aa 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/java_files +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/java_files @@ -53,7 +53,13 @@ COMM = \ OtpOutputStream \ OtpPeer \ OtpSelf \ - OtpServer + OtpServer \ + OtpServerSocketTransport \ + OtpServerTransport \ + OtpSocketTransport \ + OtpSocketTransportFactory \ + OtpTransport \ + OtpTransportFactory ERL = \ OtpErlangAtom \ diff --git a/lib/jinterface/test/jinterface_SUITE.erl b/lib/jinterface/test/jinterface_SUITE.erl index 00abc97ff5..73bab98559 100644 --- a/lib/jinterface/test/jinterface_SUITE.erl +++ b/lib/jinterface/test/jinterface_SUITE.erl @@ -22,7 +22,8 @@ init_per_suite/1, end_per_suite/1, init_per_testcase/2, end_per_testcase/2]). --export([nodename/1, register_and_whereis/1, get_names/1, boolean_atom/1, +-export([transport_factory/1, + nodename/1, register_and_whereis/1, get_names/1, boolean_atom/1, node_ping/1, mbox_ping/1, java_erlang_send_receive/1, java_internal_send_receive_same_node/1, @@ -39,7 +40,8 @@ status_handler_localStatus/1, status_handler_remoteStatus/1, status_handler_connAttempt/1, maps/1, - fun_equals/1 + fun_equals/1, + core_match_bind/1 ]). -include_lib("common_test/include/ct.hrl"). @@ -103,12 +105,14 @@ end_per_group(_GroupName, Config) -> fundamental() -> [ + transport_factory, % TransportFactoryTest.java nodename, % Nodename.java register_and_whereis, % RegisterAndWhereis.java get_names, % GetNames.java boolean_atom, % BooleanAtom.java maps, % Maps.java - fun_equals % FunEquals.java + fun_equals, % FunEquals.java + core_match_bind % CoreMatchBind.java ]. ping() -> @@ -201,6 +205,16 @@ end_per_testcase(_Case,Config) -> %%%----------------------------------------------------------------- %%% TEST CASES %%%----------------------------------------------------------------- +transport_factory(doc) -> + ["TransportFactoryTest.java: Test custom OTP Transport Factory"]; +transport_factory(suite) -> + []; +transport_factory(Config) when is_list(Config) -> + ok = jitu:java(?config(java, Config), + ?config(data_dir, Config), + "TransportFactoryTest"). + +%%%----------------------------------------------------------------- nodename(doc) -> ["Nodename.java: " "Test OtpNode.node(), OtpNode.alive() and OtpNode.host()"]; @@ -705,6 +719,18 @@ fun_equals(Config) when is_list(Config) -> []). %%%----------------------------------------------------------------- +core_match_bind(doc) -> + ["CoreMatchBind.java: " + "Test OtpErlangObject.match() and bind()"]; +core_match_bind(suite) -> + []; +core_match_bind(Config) when is_list(Config) -> + ok = jitu:java(?config(java, Config), + ?config(data_dir, Config), + "CoreMatchBind", + []). + +%%%----------------------------------------------------------------- %%% INTERNAL FUNCTIONS %%%----------------------------------------------------------------- send_receive(TestCaseTag,Fun,Config) -> diff --git a/lib/jinterface/test/jinterface_SUITE_data/CoreMatchBind.java b/lib/jinterface/test/jinterface_SUITE_data/CoreMatchBind.java new file mode 100644 index 0000000000..a78a63093e --- /dev/null +++ b/lib/jinterface/test/jinterface_SUITE_data/CoreMatchBind.java @@ -0,0 +1,584 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2015. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +import com.ericsson.otp.erlang.OtpErlangException; +import com.ericsson.otp.erlang.OtpErlangInt; +import com.ericsson.otp.erlang.OtpErlangList; +import com.ericsson.otp.erlang.OtpErlangMap; +import com.ericsson.otp.erlang.OtpErlangObject; +import com.ericsson.otp.erlang.OtpErlangTuple; +import com.ericsson.otp.erlang.OtpOutputStream; + +public class CoreMatchBind { + + @SuppressWarnings("serial") + private static class DumbObject extends OtpErlangObject { + + @Override + public String toString() { + return this.getClass().getSimpleName(); + } + + @Override + public void encode(final OtpOutputStream buf) { + fail("unexpected encode() call"); + } + + @Override + public boolean equals(final Object o) { + fail("unexpected equals() call"); + return false; + } + + } + + @SuppressWarnings("serial") + private static class BoundObject extends OtpErlangObject { + + @Override + public String toString() { + return this.getClass().getSimpleName(); + } + + @Override + public void encode(final OtpOutputStream buf) { + fail("unexpected encode() call"); + } + + @Override + public boolean equals(final Object o) { + fail("unexpected equals() call"); + return false; + } + + } + + @SuppressWarnings("serial") + private static class TestObject extends OtpErlangObject { + + private final Binder binder; + private DumbObject dumb; + private boolean flag; + private BoundObject obj; + + public TestObject(final boolean flag, final Binder binder, + final DumbObject dumb) { + this.flag = flag; + this.binder = binder; + this.dumb = dumb; + } + + public TestObject(final Binder binder, final BoundObject obj) { + this.binder = binder; + this.obj = obj; + } + + public DumbObject getDumb() { + return dumb; + } + + @Override + public String toString() { + return flag ? "T" : "F"; + } + + @Override + public void encode(final OtpOutputStream buf) { + fail("unexpected encode() call"); + } + + @Override + public boolean equals(final Object o) { + if (obj == null) { + fail("unexpected equals() call"); + } + return o == obj; + } + + @Override + public <T> boolean match(final OtpErlangObject term, final T binds) { + if (binds != binder) { + fail("invalid binder"); + } + if (term != dumb) { + fail("invalid object"); + } + return flag; + } + + @Override + public <T> OtpErlangObject bind(final T binds) + throws OtpErlangException { + if (binds != binder) { + fail("invalid binder"); + } + return obj; + } + + } + + /* + * "always matched" object + */ + @SuppressWarnings("serial") + private static class Any extends OtpErlangObject { + + @Override + public String toString() { + return "any"; + } + + @Override + public void encode(final OtpOutputStream buf) { + fail("unexpected encode() call"); + } + + @Override + public boolean equals(final Object o) { + fail("unexpected equals() call"); + return false; + } + + @Override + public <T> boolean match(final OtpErlangObject term, final T binds) { + return true; + } + } + + private static class Binder { + // make object pair for match() testing + TestObject makeTest(final boolean flag) { + return new TestObject(flag, this, new DumbObject()); + } + + // make object pair for bind() testing + TestObject makeTest() { + return new TestObject(this, new BoundObject()); + } + } + + private static void isNotNull(final Object o) throws Exception { + if (o == null) { + throw new Exception("not null expected"); + } + } + + private static void fail(final String string) { + System.err.println(string); + new Throwable().printStackTrace(System.err); + System.exit(1); + } + + private static void isT(final boolean b) throws Exception { + if (!b) { + throw new Exception("true expected"); + } + } + + private static void isF(final boolean b) throws Exception { + if (b) { + throw new Exception("false expected"); + } + } + + private static void equals(final OtpErlangObject a, final OtpErlangObject b) + throws Exception { + if (!a.equals(b)) { + throw new Exception(a + " != " + b); + } + } + + /* + * scalar match test - match particular test object (producing given result) + * against particular dumb object passing particular bindings object; ensure + * all participants are used as expected in match behavior, check result. + */ + private static void scalar_match_test() throws Exception { + final Binder bind = new Binder(); + + final TestObject t = bind.makeTest(true); + isT(t.match(t.getDumb(), bind)); + + final TestObject f = bind.makeTest(false); + isF(f.match(f.getDumb(), bind)); + } + + /* + * scalar bind test - ensure right object generated based on bindings + */ + private static void scalar_bind_test() throws Exception { + final Binder bind = new Binder(); + final TestObject t = bind.makeTest(); + final OtpErlangObject o = t.bind(bind); + isNotNull(o); + equals(t, o); + } + + /* + * used by tuple_arity_match_test() + */ + private static OtpErlangObject mkTuplePattern(final int n) { + final Any a[] = new Any[n]; + for (int i = 0; i < n; i++) { + a[i] = new Any(); + } + return new OtpErlangTuple(a); + } + + /* + * used by tuple_arity_match_test() + */ + private static OtpErlangObject mkTupleObject(final int n) { + final DumbObject a[] = new DumbObject[n]; + for (int i = 0; i < n; i++) { + a[i] = new DumbObject(); + } + return new OtpErlangTuple(a); + } + + /* + * ensure only tuples of the same arity can match + */ + private static void tuple_arity_match_test(final int m, final int n) + throws Exception { + final Binder bind = new Binder(); + for (int i = m; i < n; i++) { + for (int j = m; j < n; j++) { + final OtpErlangObject p = mkTuplePattern(i); + final OtpErlangObject o = mkTupleObject(j); + if (i == j) { + isT(p.match(o, bind)); + } else { + isF(p.match(o, bind)); + } + } + } + } + + /* + * tuple match test - ensure elements of tuple are matched to corresponding + * elements of tested object and result is logical "and" over all elements. + */ + private static void tuple_match_test(final int n) throws Exception { + final Binder bind = new Binder(); + final int max = 1 << n; + final TestObject a[] = new TestObject[n]; + final DumbObject d[] = new DumbObject[n]; + for (int k = 0; k < max; k++) { + for (int m = 1, i = 0; m < max; m = m << 1, i++) { + d[i] = new DumbObject(); + a[i] = new TestObject((k & m) != 0, bind, d[i]); + } + final OtpErlangObject tpl = new OtpErlangTuple(a); + final OtpErlangObject obj = new OtpErlangTuple(d); + if (k + 1 < max) { + isF(tpl.match(obj, bind)); + } else { + isT(tpl.match(obj, bind)); + } + } + } + + /* + * tuple bind test - ensure result is a tuple where each element is a result + * of binding of corresponding pattern element using provided bindings. + */ + private static void tuple_bind_test(final int n) throws Exception { + final Binder bind = new Binder(); + final TestObject a[] = new TestObject[n]; + final OtpErlangObject b[] = new OtpErlangObject[n]; + for (int i = 0; i < n; i++) { + a[i] = bind.makeTest(); + b[i] = a[i].obj; + } + final OtpErlangObject t = new OtpErlangTuple(a); + final OtpErlangObject o = t.bind(bind); + isNotNull(o); + equals(t, o); + } + + private static OtpErlangObject mkListPattern(final int n, final boolean tail) + throws OtpErlangException { + final Any a[] = new Any[n]; + for (int i = 0; i < n; i++) { + a[i] = new Any(); + } + return tail ? new OtpErlangList(a, new Any()) : new OtpErlangList(a); + } + + private static OtpErlangObject mkListObject(final int n, final boolean tail) + throws OtpErlangException { + final DumbObject a[] = new DumbObject[n]; + for (int i = 0; i < n; i++) { + a[i] = new DumbObject(); + } + return tail ? new OtpErlangList(a, new DumbObject()) + : new OtpErlangList(a); + } + + /* + * ensure only lists of the same arity and same tail presence can match + */ + private static void list_arity_match_test(final int m, final int n) + throws Exception { + final Binder bind = new Binder(); + for (int i = m; i < n; i++) { + for (int j = m; j < n; j++) { + for (int k = 0; k < 2; k++) { + if (i == 0 && k == 1) { + continue; + } + for (int l = 0; l < 2; l++) { + if (j == 0 && l == 1) { + continue; + } + final OtpErlangObject p = mkListPattern(i, k == 1); + final OtpErlangObject o = mkListObject(j, l == 1); + if (i == j && k == l || k == 1 && i <= j) { + isT(p.match(o, bind)); + } else { + isF(p.match(o, bind)); + } + } + } + } + } + } + + /* + * lists match test - ensure elements of lists are matched to corresponding + * elements of tested object and result is logical "and" over all elements, + * count tails as well + */ + private static void list_match_test(final int n) throws Exception { + final Binder bind = new Binder(); + final int max = 1 << n; + final TestObject a[] = new TestObject[n]; + final DumbObject d[] = new DumbObject[n]; + final DumbObject e[] = new DumbObject[n + 1]; + for (int k = 0; k < max; k++) { + for (int m = 1, i = 0; m < max; m = m << 1, i++) { + d[i] = new DumbObject(); + e[i] = d[i]; + a[i] = new TestObject((k & m) != 0, bind, d[i]); + } + for (int i = n; i < n + 1; i++) { + e[i] = new DumbObject(); + } + final OtpErlangObject lst = new OtpErlangList(a); + final OtpErlangObject obj = new OtpErlangList(d); + final OtpErlangObject ext = new OtpErlangList(e); + final OtpErlangObject eTl = new OtpErlangList(e, new DumbObject()); + + if (n > 0) { + final DumbObject dTail = new DumbObject(); + final TestObject tTail = new TestObject(true, bind, dTail); + final TestObject fTail = new TestObject(false, bind, dTail); + final OtpErlangObject fTailLst = new OtpErlangList(a, fTail); + final OtpErlangObject tTailLst = new OtpErlangList(a, tTail); + final OtpErlangObject tailObj = new OtpErlangList(d, dTail); + + // match lists with non-matching tails is always false + isF(fTailLst.match(tailObj, bind)); + + // match list with no tail to list with tail is always false + isF(lst.match(tailObj, bind)); + + // matching lists with matching tails + if (k + 1 < max) { + isF(tTailLst.match(tailObj, bind)); + } else { + isT(tTailLst.match(tailObj, bind)); + } + + // matching shorter pattern with last tail to longer list + // with or with no extra tail; matching list pattern + // with last tail to same length list with no tail. + final Any aTail = new Any(); + final OtpErlangObject shortLst = new OtpErlangList(a, aTail); + if (k + 1 < max) { + isF(shortLst.match(obj, bind)); // same arity + isF(shortLst.match(ext, bind)); // pattern arity is less + isF(shortLst.match(eTl, bind)); // + } else { + isT(shortLst.match(obj, bind)); // same arity + isT(shortLst.match(ext, bind)); // pattern arity is less + isT(shortLst.match(eTl, bind)); // + } + } + + // matching lists with no tails + if (k + 1 < max) { + isF(lst.match(obj, bind)); + } else { + isT(lst.match(obj, bind)); + } + + // extra-length object, no tail in "pattern" + isF(lst.match(ext, bind)); + } + } + + /* + * list bind test - ensure result is a list where each element is a result + * of binding of corresponding pattern element using provided bindings. + */ + private static void list_bind_test(final int n) throws Exception { + final Binder bind = new Binder(); + final TestObject a[] = new TestObject[n]; + final OtpErlangObject b[] = new OtpErlangObject[n]; + for (int i = 0; i < n; i++) { + a[i] = bind.makeTest(); + b[i] = a[i].obj; + } + OtpErlangObject t = new OtpErlangList(a); + OtpErlangObject o = t.bind(bind); + isNotNull(o); + equals(t, o); + if (n > 0) { + // improper list case + t = new OtpErlangList(a, bind.makeTest()); + o = t.bind(bind); + isNotNull(o); + equals(t, o); + } + } + + /* + * map match test - object may have more keys than pattern + */ + private static void map_match_test(final int m, final int n) + throws Exception { + final Binder bind = new Binder(); + + // pattern side - m elements + final OtpErlangObject k1[] = new OtpErlangObject[m]; + final TestObject a[] = new TestObject[m]; + + // object side - n elements + final OtpErlangObject k2[] = new OtpErlangObject[n]; + final DumbObject d[] = new DumbObject[n]; + + final int max = Math.max(m, n); + final int mskHi = 1 << max; + final int full = (1 << m) - 1; + for (int k = 0; k < mskHi; k++) { + for (int msk = 1, i = 0; msk < mskHi; msk = msk << 1, i++) { + if (i < n) { + k2[i] = new OtpErlangInt(i); + d[i] = new DumbObject(); + } + if (i < m) { + k1[i] = new OtpErlangInt(i); + a[i] = new TestObject((k & msk) != 0, bind, i < n ? d[i] + : new DumbObject()); + } + } + final OtpErlangObject map = new OtpErlangMap(k1, a); // m items + final OtpErlangObject obj = new OtpErlangMap(k2, d); // n items + if ((k & full) == full && m <= n) { + isT(map.match(obj, bind)); + } else { + isF(map.match(obj, bind)); + } + } + } + + /* + * map bind test - ensure result is a map where each element is a result of + * binding of corresponding pattern element using provided bindings. + */ + private static void map_bind_test(final int n) throws Exception { + final Binder bind = new Binder(); + final TestObject a[] = new TestObject[n]; + final OtpErlangObject b[] = new OtpErlangObject[n]; + final OtpErlangObject k[] = new OtpErlangObject[n]; + for (int i = 0; i < n; i++) { + a[i] = bind.makeTest(); + b[i] = a[i].obj; + k[i] = new OtpErlangInt(i); + } + final OtpErlangObject t = new OtpErlangMap(k, a); + final OtpErlangObject o = t.bind(bind); + isNotNull(o); + equals(t, o); + } + + public static void main(final String[] args) { + try { + scalar_match_test(); + System.out.println("scalar_match_test() passed"); + + scalar_bind_test(); + System.out.println("scalar_bind_test() passed"); + + for (int m = 0; m < 16; m++) { + for (int n = 0; n < 16; n++) { + tuple_arity_match_test(m, n); + } + } + System.out.println("tuple_arity_match_test() passed"); + + for (int n = 0; n < 16; n++) { + tuple_match_test(n); + } + System.out.println("tuple_match_test() passed"); + + for (int n = 0; n < 16; n++) { + tuple_bind_test(n); + } + System.out.println("tuple_bind_test() passed"); + + for (int m = 0; m < 16; m++) { + for (int n = 0; n < 16; n++) { + list_arity_match_test(m, n); + } + } + System.out.println("list_arity_match_test() passed"); + + for (int n = 0; n < 16; n++) { + list_match_test(n); + } + System.out.println("list_match_test() passed"); + + for (int n = 0; n < 16; n++) { + list_bind_test(n); + } + System.out.println("list_bind_test() passed"); + + for (int m = 0; m < 12; m++) { + for (int n = 0; n < 12; n++) { + map_match_test(m, n); + } + } + System.out.println("map_match_test() passed"); + + for (int n = 0; n < 16; n++) { + map_bind_test(n); + } + System.out.println("map_bind_test() passed"); + + } catch (final Exception e) { + e.printStackTrace(); + System.exit(1); + } + + System.out.println("ok"); + } +} diff --git a/lib/jinterface/test/jinterface_SUITE_data/Makefile.src b/lib/jinterface/test/jinterface_SUITE_data/Makefile.src index cd68f1ead5..a4a69000c6 100644 --- a/lib/jinterface/test/jinterface_SUITE_data/Makefile.src +++ b/lib/jinterface/test/jinterface_SUITE_data/Makefile.src @@ -38,6 +38,7 @@ JINTERFACE_CLASSPATH = @jinterface_classpath@ CLASSPATH = .@PS@$(JINTERFACE_CLASSPATH)@PS@ JAVA_FILES = \ + TransportFactoryTest.java \ Nodename.java \ RegisterAndWhereis.java \ GetNames.java \ @@ -48,7 +49,8 @@ JAVA_FILES = \ MboxLinkUnlink.java \ NodeStatusHandler.java \ Maps.java \ - FunEquals.java + FunEquals.java \ + CoreMatchBind.java CLASS_FILES = $(JAVA_FILES:.java=.class) diff --git a/lib/jinterface/test/jinterface_SUITE_data/TransportFactoryTest.java b/lib/jinterface/test/jinterface_SUITE_data/TransportFactoryTest.java new file mode 100644 index 0000000000..367e28a512 --- /dev/null +++ b/lib/jinterface/test/jinterface_SUITE_data/TransportFactoryTest.java @@ -0,0 +1,90 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2015. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +import java.io.IOException; +import java.net.InetAddress; + +import com.ericsson.otp.erlang.OtpSelf; +import com.ericsson.otp.erlang.OtpServerTransport; +import com.ericsson.otp.erlang.OtpSocketTransportFactory; +import com.ericsson.otp.erlang.OtpTransport; +import com.ericsson.otp.erlang.OtpTransportFactory; + +/** + * @author Dmitriy Kargapolov + */ +public class TransportFactoryTest { + + /** + * example of custom transport factory wrapping default one + */ + public static class TransportFactory implements OtpTransportFactory { + + OtpSocketTransportFactory tf = new OtpSocketTransportFactory(); + + public OtpTransport createTransport(final String addr, final int port) + throws IOException { + clientOk = true; + System.out.println("creating transport to " + addr + ", " + port); + return tf.createTransport(addr, port); + } + + public OtpTransport createTransport(final InetAddress addr, + final int port) throws IOException { + clientOk = true; + System.out.println("creating transport to " + addr + ", " + port); + return tf.createTransport(addr, port); + } + + public OtpServerTransport createServerTransport(final int port) + throws IOException { + serverOk = true; + System.out.println("creating server transport to " + port); + return tf.createServerTransport(port); + } + + } + + static boolean serverOk = false; + static boolean clientOk = false; + + public static void main(final String[] args) throws IOException { + + // check server transport + final OtpSelf self = new OtpSelf("local", new TransportFactory()); + if (!serverOk) { + fail("custom server transport was not created"); + } + System.out.println("accepting connections on " + self.port()); + + // check client transport + try { + self.publishPort(); + } catch (final Exception e) { + } + if (!clientOk) { + fail("custom client transport was not created"); + } + } + + private static void fail(final String string) { + System.err.println(string); + System.exit(1); + } +} diff --git a/lib/jinterface/test/jitu.erl b/lib/jinterface/test/jitu.erl index b68dfd0351..8097237af6 100644 --- a/lib/jinterface/test/jitu.erl +++ b/lib/jinterface/test/jitu.erl @@ -117,7 +117,7 @@ classpath(Dir) -> end, es(Dir++PS++ filename:join([code:lib_dir(jinterface),"priv","OtpErlang.jar"])++PS++ - os:getenv("CLASSPATH", "") end, + os:getenv("CLASSPATH", ""), Quote, EscSpace). diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml index 3ec33d2f18..a424d2978e 100644 --- a/lib/kernel/doc/src/heart.xml +++ b/lib/kernel/doc/src/heart.xml @@ -78,6 +78,16 @@ <pre> % <input>erl -heart -env ERL_CRASH_DUMP_SECONDS 10 ...</input></pre> + + <p> If a regular core dump is wanted, let heart know by setting the kill signal to abort + using the environment variable <c><![CDATA[HEART_KILL_SIGNAL=SIGABRT]]></c>. + If unset, or not set to <c><![CDATA[SIGABRT]]></c>, the default behaviour will be a kill + signal using <c><![CDATA[SIGKILL]]></c>. + </p> + + <pre> +% <input>erl -heart -env HEART_KILL_SIGNAL SIGABRT ...</input></pre> + <p> Furthermore, <c><![CDATA[ERL_CRASH_DUMP_SECONDS]]></c> has the following behaviour on <c>heart</c>: diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index 1ef106e17a..6f7f18a8e7 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -30,6 +30,54 @@ </header> <p>This document describes the changes made to the Kernel application.</p> +<section><title>Kernel 3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A bug causing an infinite loop in hostname resolving has + been corrected. To trigger this bug you would have to + enter an bogus search method from a configuration file + e.g .inetrc.</p> + <p> + Bug pinpointed by Emil Holmström</p> + <p> + Own Id: OTP-12133</p> + </item> + <item> + <p> + The standard_error process now handles the getopts I/O + protocol request correctly and stores its encoding in the + same way as standard_io.</p> + <p> + Also, io:put_chars(standard_error, [oops]) could + previously crash the standard_error process. This is now + corrected.</p> + <p> + Own Id: OTP-12424</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Configuration parameters for the Kernel application that + allows setting socket options for the distribution + sockets have been added. See the application Kernel + documentation; parameters 'inet_dist_listen_options' and + 'inet_dist_connect_options'.</p> + <p> + Own Id: OTP-12476 Aux Id: OTP-12476 </p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 3.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml index 8b85f24455..b9dbede0d3 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -142,14 +142,49 @@ DirOut = os:cmd("dir"), % on Win32 platform</code> </desc> </func> <func> + <name name="system_time" arity="0"/> + <fsummary>Current OS system time</fsummary> + <desc> + <p>Returns current + <seealso marker="erts:time_correction#OS_System_Time">OS system time</seealso> + in <c>native</c> + <seealso marker="erts:erlang#type_time_unit">time unit</seealso>.</p> + + <note><p>This time is <em>not</em> a monotonically increasing time.</p></note> + </desc> + </func> + <func> + <name name="system_time" arity="1"/> + <fsummary>Current OS system time</fsummary> + <desc> + <p>Returns current + <seealso marker="erts:time_correction#OS_System_Time">OS system time</seealso> + converted into the <c><anno>Unit</anno></c> passed as argument.</p> + + <p>Calling <c>os:system_time(<anno>Unit</anno>)</c> is equivalent to: + <seealso marker="erts:erlang#convert_time_unit/3"><c>erlang:convert_time_unit</c></seealso><c>(</c><seealso marker="#system_time/0"><c>os:system_time()</c></seealso><c>, + native, <anno>Unit</anno>)</c>.</p> + + <note><p>This time is <em>not</em> a monotonically increasing time.</p></note> + </desc> + </func> + <func> <name name="timestamp" arity="0"/> <type_desc variable="Timestamp">Timestamp = {MegaSecs, Secs, MicroSecs}</type_desc> - <fsummary>Returna a timestamp from the OS in the erlang:now/0 format</fsummary> + <fsummary>Current OS system time on the erlang:timestamp/0 format</fsummary> <desc> - <p>Returns a tuple in the same format as <seealso marker="erts:erlang#now/0">erlang:now/0</seealso>. The difference is that this function returns what the operating system thinks (a.k.a. the wall clock time) without any attempts at time correction. The result of two different calls to this function is <em>not</em> guaranteed to be different.</p> - <p>The most obvious use for this function is logging. The tuple can be used together with the function <seealso marker="stdlib:calendar#now_to_universal_time/1">calendar:now_to_universal_time/1</seealso> -or <seealso marker="stdlib:calendar#now_to_local_time/1">calendar:now_to_local_time/1</seealso> to get calendar time. Using the calendar time together with the <c>MicroSecs</c> part of the return tuple from this function allows you to log timestamps in high resolution and consistent with the time in the rest of the operating system.</p> - <p>Example of code formatting a string in the format "DD Mon YYYY HH:MM:SS.mmmmmm", where DD is the day of month, Mon is the textual month name, YYYY is the year, HH:MM:SS is the time and mmmmmm is the microseconds in six positions:</p> + <p>Returns current + <seealso marker="erts:time_correction#OS_System_Time">OS system time</seealso> + in the same format as <seealso marker="erts:erlang#timestamp/0">erlang:timestamp/0</seealso>. + The tuple can be used together with the function + <seealso marker="stdlib:calendar#now_to_universal_time/1">calendar:now_to_universal_time/1</seealso> + or <seealso marker="stdlib:calendar#now_to_local_time/1">calendar:now_to_local_time/1</seealso> to + get calendar time. Using the calendar time together with the <c>MicroSecs</c> part of the return + tuple from this function allows you to log timestamps in high resolution and consistent with the + time in the rest of the operating system.</p> + <p>Example of code formatting a string in the format "DD Mon YYYY HH:MM:SS.mmmmmm", where + DD is the day of month, Mon is the textual month name, YYYY is the year, HH:MM:SS is the time and + mmmmmm is the microseconds in six positions:</p> <code> -module(print_time). -export([format_utc_timestamp/0]). @@ -168,6 +203,9 @@ format_utc_timestamp() -> 1> <input>io:format("~s~n",[print_time:format_utc_timestamp()]).</input> 29 Apr 2009 9:55:30.051711 </pre> + <p>OS system time can also be retreived by + <c><seealso marker="#system_time/0"><c>os:system_time/0</c></seealso></c>, + and <seealso marker="#system_time/1"><c>os:system_time/1</c></seealso>.</p> </desc> </func> <func> diff --git a/lib/kernel/src/auth.erl b/lib/kernel/src/auth.erl index eda35147d3..dbc486bee1 100644 --- a/lib/kernel/src/auth.erl +++ b/lib/kernel/src/auth.erl @@ -370,8 +370,8 @@ check_cookie1([], Result) -> %% Creates a new, random cookie. create_cookie(Name) -> - {_, S1, S2} = now(), - Seed = S2*10000+S1, + Seed = abs(erlang:monotonic_time() + bxor erlang:unique_integer()), Cookie = random_cookie(20, Seed, []), case file:open(Name, [write, raw]) of {ok, File} -> diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 0eda558ed5..d73d1ff281 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -339,7 +339,7 @@ do_start(Flags) -> ok end, %% Quietly load native code for all modules loaded so far - catch load_native_code_for_all_loaded(), + load_native_code_for_all_loaded(), Ok2; Other -> Other @@ -550,18 +550,42 @@ has_ext(Ext, Extlen, File) -> _ -> false end. +%%% +%%% Silently load native code for all modules loaded so far. +%%% + -spec load_native_code_for_all_loaded() -> ok. load_native_code_for_all_loaded() -> Architecture = erlang:system_info(hipe_architecture), - ChunkName = hipe_unified_loader:chunk_name(Architecture), - lists:foreach(fun({Module, BeamFilename}) -> - case code:is_module_native(Module) of - false -> - case beam_lib:chunks(BeamFilename, [ChunkName]) of - {ok,{_,[{_,Bin}]}} when is_binary(Bin) -> - load_native_partial(Module, Bin); - {error, beam_lib, _} -> ok - end; - true -> ok - end - end, all_loaded()). + try hipe_unified_loader:chunk_name(Architecture) of + ChunkTag -> + Loaded = all_loaded(), + spawn(fun() -> load_all_native(Loaded, ChunkTag) end) + catch + _:_ -> + ok + end, + ok. + +load_all_native(Loaded, ChunkTag) -> + catch load_all_native_1(Loaded, ChunkTag). + +load_all_native_1([{_,preloaded}|T], ChunkTag) -> + load_all_native_1(T, ChunkTag); +load_all_native_1([{Mod,BeamFilename}|T], ChunkTag) -> + case code:is_module_native(Mod) of + false -> + %% prim_file is faster than file and the file server may + %% not be started yet. + {ok,Beam} = prim_file:read_file(BeamFilename), + case code:get_chunk(Beam, ChunkTag) of + undefined -> + ok; + NativeCode when is_binary(NativeCode) -> + load_native_partial(Mod, NativeCode) + end; + true -> ok + end, + load_all_native_1(T, ChunkTag); +load_all_native_1([], _) -> + ok. diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index b127fe2e33..6b510bd0c3 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -298,7 +298,7 @@ shutdown(_Module, _Line, _Data, Reason) -> exit(Reason). %% Use this line to debug connection. %% Set net_kernel verbose = 1 as well. -%% exit({Reason, ?MODULE, _Line, _Data, erlang:now()}). +%% exit({Reason, ?MODULE, _Line, _Data, erlang:timestamp()}). flush_down() -> @@ -373,7 +373,9 @@ gen_digest(Challenge, Cookie) when is_integer(Challenge), is_atom(Cookie) -> %% gen_challenge() returns a "random" number %% --------------------------------------------------------------- gen_challenge() -> - {A,B,C} = erlang:now(), + A = erlang:phash2([erlang:node()]), + B = erlang:monotonic_time(), + C = erlang:unique_integer(), {D,_} = erlang:statistics(reductions), {E,_} = erlang:statistics(runtime), {F,_} = erlang:statistics(wall_clock), diff --git a/lib/kernel/src/erl_distribution.erl b/lib/kernel/src/erl_distribution.erl index 25ad34357a..3c4429129e 100644 --- a/lib/kernel/src/erl_distribution.erl +++ b/lib/kernel/src/erl_distribution.erl @@ -22,7 +22,6 @@ -export([start_link/0,start_link/1,init/1,start/1,stop/0]). -%-define(DBG,io:format("~p:~p~n",[?MODULE,?LINE])). -define(DBG,erlang:display([?MODULE,?LINE])). start_link() -> diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index ef605d0bfe..8f81fcf825 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -20,7 +20,7 @@ %% Low-level debugging support. EXPERIMENTAL! --export([size/1,df/1,df/2,df/3]). +-export([size/1,df/1,df/2,df/3,ic/1]). %% This module contains the following *experimental* BIFs: %% disassemble/1 @@ -33,7 +33,7 @@ -export([breakpoint/2, disassemble/1, display/1, dist_ext_to_term/2, dump_monitors/1, dump_links/1, flat_size/1, get_internal_state/1, instructions/0, lock_counters/1, - same/2, set_internal_state/2]). + map_info/1, same/2, set_internal_state/2]). -spec breakpoint(MFA, Flag) -> non_neg_integer() when MFA :: {Module :: module(), @@ -114,6 +114,19 @@ get_internal_state(_) -> instructions() -> erlang:nif_error(undef). +-spec ic(F) -> Result when + F :: function(), + Result :: term(). + +ic(F) when is_function(F) -> + Is0 = erlang:system_info(instruction_counts), + R = F(), + Is1 = erlang:system_info(instruction_counts), + Is = lists:keysort(2,[{I,C1 - C0}||{{I,C1},{I,C0}} <- lists:zip(Is1,Is0)]), + _ = [io:format("~12w ~w~n", [C,I])||{I,C}<-Is], + io:format("Total: ~w~n",[lists:sum([C||{_I,C}<-Is])]), + R. + -spec lock_counters(info) -> term(); (clear) -> ok; ({copy_save, boolean()}) -> boolean(); @@ -164,8 +177,10 @@ set_internal_state(_, _) -> -spec size(term()) -> non_neg_integer(). +-record(s, {seen, maps}). + size(Term) -> - {Sum,_} = size(Term, gb_trees:empty(), 0), + {Sum,_} = size(Term, #s{seen=gb_trees:empty(),maps=[]}, 0), Sum. size([H|T]=Term, Seen0, Sum0) -> @@ -209,10 +224,24 @@ tuple_size(I, Sz, Tuple, Seen0, Sum0) -> tuple_size(I+1, Sz, Tuple, Seen, Sum). map_size(Map,Seen0,Sum0) -> - Kt = erts_internal:map_to_tuple_keys(Map), - Vs = maps:values(Map), - {Sum1,Seen1} = size(Kt,Seen0,Sum0), - fold_size(Vs,Seen1,Sum1+length(Vs)+3). + %% Danger: + %% The internal nodes from erts_internal:map_hashmap_children/1 + %% is not allowed to leak anywhere. They are only allowed in + %% containers (cons cells and tuples, not maps), in gc and + %% in erts_debug:same/2 + case erts_internal:map_type(Map) of + flatmap -> + Kt = erts_internal:map_to_tuple_keys(Map), + Vs = maps:values(Map), + {Sum1,Seen1} = size(Kt,Seen0,Sum0), + fold_size(Vs,Seen1,Sum1+length(Vs)+3); + hashmap -> + Cs = erts_internal:map_hashmap_children(Map), + fold_size(Cs,Seen0,Sum0+length(Cs)+2); + hashmap_node -> + Cs = erts_internal:map_hashmap_children(Map), + fold_size(Cs,Seen0,Sum0+length(Cs)+1) + end. fun_size(Fun, Seen, Sum) -> case erlang:fun_info(Fun, type) of @@ -229,13 +258,18 @@ fold_size([H|T], Seen0, Sum0) -> fold_size(T, Seen, Sum); fold_size([], Seen, Sum) -> {Sum,Seen}. -remember_term(Term, Seen) -> - case gb_trees:lookup(Term, Seen) of - none -> gb_trees:insert(Term, [Term], Seen); +remember_term(Term, #s{maps=Ms}=S) when is_map(Term) -> + case is_term_seen(Term, Ms) of + false -> S#s{maps=[Term|Ms]}; + true -> seen + end; +remember_term(Term, #s{seen=T}=S) -> + case gb_trees:lookup(Term,T) of + none -> S#s{seen=gb_trees:insert(Term,[Term],T)}; {value,Terms} -> case is_term_seen(Term, Terms) of - false -> gb_trees:update(Term, [Term|Terms], Seen); - true -> seen + false -> S#s{seen=gb_trees:update(Term,[Term|Terms],T)}; + true -> seen end end. @@ -313,3 +347,9 @@ cont_dis(File, {Addr,Str,MFA}, MFA) -> io:put_chars(File, binary_to_list(Str)), cont_dis(File, erts_debug:disassemble(Addr), MFA); cont_dis(_, {_,_,_}, _) -> ok. + +-spec map_info(Map) -> list() when + Map :: map(). + +map_info(_) -> + erlang:nif_error(undef). diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index 0a4edea452..6c36d417a2 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -881,11 +881,12 @@ handle_info({nodeup, Node}, S0) when S0#state.connect_all -> false -> resend_pre_connect(Node), - %% now() is used as a tag to separate different synch sessions + %% erlang:unique_integer([monotonic]) is used as a tag to + %% separate different synch sessions %% from each others. Global could be confused at bursty nodeups %% because it couldn't separate the messages between the different %% synch sessions started by a nodeup. - MyTag = now(), + MyTag = erlang:unique_integer([monotonic]), put({sync_tag_my, Node}, MyTag), ?trace({sending_nodeup_to_locker, {node,Node},{mytag,MyTag}}), S1#state.the_locker ! {nodeup, Node, MyTag}, @@ -1772,8 +1773,8 @@ update_locker_known(Upd, S) -> S#multi{known = Known, the_boss = TheBoss}. random_element(L) -> - {A,B,C} = now(), - E = (A+B+C) rem length(L), + E = abs(erlang:monotonic_time() + bxor erlang:unique_integer()) rem length(L), lists:nth(E+1, L). exclude_known(Others, Known) -> @@ -2072,9 +2073,10 @@ random_sleep(Times) -> end, case get(random_seed) of undefined -> - {A1, A2, A3} = now(), - _ = random:seed(A1, A2, A3 + erlang:phash(node(), 100000)), - ok; + _ = random:seed(erlang:phash2([erlang:node()]), + erlang:monotonic_time(), + erlang:unique_integer()), + ok; _ -> ok end, %% First time 1/4 seconds, then doubling each time up to 8 seconds max. @@ -2106,7 +2108,7 @@ trace_message(S, M, X) -> S#state{trace = [trace_message(M, X) | S#state.trace]}. trace_message(M, X) -> - {node(), now(), M, nodes(), X}. + {node(), erlang:timestamp(), M, nodes(), X}. %%----------------------------------------------------------------- %% Each sync process corresponds to one call to sync. Each such diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl index 2ebdc0f554..abe207295f 100644 --- a/lib/kernel/src/inet_db.erl +++ b/lib/kernel/src/inet_db.erl @@ -1372,8 +1372,7 @@ cache_rr(_Db, Cache, RR) -> ets:insert(Cache, RR). times() -> - {Mega,Secs,_} = erlang:now(), - Mega*1000000 + Secs. + erlang:monotonic_time(1). %% lookup and remove old entries diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl index 6037da1d22..410128a16a 100644 --- a/lib/kernel/src/inet_res.erl +++ b/lib/kernel/src/inet_res.erl @@ -715,10 +715,10 @@ udp_send(#sock{inet=I}, {A,B,C,D}=IP, Port, Buffer) udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout, Decode) when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> - do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout); + do_udp_recv(I, IP, Port, Timeout, Decode, time_now(), Timeout); udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout, Decode) when ?ip(A,B,C,D), ?port(Port) -> - do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout). + do_udp_recv(I, IP, Port, Timeout, Decode, time_now(), Timeout). do_udp_recv(_I, _IP, _Port, 0, _Decode, _Start, _T) -> timeout; @@ -742,7 +742,7 @@ do_udp_recv(I, IP, Port, Timeout, Decode, Start, T) -> NewTimeout = erlang:max(0, Timeout - 50), do_udp_recv(I, IP, Port, NewTimeout, Decode, Start, T); false -> - Now = erlang:now(), + Now = time_now(), NewT = erlang:max(0, Timeout - now_ms(Now, Start)), do_udp_recv(I, IP, Port, Timeout, Decode, Start, NewT); Result -> @@ -1057,5 +1057,9 @@ dns_msg(Msg) -> end. -compile({inline, [now_ms/2]}). -now_ms({Meg1,Sec1,Mic1}, {Meg0,Sec0,Mic0}) -> - ((Meg1-Meg0)*1000000 + (Sec1-Sec0))*1000 + ((Mic1-Mic0) div 1000). +now_ms(Int1, Int0) -> + Int1 - Int0. + +-compile({inline, [time_now/0]}). +time_now() -> + erlang:monotonic_time(1000). diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 9f6c0f4624..0cb10791d7 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -115,6 +115,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-6.1.2", "stdlib-2.0", "sasl-2.4"]} + {runtime_dependencies, ["erts-7.0", "stdlib-2.0", "sasl-2.4"]} ] }. diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl index ecdb32424a..cc5683ba06 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -117,7 +117,7 @@ init([]) -> [{local, kernel_safe_sup}, ?MODULE, safe]}, permanent, infinity, supervisor, [?MODULE]}, {ok, {SupFlags, - [File, Code, StdError, User, + [Code, File, StdError, User, Config, SafeSupervisor]}}; _ -> Rpc = {rex, {rpc, start_link, []}, @@ -139,8 +139,8 @@ init([]) -> [{local, kernel_safe_sup}, ?MODULE, safe]}, permanent, infinity, supervisor, [?MODULE]}, {ok, {SupFlags, - [Rpc, Global, InetDb | DistAC] ++ - [NetSup, Glo_grp, File, Code, + [Code, Rpc, Global, InetDb | DistAC] ++ + [NetSup, Glo_grp, File, StdError, User, Config, SafeSupervisor] ++ Timer}} end; init(safe) -> diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index 7468a06f3c..3647545777 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -26,7 +26,8 @@ %%% BIFs --export([getenv/0, getenv/1, getenv/2, getpid/0, putenv/2, timestamp/0, unsetenv/1]). +-export([getenv/0, getenv/1, getenv/2, getpid/0, putenv/2, system_time/0, system_time/1, + timestamp/0, unsetenv/1]). -spec getenv() -> [string()]. @@ -65,6 +66,17 @@ getpid() -> putenv(_, _) -> erlang:nif_error(undef). +-spec system_time() -> integer(). + +system_time() -> + erlang:nif_error(undef). + +-spec system_time(Unit) -> integer() when + Unit :: erlang:time_unit(). + +system_time(_Unit) -> + erlang:nif_error(undef). + -spec timestamp() -> Timestamp when Timestamp :: erlang:timestamp(). diff --git a/lib/kernel/src/pg2.erl b/lib/kernel/src/pg2.erl index b562d4ffd2..70d7a75671 100644 --- a/lib/kernel/src/pg2.erl +++ b/lib/kernel/src/pg2.erl @@ -140,19 +140,22 @@ get_closest_pid(Name) -> [Pid] -> Pid; [] -> - {_,_,X} = erlang:now(), case get_members(Name) of [] -> {error, {no_process, Name}}; Members -> - lists:nth((X rem length(Members))+1, Members) + random_element(Members) end; Members when is_list(Members) -> - {_,_,X} = erlang:now(), - lists:nth((X rem length(Members))+1, Members); + random_element(Members); Else -> Else end. +random_element(List) -> + X = abs(erlang:monotonic_time() + bxor erlang:unique_integer()), + lists:nth((X rem length(List)) + 1, List). + %%% %%% Callback functions from gen_server %%% diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index e6ce85c379..380c685869 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -133,6 +133,7 @@ server1(Iport, Oport, Shell) -> flatten(io_lib:format("~ts\n", [erlang:system_info(system_version)]))}, Iport, Oport), + %% Enter the server loop. server_loop(Iport, Oport, Curr, User, Gr, queue:new()). @@ -315,6 +316,9 @@ handle_escape(Iport, Oport, User, Gr, IOQueue) -> _ -> % {ok,jcl} | undefined io_request({put_chars,unicode,"\nUser switch command\n"}, Iport, Oport), + %% init edlin used by switch command and have it copy the + %% text buffer from current group process + edlin:init(gr_cur_pid(Gr)), server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr), IOQueue) end. diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index afedc17e57..549c65d034 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1396,8 +1396,9 @@ on_load_binary(_) -> {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}]}]}], - {ok,Mod,Bin} = compile:forms(Forms, [report]), - [io:put_chars(erl_pp:form(F)) || F <- Forms], + Forms1 = erl_parse:new_anno(Forms), + {ok,Mod,Bin} = compile:forms(Forms1, [report]), + [io:put_chars(erl_pp:form(F)) || F <- Forms1], {Pid1,Ref1} = spawn_monitor(fun() -> code:load_binary(Mod, File, Bin), diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl index 35d3b75b34..43224cf554 100644 --- a/lib/kernel/test/heart_SUITE.erl +++ b/lib/kernel/test/heart_SUITE.erl @@ -562,13 +562,15 @@ suicide_by_heart() -> generate(Module, Attributes, FunStrings) -> FunForms = function_forms(FunStrings), Forms = [ - {attribute,1,module,Module}, - {attribute,2,export,[FA || {FA,_} <- FunForms]} - ] ++ [{attribute, 3, A, V}|| {A, V} <- Attributes] ++ + {attribute,a(1),module,Module}, + {attribute,a(2),export,[FA || {FA,_} <- FunForms]} + ] ++ [{attribute, a(3), A, V}|| {A, V} <- Attributes] ++ [ Function || {_, Function} <- FunForms], {ok, Module, Bin} = compile:forms(Forms), Bin. +a(L) -> + erl_anno:new(L). function_forms([]) -> []; function_forms([S|Ss]) -> diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index 849013ac79..44a32fc1ec 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -88,10 +88,30 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_testcase(lookup_bad_search_option, Config) -> + Db = inet_db, + Key = res_lookup, + %% The bad option can not enter through inet_db:set_lookup/1, + %% but through e.g .inetrc. + Prev = ets:lookup(Db, Key), + ets:delete(Db, Key), + ets:insert(Db, {Key,[lookup_bad_search_option]}), + ?t:format("Misconfigured resolver lookup order", []), + Dog = test_server:timetrap(test_server:seconds(60)), + [{Key,Prev},{watchdog,Dog}|Config]; init_per_testcase(_Func, Config) -> Dog = test_server:timetrap(test_server:seconds(60)), [{watchdog,Dog}|Config]. +end_per_testcase(lookup_bad_search_option, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + Db = inet_db, + Key = res_lookup, + Prev = ?config(Key, Config), + ets:delete(Db, Key), + ets:insert(Db, Prev), + ?t:format("Restored resolver lookup order", []); end_per_testcase(_Func, Config) -> Dog = ?config(watchdog, Config), test_server:timetrap_cancel(Dog). @@ -915,10 +935,8 @@ lookup_bad_search_option(suite) -> lookup_bad_search_option(doc) -> ["Test lookup with erroneously configured lookup option (OTP-12133)"]; lookup_bad_search_option(Config) when is_list(Config) -> - Db = inet_db, - %% The bad option can not enter through inet_db:set_lookup/1, - %% but through e.g .inetrc. - ets:insert(Db, {res_lookup,[lookup_bad_search_option]}), + %% Manipulation of resolver config is done in init_per_testcase + %% and end_per_testcase to ensure cleanup. {ok,Hostname} = inet:gethostname(), {ok,_Hent} = inet:gethostbyname(Hostname), % Will hang loop for this bug ok. diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl index e99151284f..41c19fce51 100644 --- a/lib/kernel/test/zlib_SUITE.erl +++ b/lib/kernel/test/zlib_SUITE.erl @@ -146,8 +146,6 @@ api_deflateInit(Config) when is_list(Config) -> ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-20,8,default)), ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-7,8,default)), ?m(?BARG, zlib:deflateInit(Z1,default,deflated,7,8,default)), - ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-8,8,default)), - ?m(?BARG, zlib:deflateInit(Z1,default,deflated,8,8,default)), ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,0,default)), ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,10,default)), @@ -169,7 +167,7 @@ api_deflateInit(Config) when is_list(Config) -> ?m(ok, zlib:deflateInit(Z12,default,deflated,-Wbits,8,default)), ?m(ok,zlib:close(Z11)), ?m(ok,zlib:close(Z12)) - end, lists:seq(9, 15)), + end, lists:seq(8, 15)), lists:foreach(fun(MemLevel) -> ?line Z = zlib:open(), @@ -277,7 +275,7 @@ api_inflateInit(Config) when is_list(Config) -> ?m(ok, zlib:inflateInit(Z12,-Wbits)), ?m(ok,zlib:close(Z11)), ?m(ok,zlib:close(Z12)) - end, lists:seq(9,15)), + end, lists:seq(8,15)), ?m(?BARG, zlib:inflateInit(gurka, -15)), ?m(?BARG, zlib:inflateInit(Z1, 7)), ?m(?BARG, zlib:inflateInit(Z1, -7)), diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index 15820a0182..e1d447a465 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 3.1 +KERNEL_VSN = 3.2 diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index 18f72f4faf..dc98efbff3 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -38,7 +38,34 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.12.4</title> + <section><title>Mnesia 4.12.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed race condition in protocol negotiation.</p> + <p> + Own Id: OTP-12473</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Grammar corrections. (Thanks to Derek Brown)</p> + <p> + Own Id: OTP-12400</p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.12.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/mnesia/src/mnesia.app.src b/lib/mnesia/src/mnesia.app.src index e755864792..c78a7cba1e 100644 --- a/lib/mnesia/src/mnesia.app.src +++ b/lib/mnesia/src/mnesia.app.src @@ -48,6 +48,6 @@ ]}, {applications, [kernel, stdlib]}, {mod, {mnesia_sup, []}}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0"]}]}. + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-7.0"]}]}. diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index 8f14831ad3..f501a4485b 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -145,7 +145,7 @@ %% Local function in order to avoid external function call val(Var) -> case ?catch_val(Var) of - {'EXIT', Reason} -> mnesia_lib:other_val(Var, Reason); + {'EXIT', _} -> mnesia_lib:other_val(Var); Value -> Value end. @@ -807,7 +807,7 @@ next(Tid,Ts,Tab,Key) tid -> lock_table(Tid, Ts, Tab, read), do_fixtable(Tab,Ts), - New = (catch dirty_next(Tab,Key)), + New = ?CATCH(dirty_next(Tab,Key)), stored_keys(Tab,New,Key,Ts,next, val({Tab, setorbag})); _Protocol -> @@ -833,7 +833,7 @@ prev(Tid,Ts,Tab,Key) tid -> lock_table(Tid, Ts, Tab, read), do_fixtable(Tab,Ts), - New = (catch dirty_prev(Tab,Key)), + New = ?CATCH(dirty_prev(Tab,Key)), stored_keys(Tab,New,Key,Ts,prev, val({Tab, setorbag})); _Protocol -> @@ -965,7 +965,7 @@ foldl(Fun, Acc, Tab, LockKind) when is_function(Fun) -> foldl(ActivityId, Opaque, Fun, Acc, Tab, LockKind) -> {Type, Prev} = init_iteration(ActivityId, Opaque, Tab, LockKind), - Res = (catch do_foldl(ActivityId, Opaque, Tab, dirty_first(Tab), Fun, Acc, Type, Prev)), + Res = ?CATCH(do_foldl(ActivityId, Opaque, Tab, dirty_first(Tab), Fun, Acc, Type, Prev)), close_iteration(Res, Tab). do_foldl(A, O, Tab, '$end_of_table', Fun, RAcc, _Type, Stored) -> @@ -1011,7 +1011,7 @@ foldr(ActivityId, Opaque, Fun, Acc, Tab, LockKind) -> true -> %% Order doesn't matter for set and bag TempPrev %% Keep the order so we can use ordsets:del_element end, - Res = (catch do_foldr(ActivityId, Opaque, Tab, dirty_last(Tab), Fun, Acc, Type, Prev)), + Res = ?CATCH(do_foldr(ActivityId, Opaque, Tab, dirty_last(Tab), Fun, Acc, Type, Prev)), close_iteration(Res, Tab). do_foldr(A, O, Tab, '$end_of_table', Fun, RAcc, _Type, Stored) -> @@ -1905,21 +1905,21 @@ any_table_info(Tab, _Item) -> abort({bad_type, Tab}). raw_table_info(Tab, Item) -> - case ?catch_val({Tab, storage_type}) of - ram_copies -> - info_reply(catch ?ets_info(Tab, Item), Tab, Item); - disc_copies -> - info_reply(catch ?ets_info(Tab, Item), Tab, Item); - disc_only_copies -> - info_reply(catch dets:info(Tab, Item), Tab, Item); - unknown -> - bad_info_reply(Tab, Item); - {'EXIT', _} -> + try + case ?ets_lookup_element(mnesia_gvar, {Tab, storage_type}, 2) of + ram_copies -> + info_reply(?ets_info(Tab, Item), Tab, Item); + disc_copies -> + info_reply(?ets_info(Tab, Item), Tab, Item); + disc_only_copies -> + info_reply(dets:info(Tab, Item), Tab, Item); + unknown -> + bad_info_reply(Tab, Item) + end + catch error:_ -> bad_info_reply(Tab, Item) end. -info_reply({'EXIT', _Reason}, Tab, Item) -> - bad_info_reply(Tab, Item); info_reply({error, _Reason}, Tab, Item) -> bad_info_reply(Tab, Item); info_reply(Val, _Tab, _Item) -> @@ -2063,9 +2063,8 @@ storage_count(T, {U, R, D, DO}) -> end. system_info(Item) -> - case catch system_info2(Item) of - {'EXIT',Error} -> abort(Error); - Other -> Other + try system_info2(Item) + catch _:Error -> abort(Error) end. system_info2(all) -> @@ -2171,7 +2170,7 @@ system_info2(version) -> Version; false -> %% Ensure that it does not match - {mnesia_not_loaded, node(), now()} + {mnesia_not_loaded, node(), erlang:timestamp()} end; Version -> Version @@ -2381,11 +2380,10 @@ del_table_index(Tab, Ix) -> mnesia_schema:del_table_index(Tab, Ix). transform_table(Tab, Fun, NewA) -> - case catch val({Tab, record_name}) of - {'EXIT', Reason} -> - mnesia:abort(Reason); - OldRN -> - mnesia_schema:transform_table(Tab, Fun, NewA, OldRN) + try val({Tab, record_name}) of + OldRN -> mnesia_schema:transform_table(Tab, Fun, NewA, OldRN) + catch exit:Reason -> + mnesia:abort(Reason) end. transform_table(Tab, Fun, NewA, NewRN) -> @@ -2796,7 +2794,7 @@ pre_qlc(Opts, Tab) -> end. post_qlc(Tab) -> - case catch get(mnesia_activity_state) of + case get(mnesia_activity_state) of {_,#tid{},_} -> ok; _ -> case ?catch_val({Tab, setorbag}) of diff --git a/lib/mnesia/src/mnesia.hrl b/lib/mnesia/src/mnesia.hrl index c8010d5466..86b6fd908f 100644 --- a/lib/mnesia/src/mnesia.hrl +++ b/lib/mnesia/src/mnesia.hrl @@ -39,7 +39,12 @@ -define(ets_delete_table(Tab), ets:delete(Tab)). -define(ets_fixtable(Tab, Bool), ets:fixtable(Tab, Bool)). --define(catch_val(Var), (catch ?ets_lookup_element(mnesia_gvar, Var, 2))). + +-define(SAFE(OP), try (OP) catch error:_ -> ok end). +-define(CATCH(OP), try (OP) catch _:_Reason -> {'EXIT', _Reason} end). + +-define(catch_val(Var), (try ?ets_lookup_element(mnesia_gvar, Var, 2) + catch error:_ -> {'EXIT', {badarg, []}} end)). %% It's important that counter is first, since we compare tid's @@ -53,7 +58,9 @@ up_stores = [], %% list of upper layer stores for nested trans level = 1}). %% transaction level --define(unique_cookie, {erlang:now(), node()}). +-define(unique_cookie, {{erlang:monotonic_time() + erlang:time_offset(), + erlang:unique_integer(),1}, + node()}). -record(cstruct, {name, % Atom type = set, % set | bag diff --git a/lib/mnesia/src/mnesia_bup.erl b/lib/mnesia/src/mnesia_bup.erl index 3b084e7371..3fee952d77 100644 --- a/lib/mnesia/src/mnesia_bup.erl +++ b/lib/mnesia/src/mnesia_bup.erl @@ -78,24 +78,21 @@ %% BunchOfRecords will be [] when the iteration is done. iterate(Mod, Fun, Opaque, Acc) -> R = #restore{bup_module = Mod, bup_data = Opaque}, - case catch read_schema_section(R) of - {error, Reason} -> - {error, Reason}; - {R2, {Header, Schema, Rest}} -> - case catch iter(R2, Header, Schema, Fun, Acc, Rest) of - {ok, R3, Res} -> - catch safe_apply(R3, close_read, [R3#restore.bup_data]), - {ok, Res}; - {error, Reason} -> - catch safe_apply(R2, close_read, [R2#restore.bup_data]), - {error, Reason}; - {'EXIT', Pid, Reason} -> - catch safe_apply(R2, close_read, [R2#restore.bup_data]), - {error, {'EXIT', Pid, Reason}}; - {'EXIT', Reason} -> - catch safe_apply(R2, close_read, [R2#restore.bup_data]), - {error, {'EXIT', Reason}} - end + try read_schema_section(R) of + {R2, {Header, Schema, Rest}} -> + try iter(R2, Header, Schema, Fun, Acc, Rest) of + {ok, R3, Res} -> + close_read(R3), + {ok, Res} + catch throw:Err -> + close_read(R2), + Err; + _:Reason -> + close_read(R2), + {error, {Reason, erlang:get_stacktrace()}} + end + catch throw:{error,_} = Err -> + Err end. iter(R, Header, Schema, Fun, Acc, []) -> @@ -116,7 +113,7 @@ safe_apply(R, write, [_, Items]) when Items =:= [] -> safe_apply(R, What, Args) -> Abort = fun(Re) -> abort_restore(R, What, Args, Re) end, Mod = R#restore.bup_module, - case catch apply(Mod, What, Args) of + try apply(Mod, What, Args) of {ok, Opaque, Items} when What =:= read -> {R#restore{bup_data = Opaque}, Items}; {ok, Opaque} when What =/= read-> @@ -125,16 +122,19 @@ safe_apply(R, What, Args) -> Abort(Re); Re -> Abort(Re) + catch _:Re -> + Abort(Re) end. -abort_restore(R, What, Args, Reason) -> - Mod = R#restore.bup_module, - Opaque = R#restore.bup_data, +abort_restore(R = #restore{bup_module=Mod}, What, Args, Reason) -> dbg_out("Restore aborted. ~p:~p~p -> ~p~n", [Mod, What, Args, Reason]), - catch apply(Mod, close_read, [Opaque]), + close_read(R), throw({error, Reason}). +close_read(#restore{bup_module=Mod, bup_data=Opaque}) -> + ?SAFE(Mod:close_read(Opaque)). + fallback_to_schema() -> Fname = fallback_bup(), fallback_to_schema(Fname). @@ -145,40 +145,30 @@ fallback_to_schema(Fname) -> {error, Reason} -> {error, Reason}; Schema -> - case catch lookup_schema(schema, Schema) of - {error, _} -> - {error, "No schema in fallback"}; - List -> - {ok, fallback, List} + try lookup_schema(schema, Schema) of + List -> {ok, fallback, List} + catch throw:_ -> + {error, "No schema in fallback"} end end. %% Opens Opaque reads schema and then close read_schema(Mod, Opaque) -> R = #restore{bup_module = Mod, bup_data = Opaque}, - case catch read_schema_section(R) of - {error, Reason} -> - {error, Reason}; - {R2, {_Header, Schema, _}} -> - catch safe_apply(R2, close_read, [R2#restore.bup_data]), - Schema + try read_schema_section(R) of + {_, {_Header, Schema, _}} -> Schema + catch throw:{error,_} = Error -> + Error + after close_read(R) end. %% Open backup media and extract schema %% rewind backup media and leave it open %% Returns {R, {Header, Schema}} read_schema_section(R) -> - case catch do_read_schema_section(R) of - {'EXIT', Reason} -> - catch safe_apply(R, close_read, [R#restore.bup_data]), - {error, {'EXIT', Reason}}; - {error, Reason} -> - catch safe_apply(R, close_read, [R#restore.bup_data]), - {error, Reason}; - {R2, {H, Schema, Rest}} -> - Schema2 = convert_schema(H#log_header.log_version, Schema), - {R2, {H, Schema2, Rest}} - end. + {R2, {H, Schema, Rest}} = do_read_schema_section(R), + Schema2 = convert_schema(H#log_header.log_version, Schema), + {R2, {H, Schema2, Rest}}. do_read_schema_section(R) -> R2 = safe_apply(R, open_read, [R#restore.bup_data]), @@ -201,7 +191,7 @@ do_read_schema_section(R, {ok, B, _C, Rest}, Acc) -> {R, {B, Acc, Rest}}; do_read_schema_section(_R, {error, Reason}, _Acc) -> - {error, Reason}. + throw({error, Reason}). verify_header([H | RawSchema]) when is_record(H, log_header) -> Current = mnesia_log:backup_log_header(), @@ -218,7 +208,7 @@ verify_header([H | RawSchema]) when is_record(H, log_header) -> {error, {"Bad kind of header. Cannot be used as backup.", H}} end; verify_header(RawSchema) -> - {error, {"Missing header. Cannot be used as backup.", catch hd(RawSchema)}}. + {error, {"Missing header. Cannot be used as backup.", ?CATCH(hd(RawSchema))}}. refresh_cookie(Schema, NewCookie) -> case lists:keysearch(schema, 2, Schema) of @@ -345,7 +335,7 @@ create_schema(Ns, ok) -> Str = mk_str(), File = mnesia_lib:dir(Str), file:delete(File), - case catch make_initial_backup(Ns, File, Mod) of + try make_initial_backup(Ns, File, Mod) of {ok, _Res} -> case do_install_fallback(File, Mod) of ok -> @@ -353,8 +343,8 @@ create_schema(Ns, ok) -> ok; {error, Reason} -> {error, Reason} - end; - {error, Reason} -> + end + catch throw:{error, Reason} -> {error, Reason} end end @@ -368,7 +358,7 @@ create_schema(_Ns, Reason) -> {error, Reason}. mk_str() -> - Now = [integer_to_list(I) || I <- tuple_to_list(now())], + Now = integer_to_list(erlang:unique_integer([positive])), lists:concat([node()] ++ Now ++ ".TMP"). make_initial_backup(Ns, Opaque, Mod) -> @@ -384,10 +374,11 @@ make_initial_backup(Ns, Opaque, Mod) -> do_apply(_, write, [_, Items], Opaque) when Items =:= [] -> Opaque; do_apply(Mod, What, Args, _Opaque) -> - case catch apply(Mod, What, Args) of + try apply(Mod, What, Args) of {ok, Opaque2} -> Opaque2; - {error, Reason} -> throw({error, Reason}); - {'EXIT', Reason} -> throw({error, {'EXIT', Reason}}) + {error, Reason} -> throw({error, Reason}) + catch _:Reason -> + throw({error, {'EXIT', Reason}}) end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -425,11 +416,11 @@ do_install_fallback(_Opaque, Args) -> {error, {badarg, Args}}. check_fallback_args([Arg | Tail], FA) -> - case catch check_fallback_arg_type(Arg, FA) of - {'EXIT', _Reason} -> - {error, {badarg, Arg}}; + try check_fallback_arg_type(Arg, FA) of FA2 -> check_fallback_args(Tail, FA2) + catch error:_ -> + {error, {badarg, Arg}} end; check_fallback_args([], FA) -> {ok, FA}. @@ -484,7 +475,7 @@ install_fallback_master(ClientPid, FA) -> State = {start, FA}, Opaque = FA#fallback_args.opaque, Mod = FA#fallback_args.module, - Res = (catch iterate(Mod, fun restore_recs/4, Opaque, State)), + Res = iterate(Mod, fun restore_recs/4, Opaque, State), unlink(ClientPid), ClientPid ! {self(), Res}, exit(shutdown). @@ -496,9 +487,7 @@ restore_recs(Recs, Header, Schema, {start, FA}) -> %% No records in backup Schema2 = convert_schema(Header#log_header.log_version, Schema), CreateList = lookup_schema(schema, Schema2), - case catch mnesia_schema:list2cs(CreateList) of - {'EXIT', Reason} -> - throw({error, {"Bad schema in restore_recs", Reason}}); + try mnesia_schema:list2cs(CreateList) of Cs -> Ns = get_fallback_nodes(FA, Cs#cstruct.disc_copies), global:set_lock({{mnesia_table_lock, schema}, self()}, Ns, infinity), @@ -508,6 +497,8 @@ restore_recs(Recs, Header, Schema, {start, FA}) -> Res = restore_recs(Recs, Header, Schema2, Pids), global:del_lock({{mnesia_table_lock, schema}, self()}, Ns), Res + catch _:Reason -> + throw({error, {"Bad schema in restore_recs", Reason}}) end; restore_recs([], _Header, _Schema, Pids) -> @@ -579,45 +570,46 @@ fallback_tmp_name() -> "FALLBACK.TMP". fallback_receiver(Master, FA) -> process_flag(trap_exit, true), - case catch register(mnesia_fallback, self()) of - {'EXIT', _} -> - Reason = {already_exists, node()}, - local_fallback_error(Master, Reason); - true -> - FA2 = check_fallback_dir(Master, FA), - Bup = FA2#fallback_args.fallback_bup, - case mnesia_lib:exists(Bup) of - true -> - Reason2 = {already_exists, node()}, - local_fallback_error(Master, Reason2); - false -> - Mod = mnesia_backup, - Tmp = FA2#fallback_args.fallback_tmp, - R = #restore{mode = replace, - bup_module = Mod, - bup_data = Tmp}, - file:delete(Tmp), - case catch fallback_receiver_loop(Master, R, FA2, schema) of - {error, Reason} -> - local_fallback_error(Master, Reason); - Other -> - exit(Other) - end - end - end. + Res = try + register(mnesia_fallback, self()), + FA2 = check_fallback_dir(FA), + Bup = FA2#fallback_args.fallback_bup, + false = mnesia_lib:exists(Bup), + Mod = mnesia_backup, + Tmp = FA2#fallback_args.fallback_tmp, + R = #restore{mode = replace, + bup_module = Mod, + bup_data = Tmp}, + file:delete(Tmp), + fallback_receiver_loop(Master, R, FA2, schema) + catch + error:_ -> + Reason = {already_exists, node()}, + local_fallback_error(Master, Reason); + throw:{error, Reason} -> + local_fallback_error(Master, Reason) + end, + exit(Res). local_fallback_error(Master, Reason) -> Master ! {self(), {error, Reason}}, unlink(Master), exit(Reason). + check_fallback_dir(Master, FA) -> + try check_fallback_dir(FA) + catch throw:{error,Reason} -> + local_fallback_error(Master, Reason) + end. + +check_fallback_dir(FA) -> case mnesia:system_info(schema_location) of ram -> Reason = {has_no_disc, node()}, - local_fallback_error(Master, Reason); + throw({error, Reason}); _ -> - Dir = check_fallback_dir_arg(Master, FA), + Dir = check_fallback_dir_arg(FA), Bup = filename:join([Dir, fallback_name()]), Tmp = filename:join([Dir, fallback_tmp_name()]), FA#fallback_args{fallback_bup = Bup, @@ -625,22 +617,20 @@ check_fallback_dir(Master, FA) -> mnesia_dir = Dir} end. -check_fallback_dir_arg(Master, FA) -> +check_fallback_dir_arg(FA) -> case FA#fallback_args.use_default_dir of true -> mnesia_lib:dir(); false when FA#fallback_args.scope =:= local -> Dir = FA#fallback_args.mnesia_dir, - case catch mnesia_monitor:do_check_type(dir, Dir) of - {'EXIT', _R} -> + try mnesia_monitor:do_check_type(dir, Dir) + catch _:_ -> Reason = {badarg, {dir, Dir}, node()}, - local_fallback_error(Master, Reason); - AbsDir-> - AbsDir - end; + throw({error, Reason}) + end; false when FA#fallback_args.scope =:= global -> Reason = {combine_error, global, dir, node()}, - local_fallback_error(Master, Reason) + throw({error, Reason}) end. fallback_receiver_loop(Master, R, FA, State) -> @@ -666,7 +656,7 @@ fallback_receiver_loop(Master, R, FA, State) -> Bup = FA#fallback_args.fallback_bup, Tmp = FA#fallback_args.fallback_tmp, throw_bad_res(ok, file:rename(Tmp, Bup)), - catch mnesia_lib:set(active_fallback, true), + ?SAFE(mnesia_lib:set(active_fallback, true)), ?eval_debug_fun({?MODULE, fallback_receiver_loop, post_swap}, []), Master ! {self(), ok}, fallback_receiver_loop(Master, R, FA, stop); @@ -697,7 +687,7 @@ throw_bad_res(_Expected, Actual) -> throw({error, Actual}). tm_fallback_start(IgnoreFallback) -> mnesia_schema:lock_schema(), Res = do_fallback_start(fallback_exists(), IgnoreFallback), - mnesia_schema: unlock_schema(), + mnesia_schema:unlock_schema(), case Res of ok -> ok; {error, Reason} -> exit(Reason) @@ -715,9 +705,9 @@ do_fallback_start(true, false) -> BupFile = fallback_bup(), Mod = mnesia_backup, LocalTabs = ?ets_new_table(mnesia_local_tables, [set, public, {keypos, 2}]), - case catch iterate(Mod, fun restore_tables/4, BupFile, {start, LocalTabs}) of + case iterate(Mod, fun restore_tables/4, BupFile, {start, LocalTabs}) of {ok, _Res} -> - catch dets:close(schema), + ?SAFE(dets:close(schema)), TmpSchema = mnesia_lib:tab2tmp(schema), DatSchema = mnesia_lib:tab2dat(schema), AllLT = ?ets_match_object(LocalTabs, '_'), @@ -733,8 +723,6 @@ do_fallback_start(true, false) -> {error, {"Cannot start from fallback. Rename error.", Reason}} end; {error, Reason} -> - {error, {"Cannot start from fallback", Reason}}; - {'EXIT', Reason} -> {error, {"Cannot start from fallback", Reason}} end. @@ -996,10 +984,10 @@ uninstall_fallback_master(ClientPid, FA) -> case fallback_to_schema(Bup) of {ok, fallback, List} -> Cs = mnesia_schema:list2cs(List), - case catch get_fallback_nodes(FA, Cs#cstruct.disc_copies) of + try get_fallback_nodes(FA, Cs#cstruct.disc_copies) of Ns when is_list(Ns) -> - do_uninstall(ClientPid, Ns, FA); - {error, Reason} -> + do_uninstall(ClientPid, Ns, FA) + catch throw:{error, Reason} -> local_fallback_error(ClientPid, Reason) end; {error, Reason} -> @@ -1042,13 +1030,13 @@ local_uninstall_fallback(Master, FA) -> %% Don't trap exit register(mnesia_fallback, self()), % May exit - FA2 = check_fallback_dir(Master, FA), % May exit + FA2 = check_fallback_dir(Master, FA), % May exit Master ! {self(), started}, receive {Master, do_uninstall} -> ?eval_debug_fun({?MODULE, uninstall_fallback2, pre_delete}, []), - catch mnesia_lib:set(active_fallback, false), + ?SAFE(mnesia_lib:set(active_fallback, false)), Tmp = FA2#fallback_args.fallback_tmp, Bup = FA2#fallback_args.fallback_bup, file:delete(Tmp), @@ -1071,10 +1059,8 @@ rec_uninstall(ClientPid, [Pid | Pids], AccRes) -> {Pid, BadRes} -> rec_uninstall(ClientPid, Pids, BadRes) end; -rec_uninstall(ClientPid, [], Res) -> - ClientPid ! {self(), Res}, - unlink(ClientPid), - exit(normal). +rec_uninstall(_, [], Res) -> + Res. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Backup traversal @@ -1125,12 +1111,11 @@ do_traverse_backup(ClientPid, Source, SourceMod, Target, TargetMod, Fun, Acc) -> Iter = if TargetMod =/= read_only -> - case catch do_apply(TargetMod, open_write, [Target], Target) of - {error, Error} -> + try do_apply(TargetMod, open_write, [Target], Target) + catch throw:{error, Error} -> unlink(ClientPid), ClientPid ! {iter_done, self(), {error, Error}}, - exit(Error); - Else -> Else + exit(Error) end; true -> ignore @@ -1139,16 +1124,16 @@ do_traverse_backup(ClientPid, Source, SourceMod, Target, TargetMod, Fun, Acc) -> Res = case iterate(SourceMod, fun trav_apply/4, Source, A) of {ok, {iter, _, Acc2, _, Iter2}} when TargetMod =/= read_only -> - case catch do_apply(TargetMod, commit_write, [Iter2], Iter2) of - {error, Reason} -> - {error, Reason}; - _ -> - {ok, Acc2} + try + do_apply(TargetMod, commit_write, [Iter2], Iter2), + {ok, Acc2} + catch throw:{error, Reason} -> + {error, Reason} end; {ok, {iter, _, Acc2, _, _}} -> {ok, Acc2}; {error, Reason} when TargetMod =/= read_only-> - catch do_apply(TargetMod, abort_write, [Iter], Iter), + ?CATCH(do_apply(TargetMod, abort_write, [Iter], Iter)), {error, {"Backup traversal failed", Reason}}; {error, Reason} -> {error, {"Backup traversal failed", Reason}} diff --git a/lib/mnesia/src/mnesia_checkpoint.erl b/lib/mnesia/src/mnesia_checkpoint.erl index 173e3be2f5..0a3ea8d769 100644 --- a/lib/mnesia/src/mnesia_checkpoint.erl +++ b/lib/mnesia/src/mnesia_checkpoint.erl @@ -68,12 +68,12 @@ -import(mnesia_lib, [add/2, del/2, set/2, unset/1]). -import(mnesia_lib, [dbg_out/2]). --record(checkpoint_args, {name = {now(), node()}, +-record(checkpoint_args, {name = {erlang:unique_integer([positive]), node()}, allow_remote = true, ram_overrides_dump = false, nodes = [], node = node(), - now = now(), + now, %% unused cookie = ?unique_cookie, min = [], max = [], @@ -128,7 +128,7 @@ tm_enter_pending([], Pending) -> Pending; tm_enter_pending([Tab | Tabs], Pending) -> %% io:format("Add ~p ~p ~p~n",[Tab, Pending, hd(tl(element(2, process_info(self(), current_stacktrace))))]), - catch ?ets_insert(Tab, Pending), + ?SAFE(?ets_insert(Tab, Pending)), tm_enter_pending(Tabs, Pending). tm_exit_pending(Tid) -> @@ -427,22 +427,22 @@ check_tables(Cp) -> arrange_retainers(Cp, Overriders, AllTabs) -> R = #retainer{cp_name = Cp#checkpoint_args.name}, - case catch [R#retainer{tab_name = Tab, - writers = select_writers(Cp, Tab)} - || Tab <- AllTabs] of - {'EXIT', Reason} -> - {error, Reason}; + try [R#retainer{tab_name = Tab, + writers = select_writers(Cp, Tab)} + || Tab <- AllTabs] of Retainers -> {ok, Cp#checkpoint_args{ram_overrides_dump = Overriders, - retainers = Retainers, - nodes = writers(Retainers)}} + retainers = Retainers, + nodes = writers(Retainers)}} + catch throw:Reason -> + {error, Reason} end. select_writers(Cp, Tab) -> case filter_remote(Cp, val({Tab, active_replicas})) of [] -> - exit({"Cannot prepare checkpoint (replica not available)", - [Tab, Cp#checkpoint_args.name]}); + throw({"Cannot prepare checkpoint (replica not available)", + [Tab, Cp#checkpoint_args.name]}); Writers -> This = node(), case {lists:member(Tab, Cp#checkpoint_args.max), @@ -492,12 +492,12 @@ check_prep([], Name, Nodes, IgnoreNew) -> collect_pending(Name, Nodes, IgnoreNew) -> case rpc:multicall(Nodes, ?MODULE, call, [Name, collect_pending]) of {Replies, []} -> - case catch ?ets_new_table(mnesia_union, [bag]) of - {'EXIT', Reason} -> %% system limit + try + UnionTab = ?ets_new_table(mnesia_union, [bag]), + compute_union(Replies, Nodes, Name, UnionTab, IgnoreNew) + catch error:Reason -> %% system limit Msg = "Cannot create an ets table pending union", - {error, {system_limit, Msg, Reason}}; - UnionTab -> - compute_union(Replies, Nodes, Name, UnionTab, IgnoreNew) + {error, {system_limit, Msg, Reason}} end; {_, BadNodes} -> deactivate(Nodes, Name), @@ -1170,7 +1170,7 @@ iterate(Name, Tab, Fun, Acc, Source, Val) -> {error, Reason}; {ok, Iter, Pid} -> link(Pid), % We don't want any pending fixtable's - Res = (catch iter(Fun, Acc, Iter)), + Res = ?CATCH(iter(Fun, Acc, Iter)), unlink(Pid), call(Name, {iter_end, Iter}), case Res of @@ -1246,7 +1246,7 @@ system_code_change(Cp, _Module, _OldVsn, _Extra) -> val(Var) -> case ?catch_val(Var) of - {'EXIT', _ReASoN_} -> mnesia_lib:other_val(Var, _ReASoN_); - _VaLuE_ -> _VaLuE_ + {'EXIT', _} -> mnesia_lib:other_val(Var); + _VaLuE_ -> _VaLuE_ end. diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index aa72de7594..b9d3779e9a 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -186,7 +186,7 @@ max_loaders() -> val(Var) -> case ?catch_val(Var) of - {'EXIT', Reason} -> mnesia_lib:other_val(Var, Reason); + {'EXIT', _} -> mnesia_lib:other_val(Var); Value -> Value end. @@ -241,9 +241,7 @@ do_wait_for_tables(Tabs, Timeout) -> end. reply_wait(Tabs) -> - case catch mnesia_lib:active_tables() of - {'EXIT', _} -> - {error, {node_not_running, node()}}; + try mnesia_lib:active_tables() of Active when is_list(Active) -> case Tabs -- Active of [] -> @@ -251,6 +249,7 @@ reply_wait(Tabs) -> BadTabs -> {timeout, BadTabs} end + catch exit:_ -> {error, {node_not_running, node()}} end. wait_for_tables_init(From, Tabs) -> @@ -261,13 +260,12 @@ wait_for_tables_init(From, Tabs) -> exit(normal). wait_for_init(From, Tabs, Init) -> - case catch link(Init) of - {'EXIT', _} -> - %% Mnesia is not started - {error, {node_not_running, node()}}; + try link(Init) of true when is_pid(Init) -> cast({sync_tabs, Tabs, self()}), rec_tabs(Tabs, Tabs, From, Init) + catch error:_ -> %% Mnesia is not started + {error, {node_not_running, node()}} end. sync_reply(Waiter, Tab) -> @@ -343,7 +341,7 @@ get_network_copy(Tab, Cs) -> %% might be solved by using monitor in subscr instead. process_flag(trap_exit, true), Load = load_table_fun(Work), - Res = (catch Load()), + Res = ?CATCH(Load()), process_flag(trap_exit, false), call({del_other, self()}), case Res of @@ -592,11 +590,8 @@ call(Msg) -> end. remote_call(Node, Func, Args) -> - case catch gen_server:call({?MODULE, Node}, {Func, Args, self()}, infinity) of - {'EXIT', Error} -> - {error, Error}; - Else -> - Else + try gen_server:call({?MODULE, Node}, {Func, Args, self()}, infinity) + catch exit:Error -> {error, Error} end. multicall(Nodes, Msg) -> @@ -677,7 +672,7 @@ handle_call(block_controller, From, State) -> noreply(State2); handle_call({update,Fun}, From, State) -> - Res = (catch Fun()), + Res = ?CATCH(Fun()), reply(From, Res), noreply(State); @@ -1256,7 +1251,7 @@ handle_info(#sender_done{worker_pid=Pid, worker_res=Res}, State) -> end; handle_info({'EXIT', Pid, R}, State) when Pid == State#state.supervisor -> - catch set(mnesia_status, stopping), + ?SAFE(set(mnesia_status, stopping)), case State#state.dumper_pid of undefined -> dbg_out("~p was ~p~n", [?SERVER_NAME, R]), @@ -1480,9 +1475,9 @@ orphan_tables([], _, _, LocalOrphans, RemoteMasters) -> node_has_tabs([Tab | Tabs], Node, State) when Node /= node() -> State2 = - case catch update_whereabouts(Tab, Node, State) of - State1 = #state{} -> State1; - {'EXIT', R} -> %% Tab was just deleted? + try update_whereabouts(Tab, Node, State) of + State1 = #state{} -> State1 + catch exit:R -> %% Tab was just deleted? case ?catch_val({Tab, cstruct}) of {'EXIT', _} -> State; % yes _ -> erlang:error(R) @@ -1768,22 +1763,17 @@ change_table_majority(Cs) -> update_where_to_wlock(Tab) -> WNodes = val({Tab, where_to_write}), - Majority = case catch val({Tab, majority}) of - true -> true; - _ -> false - end, + Majority = ?catch_val({Tab, majority}) == true, set({Tab, where_to_wlock}, {WNodes, Majority}). %% node To now has tab loaded, but this must be undone %% This code is rpc:call'ed from the tab_copier process %% when it has *not* released it's table lock unannounce_add_table_copy(Tab, To) -> - catch del_active_replica(Tab, To), - case catch val({Tab , where_to_read}) of - To -> - mnesia_lib:set_remote_where_to_read(Tab); - _ -> - ignore + ?SAFE(del_active_replica(Tab, To)), + try To = val({Tab , where_to_read}), + mnesia_lib:set_remote_where_to_read(Tab) + catch _:_ -> ignore end. user_sync_tab(Tab) -> diff --git a/lib/mnesia/src/mnesia_dumper.erl b/lib/mnesia/src/mnesia_dumper.erl index 509b765dee..693f20dbc2 100644 --- a/lib/mnesia/src/mnesia_dumper.erl +++ b/lib/mnesia/src/mnesia_dumper.erl @@ -137,7 +137,7 @@ perform_dump(InitBy, Regulator) -> U = mnesia_monitor:get_env(dump_log_update_in_place), Cont = mnesia_log:init_log_dump(), mnesia_recover:sync(), - case catch do_perform_dump(Cont, U, InitBy, Regulator, undefined) of + try do_perform_dump(Cont, U, InitBy, Regulator, undefined) of ok -> ?eval_debug_fun({?MODULE, post_dump}, [InitBy]), case mnesia_monitor:use_dir() of @@ -148,17 +148,15 @@ perform_dump(InitBy, Regulator) -> end, mnesia_recover:allow_garb(), %% And now to the crucial point... - mnesia_log:confirm_log_dump(Diff); - {error, Reason} -> - {error, Reason}; - {'EXIT', {Desc, Reason}} -> + mnesia_log:confirm_log_dump(Diff) + catch exit:Reason when Reason =/= fatal -> case mnesia_monitor:get_env(auto_repair) of true -> - mnesia_lib:important(Desc, Reason), + mnesia_lib:important(error, Reason), %% Ignore rest of the log mnesia_log:confirm_log_dump(Diff); false -> - fatal(Desc, Reason) + fatal(error, Reason) end end; {error, Reason} -> @@ -176,24 +174,25 @@ scan_decisions(Fname, InitBy, Regulator) -> mnesia_log:open_log(Name, Header, Fname, Exists, mnesia_monitor:get_env(auto_repair), read_only), Cont = start, - Res = (catch do_perform_dump(Cont, false, InitBy, Regulator, undefined)), - mnesia_log:close_log(Name), - case Res of - ok -> ok; - {'EXIT', Reason} -> {error, Reason} + try + do_perform_dump(Cont, false, InitBy, Regulator, undefined) + catch exit:Reason when Reason =/= fatal -> + {error, Reason} + after mnesia_log:close_log(Name) end end. do_perform_dump(Cont, InPlace, InitBy, Regulator, OldVersion) -> case mnesia_log:chunk_log(Cont) of {C2, Recs} -> - case catch insert_recs(Recs, InPlace, InitBy, Regulator, OldVersion) of - {'EXIT', R} -> - Reason = {"Transaction log dump error: ~p~n", [R]}, - close_files(InPlace, {error, Reason}, InitBy), - exit(Reason); + try insert_recs(Recs, InPlace, InitBy, Regulator, OldVersion) of Version -> do_perform_dump(C2, InPlace, InitBy, Regulator, Version) + catch _:R when R =/= fatal -> + ST = erlang:get_stacktrace(), + Reason = {"Transaction log dump error: ~p~n", [{R, ST}]}, + close_files(InPlace, {error, Reason}, InitBy), + exit(Reason) end; eof -> close_files(InPlace, ok, InitBy), @@ -303,17 +302,16 @@ perform_update(Tid, SchemaOps, _DumperMode, _UseDir) -> InitBy = fast_schema_update, InPlace = mnesia_monitor:get_env(dump_log_update_in_place), - ?eval_debug_fun({?MODULE, dump_schema_op}, [InitBy]), - case catch insert_ops(Tid, schema_ops, SchemaOps, InPlace, InitBy, - mnesia_log:version()) of - {'EXIT', Reason} -> - Error = {error, {"Schema update error", Reason}}, + try insert_ops(Tid, schema_ops, SchemaOps, InPlace, InitBy, + mnesia_log:version()), + ?eval_debug_fun({?MODULE, post_dump}, [InitBy]), + close_files(InPlace, ok, InitBy), + ok + catch _:Reason when Reason =/= fatal -> + ST = erlang:get_stacktrace(), + Error = {error, {"Schema update error", {Reason, ST}}}, close_files(InPlace, Error, InitBy), - fatal("Schema update error ~p ~p", [Reason, SchemaOps]); - _ -> - ?eval_debug_fun({?MODULE, post_dump}, [InitBy]), - close_files(InPlace, ok, InitBy), - ok + fatal("Schema update error ~p ~p", [{Reason,ST}, SchemaOps]) end. insert_ops(_Tid, _Storage, [], _InPlace, _InitBy, _) -> ok; @@ -362,13 +360,11 @@ dets_insert(Op,Tab,Key,Val) -> case dets_incr_counter(Tab,Key) of true -> {RecName, Incr} = Val, - case catch dets:update_counter(Tab, Key, Incr) of - CounterVal when is_integer(CounterVal) -> - ok; - _ when Incr < 0 -> + try _ = dets:update_counter(Tab, Key, Incr) + catch error:_ when Incr < 0 -> Zero = {RecName, Key, 0}, ok = dets:insert(Tab, Zero); - _ -> + error:_ -> Init = {RecName, Key, Incr}, ok = dets:insert(Tab, Init) end; @@ -786,7 +782,7 @@ insert_op(Tid, _, {op, clear_table, TabDef}, InPlace, InitBy) -> end, %% Need to catch this, it crashes on ram_copies if %% the op comes before table is loaded at startup. - catch insert(Tid, Storage, Tab, '_', Oid, clear_table, InPlace, InitBy) + ?CATCH(insert(Tid, Storage, Tab, '_', Oid, clear_table, InPlace, InitBy)) end; insert_op(Tid, _, {op, merge_schema, TabDef}, InPlace, InitBy) -> @@ -1060,14 +1056,13 @@ prepare_open(Tab, UpdateInPlace) -> Dat; false -> Tmp = mnesia_lib:tab2tmp(Tab), - case catch mnesia_lib:copy_file(Dat, Tmp) of - ok -> - Tmp; - Error -> + try ok = mnesia_lib:copy_file(Dat, Tmp) + catch error:Error -> fatal("Cannot copy dets file ~p to ~p: ~p~n", [Dat, Tmp, Error]) - end - end. + end, + Tmp + end. del_opened_tab(Tab) -> erase({?MODULE, Tab}). @@ -1189,18 +1184,16 @@ raw_named_dump_table(Tab, Ftype) -> Storage = ram_copies, mnesia_lib:db_fixtable(Storage, Tab, true), - case catch raw_dump_table(TabRef, Tab) of - {'EXIT', Reason} -> - mnesia_lib:db_fixtable(Storage, Tab, false), - mnesia_lib:dets_sync_close(Tab), - file:delete(TmpFname), - mnesia_lib:unlock_table(Tab), - exit({"Dump of table to disc failed", Reason}); - ok -> - mnesia_lib:db_fixtable(Storage, Tab, false), - mnesia_lib:dets_sync_close(Tab), - mnesia_lib:unlock_table(Tab), - ok = file:rename(TmpFname, Fname) + try + ok = raw_dump_table(TabRef, Tab), + ok = file:rename(TmpFname, Fname) + catch _:Reason -> + ?SAFE(file:delete(TmpFname)), + exit({"Dump of table to disc failed", Reason}) + after + mnesia_lib:db_fixtable(Storage, Tab, false), + mnesia_lib:dets_sync_close(Tab), + mnesia_lib:unlock_table(Tab) end; {error, Reason} -> mnesia_lib:unlock_table(Tab), @@ -1266,6 +1259,6 @@ regulate(RegulatorPid) -> val(Var) -> case ?catch_val(Var) of - {'EXIT', Reason} -> mnesia_lib:other_val(Var, Reason); + {'EXIT', _} -> mnesia_lib:other_val(Var); Value -> Value end. diff --git a/lib/mnesia/src/mnesia_event.erl b/lib/mnesia/src/mnesia_event.erl index 67ec9d7399..8a4be88e9a 100644 --- a/lib/mnesia/src/mnesia_event.erl +++ b/lib/mnesia/src/mnesia_event.erl @@ -235,8 +235,7 @@ report_fatal(Format, Args, BinaryCore, CoreDumped) -> end. core_file(CoreDir,BinaryCore,Format,Args) -> - %% Integers = tuple_to_list(date()) ++ tuple_to_list(time()), - Integers = tuple_to_list(now()), + Integers = tuple_to_list(erlang:timestamp()), Fun = fun(I) when I < 10 -> ["_0",I]; (I) -> ["_",I] end, diff --git a/lib/mnesia/src/mnesia_frag.erl b/lib/mnesia/src/mnesia_frag.erl index 66fc20913c..6036ac4e8f 100644 --- a/lib/mnesia/src/mnesia_frag.erl +++ b/lib/mnesia/src/mnesia_frag.erl @@ -406,10 +406,11 @@ verify_numbers(FH,MatchSpec) -> VerifyFun = fun(F) when is_integer(F), F >= 1, F =< N -> false; (_F) -> true end, - case catch lists:filter(VerifyFun, FragNumbers) of - [] -> - FragNumbers; - BadFrags -> + try + Frags = lists:filter(VerifyFun, FragNumbers), + Frags == [] orelse error(Frags), + FragNumbers + catch error:BadFrags -> mnesia:abort({"match_spec_to_frag_numbers: Fragment numbers out of range", BadFrags, {range, 1, N}}) end. @@ -437,7 +438,7 @@ remote_select(ReplyTo, Ref, NameNodes, MatchSpec) -> do_remote_select(ReplyTo, Ref, [{Name, Node} | NameNodes], MatchSpec) -> if Node == node() -> - Res = (catch {ok, mnesia:dirty_select(Name, MatchSpec)}), + Res = ?CATCH({ok, mnesia:dirty_select(Name, MatchSpec)}), ReplyTo ! {remote_select, Ref, Node, Res}, do_remote_select(ReplyTo, Ref, NameNodes, MatchSpec); true -> @@ -886,17 +887,19 @@ adjust_before_split(FH) -> HashMod:add_frag(HashState) end, N = FH#frag_state.n_fragments + 1, - FromFrags2 = (catch lists:sort(FromFrags)), - UnionFrags = (catch lists:merge(FromFrags2, lists:sort(AdditionalWriteFrags))), VerifyFun = fun(F) when is_integer(F), F >= 1, F =< N -> false; (_F) -> true end, - case catch lists:filter(VerifyFun, UnionFrags) of - [] -> - FH2 = FH#frag_state{n_fragments = N, - hash_state = HashState2}, - {FH2, FromFrags2, UnionFrags}; - BadFrags -> + try + FromFrags2 = lists:sort(FromFrags), + UnionFrags = lists:merge(FromFrags2, lists:sort(AdditionalWriteFrags)), + + Frags = lists:filter(VerifyFun, UnionFrags), + Frags == [] orelse error(Frags), + FH2 = FH#frag_state{n_fragments = N, + hash_state = HashState2}, + {FH2, FromFrags2, UnionFrags} + catch error:BadFrags -> mnesia:abort({"add_frag: Fragment numbers out of range", BadFrags, {range, 1, N}}) end. @@ -981,22 +984,24 @@ adjust_before_merge(FH) -> HashMod:del_frag(HashState) end, N = FH#frag_state.n_fragments, - FromFrags2 = (catch lists:sort(FromFrags)), - UnionFrags = (catch lists:merge(FromFrags2, lists:sort(AdditionalWriteFrags))), VerifyFun = fun(F) when is_integer(F), F >= 1, F =< N -> false; (_F) -> true end, - case catch lists:filter(VerifyFun, UnionFrags) of - [] -> - case lists:member(N, FromFrags2) of - true -> - FH2 = FH#frag_state{n_fragments = N - 1, - hash_state = HashState2}, - {FH2, FromFrags2, UnionFrags}; + try + FromFrags2 = lists:sort(FromFrags), + UnionFrags = lists:merge(FromFrags2, lists:sort(AdditionalWriteFrags)), + + Frags = lists:filter(VerifyFun, UnionFrags), + [] == Frags orelse error(Frags), + case lists:member(N, FromFrags2) of + true -> + FH2 = FH#frag_state{n_fragments = N - 1, + hash_state = HashState2}, + {FH2, FromFrags2, UnionFrags}; false -> - mnesia:abort({"del_frag: Last fragment number not included", N}) - end; - BadFrags -> + mnesia:abort({"del_frag: Last fragment number not included", N}) + end + catch error:BadFrags -> mnesia:abort({"del_frag: Fragment numbers out of range", BadFrags, {range, 1, N}}) end. @@ -1141,8 +1146,8 @@ remove_node(Node, Cs) -> val(Var) -> case ?catch_val(Var) of - {'EXIT', Reason} -> mnesia_lib:other_val(Var, Reason); - Value -> Value + {'EXIT', _} -> mnesia_lib:other_val(Var); + Value -> Value end. set_frag_hash(Tab, Props) -> diff --git a/lib/mnesia/src/mnesia_index.erl b/lib/mnesia/src/mnesia_index.erl index 87cb58dae1..6a7c964fce 100644 --- a/lib/mnesia/src/mnesia_index.erl +++ b/lib/mnesia/src/mnesia_index.erl @@ -45,21 +45,11 @@ del_transient/3, del_index_table/3]). --import(mnesia_lib, [verbose/2]). +-import(mnesia_lib, [val/1, verbose/2]). -include("mnesia.hrl"). -record(index, {setorbag, pos_list}). -val(Var) -> - case ?catch_val(Var) of - {'EXIT', _ReASoN_} -> - case mnesia_lib:other_val(Var) of - error -> mnesia_lib:pr_other(Var, _ReASoN_); - Val -> Val - end; - _VaLuE_ -> _VaLuE_ - end. - %% read an object list throuh its index table %% we assume that table Tab has index on attribute number Pos diff --git a/lib/mnesia/src/mnesia_late_loader.erl b/lib/mnesia/src/mnesia_late_loader.erl index d09de3ca66..9a113c6306 100644 --- a/lib/mnesia/src/mnesia_late_loader.erl +++ b/lib/mnesia/src/mnesia_late_loader.erl @@ -36,17 +36,19 @@ -define(SERVER_NAME, ?MODULE). +-include("mnesia.hrl"). + -record(state, {supervisor}). async_late_disc_load(_, [], _) -> ok; async_late_disc_load(Node, Tabs, Reason) -> Msg = {async_late_disc_load, Tabs, Reason}, - catch ({?SERVER_NAME, Node} ! {self(), Msg}). + ?SAFE({?SERVER_NAME, Node} ! {self(), Msg}). maybe_async_late_disc_load(_, [], _) -> ok; maybe_async_late_disc_load(Node, Tabs, Reason) -> Msg = {maybe_async_late_disc_load, Tabs, Reason}, - catch ({?SERVER_NAME, Node} ! {self(), Msg}). + ?SAFE({?SERVER_NAME, Node} ! {self(), Msg}). start() -> mnesia_monitor:start_proc(?SERVER_NAME, ?MODULE, init, [self()]). diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index a32c69c59e..7bd207f816 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -114,9 +114,7 @@ lock_table/1, mkcore/1, not_active_here/1, - other_val/2, other_val/1, - pr_other/2, overload_read/0, overload_read/1, overload_set/2, @@ -380,8 +378,8 @@ search_key(_Key, []) -> val(Var) -> case ?catch_val(Var) of - {'EXIT', _ReASoN_} -> mnesia_lib:other_val(Var, _ReASoN_); - _VaLuE_ -> _VaLuE_ + {'EXIT', _} -> other_val(Var); + _VaLuE_ -> _VaLuE_ end. set(Var, Val) -> @@ -390,13 +388,13 @@ set(Var, Val) -> unset(Var) -> ?ets_delete(mnesia_gvar, Var). -other_val(Var, Other) -> - case other_val(Var) of - error -> pr_other(Var, Other); +other_val(Var) -> + case other_val_1(Var) of + error -> pr_other(Var); Val -> Val end. -other_val(Var) -> +other_val_1(Var) -> case Var of {_, where_to_read} -> nowhere; {_, where_to_write} -> []; @@ -404,21 +402,16 @@ other_val(Var) -> _ -> error end. -pr_other(Var, Other) -> - Why = +pr_other(Var) -> + Why = case is_running() of no -> {node_not_running, node()}; _ -> {no_exists, Var} end, - verbose("~p (~p) val(mnesia_gvar, ~w) -> ~p ~p ~n", + verbose("~p (~p) val(mnesia_gvar, ~w) -> ~p ~n", [self(), process_info(self(), registered_name), - Var, Other, Why]), - case Other of - {badarg, [{ets, lookup_element, _, _}|_]} -> - exit(Why); - _ -> - erlang:error(Why) - end. + Var, Why]), + exit(Why). %% Some functions for list valued variables add(Var, Val) -> @@ -905,7 +898,7 @@ dirty_rpc_error_tag(Reason) -> end. fatal(Format, Args) -> - catch set(mnesia_status, stopping), + ?SAFE(catch set(mnesia_status, stopping)), Core = mkcore({crashinfo, {Format, Args}}), report_fatal(Format, Args, Core), timer:sleep(10000), % Enough to write the core dump to disc? @@ -917,7 +910,7 @@ report_fatal(Format, Args) -> report_fatal(Format, Args, Core) -> report_system_event({mnesia_fatal, Format, Args, Core}), - catch exit(whereis(mnesia_monitor), fatal). + ?SAFE(exit(whereis(mnesia_monitor), fatal)). %% We sleep longer and longer the more we try %% Made some testing and came up with the following constants @@ -930,8 +923,9 @@ random_time(Retries, _Counter0) -> case get(random_seed) of undefined -> - {X, Y, Z} = erlang:now(), %% time() - _ = random:seed(X, Y, Z), + _ = random:seed(erlang:unique_integer(), + erlang:monotonic_time(), + erlang:unique_integer()), Time = Dup + random:uniform(MaxIntv), %% dbg_out("---random_test rs ~w max ~w val ~w---~n", [Retries, MaxIntv, Time]), Time; @@ -1013,7 +1007,7 @@ dbg_out(Format, Args) -> %% Keep the last 10 debug print outs save(DbgInfo) -> - catch save2(DbgInfo). + ?SAFE(save2(DbgInfo)). save2(DbgInfo) -> Key = {'$$$_report', current_pos}, @@ -1089,35 +1083,29 @@ db_match_object(Tab, Pat) -> db_match_object(val({Tab, storage_type}), Tab, Pat). db_match_object(Storage, Tab, Pat) -> db_fixtable(Storage, Tab, true), - Res = catch_match_object(Storage, Tab, Pat), - db_fixtable(Storage, Tab, false), - case Res of - {'EXIT', Reason} -> exit(Reason); - _ -> Res + try + case Storage of + disc_only_copies -> dets:match_object(Tab, Pat); + _ -> ets:match_object(Tab, Pat) + end + after + db_fixtable(Storage, Tab, false) end. -catch_match_object(disc_only_copies, Tab, Pat) -> - catch dets:match_object(Tab, Pat); -catch_match_object(_, Tab, Pat) -> - catch ets:match_object(Tab, Pat). - db_select(Tab, Pat) -> db_select(val({Tab, storage_type}), Tab, Pat). db_select(Storage, Tab, Pat) -> db_fixtable(Storage, Tab, true), - Res = catch_select(Storage, Tab, Pat), - db_fixtable(Storage, Tab, false), - case Res of - {'EXIT', Reason} -> exit(Reason); - _ -> Res + try + case Storage of + disc_only_copies -> dets:select(Tab, Pat); + _ -> ets:select(Tab, Pat) + end + after + db_fixtable(Storage, Tab, false) end. -catch_select(disc_only_copies, Tab, Pat) -> - catch dets:select(Tab, Pat); -catch_select(_, Tab, Pat) -> - catch ets:select(Tab, Pat). - db_select_init(disc_only_copies, Tab, Pat, Limit) -> dets:select(Tab, Pat, Limit); db_select_init(_, Tab, Pat, Limit) -> @@ -1261,7 +1249,7 @@ dets_sync_open(Tab, Args) -> end. dets_sync_close(Tab) -> - catch dets:close(Tab), + ?SAFE(dets:close(Tab)), unlock_table(Tab), ok. @@ -1297,7 +1285,7 @@ readable_indecies(Tab) -> scratch_debug_fun() -> dbg_out("scratch_debug_fun(): ~p~n", [?DEBUG_TAB]), - (catch ?ets_delete_table(?DEBUG_TAB)), + ?SAFE(?ets_delete_table(?DEBUG_TAB)), ?ets_new_table(?DEBUG_TAB, [set, public, named_table, {keypos, 2}]). activate_debug_fun(FunId, Fun, InitialContext, File, Line) -> @@ -1310,43 +1298,45 @@ activate_debug_fun(FunId, Fun, InitialContext, File, Line) -> update_debug_info(Info). update_debug_info(Info) -> - case catch ?ets_insert(?DEBUG_TAB, Info) of - {'EXIT', _} -> + try ?ets_insert(?DEBUG_TAB, Info), + ok + catch error:_ -> scratch_debug_fun(), - ?ets_insert(?DEBUG_TAB, Info); - _ -> - ok + ?ets_insert(?DEBUG_TAB, Info) end, dbg_out("update_debug_info(~p)~n", [Info]), ok. deactivate_debug_fun(FunId, _File, _Line) -> - catch ?ets_delete(?DEBUG_TAB, FunId), + ?SAFE(?ets_delete(?DEBUG_TAB, FunId)), ok. eval_debug_fun(FunId, EvalContext, EvalFile, EvalLine) -> - case catch ?ets_lookup(?DEBUG_TAB, FunId) of - [] -> - ok; - [Info] -> - OldContext = Info#debug_info.context, - dbg_out("~s(~p): ~w " - "activated in ~s(~p)~n " - "eval_debug_fun(~w, ~w)~n", - [filename:basename(EvalFile), EvalLine, Info#debug_info.id, - filename:basename(Info#debug_info.file), Info#debug_info.line, - OldContext, EvalContext]), - Fun = Info#debug_info.function, - NewContext = Fun(OldContext, EvalContext), - - case catch ?ets_lookup(?DEBUG_TAB, FunId) of - [Info] when NewContext /= OldContext -> - NewInfo = Info#debug_info{context = NewContext}, - update_debug_info(NewInfo); - _ -> - ok - end; - {'EXIT', _} -> ok + try + case ?ets_lookup(?DEBUG_TAB, FunId) of + [] -> + ok; + [Info] -> + OldContext = Info#debug_info.context, + dbg_out("~s(~p): ~w " + "activated in ~s(~p)~n " + "eval_debug_fun(~w, ~w)~n", + [filename:basename(EvalFile), EvalLine, Info#debug_info.id, + filename:basename(Info#debug_info.file), Info#debug_info.line, + OldContext, EvalContext]), + Fun = Info#debug_info.function, + NewContext = Fun(OldContext, EvalContext), + + case ?ets_lookup(?DEBUG_TAB, FunId) of + [Info] when NewContext /= OldContext -> + NewInfo = Info#debug_info{context = NewContext}, + update_debug_info(NewInfo); + _ -> + ok + end + end + catch error -> + ok end. -ifdef(debug). diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index cbb3d7e430..65ea743fd3 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -35,7 +35,7 @@ val(Var) -> case ?catch_val(Var) of - {'EXIT', Reason} -> mnesia_lib:other_val(Var, Reason); + {'EXIT', _} -> mnesia_lib:other_val(Var); Value -> Value end. @@ -332,7 +332,7 @@ wait_on_load_complete(Pid) -> {Pid, Res} -> Res; {'EXIT', Pid, Reason} -> - exit(Reason); + error(Reason); Else -> Pid ! Else, wait_on_load_complete(Pid) @@ -442,18 +442,18 @@ init_table(Tab, disc_only_copies, Fun, DetsInfo,Sender) -> ErtsVer = erlang:system_info(version), case DetsInfo of {ErtsVer, DetsData} -> - Res = (catch dets:is_compatible_bchunk_format(Tab, DetsData)), - case Res of - {'EXIT',{undef,[{dets,_,_,_}|_]}} -> - Sender ! {self(), {old_protocol, Tab}}, - dets:init_table(Tab, Fun); %% Old dets version - {'EXIT', What} -> - exit(What); + try dets:is_compatible_bchunk_format(Tab, DetsData) of false -> Sender ! {self(), {old_protocol, Tab}}, dets:init_table(Tab, Fun); %% Old dets version true -> dets:init_table(Tab, Fun, [{format, bchunk}]) + catch + error:{undef,[{dets,_,_,_}|_]} -> + Sender ! {self(), {old_protocol, Tab}}, + dets:init_table(Tab, Fun); %% Old dets version + error:What -> + What end; Old when Old /= false -> Sender ! {self(), {old_protocol, Tab}}, @@ -462,10 +462,10 @@ init_table(Tab, disc_only_copies, Fun, DetsInfo,Sender) -> dets:init_table(Tab, Fun) end; init_table(Tab, _, Fun, _DetsInfo,_) -> - case catch ets:init_table(Tab, Fun) of - true -> - ok; - {'EXIT', Else} -> Else + try + true = ets:init_table(Tab, Fun), + ok + catch _:Else -> {Else, erlang:get_stacktrace()} end. @@ -572,9 +572,9 @@ handle_last({ram_copies, Tab}, _Type, DatBin) -> down(Tab, Storage) -> case Storage of ram_copies -> - catch ?ets_delete_table(Tab); + ?SAFE(?ets_delete_table(Tab)); disc_copies -> - catch ?ets_delete_table(Tab); + ?SAFE(?ets_delete_table(Tab)); disc_only_copies -> TmpFile = mnesia_lib:tab2tmp(Tab), mnesia_lib:dets_sync_close(Tab), @@ -658,26 +658,23 @@ send_table(Pid, Tab, RemoteS) -> {Init, Chunk} = reader_funcs(UseDetsChunk, Tab, Storage, KeysPerTransfer), SendIt = fun() -> - prepare_copy(Pid, Tab, Storage), + {atomic, ok} = prepare_copy(Pid, Tab, Storage), send_more(Pid, 1, Chunk, Init(), Tab), finish_copy(Pid, Tab, Storage, RemoteS) end, - case catch SendIt() of - receiver_died -> + try SendIt() of + {_, receiver_died} -> ok; + {atomic, no_more} -> ok + catch + throw:receiver_died -> cleanup_tab_copier(Pid, Storage, Tab), - unlink(whereis(mnesia_tm)), ok; - {_, receiver_died} -> - unlink(whereis(mnesia_tm)), - ok; - {atomic, no_more} -> - unlink(whereis(mnesia_tm)), - ok; - Reason -> + error:Reason -> %% Prepare failed cleanup_tab_copier(Pid, Storage, Tab), - unlink(whereis(mnesia_tm)), - {error, Reason} + {error, {tab_copier, Tab, {Reason, erlang:get_stacktrace()}}} + after + unlink(whereis(mnesia_tm)) end end. @@ -690,12 +687,7 @@ prepare_copy(Pid, Tab, Storage) -> mnesia_lib:db_fixtable(Storage, Tab, true), ok end, - case mnesia:transaction(Trans) of - {atomic, ok} -> - ok; - {aborted, Reason} -> - exit({tab_copier_prepare, Tab, Reason}) - end. + mnesia:transaction(Trans). update_where_to_write(Tab, Node) -> case val({Tab, access_mode}) of @@ -828,6 +820,6 @@ dat2bin(_Tab, _LocalS, _RemoteS) -> nobin. handle_exit(Pid, Reason) when node(Pid) == node() -> - exit(Reason); + error(Reason); handle_exit(_Pid, _Reason) -> %% Not from our node, this will be handled by ignore. %% mnesia_down soon. diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl index 1efb939e00..6658dbeacb 100644 --- a/lib/mnesia/src/mnesia_locker.erl +++ b/lib/mnesia/src/mnesia_locker.erl @@ -98,7 +98,7 @@ init(Parent) -> val(Var) -> case ?catch_val(Var) of - {'EXIT', _ReASoN_} -> mnesia_lib:other_val(Var, _ReASoN_); + {'EXIT', _} -> mnesia_lib:other_val(Var); _VaLuE_ -> _VaLuE_ end. @@ -1001,13 +1001,11 @@ flush_remaining(Ns=[Node | Tail], SkipNode, Res) -> opt_lookup_in_client(lookup_in_client, Oid, Lock) -> {Tab, Key} = Oid, - case catch mnesia_lib:db_get(Tab, Key) of - {'EXIT', _} -> + try mnesia_lib:db_get(Tab, Key) + catch error:_ -> %% Table has been deleted from this node, %% restart the transaction. - #cyclic{op = read, lock = Lock, oid = Oid, lucky = nowhere}; - Val -> - Val + #cyclic{op = read, lock = Lock, oid = Oid, lucky = nowhere} end; opt_lookup_in_client(Val, _Oid, _Lock) -> Val. @@ -1139,11 +1137,10 @@ send_requests([], _X) -> rec_requests([Node | Nodes], Oid, Store) -> Res = l_req_rec(Node, Store), - case catch rlock_get_reply(Node, Store, Oid, Res) of - {'EXIT', Reason} -> - flush_remaining(Nodes, Node, Reason); - _ -> - rec_requests(Nodes, Oid, Store) + try rlock_get_reply(Node, Store, Oid, Res) of + _ -> rec_requests(Nodes, Oid, Store) + catch _:Reason -> + flush_remaining(Nodes, Node, Reason) end; rec_requests([], _Oid, _Store) -> ok. diff --git a/lib/mnesia/src/mnesia_log.erl b/lib/mnesia/src/mnesia_log.erl index d2fd04a60b..21ad0ffdb6 100644 --- a/lib/mnesia/src/mnesia_log.erl +++ b/lib/mnesia/src/mnesia_log.erl @@ -200,7 +200,7 @@ log_header(Kind, Version) -> log_kind=Kind, mnesia_version=mnesia:system_info(version), node=node(), - now=now()}. + now=erlang:timestamp()}. version() -> "4.3". @@ -462,7 +462,7 @@ chunk_log(Cont) -> chunk_log(_Log, eof) -> eof; chunk_log(Log, Cont) -> - case catch disk_log:chunk(Log, Cont) of + case disk_log:chunk(Log, Cont) of {error, Reason} -> fatal("Possibly truncated ~p file: ~p~n", [Log, Reason]); @@ -647,11 +647,11 @@ backup_checkpoint(Name, Opaque, Args) when is_list(Args) -> end. check_backup_args([Arg | Tail], B) -> - case catch check_backup_arg_type(Arg, B) of - {'EXIT', _Reason} -> - {error, {badarg, Arg}}; + try check_backup_arg_type(Arg, B) of B2 -> check_backup_args(Tail, B2) + catch error:_ -> + {error, {badarg, Arg}} end; check_backup_args([], B) -> @@ -674,11 +674,11 @@ check_backup_arg_type(Arg, B) -> backup_master(ClientPid, B) -> process_flag(trap_exit, true), - case catch do_backup_master(B) of - {'EXIT', Reason} -> - ClientPid ! {self(), ClientPid, {error, {'EXIT', Reason}}}; + try do_backup_master(B) of Res -> ClientPid ! {self(), ClientPid, Res} + catch _:Reason -> + ClientPid ! {self(), ClientPid, {error, {'EXIT', Reason}}} end, unlink(ClientPid), exit(normal). @@ -736,10 +736,10 @@ safe_apply(B, What, Args) -> {'EXIT', Pid, R} -> Abort({'EXIT', Pid, R}) after 0 -> Mod = B#backup_args.module, - case catch apply(Mod, What, Args) of + try apply(Mod, What, Args) of {ok, Opaque} -> B#backup_args{opaque=Opaque}; - {error, R} -> Abort(R); - R -> Abort(R) + {error, R} -> Abort(R) + catch _:R -> Abort(R) end end. @@ -748,10 +748,9 @@ abort_write(B, What, Args, Reason) -> Opaque = B#backup_args.opaque, dbg_out("Failed to perform backup. M=~p:F=~p:A=~p -> ~p~n", [Mod, What, Args, Reason]), - case catch apply(Mod, abort_write, [Opaque]) of - {ok, _Res} -> - throw({error, Reason}); - Other -> + try apply(Mod, abort_write, [Opaque]) of + {ok, _Res} -> throw({error, Reason}) + catch _:Other -> error("Failed to abort backup. ~p:~p~p -> ~p~n", [Mod, abort_write, [Opaque], Other]), throw({error, Reason}) @@ -892,10 +891,8 @@ tab_receiver(Pid, B, Tab, RecName, Slot) -> end. rec_filter(B, schema, _RecName, Recs) -> - case catch mnesia_bup:refresh_cookie(Recs, B#backup_args.cookie) of - Recs2 when is_list(Recs2) -> - Recs2; - {error, _Reason} -> + try mnesia_bup:refresh_cookie(Recs, B#backup_args.cookie) + catch throw:{error, _Reason} -> %% No schema table cookie Recs end; @@ -1006,13 +1003,14 @@ add_recs([{{Tab, _Key}, Val, delete_object} | Rest], N) -> add_recs(Rest, N+1); add_recs([{{Tab, Key}, Val, update_counter} | Rest], N) -> {RecName, Incr} = Val, - case catch ets:update_counter(Tab, Key, Incr) of - CounterVal when is_integer(CounterVal) -> - ok; - _ when Incr < 0 -> + try + CounterVal = ets:update_counter(Tab, Key, Incr), + true = (CounterVal >= 0) + catch + error:_ when Incr < 0 -> Zero = {RecName, Key, 0}, true = ets:insert(Tab, Zero); - _ -> + error:_ -> Zero = {RecName, Key, Incr}, true = ets:insert(Tab, Zero) end, diff --git a/lib/mnesia/src/mnesia_monitor.erl b/lib/mnesia/src/mnesia_monitor.erl index a0e0e630ec..14b1ab5c1a 100644 --- a/lib/mnesia/src/mnesia_monitor.erl +++ b/lib/mnesia/src/mnesia_monitor.erl @@ -268,7 +268,7 @@ init([Parent]) -> set(version, Version), dbg_out("Version: ~p~n", [Version]), - case catch process_config_args(env()) of + try process_config_args(env()) of ok -> mnesia_lib:set({'$$$_report', current_pos}, 0), Level = mnesia_lib:val(debug), @@ -288,8 +288,8 @@ init([Parent]) -> set(pending_checkpoints, []), set(pending_checkpoint_pids, []), - {ok, #state{supervisor = Parent}}; - {'EXIT', Reason} -> + {ok, #state{supervisor = Parent}} + catch _:Reason -> mnesia_lib:report_fatal("Bad configuration: ~p~n", [Reason]), {stop, {bad_config, Reason}} end. @@ -323,25 +323,24 @@ non_empty_dir() -> %%---------------------------------------------------------------------- handle_call({mktab, Tab, Args}, _From, State) -> - case catch ?ets_new_table(Tab, Args) of - {'EXIT', ExitReason} -> + try ?ets_new_table(Tab, Args) of + Reply -> + {reply, Reply, State} + catch error:ExitReason -> Msg = "Cannot create ets table", Reason = {system_limit, Msg, Tab, Args, ExitReason}, fatal("~p~n", [Reason]), - {noreply, State}; - Reply -> - {reply, Reply, State} + {noreply, State} end; handle_call({unsafe_mktab, Tab, Args}, _From, State) -> - case catch ?ets_new_table(Tab, Args) of - {'EXIT', ExitReason} -> - {reply, {error, ExitReason}, State}; + try ?ets_new_table(Tab, Args) of Reply -> {reply, Reply, State} + catch error:ExitReason -> + {reply, {error, ExitReason}, State} end; - handle_call({open_dets, Tab, Args}, _From, State) -> case mnesia_lib:dets_sync_open(Tab, Args) of {ok, Tab} -> @@ -546,7 +545,7 @@ handle_info({'EXIT', Pid, fatal}, State) when node(Pid) == node() -> %% is in progress %% exit(State#state.supervisor, shutdown), %% It is better to kill an innocent process - catch exit(whereis(mnesia_locker), kill), + ?SAFE(exit(whereis(mnesia_locker), kill)), {noreply, State}; handle_info(Msg = {'EXIT',Pid,_}, State) -> @@ -727,11 +726,8 @@ default_env(send_compressed) -> 0. check_type(Env, Val) -> - case catch do_check_type(Env, Val) of - {'EXIT', _Reason} -> - exit({bad_config, Env, Val}); - NewVal -> - NewVal + try do_check_type(Env, Val) + catch error:_ -> exit({bad_config, Env, Val}) end. do_check_type(access_module, A) when is_atom(A) -> A; @@ -781,12 +777,12 @@ media(opt_disc) -> opt_disc; media(ram) -> ram. patch_env(Env, Val) -> - case catch do_check_type(Env, Val) of - {'EXIT', _Reason} -> - {error, {bad_type, Env, Val}}; + try do_check_type(Env, Val) of NewVal -> application_controller:set_env(mnesia, Env, NewVal), NewVal + catch error:_ -> + {error, {bad_type, Env, Val}} end. detect_partitioned_network(Mon, Node) -> diff --git a/lib/mnesia/src/mnesia_recover.erl b/lib/mnesia/src/mnesia_recover.erl index eeb4fa0ced..aa567a23cb 100644 --- a/lib/mnesia/src/mnesia_recover.erl +++ b/lib/mnesia/src/mnesia_recover.erl @@ -178,11 +178,8 @@ log_decision(D) -> val(Var) -> case ?catch_val(Var) of - {'EXIT', Reason} -> - case mnesia_lib:other_val(Var) of - error -> mnesia_lib:pr_other(Var, Reason); - Val -> Val - end; + {'EXIT', _Reason} -> + mnesia_lib:other_val(Var); Value -> Value end. @@ -373,11 +370,8 @@ log_master_nodes2([], _UseDir, IsRunning, WorstRes) -> get_master_node_info() -> Tab = mnesia_decision, Pat = {master_nodes, '_', '_'}, - case catch mnesia_lib:db_match_object(ram_copies,Tab, Pat) of - {'EXIT', _} -> - []; - Masters -> - Masters + try mnesia_lib:db_match_object(ram_copies,Tab, Pat) + catch error:_ -> [] end. get_master_node_tables() -> @@ -385,9 +379,8 @@ get_master_node_tables() -> [Tab || {master_nodes, Tab, _Nodes} <- Masters]. get_master_nodes(Tab) -> - case catch ?ets_lookup_element(mnesia_decision, Tab, 3) of - {'EXIT', _} -> []; - Nodes -> Nodes + try ?ets_lookup_element(mnesia_decision, Tab, 3) + catch error:_ -> [] end. %% Determine what has happened to the transaction @@ -485,8 +478,6 @@ load_decision_tab() -> load_decision_tab(Cont, load_decision_tab), mnesia_log:close_decision_tab(). -load_decision_tab(eof, _InitBy) -> - ok; load_decision_tab(Cont, InitBy) -> case mnesia_log:chunk_decision_tab(Cont) of {Cont2, Decisions} -> @@ -519,8 +510,6 @@ dump_decision_log(InitBy) -> Cont = mnesia_log:prepare_decision_log_dump(), perform_dump_decision_log(Cont, InitBy). -perform_dump_decision_log(eof, _InitBy) -> - confirm_decision_log_dump(); perform_dump_decision_log(Cont, InitBy) when InitBy == startup -> case mnesia_log:chunk_decision_log(Cont) of {Cont2, Decisions} -> @@ -1024,7 +1013,7 @@ decision(Tid) -> decision(Tid, tabs()). decision(Tid, [Tab | Tabs]) -> - case catch ?ets_lookup(Tab, Tid) of + try ?ets_lookup(Tab, Tid) of [D] when is_record(D, decision) -> D; [C] when is_record(C, transient_decision) -> @@ -1034,8 +1023,8 @@ decision(Tid, [Tab | Tabs]) -> ram_nodes = [] }; [] -> - decision(Tid, Tabs); - {'EXIT', _} -> + decision(Tid, Tabs) + catch error:_ -> %% Recently switched transient decision table decision(Tid, Tabs) end; @@ -1046,11 +1035,8 @@ outcome(Tid, Default) -> outcome(Tid, Default, tabs()). outcome(Tid, Default, [Tab | Tabs]) -> - case catch ?ets_lookup_element(Tab, Tid, 3) of - {'EXIT', _} -> - outcome(Tid, Default, Tabs); - Val -> - Val + try ?ets_lookup_element(Tab, Tid, 3) + catch error:_ -> outcome(Tid, Default, Tabs) end; outcome(_Tid, Default, []) -> Default. diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index 6e43052fb0..4c8234bbc7 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -151,7 +151,7 @@ exit_on_error(GoodRes) -> val(Var) -> case ?catch_val(Var) of - {'EXIT', Reason} -> mnesia_lib:other_val(Var, Reason); + {'EXIT', _} -> mnesia_lib:other_val(Var); Value -> Value end. @@ -262,7 +262,7 @@ incr_version(Cs) -> [] -> {Major + 1, 0}; % All replicas are active _ -> {Major, Minor + 1} % Some replicas are inactive end, - Cs#cstruct{version = {V, {node(), now()}}}. + Cs#cstruct{version = {V, {node(), erlang:timestamp()}}}. %% Returns table name insert_cstruct(Tid, Cs, KeepWhereabouts) -> @@ -2151,14 +2151,14 @@ prepare_op(_Tid, {op, transform, Fun, TabDef}, _WaitFor) -> mnesia_lib:db_fixtable(Storage, Tab, true), Key = mnesia_lib:db_first(Tab), Op = {op, transform, Fun, TabDef}, - case catch transform_objs(Fun, Tab, RecName, - Key, NewArity, Storage, Type, [Op]) of - {'EXIT', Reason} -> - mnesia_lib:db_fixtable(Storage, Tab, false), - exit({"Bad transform function", Tab, Fun, node(), Reason}); + try transform_objs(Fun, Tab, RecName, Key, + NewArity, Storage, Type, [Op]) of Objs -> mnesia_lib:db_fixtable(Storage, Tab, false), {true, Objs, mandatory} + catch _:Reason -> + mnesia_lib:db_fixtable(Storage, Tab, false), + exit({"Bad transform function", Tab, Fun, node(), Reason}) end end; @@ -2342,7 +2342,7 @@ undo_prepare_commit(Tid, Commit) -> ignore; Ops -> %% Catch to allow failure mnesia_controller may not be started - catch mnesia_controller:release_schema_commit_lock(), + ?SAFE(mnesia_controller:release_schema_commit_lock()), undo_prepare_ops(Tid, Ops) end, Commit. @@ -2489,14 +2489,14 @@ ram_delete_table(Tab, Storage) -> %% delete possible index files and data ..... %% Got to catch this since if no info has been set in the %% mnesia_gvar it will crash - catch mnesia_index:del_transient(Tab, Storage), + ?CATCH(mnesia_index:del_transient(Tab, Storage)), case ?catch_val({Tab, {index, snmp}}) of {'EXIT', _} -> ignore; Etab -> - catch mnesia_snmp_hook:delete_table(Tab, Etab) + ?SAFE(mnesia_snmp_hook:delete_table(Tab, Etab)) end, - catch ?ets_delete_table(Tab) + ?SAFE(?ets_delete_table(Tab)) end. purge_dir(Dir, KeepFiles) -> @@ -2584,10 +2584,7 @@ info2(_, []) -> io:format("~n", []). get_table_properties(Tab) -> - case catch mnesia_lib:db_match_object(ram_copies, - mnesia_gvar, {{Tab, '_'}, '_'}) of - {'EXIT', _} -> - mnesia:abort({no_exists, Tab, all}); + try mnesia_lib:db_match_object(ram_copies, mnesia_gvar, {{Tab, '_'}, '_'}) of RawGvar -> case [{Item, Val} || {{_Tab, Item}, Val} <- RawGvar] of [] -> @@ -2598,6 +2595,8 @@ get_table_properties(Tab) -> Master = {master_nodes, mnesia:table_info(Tab, master_nodes)}, lists:sort([Size, Memory, Master | Gvar]) end + catch error:_ -> + mnesia:abort({no_exists, Tab, all}) end. %%%%%%%%%%% RESTORE %%%%%%%%%%% @@ -2620,15 +2619,15 @@ restore(_Opaque, BadArg) -> {aborted, {badarg, BadArg}}. restore(Opaque, Args, Module) when is_list(Args), is_atom(Module) -> InitR = #r{opaque = Opaque, module = Module}, - case catch lists:foldl(fun check_restore_arg/2, InitR, Args) of + try lists:foldl(fun check_restore_arg/2, InitR, Args) of R when is_record(R, r) -> case mnesia_bup:read_schema(R#r.module, Opaque) of {error, Reason} -> {aborted, Reason}; BupSchema -> schema_transaction(fun() -> do_restore(R, BupSchema) end) - end; - {'EXIT', Reason} -> + end + catch exit:Reason -> {aborted, Reason} end; restore(_Opaque, Args, Module) -> @@ -3073,15 +3072,13 @@ do_make_merge_schema(Node, NeedsConv, RemoteCs = #cstruct{}) -> %% Returns a new cstruct or issues a fatal error merge_cstructs(Cs, RemoteCs, Force) -> verify_cstruct(Cs), - case catch do_merge_cstructs(Cs, RemoteCs, Force) of - {'EXIT', {aborted, _Reason}} when Force == true -> - Cs; - {'EXIT', Reason} -> - exit(Reason); + try do_merge_cstructs(Cs, RemoteCs, Force) of MergedCs when is_record(MergedCs, cstruct) -> - MergedCs; - Other -> - throw(Other) + MergedCs + catch exit:{aborted, _Reason} when Force == true -> + Cs; + exit:Reason -> exit(Reason); + error:Reason -> exit(Reason) end. do_merge_cstructs(Cs, RemoteCs, Force) -> diff --git a/lib/mnesia/src/mnesia_snmp_hook.erl b/lib/mnesia/src/mnesia_snmp_hook.erl index 256f83b029..c76cf89ebb 100644 --- a/lib/mnesia/src/mnesia_snmp_hook.erl +++ b/lib/mnesia/src/mnesia_snmp_hook.erl @@ -30,15 +30,6 @@ -include("mnesia.hrl"). -val(Var) -> - case ?catch_val(Var) of - {'EXIT', _ReASoN_} -> - case mnesia_lib:other_val(Var) of - error -> mnesia_lib:pr_other(Var, _ReASoN_); - Val -> Val - end; - _VaLuE_ -> _VaLuE_ - end. check_ustruct([]) -> true; %% default value, not SNMP'ified @@ -85,12 +76,12 @@ delete_table(_MnesiaTab, Tree) -> %%----------------------------------------------------------------- update({clear_table, MnesiaTab}) -> - Tree = val({MnesiaTab, {index, snmp}}), + Tree = mnesia_lib:val({MnesiaTab, {index, snmp}}), b_clear(Tree), ok; update({Op, MnesiaTab, MnesiaKey, SnmpKey}) -> - Tree = val({MnesiaTab, {index, snmp}}), + Tree = mnesia_lib:val({MnesiaTab, {index, snmp}}), update(Op, Tree, MnesiaKey, SnmpKey). update(Op, Tree, MnesiaKey, SnmpKey) -> @@ -120,7 +111,7 @@ update(Op, Tree, MnesiaKey, SnmpKey) -> %%----------------------------------------------------------------- key_to_oid(Tab,Key) -> - Types = val({Tab,snmp}), + Types = mnesia_lib:val({Tab,snmp}), key_to_oid(Tab, Key, Types). key_to_oid(Tab, Key, [{key, Types}]) -> @@ -144,7 +135,7 @@ keys_to_oid(N, Key, Oid, Types) -> %% This can be lookup up in tree but that might be on a remote node. %% It's probably faster to look it up, but use when it migth be remote oid_to_key(Oid, Tab) -> - [{key, Types}] = val({Tab,snmp}), + [{key, Types}] = mnesia_lib:val({Tab,snmp}), oid_to_key_1(Types, Oid). oid_to_key_1(integer, [Key]) -> Key; diff --git a/lib/mnesia/src/mnesia_subscr.erl b/lib/mnesia/src/mnesia_subscr.erl index 866a57e370..c39edea9e3 100644 --- a/lib/mnesia/src/mnesia_subscr.erl +++ b/lib/mnesia/src/mnesia_subscr.erl @@ -186,11 +186,11 @@ patch_record(Tab, Obj) -> end. what(Tab, Tid, {RecName, Key}, delete, undefined) -> - case catch mnesia_lib:db_get(Tab, Key) of - Old when is_list(Old) -> %% Op only allowed for set table. - {mnesia_table_event, {delete, Tab, {RecName, Key}, Old, Tid}}; - _ -> - %% Record just deleted by a dirty_op or + try mnesia_lib:db_get(Tab, Key) of + Old -> %% Op only allowed for set table. + {mnesia_table_event, {delete, Tab, {RecName, Key}, Old, Tid}} + catch error:_ -> + %% Record just deleted by a dirty_op or %% the whole table has been deleted ignore end; @@ -199,10 +199,10 @@ what(Tab, Tid, Obj, delete, Old) -> what(Tab, Tid, Obj, delete_object, _Old) -> {mnesia_table_event, {delete, Tab, Obj, [Obj], Tid}}; what(Tab, Tid, Obj, write, undefined) -> - case catch mnesia_lib:db_get(Tab, element(2, Obj)) of - Old when is_list(Old) -> - {mnesia_table_event, {write, Tab, Obj, Old, Tid}}; - {'EXIT', _} -> + try mnesia_lib:db_get(Tab, element(2, Obj)) of + Old -> + {mnesia_table_event, {write, Tab, Obj, Old, Tid}} + catch error:_ -> ignore end; what(Tab, Tid, Obj, write, Old) -> @@ -386,12 +386,12 @@ activate(ClientPid, What, Var, OldSubscribers, SubscrTab) -> case lists:member(ClientPid, Old) of false -> %% Don't care about checking old links - case catch link(ClientPid) of + try link(ClientPid) of true -> ?ets_insert(SubscrTab, {ClientPid, What}), add_subscr(Var, What, ClientPid), - {ok, node()}; - {'EXIT', _Reason} -> + {ok, node()} + catch error:_ -> {error, {no_exists, ClientPid}} end; true -> @@ -443,11 +443,10 @@ add_subscr({Tab, commit_work}, What, Pid) -> deactivate(ClientPid, What, Var, SubscrTab) -> ?ets_match_delete(SubscrTab, {ClientPid, What}), - case catch ?ets_lookup_element(SubscrTab, ClientPid, 1) of - List when is_list(List) -> - ignore; - {'EXIT', _} -> - unlink(ClientPid) + try + ?ets_lookup_element(SubscrTab, ClientPid, 1), + ignore + catch error:_ -> unlink(ClientPid) end, try del_subscr(Var, What, ClientPid), diff --git a/lib/mnesia/src/mnesia_text.erl b/lib/mnesia/src/mnesia_text.erl index 0906d18da9..794e633238 100644 --- a/lib/mnesia/src/mnesia_text.erl +++ b/lib/mnesia/src/mnesia_text.erl @@ -84,8 +84,12 @@ validate_tab({Tabname, RecName, List}) -> validate_tab(_) -> error(badtab). make_tabs([{Tab, Def} | Tail]) -> - case catch mnesia:table_info(Tab, where_to_read) of - {'EXIT', _} -> %% non-existing table + try mnesia:table_info(Tab, where_to_read) of + Node -> + io:format("** Table ~w already exists on ~p, just entering data~n", + [Tab, Node]), + make_tabs(Tail) + catch exit:_ -> %% non-existing table case mnesia:create_table(Tab, Def) of {aborted, Reason} -> io:format("** Failed to create table ~w ~n" @@ -95,11 +99,7 @@ make_tabs([{Tab, Def} | Tail]) -> _ -> io:format("New table ~w~n", [Tab]), make_tabs(Tail) - end; - Node -> - io:format("** Table ~w already exists on ~p, just entering data~n", - [Tab, Node]), - make_tabs(Tail) + end end; make_tabs([]) -> @@ -118,11 +118,9 @@ load_data(L) -> parse(File) -> case file(File) of {ok, Terms} -> - case catch collect(Terms) of - {error, X} -> - {error, X}; - Other -> - {ok, Other} + try collect(Terms) of + Other -> {ok, Other} + catch throw:Error -> Error end; Other -> Other diff --git a/lib/mnesia/src/mnesia_tm.erl b/lib/mnesia/src/mnesia_tm.erl index af658150da..b4b46228e9 100644 --- a/lib/mnesia/src/mnesia_tm.erl +++ b/lib/mnesia/src/mnesia_tm.erl @@ -51,6 +51,7 @@ ]). -include("mnesia.hrl"). + -import(mnesia_lib, [set/2]). -import(mnesia_lib, [fatal/2, verbose/2, dbg_out/2]). @@ -119,7 +120,7 @@ init(Parent) -> val(Var) -> case ?catch_val(Var) of - {'EXIT', _ReASoN_} -> mnesia_lib:other_val(Var, _ReASoN_); + {'EXIT', _} -> mnesia_lib:other_val(Var); _VaLuE_ -> _VaLuE_ end. @@ -224,11 +225,7 @@ doit_loop(#state{coordinators=Coordinators,participants=Participants,supervisor= end; {From, start_outer} -> %% Create and associate ets_tab with Tid - case catch ?ets_new_table(mnesia_trans_store, [bag, public]) of - {'EXIT', Reason} -> %% system limit - Msg = "Cannot create an ets table for the " - "local transaction store", - reply(From, {error, {system_limit, Msg, Reason}}, State); + try ?ets_new_table(mnesia_trans_store, [bag, public]) of Etab -> tmlink(From), C = mnesia_recover:incr_trans_tid_serial(), @@ -237,6 +234,10 @@ doit_loop(#state{coordinators=Coordinators,participants=Participants,supervisor= A2 = gb_trees:insert(Tid,[Etab],Coordinators), S2 = State#state{coordinators = A2}, reply(From, {new_tid, Tid, Etab}, S2) + catch error:Reason -> %% system limit + Msg = "Cannot create an ets table for the " + "local transaction store", + reply(From, {error, {system_limit, Msg, Reason}}, State) end; {From, {ask_commit, Protocol, Tid, Commit, DiscNs, RamNs}} -> @@ -339,15 +340,15 @@ doit_loop(#state{coordinators=Coordinators,participants=Participants,supervisor= end; {From, {add_store, Tid}} -> %% new store for nested transaction - case catch ?ets_new_table(mnesia_trans_store, [bag, public]) of - {'EXIT', Reason} -> %% system limit - Msg = "Cannot create an ets table for a nested " - "local transaction store", - reply(From, {error, {system_limit, Msg, Reason}}, State); + try ?ets_new_table(mnesia_trans_store, [bag, public]) of Etab -> A2 = add_coord_store(Coordinators, Tid, Etab), reply(From, {new_store, Etab}, State#state{coordinators = A2}) + catch error:Reason -> %% system limit + Msg = "Cannot create an ets table for a nested " + "local transaction store", + reply(From, {error, {system_limit, Msg, Reason}}, State) end; {From, {del_store, Tid, Current, Obsolete, PropagateStore}} -> @@ -471,13 +472,13 @@ doit_loop(#state{coordinators=Coordinators,participants=Participants,supervisor= do_sync_dirty(From, Tid, Commit, _Tab) -> ?eval_debug_fun({?MODULE, sync_dirty, pre}, [{tid, Tid}]), - Res = (catch do_dirty(Tid, Commit)), + Res = do_dirty(Tid, Commit), ?eval_debug_fun({?MODULE, sync_dirty, post}, [{tid, Tid}]), From ! {?MODULE, node(), {dirty_res, Res}}. do_async_dirty(Tid, Commit, _Tab) -> ?eval_debug_fun({?MODULE, async_dirty, pre}, [{tid, Tid}]), - catch do_dirty(Tid, Commit), + do_dirty(Tid, Commit), ?eval_debug_fun({?MODULE, async_dirty, post}, [{tid, Tid}]). @@ -501,7 +502,7 @@ process_dirty_queue(_Tab, []) -> []. prepare_pending_coordinators([{Tid, [Store | _Etabs]} | Coords], IgnoreNew) -> - case catch ?ets_lookup(Store, pending) of + try ?ets_lookup(Store, pending) of [] -> prepare_pending_coordinators(Coords, IgnoreNew); [Pending] -> @@ -511,8 +512,8 @@ prepare_pending_coordinators([{Tid, [Store | _Etabs]} | Coords], IgnoreNew) -> true -> ignore end, - prepare_pending_coordinators(Coords, IgnoreNew); - {'EXIT', _} -> + prepare_pending_coordinators(Coords, IgnoreNew) + catch error:_ -> prepare_pending_coordinators(Coords, IgnoreNew) end; prepare_pending_coordinators([], _IgnoreNew) -> @@ -573,11 +574,7 @@ recover_coordinator(Tid, Etabs) -> Store = hd(Etabs), CheckNodes = get_elements(nodes,Store), TellNodes = CheckNodes -- [node()], - case catch arrange(Tid, Store, async) of - {'EXIT', Reason} -> - dbg_out("Recovery of coordinator ~p failed:~n", [Tid, Reason]), - Protocol = asym_trans, - tell_outcome(Tid, Protocol, node(), CheckNodes, TellNodes); + try arrange(Tid, Store, async) of {_N, Prep} -> %% Tell the participants about the outcome Protocol = Prep#prep.protocol, @@ -596,6 +593,11 @@ recover_coordinator(Tid, Etabs) -> false -> %% When killed before store havn't been copied to ok %% to the new nested trans store. end + catch _:Reason -> + dbg_out("Recovery of coordinator ~p failed:~n", + [Tid, {Reason, erlang:get_stacktrace()}]), + Protocol = asym_trans, + tell_outcome(Tid, Protocol, node(), CheckNodes, TellNodes) end, erase_ets_tabs(Etabs), transaction_terminated(Tid), @@ -724,33 +726,25 @@ non_transaction(OldState={_,_,Trans}, Fun, Args, ActivityKind, Mod) _ -> async end, case transaction(OldState, Fun, Args, infinity, Mod, Kind) of - {atomic, Res} -> - Res; - {aborted,Res} -> - exit(Res) + {atomic, Res} -> Res; + {aborted,Res} -> exit(Res) end; non_transaction(OldState, Fun, Args, ActivityKind, Mod) -> Id = {ActivityKind, self()}, NewState = {Mod, Id, non_transaction}, put(mnesia_activity_state, NewState), - %% I Want something uniqe here, references are expensive - Ref = mNeSia_nOn_TrAnSacTioN, - RefRes = (catch {Ref, apply(Fun, Args)}), - case OldState of - undefined -> erase(mnesia_activity_state); - _ -> put(mnesia_activity_state, OldState) - end, - case RefRes of - {Ref, Res} -> - case Res of - {'EXIT', Reason} -> exit(Reason); - {aborted, Reason} -> mnesia:abort(Reason); - _ -> Res - end; - {'EXIT', Reason} -> - exit(Reason); - Throw -> - throw(Throw) + try apply(Fun, Args) of + {'EXIT', Reason} -> exit(Reason); + {aborted, Reason} -> mnesia:abort(Reason); + Res -> Res + catch + throw:Throw -> throw(Throw); + _:Reason -> exit(Reason) + after + case OldState of + undefined -> erase(mnesia_activity_state); + _ -> put(mnesia_activity_state, OldState) + end end. transaction(OldTidTs, Fun, Args, Retries, Mod, Type) -> @@ -810,23 +804,28 @@ insert_objs([], _Tab) -> ok. execute_transaction(Fun, Args, Factor, Retries, Type) -> - case catch apply_fun(Fun, Args, Type) of - {'EXIT', Reason} -> - check_exit(Fun, Args, Factor, Retries, Reason, Type); + try apply_fun(Fun, Args, Type) of {atomic, Value} -> mnesia_lib:incr_counter(trans_commits), erase(mnesia_activity_state), %% no need to clear locks, already done by commit ... %% Flush any un processed mnesia_down messages we might have flush_downs(), - catch unlink(whereis(?MODULE)), + ?SAFE(unlink(whereis(?MODULE))), {atomic, Value}; + {do_abort, Reason} -> + check_exit(Fun, Args, Factor, Retries, {aborted, Reason}, Type); {nested_atomic, Value} -> mnesia_lib:incr_counter(trans_commits), - {atomic, Value}; - Value -> %% User called throw + {atomic, Value} + catch throw:Value -> %% User called throw Reason = {aborted, {throw, Value}}, - return_abort(Fun, Args, Reason) + return_abort(Fun, Args, Reason); + error:Reason -> + ST = erlang:get_stacktrace(), + check_exit(Fun, Args, Factor, Retries, {Reason,ST}, Type); + _:Reason -> + check_exit(Fun, Args, Factor, Retries, Reason, Type) end. apply_fun(Fun, Args, Type) -> @@ -836,10 +835,10 @@ apply_fun(Fun, Args, Type) -> {atomic, Result}; do_commit_nested -> {nested_atomic, Result}; - {do_abort, {aborted, Reason}} -> - {'EXIT', {aborted, Reason}}; - {do_abort, Reason} -> - {'EXIT', {aborted, Reason}} + {do_abort, {aborted, Reason}} -> + {do_abort, Reason}; + {do_abort, _} = Abort -> + Abort end. check_exit(Fun, Args, Factor, Retries, Reason, Type) -> @@ -943,7 +942,7 @@ return_abort(Fun, Args, Reason) -> OldStore = Ts#tidstore.store, Nodes = get_elements(nodes, OldStore), intercept_friends(Tid, Ts), - catch mnesia_lib:incr_counter(trans_failures), + ?SAFE(mnesia_lib:incr_counter(trans_failures)), Level = Ts#tidstore.level, if Level == 1 -> @@ -951,7 +950,7 @@ return_abort(Fun, Args, Reason) -> ?MODULE ! {delete_transaction, Tid}, erase(mnesia_activity_state), flush_downs(), - catch unlink(whereis(?MODULE)), + ?SAFE(unlink(whereis(?MODULE))), {aborted, mnesia_lib:fix_error(Reason)}; true -> %% Nested transaction @@ -1005,11 +1004,11 @@ erase_activity_id() -> erase(mnesia_activity_state). get_elements(Type,Store) -> - case catch ?ets_lookup(Store, Type) of + try ?ets_lookup(Store, Type) of [] -> []; [{_,Val}] -> [Val]; - {'EXIT', _} -> []; Vals -> [Val|| {_,Val} <- Vals] + catch error:_ -> [] end. opt_propagate_store(_Current, _Obsolete, false) -> @@ -1032,7 +1031,7 @@ intercept_friends(_Tid, Ts) -> intercept_best_friend([],_) -> ok; intercept_best_friend([{stop,Fun} | R],Ignore) -> - catch Fun(), + ?CATCH(Fun()), intercept_best_friend(R,Ignore); intercept_best_friend([Pid | R],false) -> Pid ! {activity_ended, undefined, self()}, @@ -1046,25 +1045,12 @@ wait_for_best_friend(Pid, Timeout) -> {'EXIT', Pid, _} -> ok; {activity_ended, _, Pid} -> ok after Timeout -> - case my_process_is_alive(Pid) of + case erlang:is_process_alive(Pid) of true -> wait_for_best_friend(Pid, 1000); false -> ok end end. -my_process_is_alive(Pid) -> - case catch erlang:is_process_alive(Pid) of % New BIF in R5 - true -> - true; - false -> - false; - {'EXIT', _} -> % Pre R5 backward compatibility - case process_info(Pid, message_queue_len) of - undefined -> false; - _ -> true - end - end. - dirty(Protocol, Item) -> {{Tab, Key}, _Val, _Op} = Item, Tid = {dirty, self()}, @@ -1144,18 +1130,8 @@ arrange(Tid, Store, Type) -> async -> #prep{protocol = sym_trans, records = Recs}; sync -> #prep{protocol = sync_sym_trans, records = Recs} end, - case catch do_arrange(Tid, Store, Key, Prep, N) of - {'EXIT', Reason} -> - dbg_out("do_arrange failed ~p ~p~n", [Reason, Tid]), - case Reason of - {aborted, R} -> - mnesia:abort(R); - _ -> - mnesia:abort(Reason) - end; - {New, Prepared} -> - {New, Prepared#prep{records = reverse(Prepared#prep.records)}} - end. + {New, Prepared} = do_arrange(Tid, Store, Key, Prep, N), + {New, Prepared#prep{records = reverse(Prepared#prep.records)}}. reverse([]) -> []; @@ -1522,7 +1498,7 @@ multi_commit(asym_trans, Majority, Tid, CR, Store) -> Pending = mnesia_checkpoint:tm_enter_pending(Tid, DiscNs, RamNs), ?ets_insert(Store, Pending), {WaitFor, Local} = ask_commit(asym_trans, Tid, CR2, DiscNs, RamNs), - SchemaPrep = (catch mnesia_schema:prepare_commit(Tid, Local, {coord, WaitFor})), + SchemaPrep = ?CATCH(mnesia_schema:prepare_commit(Tid, Local, {coord, WaitFor})), {Votes, Pids} = rec_all(WaitFor, Tid, do_commit, []), ?eval_debug_fun({?MODULE, multi_commit_asym_got_votes}, @@ -1589,7 +1565,7 @@ rec_acc_pre_commit([Pid | Tail], Tid, Store, Commit, Res, DumperMode, GoodPids, SchemaAckPids); {mnesia_down, Node} when Node == node(Pid) -> AbortRes = {do_abort, {bad_commit, Node}}, - catch Pid ! {Tid, AbortRes}, %% Tell him that he has died + ?SAFE(Pid ! {Tid, AbortRes}), %% Tell him that he has died rec_acc_pre_commit(Tail, Tid, Store, Commit, AbortRes, DumperMode, GoodPids, SchemaAckPids) end; @@ -1666,7 +1642,7 @@ commit_participant(Coord, Tid, C = #commit{}, DiscNs, RamNs) -> commit_participant(Coord, Tid, Bin, C0, DiscNs, _RamNs) -> ?eval_debug_fun({?MODULE, commit_participant, pre}, [{tid, Tid}]), - case catch mnesia_schema:prepare_commit(Tid, C0, {part, Coord}) of + try mnesia_schema:prepare_commit(Tid, C0, {part, Coord}) of {Modified, C = #commit{}, DumperMode} -> %% If we can not find any local unclear decision %% we should presume abort at startup recovery @@ -1742,9 +1718,8 @@ commit_participant(Coord, Tid, Bin, C0, DiscNs, _RamNs) -> reply(Coord, {do_abort, Tid, self(), {bad_commit,internal}}), verbose("** ERROR ** commit_participant ~p, got unexpected msg: ~p~n", [Tid, Msg]) - end; - - {'EXIT', Reason} -> + end + catch _:Reason -> ?eval_debug_fun({?MODULE, commit_participant, vote_no}, [{tid, Tid}]), reply(Coord, {vote_no, Tid, Reason}), @@ -1790,22 +1765,20 @@ do_commit(Tid, C, DumperMode) -> %% Update the items do_update(Tid, Storage, [Op | Ops], OldRes) -> - case catch do_update_op(Tid, Storage, Op) of - ok -> - do_update(Tid, Storage, Ops, OldRes); - {'EXIT', Reason} -> + try do_update_op(Tid, Storage, Op) of + ok -> do_update(Tid, Storage, Ops, OldRes); + NewRes -> do_update(Tid, Storage, Ops, NewRes) + catch _:Reason -> %% This may only happen when we recently have %% deleted our local replica, changed storage_type %% or transformed table %% BUGBUG: Updates may be lost if storage_type is changed. %% Determine actual storage type and try again. %% BUGBUG: Updates may be lost if table is transformed. - + ST = erlang:get_stacktrace(), verbose("do_update in ~w failed: ~p -> {'EXIT', ~p}~n", - [Tid, Op, Reason]), - do_update(Tid, Storage, Ops, OldRes); - NewRes -> - do_update(Tid, Storage, Ops, NewRes) + [Tid, Op, {Reason, ST}]), + do_update(Tid, Storage, Ops, OldRes) end; do_update(_Tid, _Storage, [], Res) -> Res. @@ -1821,14 +1794,15 @@ do_update_op(Tid, Storage, {{Tab, K}, Val, delete}) -> do_update_op(Tid, Storage, {{Tab, K}, {RecName, Incr}, update_counter}) -> {NewObj, OldObjs} = - case catch mnesia_lib:db_update_counter(Storage, Tab, K, Incr) of - NewVal when is_integer(NewVal), NewVal >= 0 -> - {{RecName, K, NewVal}, [{RecName, K, NewVal - Incr}]}; - _ when Incr > 0 -> + try + NewVal = mnesia_lib:db_update_counter(Storage, Tab, K, Incr), + true = is_integer(NewVal) andalso (NewVal >= 0), + {{RecName, K, NewVal}, [{RecName, K, NewVal - Incr}]} + catch error:_ when Incr > 0 -> New = {RecName, K, Incr}, mnesia_lib:db_put(Storage, Tab, New), {New, []}; - _ -> + error:_ -> Zero = {RecName, K, 0}, mnesia_lib:db_put(Storage, Tab, Zero), {Zero, []} @@ -1913,16 +1887,14 @@ commit_clear([H|R], Tid, Tab, K, Obj) do_snmp(_, []) -> ok; do_snmp(Tid, [Head | Tail]) -> - case catch mnesia_snmp_hook:update(Head) of - {'EXIT', Reason} -> + try mnesia_snmp_hook:update(Head) + catch _:Reason -> %% This should only happen when we recently have %% deleted our local replica or recently deattached %% the snmp table - + ST = erlang:get_stacktrace(), verbose("do_snmp in ~w failed: ~p -> {'EXIT', ~p}~n", - [Tid, Head, Reason]); - ok -> - ignore + [Tid, Head, {Reason, ST}]) end, do_snmp(Tid, Tail). @@ -2093,7 +2065,7 @@ rec_all([Node | Tail], Tid, Res, Pids) -> %% Make sure that mnesia_tm knows it has died %% it may have been restarted Abort = {do_abort, {bad_commit, Node}}, - catch {?MODULE, Node} ! {Tid, Abort}, + ?SAFE({?MODULE, Node} ! {Tid, Abort}), rec_all(Tail, Tid, Abort, Pids) end; rec_all([], _Tid, Res, Pids) -> diff --git a/lib/mnesia/test/mnesia_config_backup.erl b/lib/mnesia/test/mnesia_config_backup.erl index 0916e255e2..a7d8c04a45 100644 --- a/lib/mnesia/test/mnesia_config_backup.erl +++ b/lib/mnesia/test/mnesia_config_backup.erl @@ -90,7 +90,8 @@ open_read(Name) -> List = lists:reverse(ReverseList), {ok, #backup{name = Name, mode = read, items = List}}; {error, Reason} -> - {error, {open_read, Reason}} + %% {error, {open_read, Reason}} + {Reason, error} %% Testing error handling in mnesia end. read(Opaque) when Opaque#backup.mode == read -> diff --git a/lib/mnesia/test/mnesia_config_test.erl b/lib/mnesia/test/mnesia_config_test.erl index c495bce63f..a8fb93b28e 100644 --- a/lib/mnesia/test/mnesia_config_test.erl +++ b/lib/mnesia/test/mnesia_config_test.erl @@ -37,7 +37,6 @@ dump_log_update_in_place/1, event_module/1, - ignore_fallback_at_startup/1, inconsistent_database/1, max_wait_for_decision/1, send_compressed/1, @@ -104,7 +103,7 @@ all() -> [access_module, auto_repair, backup_module, debug, dir, dump_log_load_regulation, {group, dump_log_thresholds}, dump_log_update_in_place, - event_module, ignore_fallback_at_startup, + event_module, inconsistent_database, max_wait_for_decision, send_compressed, app_test, {group, schema_config}, unknown_config]. @@ -317,11 +316,17 @@ backup_module(Config) when is_list(Config) -> ?match([], mnesia_test_lib:start_mnesia(Nodes, [test_table, test_table2])), %% Now check newly started tables - ?match({atomic, [1,2]}, + ?match({atomic, [1,2]}, mnesia:transaction(fun() -> lists:sort(mnesia:all_keys(test_table)) end)), - ?match({atomic, [3,4]}, + ?match({atomic, [3,4]}, mnesia:transaction(fun() -> lists:sort(mnesia:all_keys(test_table2)) end)), - + + %% Test some error cases + mnesia:set_debug_level(debug), + ?match({error, _}, mnesia:install_fallback("NonExisting.FILE")), + ?match({error, _}, mnesia:install_fallback(filename:join(mnesia_lib:dir(), "LATEST.LOG"))), + + %% Cleanup file:delete(File), ?verify_mnesia(Nodes, []), ?cleanup(1, Config), @@ -609,13 +614,6 @@ dump_log_load_regulation(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -ignore_fallback_at_startup(doc) -> - ["Start Mnesia without rollback of the database to the fallback. ", - "Once Mnesia has been (re)started the installed fallback should", - "be handled as a normal active fallback.", - "Install a customized event module which disables the termination", - "of Mnesia when mnesia_down occurrs with an active fallback."]. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% max_wait_for_decision(doc) -> diff --git a/lib/mnesia/test/mnesia_evil_backup.erl b/lib/mnesia/test/mnesia_evil_backup.erl index 9e0a8db1ae..68efa3f6ea 100644 --- a/lib/mnesia/test/mnesia_evil_backup.erl +++ b/lib/mnesia/test/mnesia_evil_backup.erl @@ -142,6 +142,9 @@ restore_errors(Config) when is_list(Config) -> ?match({aborted, {badarg, _}}, mnesia:restore(notAfile, [{skip_tables, xxx}])), ?match({aborted, {badarg, _}}, mnesia:restore(notAfile, [{recreate_tables, [schema]}])), ?match({aborted, {badarg, _}}, mnesia:restore(notAfile, [{default_op, asdklasd}])), + MnesiaDir = mnesia_lib:dir(), + ?match({aborted, {not_a_log_file, _}}, mnesia:restore(filename:join(MnesiaDir, "schema.DAT"), [])), + ?match({aborted, _}, mnesia:restore(filename:join(MnesiaDir, "LATEST.LOG"), [])), ok. restore_clear(suite) -> []; @@ -488,6 +491,14 @@ install_fallback(Config) when is_list(Config) -> mnesia_test_lib:kill_mnesia([Node1, Node2]), timer:sleep(timer:seconds(1)), % Let it die! + ok = mnesia:start([{ignore_fallback_at_startup, true}]), + ok = mnesia:wait_for_tables([Tab, Tab2, Tab3], 10000), + ?match([{Tab, 6, test_nok}], mnesia:dirty_read({Tab, 6})), + mnesia_test_lib:kill_mnesia([Node1]), + application:set_env(mnesia, ignore_fallback_at_startup, false), + + timer:sleep(timer:seconds(1)), % Let it die! + ?match([], mnesia_test_lib:start_mnesia([Node1, Node2], [Tab, Tab2, Tab3])), % Verify @@ -510,6 +521,13 @@ install_fallback(Config) when is_list(Config) -> file:delete(File3), ?match({error, _}, mnesia:install_fallback(File3)), ?match({error, _}, mnesia:install_fallback(File2, mnesia_badmod)), + ?match({error, _}, mnesia:install_fallback(File2, {foo, foo})), + ?match({error, _}, mnesia:install_fallback(File2, [{foo, foo}])), + ?match({error, {badarg, {skip_tables, _}}}, + mnesia:install_fallback(File2, [{default_op, skip_tables}, + {default_op, keep_tables}, + {keep_tables, [Tab, Tab2, Tab3]}, + {skip_tables, [foo,{asd}]}])), ?match(ok, mnesia:install_fallback(File2, mnesia_backup)), ?match(ok, file:delete(File)), ?match(ok, file:delete(File2)), @@ -535,6 +553,7 @@ uninstall_fallback(Config) when is_list(Config) -> ?match(ok, mnesia:install_fallback(File2)), ?match(ok, file:delete(File)), ?match(ok, file:delete(File2)), + ?match({error, _}, mnesia:uninstall_fallback([foobar])), ?match(ok, mnesia:uninstall_fallback()), mnesia_test_lib:kill_mnesia([Node1, Node2]), diff --git a/lib/mnesia/test/mnesia_trans_access_test.erl b/lib/mnesia/test/mnesia_trans_access_test.erl index 237984978e..f906670296 100644 --- a/lib/mnesia/test/mnesia_trans_access_test.erl +++ b/lib/mnesia/test/mnesia_trans_access_test.erl @@ -930,20 +930,20 @@ index_update_bag(Config)when is_list(Config) -> [IPos] = mnesia_lib:val({Tab,index}), ITab = mnesia_lib:val({index_test,{index, IPos}}), io:format("~n Index ~p @ ~p => ~p ~n~n",[IPos,ITab, ets:tab2list(ITab)]), - ?match([{2,1},{2,2},{12,1}], ets:tab2list(ITab)), + ?match([{2,1},{2,2},{12,1}], lists:keysort(1,ets:tab2list(ITab))), ?match({atomic, ok}, mnesia:transaction(fun() -> mnesia:write(Rec5) end)), {atomic, R60} = mnesia:transaction(fun() -> mnesia:index_read(Tab, 2, ValPos) end), ?match([Rec1,Rec5,Rec2], lists:sort(R60)), - ?match([{2,1},{2,2},{12,1}], ets:tab2list(ITab)), + ?match([{2,1},{2,2},{12,1}], lists:keysort(1,ets:tab2list(ITab))), ?match({atomic, ok}, mnesia:transaction(fun() -> mnesia:delete_object(Rec3) end)), {atomic, R61} = mnesia:transaction(fun() -> mnesia:index_read(Tab, 2, ValPos) end), ?match([Rec1,Rec5,Rec2], lists:sort(R61)), {atomic, R62} = mnesia:transaction(fun() -> mnesia:index_read(Tab,12, ValPos) end), ?match([], lists:sort(R62)), - ?match([{2,1},{2,2}], ets:tab2list(ITab)), + ?match([{2,1},{2,2}], lists:keysort(1,ets:tab2list(ITab))), %% reset for rest of testcase ?match({atomic, ok}, mnesia:transaction(fun() -> mnesia:write(Rec3) end)), diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index 94eb360591..b23339e408 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.12.4 +MNESIA_VSN = 4.12.5 diff --git a/lib/observer/doc/src/notes.xml b/lib/observer/doc/src/notes.xml index 11729078c2..a9ec68fc9e 100644 --- a/lib/observer/doc/src/notes.xml +++ b/lib/observer/doc/src/notes.xml @@ -31,6 +31,21 @@ <p>This document describes the changes made to the Observer application.</p> +<section><title>Observer 2.0.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix crash when opening a process information window.</p> + <p> + Own Id: OTP-12634</p> + </item> + </list> + </section> + +</section> + <section><title>Observer 2.0.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/observer/src/Makefile b/lib/observer/src/Makefile index c120865213..a42967644a 100644 --- a/lib/observer/src/Makefile +++ b/lib/observer/src/Makefile @@ -61,6 +61,7 @@ MODULES= \ etop_txt \ observer \ observer_app_wx \ + observer_alloc_wx \ observer_html_lib \ observer_lib \ observer_perf_wx \ diff --git a/lib/observer/src/observer.app.src b/lib/observer/src/observer.app.src index 97a54cd6f9..e293990d64 100644 --- a/lib/observer/src/observer.app.src +++ b/lib/observer/src/observer.app.src @@ -44,6 +44,7 @@ etop_tr, etop_txt, observer, + observer_alloc_wx, observer_app_wx, observer_html_lib, observer_lib, @@ -63,6 +64,6 @@ {env, []}, {runtime_dependencies, ["wx-1.2","stdlib-2.0","runtime_tools-1.8.14", "kernel-3.0","inets-5.10","et-1.5", - "erts-6.0"]}]}. + "erts-7.0"]}]}. diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl new file mode 100644 index 0000000000..0c4bc9ee4b --- /dev/null +++ b/lib/observer/src/observer_alloc_wx.erl @@ -0,0 +1,256 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +-module(observer_alloc_wx). + +-export([start_link/2]). + +%% wx_object callbacks +-export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, + handle_event/2, handle_sync_event/3, handle_cast/2]). + +-behaviour(wx_object). +-include_lib("wx/include/wx.hrl"). +-include("observer_defs.hrl"). + +-record(state, + { + offset = 0.0, + active = false, + parent, + windows, + data = {0, queue:new()}, + panel, + paint, + appmon, + async + }). + +-define(ALLOC_W, 1). +-define(UTIL_W, 2). + +start_link(Notebook, Parent) -> + wx_object:start_link(?MODULE, [Notebook, Parent], []). + +init([Notebook, Parent]) -> + try + Panel = wxPanel:new(Notebook), + Main = wxBoxSizer:new(?wxVERTICAL), + Style = ?wxFULL_REPAINT_ON_RESIZE bor ?wxCLIP_CHILDREN, + Carrier = wxPanel:new(Panel, [{winid, ?ALLOC_W}, {style,Style}]), + Utilz = wxPanel:new(Panel, [{winid, ?UTIL_W}, {style,Style}]), + BorderFlags = ?wxLEFT bor ?wxRIGHT, + wxSizer:add(Main, Carrier, [{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP}, + {proportion, 1}, {border, 5}]), + + wxSizer:add(Main, Utilz, [{flag, ?wxEXPAND bor BorderFlags}, + {proportion, 1}, {border, 5}]), + + MemWin = {MemPanel,_} = create_mem_info(Panel), + wxSizer:add(Main, MemPanel, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM}, + {proportion, 1}, {border, 5}]), + wxWindow:setSizer(Panel, Main), + + PaintInfo = observer_perf_wx:setup_graph_drawing([Carrier, Utilz]), + {Panel, #state{parent=Parent, + panel =Panel, + windows = {Carrier, Utilz, MemWin}, + paint=PaintInfo} + } + catch _:Err -> + io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]), + {stop, Err} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +handle_event(#wx{event=#wxCommand{type=command_menu_selected}}, + State = #state{}) -> + {noreply, State}; + +handle_event(Event, _State) -> + error({unhandled_event, Event}). + +%%%%%%%%%% +handle_sync_event(#wx{obj=Panel, event = #wxPaint{}},_, + #state{active=Active, offset=Offset, paint=Paint, + windows=Windows, data=Data}) -> + %% Sigh workaround bug on MacOSX (Id in paint event is always 0) + Id = if Panel =:= element(?ALLOC_W, Windows) -> alloc; + Panel =:= element(?UTIL_W, Windows) -> utilz + end, + observer_perf_wx:refresh_panel(Panel, Id, Offset, Data, Active, Paint), + ok. +%%%%%%%%%% +handle_call(Event, From, _State) -> + error({unhandled_call, Event, From}). + +handle_cast(Event, _State) -> + error({unhandled_cast, Event}). +%%%%%%%%%% + +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, data=Data} = State) -> + Info = alloc_info(SysInfo), + update_alloc(State, Info), + {noreply, State#state{offset=0.0, data = add_data(Info, Data), async=undefined}}; + +handle_info({refresh, Seq, Freq, Node}, #state{panel=Panel, appmon=Node, async=Key} = State) -> + wxWindow:refresh(Panel), + Next = Seq+1, + if + Next > Freq, Key =:= undefined -> + erlang:send_after(trunc(1000 / Freq), self(), {refresh, 1, Freq, Node}), + Req = rpc:async_call(Node, observer_backend, sys_info, []), + {noreply, State#state{offset=Seq/Freq, async=Req}}; + true -> + erlang:send_after(trunc(1000 / Freq), self(), {refresh, Next, Freq, Node}), + {noreply, State#state{offset=Seq/Freq}} + end; +handle_info({refresh, _Seq, _Freq, _Node}, State) -> + {noreply, State}; + +handle_info({active, Node}, State = #state{parent=Parent, panel=Panel, appmon=Old}) -> + create_menus(Parent, []), + try + Node = Old, + wxWindow:refresh(Panel), + {noreply, State#state{active=true}} + catch _:_ -> + SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []), + Info = alloc_info(SysInfo), + Freq = 6, + erlang:send_after(trunc(1000 / Freq), self(), {refresh, 1, Freq, Node}), + wxWindow:refresh(Panel), + {noreply, State#state{active=true, appmon=Node, offset=0.0, + data = add_data(Info, {0, queue:new()})}} + end; + +handle_info(not_active, State = #state{appmon=_Pid}) -> + {noreply, State#state{active=false}}; + +handle_info({'EXIT', Old, _}, State = #state{appmon=Old}) -> + {noreply, State#state{active=false, appmon=undefined}}; + +handle_info(_Event, State) -> + %% io:format("~p:~p: ~p~n",[?MODULE,?LINE,_Event]), + {noreply, State}. + +terminate(_Event, #state{}) -> + ok. +code_change(_, _, State) -> + State. + +%%%%%%%%%% + +add_data(Stats, {N, Q}) when N > 60 -> + {N, queue:drop(queue:in(Stats, Q))}; +add_data(Stats, {N, Q}) -> + {N+1, queue:in(Stats, Q)}. + +update_alloc(#state{windows={_, _, {_, Grid}}}, Fields) -> + Max = wxListCtrl:getItemCount(Grid), + Update = fun({Name, BS, CS}, Row) -> + (Row >= Max) andalso wxListCtrl:insertItem(Grid, Row, ""), + wxListCtrl:setItem(Grid, Row, 0, observer_lib:to_str(Name)), + wxListCtrl:setItem(Grid, Row, 1, observer_lib:to_str(BS div 1024)), + wxListCtrl:setItem(Grid, Row, 2, observer_lib:to_str(CS div 1024)), + Row + 1 + end, + lists:foldl(Update, 0, Fields), + Fields. + +alloc_info(SysInfo) -> + AllocInfo = proplists:get_value(alloc_info, SysInfo, []), + alloc_info(AllocInfo, [], 0, 0, true). + +alloc_info([{Type,Instances}|Allocators],TypeAcc,TotalBS,TotalCS,IncludeTotal) -> + {BS,CS,NewTotalBS,NewTotalCS,NewIncludeTotal} = + sum_alloc_instances(Instances,0,0,TotalBS,TotalCS), + alloc_info(Allocators,[{Type,BS,CS}|TypeAcc],NewTotalBS,NewTotalCS, + IncludeTotal andalso NewIncludeTotal); +alloc_info([],TypeAcc,TotalBS,TotalCS,IncludeTotal) -> + Types = [X || X={_,BS,CS} <- TypeAcc, (BS>0 orelse CS>0)], + case IncludeTotal of + true -> + [{total,TotalBS,TotalCS} | lists:reverse(Types)]; + false -> + lists:reverse(Types) + end. + +sum_alloc_instances(false,BS,CS,TotalBS,TotalCS) -> + {BS,CS,TotalBS,TotalCS,false}; +sum_alloc_instances([{_,_,Data}|Instances],BS,CS,TotalBS,TotalCS) -> + {NewBS,NewCS,NewTotalBS,NewTotalCS} = + sum_alloc_one_instance(Data,BS,CS,TotalBS,TotalCS), + sum_alloc_instances(Instances,NewBS,NewCS,NewTotalBS,NewTotalCS); +sum_alloc_instances([],BS,CS,TotalBS,TotalCS) -> + {BS,CS,TotalBS,TotalCS,true}. + +sum_alloc_one_instance([{sbmbcs,[{blocks_size,BS,_,_},{carriers_size,CS,_,_}]}| + Rest],OldBS,OldCS,TotalBS,TotalCS) -> + sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS,TotalCS); +sum_alloc_one_instance([{_,[{blocks_size,BS,_,_},{carriers_size,CS,_,_}]}| + Rest],OldBS,OldCS,TotalBS,TotalCS) -> + sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS+BS,TotalCS+CS); +sum_alloc_one_instance([{_,[{blocks_size,BS},{carriers_size,CS}]}| + Rest],OldBS,OldCS,TotalBS,TotalCS) -> + sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS+BS,TotalCS+CS); +sum_alloc_one_instance([_|Rest],BS,CS,TotalBS,TotalCS) -> + sum_alloc_one_instance(Rest,BS,CS,TotalBS,TotalCS); +sum_alloc_one_instance([],BS,CS,TotalBS,TotalCS) -> + {BS,CS,TotalBS,TotalCS}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +create_mem_info(Parent) -> + Panel = wxPanel:new(Parent), + wxWindow:setBackgroundColour(Panel, {255,255,255}), + Style = ?wxLC_REPORT bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES bor ?wxLC_VRULES, + Grid = wxListCtrl:new(Panel, [{style, Style}]), + Li = wxListItem:new(), + AddListEntry = fun({Name, Align, DefSize}, Col) -> + wxListItem:setText(Li, Name), + wxListItem:setAlign(Li, Align), + wxListCtrl:insertColumn(Grid, Col, Li), + wxListCtrl:setColumnWidth(Grid, Col, DefSize), + Col + 1 + end, + ListItems = [{"Allocator Type", ?wxLIST_FORMAT_LEFT, 200}, + {"Block size (kB)", ?wxLIST_FORMAT_RIGHT, 150}, + {"Carrier size (kB)",?wxLIST_FORMAT_RIGHT, 150}], + 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}. + + +create_menus(Parent, _) -> + MenuEntries = + [{"File", + [ + ]} + ], + observer_wx:create_menus(Parent, MenuEntries). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/observer/src/observer_html_lib.erl b/lib/observer/src/observer_html_lib.erl index 53197078cf..df0bc05312 100644 --- a/lib/observer/src/observer_html_lib.erl +++ b/lib/observer/src/observer_html_lib.erl @@ -155,7 +155,7 @@ all_or_expand(_Tab,Term,Str,false) href_proc_port(lists:flatten(Str)); all_or_expand(Tab,Term,Preview,true) when not is_binary(Term) -> - Key = {Key1,Key2,Key3} = now(), + Key = {Key1,Key2,Key3} = {erlang:unique_integer([positive]),1,2}, ets:insert(Tab,{Key,Term}), [href_proc_port(lists:flatten(Preview), false), $\n, href("TARGET=\"expanded\"", diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 34c7b127ff..9592ab5977 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -493,8 +493,11 @@ link_entry2(Panel,{Target,Str},Cursor) -> wxWindow:setToolTip(TC, ToolTip), TC. -to_link(Tuple = {_Target, _Str}) -> - Tuple; +to_link(RegName={Name, Node}) when is_atom(Name), is_atom(Node) -> + Str = io_lib:format("{~p,~p}", [Name, Node]), + {RegName, Str}; +to_link(TI = {_Target, _Identifier}) -> + TI; to_link(Target0) -> Target=to_str(Target0), {Target, Target}. diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl index 8173349ed7..4df9218087 100644 --- a/lib/observer/src/observer_perf_wx.erl +++ b/lib/observer/src/observer_perf_wx.erl @@ -24,7 +24,8 @@ handle_event/2, handle_sync_event/3, handle_cast/2]). %% Drawing wrappers for DC and GC areas --export([haveGC/0, +-export([setup_graph_drawing/1, refresh_panel/6, + haveGC/0, setPen/2, setFont/3, setBrush/2, strokeLine/5, strokeLines/2, drawRoundedRectangle/6, drawText/4, getTextExtent/2]). @@ -42,13 +43,12 @@ data = {0, queue:new()}, panel, paint, - appmon, - usegc = false + appmon }). -define(wxGC, wxGraphicsContext). --record(paint, {font, small, pen, pen2, pens}). +-record(paint, {font, small, pen, pen2, pens, usegc = false}). -define(RQ_W, 1). -define(MEM_W, 2). @@ -63,14 +63,11 @@ init([Notebook, Parent]) -> Main = wxBoxSizer:new(?wxVERTICAL), Style = ?wxFULL_REPAINT_ON_RESIZE bor ?wxCLIP_CHILDREN, CPU = wxPanel:new(Panel, [{winid, ?RQ_W}, {style,Style}]), - wxWindow:setBackgroundColour(CPU, ?wxWHITE), wxSizer:add(Main, CPU, [{flag, ?wxEXPAND bor ?wxALL}, {proportion, 1}, {border, 5}]), MemIO = wxBoxSizer:new(?wxHORIZONTAL), MEM = wxPanel:new(Panel, [{winid, ?MEM_W}, {style,Style}]), - wxWindow:setBackgroundColour(MEM, ?wxWHITE), IO = wxPanel:new(Panel, [{winid, ?IO_W}, {style,Style}]), - wxWindow:setBackgroundColour(IO, ?wxWHITE), wxSizer:add(MemIO, MEM, [{flag, ?wxEXPAND bor ?wxLEFT}, {proportion, 1}, {border, 5}]), wxSizer:add(MemIO, IO, [{flag, ?wxEXPAND bor ?wxLEFT bor ?wxRIGHT}, @@ -79,53 +76,56 @@ init([Notebook, Parent]) -> {proportion, 1}, {border, 5}]), wxWindow:setSizer(Panel, Main), - wxPanel:connect(CPU, paint, [callback]), - wxPanel:connect(IO, paint, [callback]), - wxPanel:connect(MEM, paint, [callback]), - case os:type() of - {win32, _} -> %% Ignore erase on windows - wxPanel:connect(CPU, erase_background, [{callback, fun(_,_) -> ok end}]), - wxPanel:connect(IO, erase_background, [{callback, fun(_,_) -> ok end}]), - wxPanel:connect(MEM, erase_background, [{callback, fun(_,_) -> ok end}]); - _ -> ok - end, + PaintInfo = setup_graph_drawing([CPU, MEM, IO]), + process_flag(trap_exit, true), + {Panel, #state{parent=Parent, + panel =Panel, + windows = {CPU, MEM, IO}, + paint=PaintInfo + }} + catch _:Err -> + io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]), + {stop, Err} + end. + +setup_graph_drawing(Panels) -> + IsWindows = element(1, os:type()) =:= win32, + IgnoreCB = {callback, fun(_,_) -> ok end}, + Do = fun(Panel) -> + wxWindow:setBackgroundColour(Panel, ?wxWHITE), + wxPanel:connect(Panel, paint, [callback]), + IsWindows andalso + wxPanel:connect(Panel, erase_background, [IgnoreCB]) + end, + _ = [Do(Panel) || Panel <- Panels], UseGC = haveGC(), Version28 = ?wxMAJOR_VERSION =:= 2 andalso ?wxMINOR_VERSION =:= 8, {Font, SmallFont} - = case os:type() of - {unix, _} when UseGC, Version28 -> + = if UseGC, Version28 -> %% Def font is really small when using Graphics contexts in 2.8 %% Hardcode it F = wxFont:new(12,?wxFONTFAMILY_DECORATIVE,?wxFONTSTYLE_NORMAL,?wxFONTWEIGHT_BOLD), SF = wxFont:new(10, ?wxFONTFAMILY_DECORATIVE, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_NORMAL), {F, SF}; - _ -> + true -> DefFont = wxSystemSettings:getFont(?wxSYS_DEFAULT_GUI_FONT), DefSize = wxFont:getPointSize(DefFont), DefFamily = wxFont:getFamily(DefFont), - F = wxFont:new(DefSize, DefFamily, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_BOLD), - SF = wxFont:new(DefSize-1, DefFamily, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_NORMAL), + F = wxFont:new(DefSize-1, DefFamily, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_BOLD), + SF = wxFont:new(DefSize-2, DefFamily, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_NORMAL), {F, SF} end, BlackPen = wxPen:new({0,0,0}, [{width, 2}]), - Pens = [wxPen:new(Col, [{width, 2}]) || Col <- tuple_to_list(colors())], - process_flag(trap_exit, true), - {Panel, #state{parent=Parent, - panel =Panel, - windows = {CPU, MEM, IO}, - usegc=UseGC, - paint=#paint{font = Font, - small = SmallFont, - pen = ?wxGREY_PEN, - pen2 = BlackPen, - pens = list_to_tuple(Pens) - } - }} - catch _:Err -> - io:format("~p crashed ~p: ~p~n",[?MODULE, Err, erlang:get_stacktrace()]), - {stop, Err} - end. + Pens = [wxPen:new(Col, [{width, 3}]) || Col <- tuple_to_list(colors())], + #paint{usegc = UseGC, + font = Font, + small = SmallFont, + pen = ?wxGREY_PEN, + pen2 = BlackPen, + pens = list_to_tuple(Pens) + }. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -139,21 +139,25 @@ handle_event(Event, _State) -> %%%%%%%%%% handle_sync_event(#wx{obj=Panel, event = #wxPaint{}},_, #state{active=Active, offset=Offset, paint=Paint, - windows=Windows, data=Data, usegc=UseGC}) -> - %% PaintDC must be created in a callback to work on windows. + windows=Windows, data=Data}) -> %% Sigh workaround bug on MacOSX (Id in paint event is always 0) %% Panel = element(Id, Windows), - Id = if Panel =:= element(?RQ_W, Windows) -> ?RQ_W; - Panel =:= element(?MEM_W, Windows) -> ?MEM_W; - Panel =:= element(?IO_W, Windows) -> ?IO_W + Id = if Panel =:= element(?RQ_W, Windows) -> runq; + Panel =:= element(?MEM_W, Windows) -> memory; + Panel =:= element(?IO_W, Windows) -> io end, - IsWindows = element(1, os:type()) =:= win32, - DC = if IsWindows -> + refresh_panel(Panel, Id, Offset, Data, Active, Paint), + ok. + +refresh_panel(Panel, Id, Offset, Data, Active, #paint{usegc=UseGC} = Paint) -> + %% PaintDC must be created in a callback to work on windows. + IsWindows = element(1, os:type()) =:= win32, + DC = if IsWindows -> %% Ugly hack to aviod flickering on windows, works on windows only %% But the other platforms are doublebuffered by default wx:typeCast(wxBufferedPaintDC:new(Panel), wxPaintDC); - true -> + true -> wxPaintDC:new(Panel) end, IsWindows andalso wxDC:clear(DC), @@ -167,8 +171,9 @@ handle_sync_event(#wx{obj=Panel, event = #wxPaint{}},_, io:format("Internal error ~p ~p~n",[Err, erlang:get_stacktrace()]) end, UseGC andalso ?wxGC:destroy(GC), - wxPaintDC:destroy(DC), - ok. + wxPaintDC:destroy(DC). + + %%%%%%%%%% handle_call(Event, From, _State) -> error({unhandled_call, Event, From}). @@ -247,10 +252,10 @@ create_menus(Parent, _) -> observer_wx:create_menus(Parent, MenuEntries). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -collect_data(?RQ_W, {N, Q}) -> +collect_data(runq, {N, Q}) -> case queue:to_list(Q) of - [] -> {0, 0, []}; - [_] -> {0, 0, []}; + [] -> {0, 0, [], []}; + [_] -> {0, 0, [], []}; [{stats, _Ver, Init0, _IO, _Mem}|Data0] -> Init = lists:sort(Init0), [_|Data=[First|_]] = lists:foldl(fun({stats, _, T0, _, _}, [Prev|Acc]) -> @@ -258,25 +263,46 @@ collect_data(?RQ_W, {N, Q}) -> Delta = calc_delta(TN, Prev), [TN, list_to_tuple(Delta)|Acc] end, [Init], Data0), - {N, lmax(Data), lists:reverse([First|Data])} + NoGraphs = tuple_size(First), + {N, lmax(Data), lists:reverse([First|Data]), lists:seq(1, NoGraphs)} end; -collect_data(?MEM_W, {N, Q}) -> +collect_data(memory, {N, Q}) -> MemT = mem_types(), Data = [list_to_tuple([Value || {Type,Value} <- MemInfo, lists:member(Type, MemT)]) || {stats, _Ver, _RQ, _IO, MemInfo} <- queue:to_list(Q)], - {N, lmax(Data), Data}; -collect_data(?IO_W, {N, Q}) -> + {N, lmax(Data), Data, MemT}; +collect_data(io, {N, Q}) -> case queue:to_list(Q) of - [] -> {0, 0, []}; - [_] -> {0, 0, []}; + [] -> {0, 0, [], []}; + [_] -> {0, 0, [], []}; [{stats, _Ver, _RQ, {{_,In0}, {_,Out0}}, _Mem}|Data0] -> [_,_|Data=[First|_]] = lists:foldl(fun({stats, _, _, {{_,In}, {_,Out}}, _}, [PIn,Pout|Acc]) -> [In,Out,{In-PIn,Out-Pout}|Acc] end, [In0,Out0], Data0), - {N, lmax(Data), lists:reverse([First|Data])} - end. + {N, lmax(Data), lists:reverse([First|Data]), [input, output]} + end; +collect_data(alloc, {N, Q}) -> + List = queue:to_list(Q), + Data = [list_to_tuple([Carrier || {_Type,_Block,Carrier} <- MemInfo]) + || MemInfo <- List], + Info = case List of %% Varies depending on erlang build config/platform + [MInfo|_] -> [Type || {Type, _, _} <- MInfo]; + _ -> [] + end, + {N, lmax(Data), Data, Info}; + +collect_data(utilz, {N, Q}) -> + List = queue:to_list(Q), + Data = [list_to_tuple([round(100*Block/Carrier) || {_Type,Block,Carrier} <- MemInfo]) + || MemInfo <- List], + Info = case List of %% Varies depending on erlang build config/platform + [MInfo|_] -> [Type || {Type, _, _} <- MInfo]; + _ -> [] + end, + {N, lmax(Data), Data, Info}. + mem_types() -> [total, processes, atom, binary, code, ets]. @@ -299,14 +325,14 @@ draw(Offset, Id, DC, Panel, Paint=#paint{pens=Pens, small=Small}, Data, Active) %% This can be optimized a lot by collecting data once %% and draw to memory and then blit memory and only draw new entries in new memory %% area. Hmm now rewritten to use ?wxGC I don't now if it is feasable. - {Len, Max0, Hs} = collect_data(Id, Data), - Max = calc_max(Max0), - NoGraphs = try tuple_size(hd(Hs)) catch _:_ -> 0 end, + {Len, Max0, Hs, Info} = collect_data(Id, Data), + {Max,_,_} = MaxDisp = calc_max(Id, Max0), Size = wxWindow:getClientSize(Panel), - {X0,Y0,WS,HS} = draw_borders(Id, NoGraphs, DC, Size, Max, Paint), + {X0,Y0,WS,HS, DrawBs} = draw_borders(Id, Info, DC, Size, MaxDisp, Paint), Last = 60*WS+X0-1, Start = max(61-Len, 0)*WS+X0 - Offset*WS, Samples = length(Hs), + NoGraphs = try tuple_size(hd(Hs)) catch _:_ -> 0 end, case Active andalso Samples > 1 andalso NoGraphs > 0 of true -> Draw = fun(N) -> @@ -315,14 +341,16 @@ draw(Offset, Id, DC, Panel, Paint=#paint{pens=Pens, small=Small}, Data, Active) strokeLines(DC, Lines), N+1 end, - [Draw(I) || I <- lists:seq(NoGraphs, 1, -1)]; + [Draw(I) || I <- lists:seq(NoGraphs, 1, -1)], + DrawBs(); false -> - Info = case Active andalso Samples =< 1 of - true -> "Waiting on data"; + DrawBs(), + Text = case Active andalso Samples =< 1 of + true -> "Waiting for data"; false -> "Information not available" end, setFont(DC, Small, {0,0,0}), - drawText(DC, Info, X0 + 100, element(2,Size) div 2) + drawText(DC, Text, X0 + 100, element(2,Size) div 2) end, ok. @@ -397,9 +425,8 @@ spline_tan(Y0, Y1, Y2, Y3) -> -define(BW, 5). -define(BH, 5). -draw_borders(Type, NoGraphs, DC, {W,H}, Max, +draw_borders(Type, Info, DC, {W,H}, {Max, Unit, MaxUnit}, #paint{pen=Pen, pen2=Pen2, font=Font, small=Small}) -> - {Unit, MaxUnit} = bytes(Type, Max), Str1 = observer_lib:to_str(MaxUnit), Str2 = observer_lib:to_str(MaxUnit div 2), Str3 = observer_lib:to_str(0), @@ -410,10 +437,10 @@ draw_borders(Type, NoGraphs, DC, {W,H}, Max, GraphX0 = ?BW+TW+?BW, GraphX1 = W-?BW*4, - TopTextX = ?BW+TW+?BW, - MaxTextY = ?BH+TH+?BH, + TopTextX = ?BW*3+TW, + MaxTextY = TH+?BH, BottomTextY = H-?BH-TH, - SecondsY = BottomTextY - ?BH - TH, + SecondsY = BottomTextY - TH, GraphY0 = MaxTextY + (TH / 2), GraphY1 = SecondsY - ?BH, GraphW = GraphX1-GraphX0-1, @@ -447,17 +474,7 @@ draw_borders(Type, NoGraphs, DC, {W,H}, Max, strokeLine(DC, GraphX0-3, GraphY50, GraphX1, GraphY50), strokeLine(DC, GraphX0-3, GraphY75, GraphX1, GraphY75), - setPen(DC, Pen2), - strokeLines(DC, [{GraphX0, GraphY0-1}, {GraphX0, GraphY1+1}, - {GraphX1, GraphY1+1}, {GraphX1, GraphY0-1}, - {GraphX0, GraphY0-1}]), - setFont(DC, Font, {0,0,0}), - case Type of - ?RQ_W -> drawText(DC, "Scheduler Utilization (%) ", TopTextX,?BH); - ?MEM_W -> drawText(DC, "Memory Usage " ++ Unit, TopTextX,?BH); - ?IO_W -> drawText(DC, "IO Usage " ++ Unit, TopTextX,?BH) - end, Text = fun(X,Y, Str, PenId) -> if PenId == 0 -> @@ -468,32 +485,65 @@ draw_borders(Type, NoGraphs, DC, {W,H}, Max, end, drawText(DC, Str, X, Y), {StrW, _} = getTextExtent(DC, Str), - StrW + X + SpaceW + StrW + X + ?BW*2 end, + case Type of - ?RQ_W -> - TN0 = Text(?BW, BottomTextY, "Scheduler: ", 0), + runq -> + drawText(DC, "Scheduler Utilization (%) ", TopTextX, ?BH), + TN0 = Text(TopTextX, BottomTextY, "Scheduler: ", 0), lists:foldl(fun(Id, Pos0) -> Text(Pos0, BottomTextY, integer_to_list(Id), Id) - end, TN0, lists:seq(1, NoGraphs)); - ?MEM_W -> + end, TN0, Info); + memory -> + drawText(DC, "Memory Usage " ++ Unit, TopTextX,?BH), + lists:foldl(fun(MType, {PenId, Pos0}) -> + Str = to_string(MType), + Pos = Text(Pos0, BottomTextY, Str, PenId), + {PenId+1, Pos} + end, {1, TopTextX}, Info); + io -> + drawText(DC, "IO Usage " ++ Unit, TopTextX,?BH), + lists:foldl(fun(MType, {PenId, Pos0}) -> + Str = to_string(MType), + Pos = Text(Pos0, BottomTextY, Str, PenId), + {PenId+1, Pos} + end, {1, TopTextX}, Info); + alloc -> + drawText(DC, "Carrier Size " ++ Unit, TopTextX,?BH); + utilz -> + drawText(DC, "Carrier Utilization (%)" ++ Unit, TopTextX,?BH), lists:foldl(fun(MType, {PenId, Pos0}) -> - Str = uppercase(atom_to_list(MType)), + Str = to_string(MType), Pos = Text(Pos0, BottomTextY, Str, PenId), {PenId+1, Pos} - end, {1, ?BW}, mem_types()); - ?IO_W -> - TN0 = Text(?BW, BottomTextY, "Input", 1), - Text(TN0, BottomTextY, "Output", 2) + end, {1, TopTextX}, Info) end, - {GraphX0+1, GraphY1, ScaleW, ScaleH}. + DrawBorder = fun() -> + setPen(DC, Pen2), + strokeLines(DC, [{GraphX0, GraphY0-1}, {GraphX0, GraphY1+1}, + {GraphX1, GraphY1+1}, {GraphX1, GraphY0-1}, + {GraphX0, GraphY0-1}]) + end, + {GraphX0+1, GraphY1, ScaleW, ScaleH, DrawBorder}. + +to_string(Atom) -> + Name = atom_to_list(Atom), + case lists:reverse(Name) of + "colla_" ++ Rev -> + uppercase(lists:reverse(Rev)); + _ -> + uppercase(Name) + end. uppercase([C|Rest]) -> [C-$a+$A|Rest]. -calc_max(Max) when Max < 10 -> 10; -calc_max(Max) -> calc_max1(Max). +calc_max(Type, Max) -> + bytes(Type, Max). +calc_max1(Max) when Max < 10 -> + 10; calc_max1(Max) -> case Max div 10 of X when X < 10 -> @@ -506,23 +556,36 @@ calc_max1(Max) -> 10*calc_max1(X) end. -bytes(?RQ_W, Val) -> {"", Val}; +bytes(runq, Val) -> + Upper = calc_max1(Val), + {Upper, "", Upper}; +bytes(utilz, Val) -> + Upper = calc_max1(Val), + {Upper, "", Upper}; bytes(_, B) -> KB = B div 1024, MB = KB div 1024, GB = MB div 1024, if - GB > 10 -> {"(GB)", GB}; - MB > 10 -> {"(MB)", MB}; - KB > 0 -> {"(KB)", KB}; - true -> {"(B)", B} + GB > 10 -> + Upper = calc_max1(GB), + {Upper*1024*1024*1024, "(GB)", Upper}; + MB > 10 -> + Upper = calc_max1(MB), + {Upper*1024*1024, "(MB)", Upper}; + KB > 0 -> + Upper = calc_max1(KB), + {Upper*1024, "(KB)", Upper}; + true -> + Upper = calc_max1(B), + {Upper, "(B)", Upper} end. colors() -> - {{200, 50, 50}, {50, 200, 50}, {50, 50, 200}, - {255, 110, 0}, {50, 200, 200}, {200, 50, 200}, - {240, 200, 80}, {140, 2, 140}, - {100, 200, 240}, {100, 240, 100} + {{240, 100, 100}, {100, 240, 100}, {100, 100, 240}, + {220, 220, 80}, {100, 240, 240}, {240, 100, 240}, + {100, 25, 25}, {25, 100, 25}, {25, 25, 100}, + {120, 120, 0}, {25, 100, 100}, {100, 50, 100} }. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/observer/src/observer_sys_wx.erl b/lib/observer/src/observer_sys_wx.erl index f989f9cf97..ea89590e84 100644 --- a/lib/observer/src/observer_sys_wx.erl +++ b/lib/observer/src/observer_sys_wx.erl @@ -37,7 +37,6 @@ parent_notebook, panel, sizer, menubar, - alloc, fields, timer}). @@ -48,7 +47,6 @@ start_link(Notebook, Parent) -> init([Notebook, Parent]) -> SysInfo = observer_backend:sys_info(), - AllocInfo = proplists:get_value(alloc_info, SysInfo, []), {Info, Stat} = info_fields(), Panel = wxPanel:new(Notebook), Sizer = wxBoxSizer:new(?wxVERTICAL), @@ -60,16 +58,13 @@ init([Notebook, Parent]) -> wxSizer:add(TopSizer, FPanel0, [{flag, ?wxEXPAND}, {proportion, 1}]), wxSizer:add(TopSizer, FPanel1, [{flag, ?wxEXPAND}, {proportion, 1}]), BorderFlags = ?wxLEFT bor ?wxRIGHT, - {MemPanel, MemoryInfo} = create_mem_info(Panel, AllocInfo), wxSizer:add(Sizer, TopSizer, [{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP}, {proportion, 0}, {border, 5}]), - wxSizer:add(Sizer, MemPanel, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM}, - {proportion, 1}, {border, 5}]), wxPanel:setSizer(Panel, Sizer), Timer = observer_lib:start_timer(10), {Panel, #sys_wx_state{parent=Parent, parent_notebook=Notebook, - panel=Panel, sizer=Sizer, alloc=MemoryInfo, + panel=Panel, sizer=Sizer, timer=Timer, fields=Fields0 ++ Fields1}}. create_sys_menu(Parent) -> @@ -77,91 +72,13 @@ create_sys_menu(Parent) -> #create_menu{id = ?ID_REFRESH_INTERVAL, text = "Refresh interval"}]}, observer_wx:create_menus(Parent, [View]). -update_syspage(#sys_wx_state{node = Node, fields=Fields, sizer=Sizer, alloc=AllocCtrl}) -> +update_syspage(#sys_wx_state{node = Node, fields=Fields, sizer=Sizer}) -> SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []), - AllocInfo = proplists:get_value(alloc_info, SysInfo, []), {Info, Stat} = info_fields(), observer_lib:update_info(Fields, observer_lib:fill_info(Info, SysInfo) ++ observer_lib:fill_info(Stat, SysInfo)), - update_alloc(AllocCtrl, AllocInfo), wxSizer:layout(Sizer). -create_mem_info(Parent, Fields) -> - Panel = wxPanel:new(Parent), - wxWindow:setBackgroundColour(Panel, {255,255,255}), - Style = ?wxLC_REPORT bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES bor ?wxLC_VRULES, - Grid = wxListCtrl:new(Panel, [{style, Style}]), - Li = wxListItem:new(), - AddListEntry = fun({Name, Align, DefSize}, Col) -> - wxListItem:setText(Li, Name), - wxListItem:setAlign(Li, Align), - wxListCtrl:insertColumn(Grid, Col, Li), - wxListCtrl:setColumnWidth(Grid, Col, DefSize), - Col + 1 - end, - ListItems = [{"Allocator Type", ?wxLIST_FORMAT_LEFT, 200}, - {"Block size (kB)", ?wxLIST_FORMAT_RIGHT, 150}, - {"Carrier size (kB)",?wxLIST_FORMAT_RIGHT, 150}], - lists:foldl(AddListEntry, 0, ListItems), - wxListItem:destroy(Li), - update_alloc(Grid, Fields), - - Sizer = wxBoxSizer:new(?wxVERTICAL), - wxSizer:add(Sizer, Grid, [{flag, ?wxEXPAND bor ?wxLEFT bor ?wxRIGHT}, - {border, 5}, {proportion, 1}]), - wxWindow:setSizerAndFit(Panel, Sizer), - {Panel, Grid}. - -update_alloc(Grid, AllocInfo) -> - Fields = alloc_info(AllocInfo, [], 0, 0, true), - wxListCtrl:deleteAllItems(Grid), - Update = fun({Name, BS, CS}, Row) -> - wxListCtrl:insertItem(Grid, Row, ""), - wxListCtrl:setItem(Grid, Row, 0, observer_lib:to_str(Name)), - wxListCtrl:setItem(Grid, Row, 1, observer_lib:to_str(BS div 1024)), - wxListCtrl:setItem(Grid, Row, 2, observer_lib:to_str(CS div 1024)), - Row + 1 - end, - lists:foldl(Update, 0, Fields), - Fields. - -alloc_info([{Type,Instances}|Allocators],TypeAcc,TotalBS,TotalCS,IncludeTotal) -> - {BS,CS,NewTotalBS,NewTotalCS,NewIncludeTotal} = - sum_alloc_instances(Instances,0,0,TotalBS,TotalCS), - alloc_info(Allocators,[{Type,BS,CS}|TypeAcc],NewTotalBS,NewTotalCS, - IncludeTotal andalso NewIncludeTotal); -alloc_info([],TypeAcc,TotalBS,TotalCS,IncludeTotal) -> - Types = [X || X={_,BS,CS} <- TypeAcc, (BS>0 orelse CS>0)], - case IncludeTotal of - true -> - [{total,TotalBS,TotalCS} | lists:reverse(Types)]; - false -> - lists:reverse(Types) - end. - -sum_alloc_instances(false,BS,CS,TotalBS,TotalCS) -> - {BS,CS,TotalBS,TotalCS,false}; -sum_alloc_instances([{_,_,Data}|Instances],BS,CS,TotalBS,TotalCS) -> - {NewBS,NewCS,NewTotalBS,NewTotalCS} = - sum_alloc_one_instance(Data,BS,CS,TotalBS,TotalCS), - sum_alloc_instances(Instances,NewBS,NewCS,NewTotalBS,NewTotalCS); -sum_alloc_instances([],BS,CS,TotalBS,TotalCS) -> - {BS,CS,TotalBS,TotalCS,true}. - -sum_alloc_one_instance([{sbmbcs,[{blocks_size,BS,_,_},{carriers_size,CS,_,_}]}| - Rest],OldBS,OldCS,TotalBS,TotalCS) -> - sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS,TotalCS); -sum_alloc_one_instance([{_,[{blocks_size,BS,_,_},{carriers_size,CS,_,_}]}| - Rest],OldBS,OldCS,TotalBS,TotalCS) -> - sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS+BS,TotalCS+CS); -sum_alloc_one_instance([{_,[{blocks_size,BS},{carriers_size,CS}]}| - Rest],OldBS,OldCS,TotalBS,TotalCS) -> - sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS+BS,TotalCS+CS); -sum_alloc_one_instance([_|Rest],BS,CS,TotalBS,TotalCS) -> - sum_alloc_one_instance(Rest,BS,CS,TotalBS,TotalCS); -sum_alloc_one_instance([],BS,CS,TotalBS,TotalCS) -> - {BS,CS,TotalBS,TotalCS}. - info_fields() -> Info = [{"System and Architecture", [{"System Version", otp_release}, diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index 54c4092a78..cf602569aa 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -43,6 +43,7 @@ -define(LAST_NODES_MENU_ID, 2000). -define(TRACE_STR, "Trace Overview"). +-define(ALLOC_STR, "Memory Allocators"). %% Records -record(state, @@ -58,6 +59,7 @@ trace_panel, app_panel, perf_panel, + allc_panel, active_tab, node, nodes, @@ -149,6 +151,10 @@ setup(#state{frame = Frame} = State) -> PerfPanel = observer_perf_wx:start_link(Notebook, self()), wxNotebook:addPage(Notebook, PerfPanel, "Load Charts", []), + %% Memory Allocator Viewer Panel + AllcPanel = observer_alloc_wx:start_link(Notebook, self()), + wxNotebook:addPage(Notebook, AllcPanel, ?ALLOC_STR, []), + %% App Viewer Panel AppPanel = observer_app_wx:start_link(Notebook, self()), wxNotebook:addPage(Notebook, AppPanel, "Applications", []), @@ -184,6 +190,7 @@ setup(#state{frame = Frame} = State) -> trace_panel = TracePanel, app_panel = AppPanel, perf_panel = PerfPanel, + allc_panel = AllcPanel, active_tab = SysPid, node = node(), nodes = Nodes @@ -505,7 +512,7 @@ check_page_title(Notebook) -> get_active_pid(#state{notebook=Notebook, pro_panel=Pro, sys_panel=Sys, tv_panel=Tv, trace_panel=Trace, app_panel=App, - perf_panel=Perf + perf_panel=Perf, allc_panel=Alloc }) -> Panel = case check_page_title(Notebook) of "Processes" -> Pro; @@ -513,13 +520,14 @@ get_active_pid(#state{notebook=Notebook, pro_panel=Pro, sys_panel=Sys, "Table Viewer" -> Tv; ?TRACE_STR -> Trace; "Load Charts" -> Perf; - "Applications" -> App + "Applications" -> App; + ?ALLOC_STR -> Alloc end, wx_object:get_pid(Panel). pid2panel(Pid, #state{pro_panel=Pro, sys_panel=Sys, tv_panel=Tv, trace_panel=Trace, app_panel=App, - perf_panel=Perf}) -> + perf_panel=Perf, allc_panel=Alloc}) -> case Pid of Pro -> "Processes"; Sys -> "System"; @@ -527,6 +535,7 @@ pid2panel(Pid, #state{pro_panel=Pro, sys_panel=Sys, Trace -> ?TRACE_STR; Perf -> "Load Charts"; App -> "Applications"; + Alloc -> ?ALLOC_STR; _ -> "unknown" end. @@ -617,8 +626,8 @@ default_menus(NodesMenuItems) -> %% automagicly, so just add them to a menu that always exist. %% But not to the help menu for some reason - {Tag, Menus} = NodeMenu, - [{Tag, Menus ++ [Quit,About]}, LogMenu, {"&Help", [Help]}] + {Tag, Menus} = FileMenu, + [{Tag, Menus ++ [Quit,About]}, NodeMenu, LogMenu, {"&Help", [Help]}] end. clean_menus(Menus, MenuBar) -> diff --git a/lib/observer/src/ttb.erl b/lib/observer/src/ttb.erl index 61fd6d1787..a2db40aa2f 100644 --- a/lib/observer/src/ttb.erl +++ b/lib/observer/src/ttb.erl @@ -849,7 +849,7 @@ get_nodes() -> receive {?MODULE,Nodes} -> Nodes end. ts() -> - {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(now()), + {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(erlang:timestamp()), io_lib:format("-~4.4.0w~2.2.0w~2.2.0w-~2.2.0w~2.2.0w~2.2.0w", [Y,M,D,H,Min,S]). diff --git a/lib/observer/vsn.mk b/lib/observer/vsn.mk index c8a6023b4f..10ed3bdfe5 100644 --- a/lib/observer/vsn.mk +++ b/lib/observer/vsn.mk @@ -1 +1 @@ -OBSERVER_VSN = 2.0.3 +OBSERVER_VSN = 2.0.4 diff --git a/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl b/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl index 84db0b89f8..654a8f4385 100644 --- a/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl +++ b/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -533,7 +533,9 @@ unbind(_OE_THIS, _OE_State, []) -> %% Returns : %%---------------------------------------------------------------------- new_context(_OE_THIS, OE_State) -> - DBKey = term_to_binary({now(), node()}), + DBKey = term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}), %% Create a record in the table and set the key to a newly {reply, 'CosNaming_NamingContextExt':oe_create(DBKey, @@ -547,7 +549,9 @@ new_context(_OE_THIS, OE_State) -> %% Returns : %%---------------------------------------------------------------------- bind_new_context(OE_THIS, OE_State, N) -> - DBKey = term_to_binary({now(), node()}), + DBKey = term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}), %% Create a record in the table and set the key to a newly %% generated objectkey. %%?PRINTDEBUG("bind_new_context"), diff --git a/lib/orber/src/cdr_decode.erl b/lib/orber/src/cdr_decode.erl index 9aec64892e..00dcf01c56 100644 --- a/lib/orber/src/cdr_decode.erl +++ b/lib/orber/src/cdr_decode.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1110,10 +1110,8 @@ ifrid_to_name(Id, Type) -> [?LINE, Id, Type], ?DEBUG_LEVEL), corba:raise(#'MARSHAL'{completion_status=?COMPLETED_MAYBE}); Nodes -> - {A,B,C} = now(), - random:seed(A,B,C), L = length(Nodes), - IFR = get_ifr_node(Nodes, random:uniform(L), L), + IFR = get_ifr_node(Nodes, rand:uniform(L), L), list_to_atom('OrberApp_IFR':get_absolute_name(IFR, Id)) end; {'EXIT', Other} -> @@ -1176,7 +1174,7 @@ get_ifr_node(Nodes, N, L) -> _ -> %% Not able to commincate with the node. Try next one. NewL = L-1, - get_ifr_node(lists:delete(Node, Nodes), random:uniform(NewL), NewL) + get_ifr_node(lists:delete(Node, Nodes), rand:uniform(NewL), NewL) end. @@ -1260,10 +1258,8 @@ get_user_exception_type(TypeId) -> completion_status=?COMPLETED_MAYBE}) end; Nodes -> - {A,B,C} = now(), - random:seed(A,B,C), L = length(Nodes), - IFR = get_ifr_node(Nodes, random:uniform(L), L), + IFR = get_ifr_node(Nodes, rand:uniform(L), L), 'OrberApp_IFR':get_user_exception_type(IFR, TypeId) end end. diff --git a/lib/orber/src/corba.erl b/lib/orber/src/corba.erl index 586a02d540..f0eeb18c24 100644 --- a/lib/orber/src/corba.erl +++ b/lib/orber/src/corba.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1922,7 +1922,9 @@ mk_passive_objkey(Mod, Module, Flags) -> {Mod, 'passive', Module, term_to_binary(undefined), 0, Flags}. make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). objkey_to_string({_Mod, 'registered', 'orber_init', _UserDef, _OrberDef, _Flags}) -> "INIT"; diff --git a/lib/orber/src/orber.app.src b/lib/orber/src/orber.app.src index 30bd90347d..5dda63982f 100644 --- a/lib/orber/src/orber.app.src +++ b/lib/orber/src/orber.app.src @@ -105,7 +105,7 @@ {env, []}, {mod, {orber, []}}, {runtime_dependencies, ["stdlib-2.0","ssl-5.3.4","mnesia-4.12","kernel-3.0", - "inets-5.10","erts-6.0"]} + "inets-5.10","erts-7.0"]} ]}. diff --git a/lib/orber/src/orber_ifr_utils.erl b/lib/orber/src/orber_ifr_utils.erl index 11e3d1cd3b..35c891ef6e 100644 --- a/lib/orber/src/orber_ifr_utils.erl +++ b/lib/orber/src/orber_ifr_utils.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -289,10 +289,9 @@ makeref(Obj) -> %%% unique tag. I do this because the tuple generated takes a lot of space %%% when I dump the database. A binary is simply printed as #Bin, which %%% is much less obtrusive. -%%% The code has been moved to a macro defined in orber_ifr.hrl, so we -%%% can use a simpler uniqification code when debugging. -unique() -> term_to_binary({node(), now()}). +unique() -> term_to_binary({node(), {erlang:system_time(), + erlang:unique_integer()}}). %%%---------------------------------------------------------------------- %%% Check for an existing object with the Id of the object which is diff --git a/lib/orber/src/orber_objectkeys.erl b/lib/orber/src/orber_objectkeys.erl index b0e759187b..f57b1d811f 100644 --- a/lib/orber/src/orber_objectkeys.erl +++ b/lib/orber/src/orber_objectkeys.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -374,11 +374,11 @@ handle_call({register, Objkey, Pid, Type}, _From, State) -> %% No key exists. Ok to register. mnesia:write(#orber_objkeys{object_key=Objkey, pid=Pid, persistent=Type, - timestamp=now()}); + timestamp=erlang:monotonic_time(seconds)}); [X] when X#orber_objkeys.persistent==true, X#orber_objkeys.pid == dead -> %% A persistent object is being restarted. Update Pid & time. - mnesia:write(X#orber_objkeys{pid=Pid, timestamp=now()}); + mnesia:write(X#orber_objkeys{pid=Pid, timestamp=erlang:monotonic_time(seconds)}); [X] when is_pid(X#orber_objkeys.pid) -> %% Object exists, i.e., trying to create an object with %% the same name. @@ -477,7 +477,7 @@ handle_info({'EXIT', Pid, Reason}, State) when is_pid(Pid) -> Reason /= normal andalso Reason /= shutdown -> mnesia:write(X#orber_objkeys{pid=dead, - timestamp=now()}); + timestamp=erlang:monotonic_time(seconds)}); [X] when X#orber_objkeys.persistent==true -> mnesia:delete({orber_objkeys, X#orber_objkeys.object_key}); _-> @@ -503,8 +503,8 @@ code_change(_OldVsn, State, _Extra) -> %% Internal Functions %%----------------------------------------------------------------- -timetest(S, {MeSec, Sec, USec}) -> - {MeSec, Sec+S, USec} < now(). +timetest(S, TimeStamp) -> + TimeStamp+S < erlang:monotonic_time(seconds). get_key_from_pid(Pid) -> case mnesia:dirty_match_object({orber_objkeys, '_', Pid,'_','_'}) of diff --git a/lib/orber/src/orber_socket.erl b/lib/orber/src/orber_socket.erl index 4507d90cce..4567728693 100644 --- a/lib/orber/src/orber_socket.erl +++ b/lib/orber/src/orber_socket.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -167,8 +167,6 @@ multi_connect([CurrentPort|Rest], Retries, ssl, Host, Port, Options, Timeout) -> get_port_sequence(Min, Max) -> case orber_env:iiop_out_ports_random() of true -> - {A1,A2,A3} = now(), - random:seed(A1, A2, A3), Seq = lists:seq(Min, Max), random_sequence((Max - Min) + 1, Seq, []); _ -> @@ -178,7 +176,7 @@ get_port_sequence(Min, Max) -> random_sequence(0, _, Acc) -> Acc; random_sequence(Length, Seq, Acc) -> - Nth = random:uniform(Length), + Nth = rand:uniform(Length), Value = lists:nth(Nth, Seq), NewSeq = lists:delete(Value, Seq), random_sequence(Length-1, NewSeq, [Value|Acc]). diff --git a/lib/orber/src/orber_web_server.erl b/lib/orber/src/orber_web_server.erl index 9d2a063a69..1cda862f1b 100644 --- a/lib/orber/src/orber_web_server.erl +++ b/lib/orber/src/orber_web_server.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -46,7 +46,7 @@ -define(DEBUG_LEVEL, 5). --record(state, {ts}). +-record(state, {}). -include("ifr_objects.hrl"). %%---------------------------------------------------------------------- @@ -133,9 +133,7 @@ delete_obj(Env, Input) -> %% Description: %%---------------------------------------------------------------------- init(_Arg)-> - {M, S, U} = now(), - TS = M*1000000000000 + S*1000000 + U, - {ok, #state{ts = TS}}. + {ok, #state{}}. terminate(_,_State)-> ok. diff --git a/lib/orber/test/cdrcoding_10_SUITE.erl b/lib/orber/test/cdrcoding_10_SUITE.erl index 54ad92cf7e..d8e57f74e5 100644 --- a/lib/orber/test/cdrcoding_10_SUITE.erl +++ b/lib/orber/test/cdrcoding_10_SUITE.erl @@ -622,4 +622,6 @@ corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) -> term_to_binary(undefined), term_to_binary(undefined)}. make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). diff --git a/lib/orber/test/cdrcoding_11_SUITE.erl b/lib/orber/test/cdrcoding_11_SUITE.erl index 29b3e33069..bcd2b70446 100644 --- a/lib/orber/test/cdrcoding_11_SUITE.erl +++ b/lib/orber/test/cdrcoding_11_SUITE.erl @@ -621,4 +621,6 @@ corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) -> term_to_binary(undefined), term_to_binary(undefined)}. make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). diff --git a/lib/orber/test/cdrcoding_12_SUITE.erl b/lib/orber/test/cdrcoding_12_SUITE.erl index dd9b98434d..a58688b654 100644 --- a/lib/orber/test/cdrcoding_12_SUITE.erl +++ b/lib/orber/test/cdrcoding_12_SUITE.erl @@ -609,4 +609,6 @@ corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) -> term_to_binary(undefined), term_to_binary(undefined)}. make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). diff --git a/lib/orber/test/iop_ior_10_SUITE.erl b/lib/orber/test/iop_ior_10_SUITE.erl index 58dd1b5dba..be3daf6198 100644 --- a/lib/orber/test/iop_ior_10_SUITE.erl +++ b/lib/orber/test/iop_ior_10_SUITE.erl @@ -182,4 +182,6 @@ corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) -> make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). diff --git a/lib/orber/test/iop_ior_11_SUITE.erl b/lib/orber/test/iop_ior_11_SUITE.erl index 24b2f66357..4c4dd4effa 100644 --- a/lib/orber/test/iop_ior_11_SUITE.erl +++ b/lib/orber/test/iop_ior_11_SUITE.erl @@ -201,4 +201,6 @@ corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) -> {Id, 'registered', RegName, term_to_binary(undefined), 0, 0}. make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). diff --git a/lib/orber/test/iop_ior_12_SUITE.erl b/lib/orber/test/iop_ior_12_SUITE.erl index 4c6e9ddb91..9f50784666 100644 --- a/lib/orber/test/iop_ior_12_SUITE.erl +++ b/lib/orber/test/iop_ior_12_SUITE.erl @@ -202,4 +202,6 @@ corba_fake_mk_objkey(Id, 'registered', RegName) when is_atom(RegName) -> {Id, 'registered', RegName, term_to_binary(undefined), 0, 0}. make_objkey() -> - term_to_binary({now(), node()}). + term_to_binary({{erlang:system_time(), + erlang:unique_integer()}, + node()}). diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl index 40d8846e0f..3d0132c3e6 100644 --- a/lib/orber/test/multi_ORB_SUITE.erl +++ b/lib/orber/test/multi_ORB_SUITE.erl @@ -922,9 +922,9 @@ max_requests(Node, Host, Port) -> spawn(orber_test_server, pseudo_call_delay, [Obj, 15000]), %% Wait for a second to be sure that the previous request has been sent timer:sleep(1000), - {MegaSecsB, Before, _} = now(), + {MegaSecsB, Before, _} = erlang:timestamp(), pseudo_calls(5, Obj), - {MegaSecsA, After, _} = now(), + {MegaSecsA, After, _} = erlang:timestamp(), %% Normally we we can perform hundreds of pseudo-calls per second. Hence, %% if we add 8 seconds to 'Before' it should still be less since we only %% allow one request at a time to the target ORB. diff --git a/lib/orber/test/orber_acl_SUITE.erl b/lib/orber/test/orber_acl_SUITE.erl index ab2c2c872c..05146afded 100644 --- a/lib/orber/test/orber_acl_SUITE.erl +++ b/lib/orber/test/orber_acl_SUITE.erl @@ -272,21 +272,21 @@ ipv6_bm(_) -> bm2(Filters, Family, Ip) -> {ok, IPTuple} = inet:getaddr(Ip, Family), orber_acl:init_acl(Filters, Family), - TimeBefore1 = erlang:now(), + TimeBefore1 = erlang:timestamp(), bm_loop(IPTuple, ?NO_OF_TIMES), - TimeAfter1 = erlang:now(), + TimeAfter1 = erlang:timestamp(), orber_acl:clear_acl(), Time1 = computeTime(TimeBefore1, TimeAfter1), orber_acl:init_acl(Filters, Family), - TimeBefore2 = erlang:now(), + TimeBefore2 = erlang:timestamp(), bm_loop2(Ip, ?NO_OF_TIMES, Family), - TimeAfter2 = erlang:now(), + TimeAfter2 = erlang:timestamp(), orber_acl:clear_acl(), Time2 = computeTime(TimeBefore2, TimeAfter2), orber_acl:init_acl(Filters, Family), - TimeBefore3 = erlang:now(), + TimeBefore3 = erlang:timestamp(), bm_loop2(IPTuple, ?NO_OF_TIMES, Family), - TimeAfter3 = erlang:now(), + TimeAfter3 = erlang:timestamp(), orber_acl:clear_acl(), Time3 = computeTime(TimeBefore3, TimeAfter3), {ok, round(?NO_OF_TIMES/Time1), round(?NO_OF_TIMES/Time2), round(?NO_OF_TIMES/Time3)}. diff --git a/lib/orber/test/orber_test_lib.erl b/lib/orber/test/orber_test_lib.erl index 46ed26f210..c970600fce 100644 --- a/lib/orber/test/orber_test_lib.erl +++ b/lib/orber/test/orber_test_lib.erl @@ -220,7 +220,7 @@ js_node(InitOptions) when is_list(InitOptions) -> js_node(InitOptions, []). js_node(InitOptions, StartOptions) when is_list(InitOptions) -> - {A,B,C} = erlang:now(), + {A,B,C} = erlang:timestamp(), [_, Host] = string:tokens(atom_to_list(node()), [$@]), _NewInitOptions = check_options(InitOptions), js_node_helper(Host, 0, lists:concat([A,'_',B,'_',C]), diff --git a/lib/orber/test/orber_test_server_impl.erl b/lib/orber/test/orber_test_server_impl.erl index 10a9caf242..9aa12e98fb 100644 --- a/lib/orber/test/orber_test_server_impl.erl +++ b/lib/orber/test/orber_test_server_impl.erl @@ -243,22 +243,22 @@ relay_cast(_Self, State, Target) -> %% Testing pseudo calls. pseudo_call(_Self, State) -> - io:format("orber_test_server:pseudo_call( ~p )~n", [now()]), + io:format("orber_test_server:pseudo_call( ~p )~n", [erlang:timestamp()]), {reply, ok, State}. pseudo_cast(_Self, State) -> - io:format("orber_test_server:pseudo_cast( ~p )~n", [now()]), + io:format("orber_test_server:pseudo_cast( ~p )~n", [erlang:timestamp()]), {noreply, State}. pseudo_call_delay(_Self, State, Time) -> - io:format("orber_test_server:pseudo_call_delay( ~p )~n", [now()]), + io:format("orber_test_server:pseudo_call_delay( ~p )~n", [erlang:timestamp()]), timer:sleep(Time), - io:format("orber_test_server:pseudo_call_delay( ~p )~n", [now()]), + io:format("orber_test_server:pseudo_call_delay( ~p )~n", [erlang:timestamp()]), {reply, {ok, Time}, State}. pseudo_cast_delay(_Self, State, Time) -> - io:format("orber_test_server:pseudo_cast_delay( ~p )~n", [now()]), + io:format("orber_test_server:pseudo_cast_delay( ~p )~n", [erlang:timestamp()]), timer:sleep(Time), - io:format("orber_test_server:pseudo_cast_delay( ~p )~n", [now()]), + io:format("orber_test_server:pseudo_cast_delay( ~p )~n", [erlang:timestamp()]), {noreply, State}. pseudo_call_raise_exc(_Self, State, 1) -> diff --git a/lib/orber/vsn.mk b/lib/orber/vsn.mk index 28fe9323fb..505c77de18 100644 --- a/lib/orber/vsn.mk +++ b/lib/orber/vsn.mk @@ -1 +1 @@ -ORBER_VSN = 3.7.1 +ORBER_VSN = 3.8 diff --git a/lib/os_mon/doc/src/notes.xml b/lib/os_mon/doc/src/notes.xml index 6bc0cf7d43..d3acc1effc 100644 --- a/lib/os_mon/doc/src/notes.xml +++ b/lib/os_mon/doc/src/notes.xml @@ -30,6 +30,34 @@ </header> <p>This document describes the changes made to the OS_Mon application.</p> +<section><title>Os_Mon 2.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Do not crash with badmatch when integer part of loadavg + has more than 2 digits.</p> + <p> + Own Id: OTP-12581</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix compilation of memsup on OpenBSD.</p> + <p> + Own Id: OTP-12404</p> + </item> + </list> + </section> + +</section> + <section><title>Os_Mon 2.3</title> <section><title>Improvements and New Features</title> diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl index 1f088ecbde..66e7973e7e 100644 --- a/lib/os_mon/src/cpu_sup.erl +++ b/lib/os_mon/src/cpu_sup.erl @@ -221,7 +221,7 @@ get_uint32_measurement(Request, #internal{port = P, os_type = {unix, sunos}}) -> port_server_call(P, Request); get_uint32_measurement(Request, #internal{os_type = {unix, linux}}) -> {ok,F} = file:open("/proc/loadavg",[read,raw]), - {ok,D} = file:read(F,24), + {ok,D} = file:read_line(F), ok = file:close(F), {ok,[Load1,Load5,Load15,_PRun,PTotal],_} = io_lib:fread("~f ~f ~f ~d/~d", D), case Request of diff --git a/lib/os_mon/vsn.mk b/lib/os_mon/vsn.mk index f90cc306f0..833e855e0e 100644 --- a/lib/os_mon/vsn.mk +++ b/lib/os_mon/vsn.mk @@ -1 +1 @@ -OS_MON_VSN = 2.3 +OS_MON_VSN = 2.3.1 diff --git a/lib/parsetools/include/yeccpre.hrl b/lib/parsetools/include/yeccpre.hrl index 855bff5fdc..b9bba9a7c2 100644 --- a/lib/parsetools/include/yeccpre.hrl +++ b/lib/parsetools/include/yeccpre.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -124,21 +124,10 @@ yecc_end(Line) -> {'$end', Line}. yecctoken_end_location(Token) -> - try - {text, Str} = erl_scan:token_info(Token, text), - {line, Line} = erl_scan:token_info(Token, line), - Parts = re:split(Str, "\n"), - Dline = length(Parts) - 1, - Yline = Line + Dline, - case erl_scan:token_info(Token, column) of - {column, Column} -> - Col = byte_size(lists:last(Parts)), - {Yline, Col + if Dline =:= 0 -> Column; true -> 1 end}; - undefined -> - Yline - end - catch _:_ -> - yecctoken_location(Token) + try erl_anno:end_location(element(2, Token)) of + undefined -> yecctoken_location(Token); + Loc -> Loc + catch _:_ -> yecctoken_location(Token) end. -compile({nowarn_unused_function, yeccerror/1}). @@ -149,15 +138,15 @@ yeccerror(Token) -> -compile({nowarn_unused_function, yecctoken_to_string/1}). yecctoken_to_string(Token) -> - case catch erl_scan:token_info(Token, text) of - {text, Txt} -> Txt; - _ -> yecctoken2string(Token) + try erl_scan:text(Token) of + undefined -> yecctoken2string(Token); + Txt -> Txt + catch _:_ -> yecctoken2string(Token) end. yecctoken_location(Token) -> - case catch erl_scan:token_info(Token, location) of - {location, Loc} -> Loc; - _ -> element(2, Token) + try erl_scan:location(Token) + catch _:_ -> element(2, Token) end. -compile({nowarn_unused_function, yecctoken2string/1}). diff --git a/lib/parsetools/src/leex.erl b/lib/parsetools/src/leex.erl index 03f864ff03..15d42a4d9c 100644 --- a/lib/parsetools/src/leex.erl +++ b/lib/parsetools/src/leex.erl @@ -1545,7 +1545,7 @@ out_action_code(File, XrlFile, {_A,Code,_Vars,Name,Args,ArgsChars}) -> %% Should set the file to the .erl file, but instead assumes that %% ?LEEXINC is syntactically correct. io:fwrite(File, "\n-compile({inline,~w/~w}).\n", [Name, length(Args)]), - {line, L} = erl_scan:token_info(hd(Code), line), + L = erl_scan:line(hd(Code)), output_file_directive(File, XrlFile, L-2), io:fwrite(File, "~s(~s) ->~n", [Name, ArgsChars]), io:fwrite(File, " ~s\n", [pp_tokens(Code, L)]). @@ -1557,7 +1557,7 @@ pp_tokens(Tokens, Line0) -> pp_tokens(Tokens, Line0, none). pp_tokens([], _Line0, _) -> []; pp_tokens([T | Ts], Line0, Prev) -> - {line, Line} = erl_scan:token_info(T, line), + Line = erl_scan:line(T), [pp_sep(Line, Line0, Prev, T), pp_symbol(T) | pp_tokens(Ts, Line, T)]. pp_symbol({var,_,Var}) -> atom_to_list(Var); diff --git a/lib/parsetools/src/yeccgramm.yrl b/lib/parsetools/src/yeccgramm.yrl index 562a9a7458..d76ebfc569 100644 --- a/lib/parsetools/src/yeccgramm.yrl +++ b/lib/parsetools/src/yeccgramm.yrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -38,8 +38,8 @@ rule -> head '->' symbols attached_code dot: {rule, ['$1' | '$3'], '$4'}. head -> symbol : '$1'. symbols -> symbol : ['$1']. symbols -> symbol symbols : ['$1' | '$2']. -strings -> string : ['$1']. -strings -> string strings : ['$1' | '$2']. +strings -> string : [string('$1')]. +strings -> string strings : [string('$1') | '$2']. attached_code -> ':' tokens : {erlang_code, '$2'}. attached_code -> '$empty' : {erlang_code, [{atom, 0, '$undefined'}]}. tokens -> token : ['$1']. @@ -48,12 +48,12 @@ symbol -> var : symbol('$1'). symbol -> atom : symbol('$1'). symbol -> integer : symbol('$1'). symbol -> reserved_word : symbol('$1'). -token -> var : '$1'. -token -> atom : '$1'. -token -> float : '$1'. -token -> integer : '$1'. -token -> string : '$1'. -token -> char : '$1'. +token -> var : token('$1'). +token -> atom : token('$1'). +token -> float : token('$1'). +token -> integer : token('$1'). +token -> string : token('$1'). +token -> char : token('$1'). token -> reserved_symbol : {value_of('$1'), line_of('$1')}. token -> reserved_word : {value_of('$1'), line_of('$1')}. token -> '->' : {'->', line_of('$1')}. % Have to be treated in this @@ -67,8 +67,14 @@ Erlang code. symbol(Symbol) -> #symbol{line = line_of(Symbol), name = value_of(Symbol)}. +token(Token) -> + setelement(2, Token, line_of(Token)). + +string(Token) -> + setelement(2, Token, line_of(Token)). + value_of(Token) -> element(3, Token). line_of(Token) -> - element(2, Token). + erl_anno:line(element(2, Token)). diff --git a/lib/parsetools/src/yeccparser.erl b/lib/parsetools/src/yeccparser.erl index 54f9ba5a58..fa0a1c4e2a 100644 --- a/lib/parsetools/src/yeccparser.erl +++ b/lib/parsetools/src/yeccparser.erl @@ -7,17 +7,23 @@ symbol(Symbol) -> #symbol{line = line_of(Symbol), name = value_of(Symbol)}. +token(Token) -> + setelement(2, Token, line_of(Token)). + +string(Token) -> + setelement(2, Token, line_of(Token)). + value_of(Token) -> element(3, Token). line_of(Token) -> - element(2, Token). + erl_anno:line(element(2, Token)). --file("/clearcase/otp/erts/lib/parsetools/include/yeccpre.hrl", 0). +-file("lib/parsetools/include/yeccpre.hrl", 0). %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -44,10 +50,11 @@ parse(Tokens) -> -spec parse_and_scan({function() | {atom(), atom()}, [_]} | {atom(), atom(), [_]}) -> yecc_ret(). -parse_and_scan({F, A}) -> % Fun or {M, F} +parse_and_scan({F, A}) -> yeccpars0([], {{F, A}, no_line}, 0, [], []); parse_and_scan({M, F, A}) -> - yeccpars0([], {{{M, F}, A}, no_line}, 0, [], []). + Arity = length(A), + yeccpars0([], {{fun M:F/Arity, A}, no_line}, 0, [], []). -spec format_error(any()) -> [char() | list()]. format_error(Message) -> @@ -140,13 +147,13 @@ yecc_end(Line) -> yecctoken_end_location(Token) -> try - {text, Str} = erl_scan:token_info(Token, text), - {line, Line} = erl_scan:token_info(Token, line), + Str = erl_scan:text(Token), + Line = erl_scan:line(Token), Parts = re:split(Str, "\n"), Dline = length(Parts) - 1, Yline = Line + Dline, - case erl_scan:token_info(Token, column) of - {column, Column} -> + case erl_scan:column(Token) of + Column when is_integer(Column) -> Col = byte_size(lists:last(Parts)), {Yline, Col + if Dline =:= 0 -> Column; true -> 1 end}; undefined -> @@ -156,23 +163,26 @@ yecctoken_end_location(Token) -> yecctoken_location(Token) end. +-compile({nowarn_unused_function, yeccerror/1}). yeccerror(Token) -> Text = yecctoken_to_string(Token), Location = yecctoken_location(Token), {error, {Location, ?MODULE, ["syntax error before: ", Text]}}. +-compile({nowarn_unused_function, yecctoken_to_string/1}). yecctoken_to_string(Token) -> - case catch erl_scan:token_info(Token, text) of - {text, Txt} -> Txt; + case catch erl_scan:text(Token) of + Txt when is_list(Txt) -> Txt; _ -> yecctoken2string(Token) end. yecctoken_location(Token) -> - case catch erl_scan:token_info(Token, location) of - {location, Loc} -> Loc; + case catch erl_scan:location(Token) of + Loc when Loc =/= undefined -> Loc; _ -> element(2, Token) end. +-compile({nowarn_unused_function, yecctoken2string/1}). yecctoken2string({atom, _, A}) -> io_lib:write(A); yecctoken2string({integer,_,N}) -> io_lib:write(N); yecctoken2string({float,_,F}) -> io_lib:write(F); @@ -180,7 +190,7 @@ yecctoken2string({char,_,C}) -> io_lib:write_char(C); yecctoken2string({var,_,V}) -> io_lib:format("~s", [V]); yecctoken2string({string,_,S}) -> io_lib:write_string(S); yecctoken2string({reserved_symbol, _, A}) -> io_lib:write(A); -yecctoken2string({_Cat, _, Val}) -> io_lib:write(Val); +yecctoken2string({_Cat, _, Val}) -> io_lib:format("~p",[Val]); yecctoken2string({dot, _}) -> "'.'"; yecctoken2string({'$end', _}) -> []; @@ -193,7 +203,7 @@ yecctoken2string(Other) -> --file("yeccparser.erl", 196). +-file("yeccgramm.erl", 207). yeccpars2(0=S, Cat, Ss, Stack, T, Ts, Tzr) -> yeccpars2_0(S, Cat, Ss, Stack, T, Ts, Tzr); @@ -268,7 +278,7 @@ yeccpars2(34=S, Cat, Ss, Stack, T, Ts, Tzr) -> yeccpars2(35=S, Cat, Ss, Stack, T, Ts, Tzr) -> yeccpars2_35(S, Cat, Ss, Stack, T, Ts, Tzr); yeccpars2(Other, _, _, _, _, _, _) -> - erlang:error({yecc_bug,"1.3",{missing_state_in_action_table, Other}}). + erlang:error({yecc_bug,"1.4",{missing_state_in_action_table, Other}}). yeccpars2_0(S, atom, Ss, Stack, T, Ts, Tzr) -> yeccpars1(S, 6, Ss, Stack, T, Ts, Tzr); @@ -417,16 +427,20 @@ yeccpars2_19(_S, Cat, Ss, Stack, T, Ts, Tzr) -> yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_20(_S, Cat, Ss, Stack, T, Ts, Tzr) -> - yeccgoto_token(hd(Ss), Cat, Ss, Stack, T, Ts, Tzr). + NewStack = yeccpars2_20_(Stack), + yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_21(_S, Cat, Ss, Stack, T, Ts, Tzr) -> - yeccgoto_token(hd(Ss), Cat, Ss, Stack, T, Ts, Tzr). + NewStack = yeccpars2_21_(Stack), + yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_22(_S, Cat, Ss, Stack, T, Ts, Tzr) -> - yeccgoto_token(hd(Ss), Cat, Ss, Stack, T, Ts, Tzr). + NewStack = yeccpars2_22_(Stack), + yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_23(_S, Cat, Ss, Stack, T, Ts, Tzr) -> - yeccgoto_token(hd(Ss), Cat, Ss, Stack, T, Ts, Tzr). + NewStack = yeccpars2_23_(Stack), + yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_24(_S, Cat, Ss, Stack, T, Ts, Tzr) -> NewStack = yeccpars2_24_(Stack), @@ -437,10 +451,12 @@ yeccpars2_25(_S, Cat, Ss, Stack, T, Ts, Tzr) -> yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_26(_S, Cat, Ss, Stack, T, Ts, Tzr) -> - yeccgoto_token(hd(Ss), Cat, Ss, Stack, T, Ts, Tzr). + NewStack = yeccpars2_26_(Stack), + yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_27(_S, Cat, Ss, Stack, T, Ts, Tzr) -> - yeccgoto_token(hd(Ss), Cat, Ss, Stack, T, Ts, Tzr). + NewStack = yeccpars2_27_(Stack), + yeccgoto_token(hd(Ss), Cat, Ss, NewStack, T, Ts, Tzr). yeccpars2_28(_S, Cat, Ss, Stack, T, Ts, Tzr) -> [_|Nss] = Ss, @@ -616,6 +632,38 @@ yeccpars2_19_(__Stack0) -> { ':' , line_of ( __1 ) } end | __Stack]. +-compile({inline,yeccpars2_20_/1}). +-file("yeccgramm.yrl", 48). +yeccpars2_20_(__Stack0) -> + [__1 | __Stack] = __Stack0, + [begin + token ( __1 ) + end | __Stack]. + +-compile({inline,yeccpars2_21_/1}). +-file("yeccgramm.yrl", 52). +yeccpars2_21_(__Stack0) -> + [__1 | __Stack] = __Stack0, + [begin + token ( __1 ) + end | __Stack]. + +-compile({inline,yeccpars2_22_/1}). +-file("yeccgramm.yrl", 49). +yeccpars2_22_(__Stack0) -> + [__1 | __Stack] = __Stack0, + [begin + token ( __1 ) + end | __Stack]. + +-compile({inline,yeccpars2_23_/1}). +-file("yeccgramm.yrl", 50). +yeccpars2_23_(__Stack0) -> + [__1 | __Stack] = __Stack0, + [begin + token ( __1 ) + end | __Stack]. + -compile({inline,yeccpars2_24_/1}). -file("yeccgramm.yrl", 53). yeccpars2_24_(__Stack0) -> @@ -632,6 +680,22 @@ yeccpars2_25_(__Stack0) -> { value_of ( __1 ) , line_of ( __1 ) } end | __Stack]. +-compile({inline,yeccpars2_26_/1}). +-file("yeccgramm.yrl", 51). +yeccpars2_26_(__Stack0) -> + [__1 | __Stack] = __Stack0, + [begin + token ( __1 ) + end | __Stack]. + +-compile({inline,yeccpars2_27_/1}). +-file("yeccgramm.yrl", 47). +yeccpars2_27_(__Stack0) -> + [__1 | __Stack] = __Stack0, + [begin + token ( __1 ) + end | __Stack]. + -compile({inline,yeccpars2_28_/1}). -file("yeccgramm.yrl", 42). yeccpars2_28_(__Stack0) -> @@ -653,7 +717,7 @@ yeccpars2_29_(__Stack0) -> yeccpars2_32_(__Stack0) -> [__1 | __Stack] = __Stack0, [begin - [ __1 ] + [ string ( __1 ) ] end | __Stack]. -compile({inline,yeccpars2_33_/1}). @@ -661,7 +725,7 @@ yeccpars2_32_(__Stack0) -> yeccpars2_33_(__Stack0) -> [__2,__1 | __Stack] = __Stack0, [begin - [ __1 | __2 ] + [ string ( __1 ) | __2 ] end | __Stack]. -compile({inline,yeccpars2_34_/1}). @@ -681,4 +745,4 @@ yeccpars2_35_(__Stack0) -> end | __Stack]. --file("yeccgramm.yrl", 75). +-file("yeccgramm.yrl", 82). diff --git a/lib/parsetools/test/yecc_SUITE.erl b/lib/parsetools/test/yecc_SUITE.erl index c18dc15e37..b8d658e5c2 100644 --- a/lib/parsetools/test/yecc_SUITE.erl +++ b/lib/parsetools/test/yecc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2014. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1521,7 +1521,9 @@ otp_7945(doc) -> "OTP-7945. A bug introduced in R13A."; otp_7945(suite) -> []; otp_7945(Config) when is_list(Config) -> - ?line {error,_} = erl_parse:parse([{atom,3,foo},{'.',2,9,9}]), + A2 = erl_anno:new(2), + A3 = erl_anno:new(3), + {error,_} = erl_parse:parse([{atom,3,foo},{'.',A2,9,9}]), ok. otp_8483(doc) -> @@ -1786,7 +1788,8 @@ otp_7969(Config) when is_list(Config) -> ?line {ok, Ts11, _}=R1 = erl_scan:string("f() -> a."), ?line F1 = fun() -> {ok,Ts11 ++ [{'$end',2}],2} end, - ?line{ok,{function,1,f,0,[{clause,1,[],[],[{atom,1,a}]}]}} = + A1 = erl_anno:new(1), + {ok,{function,A1,f,0,[{clause,A1,[],[],[{atom,A1,a}]}]}} = erl_parse:parse_and_scan({F1, []}), ?line F2 = fun() -> erl_scan:string("f() -> ,") end, ?line {error,{1,erl_parse,_}} = erl_parse:parse_and_scan({F2, []}), @@ -1797,7 +1800,7 @@ otp_7969(Config) when is_list(Config) -> put(foo,bar), R1 end end, - ?line {ok,{function,1,f,0,[{clause,1,[],[],[{atom,1,a}]}]}} = + {ok,{function,A1,f,0,[{clause,A1,[],[],[{atom,A1,a}]}]}} = erl_parse:parse_and_scan({F3,[]}), F4 = fun() -> {error, {1, ?MODULE, bad}, 2} end, ?line {error, {1,?MODULE,bad}} = erl_parse:parse_and_scan({F4, []}), @@ -1813,7 +1816,8 @@ otp_8919(doc) -> "OTP-8919. Improve formating of Yecc error messages."; otp_8919(suite) -> []; otp_8919(Config) when is_list(Config) -> - {error,{1,Mod,Mess}} = erl_parse:parse([{cat,1,"hello"}]), + A1 = erl_anno:new(1), + {error,{1,Mod,Mess}} = erl_parse:parse([{cat,A1,"hello"}]), "syntax error before: \"hello\"" = lists:flatten(Mod:format_error(Mess)), ok. diff --git a/lib/percept/src/percept.erl b/lib/percept/src/percept.erl index 3a2d9f7601..135e20774e 100644 --- a/lib/percept/src/percept.erl +++ b/lib/percept/src/percept.erl @@ -319,10 +319,6 @@ get_webserver_config(Servername, Port) when is_list(Servername), is_integer(Port {alias,{"/images/", filename:join([Root, "images"]) ++ "/"}}, {alias,{"/css/", filename:join([Root, "css"]) ++ "/"}}, - % Logs - %{transfer_log, filename:join([Path, "logs", "transfer.log"])}, - %{error_log, filename:join([Path, "logs", "error.log"])}, - % Configs {default_type,"text/plain"}, {directory_index,["index.html"]}, @@ -331,12 +327,9 @@ get_webserver_config(Servername, Port) when is_list(Servername), is_integer(Port mod_esi, mod_actions, mod_cgi, - mod_include, mod_dir, mod_get, mod_head - % mod_log, - % mod_disk_log ]}, {com_type,ip_comm}, {server_name, Servername}, diff --git a/lib/public_key/asn1/Makefile b/lib/public_key/asn1/Makefile index c1b3bc866d..11b03dc2f7 100644 --- a/lib/public_key/asn1/Makefile +++ b/lib/public_key/asn1/Makefile @@ -66,7 +66,7 @@ EBIN = ../ebin EXTRA_ERLC_FLAGS = ERL_COMPILE_FLAGS += $(EXTRA_ERLC_FLAGS) -ASN_FLAGS = -bber +der +compact_bit_string +noobj +asn1config +ASN_FLAGS = -bber +der +noobj +asn1config # ---------------------------------------------------- # Targets diff --git a/lib/public_key/doc/src/cert_records.xml b/lib/public_key/doc/src/cert_records.xml index b66c66bead..857a39bf40 100644 --- a/lib/public_key/doc/src/cert_records.xml +++ b/lib/public_key/doc/src/cert_records.xml @@ -98,7 +98,7 @@ semantics, please see <url #'Certificate'{ tbsCertificate, % #'TBSCertificate'{} signatureAlgorithm, % #'AlgorithmIdentifier'{} - signature % {0, binary()} - ASN1 compact bitstring + signature % bitstring() }. #'TBSCertificate'{ @@ -124,7 +124,7 @@ semantics, please see <url #'OTPCertificate'{ tbsCertificate, % #'OTPTBSCertificate'{} signatureAlgorithm, % #'SignatureAlgorithm' - signature % {0, binary()} - ASN1 compact bitstring + signature % bitstring() }. #'OTPTBSCertificate'{ @@ -542,7 +542,7 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> #'CertificateList'{ tbsCertList, % #'TBSCertList{} signatureAlgorithm, % #'AlgorithmIdentifier'{} - signature % {0, binary()} - ASN1 compact bitstring + signature % bitstring() }). #'TBSCertList'{ @@ -654,7 +654,7 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> #'CertificationRequest'{ certificationRequestInfo #'CertificationRequestInfo'{}, signatureAlgorithm #'CertificationRequest_signatureAlgorithm'{}}. - signature {0, binary()} - ASN1 compact bitstring + signature bitstring() } #'CertificationRequestInfo'{ @@ -666,7 +666,7 @@ oid names see table below. Ex: ?'id-dsa-with-sha1'</p> #'CertificationRequestInfo_subjectPKInfo'{ algorithm #'CertificationRequestInfo_subjectPKInfo_algorithm'{} - subjectPublicKey {0, binary()} - ASN1 compact bitstring + subjectPublicKey bitstring() } #'CertificationRequestInfo_subjectPKInfo_algorithm'{ diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml index fe4bf5ce2d..f241a91eb0 100644 --- a/lib/public_key/doc/src/notes.xml +++ b/lib/public_key/doc/src/notes.xml @@ -34,6 +34,21 @@ <file>notes.xml</file> </header> +<section><title>Public_Key 0.23</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Improve/extend support for CRL handling.</p> + <p> + Own Id: OTP-12547 Aux Id: OTP-10362 </p> + </item> + </list> + </section> + +</section> + <section><title>Public_Key 0.22.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/public_key/doc/src/public_key_records.xml b/lib/public_key/doc/src/public_key_records.xml index d3534846fa..a7dfc41449 100644 --- a/lib/public_key/doc/src/public_key_records.xml +++ b/lib/public_key/doc/src/public_key_records.xml @@ -115,7 +115,7 @@ <code> #'ECPrivateKey'{ version, % integer() - privateKey, % octet_string() + privateKey, % binary() parameters, % der_encoded() - {'EcpkParameters', #'ECParameters'{}} | {'EcpkParameters', {namedCurve, oid()}} | {'EcpkParameters', 'NULL'} % Inherited by CA @@ -126,14 +126,14 @@ version, % integer() fieldID, % #'FieldID'{} curve, % #'Curve'{} - base, % octet_string() + base, % binary() order, % integer() cofactor % integer() }. #'Curve'{ - a, % octet_string() - b, % octet_string() + a, % binary() + b, % binary() seed % bitstring() - optional }. @@ -144,7 +144,7 @@ }. #'ECPoint'{ - point % octet_string() - the public key + point % binary() - the public key }. </code> diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl index 8b11538499..1aa9c6764b 100644 --- a/lib/public_key/src/pubkey_cert.erl +++ b/lib/public_key/src/pubkey_cert.erl @@ -445,7 +445,7 @@ extensions_list(Extensions) -> Extensions. extract_verify_data(OtpCert, DerCert) -> - {_, Signature} = OtpCert#'OTPCertificate'.signature, + Signature = OtpCert#'OTPCertificate'.signature, SigAlgRec = OtpCert#'OTPCertificate'.signatureAlgorithm, SigAlg = SigAlgRec#'SignatureAlgorithm'.algorithm, PlainText = encoded_tbs_cert(DerCert), diff --git a/lib/public_key/src/pubkey_cert_records.erl b/lib/public_key/src/pubkey_cert_records.erl index 9a8e49f265..f412d5862e 100644 --- a/lib/public_key/src/pubkey_cert_records.erl +++ b/lib/public_key/src/pubkey_cert_records.erl @@ -217,8 +217,8 @@ namedCurves(brainpoolP512t1) -> ?'brainpoolP512t1'. %%% SubjectPublicKey decode_supportedPublicKey(#'OTPSubjectPublicKeyInfo'{algorithm= PA = - #'PublicKeyAlgorithm'{algorithm=Algo}, - subjectPublicKey = {0,SPK0}}) -> + #'PublicKeyAlgorithm'{algorithm=Algo}, + subjectPublicKey = SPK0}) -> Type = supportedPublicKeyAlgorithms(Algo), SPK = case Type of 'ECPoint' -> #'ECPoint'{point = SPK0}; @@ -238,7 +238,7 @@ encode_supportedPublicKey(#'OTPSubjectPublicKeyInfo'{algorithm= PA = {ok, SPK1} = 'OTP-PUB-KEY':encode(Type, SPK0), SPK1 end, - #'OTPSubjectPublicKeyInfo'{subjectPublicKey = {0,SPK}, algorithm=PA}. + #'OTPSubjectPublicKeyInfo'{subjectPublicKey = SPK, algorithm=PA}. %%% Extensions diff --git a/lib/public_key/src/pubkey_crl.erl b/lib/public_key/src/pubkey_crl.erl index 488cc97c70..0010725da9 100644 --- a/lib/public_key/src/pubkey_crl.erl +++ b/lib/public_key/src/pubkey_crl.erl @@ -473,7 +473,7 @@ check_crl_num(_,_) -> extension_value(Extension, ExtType, Extensions) -> case pubkey_cert:select_extension(Extension, Extensions) of #'Extension'{extnValue = Value} -> - public_key:der_decode(ExtType, list_to_binary(Value)); + public_key:der_decode(ExtType, iolist_to_binary(Value)); _ -> undefined end. @@ -565,7 +565,7 @@ verify_crl_signature(CRL, DerCRL, Key, KeyParams) -> {Key, KeyParams}) end. extract_crl_verify_data(CRL, DerCRL) -> - {0, Signature} = CRL#'CertificateList'.signature, + Signature = CRL#'CertificateList'.signature, #'AlgorithmIdentifier'{algorithm = SigAlg} = CRL#'CertificateList'.signatureAlgorithm, PlainText = encoded_tbs_crl(DerCRL), diff --git a/lib/public_key/src/pubkey_pbe.erl b/lib/public_key/src/pubkey_pbe.erl index 521a32189d..8c61bc71d4 100644 --- a/lib/public_key/src/pubkey_pbe.erl +++ b/lib/public_key/src/pubkey_pbe.erl @@ -106,9 +106,8 @@ pbdkdf2(Password, Salt, Count, DerivedKeyLen, Prf, PrfHash, PrfOutputLen)-> %%-------------------------------------------------------------------- decrypt_parameters(#'EncryptedPrivateKeyInfo_encryptionAlgorithm'{ algorithm = Oid, parameters = Param}) -> - decrypt_parameters(Oid, Param). + decrypt_parameters(Oid, decode_handle_open_type_wrapper(Param)). - %%-------------------------------------------------------------------- -spec encrypt_parameters({Cipher::string(), Params::term()}) -> #'EncryptedPrivateKeyInfo_encryptionAlgorithm'{}. @@ -129,7 +128,7 @@ password_to_key_and_iv(Password, _, #'PBES2-params'{} = Params) -> password_to_key_and_iv(Password, _Cipher, {#'PBEParameter'{salt = Salt, iterationCount = Count}, Hash}) -> <<Key:8/binary, IV:8/binary, _/binary>> - = pbdkdf1(Password, erlang:iolist_to_binary(Salt), Count, Hash), + = pbdkdf1(Password, Salt, Count, Hash), {Key, IV}; password_to_key_and_iv(Password, Cipher, Salt) -> KeyLen = derived_key_length(Cipher, undefined), @@ -151,15 +150,15 @@ do_pbdkdf1(Prev, Count, Acc, Hash) -> do_pbdkdf1(Result, Count-1 , <<Result/binary, Acc/binary>>, Hash). iv(#'PBES2-params_encryptionScheme'{algorithm = Algo, - parameters = ASNIV}) when (Algo == ?'desCBC') or - (Algo == ?'des-EDE3-CBC') -> - %% This is an so called open ASN1-type that in this - %% case will be an octet-string of length 8 - <<?ASN1_OCTET_STR_TAG, ?IV_LEN, IV:?IV_LEN/binary>> = ASNIV, + parameters = ASN1IV}) + when (Algo == ?'desCBC') or + (Algo == ?'des-EDE3-CBC') -> + <<?ASN1_OCTET_STR_TAG, ?IV_LEN, IV:?IV_LEN/binary>> = decode_handle_open_type_wrapper(ASN1IV), IV; iv(#'PBES2-params_encryptionScheme'{algorithm = ?'rc2CBC', - parameters = ASN1IV}) -> - {ok, #'RC2-CBC-Parameter'{iv = IV}} = 'PKCS-FRAME':decode('RC2-CBC-Parameter', ASN1IV), + parameters = ASN1IV}) -> + {ok, #'RC2-CBC-Parameter'{iv = IV}} + = 'PKCS-FRAME':decode('RC2-CBC-Parameter', decode_handle_open_type_wrapper(ASN1IV)), iolist_to_binary(IV). blocks(1, N, Index, Password, Salt, Count, Prf, PrfHash, PrfLen, Acc) -> @@ -200,13 +199,13 @@ encrypt_parameters(_Cipher, #'PBES2-params'{} = Params) -> {ok, Der} ='PKCS-FRAME':encode('PBES2-params', Params), #'EncryptedPrivateKeyInfo_encryptionAlgorithm'{ algorithm = ?'id-PBES2', - parameters = Der}; + parameters = encode_handle_open_type_wrapper(Der)}; encrypt_parameters(Cipher, {#'PBEParameter'{} = Params, Hash}) -> {ok, Der} ='PKCS-FRAME':encode('PBEParameter', Params), #'EncryptedPrivateKeyInfo_encryptionAlgorithm'{ algorithm = pbe1_oid(Cipher, Hash), - parameters = Der}. + parameters = encode_handle_open_type_wrapper(Der)}. pbe1_oid("RC2-CBC", sha) -> ?'pbeWithSHA1AndRC2-CBC'; @@ -277,3 +276,8 @@ cipher(#'PBES2-params_encryptionScheme'{algorithm = ?'rc2CBC'}) -> ceiling(Float) -> erlang:round(Float + 0.5). + +decode_handle_open_type_wrapper({asn1_OPENTYPE, Type}) -> + Type. +encode_handle_open_type_wrapper(Type) -> + {asn1_OPENTYPE, Type}. diff --git a/lib/public_key/src/pubkey_pem.erl b/lib/public_key/src/pubkey_pem.erl index 98881c4a6a..a62658923f 100644 --- a/lib/public_key/src/pubkey_pem.erl +++ b/lib/public_key/src/pubkey_pem.erl @@ -143,8 +143,7 @@ decode_encrypted_private_keyinfo(Der) -> encryptedData = Data} = public_key:der_decode('EncryptedPrivateKeyInfo', Der), DecryptParams = pubkey_pbe:decrypt_parameters(AlgorithmInfo), - {'PrivateKeyInfo', iolist_to_binary(Data), DecryptParams}. - + {'PrivateKeyInfo', Data, DecryptParams}. encode_encrypted_private_keyinfo(EncData, EncryptParmams) -> AlgorithmInfo = pubkey_pbe:encrypt_parameters(EncryptParmams), diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index a0a87e5351..261054637d 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -114,13 +114,13 @@ pem_encode(PemEntries) when is_list(PemEntries) -> iolist_to_binary(pubkey_pem:encode(PemEntries)). %%-------------------------------------------------------------------- --spec pem_entry_decode(pem_entry(), [string()]) -> term(). +-spec pem_entry_decode(pem_entry(), string()) -> term(). % %% Description: Decodes a pem entry. pem_decode/1 returns a list of %% pem entries. %%-------------------------------------------------------------------- pem_entry_decode({'SubjectPublicKeyInfo', Der, _}) -> - {_, {'AlgorithmIdentifier', AlgId, Params}, {0, Key0}} + {_, {'AlgorithmIdentifier', AlgId, Params}, Key0} = der_decode('SubjectPublicKeyInfo', Der), KeyType = pubkey_cert_records:supportedPublicKeyAlgorithms(AlgId), case KeyType of @@ -146,14 +146,16 @@ pem_entry_decode({Asn1Type, CryptDer, {Cipher, #'PBES2-params'{}}} = PemEntry, pem_entry_decode({Asn1Type, CryptDer, {Cipher, {#'PBEParameter'{},_}}} = PemEntry, Password) when is_atom(Asn1Type) andalso is_binary(CryptDer) andalso - is_list(Cipher) -> + is_list(Cipher) andalso + is_list(Password) -> do_pem_entry_decode(PemEntry, Password); pem_entry_decode({Asn1Type, CryptDer, {Cipher, Salt}} = PemEntry, Password) when is_atom(Asn1Type) andalso is_binary(CryptDer) andalso is_list(Cipher) andalso is_binary(Salt) andalso - ((erlang:byte_size(Salt) == 8) or (erlang:byte_size(Salt) == 16)) -> + ((erlang:byte_size(Salt) == 8) or (erlang:byte_size(Salt) == 16)) andalso + is_list(Password) -> do_pem_entry_decode(PemEntry, Password). @@ -166,14 +168,14 @@ pem_entry_decode({Asn1Type, CryptDer, {Cipher, Salt}} = PemEntry, pem_entry_encode('SubjectPublicKeyInfo', Entity=#'RSAPublicKey'{}) -> Der = der_encode('RSAPublicKey', Entity), Spki = {'SubjectPublicKeyInfo', - {'AlgorithmIdentifier', ?'rsaEncryption', ?DER_NULL}, {0, Der}}, + {'AlgorithmIdentifier', ?'rsaEncryption', ?DER_NULL}, Der}, pem_entry_encode('SubjectPublicKeyInfo', Spki); pem_entry_encode('SubjectPublicKeyInfo', {DsaInt, Params=#'Dss-Parms'{}}) when is_integer(DsaInt) -> KeyDer = der_encode('DSAPublicKey', DsaInt), ParamDer = der_encode('DSAParams', {params, Params}), Spki = {'SubjectPublicKeyInfo', - {'AlgorithmIdentifier', ?'id-dsa', ParamDer}, {0, KeyDer}}, + {'AlgorithmIdentifier', ?'id-dsa', ParamDer}, KeyDer}, pem_entry_encode('SubjectPublicKeyInfo', Spki); pem_entry_encode(Asn1Type, Entity) when is_atom(Asn1Type) -> Der = der_encode(Asn1Type, Entity), @@ -232,7 +234,7 @@ der_encode(Asn1Type, Entity) when (Asn1Type == 'PrivateKeyInfo') or (Asn1Type == 'EncryptedPrivateKeyInfo') -> try {ok, Encoded} = 'PKCS-FRAME':encode(Asn1Type, Entity), - iolist_to_binary(Encoded) + Encoded catch error:{badmatch, {error, _}} = Error -> erlang:error(Error) @@ -241,7 +243,7 @@ der_encode(Asn1Type, Entity) when (Asn1Type == 'PrivateKeyInfo') or der_encode(Asn1Type, Entity) when is_atom(Asn1Type) -> try {ok, Encoded} = 'OTP-PUB-KEY':encode(Asn1Type, Entity), - iolist_to_binary(Encoded) + Encoded catch error:{badmatch, {error, _}} = Error -> erlang:error(Error) @@ -389,7 +391,7 @@ generate_key(#'ECParameters'{} = Params) -> compute_key(#'ECPoint'{point = Point}, #'ECPrivateKey'{privateKey = PrivKey, parameters = Param}) -> ECCurve = ec_curve_spec(Param), - crypto:compute_key(ecdh, Point, list_to_binary(PrivKey), ECCurve). + crypto:compute_key(ecdh, Point, PrivKey, ECCurve). compute_key(PubKey, PrivKey, #'DHParameter'{prime = P, base = G}) -> crypto:compute_key(dh, PubKey, PrivKey, [P, G]). @@ -444,7 +446,7 @@ sign(DigestOrPlainText, sha, #'DSAPrivateKey'{p = P, q = Q, g = G, x = X}) -> sign(DigestOrPlainText, DigestType, #'ECPrivateKey'{privateKey = PrivKey, parameters = Param}) -> ECCurve = ec_curve_spec(Param), - crypto:sign(ecdsa, DigestType, DigestOrPlainText, [list_to_binary(PrivKey), ECCurve]); + crypto:sign(ecdsa, DigestType, DigestOrPlainText, [PrivKey, ECCurve]); %% Backwards compatible sign(Digest, none, #'DSAPrivateKey'{} = Key) -> @@ -456,22 +458,12 @@ sign(Digest, none, #'DSAPrivateKey'{} = Key) -> | dsa_public_key() | ec_public_key()) -> boolean(). %% Description: Verifies a digital signature. %%-------------------------------------------------------------------- -verify(DigestOrPlainText, DigestType, Signature, - #'RSAPublicKey'{modulus = Mod, publicExponent = Exp}) -> - crypto:verify(rsa, DigestType, DigestOrPlainText, Signature, - [Exp, Mod]); - -verify(DigestOrPlaintext, DigestType, Signature, {#'ECPoint'{point = Point}, Param}) -> - ECCurve = ec_curve_spec(Param), - crypto:verify(ecdsa, DigestType, DigestOrPlaintext, Signature, [Point, ECCurve]); - -%% Backwards compatibility -verify(Digest, none, Signature, {_, #'Dss-Parms'{}} = Key ) -> - verify({digest,Digest}, sha, Signature, Key); - -verify(DigestOrPlainText, sha = DigestType, Signature, {Key, #'Dss-Parms'{p = P, q = Q, g = G}}) - when is_integer(Key), is_binary(Signature) -> - crypto:verify(dss, DigestType, DigestOrPlainText, Signature, [P, Q, G, Key]). +verify(DigestOrPlainText, DigestType, Signature, Key) when is_binary(Signature) -> + do_verify(DigestOrPlainText, DigestType, Signature, Key); +verify(_,_,_,_) -> + %% If Signature is a bitstring and not a binary we know already at this + %% point that the signature is invalid. + false. %%-------------------------------------------------------------------- -spec pkix_dist_point(der_encoded() | #'OTPCertificate'{}) -> @@ -528,7 +520,7 @@ pkix_sign(#'OTPTBSCertificate'{signature = Signature = sign(Msg, DigestType, Key), Cert = #'OTPCertificate'{tbsCertificate= TBSCert, signatureAlgorithm = SigAlg, - signature = {0, Signature} + signature = Signature }, pkix_encode('OTPCertificate', Cert, otp). @@ -626,8 +618,12 @@ pkix_is_fixed_dh_cert(Cert) when is_binary(Cert) -> % %% Description: Returns the issuer id. %%-------------------------------------------------------------------- -pkix_issuer_id(Cert, Signed)-> - pkix_issuer_id(Cert, Signed, decode). +pkix_issuer_id(#'OTPCertificate'{} = OtpCert, Signed) when (Signed == self) or + (Signed == other) -> + pubkey_cert:issuer_id(OtpCert, Signed); +pkix_issuer_id(Cert, Signed) when is_binary(Cert) -> + OtpCert = pkix_decode_cert(Cert, otp), + pkix_issuer_id(OtpCert, Signed). %%-------------------------------------------------------------------- -spec pkix_crl_issuer(CRL::binary()| #'CertificateList'{}) -> @@ -747,6 +743,23 @@ ssh_encode(Entries, Type) when is_list(Entries), %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- +do_verify(DigestOrPlainText, DigestType, Signature, + #'RSAPublicKey'{modulus = Mod, publicExponent = Exp}) -> + crypto:verify(rsa, DigestType, DigestOrPlainText, Signature, + [Exp, Mod]); + +do_verify(DigestOrPlaintext, DigestType, Signature, {#'ECPoint'{point = Point}, Param}) -> + ECCurve = ec_curve_spec(Param), + crypto:verify(ecdsa, DigestType, DigestOrPlaintext, Signature, [Point, ECCurve]); + +%% Backwards compatibility +do_verify(Digest, none, Signature, {_, #'Dss-Parms'{}} = Key ) -> + verify({digest,Digest}, sha, Signature, Key); + +do_verify(DigestOrPlainText, sha = DigestType, Signature, {Key, #'Dss-Parms'{p = P, q = Q, g = G}}) + when is_integer(Key), is_binary(Signature) -> + crypto:verify(dss, DigestType, DigestOrPlainText, Signature, [P, Q, G, Key]). + do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password) -> Der = der_encode(Asn1Type, Entity), DecryptDer = pubkey_pem:cipher(Der, CipherInfo, Password), @@ -979,28 +992,14 @@ ec_generate_key(Params) -> ec_curve_spec( #'ECParameters'{fieldID = FieldId, curve = PCurve, base = Base, order = Order, cofactor = CoFactor }) -> Field = {pubkey_cert_records:supportedCurvesTypes(FieldId#'FieldID'.fieldType), FieldId#'FieldID'.parameters}, - Curve = {erlang:list_to_binary(PCurve#'Curve'.a), erlang:list_to_binary(PCurve#'Curve'.b), none}, - {Field, Curve, erlang:list_to_binary(Base), Order, CoFactor}; + Curve = {PCurve#'Curve'.a, PCurve#'Curve'.b, none}, + {Field, Curve, Base, Order, CoFactor}; ec_curve_spec({namedCurve, OID}) -> pubkey_cert_records:namedCurves(OID). ec_key({PubKey, PrivateKey}, Params) -> #'ECPrivateKey'{version = 1, - privateKey = binary_to_list(PrivateKey), + privateKey = PrivateKey, parameters = Params, - publicKey = {0, PubKey}}. + publicKey = PubKey}. -pkix_issuer_id(#'OTPCertificate'{} = OtpCert, Signed, decode) when (Signed == self) or - (Signed == other) -> - pubkey_cert:issuer_id(OtpCert, Signed); -pkix_issuer_id(#'OTPCertificate'{} = OtpCert, Signed, encode) when (Signed == self) or - (Signed == other) -> - case pubkey_cert:issuer_id(OtpCert, Signed) of - {ok, {Serial, Issuer}} -> - {ok, {Serial, pubkey_cert_records:transform(Issuer, encode)}}; - Error -> - Error - end; -pkix_issuer_id(Cert, Signed, Decode) when is_binary(Cert) -> - OtpCert = pkix_decode_cert(Cert, otp), - pkix_issuer_id(OtpCert, Signed, Decode). diff --git a/lib/public_key/test/erl_make_certs.erl b/lib/public_key/test/erl_make_certs.erl index b8e0494ce7..668924c03e 100644 --- a/lib/public_key/test/erl_make_certs.erl +++ b/lib/public_key/test/erl_make_certs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -114,7 +114,7 @@ verify_signature(DerEncodedCert, DerKey, _KeyParams) -> #'DSAPrivateKey'{p=P, q=Q, g=G, y=Y} -> public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}}); #'ECPrivateKey'{version = _Version, privateKey = _PrivKey, - parameters = Params, publicKey = {0, PubKey}} -> + parameters = Params, publicKey = PubKey} -> public_key:pkix_verify(DerEncodedCert, {#'ECPoint'{point = PubKey}, Params}) end. @@ -259,9 +259,8 @@ default_extensions(Exts) -> Filter = fun({Key, _}, D) -> lists:keydelete(Key, 1, D) end, Exts ++ lists:foldl(Filter, Def, Exts). - - extension({_, undefined}) -> []; + extension({basic_constraints, Data}) -> case Data of default -> @@ -278,9 +277,11 @@ extension({basic_constraints, Data}) -> #'Extension'{extnID = ?'id-ce-basicConstraints', extnValue = Data} end; + extension({key_usage, default}) -> #'Extension'{extnID = ?'id-ce-keyUsage', extnValue = [keyCertSign], critical = true}; + extension({Id, Data, Critical}) -> #'Extension'{extnID = Id, extnValue = Data, critical = Critical}. @@ -297,7 +298,7 @@ publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) -> publickey(#'ECPrivateKey'{version = _Version, privateKey = _PrivKey, parameters = Params, - publicKey = {0, PubKey}}) -> + publicKey = PubKey}) -> Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-ecPublicKey', parameters=Params}, #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = #'ECPoint'{point = PubKey}}. @@ -322,14 +323,14 @@ sign_algorithm(#'RSAPrivateKey'{}, Opts) -> {Type, 'NULL'}; sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) -> {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}; -sign_algorithm(#'ECPrivateKey'{}, Opts) -> +sign_algorithm(#'ECPrivateKey'{parameters = Parms}, Opts) -> Type = case proplists:get_value(digest, Opts, sha1) of sha1 -> ?'ecdsa-with-SHA1'; sha512 -> ?'ecdsa-with-SHA512'; sha384 -> ?'ecdsa-with-SHA384'; sha256 -> ?'ecdsa-with-SHA256' end, - {Type, 'NULL'}. + {Type, Parms}. make_key(rsa, _Opts) -> %% (OBS: for testing only) @@ -406,9 +407,9 @@ gen_ec2(CurveId) -> {PubKey, PrivKey} = crypto:generate_key(ecdh, CurveId), #'ECPrivateKey'{version = 1, - privateKey = binary_to_list(PrivKey), + privateKey = PrivKey, parameters = {namedCurve, pubkey_cert_records:namedCurves(CurveId)}, - publicKey = {0, PubKey}}. + publicKey = PubKey}. %% See fips_186-3.pdf dsa_search(T, P0, Q, Iter) when Iter > 0 -> @@ -477,5 +478,3 @@ der_to_pem(File, Entries) -> PemBin = public_key:pem_encode(Entries), file:write_file(File, PemBin). - - diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index 2fa2d725c3..7f752529f0 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 0.22.1 +PUBLIC_KEY_VSN = 1.0 diff --git a/lib/reltool/src/reltool.app.src b/lib/reltool/src/reltool.app.src index 65fcf4aae5..579d2c0d1b 100644 --- a/lib/reltool/src/reltool.app.src +++ b/lib/reltool/src/reltool.app.src @@ -36,5 +36,5 @@ {applications, [stdlib, kernel]}, {env, []}, {runtime_dependencies, ["wx-1.2","tools-2.6.14","stdlib-2.0","sasl-2.4", - "kernel-3.0","erts-6.0"]} + "kernel-3.0","erts-7.0"]} ]}. diff --git a/lib/reltool/src/reltool_fgraph_win.erl b/lib/reltool/src/reltool_fgraph_win.erl index 66bc2b5ab3..d9e6f6d427 100644 --- a/lib/reltool/src/reltool_fgraph_win.erl +++ b/lib/reltool/src/reltool_fgraph_win.erl @@ -252,10 +252,10 @@ ticker_init(Pid) -> ticker_loop(Pid, Time) -> receive after Time -> Pid ! {self(), redraw}, - T0 = now(), + T0 = erlang:monotonic_time(), receive {Pid, ok} -> ok end, - T1 = now(), - D = timer:now_diff(T1, T0)/1000, + T1 = erlang:monotonic_time(), + D = erlang:convert_time_unit(T1-T0, native, milli_seconds), case round(40 - D) of Ms when Ms < 0 -> %io:format("ticker: wait is 0 ms [fg ~7s ms] [fps ~7s]~n", diff --git a/lib/runtime_tools/doc/src/notes.xml b/lib/runtime_tools/doc/src/notes.xml index 2877355718..1612c62c98 100644 --- a/lib/runtime_tools/doc/src/notes.xml +++ b/lib/runtime_tools/doc/src/notes.xml @@ -31,6 +31,22 @@ <p>This document describes the changes made to the Runtime_Tools application.</p> +<section><title>Runtime_Tools 1.8.16</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The trace process started by <c>dbg</c> would not always + terminate when <c>dbg:stop/0</c> was called.</p> + <p> + Own Id: OTP-12517</p> + </item> + </list> + </section> + +</section> + <section><title>Runtime_Tools 1.8.15</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index fea0854042..fe814ceda4 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -248,7 +248,7 @@ etop_collect(Collector) -> SchedulerWallTime = erlang:statistics(scheduler_wall_time), ProcInfo = etop_collect(processes(), []), - Collector ! {self(),#etop_info{now = now(), + Collector ! {self(),#etop_info{now = erlang:timestamp(), n_procs = length(ProcInfo), run_queue = erlang:statistics(run_queue), runtime = SchedulerWallTime, diff --git a/lib/runtime_tools/src/percept_profile.erl b/lib/runtime_tools/src/percept_profile.erl index cdc7a0fca1..dfadb21aa8 100644 --- a/lib/runtime_tools/src/percept_profile.erl +++ b/lib/runtime_tools/src/percept_profile.erl @@ -119,7 +119,7 @@ stop() -> undefined -> {error, not_started}; Port -> - erlang:port_command(Port, erlang:term_to_binary({profile_stop, erlang:now()})), + erlang:port_command(Port, erlang:term_to_binary({profile_stop, erlang:timestamp()})), %% trace delivered? erlang:port_close(Port), ok @@ -139,7 +139,7 @@ profile_to_file(Filename, Opts) -> erlang:system_flag(multi_scheduling, block), Port = (dbg:trace_port(file, Filename))(), % Send start time - erlang:port_command(Port, erlang:term_to_binary({profile_start, erlang:now()})), + erlang:port_command(Port, erlang:term_to_binary({profile_start, erlang:timestamp()})), erlang:system_flag(multi_scheduling, unblock), %% Register Port diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index 0a70802c08..32ea9e564b 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -27,6 +27,6 @@ {env, []}, {mod, {runtime_tools, []}}, {runtime_dependencies, ["stdlib-2.0","mnesia-4.12","kernel-3.0", - "erts-6.0"]}]}. + "erts-7.0"]}]}. diff --git a/lib/runtime_tools/vsn.mk b/lib/runtime_tools/vsn.mk index c1df23d2a2..e9f43df1aa 100644 --- a/lib/runtime_tools/vsn.mk +++ b/lib/runtime_tools/vsn.mk @@ -1 +1 @@ -RUNTIME_TOOLS_VSN = 1.8.15 +RUNTIME_TOOLS_VSN = 1.8.16 diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index fd307ef824..52022f59ff 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -33,7 +33,40 @@ </header> - <section> + <section><title>SNMP 5.1.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A bug in the SNMP Agent has been corrected; when opening + a port using the command line argument -snmpa_fd the Port + should be 0 when calling gen_udp:open.</p> + <p> + A bug in the SNMP manager has been corrected; it should + not look at the -snmp_fd command line argument, but + instead at -snmpm_fd.</p> + <p> + Own Id: OTP-12669 Aux Id: seq12841 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Improved cryptocraphic capability.</p> + <p> + Own Id: OTP-12452</p> + </item> + </list> + </section> + +</section> + +<section> <title>SNMP Development Toolkit 5.1.1</title> <p>Version 5.1.1 supports code replacement in runtime from/to version 5.1. </p> diff --git a/lib/snmp/src/agent/snmp_shadow_table.erl b/lib/snmp/src/agent/snmp_shadow_table.erl index 34543d542b..c4704e201b 100644 --- a/lib/snmp/src/agent/snmp_shadow_table.erl +++ b/lib/snmp/src/agent/snmp_shadow_table.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -76,7 +76,7 @@ delete_time_stamp_table() -> end. update(Name, UpdateFunc, Interval) -> - CurrentTime = get_time(), + CurrentTime = snmp_misc:now(ms), case mnesia:dirty_read({time_stamp, Name}) of [#time_stamp{data = Expire}] when CurrentTime =< Expire -> ok; _ -> @@ -117,9 +117,6 @@ table_func(Op, RowIndex, Cols, update(Name, UpdateFunc, Interval), snmp_generic:table_func(Op, RowIndex, Cols, {Name, mnesia}). -get_time() -> - {M,S,U} = erlang:now(), - 1000000000 * M + 1000 * S + (U div 1000). %%----------------------------------------------------------------- %% Urrk. @@ -183,5 +180,3 @@ delete_table(Tab) -> error_msg(F, A) -> ?snmpa_error(F, A). - - diff --git a/lib/snmp/src/agent/snmp_standard_mib.erl b/lib/snmp/src/agent/snmp_standard_mib.erl index aace3fd413..53f733ae4e 100644 --- a/lib/snmp/src/agent/snmp_standard_mib.erl +++ b/lib/snmp/src/agent/snmp_standard_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -546,8 +546,9 @@ dummy(_Op) -> ok. %%----------------------------------------------------------------- snmp_set_serial_no(new) -> snmp_generic:variable_func(new, {snmpSetSerialNo, volatile}), - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), Val = random:uniform(2147483648) - 1, snmp_generic:variable_func(set, Val, {snmpSetSerialNo, volatile}); diff --git a/lib/snmp/src/agent/snmp_target_mib.erl b/lib/snmp/src/agent/snmp_target_mib.erl index ef9503cda8..f66c54849f 100644 --- a/lib/snmp/src/agent/snmp_target_mib.erl +++ b/lib/snmp/src/agent/snmp_target_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -346,13 +346,6 @@ check_target_params(X) -> error({invalid_target_params, X}). - -%% maybe_create_table(Name) -> -%% case snmpa_local_db:table_exists(db(Name)) of -%% true -> ok; -%% _ -> snmpa_local_db:table_create(db(Name)) -%% end. - init_tabs(Addrs, Params) -> ?vdebug("create target address table",[]), AddrDB = db(snmpTargetAddrTable), @@ -679,8 +672,9 @@ snmpTargetSpinLock(print) -> snmpTargetSpinLock(new) -> snmp_generic:variable_func(new, {snmpTargetSpinLock, volatile}), - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), Val = random:uniform(2147483648) - 1, snmp_generic:variable_func(set, Val, {snmpTargetSpinLock, volatile}); @@ -1080,5 +1074,3 @@ error(Reason) -> config_err(F, A) -> snmpa_error:config_err("[TARGET-MIB]: " ++ F, A). - - diff --git a/lib/snmp/src/agent/snmp_user_based_sm_mib.erl b/lib/snmp/src/agent/snmp_user_based_sm_mib.erl index 69dce337ba..ce6dc21435 100644 --- a/lib/snmp/src/agent/snmp_user_based_sm_mib.erl +++ b/lib/snmp/src/agent/snmp_user_based_sm_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -439,8 +439,9 @@ usmUserSpinLock(print) -> usmUserSpinLock(new) -> snmp_generic:variable_func(new, {usmUserSpinLock, volatile}), - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), Val = random:uniform(2147483648) - 1, snmp_generic:variable_func(set, Val, {usmUserSpinLock, volatile}); @@ -1191,29 +1192,7 @@ extract_new_key(Hash, OldKey, KeyChange) -> -define(i8(Int), Int band 255). mk_random(Len) when Len =< 20 -> - %% Use of yield(): - %% This will either schedule another process, or fail and invoke - %% the error_handler (in old versions). In either case, it is - %% safe to assume that now, reductions and garbage_collection have - %% changed in a non-deterministically way. - {_,_,A} = erlang:now(), - catch erlang:yield(), - {_,_,B} = erlang:now(), - catch erlang:yield(), - {_,_,C} = erlang:now(), - {D,_} = erlang:statistics(reductions), - {E,_} = erlang:statistics(runtime), - {F,_} = erlang:statistics(wall_clock), - {G,H,_} = erlang:statistics(garbage_collection), - catch erlang:yield(), - {_,_,C2} = erlang:now(), - {D2,_} = erlang:statistics(reductions), - {_,H2,_} = erlang:statistics(garbage_collection), - %% X(N) means we can use N bits from variable X: - %% A(16) B(16) C(16) D(16) E(8) F(16) G(8) H(16) - Rnd20 = [?i16(A),?i16(B),?i16(C),?i16(D),?i8(E),?i16(F), - ?i8(G),?i16(H),?i16(C2),?i16(D2),?i16(H2)], - lists:sublist(Rnd20, Len). + binary_to_list(crypto:strong_rand_bytes(Len)). split(0, Rest, FirstRev) -> {lists:reverse(FirstRev), Rest}; diff --git a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl index 722bd7ac5b..28e2bdbb96 100644 --- a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl +++ b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -845,8 +845,9 @@ vacmViewSpinLock(print) -> vacmViewSpinLock(new) -> snmp_generic:variable_func(new, volatile_db(vacmViewSpinLock)), - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), Val = random:uniform(2147483648) - 1, snmp_generic:variable_func(set, Val, volatile_db(vacmViewSpinLock)); @@ -1133,4 +1134,3 @@ error(Reason) -> config_err(F, A) -> snmpa_error:config_err("[VIEW-BASED-ACM-MIB]: " ++ F, A). - diff --git a/lib/snmp/src/agent/snmpa_mpd.erl b/lib/snmp/src/agent/snmpa_mpd.erl index 642b1f7fc5..24007a4e63 100644 --- a/lib/snmp/src/agent/snmpa_mpd.erl +++ b/lib/snmp/src/agent/snmpa_mpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -75,8 +75,9 @@ init(Vsns) -> ?vlog("init -> entry with" "~n Vsns: ~p", [Vsns]), - {A,B,C} = erlang:now(), - random:seed(A,B,C), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), ets:insert(snmp_agent_table, {msg_id, random:uniform(2147483647)}), ets:insert(snmp_agent_table, {req_id, random:uniform(2147483647)}), init_counters(), @@ -771,21 +772,7 @@ generate_v3_report_msg(MsgID, MsgSecurityModel, Data, LocalEngineID, ContextEngineID, ContextName, SecData}, LocalEngineID, Log). -%% req_id(#scopedPdu{data = #pdu{request_id = ReqId}}) -> -%% ?vtrace("Report ReqId: ~p",[ReqId]), -%% ReqId; -%% req_id(_) -> -%% 0. % RFC2572, 7.1.3.c.4 - -%% maybe_generate_discovery1_report_msg() -> -%% case (catch DiscoveryHandler:handle_discovery1(Ip, Udp, EngineId)) of -%% {ok, Entry} when is_record(Entry, snmp_discovery_data1) -> -%% ok; -%% ignore -> -%% ok; -%% {error, Reason} -> - %% Response to stage 1 discovery message (terminating, i.e. from the manager) generate_discovery1_report_msg(MsgID, MsgSecurityModel, SecName, SecLevel, diff --git a/lib/snmp/src/agent/snmpa_net_if.erl b/lib/snmp/src/agent/snmpa_net_if.erl index 840d56d563..c813c57d56 100644 --- a/lib/snmp/src/agent/snmpa_net_if.erl +++ b/lib/snmp/src/agent/snmpa_net_if.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -297,14 +297,14 @@ socket_open(snmpUDPDomain = Domain, [IpPort | Opts]) -> Fd = list_to_integer(FdStr), ?vdebug("socket_open(~p, [~p | ~p]) Fd: ~p", [Domain, IpPort, Opts, Fd]), - gen_udp_open(IpPort, [{fd, Fd} | Opts]); + gen_udp_open(0, [{fd, Fd} | Opts]); error -> case init:get_argument(snmpa_fd) of {ok, [[FdStr]]} -> Fd = list_to_integer(FdStr), ?vdebug("socket_open(~p, [~p | ~p]) Fd: ~p", [Domain, IpPort, Opts, Fd]), - gen_udp_open(IpPort, [{fd, Fd} | Opts]); + gen_udp_open(0, [{fd, Fd} | Opts]); error -> ?vdebug("socket_open(~p, [~p | ~p])", [Domain, IpPort, Opts]), @@ -674,7 +674,7 @@ handle_recv( #state{mpd_state = MpdState, note_store = NS, log = Log} = S, #transport{socket = Socket} = Transport, From, Packet) -> - put(n1, erlang:now()), + put(n1, erlang:monotonic_time(micro_seconds)), LogF = fun(Type, Data) -> log(Log, Type, Data, From) @@ -1379,15 +1379,7 @@ do_close_log(_) -> %%% DEBUG FUNCTIONS %%%----------------------------------------------------------------- time_in_agent() -> - subtr(erlang:now(), get(n1)). - -subtr({X1,Y1,Z1}, {X1,Y1,Z2}) -> - Z1 - Z2; -subtr({X1,Y1,Z1}, {X1,Y2,Z2}) -> - ((Y1-Y2) * 1000000) + (Z1 - Z2); -subtr({X1,Y1,Z1}, {X2,Y2,Z2}) -> - ((X1 - X2) * 1000000000000) + ((Y1 - Y2) * 1000000) + (Z1 - Z2). - + erlang:monotonic_time(micro_seconds) - get(n1). %% ---------------------------------------------------------------- @@ -1637,10 +1629,3 @@ get_port_info(Id) -> %% ---------------------------------------------------------------- - -% i(F) -> -% i(F, []). - -% i(F, A) -> -% io:format("~p: " ++ F ++ "~n", [?MODULE|A]). - diff --git a/lib/snmp/src/agent/snmpa_usm.erl b/lib/snmp/src/agent/snmpa_usm.erl index 719ea4e356..c571e50517 100644 --- a/lib/snmp/src/agent/snmpa_usm.erl +++ b/lib/snmp/src/agent/snmpa_usm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -645,8 +645,9 @@ get_des_salt() -> ets:insert(snmp_agent_table, {usm_des_salt, 0}), 0; _ -> % it doesn't exist, initialize - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), R = random:uniform(4294967295), ets:insert(snmp_agent_table, {usm_des_salt, R}), R @@ -677,8 +678,9 @@ get_aes_salt() -> ets:insert(snmp_agent_table, {usm_aes_salt, 0}), 0; _ -> % it doesn't exist, initialize - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), R = random:uniform(36893488147419103231), ets:insert(snmp_agent_table, {usm_aes_salt, R}), R diff --git a/lib/snmp/src/agent/snmpa_vacm.erl b/lib/snmp/src/agent/snmpa_vacm.erl index dadcf32543..281b2bd34a 100644 --- a/lib/snmp/src/agent/snmpa_vacm.erl +++ b/lib/snmp/src/agent/snmpa_vacm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -305,8 +305,8 @@ dump_table() -> %% time dumping the table. unique_table_name(Pre) -> %% We want something that is guaranteed to be unique, - %% therefor we use erlang:now() instead of os:timestamp() - unique_table_name(Pre, erlang:now()). + %% therefor we use erlang:timestamp() instead of os:timestamp() + unique_table_name(Pre, erlang:timestamp()). unique_table_name(Pre, {_A, _B, C} = Now) -> {Date, Time} = calendar:now_to_datetime(Now), @@ -445,6 +445,3 @@ gc_tab(Oid) -> user_err(F, A) -> snmpa_error:user_err(F, A). - -% config_err(F, A) -> -% snmpa_error:config_err(F, A). diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index e7e54f5b7e..081163b368 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -28,6 +28,7 @@ %% {update, snmpa_local_db, soft, soft_purge, soft_purge, []} %% {add_module, snmpm_net_if_mt} [ + {"5.1.1", [{restart_application, snmp}]}, {"5.1", [ % Only compiler changes ]}, {"5.0", [{restart_application, snmp}]}, @@ -46,6 +47,7 @@ %% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}} [ + {"5.1.1", [{restart_application, snmp}]}, {"5.1", [ % Only compiler changes ]}, {"5.0", [{restart_application, snmp}]}, diff --git a/lib/snmp/src/compile/snmpc.erl b/lib/snmp/src/compile/snmpc.erl index 2f065dddac..e7839c0792 100644 --- a/lib/snmp/src/compile/snmpc.erl +++ b/lib/snmp/src/compile/snmpc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -409,8 +409,9 @@ get_verbosity(Options) -> %%---------------------------------------------------------------------- init(From, MibFileName, Options) -> - {A,B,C} = now(), - random:seed(A,B,C), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), put(options, Options), put(verbosity, get_verbosity(Options)), put(description, get_description(Options)), diff --git a/lib/snmp/src/manager/snmpm_mpd.erl b/lib/snmp/src/manager/snmpm_mpd.erl index f8a7441c0a..5fc9d3655c 100644 --- a/lib/snmp/src/manager/snmpm_mpd.erl +++ b/lib/snmp/src/manager/snmpm_mpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -67,8 +67,9 @@ %%%----------------------------------------------------------------- init(Vsns) -> ?vdebug("init -> entry with ~p", [Vsns]), - {A,B,C} = erlang:now(), - random:seed(A,B,C), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), snmpm_config:cre_counter(msg_id, random:uniform(2147483647)), snmpm_config:cre_counter(req_id, random:uniform(2147483647)), init_counters(), @@ -896,17 +897,6 @@ get_agent_engine_id(Name) -> is_known_engine_id(EngineID, {Addr, Port}) -> snmpm_config:is_known_engine_id(EngineID, Addr, Port). -%% is_known_engine_id(EngineID, Addr, Port) -> -%% snmpm_config:is_known_engine_id(EngineID, Addr, Port). - -% get_agent_engine_id(Addr, Port) -> -% case snmpm_config:get_agent_engine_id(Addr, Port) of -% {ok, Id} -> -% Id; -% _Error -> -% "" -% end. - %%----------------------------------------------------------------- %% Sequence number (msg-id & req-id) functions diff --git a/lib/snmp/src/manager/snmpm_net_if.erl b/lib/snmp/src/manager/snmpm_net_if.erl index b4cc165d2e..e81383eeea 100644 --- a/lib/snmp/src/manager/snmpm_net_if.erl +++ b/lib/snmp/src/manager/snmpm_net_if.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -330,7 +330,7 @@ socket_params(Domain, {IpAddr, IpPort} = Addr, BindTo, CommonSocketOpts) -> end, case Family of inet -> - case init:get_argument(snmp_fd) of + case init:get_argument(snmpm_fd) of {ok, [[FdStr]]} -> Fd = list_to_integer(FdStr), case BindTo of @@ -489,11 +489,6 @@ handle_call({verbosity, Verbosity}, _From, State) -> put(verbosity, Verbosity), {reply, ok, State}; -%% handle_call({system_info_updated, What}, _From, State) -> -%% ?vlog("received system_info_updated request with What = ~p", [What]), -%% {NewState, Reply} = handle_system_info_updated(State, What), -%% {reply, Reply, NewState}; - handle_call(get_log_type, _From, State) -> ?vlog("received get-log-type request", []), Reply = (catch handle_get_log_type(State)), @@ -816,7 +811,7 @@ handle_inform_request( ok; [] -> RePdu = make_response_pdu(Pdu), - Expire = t() + To, + Expire = snmp_misc:now(ms) + To, Rec = {Key, Expire, {Vsn, ACM, RePdu}}, ets:insert(snmpm_inform_request_table, Rec) end. @@ -876,7 +871,7 @@ maybe_send_inform_response( handle_inform_response_gc(#state{irb = IRB} = State) -> ets:safe_fixtable(snmpm_inform_request_table, true), - do_irgc(ets:first(snmpm_inform_request_table), t()), + do_irgc(ets:first(snmpm_inform_request_table), snmp_misc:now(ms)), ets:safe_fixtable(snmpm_inform_request_table, false), State#state{irgc = irgc_start(IRB)}. @@ -1023,110 +1018,6 @@ handle_disk_log(_Log, _Info, State) -> State. -%% mk_discovery_msg('version-3', Pdu, _VsnHdr, UserName) -> -%% ScopedPDU = #scopedPdu{contextEngineID = "", -%% contextName = "", -%% data = Pdu}, -%% Bytes = snmp_pdus:enc_scoped_pdu(ScopedPDU), -%% MsgID = get(msg_id), -%% put(msg_id,MsgID+1), -%% UsmSecParams = -%% #usmSecurityParameters{msgAuthoritativeEngineID = "", -%% msgAuthoritativeEngineBoots = 0, -%% msgAuthoritativeEngineTime = 0, -%% msgUserName = UserName, -%% msgPrivacyParameters = "", -%% msgAuthenticationParameters = ""}, -%% SecBytes = snmp_pdus:enc_usm_security_parameters(UsmSecParams), -%% PduType = Pdu#pdu.type, -%% Hdr = #v3_hdr{msgID = MsgID, -%% msgMaxSize = 1000, -%% msgFlags = snmp_misc:mk_msg_flags(PduType, 0), -%% msgSecurityModel = ?SEC_USM, -%% msgSecurityParameters = SecBytes}, -%% Msg = #message{version = 'version-3', vsn_hdr = Hdr, data = Bytes}, -%% case (catch snmp_pdus:enc_message_only(Msg)) of -%% {'EXIT', Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% L when list(L) -> -%% {Msg, L} -%% end; -%% mk_discovery_msg(Version, Pdu, {Com, _, _, _, _}, UserName) -> -%% Msg = #message{version = Version, vsn_hdr = Com, data = Pdu}, -%% case catch snmp_pdus:enc_message(Msg) of -%% {'EXIT', Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% L when list(L) -> -%% {Msg, L} -%% end. - - -%% mk_msg('version-3', Pdu, {Context, User, EngineID, CtxEngineId, SecLevel}, -%% MsgData) -> -%% %% Code copied from snmp_mpd.erl -%% {MsgId, SecName, SecData} = -%% if -%% tuple(MsgData), Pdu#pdu.type == 'get-response' -> -%% MsgData; -%% true -> -%% Md = get(msg_id), -%% put(msg_id, Md + 1), -%% {Md, User, []} -%% end, -%% ScopedPDU = #scopedPdu{contextEngineID = CtxEngineId, -%% contextName = Context, -%% data = Pdu}, -%% ScopedPDUBytes = snmp_pdus:enc_scoped_pdu(ScopedPDU), - -%% PduType = Pdu#pdu.type, -%% V3Hdr = #v3_hdr{msgID = MsgId, -%% msgMaxSize = 1000, -%% msgFlags = snmp_misc:mk_msg_flags(PduType, SecLevel), -%% msgSecurityModel = ?SEC_USM}, -%% Message = #message{version = 'version-3', vsn_hdr = V3Hdr, -%% data = ScopedPDUBytes}, -%% SecEngineID = case PduType of -%% 'get-response' -> snmp_framework_mib:get_engine_id(); -%% _ -> EngineID -%% end, -%% case catch snmp_usm:generate_outgoing_msg(Message, SecEngineID, -%% SecName, SecData, SecLevel) of -%% {'EXIT', Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% {error, Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% Packet -> -%% Packet -%% end; -%% mk_msg(Version, Pdu, {Com, _User, _EngineID, _Ctx, _SecLevel}, _SecData) -> -%% Msg = #message{version = Version, vsn_hdr = Com, data = Pdu}, -%% case catch snmp_pdus:enc_message(Msg) of -%% {'EXIT', Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% B when list(B) -> -%% B -%% end. - - -%% handle_system_info_updated(#state{log = {Log, _OldType}} = State, -%% audit_trail_log_type = _What) -> -%% %% Just to make sure, check that ATL is actually enabled -%% case snmpm_config:system_info(audit_trail_log) of -%% {ok, true} -> -%% {ok, Type} = snmpm_config:system_info(audit_trail_log_type), -%% NewState = State#state{log = {Log, Type}}, -%% {NewState, ok}; -%% _ -> -%% {State, {error, {adt_not_enabled}}} -%% end; -%% handle_system_info_updated(_State, _What) -> -%% ok. - handle_get_log_type(#state{log = {_Log, Value}} = State) -> %% Just to make sure, check that ATL is actually enabled case snmpm_config:system_info(audit_trail_log) of @@ -1257,13 +1148,6 @@ maybe_process_extra_info(_ExtraInfo) -> %% ------------------------------------------------------------------- -t() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). - - -%% ------------------------------------------------------------------- - %% info_msg(F, A) -> %% ?snmpm_info("NET-IF server: " ++ F, A). @@ -1301,8 +1185,6 @@ proc_mem(P) when is_pid(P) -> _ -> undefined end. -%% proc_mem(_) -> -%% undefined. get_port_info(Id) -> @@ -1382,20 +1264,6 @@ counters() -> inc(Name) -> inc(Name, 1). inc(Name, N) -> snmpm_config:incr_stats_counter(Name, N). -%% get_counters() -> -%% Counters = counters(), -%% get_counters(Counters, []). - -%% get_counters([], Acc) -> -%% lists:reverse(Acc); -%% get_counters([Counter|Counters], Acc) -> -%% case snmpm_config:get_stats_counter(Counter) of -%% {ok, CounterVal} -> -%% get_counters(Counters, [{Counter, CounterVal}|Acc]); -%% _ -> -%% get_counters(Counters, Acc) -%% end. - %% ---------------------------------------------------------------- diff --git a/lib/snmp/src/manager/snmpm_server.erl b/lib/snmp/src/manager/snmpm_server.erl index a75122d0bb..00a9b82daa 100644 --- a/lib/snmp/src/manager/snmpm_server.erl +++ b/lib/snmp/src/manager/snmpm_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -467,27 +467,6 @@ cancel_async_request(UserId, ReqId) -> call({cancel_async_request, UserId, ReqId}). -%% discovery(UserId, BAddr) -> -%% discovery(UserId, BAddr, ?SNMP_AGENT_PORT, [], -%% ?DEFAULT_ASYNC_EXPIRE, ?EXTRA_INFO). - -%% discovery(UserId, BAddr, Config) when is_list(Config) -> -%% discovery(UserId, BAddr, ?SNMP_AGENT_PORT, Config, -%% ?DEFAULT_ASYNC_EXPIRE, ?EXTRA_INFO); - -%% discovery(UserId, BAddr, Expire) when is_integer(Expire) -> -%% discovery(UserId, BAddr, ?SNMP_AGENT_PORT, [], Expire, ?EXTRA_INFO). - -%% discovery(UserId, BAddr, Config, Expire) -> -%% discovery(UserId, BAddr, ?SNMP_AGENT_PORT, Config, Expire, ?EXTRA_INFO). - -%% discovery(UserId, BAddr, Port, Config, Expire) -> -%% discovery(UserId, BAddr, Port, Config, Expire, ?EXTRA_INFO). - -%% discovery(UserId, BAddr, Port, Config, Expire, ExtraInfo) -> -%% call({discovery, self(), UserId, BAddr, Port, Config, Expire, ExtraInfo}). - - verbosity(Verbosity) -> case ?vvalidate(Verbosity) of Verbosity -> @@ -927,14 +906,6 @@ handle_call({cancel_async_request, UserId, ReqId}, _From, State) -> {reply, Reply, State}; -%% handle_call({discovery, Pid, UserId, BAddr, Port, Config, Expire, ExtraInfo}, -%% _From, State) -> -%% ?vlog("received discovery request", []), -%% Reply = (catch handle_discovery(Pid, UserId, BAddr, Port, Config, -%% Expire, ExtraInfo, State)), -%% {reply, Reply, State}; - - handle_call({load_mib, Mib}, _From, State) -> ?vlog("received load_mib request", []), case snmpm_config:load_mib(Mib) of @@ -988,13 +959,6 @@ handle_call(is_started, _From, State) -> IsStarted = is_started(State), {reply, IsStarted, State}; -%% handle_call({system_info_updated, Target, What}, _From, State) -> -%% ?vlog("received system_info_updated request: " -%% "~n Target: ~p" -%% "~n What: ~p", [Target, What]), -%% Reply = handle_system_info_updated(State, Target, What), -%% {reply, Reply, State}; - handle_call(get_log_type, _From, State) -> ?vlog("received get_log_type request", []), Reply = handle_get_log_type(State), @@ -1042,11 +1006,6 @@ handle_info({snmp_error, ReqId, Reason, Domain, Addr}, State) -> handle_snmp_error(Domain, Addr, ReqId, Reason, State), {noreply, State}; -%% handle_info({snmp_error, ReqId, Pdu, Reason, Addr, Port}, State) -> -%% ?vlog("received snmp_error message", []), -%% handle_snmp_error(Pdu, ReqId, Reason, Addr, Port, State), -%% {noreply, State}; - handle_info({snmp_pdu, Pdu, Domain, Addr}, State) -> ?vlog("received snmp_pdu message", []), @@ -1411,7 +1370,7 @@ handle_async_get(Pid, UserId, TargetName, Oids, SendOpts, State) -> address = Addr, type = get, data = MsgData, - expire = t() + Expire}, + expire = snmp_misc:now(ms) + Expire}, ets:insert(snmpm_request_table, Req), gct_activate(State#state.gct), @@ -1460,7 +1419,7 @@ handle_async_get_next(Pid, UserId, TargetName, Oids, SendOpts, State) -> address = Addr, type = get_next, data = MsgData, - expire = t() + Expire}, + expire = snmp_misc:now(ms) + Expire}, ets:insert(snmpm_request_table, Req), gct_activate(State#state.gct), @@ -1516,7 +1475,7 @@ handle_async_get_bulk(Pid, address = Addr, type = get_bulk, data = MsgData, - expire = t() + Expire}, + expire = snmp_misc:now(ms) + Expire}, ets:insert(snmpm_request_table, Req), gct_activate(State#state.gct), {ok, ReqId}; @@ -1564,7 +1523,7 @@ handle_async_set(Pid, UserId, TargetName, VarsAndVals, SendOpts, State) -> address = Addr, type = set, data = MsgData, - expire = t() + Expire}, + expire = snmp_misc:now(ms) + Expire}, ets:insert(snmpm_request_table, Req), gct_activate(State#state.gct), @@ -1600,18 +1559,6 @@ handle_cancel_async_request(UserId, ReqId, _State) -> ?vlog("handle_cancel_async_request -> not found", []), {error, not_found} end. - - -%% handle_system_info_updated(#state{net_if = Pid, net_if_mod = Mod} = _State, -%% net_if = _Target, What) -> -%% case (catch Mod:system_info_updated(Pid, What)) of -%% {'EXIT', _} -> -%% {error, not_supported}; -%% Else -> -%% Else -%% end; -%% handle_system_info_updated(_State, Target, What) -> -%% {error, {bad_target, Target, What}}. handle_get_log_type(#state{net_if = Pid, net_if_mod = Mod}) -> case (catch Mod:get_log_type(Pid)) of @@ -1629,47 +1576,6 @@ handle_set_log_type(#state{net_if = Pid, net_if_mod = Mod}, NewType) -> Else end. - -%% handle_discovery(Pid, UserId, BAddr, Port, Config, Expire, ExtraInfo, State) -> -%% ?vtrace("handle_discovery -> entry with" -%% "~n Pid: ~p" -%% "~n UserId: ~p" -%% "~n BAddr: ~p" -%% "~n Port: ~p" -%% "~n Config: ~p" -%% "~n Expire: ~p", -%% [Pid, UserId, BAddr, Port, Config, Expire]), -%% case agent_data(default, default, "", Config) of -%% {ok, Addr, Port, Vsn, MsgData} -> -%% ?vtrace("handle_discovery -> send a ~p disco message", [Vsn]), -%% ReqId = send_discovery(Vsn, MsgData, BAddr, Port, ExtraInfo, -%% State), -%% ?vdebug("handle_discovery -> ReqId: ~p", [ReqId]), -%% MonRef = erlang:monitor(process, Pid), -%% ?vtrace("handle_discovery -> MonRef: ~p", [MonRef]), -%% Req = #request{id = ReqId, -%% user_id = UserId, -%% target = TargetName, -%% addr = BAddr, -%% port = Port, -%% type = get, -%% data = MsgData, -%% mon = MonRef, -%% discovery = true, -%% expire = t() + Expire}, -%% ets:insert(snmpm_request_table, Req), -%% gct_activate(State#state.gct), -%% {ok, ReqId}; - -%% Error -> -%% ?vinfo("failed retrieving agent data for discovery (get):" -%% "~n BAddr: ~p" -%% "~n Port: ~p" -%% "~n Error: ~p", [BAddr, Port, Error]), -%% Error -%% end. - - handle_sync_timeout(ReqId, From, State) -> ?vtrace("handle_sync_timeout -> entry with" "~n ReqId: ~p" @@ -1693,7 +1599,7 @@ handle_sync_timeout(ReqId, From, State) -> Req = Req0#request{ref = undefined, mon = undefined, from = undefined, - expire = t()}, + expire = snmp_misc:now(ms)}, ets:insert(snmpm_request_table, Req), gct_activate(State#state.gct), ok; @@ -2116,7 +2022,8 @@ do_handle_agent(DefUserId, DefMod, ok; InvalidResult -> - CallbackArgs = [Domain, Addr, Type, SnmpInfo, DefData], + CallbackArgs = + [Domain_or_Ip, Addr_or_Port, Type, SnmpInfo, DefData], handle_invalid_result(handle_agent, CallbackArgs, InvalidResult) catch @@ -2212,7 +2119,8 @@ do_handle_agent(DefUserId, DefMod, end; T:E -> - CallbackArgs = [Domain, Addr, Type, SnmpInfo, DefData], + CallbackArgs = + [Domain_or_Ip, Addr_or_Port, Type, SnmpInfo, DefData], handle_invalid_result(handle_agent, CallbackArgs, T, E) end. @@ -3024,7 +2932,7 @@ cancel_timer(Ref) -> handle_gc(GCT) -> ets:safe_fixtable(snmpm_request_table, true), - case do_gc(ets:first(snmpm_request_table), t()) of + case do_gc(ets:first(snmpm_request_table), snmp_misc:now(ms)) of 0 -> gct_deactivate(GCT); _ -> @@ -3098,23 +3006,11 @@ send_set_request(VarsAndVals, Vsn, MsgData, Domain, Addr, ExtraInfo, Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Domain, Addr, ExtraInfo), Pdu#pdu.request_id. -%% send_discovery(Vsn, MsgData, Addr, Port, ExtraInfo, -%% #state{net_if = NetIf, -%% net_if_mod = Mod}) -> -%% Pdu = make_discovery_pdu(), -%% Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Addr, Port, ExtraInfo), -%% Pdu#pdu.request_id. - - %%---------------------------------------------------------------------- %% %%---------------------------------------------------------------------- -%% make_discovery_pdu() -> -%% Oids = [?sysObjectID_instance, ?sysDescr_instance, ?sysUpTime_instance], -%% make_pdu_impl(get, Oids). - make_pdu(set, VarsAndVals, MiniMIB) -> VBs = [var_and_value_to_varbind(VAV, MiniMIB) || VAV <- VarsAndVals], make_pdu_impl(set, VBs); @@ -3397,7 +3293,7 @@ gct_init(#gct{parent = Parent, timeout = Timeout} = State) -> gct(State, Timeout). gct(#gct{parent = Parent, state = active} = State, Timeout) -> - T = t(), + T = snmp_misc:now(ms), receive {stop, Parent} -> ok; @@ -3455,7 +3351,7 @@ gct(#gct{parent = Parent, state = idle} = State, Timeout) -> end. new_timeout(T1, T2) -> - case T1 - (t() - T2) of + case T1 - (snmp_misc:now(ms) - T2) of T when (T > 0) -> T; _ -> @@ -3475,11 +3371,6 @@ maybe_demonitor(undefined) -> maybe_demonitor(MonRef) -> erlang:demonitor(MonRef). -%% Time in milli seconds -t() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). - mk_target_name(Domain, Addr, Config) -> snmpm_config:mk_target_name(Domain, Addr, Config). @@ -3518,12 +3409,6 @@ call(Req) -> call(Req, To) -> gen_server:call(?SERVER, Req, To). -%% cast(Msg) -> -%% gen_server:cast(?SERVER, Msg). - -%% info_msg(F, A) -> -%% ?snmpm_info("Server: " ++ F, A). - warning_msg(F, A) -> ?snmpm_warning("Server: " ++ F, A). @@ -3599,20 +3484,3 @@ note_store_info(Pid) -> %%---------------------------------------------------------------------- - - -%%---------------------------------------------------------------------- -%% Debug -%%---------------------------------------------------------------------- - -% sz(L) when is_list(L) -> -% length(lists:flatten(L)); -% sz(B) when is_binary(B) -> -% size(B). - -%% p(F) -> -%% p(F, []). - -%% p(F, A) -> -%% io:format("~w:" ++ F ++ "~n", [?MODULE | A]). - diff --git a/lib/snmp/src/misc/snmp_misc.erl b/lib/snmp/src/misc/snmp_misc.erl index c36cee2a53..cc438977c9 100644 --- a/lib/snmp/src/misc/snmp_misc.erl +++ b/lib/snmp/src/misc/snmp_misc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -101,21 +101,14 @@ sleep(Time) -> %% Returns time in ms = sec/1000 % now() -> now(ms). now(ms) -> - Now = erlang:now(), - element(1,Now)*1000000000+ - element(2,Now)*1000+ - (element(3,Now) div 1000); + erlang:monotonic_time(milli_seconds); + %% Returns time in cs = sec/100 now(cs) -> - Now = erlang:now(), - element(1,Now)*100000000+ - element(2,Now)*100+ - (element(3,Now) div 10000); + erlang:monotonic_time(100); + now(sec) -> - Now = erlang:now(), - element(1,Now)*1000000+ - element(2,Now)+ - (element(3,Now) div 1000000). + erlang:monotonic_time(seconds). is_crypto_supported(Alg) -> @@ -479,7 +472,3 @@ format_val('OBJECT IDENTIFIER', _, Val, MiniMib) -> io_lib:format("~w", [NVal]); format_val(_, _, Val, _MiniMib) -> io_lib:format("~p", [Val]). - - - - diff --git a/lib/snmp/src/misc/snmp_verbosity.erl b/lib/snmp/src/misc/snmp_verbosity.erl index f27c31db03..c9192158ef 100644 --- a/lib/snmp/src/misc/snmp_verbosity.erl +++ b/lib/snmp/src/misc/snmp_verbosity.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2012. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -69,7 +69,7 @@ print2(_Verbosity,Format,Arguments) -> timestamp() -> - format_timestamp(now()). + format_timestamp(os:timestamp()). format_timestamp({_N1, _N2, N3} = Now) -> {Date, Time} = calendar:now_to_datetime(Now), @@ -162,4 +162,3 @@ validate(log) -> log; validate(debug) -> debug; validate(trace) -> trace; validate(_) -> silence. - diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index b4770ad0a9..a28cdf6aca 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2014. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -426,10 +426,6 @@ -include_lib("snmp/include/snmp_types.hrl"). -include_lib("snmp/src/agent/snmpa_atl.hrl"). -%% -include_lib("snmp/include/SNMP-COMMUNITY-MIB.hrl"). -%% -include_lib("snmp/include/SNMP-VIEW-BASED-ACM-MIB.hrl"). -%% -include_lib("snmp/include/SNMP-USER-BASED-SM-MIB.hrl"). - -define(klas1, [1,3,6,1,2,1,7]). -define(klas2, [1,3,6,1,2,1,9]). @@ -1612,7 +1608,8 @@ app_dir(App) -> create_local_db_dir(Config) when is_list(Config) -> ?P(create_local_db_dir), DataDir = snmp_test_lib:lookup(data_dir, Config), - T = erlang:now(), + UName = erlang:unique_integer([positive]), + T = {UName, UName, UName}, [As,Bs,Cs] = [integer_to_list(I) || I <- tuple_to_list(T)], DbDir = filename:join([DataDir, As, Bs, Cs]), ok = del_dir(DbDir, 3), @@ -2448,10 +2445,6 @@ mul_cases() -> ]. -%% multiple_reqs_3(_X) -> -%% {req, [], {conf, init_mul, mul_cases_3(), finish_mul}}. - - mul_cases_2() -> [ mul_get_2, @@ -3200,19 +3193,18 @@ v1_get_next_p() -> %% 4.1.3:2 gn([[tTooBig]]), io:format("We currently don't handle tooBig correct!!!\n"), -% ?line ?expect3(tooBig, 0, [{[tTooBig], 'NULL'}]), + ?line ?expect3(tooBig, 0, any), %% 4.1.3:3 gn([[tGenErr1]]), -% ?line expect(40, genErr, 1, [{[tGenErr1], 'NULL'}]), + ?line ?expect3(genErr, 1, any), gn([[tGenErr2]]), -% ?line ?expect3(genErr, 1, [{[tGenErr2], 'NULL'}]), + ?line ?expect3(genErr, 1, any), gn([[sysDescr], [tGenErr3]]), -% ?line ?expect3(genErr, 2, [{[sysDescr], 'NULL'}, -% {[tGenErr3], 'NULL'}]). + ?line ?expect3(genErr, 2, any). v1_set_p() -> @@ -3451,8 +3443,7 @@ v2_set_p() -> %% Req. OLD-SNMPEA-MIB table_test() -> io:format("Testing simple get, next and set on communityTable...~n"), -%% {[147,214,36,45], "public", 2, readWrite}. -%% {[147,214,36,45], "standard trap", 2, read}. + Key1c3 = [intCommunityViewIndex,get(mip),is("public")], Key2c3 = [intCommunityViewIndex,get(mip),is("standard trap")], Key1c4 = [intCommunityAccess,get(mip),is("public")], @@ -3620,8 +3611,6 @@ notify(Pid, What) -> %% Req: system group, OLD-SNMPEA-MIB, Klas1 big_test() -> - %% put(sname, {?MODULE, big_test}), - %% put(verbosity, trace), ?DBG("big_test -> testing simple next/get/set @ master agent...",[]), simple_standard_test(), @@ -5691,8 +5680,7 @@ loop_mib_1(suite) -> []; loop_mib_1(Config) when is_list(Config) -> ?P(loop_mib_1), ?LOG("loop_mib_1 -> initiate case",[]), - %% snmpa:verbosity(master_agent,debug), - %% snmpa:verbosity(mib_server,info), + {_SaNode, _MgrNode, _MibDir} = init_case(Config), ?DBG("loop_mib_1 -> ~n" "\tSaNode: ~p~n" @@ -6643,7 +6631,6 @@ otp8395({init, Config}) when is_list(Config) -> %% {ok, AgentNode} = start_node(agent), - %% {ok, SubAgentNode} = start_node(sub_agent), {ok, ManagerNode} = start_node(manager), %% -- @@ -6654,16 +6641,9 @@ otp8395({init, Config}) when is_list(Config) -> AgentMnesiaDir = join([AgentDbDir, "mnesia"]), mnesia_init(AgentNode, AgentMnesiaDir), - %% SubAgentDir = ?config(sub_agent_dir, Config), - %% SubAgentMnesiaDir = join([SubAgentDir, "mnesia"]), - %% mnesia_init(SubAgentNode, SubAgentMnesiaDir), - - %% ok = mnesia_create_schema(AgentNode, [AgentNode, SubAgentNode]), - %% ok = mnesia:create_schema([AgentNode, SubAgentNode]), mnesia_create_schema(AgentNode, [AgentNode]), mnesia_start(AgentNode), - %% mnesia_start(SubAgentNode), %% -- %% Host & IP @@ -6749,11 +6729,6 @@ otp8395({fin, Config}) when is_list(Config) -> ?DBG("otp8395(fin) -> stop agent node", []), stop_node(AgentNode), - - %% SubAgentNode = ?config(sub_agent_node, Config), - %% stop_node(SubAgentNode), - - %% - %% Stop the manager node %% @@ -6970,20 +6945,6 @@ process_options(Defaults, _Opts) -> %% process_options(Defaults, Opts, []). Defaults. -%% process_options([], _Opts, Acc) -> -%% lists:reverse(Acc); -%% process_options([{Key, DefaultValue}|Defaults], Opts, Acc) -> -%% case lists:keysearch(Key, 1, Opts) of -%% {value, {Key, Value}} when is_list-> - - -%% snmp_app_env_init(Node, Entity, Conf) -> -%% rpc:call(Node, snmp_app_env_init, [Entity, Conf]). - -%% snmp_app_env_init(Entity, Conf) -> -%% application:unload(snmp), -%% application:load(snmp), -%% application:set_env(snmp, Entity, Conf). start_stdalone_agent(Node, Config) -> rpc:call(Node, ?MODULE, start_stdalone_agent, [Config]). @@ -7063,9 +7024,6 @@ do_info(MaNode) -> tree_size_bytes, db_memory]}], verify_info(Info, Keys), - %% OldInfo = snmpa:old_info_format(Info), - %% ?DBG("info_test1 -> OldInfo: ~n~p", [OldInfo]), - %% verify_old_info(OldInfo), ok. verify_info([], []) -> @@ -7107,21 +7065,6 @@ verify_subinfo(Info0, [Key|Keys]) -> Info -> verify_subinfo(Info, Keys) end. - -%% verify_old_info(Info) -> -%% Keys = [vsns, subagents, loaded_mibs, -%% tree_size_bytes, process_memory, db_memory], -%% verify_old_info(Keys, Info). - -%% verify_old_info([], _) -> -%% ok; -%% verify_old_info([Key|Keys], Info) -> -%% case lists:keymember(Key, 1, Info) of -%% true -> -%% verify_old_info(Keys, Info); -%% false -> -%% ?FAIL({missing_old_info, Key}) -%% end. %% Index String - string used in index is(S) -> [length(S) | S]. @@ -7184,8 +7127,6 @@ rewrite_usm_mgr(Dir, ShaKey, DesKey) -> reset_usm_mgr(Dir) -> snmp_agent_test_lib:reset_usm_mgr(Dir). -%% update_community(Vsns, Dir) -> -%% snmp_agent_test_lib:update_community(Vsns, Dir). update_vacm(Vsn, Dir) -> snmp_agent_test_lib:update_vacm(Vsn, Dir). @@ -7196,8 +7137,6 @@ write_community_conf(Dir, Conf) -> write_target_addr_conf(Dir, Conf) -> snmp_agent_test_lib:write_target_addr_conf(Dir, Conf). -%% write_target_addr_conf(Dir, ManagerIp, UDP, Vsns) -> -%% snmp_agent_test_lib:write_target_addr_conf(Dir, ManagerIp, UDP, Vsns). rewrite_target_addr_conf(Dir, NewPort) -> snmp_agent_test_lib:rewrite_target_addr_conf(Dir, NewPort). @@ -7218,10 +7157,6 @@ reset_target_params_conf(Dir) -> write_notify_conf(Dir) -> snmp_agent_test_lib:write_notify_conf(Dir). -%% write_view_conf(Dir) -> -%% snmp_agent_test_lib:write_view_conf(Dir). - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% copy_file(From, To) -> @@ -7381,9 +7316,6 @@ lists_key1search(Key, List) when is_atom(Key) -> end. -%% regs() -> -%% lists:sort(registered()). - %% ------ join(Parts) -> diff --git a/lib/snmp/test/snmp_app_test.erl b/lib/snmp/test/snmp_app_test.erl index 9b13e7cf1a..1e68b4e2c8 100644 --- a/lib/snmp/test/snmp_app_test.erl +++ b/lib/snmp/test/snmp_app_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -32,8 +32,6 @@ modules/1, exportall/1, app_depend/1, - undef_funcs/1, - start_and_stop_empty/1, start_and_stop_with_agent/1, @@ -59,7 +57,6 @@ all() -> modules, exportall, app_depend, - undef_funcs, {group, start_and_stop} ], Cases. @@ -131,9 +128,6 @@ end_per_suite(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Test server callbacks -init_per_testcase(undef_funcs, Config) -> - Config2 = lists:keydelete(watchdog, 1, Config), - [{watchdog, ?WD_START(?MINS(10))} | Config2]; init_per_testcase(_Case, Config) -> Config. @@ -293,88 +287,6 @@ check_apps([App|Apps]) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -undef_funcs(suite) -> - []; -undef_funcs(doc) -> - []; -undef_funcs(Config) when is_list(Config) -> - App = snmp, - AppFile = key1search(app_file, Config), - Mods = key1search(modules, AppFile), - Root = code:root_dir(), - LibDir = code:lib_dir(App), - EbinDir = filename:join([LibDir,"ebin"]), - XRefTestName = undef_funcs_make_name(App, xref_test_name), - {ok, XRef} = xref:start(XRefTestName), - ok = xref:set_default(XRef, - [{verbose,false},{warnings,false}]), - XRefName = undef_funcs_make_name(App, xref_name), - {ok, XRefName} = xref:add_release(XRef, Root, {name,XRefName}), - {ok, App} = xref:replace_application(XRef, App, EbinDir), - {ok, Undefs} = xref:analyze(XRef, undefined_function_calls), - xref:stop(XRef), - analyze_undefined_function_calls(Undefs, Mods, []). - -valid_undef(crypto = CalledMod) -> - case (catch CalledMod:version()) of - Version when is_list(Version) -> - %% The called module was crypto and the version - %% function returns a valid value. - %% This means that the function is - %% actually undefined... - true; - _ -> - %% The called module was crypto but the version - %% function does *not* return a valid value. - %% This means the crypto was not actually not - %% build, which is an case snmp handles. - false - end; -valid_undef(_) -> - true. - - -analyze_undefined_function_calls([], _, []) -> - ok; -analyze_undefined_function_calls([], _, AppUndefs) -> - exit({suite_failed, {undefined_function_calls, AppUndefs}}); -analyze_undefined_function_calls([{{Mod, _F, _A}, _C} = AppUndef|Undefs], - AppModules, AppUndefs) -> - %% Check that this module is our's - case lists:member(Mod,AppModules) of - true -> - {Calling,Called} = AppUndef, - {Mod1,Func1,Ar1} = Calling, - {Mod2,Func2,Ar2} = Called, - %% If the called module is crypto, then we will *not* - %% fail if crypto is not built (since crypto is actually - %% not built for all platforms) - case valid_undef(Mod2) of - true -> - io:format("undefined function call: " - "~n ~w:~w/~w calls ~w:~w/~w~n", - [Mod1,Func1,Ar1,Mod2,Func2,Ar2]), - analyze_undefined_function_calls( - Undefs, AppModules, [AppUndef|AppUndefs]); - false -> - io:format("skipping ~p (calling ~w:~w/~w)~n", - [Mod, Mod2, Func2, Ar2]), - analyze_undefined_function_calls(Undefs, - AppModules, AppUndefs) - end; - false -> - io:format("dropping ~p~n", [Mod]), - analyze_undefined_function_calls(Undefs, AppModules, AppUndefs) - end. - -%% This function is used simply to avoid cut-and-paste errors later... -undef_funcs_make_name(App, PostFix) -> - list_to_atom(atom_to_list(App) ++ "_" ++ atom_to_list(PostFix)). - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/snmp/test/snmp_appup_mgr.erl b/lib/snmp/test/snmp_appup_mgr.erl index 6648ce9dbe..b07f8b3c72 100644 --- a/lib/snmp/test/snmp_appup_mgr.erl +++ b/lib/snmp/test/snmp_appup_mgr.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -140,7 +140,7 @@ handle_req(#agent{host = Host, port = Port}, Reqs) -> {ok, ReqId} = snmpm:ag(?USER_ID, Host, Port, Oids), p("issued get-request (~w) for: ~s", [ReqId, oid_descs(Descs)]), ReqTimer = erlang:send_after(?REQ_TIMEOUT, self(), {req_timeout, ReqId}), - {ReqId, erlang:now(), ReqTimer}. + {ReqId, erlang:monotonic_time(micro_seconds), ReqTimer}. oid_descs([]) -> []; @@ -163,7 +163,7 @@ handle_req_timeout(#state{ids = IDs0} = State, ReqId) -> handle_snmp(#state{ids = IDs0} = S, {error, ReqId, Reason}) -> case lists:keysearch(ReqId, 1, IDs0) of {value, {ReqId, T, Ref}} -> - Diff = timer:now_diff(erlang:now(), T), + Diff = erlang:monotonic_time(micro_seconds) - T, p("SNMP error regarding outstanding request after ~w microsec:" "~n ReqId: ~w" "~n Reason: ~w", [Diff, ReqId, Reason]), @@ -187,7 +187,7 @@ handle_snmp(State, {agent, Addr, Port, SnmpInfo}) -> handle_snmp(#state{ids = IDs0} = S, {pdu, Addr, Port, ReqId, SnmpResponse}) -> case lists:keysearch(ReqId, 1, IDs0) of {value, {ReqId, T, Ref}} -> - Diff = timer:now_diff(erlang:now(), T), + Diff = erlang:monotonic_time(micro_seconds) - T, p("SNMP pdu regarding outstanding request after ~w microsec:" "~n ReqId: ~w" "~n Addr: ~w" diff --git a/lib/snmp/test/snmp_conf_test.erl b/lib/snmp/test/snmp_conf_test.erl index 7f5d11c0e7..dacedf0847 100644 --- a/lib/snmp/test/snmp_conf_test.erl +++ b/lib/snmp/test/snmp_conf_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2014. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -117,7 +117,7 @@ check_mandatory(Config) when is_list(Config) -> {b, mandatory}, {d, {value, 20202}}, {e, {value, "kalle"}}], - ?line {ok, L1} = verify_mandatory(A1, B1), + ?line {ok, _L1} = verify_mandatory(A1, B1), ?DBG("check_mandatory -> L1: ~p", [L1]), A2 = [{a, hej}, {c, 10}, {d, 10101}, {f, 10.88}], B2 = [{a, {value, hejsan}}, diff --git a/lib/snmp/test/snmp_log_test.erl b/lib/snmp/test/snmp_log_test.erl index fb7285110f..ed71dba23f 100644 --- a/lib/snmp/test/snmp_log_test.erl +++ b/lib/snmp/test/snmp_log_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -633,11 +633,11 @@ log_to_txt3(Config) when is_list(Config) -> log_reader_log_to(Reader, fun() -> I = disk_log:info(Log), - T1 = t(), + T1 = snmp_misc:now(ms), R = snmp_log:log_to_txt(Log, LogFile, Dir, Mibs, TxtFile), - T2 = t(), - io:format(user, + T2 = snmp_misc:now(ms), + io:format(user, "Time converting file: ~w ms~n", [T2 - T1]), {R, I} @@ -704,10 +704,10 @@ log_writer_start(Name, File, Size, Repair) -> log_writer_stop(Pid) -> Pid ! {stop, self()}, - _T1 = t(), + _T1 = snmp_misc:now(ms), receive {'EXIT', Pid, normal} -> - _T2 = t(), + _T2 = snmp_misc:now(ms), ?DBG("it took ~w ms to stop the writer", [_T2 - _T1]), ok after 60000 -> @@ -721,10 +721,10 @@ log_writer_info(Pid) -> log_writer_sleep(Pid, Time) -> Pid ! {sleep, Time, self()}, - _T1 = t(), + _T1 = snmp_misc:now(ms), receive {sleeping, Pid} -> - _T2 = t(), + _T2 = snmp_misc:now(ms), ?DBG("it took ~w ms to put the writer to sleep", [_T2 - _T1]), ok; {'EXIT', Pid, Reason} -> @@ -793,10 +793,10 @@ lp(F, A) -> log_reader_start() -> Pid = spawn_link(?MODULE, log_reader_main, [self()]), - _T1 = t(), + _T1 = snmp_misc:now(ms), receive {started, Pid} -> - _T2 = t(), + _T2 = snmp_misc:now(ms), ?DBG("it took ~w ms to start the reader", [_T2 - _T1]), {ok, Pid}; {'EXIT', Pid, Reason} -> @@ -807,10 +807,10 @@ log_reader_start() -> log_reader_stop(Pid) -> Pid ! {stop, self()}, - _T1 = t(), + _T1 = snmp_misc:now(ms), receive {'EXIT', Pid, normal} -> - _T2 = t(), + _T2 = snmp_misc:now(ms), ?DBG("it took ~w ms to put the reader to eleep", [_T2 - _T1]), ok after 1000 -> @@ -1124,8 +1124,3 @@ join(D, F) -> p(Case) -> io:format(user, "test case: ~w~n", [Case]). - -%% Time in milli sec -t() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). diff --git a/lib/snmp/test/snmp_manager_config_test.erl b/lib/snmp/test/snmp_manager_config_test.erl index f37e957dae..ba674edce3 100644 --- a/lib/snmp/test/snmp_manager_config_test.erl +++ b/lib/snmp/test/snmp_manager_config_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -2169,7 +2169,6 @@ register_usm_user_using_function(Conf) when is_list(Conf) -> %% -- p("done"), ok. -%% ?SKIP(not_yet_implemented). %% @@ -2259,8 +2258,9 @@ create_and_increment(Conf) when is_list(Conf) -> ?line {ok, _Pid} = snmpm_config:start_link(Opts), %% Random init - {A,B,C} = erlang:now(), - random:seed(A,B,C), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), StartVal = random:uniform(2147483647), IncVal = 42, diff --git a/lib/snmp/test/snmp_test_lib.erl b/lib/snmp/test/snmp_test_lib.erl index 5e611340a3..72c7452ec4 100644 --- a/lib/snmp/test/snmp_test_lib.erl +++ b/lib/snmp/test/snmp_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2014. All Rights Reserved. +%% Copyright Ericsson AB 2002-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -30,7 +30,7 @@ lookup/2, replace_config/3, set_config/3, get_config/2, get_config/3]). -export([fail/3, skip/3]). --export([millis/0, millis_diff/2, hours/1, minutes/1, seconds/1, sleep/1]). +-export([hours/1, minutes/1, seconds/1, sleep/1]). -export([flush_mqueue/0, trap_exit/0, trap_exit/1]). -export([ping/1, local_nodes/0, nodes_on/1]). -export([start_node/2]). @@ -334,14 +334,6 @@ skip(Reason, Module, Line) -> %% Time related function %% -millis() -> - erlang:now(). - -millis_diff(A,B) -> - T1 = (element(1,A)*1000000) + element(2,A) + (element(3,A)/1000000), - T2 = (element(1,B)*1000000) + element(2,B) + (element(3,B)/1000000), - T1 - T2. - hours(N) -> trunc(N * 1000 * 60 * 60). minutes(N) -> trunc(N * 1000 * 60). seconds(N) -> trunc(N * 1000). @@ -628,4 +620,3 @@ format_timestamp({_N1, _N2, N3} = Now) -> io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w ~w", [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), lists:flatten(FormatDate). - diff --git a/lib/snmp/test/snmp_test_lib.hrl b/lib/snmp/test/snmp_test_lib.hrl index 9b7609b831..fd584880da 100644 --- a/lib/snmp/test/snmp_test_lib.hrl +++ b/lib/snmp/test/snmp_test_lib.hrl @@ -1,8 +1,8 @@ -%%<copyright> -%% <year>2002-2014</year> -%% <holder>Ericsson AB, All Rights Reserved</holder> -%%</copyright> -%%<legalnotice> +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2015. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the @@ -15,7 +15,7 @@ %% under the License. %% %% The Initial Developer of the Original Code is Ericsson AB. -%%</legalnotice> +%% %CopyrightEnd% %% %%---------------------------------------------------------------------- %% Purpose: Define common macros for testing @@ -73,8 +73,6 @@ -endif. -define(SLEEP(MSEC), snmp_test_lib:sleep(MSEC)). --define(M(), snmp_test_lib:millis()). --define(MDIFF(A,B), snmp_test_lib:millis_diff(A,B)). %% - Process utility macros - @@ -149,4 +147,3 @@ -define(PRINT(P,F,A), snmp_test_lib:print(P,?MODULE,?LINE,F,A)). - diff --git a/lib/snmp/test/snmp_test_mgr.erl b/lib/snmp/test/snmp_test_mgr.erl index 8cb6ec588e..1bf7efc695 100644 --- a/lib/snmp/test/snmp_test_mgr.erl +++ b/lib/snmp/test/snmp_test_mgr.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -188,8 +188,9 @@ receive_trap(Timeout) -> init({Options, CallerPid}) -> put(sname, mgr), put(verbosity, debug), - {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + random:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), case (catch is_options_ok(Options)) of true -> put(debug, get_value(debug, Options, false)), @@ -1135,4 +1136,3 @@ d(_,_F,_A) -> formated_timestamp() -> snmp_test_lib:formated_timestamp(). - diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 345cc790f2..67adf0a34f 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2014. All Rights Reserved. +# Copyright Ericsson AB 1997-2015. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 5.1.1 +SNMP_VSN = 5.1.2 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssh/doc/src/introduction.xml b/lib/ssh/doc/src/introduction.xml index b42910cb34..1efbc16016 100644 --- a/lib/ssh/doc/src/introduction.xml +++ b/lib/ssh/doc/src/introduction.xml @@ -25,31 +25,181 @@ <title>Introduction</title> <prepared>OTP team</prepared> + <responsible></responsible> + <docno></docno> + <approved></approved> + <checked></checked> + <date></date> + <rev></rev> <file>introduction.xml</file> </header> - + <p>SSH is a protocol for secure remote logon and + other secure network services over an insecure network.</p> <section> - <title>Purpose</title> + <title>Scope and Purpose</title> - <p>Secure Shell (SSH) is a protocol for secure remote login and - other secure network services over an insecure network. SSH - provides a single, full-duplex, byte-oriented connection between + <p>SSH provides a single, full-duplex, and byte-oriented connection between client and server. The protocol also provides privacy, integrity, - server authentication and man-in-the-middle protection.</p> - - <p>The Erlang SSH application is an implementation of the SSH - protocol in Erlang which offers API functions to write customized - SSH clients and servers as well as making the Erlang shell - available via SSH. Also included in the SSH application are an - SFTP (SSH File Transfer Protocol) client <seealso - marker="ssh_sftp">ssh_sftp</seealso> and server <seealso - marker="ssh_sftp">ssh_sftpd</seealso>.</p> + server authentication, and man-in-the-middle protection.</p> + + <p>The <c>ssh</c> application is an implementation of the SSH Transport, Connection and Authentication + Layer Protocols in Erlang. It provides the following:</p> + <list type="bulleted"> + <item>API functions to write customized SSH clients and servers applications</item> + <item>The Erlang shell available over SSH</item> + <item>An SFTP client (<seealso marker="ssh_sftp">ssh_sftp</seealso>) + and server (<seealso marker="ssh_sftp">ssh_sftpd</seealso>)</item> + </list> </section> <section> <title>Prerequisites</title> - <p>It is assumed that the reader is familiar with the concepts of <seealso marker="doc/design_principles:des_princ">OTP</seealso> - and has a basic understanding of <url href="http://en.wikipedia.org/wiki/Public-key_cryptography">public keys</url>.</p> + <p>It is assumed that the reader is familiar with the Erlang programming language, + concepts of <em>OTP</em>, and has a basic understanding of <em>public keys</em>.</p> + </section> + +<section> + <title>SSH Protocol Overview</title> + + <p>Conceptually, the SSH protocol can be partitioned into four + layers:</p> + + <image file="SSH_protocols.png"> + <icaption>SSH Protocol Architecture</icaption> + </image> + + <section> + <title>Transport Protocol</title> + + <p>The SSH Transport Protocol is a secure, low-level transport. + It provides strong encryption, cryptographic host + authentication, and integrity protection. A minimum of + Message Authentication Code (MAC) and encryption + algorithms are supported. For details, see the + <seealso marker="ssh">ssh(3)</seealso> manual page in <c>ssh</c>.</p> + </section> + + <section> + <title>Authentication Protocol</title> + + <p>The SSH Authentication Protocol is a general-purpose user + authentication protocol run over the SSH Transport Layer + Protocol. The <c>ssh</c> application supports user authentication as follows: + </p> + <list type="bulleted"> + <item> + Using public key technology. RSA and DSA, X509-certificates + are not supported. + </item> + <item> + Using keyboard-interactive authentication. + This is suitable for interactive authentication methods + that do not need any special software support on the client side. + Instead, all authentication data is entered from the keyboard. + </item> + <item> + Using a pure password-based authentication scheme. + Here, the plain text password is encrypted before sent + over the network. + </item> + </list> + <p>Several configuration options for + authentication handling are available in + <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso> + and <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso>.</p> + <p> + The public key handling can be customized by implementing + the following behaviours from <c>ssh</c>:</p> + <list type="bulleted"> + <item>Module + <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso>. + </item> + <item>Module + <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>. + </item> + </list> + </section> + + <section> + <title>Connection Protocol</title> + + <p>The SSH Connection Protocol provides application-support + services over the transport pipe, for example, channel multiplexing, + flow control, remote program execution, signal propagation, and + connection forwarding. Functions for handling the SSH + Connection Protocol can be found in the module <seealso + marker="ssh_connection">ssh_connection</seealso> in <c>ssh</c>. + </p> + </section> + + <section> + <title>Channels</title> + + <p>All terminal sessions, forwarded connections, and so on, are + channels. Multiple channels are multiplexed into a single + connection. All channels are flow-controlled. This means that no + data is sent to a channel peer until a message is received to + indicate that window space is available. + The <em>initial window size</em> specifies how many bytes of channel + data that can be sent to the channel peer without adjusting the + window. Typically, an SSH client opens a channel, sends data (commands), + receives data (control information), and then closes the channel. + The <seealso marker="ssh_channel">ssh_channel</seealso> behaviour + handles generic parts of SSH channel management. This makes it easy + to write your own SSH client/server processes that use flow-control + and thus opens for more focus on the application logic. + </p> + + <p>Channels come in the following three flavors:</p> + + <list type="bulleted"> + <item><em>Subsystem</em> - Named services that can be run as + part of an SSH server, such as SFTP <seealso + marker="ssh_sftpd">(ssh_sftpd)</seealso>, that is built into the + SSH daemon (server) by default, but it can be disabled. The Erlang <c>ssh</c> + daemon can be configured to run any Erlang- + implemented SSH subsystem. + </item> + <item><em>Shell</em> - Interactive shell. By default the + Erlang daemon runs the Erlang shell. The shell can be customized by + providing your own read-eval-print loop. You can also provide your + own Command-Line Interface (CLI) implementation, + but that is much more work. + </item> + <item><em>Exec</em> - One-time remote execution of commands. See function + <seealso marker="ssh_connection#exec-4">ssh_connection:exec/4</seealso> + for more information.</item> + </list> + </section> + + + </section> + <section> + <title>Where to Find More Information</title> + <p> + For detailed information about the SSH protocol, refer to the + following Request for Comments(RFCs): + </p> + + <list type="bulleted"> + <item><url href="http://www.ietf.org/rfc/rfc4250.txt">RFC 4250</url> - + Protocol Assigned Numbers</item> + <item><url href="http://www.ietf.org/rfc/rfc4251.txt">RFC 4251</url> - + Protocol Architecture</item> + <item><url href="http://www.ietf.org/rfc/rfc4252.txt">RFC 4252</url> - + Authentication Protocol</item> + <item><url href="http://www.ietf.org/rfc/rfc4253.txt">RFC 4253</url> - + Transport Layer Protocol</item> + <item><url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url> - + Connection Protocol</item> + <item><url href="http://www.ietf.org/rfc/rfc4255.txt">RFC 4255</url> - + Key Fingerprints</item> + <item><url href="http://www.ietf.org/rfc/rfc4344.txt">RFC 4344</url> - + Transport Layer Encryption Modes</item> + <item><url href="http://www.ietf.org/rfc/rfc4716.txt">RFC 4716</url> - + Public Key File Format</item> + </list> + </section> </chapter> diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 3aa61aa9ec..41885c684c 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -29,6 +29,93 @@ <file>notes.xml</file> </header> +<section><title>Ssh 3.2.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + New option <c>id_string</c> for <c>ssh:daemon</c> and + <c>ssh:connect</c> for limiting banner grabbing attempts.</p> + <p> + The possible values are: <c>{id_string,string()}</c> and + <c>{id_string,random}</c>. The latter will make ssh + generate a random nonsence id-string for each new + connection.</p> + <p> + Own Id: OTP-12659</p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 3.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Ssh crashed if a message was sent on a channel with + packet_size = 0.</p> + <p> + A new option for ssh:daemon is also introduced: + <c>minimal_remote_max_packet_size</c>. This option sets + the least max packet size declaration that the daemon + will accept from a client. The default value is 0 to + maintain compatibility with OpenSSH and the rfc:s.</p> + <p> + Own Id: OTP-12645 Aux Id: seq12816 </p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + If a channel is closed by the peer while using a function + with call semantics in ssh_connection.erl return {error, + closed}. Document that the functions can return {error, + timeout | closed} and not only ssh_request_status()</p> + <p> + Own Id: OTP-12004</p> + </item> + <item> + <p> + Bug that causes ssh:connect to return + <c>{error,int()}</c> instead of <c>{error,timeout}</c> + when ssh handshake takes too long time.</p> + <p> + Own Id: OTP-12369</p> + </item> + <item> + <p> + Documentation corrections. (Thanks to Rabbe Fogelholm)</p> + <p> + Own Id: OTP-12399</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Example of ssh_connection:exec added.</p> + <p> + Own Id: OTP-12558</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 3.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/doc/src/ref_man.xml b/lib/ssh/doc/src/ref_man.xml index 55339298e8..afe3f2ddf9 100644 --- a/lib/ssh/doc/src/ref_man.xml +++ b/lib/ssh/doc/src/ref_man.xml @@ -28,8 +28,8 @@ <file>ref_man.xml</file> </header> <description> - <p>The SSH application is an erlang implementation of the - secure shell protocol (SSH) as defined by RFC 4250 - 4254</p> + <p>The <c>ssh</c> application is an Erlang implementation of the + Secure Shell Protocol (SSH) as defined by RFC 4250 - 4254.</p> </description> <xi:include href="ssh_app.xml"/> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index d481a75c9a..d49d3ac2a7 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -22,54 +22,72 @@ </legalnotice> <title>ssh</title> + <prepared></prepared> + <docno></docno> <date>2007-10-06</date> + <rev></rev> </header> <module>ssh</module> - <modulesummary>Main API of the SSH application</modulesummary> + <modulesummary>Main API of the ssh application</modulesummary> <description> - <p>Interface module for the SSH application. </p> + <p>Interface module for the <c>ssh</c> application.</p> </description> <section> <title>SSH</title> <list type="bulleted"> - <item>SSH requires the crypto and public_key applications.</item> - <item>Supported SSH version is 2.0 </item> - <item>Supported MAC algorithms: hmac-sha2-256 and hmac-sha1</item> - <item>Supported encryption algorithms: aes128-ctr, aes128-cb and 3des-cbc</item> - <item>Supports unicode filenames if the emulator and the underlaying OS supports it. See the DESCRIPTION section in <seealso marker="kernel:file">file</seealso> for information about this subject</item> - <item>Supports unicode in shell and cli</item> + <item>For application dependencies see <seealso marker="SSH_app"> ssh(6)</seealso> </item> + <item>Supported SSH version is 2.0.</item> + <item>Supported MAC algorithms: hmac-sha2-256 and hmac-sha1.</item> + <item>Supported encryption algorithms: aes128-ctr, aes128-cb and 3des-cbc.</item> + <item>Supported key exchange algorithms: diffie-hellman-group1-sha1.</item> + <item>Supports unicode filenames if the emulator and the underlaying OS support it. + See section DESCRIPTION in the + <seealso marker="kernel:file">file</seealso> manual page in <c>kernel</c> + for information about this subject.</item> + <item>Supports unicode in shell and CLI.</item> </list> </section> <section> - <title>DATA TYPES </title> + <title>DATA TYPES</title> <p>Type definitions that are used more than once in - this module and/or abstractions to indicate the intended use of the data - type:</p> - <p><c>boolean() = true | false </c></p> - <p><c>string() = [byte()]</c></p> - <p><c>ssh_daemon_ref() - opaque to the user - returned by ssh:daemon/[1,2,3]</c></p> - <p><c>ssh_connection_ref() - opaque to the user - returned by ssh:connect/3</c></p> - <p><c>ip_address() - inet::ip_address()</c></p> - <p><c>subsystem_spec() = {subsystem_name(), - {channel_callback(), channel_init_args()}} </c></p> - <p><c>subsystem_name() = string() </c></p> - <p><c>channel_callback() = atom() - Name of the erlang module - implementing the subsystem using the ssh_channel behavior see</c> - <seealso marker="ssh_channel">ssh_channel(3)</seealso></p> - <p><c>channel_init_args() = list()</c></p> - </section> + this module, or abstractions to indicate the intended use of the data + type, or both:</p> + <taglist> + <tag><c>boolean()</c></tag> + <item><p>= <c>true | false</c></p></item> + <tag><c>string()</c></tag> + <item><p>= <c>[byte()]</c></p></item> + <tag><c>ssh_daemon_ref()</c></tag> + <item><p>Opaque to the user, + returned by <c>ssh:daemon/[1,2,3]</c></p></item> + <tag><c>ssh_connection_ref()</c></tag> + <item><p>Opaque to the user, + returned by <c>ssh:connect/3</c></p></item> + <tag><c>ip_address()</c></tag> + <item><p><c>inet::ip_address</c></p></item> + <tag><c>subsystem_spec()</c></tag> + <item><p>= <c>{subsystem_name(), + {channel_callback(), channel_init_args()}}</c></p></item> + <tag><c>subsystem_name()</c></tag> + <item><p>= <c>string()</c></p></item> + <tag><c>channel_callback()</c></tag> + <item><p>= <c>atom()</c> - Name of the Erlang module + implementing the subsystem using the <c>ssh_channel</c> behavior, see + <seealso marker="ssh_channel">ssh_channel(3)</seealso></p></item> + <tag><c>channel_init_args()</c></tag> + <item><p>= <c>list()</c></p></item> + </taglist> +</section> <funcs> <func> <name>close(ConnectionRef) -> ok </name> - <fsummary>Closes an SSH connection</fsummary> + <fsummary>Closes an SSH connection.</fsummary> <type> <v>ConnectionRef = ssh_connection_ref()</v> </type> @@ -81,135 +99,151 @@ <name>connect(Host, Port, Options) -> </name> <name>connect(Host, Port, Options, Timeout) -> {ok, ssh_connection_ref()} | {error, Reason}</name> - <fsummary>Connect to an ssh server.</fsummary> + <fsummary>Connects to an SSH server.</fsummary> <type> <v>Host = string()</v> <v>Port = integer()</v> - <d>The default is <c><![CDATA[22]]></c>, the assigned well known port + <d><c><![CDATA[22]]></c> is default, the assigned well-known port number for SSH.</d> <v>Options = [{Option, Value}]</v> - <v>Timeout = infinity | integer(milliseconds)</v> - <d>Negotiation timeout, for connection timeout use the option <c>{connect_timeout, timeout()}</c>.</d> + <v>Timeout = infinity | integer()</v> + <d>Negotiation time-out in milli-seconds. The default value is <c>infinity</c>. + For connection time-out, use option <c>{connect_timeout, timeout()}</c>.</d> </type> <desc> <p>Connects to an SSH server. No channel is started. This is done by calling - <seealso marker="ssh_connection#session_channel/2">ssh_connection:session_channel/[2, 4]</seealso>.</p> - <p>Options are:</p> + <seealso marker="ssh_connection#session_channel/2"> + ssh_connection:session_channel/[2, 4]</seealso>.</p> + <p>Options:</p> <taglist> <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag> - <item> IP version to use.</item> + <item> + <p>IP version to use.</p> + </item> <tag><c><![CDATA[{user_dir, string()}]]></c></tag> <item> - <p>Sets the user directory i.e. the directory containing - ssh configuration files for the user such as + <p>Sets the user directory, that is, the directory containing + <c>ssh</c> configuration files for the user, such as <c><![CDATA[known_hosts]]></c>, <c><![CDATA[id_rsa, - id_dsa]]></c> and + id_dsa]]></c>, and <c><![CDATA[authorized_key]]></c>. Defaults to the directory normally referred to as - <c><![CDATA[~/.ssh]]></c> </p> + <c><![CDATA[~/.ssh]]></c>.</p> </item> <tag><c><![CDATA[{dsa_pass_phrase, string()}]]></c></tag> <item> - <p>If the user dsa key is protected by a passphrase it can be + <p>If the user DSA key is protected by a passphrase, it can be supplied with this option. </p> </item> <tag><c><![CDATA[{rsa_pass_phrase, string()}]]></c></tag> <item> - <p>If the user rsa key is protected by a passphrase it can be + <p>If the user RSA key is protected by a passphrase, it can be supplied with this option. </p> </item> <tag><c><![CDATA[{silently_accept_hosts, boolean()}]]></c></tag> <item> - <p>When true hosts are added to the + <p>When <c>true</c>, hosts are added to the file <c><![CDATA[known_hosts]]></c> without asking the user. - Defaults to false. + Defaults to <c>false</c>. </p> </item> <tag><c><![CDATA[{user_interaction, boolean()}]]></c></tag> <item> - <p>If false disables the client to connect to the server - if any user interaction is needed such as accepting that - the server will be added to the <c>known_hosts</c> file or - supplying a password. Defaults to true. + <p>If <c>false</c>, disables the client to connect to the server + if any user interaction is needed, such as accepting + the server to be added to the <c>known_hosts</c> file, or + supplying a password. Defaults to <c>true</c>. Even if user interaction is allowed it can be - suppressed by other options such as silently_accept_hosts and - password. Do note that it may not always be desirable to use - those options from a security point of view.</p> + suppressed by other options, such as <c>silently_accept_hosts</c> + and <c>password</c>. However, those optins are not always desirable + to use from a security point of view.</p> </item> <tag><c><![CDATA[{public_key_alg, 'ssh-rsa' | 'ssh-dss'}]]></c></tag> <item> <p>Sets the preferred public key algorithm to use for user - authentication. If the the preferred algorithm fails for - some reason, the other algorithm is tried. The default is + authentication. If the preferred algorithm fails, + the other algorithm is tried. The default is to try <c><![CDATA['ssh-rsa']]></c> first.</p> </item> <tag><c><![CDATA[{pref_public_key_algs, list()}]]></c></tag> <item> - <p>List of public key algorithms to try to use, 'ssh-rsa' and 'ssh-dss' available. - Will override <c><![CDATA[{public_key_alg, 'ssh-rsa' | 'ssh-dss'}]]></c></p> + <p>List of public key algorithms to try to use. + <c>'ssh-rsa'</c> and <c>'ssh-dss'</c> are available. + Overrides <c><![CDATA[{public_key_alg, 'ssh-rsa' | 'ssh-dss'}]]></c></p> </item> <tag><c><![CDATA[{connect_timeout, timeout()}]]></c></tag> <item> - <p>Sets a timeout on the transport layer - connection. Defaults to <c>infinity</c>.</p> + <p>Sets a time-out on the transport layer + connection. For <c>gen_tcp</c> the time is in milli-seconds and the default value is + <c>infinity</c>.</p> </item> <tag><c><![CDATA[{user, string()}]]></c></tag> <item> - <p>Provides a user name. If this option is not given, ssh + <p>Provides a username. If this option is not given, <c>ssh</c> reads from the environment (<c><![CDATA[LOGNAME]]></c> or - <c><![CDATA[USER]]></c> on unix, + <c><![CDATA[USER]]></c> on UNIX, <c><![CDATA[USERNAME]]></c> on Windows).</p> </item> <tag><c><![CDATA[{password, string()}]]></c></tag> <item> - <p>Provide a password for password authentication. If - this option is not given, the user will be asked for a - password if the password authentication method is + <p>Provides a password for password authentication. + If this option is not given, the user is asked for a + password, if the password authentication method is attempted.</p> </item> <tag><c><![CDATA[{key_cb, atom()}]]></c></tag> <item> - <p>Module implementing the behaviour <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso>. + <p>Module implementing the behaviour + <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso>. Can be used to customize the handling of public keys. </p> </item> <tag><c><![CDATA[{quiet_mode, atom() = boolean()}]]></c></tag> <item> - <p>If true, the client will not print out anything on authorization.</p> + <p>If <c>true</c>, the client does not print anything on authorization.</p> </item> + + <tag><c><![CDATA[{id_string, random | string()}]]></c></tag> + <item> + <p>The string that the client presents to a connected server initially. The default value is "Erlang/VSN" where VSN is the ssh application version number. + </p> + <p>The value <c>random</c> will cause a random string to be created at each connection attempt. This is to make it a bit more difficult for a malicious peer to find the ssh software brand and version. + </p> + </item> + <tag><c><![CDATA[{fd, file_descriptor()}]]></c></tag> <item> - <p>Allow an existing file descriptor to be used - (simply passed on to the transport protocol).</p></item> + <p>Allows an existing file descriptor to be used + (by passing it on to the transport protocol).</p></item> <tag><c><![CDATA[{rekey_limit, integer()}]]></c></tag> <item> - <p>Provide, in bytes, when rekeying should be initiated, - defaults to one time each GB and one time per hour.</p> + <p>Provides, in bytes, when rekeying is to be initiated. + Defaults to once per each GB and once per hour.</p> </item> <tag><c><![CDATA[{idle_time, integer()}]]></c></tag> <item> - <p>Sets a timeout on connection when no channels are active, default is infinity</p></item> + <p>Sets a time-out on a connection when no channels are active. + Defaults to <c>infinity</c>.</p></item> </taglist> </desc> </func> <func> <name>connection_info(ConnectionRef, [Option]) ->[{Option, - Value}] </name> - <fsummary> Retrieves information about a connection. </fsummary> + Value}]</name> + <fsummary>Retrieves information about a connection.</fsummary> <type> <v>Option = client_version | server_version | user | peer | sockname </v> <v>Value = [option_value()] </v> - <v>option_value() = {{Major::integer(), Minor::integer()}, VersionString::string()} | User::string() | - Peer::{inet:hostname(), {inet::ip_adress(), inet::port_number()}} | - Sockname::{inet::ip_adress(), inet::port_number()} () </v> + <v>option_value() = {{Major::integer(), Minor::integer()}, VersionString::string()} | + User::string() | Peer::{inet:hostname(), {inet::ip_adress(), inet::port_number()}} | + Sockname::{inet::ip_adress(), inet::port_number()}</v> </type> <desc> - <p> Retrieves information about a connection. - </p> + <p>Retrieves information about a connection.</p> </desc> </func> @@ -230,135 +264,168 @@ <desc> <p>Starts a server listening for SSH connections on the given port.</p> - <p>Options are:</p> + <p>Options:</p> <taglist> <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag> - <item> IP version to use when the host address is specified as <c>any</c>. </item> + <item><p>IP version to use when the host address is specified as <c>any</c>.</p></item> <tag><c><![CDATA[{subsystems, [subsystem_spec()]}]]></c></tag> <item> - Provides specifications for handling of subsystems. The - "sftp" subsystem spec can be retrieved by calling - ssh_sftpd:subsystem_spec/1. If the subsystems option is - not present the value of - <c>[ssh_sftpd:subsystem_spec([])]</c> will be used. It is - of course possible to set the option to the empty list if - you do not want the daemon to run any subsystems at all. + <p>Provides specifications for handling of subsystems. The + "sftp" subsystem specification is retrieved by calling + <c>ssh_sftpd:subsystem_spec/1</c>. If the subsystems option is + not present, the value of + <c>[ssh_sftpd:subsystem_spec([])]</c> is used. + The option can be set to the empty list if + you do not want the daemon to run any subsystems.</p> </item> <tag><c><![CDATA[{shell, {Module, Function, Args} | fun(string() = User) - > pid() | fun(string() = User, ip_address() = PeerAddr) -> pid()}]]></c></tag> <item> - Defines the read-eval-print loop used when a shell is - requested by the client. Default is to use the erlang shell: - <c><![CDATA[{shell, start, []}]]></c> + <p>Defines the read-eval-print loop used when a shell is + requested by the client. The default is to use the Erlang shell: + <c><![CDATA[{shell, start, []}]]></c></p> </item> <tag><c><![CDATA[{ssh_cli, {channel_callback(), channel_init_args()} | no_cli}]]></c></tag> <item> - Provides your own CLI implementation, i.e. a channel callback - module that implements a shell and command execution. Note - that you may customize the shell read-eval-print loop using the - option <c>shell</c> which is much less work than implementing - your own CLI channel. If set to <c>no_cli</c> you will disable - CLI channels and only subsystem channels will be allowed. + <p>Provides your own CLI implementation, that is, a channel callback + module that implements a shell and command execution. The shell + read-eval-print loop can be customized, using the + option <c>shell</c>. This means less work than implementing + an own CLI channel. If set to <c>no_cli</c>, the CLI channels + are disabled and only subsystem channels are allowed.</p> </item> <tag><c><![CDATA[{user_dir, String}]]></c></tag> <item> - <p>Sets the user directory i.e. the directory containing - ssh configuration files for the user such as + <p>Sets the user directory. That is, the directory containing + <c>ssh</c> configuration files for the user, such as <c><![CDATA[known_hosts]]></c>, <c><![CDATA[id_rsa, - id_dsa]]></c> and + id_dsa]]></c>, and <c><![CDATA[authorized_key]]></c>. Defaults to the directory normally referred to as - <c><![CDATA[~/.ssh]]></c> </p> + <c><![CDATA[~/.ssh]]></c>.</p> </item> <tag><c><![CDATA[{system_dir, string()}]]></c></tag> <item> <p>Sets the system directory, containing the host key files - that identifies the host keys for ssh. The default is - <c><![CDATA[/etc/ssh]]></c>, note that for security reasons - this directory is normally only accessible by the root user.</p> + that identify the host keys for <c>ssh</c>. Defaults to + <c><![CDATA[/etc/ssh]]></c>. For security reasons, + this directory is normally accessible only to the root user.</p> </item> <tag><c><![CDATA[{auth_methods, string()}]]></c></tag> <item> - <p>Comma separated string that determines which - authentication methodes that the server should support and - in what order they will be tried. Defaults to + <p>Comma-separated string that determines which + authentication methods that the server is to support and + in what order they are tried. Defaults to <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p> </item> <tag><c><![CDATA[{user_passwords, [{string() = User, string() = Password}]}]]></c></tag> <item> - <p>Provide passwords for password authentication.They will - be used when someone tries to connect to the server and - public key user authentication fails. The option provides - a list of valid user names and the corresponding password. + <p>Provides passwords for password authentication. The passwords + are used when someone tries to connect to the server and + public key user-authentication fails. The option provides + a list of valid usernames and the corresponding passwords. </p> </item> <tag><c><![CDATA[{password, string()}]]></c></tag> <item> - <p>Provide a global password that will authenticate any + <p>Provides a global password that authenticates any user. From a security perspective this option makes the server very vulnerable.</p> </item> <tag><c><![CDATA[{pwdfun, fun(User::string(), password::string()) -> boolean()}]]></c></tag> <item> - <p>Provide a function for password validation. This is called - with user and password as strings, and should return + <p>Provides a function for password validation. This function is called + with user and password as strings, and returns <c><![CDATA[true]]></c> if the password is valid and <c><![CDATA[false]]></c> otherwise.</p> </item> <tag><c><![CDATA[{negotiation_timeout, integer()}]]></c></tag> <item> - <p>Max time in milliseconds for the authentication negotiation. The default value is 2 minutes. If the client fails to login within this time, the connection is closed. + <p>Maximum time in milliseconds for the authentication negotiation. + Defaults to 120000 (2 minutes). If the client fails to log in within this time, + the connection is closed. </p> </item> <tag><c><![CDATA[{max_sessions, pos_integer()}]]></c></tag> <item> - <p>The maximum number of simultaneous sessions that are accepted at any time for this daemon. This includes sessions that are being authorized. So if set to <c>N</c>, and <c>N</c> clients have connected but not started the login process, the <c>N+1</c> connection attempt will be aborted. If <c>N</c> connections are authenticated and still logged in, no more loggins will be accepted until one of the existing ones log out. + <p>The maximum number of simultaneous sessions that are accepted at any time + for this daemon. This includes sessions that are being authorized. + Thus, if set to <c>N</c>, and <c>N</c> clients have connected but not started + the login process, connection attempt <c>N+1</c> is aborted. + If <c>N</c> connections are authenticated and still logged in, no more logins + are accepted until one of the existing ones log out. </p> - <p>The counter is per listening port, so if two daemons are started, one with <c>{max_sessions,N}</c> and the other with <c>{max_sessions,M}</c> there will be in total <c>N+M</c> connections accepted for the whole ssh application. + <p>The counter is per listening port. Thus, if two daemons are started, one with + <c>{max_sessions,N}</c> and the other with <c>{max_sessions,M}</c>, in total + <c>N+M</c> connections are accepted for the whole <c>ssh</c> application. </p> - <p>Note that if <c>parallel_login</c> is <c>false</c>, only one client at a time may be in the authentication phase. + <p>Notice that if <c>parallel_login</c> is <c>false</c>, only one client + at a time can be in the authentication phase. </p> - <p>As default, the option is not set. This means that the number is not limited. + <p>By default, this option is not set. This means that the number is not limited. </p> </item> <tag><c><![CDATA[{parallel_login, boolean()}]]></c></tag> <item> - <p>If set to false (the default value), only one login is handled a time. If set to true, an unlimited number of login attempts will be allowed simultanously. + <p>If set to false (the default value), only one login is handled at a time. + If set to true, an unlimited number of login attempts are allowed simultaneously. </p> - <p>If the <c>max_sessions</c> option is set to <c>N</c> and <c>parallel_login</c> is set to <c>true</c>, the max number of simultaneous login attempts at any time is limited to <c>N-K</c> where <c>K</c> is the number of authenticated connections present at this daemon. + <p>If the <c>max_sessions</c> option is set to <c>N</c> and <c>parallel_login</c> + is set to <c>true</c>, the maximum number of simultaneous login attempts at any time is + limited to <c>N-K</c>, where <c>K</c> is the number of authenticated connections present + at this daemon. </p> <warning> - <p>Do not enable <c>parallel_logins</c> without protecting the server by other means, for example the <c>max_sessions</c> option or a firewall configuration. If set to <c>true</c>, there is no protection against DOS attacks.</p> + <p>Do not enable <c>parallel_logins</c> without protecting the server by other means, + for example, by the <c>max_sessions</c> option or a firewall configuration. If set to + <c>true</c>, there is no protection against DOS attacks.</p> </warning> </item> + <tag><c><![CDATA[{minimal_remote_max_packet_size, non_negative_integer()}]]></c></tag> + <item> + <p>The least maximum packet size that the daemon will accept in channel open requests from the client. The default value is 0. + </p> + </item> + + <tag><c><![CDATA[{id_string, random | string()}]]></c></tag> + <item> + <p>The string the daemon will present to a connecting peer initially. The default value is "Erlang/VSN" where VSN is the ssh application version number. + </p> + <p>The value <c>random</c> will cause a random string to be created at each connection attempt. This is to make it a bit more difficult for a malicious peer to find the ssh software brand and version. + </p> + </item> + <tag><c><![CDATA[{key_cb, atom()}]]></c></tag> <item> - <p>Module implementing the behaviour <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>. + <p>Module implementing the behaviour + <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>. Can be used to customize the handling of public keys. </p> </item> <tag><c><![CDATA[{fd, file_descriptor()}]]></c></tag> <item> - <p>Allow an existing file-descriptor to be used - (simply passed on to the transport protocol).</p></item> - <tag><c><![CDATA[{failfun, fun(User::string(), PeerAddress::ip_address(), Reason::term()) -> _}]]></c></tag> + <p>Allows an existing file-descriptor to be used + (passed on to the transport protocol).</p></item> + <tag><c><![CDATA[{failfun, fun(User::string(), + PeerAddress::ip_address(), Reason::term()) -> _}]]></c></tag> <item> - <p>Provide a fun to implement your own logging when a user fails to authenticate.</p> + <p>Provides a fun to implement your own logging when a user fails to authenticate.</p> </item> - <tag><c><![CDATA[{connectfun, fun(User::string(), PeerAddress::ip_address(), Method::string()) ->_}]]></c></tag> + <tag><c><![CDATA[{connectfun, fun(User::string(), PeerAddress::ip_address(), + Method::string()) ->_}]]></c></tag> <item> - <p>Provide a fun to implement your own logging when a user authenticates to the server.</p> + <p>Provides a fun to implement your own logging when a user authenticates to the server.</p> </item> <tag><c><![CDATA[{disconnectfun, fun(Reason:term()) -> _}]]></c></tag> <item> - <p>Provide a fun to implement your own logging when a user disconnects from the server.</p> + <p>Provides a fun to implement your own logging when a user disconnects from the server.</p> </item> </taglist> </desc> @@ -369,16 +436,16 @@ <name>shell(Host) -> </name> <name>shell(Host, Option) -> </name> <name>shell(Host, Port, Option) -> _</name> - <fsummary> </fsummary> + <fsummary>Starts an interactive shell over an SSH server.</fsummary> <type> - <v> Host = string()</v> - <v> Port = integer()</v> - <v> Options - see ssh:connect/3</v> + <v>Host = string()</v> + <v>Port = integer()</v> + <v>Options - see ssh:connect/3</v> </type> <desc> - <p>Starts an interactive shell via an SSH server on the + <p>Starts an interactive shell over an SSH server on the given <c>Host</c>. The function waits for user input, - and will not return until the remote shell is ended (i.e. + and does not return until the remote shell is ended (that is, exit from the shell). </p> </desc> @@ -387,28 +454,29 @@ <func> <name>start() -> </name> <name>start(Type) -> ok | {error, Reason}</name> - <fsummary>Starts the SSH application. </fsummary> + <fsummary>Starts the SSH application.</fsummary> <type> <v>Type = permanent | transient | temporary</v> <v>Reason = term() </v> </type> <desc> - <p>Utility function that starts crypto, public_key and the SSH - application. Defult type is temporary. - See also <seealso marker="kernel:application">application(3)</seealso> - </p> + <p>Utility function that starts the applications <c>crypto</c>, <c>public_key</c>, + and <c>ssh</c>. Default type is <c>temporary</c>. + For more information, see the <seealso marker="kernel:application">application(3)</seealso> + manual page in <c>kernel</c>.</p> </desc> </func> <func> <name>stop() -> ok | {error, Reason}</name> - <fsummary>Stops the SSH application.</fsummary> + <fsummary>Stops the <c>ssh</c> application.</fsummary> <type> <v>Reason = term()</v> </type> <desc> - <p>Stops the SSH application. See also - <seealso marker="kernel:application">application(3)</seealso></p> + <p>Stops the <c>ssh</c> application. + For more information, see the <seealso marker="kernel:application">application(3)</seealso> + manual page in <c>kernel</c>.</p> </desc> </func> @@ -432,7 +500,7 @@ <name>stop_listener(DaemonRef) -> </name> <name>stop_listener(Address, Port) -> ok </name> <fsummary>Stops the listener, but leaves existing connections started - by the listener up and running.</fsummary> + by the listener operational.</fsummary> <type> <v>DaemonRef = ssh_daemon_ref()</v> <v>Address = ip_address()</v> @@ -440,7 +508,7 @@ </type> <desc> <p>Stops the listener, but leaves existing connections started - by the listener up and running.</p> + by the listener operational.</p> </desc> </func> diff --git a/lib/ssh/doc/src/ssh_app.xml b/lib/ssh/doc/src/ssh_app.xml index a1d2402790..1dfe68b17d 100644 --- a/lib/ssh/doc/src/ssh_app.xml +++ b/lib/ssh/doc/src/ssh_app.xml @@ -18,83 +18,103 @@ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - </legalnotice> <title>SSH</title> + <prepared></prepared> + <docno></docno> + <checked></checked> + <date></date> + <rev></rev> <file>ssh_app.xml</file> </header> <app>SSH</app> - <appsummary>The ssh application implements the SSH (Secure Shell) protocol and - provides an SFTP (SSH File Transfer Protocol) client and server. </appsummary> + <appsummary>The ssh application implements the Secure Shell (SSH) protocol and + provides an SSH File Transfer Protocol (SFTP) client and server.</appsummary> + <description> + <p>The <c>ssh</c> application is an implementation of the SSH protocol in Erlang. + <c>ssh</c> offers API functions to write customized SSH clients and servers as well as + making the Erlang shell available over SSH. An SFTP client, <c>ssh_sftp</c>, and server, + <c>ssh_sftpd</c>, are also included.</p> + </description> - <section> + <section> <title>DEPENDENCIES</title> - <p>The ssh application uses the Erlang applications public_key and - crypto to handle public keys and encryption, hence these - applications needs to be loaded for the ssh application to work. In - an embedded environment that means they need to be started with - application:start/[1,2] before the ssh application is started. + <p>The <c>ssh</c> application uses the applications <c>public_key</c> and + <c>crypto</c> to handle public keys and encryption. Hence, these + applications must be loaded for the <c>ssh</c> application to work. In + an embedded environment this means that they must be started with + <c>application:start/[1,2]</c> before the <c>ssh</c> application is started. </p> </section> <section> <title>CONFIGURATION</title> - <p>The ssh application does not currently have an application - specific configuration file as described in application(3), - however it will by default use the following configuration files - from openssh: known_hosts, authorized_keys, authorized_keys2, - id_dsa and id_rsa, ssh_host_dsa_key and ssh_host_rsa_key. By - default Erlang SSH will look for id_dsa, id_rsa, known_hosts - and authorized_keys in ~/.ssh, and the host key files in /etc/ssh - . These locations may be changed by the options user_dir and - system_dir. Public key handling may also be customized by - providing a callback module implementing the behaviors - <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> and - <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>. - </p> + <p>The <c>ssh</c> application does not have an application- + specific configuration file, as described in <seealso marker="kernel:application">application(3)</seealso>. + However, by default it use the following configuration files + from OpenSSH:</p> + <list type="bulleted"> + <item><c>known_hosts</c></item> + <item><c>authorized_keys</c></item> + <item><c>authorized_keys2</c></item> + <item><c>id_dsa</c></item> + <item><c>id_rsa</c></item> + <item><c>ssh_host_dsa_key</c></item> + <item><c>ssh_host_rsa_key</c></item> + </list> + <p>By default, <c>ssh</c> looks for <c>id_dsa</c>, <c>id_rsa</c>, + <c>known_hosts</c>, and <c>authorized_keys</c> in ~/.ssh, + and for the host key files in <c>/etc/ssh</c>. These locations can be changed + by the options <c>user_dir</c> and <c>system_dir</c>. + </p> + <p>Public key handling can also be customized through a callback module that + implements the behaviors + <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> and + <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>. + </p> - <section> - <title>PUBLIC KEYS</title> - <p> - id_dsa and id_rsa are the users private key files, note that - the public key is part of the private key so the ssh - application will not use the id_<*>.pub files. These are - for the users convenience when he/she needs to convey their + </section> + <section> + <title>Public Keys</title> + <p><c>id_dsa</c> and <c>id_rsa</c> are the users private key files. + Notice that the public key is part of the private key so the <c>ssh</c> + application does not use the <c>id_<*>.pub</c> files. These are + for the user's convenience when it is needed to convey the user's public key. </p> - </section> - - <section> - <title>KNOW HOSTS</title> - <p>The known_hosts file contains a list of approved servers and - their public keys. Once a server is listed, it can be verified + </section> + <section> + <title>Known Hosts</title> + <p>The <c>known_hosts</c> file contains a list of approved servers and + their public keys. Once a server is listed, it can be verified without user interaction. </p> - </section> - - <section> - <title>AUTHORIZED KEYS</title> - <p>The authorized key file keeps track of the user's authorized + </section> + <section> + <title>Authorized Keys</title> + <p>The <c>authorized_key</c> file keeps track of the user's authorized public keys. The most common use of this file is to let users - log in without entering their password which is supported by the - Erlang SSH daemon. + log in without entering their password, which is supported by the + Erlang <c>ssh</c> daemon. </p> - </section> - - <section> - <title>HOST KEYS</title> - <p>Currently rsa and dsa host keys are supported and are - expected to be found in files named ssh_host_rsa_key and - ssh_host_dsa_key. + </section> + <section> + <title>Host Keys</title> + <p>RSA and DSA host keys are supported and are + expected to be found in files named <c>ssh_host_rsa_key</c> and + <c>ssh_host_dsa_key</c>. </p> - </section> + </section> + <section> + <title>ERROR LOGGER AND EVENT HANDLERS</title> + <p>The <c>ssh</c> application uses the default <seealso marker="kernel:error_logger">OTP error logger</seealso> to log unexpected errors or print information about special events.</p> </section> <section> <title>SEE ALSO</title> - <p>application(3)</p> + <p><seealso marker="kernel:application">application(3)</seealso></p> </section> </appref> diff --git a/lib/ssh/doc/src/ssh_channel.xml b/lib/ssh/doc/src/ssh_channel.xml index a52a6a115e..b8a03c350a 100644 --- a/lib/ssh/doc/src/ssh_channel.xml +++ b/lib/ssh/doc/src/ssh_channel.xml @@ -23,69 +23,84 @@ The Initial Developer of the Original Code is Ericsson AB. </legalnotice> <title>ssh_channel</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> </header> <module>ssh_channel</module> <modulesummary>-behaviour(ssh_channel). </modulesummary> <description> <p>SSH services (clients and servers) are implemented as channels - that are multiplexed over an SSH connection and communicates via + that are multiplexed over an SSH connection and communicates over the <url href="http://www.ietf.org/rfc/rfc4254.txt"> SSH Connection Protocol</url>. This module provides a callback API - that takes care of generic channel aspects such as flow control - and close messages and lets the callback functions take care of + that takes care of generic channel aspects, such as flow control + and close messages. It lets the callback functions take care of the service (application) specific parts. This behavior also ensures that the channel process honors the principal of an OTP-process so that it can be part of a supervisor tree. This is a requirement of channel processes implementing a subsystem that will be added to - the SSH applications supervisor tree. + the <c>ssh</c> applications supervisor tree. </p> - <note> <p>When implementing a SSH subsystem use the - <c>-behaviour(ssh_daemon_channel).</c> instead of <c>-behaviour(ssh_channel).</c> - as the only relevant callback functions for subsystems are - init/1, handle_ssh_msg/2, handle_msg/2 and terminate/2, so the ssh_daemon_channel - behaviour is limited version of the ssh_channel behaviour. - </p> </note> + <note><p>When implementing an <c>ssh</c> subsystem, use + <c>-behaviour(ssh_daemon_channel)</c> instead of <c>-behaviour(ssh_channel)</c>. + The reason is that the only relevant callback functions for subsystems are + <c>init/1</c>, <c>handle_ssh_msg/2</c>, <c>handle_msg/2</c>, and <c>terminate/2</c>. + So, the <c>ssh_daemon_channel</c> behaviour is a limited version of the + <c>ssh_channel</c> behaviour. + </p></note> </description> <section> - <title>DATA TYPES </title> + <title>DATA TYPES</title> - <p>Type definitions that are used more than once in this module - and/or abstractions to indicate the intended use of the data - type:</p> + <p>Type definitions that are used more than once in this module, + or abstractions to indicate the intended use of the data + type, or both:</p> - <p><c>boolean() = true | false </c></p> - <p><c>string() = list of ASCII characters</c></p> - <p><c>timeout() = infinity | integer() - in milliseconds.</c></p> - <p><c>ssh_connection_ref() - opaque to the user returned by - ssh:connect/3 or sent to an SSH channel process</c></p> - <p><c>ssh_channel_id() = integer() </c></p> - <p><c>ssh_data_type_code() = 1 ("stderr") | 0 ("normal") are - currently valid values see <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254 </url> section 5.2.</c></p> + <taglist> + <tag><c>boolean()</c></tag> + <item><p>= <c>true | false</c></p></item> + <tag><c>string()</c></tag> + <item><p>= list of ASCII characters</p></item> + <tag><c>timeout()</c></tag> + <item><p>= <c>infinity | integer()</c> in milliseconds</p></item> + <tag><c>ssh_connection_ref()</c></tag> + <item><p>Opaque to the user, returned by + <c>ssh:connect/3</c> or sent to an SSH channel process</p></item> + <tag><c>ssh_channel_id()</c></tag> + <item><p>= <c>integer()</c></p></item> + <tag><c>ssh_data_type_code()</c></tag> + <item><p>= <c>1</c> ("stderr") | <c>0</c> ("normal") are + the valid values, + see <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url> + Section 5.2</p></item> + </taglist> </section> <funcs> <func> <name>call(ChannelRef, Msg) -></name> <name>call(ChannelRef, Msg, Timeout) -> Reply | {error, Reason}</name> - <fsummary> Makes a synchronous call to a channel.</fsummary> + <fsummary>Makes a synchronous call to a channel.</fsummary> <type> <v>ChannelRef = pid() </v> - <d>As returned by start_link/4 </d> - <v>Msg = term() </v> - <v>Timeout = timeout() </v> - <v>Reply = term() </v> - <v>Reason = closed | timeout </v> + <d>As returned by <seealso marker = "#start_link-4">ssh_channel:start_link/4</seealso></d> + <v>Msg = term()</v> + <v>Timeout = timeout()</v> + <v>Reply = term()</v> + <v>Reason = closed | timeout</v> </type> <desc> <p>Makes a synchronous call to the channel process by sending - a message and waiting until a reply arrives or a timeout - occurs. The channel will call <seealso marker = + a message and waiting until a reply arrives, or a time-out + occurs. The channel calls <seealso marker = "#Module:handle_call-3">Module:handle_call/3</seealso> - to handle the message. If the channel process does not exist + to handle the message. If the channel process does not exist, <c>{error, closed}</c> is returned. </p> </desc> @@ -96,14 +111,14 @@ <fsummary>Sends an asynchronous message to the channel ChannelRef and returns ok.</fsummary> <type> - <v>ChannelRef = pid() </v> - <d>As returned by start_link/4 </d> - <v>Msg = term() </v> + <v>ChannelRef = pid()</v> + <d>As returned by <seealso marker = "#start_link-4">ssh_channel:start_link/4</seealso></d> + <v>Msg = term()</v> </type> <desc> <p>Sends an asynchronous message to the channel process and returns ok immediately, ignoring if the destination node or - channel process does not exist. The channel will call + channel process does not exist. The channel calls <seealso marker = "#Module:handle_cast-2">Module:handle_cast/2</seealso> to handle the message. </p> @@ -112,31 +127,32 @@ <func> <name>enter_loop(State) -> _ </name> - <fsummary> Makes an existing process an ssh_channel process. </fsummary> + <fsummary>Makes an existing process an ssh_channel process.</fsummary> <type> - <v> State = term() - as returned by <seealso marker = "#init-1">ssh_channel:init/1</seealso></v> + <v>State = term()</v> + <d>as returned by <seealso marker = "#init-1">ssh_channel:init/1</seealso></d> </type> <desc> - <p> Makes an existing process an <c>ssh_channel</c> - process. Does not return, instead the calling process will - enter the <c>ssh_channel</c> process receive loop and become an - <c>ssh_channel process.</c> The process must have been started using - one of the start functions in proc_lib, see <seealso - marker="stdlib:proc_lib">proc_lib(3)</seealso>. The - user is responsible for any initialization of the process - and needs to call <seealso marker = "#init-1">ssh_channel:init/1</seealso> + <p>Makes an existing process an <c>ssh_channel</c> + process. Does not return, instead the calling process + enters the <c>ssh_channel</c> process receive loop and become an + <c>ssh_channel process</c>. The process must have been started using + one of the start functions in <c>proc_lib</c>, see the <seealso + marker="stdlib:proc_lib">proc_lib(3)</seealso> manual page in <c>stdlib</c>. + The user is responsible for any initialization of the process + and must call <seealso marker = "#init-1">ssh_channel:init/1</seealso>. </p> </desc> </func> <func> <name>init(Options) -> {ok, State} | {ok, State, Timeout} | {stop, Reason} </name> - <fsummary> Initiates a ssh_channel process.</fsummary> + <fsummary>Initiates an <c>ssh_channel</c> process.</fsummary> <type> <v>Options = [{Option, Value}]</v> <v>State = term()</v> - <v>Timeout = timeout() </v> - <v>Reason = term() </v> + <v>Timeout = timeout()</v> + <v>Reason = term()</v> </type> <desc> <p> @@ -144,48 +160,47 @@ </p> <taglist> <tag><c><![CDATA[{channel_cb, atom()}]]></c></tag> - <item>The module that implements the channel behaviour.</item> + <item><p>The module that implements the channel behaviour.</p></item> <tag><c><![CDATA[{init_args(), list()}]]></c></tag> - <item> The list of arguments to the callback module's - init function.</item> + <item><p>The list of arguments to the <c>init</c> function of the callback module.</p></item> <tag><c><![CDATA[{cm, connection_ref()}]]></c></tag> - <item> Reference to the ssh connection as returned by <seealso - marker="ssh#connect-3">ssh:connect/3</seealso></item> + <item><p>Reference to the <c>ssh</c> connection as returned by <seealso + marker="ssh#connect-3">ssh:connect/3</seealso></p></item> <tag><c><![CDATA[{channel_id, channel_id()}]]></c></tag> - <item> Id of the SSH channel.</item> + <item><p>Id of the <c>ssh</c> channel.</p></item> </taglist> <note><p>This function is normally not called by the - user. The user only needs to call if for some reason the + user. The user only needs to call if the channel process needs to be started with help of <c>proc_lib</c> instead of calling <c>ssh_channel:start/4</c> or - <c>ssh_channel:start_link/4</c> </p> + <c>ssh_channel:start_link/4</c>.</p> </note> </desc> </func> <func> <name>reply(Client, Reply) -> _</name> - <fsummary>Send a reply to a client.</fsummary> + <fsummary>Sends a reply to a client.</fsummary> <type> - <v>Client - opaque to the user, see explanation below</v> + <v>Client = opaque()</v> <v>Reply = term()</v> </type> <desc> - <p>This function can be used by a channel to explicitly send a + <p>This function can be used by a channel to send a reply to a client that called <c>call/[2,3]</c> when the reply cannot be defined in the return value of <seealso marker ="#Module:handle_call-3">Module:handle_call/3</seealso>.</p> <p><c>Client</c> must be the <c>From</c> argument provided to the callback function <c>handle_call/3</c>. <c>Reply</c> is an arbitrary term, - which will be given back to the client as the return value of - <seealso marker="#call-2">ssh_channel:call/[2,3].</seealso>></p> + which is given back to the client as the return value of + <seealso marker="#call-2">ssh_channel:call/[2,3].</seealso></p> </desc> </func> @@ -193,24 +208,25 @@ <name>start(SshConnection, ChannelId, ChannelCb, CbInitArgs) -> </name> <name>start_link(SshConnection, ChannelId, ChannelCb, CbInitArgs) -> {ok, ChannelRef} | {error, Reason}</name> - <fsummary> Starts a processes that handles a SSH channel. </fsummary> + <fsummary>Starts a process that handles an SSH channel.</fsummary> <type> <v>SshConnection = ssh_connection_ref()</v> - <v>ChannelId = ssh_channel_id() </v> - <d> As returned by cannot be defined in the return value of - <seealso marker ="ssh_connection#session_channel/2">ssh_connection:session_channel/[2,4]</seealso></d> + <v>ChannelId = ssh_channel_id()</v> + <d>As returned by + <seealso marker ="ssh_connection#session_channel/2"> + ssh_connection:session_channel/[2,4]</seealso>.</d> <v>ChannelCb = atom()</v> - <d> The name of the module implementing the service specific parts + <d>Name of the module implementing the service-specific parts of the channel.</d> <v>CbInitArgs = [term()]</v> - <d>Argument list for the init function in the callback module. </d> + <d>Argument list for the <c>init</c> function in the callback module.</d> <v>ChannelRef = pid()</v> </type> <desc> - <p>Starts a processes that handles an SSH channel. It will be - called internally by the SSH daemon or explicitly by the SSH - client implementations. The behavior will set the - <c>trap_exit</c> flag to true. + <p>Starts a process that handles an SSH channel. It is + called internally, by the <c>ssh</c> daemon, or explicitly by the <c>ssh</c> + client implementations. The behavior sets the + <c>trap_exit</c> flag to <c>true</c>. </p> </desc> </func> @@ -219,19 +235,19 @@ <section> <marker id="cb_timeouts"></marker> - <title> CALLBACK TIMEOUTS</title> + <title>CALLBACK TIME-OUTS</title> - <p>The timeout values that may be returned by the callback functions - has the same semantics as in a <seealso marker="stdlib:gen_server">gen_server</seealso> - If the timeout occurs <seealso marker="#Module:handle_msg-2">handle_msg/2</seealso> - will be called as <c>handle_msg(timeout, State). </c></p> + <p>The time-out values that can be returned by the callback functions + have the same semantics as in a <seealso marker="stdlib:gen_server">gen_server</seealso>. + If the time-out occurs, <seealso marker="#Module:handle_msg-2">handle_msg/2</seealso> + is called as <c>handle_msg(timeout, State)</c>.</p> </section> <funcs> <func> <name>Module:code_change(OldVsn, State, Extra) -> {ok, NewState}</name> - <fsummary> Converts process state when code is changed.</fsummary> + <fsummary>Converts process state when code is changed.</fsummary> <type> <v>OldVsn = term()</v> <d>In the case of an upgrade, <c>OldVsn</c> is <c>Vsn</c>, and @@ -241,31 +257,31 @@ <c>Module</c>. If no such attribute is defined, the version is the checksum of the BEAM file.</d> <v>State = term()</v> - <d>The internal state of the channel.</d> + <d>Internal state of the channel.</d> <v>Extra = term()</v> - <d>Passed as-is from the <c>{advanced,Extra}</c> + <d>Passed "as-is" from the <c>{advanced,Extra}</c> part of the update instruction.</d> </type> <desc> - <p> Converts process state when code is changed.</p> + <p>Converts process state when code is changed.</p> - <p>This function is called by a client side channel when it - should update its internal state during a release - upgrade/downgrade, i.e. when the instruction - <c>{update,Module,Change,...}</c> where - <c>Change={advanced,Extra}</c> is given in the <c>appup</c> - file. See <seealso marker="doc/design_principles:release_handling#instr">OTP - Design Principles</seealso> for more information. + <p>This function is called by a client-side channel when it + is to update its internal state during a release + upgrade or downgrade, that is, when the instruction + <c>{update,Module,Change,...}</c>, where + <c>Change={advanced,Extra}</c>, is given in the <c>appup</c> + file. For more information, refer to Section 9.11.6 + Release Handling Instructions in the + <seealso marker="doc/design_principles:release_handling#instr">System Documentation</seealso>. </p> <note><p>Soft upgrade according to the OTP release concept is not straight forward for the server side, as subsystem - channel processes are spawned by the SSH application and - hence added to its supervisor tree. It could be possible to - upgrade the subsystem channels, when upgrading the user - application, if the callback functions can handle two - versions of the state, but this function can not be used in - the normal way.</p> + channel processes are spawned by the <c>ssh</c> application and + hence added to its supervisor tree. The subsystem channels can + be upgraded when upgrading the user application, if the callback + functions can handle two versions of the state, but this function + cannot be used in the normal way.</p> </note> </desc> @@ -274,36 +290,38 @@ <func> <name>Module:init(Args) -> {ok, State} | {ok, State, timeout()} | {stop, Reason}</name> - <fsummary> Makes necessary initializations and returns the + <fsummary>Makes necessary initializations and returns the initial channel state if the initializations succeed.</fsummary> <type> - <v> Args = term() </v> - <d> Last argument to ssh_channel:start_link/4.</d> - <v> State = term() </v> - <v> Reason = term() </v> + <v>Args = term()</v> + <d>Last argument to <c>ssh_channel:start_link/4</c>.</d> + <v>State = term()</v> + <v>Reason = term()</v> </type> <desc> - <p> Makes necessary initializations and returns the initial channel + <p>Makes necessary initializations and returns the initial channel state if the initializations succeed. </p> - <p>For more detailed information on timeouts see the section - <seealso marker="#cb_timeouts">CALLBACK TIMEOUTS</seealso>. </p> + <p>For more detailed information on time-outs, see Section + <seealso marker="#cb_timeouts">CALLBACK TIME-OUTS</seealso>. </p> </desc> </func> <func> <name>Module:handle_call(Msg, From, State) -> Result</name> - <fsummary> Handles messages sent by calling - <c>ssh_channel:call/[2,3]</c></fsummary> + <fsummary>Handles messages sent by calling + <c>ssh_channel:call/[2,3]</c>.</fsummary> <type> <v>Msg = term()</v> - <v>From = opaque to the user should be used as argument to - ssh_channel:reply/2</v> + <v>From = opaque()</v> + <d>Is to be used as argument to + <seealso marker="#reply-2">ssh_channel:reply/2</seealso></d> <v>State = term()</v> <v>Result = {reply, Reply, NewState} | {reply, Reply, NewState, timeout()} | {noreply, NewState} | {noreply , NewState, timeout()} | {stop, Reason, Reply, NewState} | {stop, Reason, NewState} </v> - <v>Reply = term() - will be the return value of ssh_channel:call/[2,3]</v> + <v>Reply = term()</v> + <d>Will be the return value of <seealso marker="#call-2">ssh_channel:call/[2,3]</seealso></d> <v>NewState = term()</v> <v>Reason = term()</v> </type> @@ -311,15 +329,15 @@ <p>Handles messages sent by calling <seealso marker="#call-2">ssh_channel:call/[2,3]</seealso> </p> - <p>For more detailed information on timeouts see the section - <seealso marker="#cb_timeouts">CALLBACK TIMEOUTS</seealso>. </p> + <p>For more detailed information on time-outs,, see Section + <seealso marker="#cb_timeouts">CALLBACK TIME-OUTS</seealso>.</p> </desc> </func> <func> <name>Module:handle_cast(Msg, State) -> Result</name> - <fsummary> Handles messages sent by calling - <c>ssh_channel:cact/2</c></fsummary> + <fsummary>Handles messages sent by calling + <c>ssh_channel:cact/2</c>.</fsummary> <type> <v>Msg = term()</v> <v>State = term()</v> @@ -329,11 +347,11 @@ <v>Reason = term()</v> </type> <desc> - <p> Handles messages sent by calling - <c>ssh_channel:cast/2</c> + <p>Handles messages sent by calling + <c>ssh_channel:cast/2</c>. </p> - <p>For more detailed information on timeouts see the section - <seealso marker="#cb_timeouts">CALLBACK TIMEOUTS</seealso>. </p> + <p>For more detailed information on time-outs, see Section + <seealso marker="#cb_timeouts">CALLBACK TIME-OUTS</seealso>.</p> </desc> </func> @@ -341,33 +359,33 @@ <name>Module:handle_msg(Msg, State) -> {ok, State} | {stop, ChannelId, State}</name> - <fsummary> Handle other messages than SSH connection protocol, - call or cast messages sent to the channel.</fsummary> + <fsummary>Handles other messages than SSH connection protocol, + call, or cast messages sent to the channel.</fsummary> <type> <v>Msg = timeout | term()</v> <v>ChannelId = ssh_channel_id()</v> <v>State = term() </v> </type> <desc> - <p>Handle other messages than ssh connection protocol, call or + <p>Handles other messages than SSH Connection Protocol, call, or cast messages sent to the channel. </p> - <p> Possible erlang 'EXIT'-messages should be handled by this - function and all channels should handle the following message.</p> + <p>Possible Erlang 'EXIT' messages is to be handled by this + function and all channels are to handle the following message.</p> <taglist> <tag><c><![CDATA[{ssh_channel_up, ssh_channel_id(), ssh_connection_ref()}]]></c></tag> - <item>This is the first messages that will be received by - the channel, it is sent just before the <seealso + <item><p>This is the first message that the channel receives. + It is sent just before the <seealso marker="#init-1">ssh_channel:init/1</seealso> function - returns successfully. This is especially useful if the + returns successfully. This is especially useful if the server wants to send a message to the client without first receiving a message from it. If the message is not - useful for your particular scenario just ignore it by - immediately returning {ok, State}. - </item> + useful for your particular scenario, ignore it by + immediately returning <c>{ok, State}</c>. + </p></item> </taglist> </desc> </func> @@ -375,42 +393,44 @@ <func> <name>Module:handle_ssh_msg(Msg, State) -> {ok, State} | {stop, ChannelId, State}</name> - <fsummary> Handles ssh connection protocol messages. </fsummary> + <fsummary>Handles <c>ssh</c> connection protocol messages.</fsummary> <type> - <v>Msg = <seealso marker="ssh_connection"> ssh_connection:event() </seealso> </v> + <v>Msg = ssh_connection:event()</v> <v>ChannelId = ssh_channel_id()</v> <v>State = term()</v> </type> <desc> - <p> Handles SSH connection protocol messages that may need - service specific attention. + <p>Handles SSH Connection Protocol messages that may need + service-specific attention. For details, + see <seealso marker="ssh_connection"> ssh_connection:event()</seealso>. </p> - <p> The following message is completely taken care of by the - SSH channel behavior</p> + <p>The following message is taken care of by the + <c>ssh_channel</c> behavior.</p> <taglist> <tag><c><![CDATA[{closed, ssh_channel_id()}]]></c></tag> - <item> The channel behavior will send a close message to the - other side if such a message has not already been sent and - then terminate the channel with reason normal.</item> + <item><p>The channel behavior sends a close message to the + other side, if such a message has not already been sent. + Then it terminates the channel with reason <c>normal</c>.</p></item> </taglist> </desc> </func> <func> <name>Module:terminate(Reason, State) -> _</name> - <fsummary> </fsummary> + <fsummary>Does cleaning up before channel process termination. + </fsummary> <type> <v>Reason = term()</v> <v>State = term()</v> </type> <desc> <p>This function is called by a channel process when it is - about to terminate. Before this function is called <seealso + about to terminate. Before this function is called, <seealso marker="ssh_connection#close-2"> ssh_connection:close/2 - </seealso> will be called if it has not been called earlier. - This function should do any necessary cleaning + </seealso> is called, if it has not been called earlier. + This function does any necessary cleaning up. When it returns, the channel process terminates with reason <c>Reason</c>. The return value is ignored. </p> diff --git a/lib/ssh/doc/src/ssh_client_key_api.xml b/lib/ssh/doc/src/ssh_client_key_api.xml index f3d05a8980..a8dda042c9 100644 --- a/lib/ssh/doc/src/ssh_client_key_api.xml +++ b/lib/ssh/doc/src/ssh_client_key_api.xml @@ -23,102 +23,112 @@ The Initial Developer of the Original Code is Ericsson AB. </legalnotice> <title>ssh_client_key_api</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> </header> <module>ssh_client_key_api</module> <modulesummary> -behaviour(ssh_client_key_api). </modulesummary> <description> - <p> Behavior describing the API for an SSH client's public key handling. - By implementing the callbacks defined. - in this behavior it is possible to customize the SSH client's public key - handling. By default the SSH application implements this behavior - with help of the standard openssh files, see <seealso marker="SSH_app"> ssh(6)</seealso>. </p> + <p>Behavior describing the API for public key handling of an SSH client. By implementing + the callbacks defined in this behavior, the public key handling of an SSH client can + be customized. By default the <c>ssh</c> application implements this behavior + with help of the standard OpenSSH files, + see the <seealso marker="SSH_app"> ssh(6)</seealso> application manual.</p> </description> <section> - <title>DATA TYPES </title> + <title>DATA TYPES</title> - <p>Type definitions that are used more than once in this module - and/or abstractions to indicate the intended use of the data - type. For more details on public key data types - see the <seealso marker="public_key:public_key_records"> public_key user's guide.</seealso> + <p>Type definitions that are used more than once in this module, + or abstractions to indicate the intended use of the data + type, or both. For more details on public key data types, + refer to Section 2 Public Key Records in the + <seealso marker="public_key:public_key_records"> public_key user's guide:</seealso> </p> - - <p> boolean() = true | false</p> - <p> string() = [byte()] </p> - <p> public_key() = #'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()</p> - <p> private_key() = #'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()</p> - <p> public_key_algorithm() = 'ssh-rsa'| 'ssh-dss' | atom()</p> - + <taglist> + <tag><c>boolean()</c></tag> + <item><p>= <c>true | false</c></p></item> + <tag><c>string()</c></tag> + <item><p>= <c>[byte()]</c></p></item> + <tag><c>public_key()</c></tag> + <item><p>= <c>#'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()</c></p></item> + <tag><c>private_key()</c></tag> + <item><p>= <c>#'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()</c></p></item> + <tag><c>public_key_algorithm()</c></tag> + <item><p>= <c>'ssh-rsa'| 'ssh-dss' | atom()</c></p></item> + </taglist> </section> <funcs> <func> <name>Module:add_host_key(HostNames, Key, ConnectOptions) -> ok | {error, Reason}</name> - <fsummary>Adds a host key to the set of trusted host keys</fsummary> + <fsummary>Adds a host key to the set of trusted host keys.</fsummary> <type> <v>HostNames = string()</v> - <d>Description of the host that owns the <c>PublicKey</c></d> + <d>Description of the host that owns the <c>PublicKey</c>.</d> - <v>Key = public_key() </v> - <d> Normally an RSA or DSA public key but handling of other public keys can be added</d> + <v>Key = public_key()</v> + <d>Normally an RSA or DSA public key, but handling of other public keys can be added.</d> - <v>ConnectOptions = proplists:proplist() </v> - <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso></d> - <v>Reason = term() </v> + <v>ConnectOptions = proplists:proplist()</v> + <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso></d> + <v>Reason = term().</v> </type> <desc> - <p> Adds a host key to the set of trusted host keys</p> + <p>Adds a host key to the set of trusted host keys.</p> </desc> </func> <func> <name>Module:is_host_key(Key, Host, Algorithm, ConnectOptions) -> Result</name> - <fsummary>Checks if a host key is trusted</fsummary> + <fsummary>Checks if a host key is trusted.</fsummary> <type> <v>Key = public_key() </v> - <d> Normally an RSA or DSA public key but handling of other public keys can be added</d> + <d>Normally an RSA or DSA public key, but handling of other public keys can be added.</d> <v>Host = string()</v> - <d>Description of the host</d> + <d>Description of the host.</d> <v>Algorithm = public_key_algorithm()</v> - <d> Host key algorithm. Should support 'ssh-rsa'| 'ssh-dss' but additional algorithms + <d>Host key algorithm. Is to support <c>'ssh-rsa'| 'ssh-dss'</c>, but more algorithms can be handled.</d> - <v> ConnectOptions = proplists:proplist() </v> - <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso></d> + <v>ConnectOptions = proplists:proplist() </v> + <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>.</d> - <v> Result = boolean()</v> + <v>Result = boolean()</v> </type> <desc> - <p>Checks if a host key is trusted</p> + <p>Checks if a host key is trusted.</p> </desc> </func> <func> <name>Module:user_key(Algorithm, ConnectOptions) -> {ok, PrivateKey} | {error, Reason}</name> - <fsummary>Fetches the users "public key" matching the <c>Algorithm</c>.</fsummary> + <fsummary>Fetches the users <em>public key</em> matching the <c>Algorithm</c>.</fsummary> <type> <v>Algorithm = public_key_algorithm()</v> - <d> Host key algorithm. Should support 'ssh-rsa'| 'ssh-dss' but additional algorithms + <d>Host key algorithm. Is to support <c>'ssh-rsa'| 'ssh-dss'</c> but more algorithms can be handled.</d> - <v> ConnectOptions = proplists:proplist() </v> - <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso></d> + <v>ConnectOptions = proplists:proplist()</v> + <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso></d> - <v> PrivateKey = private_key()</v> - <d> The private key of the user matching the <c>Algorithm</c></d> + <v>PrivateKey = private_key()</v> + <d>Private key of the user matching the <c>Algorithm</c>.</d> - <v>Reason = term() </v> + <v>Reason = term()</v> </type> <desc> - <p>Fetches the users "public key" matching the <c>Algorithm</c>. - <note><p>The private key contains the public key</p></note> - </p> + <p>Fetches the users <em>public key</em> matching the <c>Algorithm</c>.</p> + <note><p>The private key contains the public key.</p></note> + </desc> </func> diff --git a/lib/ssh/doc/src/ssh_connection.xml b/lib/ssh/doc/src/ssh_connection.xml index 5e2926dfa6..669a361db9 100644 --- a/lib/ssh/doc/src/ssh_connection.xml +++ b/lib/ssh/doc/src/ssh_connection.xml @@ -24,156 +24,174 @@ </legalnotice> <title>ssh_connection</title> + <prepared></prepared> + <docno></docno> <date></date> + <rev></rev> </header> <module>ssh_connection</module> - <modulesummary>This module provides API functions to send <url href="http://www.ietf.org/rfc/rfc4254.txt"> SSH Connection Protocol </url> + <modulesummary>This module provides API functions to send + <url href="http://www.ietf.org/rfc/rfc4254.txt"> SSH Connection Protocol </url> events to the other side of an SSH channel. </modulesummary> <description> - <p>The SSH Connection Protocol is used by clients and servers - (i.e. SSH channels) to communicate over the SSH connection. The - API functions in this module sends SSH Connection Protocol events - that are received as messages by the remote channel. - In the case that the receiving channel is an Erlang process the - message will be on the following format - <c><![CDATA[{ssh_cm, ssh_connection_ref(), ssh_event_msg()}]]></c>. If the <seealso - marker="ssh_channel">ssh_channel</seealso> behavior is used to - implement the channel process these will be handled by - <seealso - marker="ssh_channel#Module:handle_ssh_msg-2">handle_ssh_msg/2 </seealso>.</p> + <p>The SSH Connection Protocol is used by clients and servers, + that is, SSH channels, to communicate over the SSH connection. The + API functions in this module send SSH Connection Protocol events, + which are received as messages by the remote channel. + If the receiving channel is an Erlang process, the + messages have the format + <c><![CDATA[{ssh_cm, ssh_connection_ref(), ssh_event_msg()}]]></c>. + If the <seealso marker="ssh_channel">ssh_channel</seealso> behavior is used to + implement the channel process, these messages are handled by + <seealso marker="ssh_channel#Module:handle_ssh_msg-2">handle_ssh_msg/2</seealso>.</p> </description> <section> - <title>DATA TYPES </title> - - <p>Type definitions that are used more than once in this module and/or - abstractions to indicate the intended use of the data type:</p> - - <p><c>boolean() = true | false </c></p> - <p><c>string() = list of ASCII characters</c></p> - <p><c>timeout() = infinity | integer() - in milliseconds.</c></p> - <p><c>ssh_connection_ref() - opaque to the user returned by - ssh:connect/3 or sent to an SSH channel processes</c></p> - <p><c>ssh_channel_id() = integer() </c></p> - <p><c>ssh_data_type_code() = 1 ("stderr") | 0 ("normal") are - currently valid values see</c> <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254 </url> section 5.2.</p> - <p><c>ssh_request_status() = success | failure</c></p> - <p><c>event() = {ssh_cm, ssh_connection_ref(), ssh_event_msg()} </c></p> - <p><c>ssh_event_msg() = data_events() | status_events() | terminal_events() </c></p> - <p><c>reason() = timeout | closed </c></p> + <title>DATA TYPES</title> + + <p>Type definitions that are used more than once in this module, + or abstractions to indicate the intended use of the data + type, or both:</p> + + <taglist> + <tag><c>boolean()</c></tag> + <item><p>= <c>true | false </c></p></item> + <tag><c>string()</c></tag> + <item><p>= list of ASCII characters</p></item> + <tag><c>timeout()</c></tag> + <item><p>= <c>infinity | integer()</c> in milliseconds</p></item> + <tag><c>ssh_connection_ref()</c></tag> + <item><p>Opaque to the user, returned by + <c>ssh:connect/3</c> or sent to an SSH channel processes</p></item> + <tag><c>ssh_channel_id()</c></tag> + <item><p>= <c>integer()</c></p></item> + <tag><c>ssh_data_type_code()</c></tag> + <item><p>= <c>1</c> ("stderr") | <c>0</c> ("normal") are + valid values, see + <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url> Section 5.2.</p></item> + <tag><c>ssh_request_status() ssh_request_status()</c></tag> + <item><p>= <c>success | failure</c></p></item> + <tag><c>event()</c></tag> + <item><p>= <c>{ssh_cm, ssh_connection_ref(), ssh_event_msg()}</c></p></item> + <tag><c>ssh_event_msg()</c></tag> + <item><p>= <c>data_events() | status_events() | terminal_events()</c></p></item> + <tag><c>reason()</c></tag> + <item><p>= <c>timeout | closed</c></p></item> + </taglist> <taglist> - <tag><b>data_events()</b></tag> + <tag><em>data_events()</em></tag> <item> <taglist> <tag><c><![CDATA[{data, ssh_channel_id(), ssh_data_type_code(), binary() = Data}]]></c></tag> - <item> Data has arrived on the channel. This event is sent as - result of calling <seealso marker="ssh_connection#send-3"> ssh_connection:send/[3,4,5] </seealso></item> + <item><p>Data has arrived on the channel. This event is sent as a + result of calling <seealso marker="ssh_connection#send-3"> + ssh_connection:send/[3,4,5]</seealso>.</p></item> <tag><c><![CDATA[{eof, ssh_channel_id()}]]></c></tag> - <item>Indicates that the other side will not send any more - data. This event is sent as result of calling <seealso - marker="ssh_connection#send_eof-2"> ssh_connection:send_eof/2</seealso> - </item> + <item><p>Indicates that the other side sends no more data. + This event is sent as a result of calling <seealso + marker="ssh_connection#send_eof-2"> ssh_connection:send_eof/2</seealso>. + </p></item> </taglist> </item> - <tag><b>status_events()</b></tag> + <tag><em>status_events()</em></tag> <item> <taglist> <tag><c><![CDATA[{signal, ssh_channel_id(), ssh_signal()}]]></c></tag> - <item>A signal can be delivered to the remote process/service - using the following message. Some systems will not support - signals, in which case they should ignore this message. There is - currently no funtion to generate this event as the signals - refered to are on OS-level and not something generated by an - Erlang program.</item> + <item><p>A signal can be delivered to the remote process/service + using the following message. Some systems do not support + signals, in which case they are to ignore this message. There is + currently no function to generate this event as the signals + referred to are on OS-level and not something generated by an + Erlang program.</p></item> <tag><c><![CDATA[{exit_signal, ssh_channel_id(), string() = ExitSignal, string() = ErrorMsg, string() = LanguageString}]]></c></tag> - <item>A remote execution may terminate violently due to a signal - then this message may be received. For details on valid string - values see <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url> section 6.10. Special case of the signals - mentioned above.</item> + <item><p>A remote execution can terminate violently because of a signal. + Then this message can be received. For details on valid string + values, see <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url> + Section 6.10, which shows a special case of these signals.</p></item> <tag><c><![CDATA[{exit_status, ssh_channel_id(), integer() = ExitStatus}]]></c></tag> - <item> When the command running at the other end terminates, the + <item><p>When the command running at the other end terminates, the following message can be sent to return the exit status of the - command. A zero 'exit_status' usually means that the command - terminated successfully. This event is sent as result of calling + command. A zero <c>exit_status</c> usually means that the command + terminated successfully. This event is sent as a result of calling <seealso marker="ssh_connection#exit_status-3"> - ssh_connection:exit_status/3</seealso></item> + ssh_connection:exit_status/3</seealso>.</p></item> <tag><c><![CDATA[{closed, ssh_channel_id()}]]></c></tag> - <item> This event is sent as result of calling - <seealso marker="ssh_connection#close-2">ssh_connection:close/2</seealso> Both the handling of this - event and sending of it will be taken care of by the - <seealso marker="ssh_channel">ssh_channel</seealso> behavior.</item> + <item><p>This event is sent as a result of calling + <seealso marker="ssh_connection#close-2">ssh_connection:close/2</seealso>. + Both the handling of this event and sending it are taken care of by the + <seealso marker="ssh_channel">ssh_channel</seealso> behavior.</p></item> </taglist> </item> - <tag><b>terminal_events()</b></tag> + <tag><em>terminal_events()</em></tag> <item> - <p> Channels implementing a shell and command execution on the - server side should handle the following messages that may be sent by client channel processes. </p> + <p>Channels implementing a shell and command execution on the + server side are to handle the following messages that can be sent by client- + channel processes.</p> - <note> <p>Events that includes a <c> WantReply</c> expects the event handling - process to call <seealso marker="ssh_connection#reply_request-4">ssh_connection:reply_request/4</seealso> - with the boolean value of <c> WantReply</c> as the second - argument. </p></note> + <p>Events that include a <c>WantReply</c> expect the event handling + process to call <seealso marker="ssh_connection#reply_request-4"> + ssh_connection:reply_request/4</seealso> + with the boolean value of <c>WantReply</c> as the second argument.</p> <taglist> <tag><c><![CDATA[{env, ssh_channel_id(), boolean() = WantReply, string() = Var, string() = Value}]]></c></tag> - <item> Environment variables may be passed to the shell/command - to be started later. This event is sent as result of calling <seealso - marker="ssh_connection#setenv-5"> ssh_connection:setenv/5</seealso> - </item> + <item><p>Environment variables can be passed to the shell/command + to be started later. This event is sent as a result of calling <seealso + marker="ssh_connection#setenv-5"> ssh_connection:setenv/5</seealso>. + </p></item> <tag><c><![CDATA[{pty, ssh_channel_id(), boolean() = WantReply, {string() = Terminal, integer() = CharWidth, integer() = RowHeight, integer() = PixelWidth, integer() = PixelHeight, [{atom() | integer() = Opcode, integer() = Value}] = TerminalModes}}]]></c></tag> - <item>A pseudo-terminal has been requested for the - session. Terminal is the value of the TERM environment - variable value (e.g., vt100). Zero dimension parameters must - be ignored. The character/row dimensions override the pixel - dimensions (when nonzero). Pixel dimensions refer to the - drawable area of the window. The <c>Opcode</c> in the + <item><p>A pseudo-terminal has been requested for the + session. <c>Terminal</c> is the value of the TERM environment + variable value, that is, <c>vt100</c>. Zero dimension parameters must + be ignored. The character/row dimensions override the pixel + dimensions (when non-zero). Pixel dimensions refer to the + drawable area of the window. <c>Opcode</c> in the <c>TerminalModes</c> list is the mnemonic name, represented - as an lowercase erlang atom, defined in - <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254 </url> section 8. - It may also be an opcode if the mnemonic name is not listed in the - RFC. Example <c>OP code: 53, mnemonic name ECHO erlang atom: - echo</c>.This event is sent as result of calling <seealso - marker="ssh_connection#ptty_alloc/4">ssh_connection:ptty_alloc/4</seealso></item> + as a lowercase Erlang atom, defined in + <url href="http://www.ietf.org/rfc/rfc4254.txt">RFC 4254</url>, Section 8. + It can also be an <c>Opcode</c> if the mnemonic name is not listed in the + RFC. Example: <c>OP code: 53, mnemonic name ECHO erlang atom: + echo</c>. This event is sent as a result of calling <seealso + marker="ssh_connection#ptty_alloc/4">ssh_connection:ptty_alloc/4</seealso>.</p></item> <tag><c><![CDATA[{shell, boolean() = WantReply}]]></c></tag> - <item> This message will request that the user's default shell - be started at the other end. This event is sent as result of calling <seealso - marker="ssh_connection#shell-2"> ssh_connection:shell/2</seealso> - </item> + <item><p>This message requests that the user default shell + is started at the other end. This event is sent as a result of calling + <seealso marker="ssh_connection#shell-2"> ssh_connection:shell/2</seealso>. + </p></item> <tag><c><![CDATA[{window_change, ssh_channel_id(), integer() = CharWidth, integer() = RowHeight, integer() = PixWidth, integer() = PixHeight}]]></c></tag> - <item> When the window (terminal) size changes on the client - side, it MAY send a message to the server side to inform it of - the new dimensions. There is currently no API function to generate this - event.</item> + <item><p>When the window (terminal) size changes on the client + side, it <em>can</em> send a message to the server side to inform it of + the new dimensions. No API function generates this event.</p></item> <tag><c><![CDATA[{exec, ssh_channel_id(), boolean() = WantReply, string() = Cmd}]]></c></tag> - <item> This message will request that the server starts - execution of the given command. This event is sent as result of calling <seealso - marker="ssh_connection#exec-4">ssh_connection:exec/4 </seealso> - </item> + <item><p>This message requests that the server starts + execution of the given command. This event is sent as a result of calling <seealso + marker="ssh_connection#exec-4">ssh_connection:exec/4 </seealso>. + </p></item> </taglist> </item> </taglist> @@ -183,80 +201,83 @@ <func> <name>adjust_window(ConnectionRef, ChannelId, NumOfBytes) -> ok</name> - <fsummary>Adjusts the SSH flowcontrol window. </fsummary> + <fsummary>Adjusts the SSH flow control window.</fsummary> <type> - <v> ConnectionRef = ssh_connection_ref() </v> - <v> ChannelId = ssh_channel_id() </v> - <v> NumOfBytes = integer()</v> + <v>ConnectionRef = ssh_connection_ref()</v> + <v>ChannelId = ssh_channel_id()</v> + <v>NumOfBytes = integer()</v> </type> <desc> - <p>Adjusts the SSH flowcontrol window. This shall be done by both client and server side channel processes.</p> + <p>Adjusts the SSH flow control window. This is to be done by both the + client- and server-side channel processes.</p> - <note><p>Channels implemented with the <seealso marker="ssh_channel"> ssh_channel - behavior</seealso> will normaly not need to call this function as flow control - will be handled by the behavior. The behavior will adjust the window every time + <note><p>Channels implemented with the <seealso marker="ssh_channel"> ssh_channel</seealso> + behavior do not normally need to call this function as flow control + is handled by the behavior. The behavior adjusts the window every time the callback <seealso marker="ssh_channel#Module:handle_ssh_msg-2"> - handle_ssh_msg/2 </seealso> has returned after processing channel data</p> </note> + handle_ssh_msg/2</seealso> returns after processing channel data.</p></note> </desc> </func> <func> <name>close(ConnectionRef, ChannelId) -> ok</name> - <fsummary>Sends a close message on the channel <c>ChannelId</c>. </fsummary> + <fsummary>Sends a close message on the channel <c>ChannelId</c>.</fsummary> <type> - <v> ConnectionRef = ssh_connection_ref() </v> - <v> ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = ssh_connection_ref()</v> + <v>ChannelId = ssh_channel_id()</v> </type> <desc> - <p>A server or client channel process can choose to close their session by sending a close event. + <p>A server- or client-channel process can choose to close their session by + sending a close event. </p> - <note><p>This function will be called by the ssh_channel - behavior when the channel is terminated see <seealso - marker="ssh_channel"> ssh_channel(3) </seealso> so channels implemented with the - behavior should not call this function explicitly.</p></note> + <note><p>This function is called by the <c>ssh_channel</c> + behavior when the channel is terminated, see <seealso + marker="ssh_channel"> ssh_channel(3)</seealso>. Thus, channels implemented + with the behavior are not to call this function explicitly.</p></note> </desc> </func> <func> - <name>exec(ConnectionRef, ChannelId, Command, TimeOut) -> ssh_request_status() | {error, reason()} </name> - <fsummary>Request that the server start the execution of the given command. </fsummary> + <name>exec(ConnectionRef, ChannelId, Command, TimeOut) -> ssh_request_status() | + {error, reason()}</name> + <fsummary>Requests that the server starts the execution of the given command.</fsummary> <type> - <v> ConnectionRef = ssh_connection_ref() </v> - <v> ChannelId = ssh_channel_id()</v> - <v> Command = string()</v> - <v>Timeout = timeout() </v> + <v>ConnectionRef = ssh_connection_ref()</v> + <v>ChannelId = ssh_channel_id()</v> + <v>Command = string()</v> + <v>Timeout = timeout()</v> </type> <desc> - <p>Should be called by a client channel process to request that the server starts execution of the - given command, the result will be several messages according to the following pattern. Note - that the last message will be a channel close message, as the exec request is a one time - execution that closes the channel when it is done.</p> + <p>Is to be called by a client-channel process to request that the server starts + executing the given command. The result is several messages according to the + following pattern. The last message is a channel close message, as the <c>exec</c> + request is a one-time execution that closes the channel when it is done.</p> <taglist> - <tag><c> N x {ssh_cm, ssh_connection_ref(), - {data, ssh_channel_id(), ssh_data_type_code(), binary() = Data}} </c></tag> - <item>The result of executing the command may be only one line - or thousands of lines depending on the command.</item> + <tag><c>N x {ssh_cm, ssh_connection_ref(), + {data, ssh_channel_id(), ssh_data_type_code(), binary() = Data}}</c></tag> + <item><p>The result of executing the command can be only one line + or thousands of lines depending on the command.</p></item> <tag><c>0 or 1 x {ssh_cm, ssh_connection_ref(), {eof, ssh_channel_id()}}</c></tag> - <item>Indicates that no more data will be sent.</item> + <item><p>Indicates that no more data is to be sent.</p></item> <tag><c>0 or 1 x {ssh_cm, ssh_connection_ref(), {exit_signal, ssh_channel_id(), string() = ExitSignal, string() = ErrorMsg, string() = LanguageString}}</c></tag> - <item>Not all systems send signals. For details on valid string - values see RFC 4254 section 6.10 </item> + <item><p>Not all systems send signals. For details on valid string + values, see RFC 4254, Section 6.10</p></item> <tag><c>0 or 1 x {ssh_cm, ssh_connection_ref(), {exit_status, ssh_channel_id(), integer() = ExitStatus}}</c></tag> - <item>It is recommended by the <c>ssh connection protocol</c> that this - message shall be sent, but that may not always be the case.</item> + <item><p>It is recommended by the SSH Connection Protocol to send this + message, but that is not always the case.</p></item> - <tag><c> 1 x {ssh_cm, ssh_connection_ref(), + <tag><c>1 x {ssh_cm, ssh_connection_ref(), {closed, ssh_channel_id()}}</c></tag> - <item>Indicates that the ssh channel started for the - execution of the command has now been shutdown.</item> + <item><p>Indicates that the <c>ssh_channel</c> started for the + execution of the command has now been shut down.</p></item> </taglist> </desc> </func> @@ -265,78 +286,72 @@ <name>exit_status(ConnectionRef, ChannelId, Status) -> ok</name> <fsummary>Sends the exit status of a command to the client.</fsummary> <type> - <v> ConnectionRef = ssh_connection_ref() </v> - <v> ChannelId = ssh_channel_id()</v> - <v> Status = integer()</v> + <v>ConnectionRef = ssh_connection_ref() </v> + <v>ChannelId = ssh_channel_id()</v> + <v>Status = integer()</v> </type> <desc> - <p>Should be called by a server channel process to sends the exit status of a command to the client.</p> + <p>Is to be called by a server-channel process to send the exit status of a command + to the client.</p> </desc> </func> <func> - <name>ptty_alloc(ConnectionRef, ChannelId, Options) -> </name> - <name>ptty_alloc(ConnectionRef, ChannelId, Options, Timeout) -> > ssh_request_status() | {error, reason()} </name> - <fsummary>Send status replies to requests that want such replies. </fsummary> + <name>ptty_alloc(ConnectionRef, ChannelId, Options) -></name> + <name>ptty_alloc(ConnectionRef, ChannelId, Options, Timeout) -> > ssh_request_status() | + {error, reason()}</name> + <fsummary>Sends an SSH Connection Protocol <c>pty_req</c>, + to allocate a pseudo-terminal.</fsummary> <type> - <v> ConnectionRef = ssh_connection_ref() </v> - <v> ChannelId = ssh_channel_id()</v> - <v> Options = proplists:proplist()</v> + <v>ConnectionRef = ssh_connection_ref()</v> + <v>ChannelId = ssh_channel_id()</v> + <v>Options = proplists:proplist()</v> </type> <desc> - <p> Sends a SSH Connection Protocol pty_req, to allocate a pseudo tty. - Should be called by a SSH client process. - Options are: - </p> + <p>Sends an SSH Connection Protocol <c>pty_req</c>, to allocate a pseudo-terminal. + Is to be called by an SSH client process.</p> + <p>Options:</p> <taglist> <tag>{term, string()}</tag> - <item> - Defaults to os:getenv("TERM") or "vt100" if it is undefined. - </item> + <item><p>Defaults to <em>os:getenv("TERM")</em> or <em>vt100</em> + if it is undefined.</p></item> + <tag>{width, integer()}</tag> - <item> - Defaults to 80 if pixel_width is not defined. - </item> + <item><p>Defaults to 80 if <c>pixel_width</c> is not defined.</p></item> + <tag>{height, integer()}</tag> - <item> - Defaults to 24 if pixel_height is not defined. - </item> + <item><p>Defaults to 24 if <c>pixel_height</c> is not defined.</p></item> + <tag>{pixel_width, integer()}</tag> - <item> - Is disregarded if width is defined. - </item> + <item><p>Is disregarded if <c>width</c> is defined.</p></item> + <tag>{pixel_height, integer()}</tag> - <item> - Is disregarded if height is defined. - </item> + <item><p>Is disregarded if <c>height</c> is defined.</p></item> + <tag>{pty_opts, [{posix_atom(), integer()}]}</tag> - <item> - Option may be an empty list, otherwise - see possible POSIX names in section 8 in <url href="http://www.ietf.org/rfc/rfc4254.txt"> RFC 4254</url>. + <item><p>Option can be an empty list. Otherwise, see possible <em>POSIX</em> names + in Section 8 in <url href="http://www.ietf.org/rfc/rfc4254.txt"> RFC 4254</url>.</p> </item> </taglist> - </desc> </func> - <func> + <func> <name>reply_request(ConnectionRef, WantReply, Status, ChannelId) -> ok</name> - <fsummary>Send status replies to requests that want such replies. </fsummary> + <fsummary>Sends status replies to requests that want such replies.</fsummary> <type> - <v> ConnectionRef = ssh_connection_ref() </v> - <v> WantReply = boolean()</v> - <v> Status = ssh_request_status() </v> - <v> ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = ssh_connection_ref()</v> + <v>WantReply = boolean()</v> + <v>Status = ssh_request_status()</v> + <v>ChannelId = ssh_channel_id()</v> </type> <desc> <p>Sends status replies to requests where the requester has - stated that they want a status report e.i .<c> WantReply = true</c>, - if <c> WantReply</c> is false calling this function will be a - "noop". Should be called while handling an ssh connection - protocol message containing a <c>WantReply</c> boolean - value. - </p> + stated that it wants a status report, that is, <c>WantReply = true</c>. + If <c>WantReply</c> is <c>false</c>, calling this function becomes a + "noop". Is to be called while handling an SSH Connection + Protocol message containing a <c>WantReply</c> boolean value.</p> </desc> </func> @@ -346,98 +361,97 @@ <name>send(ConnectionRef, ChannelId, Type, Data) -></name> <name>send(ConnectionRef, ChannelId, Type, Data, TimeOut) -> ok | {error, timeout} | {error, closed}</name> - <fsummary>Sends channel data </fsummary> + <fsummary>Sends channel data.</fsummary> <type> - <v> ConnectionRef = ssh_connection_ref() </v> - <v> ChannelId = ssh_channel_id()</v> - <v> Data = binary()</v> - <v> Type = ssh_data_type_code()</v> - <v> Timeout = timeout()</v> + <v>ConnectionRef = ssh_connection_ref()</v> + <v>ChannelId = ssh_channel_id()</v> + <v>Data = binary()</v> + <v>Type = ssh_data_type_code()</v> + <v>Timeout = timeout()</v> </type> <desc> - <p>Should be called by client- and server channel processes to send data to each other. + <p>Is to be called by client- and server-channel processes to send data to each other. </p> </desc> </func> <func> <name>send_eof(ConnectionRef, ChannelId) -> ok | {error, closed}</name> - <fsummary>Sends eof on the channel <c>ChannelId</c>. </fsummary> + <fsummary>Sends EOF on channel <c>ChannelId</c>.</fsummary> <type> - <v> ConnectionRef = ssh_connection_ref() </v> - <v> ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = ssh_connection_ref()</v> + <v>ChannelId = ssh_channel_id()</v> </type> <desc> - <p>Sends eof on the channel <c>ChannelId</c>. - </p> + <p>Sends EOF on channel <c>ChannelId</c>.</p> </desc> </func> <func> - <name>session_channel(ConnectionRef, Timeout) -> </name> + <name>session_channel(ConnectionRef, Timeout) -></name> <name>session_channel(ConnectionRef, InitialWindowSize, MaxPacketSize, Timeout) -> {ok, ssh_channel_id()} | {error, reason()}</name> - <fsummary>Opens a channel for a ssh session. </fsummary> + <fsummary>Opens a channel for an SSH session.</fsummary> <type> - <v> ConnectionRef = ssh_connection_ref()</v> - <v> InitialWindowSize = integer() </v> - <v> MaxPacketSize = integer() </v> - <v> Timeout = timeout()</v> - <v> Reason = term() </v> + <v>ConnectionRef = ssh_connection_ref()</v> + <v>InitialWindowSize = integer()</v> + <v>MaxPacketSize = integer()</v> + <v>Timeout = timeout()</v> + <v>Reason = term()</v> </type> <desc> <p>Opens a channel for an SSH session. The channel id returned from this function - is the id used as input to the other funtions in this module. - </p> + is the id used as input to the other functions in this module.</p> </desc> </func> <func> - <name>setenv(ConnectionRef, ChannelId, Var, Value, TimeOut) -> ssh_request_status() | {error, reason()} </name> - <fsummary> Environment variables may be passed to the + <name>setenv(ConnectionRef, ChannelId, Var, Value, TimeOut) -> ssh_request_status() | + {error, reason()}</name> + <fsummary>Environment variables can be passed to the shell/command to be started later.</fsummary> <type> - <v> ConnectionRef = ssh_connection_ref() </v> - <v> ChannelId = ssh_channel_id()</v> - <v> Var = string()</v> - <v> Value = string()</v> - <v> Timeout = timeout()</v> + <v>ConnectionRef = ssh_connection_ref()</v> + <v>ChannelId = ssh_channel_id()</v> + <v>Var = string()</v> + <v>Value = string()</v> + <v>Timeout = timeout()</v> </type> <desc> - <p> Environment variables may be passed before starting the - shell/command. Should be called by a client channel processes. - </p> + <p>Environment variables can be passed before starting the + shell/command. Is to be called by a client channel processes.</p> </desc> </func> <func> <name>shell(ConnectionRef, ChannelId) -> ssh_request_status() | {error, closed} </name> - <fsummary> Requests that the user's default shell (typically - defined in /etc/passwd in UNIX systems) shall be executed at the server - end. </fsummary> + <fsummary>Requests that the user default shell (typically defined in + /etc/passwd in Unix systems) is to be executed at the server end.</fsummary> <type> - <v> ConnectionRef = ssh_connection_ref() </v> - <v> ChannelId = ssh_channel_id()</v> + <v>ConnectionRef = ssh_connection_ref()</v> + <v>ChannelId = ssh_channel_id()</v> </type> <desc> - <p> Should be called by a client channel process to request that the user's default shell (typically - defined in /etc/passwd in UNIX systems) shall be executed at the server end. - </p> + <p>Is to be called by a client channel process to request that the user default + shell (typically defined in /etc/passwd in Unix systems) is executed + at the server end.</p> </desc> </func> <func> - <name>subsystem(ConnectionRef, ChannelId, Subsystem, Timeout) -> ssh_request_status() | {error, reason()} </name> - <fsummary> </fsummary> + <name>subsystem(ConnectionRef, ChannelId, Subsystem, Timeout) -> ssh_request_status() | + {error, reason()}</name> + <fsummary>Requests to execute a predefined subsystem on the server.</fsummary> <type> - <v> ConnectionRef = ssh_connection_ref() </v> - <v> ChannelId = ssh_channel_id()</v> - <v> Subsystem = string()</v> - <v> Timeout = timeout()</v> + <v>ConnectionRef = ssh_connection_ref()</v> + <v>ChannelId = ssh_channel_id()</v> + <v>Subsystem = string()</v> + <v>Timeout = timeout()</v> </type> <desc> - <p> Should be called by a client channel process for requesting to execute a predefined subsystem on the server. + <p>Is to be called by a client-channel process for requesting to execute a predefined + subsystem on the server. </p> </desc> </func> diff --git a/lib/ssh/doc/src/ssh_server_key_api.xml b/lib/ssh/doc/src/ssh_server_key_api.xml index f7133e4ba5..34ce7f7660 100644 --- a/lib/ssh/doc/src/ssh_server_key_api.xml +++ b/lib/ssh/doc/src/ssh_server_key_api.xml @@ -23,68 +23,81 @@ The Initial Developer of the Original Code is Ericsson AB. </legalnotice> <title>ssh_server_key_api</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> </header> <module>ssh_server_key_api</module> <modulesummary> -behaviour(ssh_server_key_api). </modulesummary> <description> - <p> Behaviour describing the API for an SSH server's public key handling. By implementing the callbacks defined - in this behavior it is possible to customize the SSH server's public key - handling. By default the SSH application implements this behavior - with help of the standard openssh files, see <seealso marker="SSH_app"> ssh(6)</seealso>.</p> + <p>Behaviour describing the API for public key handling of an SSH server. By implementing + the callbacks defined in this behavior, the public key handling of an SSH server can + be customized. By default the SSH application implements this behavior + with help of the standard OpenSSH files, + see the <seealso marker="SSH_app"> ssh(6)</seealso> application manual.</p> </description> <section> - <title>DATA TYPES </title> + <title>DATA TYPES</title> - <p>Type definitions that are used more than once in this module - and/or abstractions to indicate the intended use of the data - type. For more details on public key data types - see the <seealso marker="public_key:public_key_records"> public_key user's guide.</seealso> + <p>Type definitions that are used more than once in this module, + or abstractions to indicate the intended use of the data + type, or both. For more details on public key data types, + refer to Section 2 Public Key Records in the + <seealso marker="public_key:public_key_records"> public_key user's guide</seealso>. </p> - <p> boolean() = true | false</p> - <p> string() = [byte()]</p> - <p> public_key() = #'RSAPublicKey'{} | {integer(), #'Dss-Parms'{}} | term()</p> - <p> private_key() = #'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()</p> - <p> public_key_algorithm() = 'ssh-rsa' | 'ssh-dss' | atom()</p> +<taglist> + <tag><c>boolean()</c></tag> + <item><p>= <c>true | false</c></p></item> + <tag><c>string()</c></tag> + <item><p>= <c>[byte()]</c></p></item> + <tag><c>public_key()</c></tag> + <item><p>= <c>#'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()</c></p></item> + <tag><c>private_key()</c></tag> + <item><p>= <c>#'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()</c></p></item> + <tag><c>public_key_algorithm()</c></tag> + <item><p>= <c>'ssh-rsa'| 'ssh-dss' | atom()</c></p></item> + </taglist> </section> <funcs> <func> <name>Module:host_key(Algorithm, DaemonOptions) -> {ok, Key} | {error, Reason}</name> - <fsummary>Fetches the hosts private key </fsummary> + <fsummary>Fetches the host’s private key.</fsummary> <type> <v>Algorithm = public_key_algorithm()</v> - <d> Host key algorithm. Should support 'ssh-rsa' | 'ssh-dss' but additional algorithms + <d>Host key algorithm. Is to support <c>'ssh-rsa' | 'ssh-dss'</c>, but more algorithms can be handled.</d> - <v> DaemonOptions = proplists:proplist() </v> - <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso></d> - <v> Key = private_key()</v> - <d> The private key of the host matching the <c>Algorithm</c></d> - <v>Reason = term() </v> + <v>DaemonOptions = proplists:proplist()</v> + <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso>.</d> + <v>Key = private_key()</v> + <d>Private key of the host matching the <c>Algorithm</c>.</d> + <v>Reason = term()</v> </type> <desc> - <p>Fetches the hosts private key</p> + <p>Fetches the private key of the host.</p> </desc> </func> <func> <name>Module:is_auth_key(Key, User, DaemonOptions) -> Result</name> - <fsummary> Checks if the user key is authorized</fsummary> + <fsummary>Checks if the user key is authorized.</fsummary> <type> - <v> Key = public_key() </v> - <d> Normally an RSA or DSA public key but handling of other public keys can be added</d> - <v> User = string()</v> - <d> The user owning the public key</d> - <v> DaemonOptions = proplists:proplist() </v> - <d> Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso></d> - <v> Result = boolean()</v> + <v>Key = public_key()</v> + <d>Normally an RSA or DSA public key, but handling of other public keys can be added</d> + <v>User = string()</v> + <d>User owning the public key.</d> + <v>DaemonOptions = proplists:proplist()</v> + <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso>.</d> + <v>Result = boolean()</v> </type> <desc> - <p> Checks if the user key is authorized </p> + <p>Checks if the user key is authorized.</p> </desc> </func> diff --git a/lib/ssh/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml index ab111562f9..643130fe6b 100644 --- a/lib/ssh/doc/src/ssh_sftp.xml +++ b/lib/ssh/doc/src/ssh_sftp.xml @@ -23,131 +23,173 @@ <title>ssh_sftp</title> <prepared>OTP</prepared> + <docno></docno> <date>2005-09-22</date> + <rev></rev> <file>ssh_sftp.sgml</file> </header> <module>ssh_sftp</module> <modulesummary>SFTP client.</modulesummary> <description> - <p>This module implements an SFTP (SSH FTP) client. SFTP is a + <p>This module implements an SSH FTP (SFTP) client. SFTP is a secure, encrypted file transfer service available for SSH.</p> </description> <section> - <title>DATA TYPES </title> - <p>Type definitions that are used more than once in this module - and/or abstractions to indicate the intended use of the data type: + <title>DATA TYPES</title> + <p>Type definitions that are used more than once in this module, + or abstractions to indicate the intended use of the data type, or both: </p> - <p><c>ssh_connection_ref() - opaque to the user - returned by ssh:connect/3</c></p> - <p><c>timeout() = infinity | integer() - in milliseconds.</c></p> + + <taglist> + <tag><c>ssh_connection_ref()</c></tag> + <item><p>Opaque to the user, returned by <c>ssh:connect/3</c></p></item> + <tag><c>timeout()</c></tag> + <item><p>= <c>infinity | integer() in milliseconds. Default infinity.</c></p></item> + </taglist> </section> <section> - <title>TIMEOUTS </title> - <p>If the request functions for the SFTP channel return {error, timeout} - it does not guarantee that the request did not reach the server and was - not performed, it only means that we did not receive an answer from the - server within the time that was expected.</p> + <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> </section> <funcs> + <func> + <name>apread(ChannelPid, Handle, Position, Len) -> {async, N} | {error, Error}</name> + <v>ChannelPid = pid()</v> + <v>Handle = term()</v> + <v>Position = integer()</v> + <v>Len = integer()</v> + <v>N = term()</v> + <v>Reason = term()</v> + + <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> + </func> + + <func> + <name>apwrite(ChannelPid, Handle, Position, Data) -> ok | {error, Reason}</name> + <fsummary>Writes asynchronously to an open file.</fsummary> + <type> + <v>ChannelPid = pid()</v> + <v>Handle = term()</v> + <v>Position = integer()</v> + <v>Len = integer()</v> + <v>Data = binary()</v> + <v>Timeout = timeout()</v> + <v>Reason = 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> + </func> + + <func> + <name>aread(ChannelPid, Handle, Len) -> {async, N} | {error, Error}</name> + <fsummary>Reads asynchronously from an open file.</fsummary> + <type> + <v>ChannelPid = pid()</v> + <v>Handle = term()</v> + <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 + handle is valid, the function returns <c><![CDATA[{async, N}]]></c>, where <c>N</c> + is a term guaranteed to be unique between calls of <c><![CDATA[aread]]></c>. + 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> + </desc> + </func> + + + <func> - <name>start_channel(ConnectionRef) -> </name> - <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> - <fsummary>Starts a SFTP client</fsummary> + <name>awrite(ChannelPid, Handle, Data) -> ok | {error, Reason}</name> + <fsummary>Writes asynchronously to an open file.</fsummary> <type> - <v>Host = string()</v> - <v>ConnectionRef = ssh_connection_ref()</v> - <v>Port = integer()</v> - <v>Options = [{Option, Value}]</v> + <v>ChannelPid = pid()</v> + <v>Handle = term()</v> + <v>Position = integer()</v> + <v>Len = integer()</v> + <v>Data = binary()</v> + <v>Timeout = timeout()</v> <v>Reason = term()</v> </type> <desc> - <p>If no connection reference is provided, a connection is set - up and the new connection is returned. An SSH channel process - is started to handle the communication with the SFTP server. - The returned pid for this process should be used as input to - all other API functions in this module.</p> - - <p>Options are:</p> - <taglist> - <tag><c><![CDATA[{timeout, timeout()}]]></c></tag> - <item> - <p>The timeout is passed to the ssh_channel start function, - and defaults to infinity.</p> - </item> - <tag> - <p><c><![CDATA[{sftp_vsn, integer()}]]></c></p> - </tag> - <item> - <p> - Desired SFTP protocol version. - The actual version will be the minimum of - the desired version and the maximum supported - versions by the SFTP server. - </p> - </item> - </taglist> - <p>All other options are directly passed to - <seealso marker="ssh">ssh:connect/3</seealso> or ignored if a - connection is already provided. </p> + <p>Writes to an open file, without waiting for the result. If the + handle is valid, the function returns <c><![CDATA[{async, N}]]></c>, where <c>N</c> + is a term guaranteed to be unique between calls of + <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> </desc> </func> <func> - <name>stop_channel(ChannelPid) -> ok</name> - <fsummary>Stops the SFTP client channel.</fsummary> + <name>close(ChannelPid, Handle) -></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>Stops an SFTP channel. Does not close the SSH connetion. - Use <seealso marker="ssh">ssh:close/1</seealso> to close it.</p> + <p>Closes a handle to an open file or directory on the server.</p> </desc> </func> - + <func> - <name>read_file(ChannelPid, File) -> </name> - <name>read_file(ChannelPid, File, Timeout) -> {ok, Data} | {error, Reason}</name> - <fsummary>Read a file</fsummary> + <name>delete(ChannelPid, Name) -></name> + <name>delete(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> + <fsummary>Deletes a file.</fsummary> <type> - <v>ChannelPid = pid()</v> - <v>File = string()</v> - <v>Data = binary()</v> + <v>ChannelPid = pid()</v> + <v>Name = string()</v> <v>Timeout = timeout()</v> - <v>Reason = term()</v> + <v>Reason = term()</v> </type> <desc> - <p>Reads a file from the server, and returns the data in a binary, - like <c><![CDATA[file:read_file/1]]></c>.</p> + <p>Deletes the file specified by <c><![CDATA[Name]]></c>, like + <seealso marker="kernel:file#delete-1">file:delete/1</seealso></p> </desc> </func> + <func> - <name>write_file(ChannelPid, File, Iolist) -> </name> - <name>write_file(ChannelPid, File, Iolist, Timeout) -> ok | {error, Reason}</name> - <fsummary>Write a file</fsummary> + <name>del_dir(ChannelPid, Name) -></name> + <name>del_dir(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> + <fsummary>Deletes an empty directory.</fsummary> <type> <v>ChannelPid = pid()</v> - <v>File = string()</v> - <v>Iolist = iolist()</v> + <v>Name = string()</v> <v>Timeout = timeout()</v> <v>Reason = term()</v> </type> <desc> - <p>Writes a file to the server, like - <c><![CDATA[file:write_file/2]]></c>. The file is created if - it does not exist or is owerwritten if it does.</p> + <p>Deletes a directory specified by <c><![CDATA[Name]]></c>. + The directory must be empty before it can be successfully deleted. + </p> </desc> </func> - <func> - <name>list_dir(ChannelPid, Path) -> </name> + + <func> + <name>list_dir(ChannelPid, Path) -></name> <name>list_dir(ChannelPid, Path, Timeout) -> {ok, Filenames} | {error, Reason}</name> - <fsummary>List directory</fsummary> + <fsummary>Lists the directory.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Path = string()</v> @@ -161,10 +203,45 @@ filenames as a list of strings.</p> </desc> </func> + + <func> + <name>make_dir(ChannelPid, Name) -></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> + must be a full path to a new directory. The directory can only be + created in an existing directory.</p> + </desc> + </func> + <func> - <name>open(ChannelPid, File, Mode) -> </name> + <name>make_symlink(ChannelPid, Name, Target) -></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> + </desc> + </func> + + <func> + <name>open(ChannelPid, File, Mode) -></name> <name>open(ChannelPid, File, Mode, Timeout) -> {ok, Handle} | {error, Reason}</name> - <fsummary>Open a file and return a handle</fsummary> + <fsummary>Opens a file and returns a handle.</fsummary> <type> <v>ChannelPid = pid()</v> <v>File = string()</v> @@ -175,14 +252,14 @@ <v>Reason = term()</v> </type> <desc> - <p>Opens a file on the server, and returns a handle that + <p>Opens a file on the server and returns a handle, which can be used for reading or writing.</p> </desc> </func> <func> - <name>opendir(ChannelPid, Path) -> </name> + <name>opendir(ChannelPid, Path) -></name> <name>opendir(ChannelPid, Path, Timeout) -> {ok, Handle} | {error, Reason}</name> - <fsummary>Open a directory and return a handle</fsummary> + <fsummary>Opens a directory and returns a handle.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Path = string()</v> @@ -190,7 +267,7 @@ <v>Reason = term()</v> </type> <desc> - <p>Opens a handle to a directory on the server, the handle + <p>Opens a handle to a directory on the server. The handle can be used for reading directory contents.</p> </desc> </func> @@ -198,14 +275,15 @@ <func> <name>open_tar(ChannelPid, Path, Mode) -></name> <name>open_tar(ChannelPid, Path, Mode, Timeout) -> {ok, Handle} | {error, Reason}</name> - <fsummary>Opens a tar file on the server to which <v>ChannelPid</v> is connected and returns a handle</fsummary> + <fsummary>Opens a tar file on the server to which <c>ChannelPid</c> + is connected and returns a handle.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Path = string()</v> - <v>Mode = [read] | [write] | [read,EncryptOpt] | [write,DecryptOpt] </v> + <v>Mode = [read] | [write] | [read,EncryptOpt] | [write,DecryptOpt]</v> <v>EncryptOpt = {crypto,{InitFun,EncryptFun,CloseFun}}</v> <v>DecryptOpt = {crypto,{InitFun,DecryptFun}}</v> - <v>InitFun = (fun() -> {ok,CryptoState}) | (fun() -> {ok,CryptoState,ChunkSize}) </v> + <v>InitFun = (fun() -> {ok,CryptoState}) | (fun() -> {ok,CryptoState,ChunkSize})</v> <v>CryptoState = any()</v> <v>ChunkSize = undefined | pos_integer()</v> <v>EncryptFun = (fun(PlainBin,CryptoState) -> EncryptResult)</v> @@ -219,113 +297,86 @@ <v>Reason = term()</v> </type> <desc> - <p>Opens a handle to a tar file on the server associated with <c>ChannelPid</c>. The handle - can be used for remote tar creation and extraction as defined by the - <seealso marker="stdlib:erl_tar#init/3">erl_tar:init/3</seealso> function. + <p>Opens a handle to a tar file on the server, associated with <c>ChannelPid</c>. + The handle can be used for remote tar creation and extraction, as defined by the + <seealso marker="stdlib:erl_tar#init-3">erl_tar:init/3</seealso> function. </p> - <p>An example of writing and then reading a tar file:</p> - <code type="none"> - {ok,HandleWrite} = ssh_sftp:open_tar(ChannelPid, ?tar_file_name, [write]), - ok = erl_tar:add(HandleWrite, .... ), - ok = erl_tar:add(HandleWrite, .... ), - ... - ok = erl_tar:add(HandleWrite, .... ), - ok = erl_tar:close(HandleWrite), - - %% And for reading - {ok,HandleRead} = ssh_sftp:open_tar(ChannelPid, ?tar_file_name, [read]), - {ok,NameValueList} = erl_tar:extract(HandleRead,[memory]), - ok = erl_tar:close(HandleRead), - </code> - - <p>The <c>crypto</c> mode option is applied to the generated stream of bytes just prior to sending - them to the sftp server. This is intended for encryption but could of course be used for other + + <p> For code exampel see Section + <seealso marker="using_ssh">SFTP Client with TAR Compression and Encryption</seealso> in + the ssh Users Guide. </p> + + <p>The <c>crypto</c> mode option is applied to the generated stream of bytes prior to sending + them to the SFTP server. This is intended for encryption but can be used for other purposes. </p> <p>The <c>InitFun</c> is applied once - prior to any other crypto operation. The returned <c>CryptoState</c> is then folded into - repeated applications of the <c>EncryptFun</c> or <c>DecryptFun</c>. The binary returned - from those Funs are sent further to the remote sftp server. Finally - if doing encryption - - the <c>CloseFun</c> is applied to the last piece of data. The <c>CloseFun</c> is + prior to any other <c>crypto</c> operation. The returned <c>CryptoState</c> is then folded into + repeated applications of the <c>EncryptFun</c> or <c>DecryptFun</c>. The binary returned + from those funs are sent further to the remote SFTP server. Finally, if doing encryption, + the <c>CloseFun</c> is applied to the last piece of data. The <c>CloseFun</c> is responsible for padding (if needed) and encryption of that last piece. </p> <p>The <c>ChunkSize</c> defines the size of the <c>PlainBin</c>s that <c>EncodeFun</c> is applied - to. If the <c>ChunkSize</c> is <c>undefined</c> the size of the <c>PlainBin</c>s varies because - this is inteded for stream crypto while a fixed <c>ChunkSize</c> is intended for block crypto. It - is possible to change the <c>ChunkSize</c>s in the return from the <c>EncryptFun</c> or - <c>DecryptFun</c>. It is in fact possible to change the value between <c>pos_integer()</c> and - <c>undefined</c>. + to. If the <c>ChunkSize</c> is <c>undefined</c>, the size of the <c>PlainBin</c>s varies, + because this is intended for stream crypto, whereas a fixed <c>ChunkSize</c> is intended for block crypto. + <c>ChunkSize</c>s can be changed in the return from the <c>EncryptFun</c> or + <c>DecryptFun</c>. The value can be changed between <c>pos_integer()</c> and <c>undefined</c>. </p> - <p>The write and read example above can be extended with encryption and decryption:</p> - <code type="none"> - %% First three parameters depending on which crypto type we select: - Key = <<"This is a 256 bit key. abcdefghi">>, - Ivec0 = crypto:rand_bytes(16), - DataSize = 1024, % DataSize rem 16 = 0 for aes_cbc - - %% Initialization of the CryptoState, in this case it is the Ivector. - InitFun = fun() -> {ok, Ivec0, DataSize} end, - - %% How to encrypt: - EncryptFun = - fun(PlainBin,Ivec) -> - EncryptedBin = crypto:block_encrypt(aes_cbc256, Key, Ivec, PlainBin), - {ok, EncryptedBin, crypto:next_iv(aes_cbc,EncryptedBin)} - end, - - %% What to do with the very last block: - CloseFun = - fun(PlainBin, Ivec) -> - EncryptedBin = crypto:block_encrypt(aes_cbc256, Key, Ivec, - pad(16,PlainBin) %% Last chunk - ), - {ok, EncryptedBin} - end, - - Cw = {InitFun,EncryptFun,CloseFun}, - {ok,HandleWrite} = ssh_sftp:open_tar(ChannelPid, ?tar_file_name, [write,{crypto,Cw}]), - ok = erl_tar:add(HandleWrite, .... ), - ok = erl_tar:add(HandleWrite, .... ), - ... - ok = erl_tar:add(HandleWrite, .... ), - ok = erl_tar:close(HandleWrite), - - %% And for decryption (in this crypto example we could use the same InitFun - %% as for encryption): - DecryptFun = - fun(EncryptedBin,Ivec) -> - PlainBin = crypto:block_decrypt(aes_cbc256, Key, Ivec, EncryptedBin), - {ok, PlainBin, crypto:next_iv(aes_cbc,EncryptedBin)} - end, - - Cr = {InitFun,DecryptFun}, - {ok,HandleRead} = ssh_sftp:open_tar(ChannelPid, ?tar_file_name, [read,{crypto,Cw}]), - {ok,NameValueList} = erl_tar:extract(HandleRead,[memory]), - ok = erl_tar:close(HandleRead), - </code> + </desc> </func> <func> - <name>close(ChannelPid, Handle) -> </name> - <name>close(ChannelPid, Handle, Timeout) -> ok | {error, Reason}</name> - <fsummary>Close an open handle</fsummary> + <name>position(ChannelPid, Handle, Location) -></name> + <name>position(ChannelPid, Handle, Location, Timeout) -> {ok, NewPosition | {error, Error}</name> + <fsummary>Sets the file position of a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Handle = term()</v> + <v>Location = Offset + | {bof, Offset} | {cur, Offset} | {eof, Offset} | bof | cur | eof</v> + <v>Offset = integer()</v> <v>Timeout = timeout()</v> + <v>NewPosition = integer()</v> <v>Reason = term()</v> </type> <desc> - <p>Closes a handle to an open file or directory on the server.</p> + <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 + one of the following:</p> + <taglist> + <tag><c><![CDATA[Offset]]></c></tag> + <item> + <p>The same as <c><![CDATA[{bof, Offset}]]></c>.</p> + </item> + <tag><c><![CDATA[{bof, Offset}]]></c></tag> + <item> + <p>Absolute offset.</p> + </item> + <tag><c><![CDATA[{cur, Offset}]]></c></tag> + <item> + <p>Offset from the current position.</p> + </item> + <tag><c><![CDATA[{eof, Offset}]]></c></tag> + <item> + <p>Offset from the end of file.</p> + </item> + <tag><c><![CDATA[bof | cur | eof]]></c></tag> + <item> + <p>The same as eariler with <c><![CDATA[Offset]]></c> 0, + that is, <c><![CDATA[{bof, 0} | {cur, 0} | {eof, 0}]]></c>. + </p> + </item> + </taglist> </desc> </func> + <func> - <name>read(ChannelPid, Handle, Len) -> </name> - <name>read(ChannelPid, Handle, Len, Timeout) -> {ok, Data} | eof | {error, Error}</name> - <name>pread(ChannelPid, Handle, Position, Len) -> </name> + <name>pread(ChannelPid, Handle, Position, Len) -></name> <name>pread(ChannelPid, Handle, Position, Len, Timeout) -> {ok, Data} | eof | {error, Error}</name> - <fsummary>Read from an open file</fsummary> + <fsummary>Reads from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Handle = term()</v> @@ -336,47 +387,16 @@ <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[Data]]></c> is a binary, otherwise it is a string.</p> - <p>If the file is read past eof, only the remaining bytes - will be read and returned. If no bytes are read, <c><![CDATA[eof]]></c> - is returned.</p> - <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> - </desc> - </func> - <func> - <name>aread(ChannelPid, Handle, Len) -> {async, N} | {error, Error}</name> - <name>apread(ChannelPid, Handle, Position, Len) -> {async, N} | {error, Error}</name> - <fsummary>Read asynchronously from an open file</fsummary> - <type> - <v>ChannelPid = pid()</v> - <v>Handle = term()</v> - <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 - handle is valid, the function returns <c><![CDATA[{async, N}]]></c>, where N - is a term guaranteed to be unique between calls of <c><![CDATA[aread]]></c>. - 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>, - or <c><![CDATA[eof]]></c>, or <c><![CDATA[{error, Error}]]></c>.</p> - <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>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> + <func> - <name>write(ChannelPid, Handle, Data) -></name> - <name>write(ChannelPid, Handle, Data, Timeout) -> ok | {error, Error}</name> - <name>pwrite(ChannelPid, Handle, Position, Data) -> ok </name> + <name>pwrite(ChannelPid, Handle, Position, Data) -> ok</name> <name>pwrite(ChannelPid, Handle, Position, Data, Timeout) -> ok | {error, Error}</name> - <fsummary>Write to an open file</fsummary> + <fsummary>Writes to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Handle = term()</v> @@ -386,94 +406,59 @@ <v>Reason = term()</v> </type> <desc> - <p>Writes<c><![CDATA[data]]></c> to the file referenced by <c><![CDATA[Handle]]></c>. - The file should be opened with <c><![CDATA[write]]></c> or <c><![CDATA[append]]></c> - flag. Returns <c><![CDATA[ok]]></c> if successful or S<c><![CDATA[{error, Reason}]]></c> - otherwise.</p> - <p>Typical error reasons are:</p> - <taglist> - <tag><c><![CDATA[ebadf]]></c></tag> - <item> - <p>The file is not opened for writing.</p> - </item> - <tag><c><![CDATA[enospc]]></c></tag> - <item> - <p>There is a no space left on the device.</p> - </item> - </taglist> + <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> </func> - <func> - <name>awrite(ChannelPid, Handle, Data) -> ok | {error, Reason} </name> - <name>apwrite(ChannelPid, Handle, Position, Data) -> ok | {error, Reason}</name> - <fsummary>Write asynchronously to an open file</fsummary> + + + <func> + <name>read(ChannelPid, Handle, Len) -></name> + <name>read(ChannelPid, Handle, Len, Timeout) -> {ok, Data} | eof | {error, Error}</name> + <fsummary>Reads from an open file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Handle = term()</v> <v>Position = integer()</v> <v>Len = integer()</v> - <v>Data = binary()</v> <v>Timeout = timeout()</v> + <v>Data = string() | binary()</v> <v>Reason = term()</v> </type> <desc> - <p>Writes to an open file, without waiting for the result. If the - handle is valid, the function returns <c><![CDATA[{async, N}]]></c>, where N - is a term guaranteed to be unique between calls of - <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> - <p>The <c><![CDATA[apwrite]]></c> writes on a specified position, combining - the <c><![CDATA[position]]></c> and <c><![CDATA[awrite]]></c> operations.</p> + <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[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> + is returned.</p> </desc> </func> - <func> - <name>position(ChannelPid, Handle, Location) -> </name> - <name>position(ChannelPid, Handle, Location, Timeout) -> {ok, NewPosition | {error, Error}</name> - <fsummary>Seek position in open file</fsummary> + + <func> + <name>read_file(ChannelPid, File) -></name> + <name>read_file(ChannelPid, File, Timeout) -> {ok, Data} | {error, Reason}</name> + <fsummary>Reads a file.</fsummary> <type> - <v>ChannelPid = pid()</v> - <v>Handle = term()</v> - <v>Location = Offset | {bof, Offset} | {cur, Offset} | {eof, Offset} | bof | cur | eof</v> - <v>Offset = integer()</v> + <v>ChannelPid = pid()</v> + <v>File = string()</v> + <v>Data = binary()</v> <v>Timeout = timeout()</v> - <v>NewPosition = integer()</v> - <v>Reason = term()</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 - one of the following:</p> - <taglist> - <tag><c><![CDATA[Offset]]></c></tag> - <item> - <p>The same as <c><![CDATA[{bof, Offset}]]></c>.</p> - </item> - <tag><c><![CDATA[{bof, Offset}]]></c></tag> - <item> - <p>Absolute offset.</p> - </item> - <tag><c><![CDATA[{cur, Offset}]]></c></tag> - <item> - <p>Offset from the current position.</p> - </item> - <tag><c><![CDATA[{eof, Offset}]]></c></tag> - <item> - <p>Offset from the end of file.</p> - </item> - <tag><c><![CDATA[bof | cur | eof]]></c></tag> - <item> - <p>The same as above with <c><![CDATA[Offset]]></c> 0.</p> - </item> - </taglist> + <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> </desc> </func> - <func> - <name>read_file_info(ChannelPid, Name) -> </name> + + <func> + <name>read_file_info(ChannelPid, Name) -></name> <name>read_file_info(ChannelPid, Name, Timeout) -> {ok, FileInfo} | {error, Reason}</name> - <fsummary>Get information about a file</fsummary> + <fsummary>Gets information about a file.</fsummary> <type> <v>ChannelPid = pid()</v> <v>Name = string()</v> @@ -484,138 +469,191 @@ </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 <c><![CDATA[file:read_file_info/2]]></c>.</p> + <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> </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> - <fsummary>Get information about a symbolic link</fsummary> + + <func> + <name>read_link(ChannelPid, Name) -></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>Handle = term()</v> - <v>Timeout = timeout()</v> - <v>FileInfo = record()</v> + <v>Target = string()</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 - <c><![CDATA[file:read_link_info/2]]></c>.</p> + <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> </desc> </func> - <func> - <name>write_file_info(ChannelPid, Name, Info) -> </name> - <name>write_file_info(ChannelPid, Name, Info, Timeout) -> ok | {error, Reason}</name> - <fsummary>Write information for a file</fsummary> + + <func> + <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> <v>Name = string()</v> - <v>Info = record()</v> + <v>Handle = term()</v> <v>Timeout = timeout()</v> + <v>FileInfo = record()</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 <c><![CDATA[file:write_file_info]]></c>.</p> + <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> </desc> </func> + <func> - <name>read_link(ChannelPid, Name) -> </name> - <name>read_link(ChannelPid, Name, Timeout) -> {ok, Target} | {error, Reason}</name> - <fsummary>Read symbolic link</fsummary> + <name>rename(ChannelPid, OldName, NewName) -> </name> + <name>rename(ChannelPid, OldName, NewName, Timeout) -> ok | {error, Reason}</name> + <fsummary>Renames a file.</fsummary> <type> <v>ChannelPid = pid()</v> - <v>Name = string()</v> - <v>Target = string()</v> + <v>OldName = string()</v> + <v>NewName = string()</v> + <v>Timeout = timeout()</v> <v>Reason = term()</v> </type> <desc> - <p>Reads the link target from the symbolic link specified - by <c><![CDATA[name]]></c>, like <c><![CDATA[file:read_link/1]]></c>.</p> + <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> </desc> </func> + <func> - <name>make_symlink(ChannelPid, Name, Target) -> </name> - <name>make_symlink(ChannelPid, Name, Target, Timeout) -> ok | {error, Reason}</name> - <fsummary>Create symbolic link</fsummary> + <name>start_channel(ConnectionRef) -></name> + <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> + <fsummary>Starts an SFTP client.</fsummary> <type> - <v>ChannelPid = pid()</v> - <v>Name = string()</v> - <v>Target = string()</v> + <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>Creates a symbolic link pointing to <c><![CDATA[Target]]></c> with the - name <c><![CDATA[Name]]></c>, like <c><![CDATA[file:make_symlink/2]]></c>.</p> + <p>If no connection reference is provided, a connection is set + up, and the new connection is returned. An SSH channel process + is started to handle the communication with the SFTP server. + The returned <c>pid</c> for this process is to be used as input to + all other API functions in this module.</p> + + <p>Options:</p> + <taglist> + <tag><c><![CDATA[{timeout, timeout()}]]></c></tag> + <item> + <p>The time-out is passed to the <c>ssh_channel</c> start function, + and defaults to <c>infinity</c>.</p> + </item> + <tag> + <c><![CDATA[{sftp_vsn, integer()}]]></c> + </tag> + <item> + <p> + Desired SFTP protocol version. + The actual version is the minimum of + the desired version and the maximum supported + versions by the SFTP server. + </p> + </item> + </taglist> + <p>All other options are directly passed to + <seealso marker="ssh">ssh:connect/3</seealso> or ignored if a + connection is already provided.</p> </desc> </func> - <func> - <name>rename(ChannelPid, OldName, NewName) -> </name> - <name>rename(ChannelPid, OldName, NewName, Timeout) -> ok | {error, Reason}</name> - <fsummary>Rename a file</fsummary> + + <func> + <name>stop_channel(ChannelPid) -> ok</name> + <fsummary>Stops the SFTP client channel.</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 <c><![CDATA[file:rename/2]]></c></p> + <p>Stops an SFTP channel. Does not close the SSH connection. + Use <seealso marker="ssh#close-1">ssh:close/1</seealso> to close it.</p> </desc> </func> + <func> - <name>delete(ChannelPid, Name) -> </name> - <name>delete(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> - <fsummary>Delete a file</fsummary> + <name>write(ChannelPid, Handle, Data) -></name> + <name>write(ChannelPid, Handle, Data, Timeout) -> ok | {error, Error}</name> + <fsummary>Writes to an open file.</fsummary> <type> <v>ChannelPid = pid()</v> - <v>Name = string()</v> + <v>Handle = term()</v> + <v>Position = integer()</v> + <v>Data = iolist()</v> <v>Timeout = timeout()</v> <v>Reason = term()</v> </type> <desc> - <p>Deletes the file specified by <c><![CDATA[Name]]></c>, like - <c><![CDATA[file:delete/1]]></c></p> + <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> + 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>make_dir(ChannelPid, Name) -> </name> - <name>make_dir(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> - <fsummary>Create a directory</fsummary> + <name>write_file(ChannelPid, File, Iolist) -></name> + <name>write_file(ChannelPid, File, Iolist, Timeout) -> ok | {error, Reason}</name> + <fsummary>Writes a file.</fsummary> <type> <v>ChannelPid = pid()</v> - <v>Name = string()</v> + <v>File = string()</v> + <v>Iolist = iolist()</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> should - be a full path to a new directory. The directory can only be - created in an existing directory.</p> + <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> </desc> </func> + <func> - <name>del_dir(ChannelPid, Name) -> </name> - <name>del_dir(ChannelPid, Name, Timeout) -> ok | {error, Reason}</name> - <fsummary>Delete an empty directory</fsummary> + <name>write_file_info(ChannelPid, Name, Info) -></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>Deletes a directory specified by <c><![CDATA[Name]]></c>. - Note that the directory must be empty before it can be successfully deleted - </p> + <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> </desc> </func> - </funcs> - + </erlref> diff --git a/lib/ssh/doc/src/ssh_sftpd.xml b/lib/ssh/doc/src/ssh_sftpd.xml index 81c2acc575..bc2660f595 100644 --- a/lib/ssh/doc/src/ssh_sftpd.xml +++ b/lib/ssh/doc/src/ssh_sftpd.xml @@ -22,67 +22,73 @@ </legalnotice> <title>ssh_sftpd</title> + <prepared></prepared> + <docno></docno> <date>2005-09-22</date> + <rev></rev> <file>ssh_sftpd.sgml</file> </header> <module>ssh_sftpd</module> - <modulesummary>Specifies the channel process to handle an sftp subsystem.</modulesummary> + <modulesummary>Specifies the channel process to handle an SFTP subsystem.</modulesummary> <description> - <p>Specifies a channel process to handle a sftp subsystem.</p> + <p>Specifies a channel process to handle an SFTP subsystem.</p> </description> <section> - <title>DATA TYPES </title> - <p><c>subsystem_spec() = {subsystem_name(), {channel_callback(), channel_init_args()}} </c></p> - <p><c>subsystem_name() = "sftp"</c></p> - <p><c>channel_callback() = atom()</c> - Name of the erlang module implementing the - subsystem using the ssh_channel behavior see - <seealso marker="ssh_channel">ssh_channel(3)</seealso></p> - <p><c> channel_init_args() = list() - The one given as argument to function - subsystem_spec/1.</c></p> + <title>DATA TYPES</title> + <taglist> + <tag><c>subsystem_spec()</c></tag> + <item><p>= <c>{subsystem_name(), {channel_callback(), channel_init_args()}}</c></p></item> + <tag><c>subsystem_name()</c></tag> + <item><p>= <c>"sftp"</c></p></item> + <tag><c>channel_callback()</c></tag> + <item><p>= <c>atom()</c> - Name of the Erlang module implementing the subsystem using the + <c>ssh_channel</c> behavior, see the + <seealso marker="ssh_channel">ssh_channel(3)</seealso> manual page.</p></item> + <tag><c>channel_init_args()</c></tag> + <item><p>= <c>list()</c> - The one given as argument to function <c>subsystem_spec/1</c>.</p></item> + </taglist> </section> <funcs> <func> <name>subsystem_spec(Options) -> subsystem_spec()</name> - <fsummary>Returns the subsystem specification that allows an ssh daemon to handle the subsystem "sftp".</fsummary> + <fsummary>Returns the subsystem specification that allows an SSH daemon to handle the subsystem "sftp".</fsummary> <type> <v>Options = [{Option, Value}]</v> </type> <desc> - <p>Should be used together with ssh:daemon/[1,2,3]</p> - <p>Options are:</p> + <p>Is to be used together with <c>ssh:daemon/[1,2,3]</c></p> + <p>Options:</p> <taglist> <tag><c><![CDATA[{cwd, String}]]></c></tag> <item> - <p>Sets the initial current working directory for the - server.</p> + <p>Sets the initial current working directory for the server.</p> </item> <tag><c><![CDATA[{file_handler, CallbackModule}]]></c></tag> <item> <p>Determines which module to call for accessing - the file server. The default value is <c>ssh_sftpd_file</c> that uses the - <seealso marker="kernel:file">file</seealso> and <seealso marker="stdlib:filelib">filelib</seealso> API:s to access the standard OTP file - server. This option may be used to plug in + the file server. The default value is <c>ssh_sftpd_file</c>, which uses the + <seealso marker="kernel:file">file</seealso> and <seealso marker="stdlib:filelib">filelib</seealso> + APIs to access the standard OTP file server. This option can be used to plug in other file servers.</p> </item> <tag><c><![CDATA[{max_files, Integer}]]></c></tag> <item> <p>The default value is <c>0</c>, which means that there is no upper limit. - If supplied, the number of filenames returned to the sftp client per <c>READDIR</c> + If supplied, the number of filenames returned to the SFTP client per <c>READDIR</c> request is limited to at most the given value.</p> </item> <tag><c><![CDATA[{root, String}]]></c></tag> <item> - <p>Sets the sftp root directory. The user will then not be - able to see any files above this root. If for instance - the root is set to <c>/tmp</c> the user will see this - directory as <c>/</c> and if the user does cd <c>/etc</c> - the user will end up in <c>/tmp/etc</c>. + <p>Sets the SFTP root directory. Then the user cannot see any files + above this root. If, for example, the root directory is set to <c>/tmp</c>, + then the user sees this directory as <c>/</c>. If the user then writes + <c>cd /etc</c>, the user moves to <c>/tmp/etc</c>. </p> </item> <tag><c><![CDATA[{sftpd_vsn, integer()}]]></c></tag> <item> - <p>Sets the sftp version to use, defaults to 5. Version 6 is under + <p>Sets the SFTP version to use. Defaults to 5. Version 6 is under development and limited.</p> </item> </taglist> diff --git a/lib/ssh/doc/src/usersguide.xml b/lib/ssh/doc/src/usersguide.xml index 8ab14c2945..a9ed5fe21e 100644 --- a/lib/ssh/doc/src/usersguide.xml +++ b/lib/ssh/doc/src/usersguide.xml @@ -23,15 +23,16 @@ <title>SSH User's Guide</title> <prepared>OTP Team</prepared> + <docno></docno> <date>2012-10-11</date> + <rev></rev> <file>usersguide.xml</file> </header> <description> - <p>The <em>SSH</em> application implements the SSH (Secure Shell) protocol and - provides an SFTP (Secret File Transfer Protocol) client and server. + <p>The Erlang Secure Shell (SSH) application, <c>ssh</c>, implements the SSH Transport Layer Protocol and + provides SSH File Transfer Protocol (SFTP) clients and servers. </p> </description> <xi:include href="introduction.xml"/> - <xi:include href="ssh_protocol.xml"/> <xi:include href="using_ssh.xml"/> </part> diff --git a/lib/ssh/doc/src/using_ssh.xml b/lib/ssh/doc/src/using_ssh.xml index 46178d4018..cd7b64ac43 100644 --- a/lib/ssh/doc/src/using_ssh.xml +++ b/lib/ssh/doc/src/using_ssh.xml @@ -22,64 +22,70 @@ </legalnotice> - <title>Getting started</title> + <title>Getting Started</title> + <prepared></prepared> + <docno></docno> + <approved></approved> + <date></date> + <rev></rev> <file>using_ssh.xml</file> </header> <section> - <title> General information</title> - <p>The examples in the following sections use the utility function - <seealso marker="ssh#start-0"> ssh:start/0 </seealso> that starts - all needed applications (crypto, public_key and ssh). All examples - are run in an Erlang shell, or in a bash shell using openssh to - illustrate how the erlang ssh application can be used. The - examples are run as the user otptest on a local network where the - user is authorized to login in over ssh to the host "tarlop". If - nothing else is stated it is persumed that the otptest user has an - entry in tarlop's authorized_keys file (may log in via ssh without - entering a password). Also tarlop is a known host in the user - otptest's known_hosts file so that host verification can be done - without user interaction. + <title>General Information</title> + <p>The following examples use the utility function + <seealso marker="ssh#start-0"> ssh:start/0</seealso> to start + all needed applications (<c>crypto</c>, <c>public_key</c>, and <c>ssh</c>). + All examples are run in an Erlang shell, or in a bash shell, using <em>openssh</em> + to illustrate how the <c>ssh</c> application can be used. The + examples are run as the user <c>otptest</c> on a local network where the + user is authorized to log in over <c>ssh</c> to the host <em>tarlop</em>. + </p> + <p>If nothing else is stated, it is presumed that the <c>otptest</c> user + has an entry in the <em>authorized_keys</em> file of <em>tarlop</em> + (allowed to log in over <c>ssh</c> without entering a password). + Also, <em>tarlop</em> is a known host in the <c>known_hosts</c> + file of the user <c>otptest</c>. This means that host-verification + can be done without user-interaction. </p> </section> <section> - <title>Using the Erlang SSH Terminal Client</title> + <title>Using the Erlang ssh Terminal Client</title> - <p>The user otptest, that has bash as default shell, uses the - ssh:shell/1 client to connect to the openssh daemon running on a - host called tarlop. Note that currently this client is very simple - and you should not be expected to be as fancy as the openssh - client.</p> + <p>The user <c>otptest</c>, which has bash as default shell, uses the + <c>ssh:shell/1</c> client to connect to the <em>openssh</em> daemon running on a + host called <em>tarlop</em>:</p> <code type="erl" > 1> ssh:start(). ok 2> {ok, S} = ssh:shell("tarlop"). - >pwd + otptest@tarlop:> pwd /home/otptest - >exit + otptest@tarlop:> exit logout 3> </code> </section> <section> - <title>Running an Erlang SSH Daemon </title> + <marker id="Running an Erlang ssh Daemon"></marker> + <title>Running an Erlang ssh Daemon</title> - <p> The option system_dir must be a directory containing a host - key file and it defaults to /etc/ssh. For details see section + <p>The <c>system_dir</c> option must be a directory containing a host + key file and it defaults to <c>/etc/ssh</c>. For details, see Section Configuration Files in <seealso marker="SSH_app">ssh(6)</seealso>. </p> - <note><p>Normally the /etc/ssh directory is only readable by root. </p> + <note><p>Normally, the <c>/etc/ssh</c> directory is only readable by root.</p> </note> - <p> The option user_dir defaults to the users ~/.ssh directory</p> + <p>The option <c>user_dir</c> defaults to directory <c>users ~/.ssh</c>.</p> - <p>In the following example we generate new keys and host keys as - to be able to run the example without having root privileges</p> + <p><em>Step 1.</em> To run the example without root privileges, + generate new keys and host keys:</p> <code> $bash> ssh-keygen -t rsa -f /tmp/ssh_daemon/ssh_host_rsa_key @@ -88,19 +94,22 @@ [...] </code> - <p>Create the file /tmp/otptest_user/.ssh/authorized_keys and add the content - of /tmp/otptest_user/.ssh/id_rsa.pub Now we can do</p> + <p><em>Step 2.</em> Create the file <c>/tmp/otptest_user/.ssh/authorized_keys</c> + and add the content of <c>/tmp/otptest_user/.ssh/id_rsa.pub</c>.</p> + + <p><em>Step 3.</em> Start the Erlang <c>ssh</c> daemon:</p> <code type="erl"> 1> ssh:start(). ok - 2> {ok, Sshd} = ssh:daemon(8989, [{system_dir, "/tmp/ssh_daemon"}, - {user_dir, "/tmp/otptest_user/.ssh"}]). + 2> {ok, Sshd} = ssh:daemon(8989, [{system_dir, "/tmp/ssh_daemon"}, + {user_dir, "/tmp/otptest_user/.ssh"}]). {ok,<0.54.0>} 3> </code> - <p>Use the openssh client from a shell to connect to the Erlang ssh daemon.</p> + <p><em>Step 4.</em> Use the <em>openssh</em> client from a shell to connect + to the Erlang <c>ssh</c> daemon:</p> <code> $bash> ssh tarlop -p 8989 -i /tmp/otptest_user/.ssh/id_rsa\ @@ -113,9 +122,12 @@ 1> </code> - <p>There are two ways of shutting down an SSH daemon</p> + <p>There are two ways of shutting down an <c>ssh</c> daemon, + see <em>Step 5a</em> and <em>Step 5b</em>.</p> - <p>1: Stops the listener, but leaves existing connections started by the listener up and running.</p> + <p><em>Step 5a.</em> Shut down the Erlang <c>ssh</c> daemon so that it + stops the listener but leaves existing connections, started by the listener, + operational:</p> <code type="erl"> 3> ssh:stop_listener(Sshd). @@ -123,7 +135,8 @@ 4> </code> - <p>2: Stops the listener and all connections started by the listener.</p> + <p><em>Step 5b.</em> Shut down the Erlang <c>ssh</c> daemon so that it + stops the listener and all connections started by the listener:</p> <code type="erl"> 3> ssh:stop_daemon(Sshd) @@ -134,17 +147,18 @@ </section> <section> - <title>One Time Execution</title> + <title>One-Time Execution</title> - <p>In the following example the Erlang shell is the client process - that receives the channel replies. </p> + <p>In the following example, the Erlang shell is the client process + that receives the channel replies.</p> - <note><p> If you run this example - in your environment you may get fewer or more messages back as - this depends on the OS and shell on the machine running the ssh - daemon. See also <seealso marker="ssh_connection#exec-4">ssh_connection:exec/4</seealso> + <note><p>The number of received messages in this example depends on which OS + and which shell that is used on the machine running the <c>ssh</c> daemon. + See also <seealso marker="ssh_connection#exec-4">ssh_connection:exec/4</seealso>. </p></note> + <p>Do a one-time execution of a remote command over <c>ssh</c>:</p> + <code type="erl" > 1> ssh:start(). ok @@ -162,7 +176,8 @@ 6> </code> - <p>Note only the channel is closed the connection is still up and can handle other channels</p> + <p>Notice that only the channel is closed. The connection is still up and can + handle other channels:</p> <code type="erl" > 6> {ok, NewChannelId} = ssh_connection:session_channel(ConnectionRef, infinity). @@ -172,19 +187,22 @@ </section> <section> - <title>SFTP (SSH File Transport Protocol) server</title> + <title>SFTP Server</title> + + <p>Start the Erlang <c>ssh</c> daemon with the SFTP subsystem:</p> <code type="erl" > 1> ssh:start(). ok - 2> ssh:daemon(8989, [{system_dir, "/tmp/ssh_daemon"}, - {user_dir, "/tmp/otptest_user/.ssh"}, - {subsystems, [ssh_sftpd:subsystem_spec([{cwd, "/tmp/sftp/example"}])]}]). + 2> ssh:daemon(8989, [{system_dir, "/tmp/ssh_daemon"}, + {user_dir, "/tmp/otptest_user/.ssh"}, + {subsystems, [ssh_sftpd:subsystem_spec([{cwd, "/tmp/sftp/example"}]) + ]}]). {ok,<0.54.0>} 3> </code> - <p> Run the openssh sftp client</p> + <p>Run the OpenSSH SFTP client:</p> <code type="erl"> $bash> sftp -oPort=8989 -o IdentityFile=/tmp/otptest_user/.ssh/id_rsa\ @@ -197,7 +215,9 @@ </section> <section> - <title>SFTP (SSH File Transport Protocol) client</title> + <title>SFTP Client</title> + + <p>Fetch a file with the Erlang SFTP client:</p> <code type="erl" > 1> ssh:start(). @@ -210,10 +230,77 @@ </section> <section> - <title>Creating a subsystem</title> + <title>SFTP Client with TAR Compression and Encryption</title> + + <p>Example of writing and then reading a tar file follows:</p> + <code type="erlang"> + {ok,HandleWrite} = ssh_sftp:open_tar(ChannelPid, ?tar_file_name, [write]), + ok = erl_tar:add(HandleWrite, .... ), + ok = erl_tar:add(HandleWrite, .... ), + ... + ok = erl_tar:add(HandleWrite, .... ), + ok = erl_tar:close(HandleWrite), + + %% And for reading + {ok,HandleRead} = ssh_sftp:open_tar(ChannelPid, ?tar_file_name, [read]), + {ok,NameValueList} = erl_tar:extract(HandleRead,[memory]), + ok = erl_tar:close(HandleRead), + </code> + + <p>The previous write and read example can be extended with encryption and decryption as follows:</p> + <code type="erlang"> +%% First three parameters depending on which crypto type we select: +Key = <<"This is a 256 bit key. abcdefghi">>, +Ivec0 = crypto:rand_bytes(16), +DataSize = 1024, % DataSize rem 16 = 0 for aes_cbc + +%% Initialization of the CryptoState, in this case it is the Ivector. +InitFun = fun() -> {ok, Ivec0, DataSize} end, + +%% How to encrypt: +EncryptFun = + fun(PlainBin,Ivec) -> + EncryptedBin = crypto:block_encrypt(aes_cbc256, Key, Ivec, PlainBin), + {ok, EncryptedBin, crypto:next_iv(aes_cbc,EncryptedBin)} + end, + +%% What to do with the very last block: +CloseFun = + fun(PlainBin, Ivec) -> + EncryptedBin = crypto:block_encrypt(aes_cbc256, Key, Ivec, + pad(16,PlainBin) %% Last chunk + ), + {ok, EncryptedBin} + end, + +Cw = {InitFun,EncryptFun,CloseFun}, +{ok,HandleWrite} = ssh_sftp:open_tar(ChannelPid, ?tar_file_name, [write,{crypto,Cw}]), +ok = erl_tar:add(HandleWrite, .... ), +ok = erl_tar:add(HandleWrite, .... ), +... +ok = erl_tar:add(HandleWrite, .... ), +ok = erl_tar:close(HandleWrite), + +%% And for decryption (in this crypto example we could use the same InitFun +%% as for encryption): +DecryptFun = + fun(EncryptedBin,Ivec) -> + PlainBin = crypto:block_decrypt(aes_cbc256, Key, Ivec, EncryptedBin), + {ok, PlainBin, crypto:next_iv(aes_cbc,EncryptedBin)} + end, + +Cr = {InitFun,DecryptFun}, +{ok,HandleRead} = ssh_sftp:open_tar(ChannelPid, ?tar_file_name, [read,{crypto,Cw}]), +{ok,NameValueList} = erl_tar:extract(HandleRead,[memory]), +ok = erl_tar:close(HandleRead), + </code> + </section> + + <section> + <title>Creating a Subsystem</title> - <p>A very small SSH subsystem that echos N bytes could be implemented like this. - See also <seealso marker="ssh_channel"> ssh_channel(3)</seealso> </p> + <p>A small <c>ssh</c> subsystem that echoes N bytes can be implemented as shown + in the following example:</p> <code type="erl" > -module(ssh_echo_server). @@ -267,14 +354,16 @@ terminate(_Reason, _State) -> ok. </code> - <p>And run like this on the host tarlop with the keys generated in section 3.3</p> + <p>The subsystem can be run on the host <em>tarlop</em> with the generated keys, + as described in Section <seealso marker="#Running an Erlang ssh Daemon"> + Running an Erlang ssh Daemon</seealso>:</p> <code type="erl" > 1> ssh:start(). ok - 2> ssh:daemon(8989, [{system_dir, "/tmp/ssh_daemon"}, - {user_dir, "/tmp/otptest_user/.ssh"} - {subsystems, [{"echo_n", {ssh_echo_server, [10]}}]}]). + 2> ssh:daemon(8989, [{system_dir, "/tmp/ssh_daemon"}, + {user_dir, "/tmp/otptest_user/.ssh"} + {subsystems, [{"echo_n", {ssh_echo_server, [10]}}]}]). {ok,<0.54.0>} 3> </code> @@ -293,6 +382,7 @@ terminate(_Reason, _State) -> {ssh_msg, <0.57.0>, {closed, 0}} 7> {error, closed} = ssh_connection:send(ConnectionRef, ChannelId, "10", infinity). </code> +<p>See also <seealso marker="ssh_channel"> ssh_channel(3)</seealso>.</p> </section> diff --git a/lib/ssh/examples/Makefile b/lib/ssh/examples/Makefile index de019f75b5..9280c42076 100644 --- a/lib/ssh/examples/Makefile +++ b/lib/ssh/examples/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2012. All Rights Reserved. +# Copyright Ericsson AB 2005-2015. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -38,7 +38,8 @@ RELSYSDIR = $(RELEASE_PATH)/lib/ssh-$(VSN) MODULES = \ - ssh_sample_cli + ssh_sample_cli \ + ssh_device.erl ERL_FILES= $(MODULES:=.erl) diff --git a/lib/ssh/examples/ssh_device.erl b/lib/ssh/examples/ssh_device.erl new file mode 100644 index 0000000000..f6be812915 --- /dev/null +++ b/lib/ssh/examples/ssh_device.erl @@ -0,0 +1,62 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssh_device). + +%% api +-export([ssh_device/5]). + +%%% I wrote this because of i think a fully ssh client sample will be easy to start the ssh module better than +%%% go though each function file. +ssh_device(Host, Port, User, Pass, Cmd) -> + ssh:start(), + case ssh:connect(Host, Port, + [{user, User}, {password, Pass}, + {silently_accept_hosts, true}, {quiet_mode, true}]) + of + {ok, Conn} -> + {ok, ChannelId} = ssh_connection:session_channel(Conn, + infinity), + ssh_connection:exec(Conn, ChannelId, Cmd, infinity), + Init_rep = <<>>, + wait_for_response(Conn, Host, Init_rep), + ssh:close(Conn); + {error, nxdomain} -> + {error,nxdomain} + end. + +%%-------------------------------------------------------------------- +%%% Internal application API +%%-------------------------------------------------------------------- +wait_for_response(Conn, Host, Acc) -> + receive + {ssh_cm, Conn, Msg} -> + case Msg of + {closed, _ChannelId} -> + {ok,Acc}; + {data, _, _, A} -> + Acc2 = <<Acc/binary, A/binary>>, + wait_for_response(Conn, Host, Acc2); + _ -> + wait_for_response(Conn, Host, Acc) + end + after + 5000 -> + {error,timeout} + end. diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index b2b2994eed..e76c110c04 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -19,61 +19,9 @@ {"%VSN%", [ - {"3.0.8", [{load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_xfer]}, - {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, - {load_module, ssh, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_xfer, soft_purge, soft_purge, []} - ]}, - {"3.0.7", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, - {load_module, ssh_info, soft_purge, soft_purge, []}, - {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]}, - {"3.0.6", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, - {load_module, ssh_info, soft_purge, soft_purge, []}, - {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]}, {<<".*">>, [{restart_application, ssh}]} ], [ - {"3.0.8", [{load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_sftp, soft_purge, soft_purge, []}, - {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, - {load_module, ssh, soft_purge, soft_purge, []}, - {load_module, ssh_xfer, soft_purge, soft_purge, []} - ]}, - {"3.0.7", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, - {load_module, ssh_info, soft_purge, soft_purge, []}, - {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]}, - {"3.0.6", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, - {load_module, ssh_info, soft_purge, soft_purge, []}, - {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]}, - {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]}, {<<".*">>, [{restart_application, ssh}]} ] }. diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index eae33e3683..d4b02a024e 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -345,9 +345,16 @@ handle_option([{parallel_login, _} = Opt|Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([parallel_login|Rest], SocketOptions, SshOptions) -> handle_option(Rest, SocketOptions, [handle_ssh_option({parallel_login,true}) | SshOptions]); +handle_option([{minimal_remote_max_packet_size, _} = Opt|Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); +handle_option([{id_string, _ID} = Opt|Rest], SocketOptions, SshOptions) -> + handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]); handle_option([Opt | Rest], SocketOptions, SshOptions) -> handle_option(Rest, [handle_inet_option(Opt) | SocketOptions], SshOptions). + +handle_ssh_option({minimal_remote_max_packet_size, Value} = Opt) when is_integer(Value), Value >=0 -> + Opt; handle_ssh_option({system_dir, Value} = Opt) when is_list(Value) -> Opt; handle_ssh_option({user_dir, Value} = Opt) when is_list(Value) -> @@ -434,6 +441,10 @@ handle_ssh_option({idle_time, Value} = Opt) when is_integer(Value), Value > 0 -> Opt; handle_ssh_option({rekey_limit, Value} = Opt) when is_integer(Value) -> Opt; +handle_ssh_option({id_string, random}) -> + {id_string, {random,2,5}}; %% 2 - 5 random characters +handle_ssh_option({id_string, ID} = Opt) when is_list(ID) -> + Opt; handle_ssh_option(Opt) -> throw({error, {eoptions, Opt}}). diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index 6c443eeb9c..34988f17b6 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -43,7 +43,7 @@ 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, SockOpts)) of + case (catch do_socket_listen(Callback, Port, [{active, false} | SockOpts])) of {ok, ListenSocket} -> proc_lib:init_ack(Parent, {ok, self()}), acceptor_loop(Callback, diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index e97bf9ceeb..388c080d99 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -326,9 +326,7 @@ channel_data(ChannelId, DataType, Data, SendDataType, SendData)} end, SendList), - FlowCtrlMsgs = flow_control(Replies, - Channel, - Cache), + FlowCtrlMsgs = flow_control(Replies, Channel, Cache), {{replies, Replies ++ FlowCtrlMsgs}, Connection}; _ -> gen_fsm:reply(From, {error, closed}), @@ -470,18 +468,31 @@ handle_msg(#ssh_msg_channel_window_adjust{recipient_channel = ChannelId, handle_msg(#ssh_msg_channel_open{channel_type = "session" = Type, sender_channel = RemoteId, initial_window_size = WindowSz, - maximum_packet_size = PacketSz}, Connection0, server) -> - - try setup_session(Connection0, RemoteId, - Type, WindowSz, PacketSz) of - Result -> - Result - catch _:_ -> + maximum_packet_size = PacketSz}, + #connection{options = SSHopts} = Connection0, + server) -> + MinAcceptedPackSz = proplists:get_value(minimal_remote_max_packet_size, SSHopts, 0), + + if + MinAcceptedPackSz =< PacketSz -> + try setup_session(Connection0, RemoteId, + Type, WindowSz, PacketSz) of + Result -> + Result + catch _:_ -> + FailMsg = channel_open_failure_msg(RemoteId, + ?SSH_OPEN_CONNECT_FAILED, + "Connection refused", "en"), + {{replies, [{connection_reply, FailMsg}]}, + Connection0} + end; + + MinAcceptedPackSz > PacketSz -> FailMsg = channel_open_failure_msg(RemoteId, - ?SSH_OPEN_CONNECT_FAILED, - "Connection refused", "en"), - {{replies, [{connection_reply, FailMsg}]}, - Connection0} + ?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 = "session", @@ -501,41 +512,57 @@ handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip" = Type, initial_window_size = RWindowSz, maximum_packet_size = RPacketSz, data = Data}, - #connection{channel_cache = Cache} = Connection0, server) -> + #connection{channel_cache = Cache, + options = SSHopts} = Connection0, server) -> <<?UINT32(ALen), Address:ALen/binary, ?UINT32(Port), ?UINT32(OLen), Orig:OLen/binary, ?UINT32(OrigPort)>> = Data, - case bound_channel(Address, Port, Connection0) of - undefined -> + 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_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}, - 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} + ?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) -> @@ -917,7 +944,8 @@ start_channel(Cb, Id, Args, SubSysSup, Exec) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -setup_session(#connection{channel_cache = Cache} = Connection0, +setup_session(#connection{channel_cache = Cache + } = Connection0, RemoteId, Type, WindowSize, PacketSize) -> {ChannelId, Connection} = new_channel_id(Connection0), @@ -929,6 +957,7 @@ setup_session(#connection{channel_cache = Cache} = Connection0, recv_packet_size = ?DEFAULT_PACKET_SIZE, send_window_size = WindowSize, send_packet_size = PacketSize, + send_buf = queue:new(), remote_id = RemoteId }, ssh_channel:cache_update(Cache, Channel), @@ -1024,63 +1053,74 @@ request_reply_or_data(#channel{local_id = ChannelId, user = ChannelPid}, update_send_window(Channel, _, undefined, #connection{channel_cache = Cache}) -> - do_update_send_window(Channel, Channel#channel.send_buf, Cache); + do_update_send_window(Channel, Cache); -update_send_window(Channel, DataType, Data, +update_send_window(#channel{send_buf = SendBuffer} = Channel, DataType, Data, #connection{channel_cache = Cache}) -> - do_update_send_window(Channel, Channel#channel.send_buf ++ [{DataType, Data}], Cache). - -do_update_send_window(Channel0, Buf0, Cache) -> - {Buf1, NewSz, Buf2} = get_window(Buf0, - Channel0#channel.send_packet_size, - Channel0#channel.send_window_size), + do_update_send_window(Channel#channel{send_buf = queue:in({DataType, Data}, SendBuffer)}, + Cache). - Channel = Channel0#channel{send_window_size = NewSz, send_buf = Buf2}, +do_update_send_window(Channel0, Cache) -> + {SendMsgs, Channel} = get_window(Channel0, []), ssh_channel:cache_update(Cache, Channel), - {Buf1, Channel}. - -get_window(Bs, PSz, WSz) -> - get_window(Bs, PSz, WSz, []). - -get_window(Bs, _PSz, 0, Acc) -> - {lists:reverse(Acc), 0, Bs}; -get_window([B0 = {DataType, Bin} | Bs], PSz, WSz, Acc) -> - BSz = size(Bin), - if BSz =< WSz -> %% will fit into window - if BSz =< PSz -> %% will fit into a packet - get_window(Bs, PSz, WSz-BSz, [B0|Acc]); - true -> %% split into packet size - <<Bin1:PSz/binary, Bin2/binary>> = Bin, - get_window([setelement(2, B0, Bin2) | Bs], - PSz, WSz-PSz, - [{DataType, Bin1}|Acc]) + {SendMsgs, Channel}. + +get_window(#channel{send_window_size = 0 + } = Channel, Acc) -> + {lists:reverse(Acc), Channel}; +get_window(#channel{send_packet_size = 0 + } = Channel, Acc) -> + {lists:reverse(Acc), Channel}; +get_window(#channel{send_buf = Buffer, + send_packet_size = PacketSize, + send_window_size = WindowSize0 + } = Channel, Acc0) -> + case queue:out(Buffer) of + {{value, {_, Data} = Msg}, NewBuffer} -> + case handle_send_window(Msg, size(Data), PacketSize, WindowSize0, Acc0) of + {WindowSize, Acc, {_, <<>>}} -> + {lists:reverse(Acc), Channel#channel{send_window_size = WindowSize, + send_buf = NewBuffer}}; + {WindowSize, Acc, Rest} -> + get_window(Channel#channel{send_window_size = WindowSize, + send_buf = queue:in_r(Rest, NewBuffer)}, Acc) end; - WSz =< PSz -> %% use rest of window - <<Bin1:WSz/binary, Bin2/binary>> = Bin, - get_window([setelement(2, B0, Bin2) | Bs], - PSz, WSz-WSz, - [{DataType, Bin1}|Acc]); - true -> %% use packet size - <<Bin1:PSz/binary, Bin2/binary>> = Bin, - get_window([setelement(2, B0, Bin2) | Bs], - PSz, WSz-PSz, - [{DataType, Bin1}|Acc]) + {empty, NewBuffer} -> + {[], Channel#channel{send_buf = NewBuffer}} + end. + +handle_send_window(Msg = {Type, Data}, Size, PacketSize, WindowSize, Acc) when Size =< WindowSize -> + case Size =< PacketSize of + true -> + {WindowSize - Size, [Msg | Acc], {Type, <<>>}}; + false -> + <<Msg1:PacketSize/binary, Msg2/binary>> = Data, + {WindowSize - PacketSize, [{Type, Msg1} | Acc], {Type, Msg2}} end; -get_window([], _PSz, WSz, Acc) -> - {lists:reverse(Acc), WSz, []}. +handle_send_window({Type, Data}, _, PacketSize, WindowSize, Acc) when WindowSize =< PacketSize -> + <<Msg1:WindowSize/binary, Msg2/binary>> = Data, + {WindowSize - WindowSize, [{Type, Msg1} | Acc], {Type, Msg2}}; +handle_send_window({Type, Data}, _, PacketSize, WindowSize, Acc) -> + <<Msg1:PacketSize/binary, Msg2/binary>> = Data, + {WindowSize - PacketSize, [{Type, Msg1} | Acc], {Type, Msg2}}. flow_control(Channel, Cache) -> flow_control([window_adjusted], Channel, Cache). - + flow_control([], Channel, Cache) -> ssh_channel:cache_update(Cache, Channel), []; - flow_control([_|_], #channel{flow_control = From, - send_buf = []} = Channel, Cache) when From =/= undefined -> - [{flow_control, Cache, Channel, From, ok}]; + send_buf = Buffer} = Channel, Cache) when From =/= undefined -> + case queue:is_empty(Buffer) of + true -> + ssh_channel:cache_update(Cache, Channel#channel{flow_control = undefined}), + [{flow_control, Cache, Channel, From, ok}]; + false -> + [] + end; flow_control(_,_,_) -> - []. + []. pty_req(ConnectionHandler, Channel, Term, Width, Height, PixWidth, PixHeight, PtyOpts, TimeOut) -> diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 68523aa72b..4dea284071 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -70,6 +70,7 @@ undecoded_packet_length, % integer() key_exchange_init_msg, % #ssh_msg_kexinit{} renegotiate = false, % boolean() + last_size_rekey = 0, connection_queue, address, port, @@ -635,7 +636,8 @@ handle_event(renegotiate, StateName, State) -> %% Rekey due to sent data limit reached? handle_event(data_size, connected, #state{ssh_params = Ssh0} = State) -> - {ok, [{send_oct,Sent}]} = inet:getstat(State#state.socket, [send_oct]), + {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]), case Sent >= MaxSent of @@ -645,7 +647,8 @@ handle_event(data_size, connected, #state{ssh_params = Ssh0} = State) -> {next_state, kexinit, next_packet(State#state{ssh_params = Ssh, key_exchange_init_msg = KeyInitMsg, - renegotiate = true})}; + renegotiate = true, + last_size_rekey = Sent0})}; _ -> {next_state, connected, next_packet(State)} end; @@ -751,7 +754,9 @@ handle_sync_event({open, ChannelPid, Type, InitialWindowSize, MaxPacketSize, Dat user = ChannelPid, local_id = ChannelId, recv_window_size = InitialWindowSize, - recv_packet_size = MaxPacketSize}, + 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), @@ -1241,10 +1246,9 @@ event(Event, StateName, State) -> handle_disconnect(DisconnectMsg, State); throw:{ErrorToDisplay, #ssh_msg_disconnect{} = DisconnectMsg} -> handle_disconnect(DisconnectMsg, State, ErrorToDisplay); - _:Error -> - log_error(Error), + _:_ -> handle_disconnect(#ssh_msg_disconnect{code = error_code(StateName), - description = "Internal error", + description = "Invalid state", language = "en"}, State) end. error_code(key_exchange) -> diff --git a/lib/ssh/src/ssh_info.erl b/lib/ssh/src/ssh_info.erl index e5a8666af0..9c79d773a7 100644 --- a/lib/ssh/src/ssh_info.erl +++ b/lib/ssh/src/ssh_info.erl @@ -27,18 +27,21 @@ -compile(export_all). print() -> + print(user). + +print(D) -> try supervisor:which_children(ssh_sup) of _ -> - io:nl(), - print_general(), - io:nl(), - underline("Client part", $=), - print_clients(), - io:nl(), - underline("Server part", $=), - print_servers(), - io:nl(), + io:nl(D), + print_general(D), + io:nl(D), + underline(D, "Client part", $=), + print_clients(D), + io:nl(D), + underline(D, "Server part", $=), + print_servers(D), + io:nl(D), %% case os:type() of %% {unix,_} -> %% io:nl(), @@ -50,90 +53,95 @@ print() -> %% catch io:format(os:cmd("netstat -tpn")); %% _ -> ok %% end, - underline("Supervisors", $=), - walk_sups(ssh_sup), - io:nl() + underline(D, "Supervisors", $=), + walk_sups(D, ssh_sup), + io:nl(D) catch _:_ -> - io:format("Ssh not found~n",[]) + io:format(D,"Ssh not found~n",[]) end. %%%================================================================ -print_general() -> +print_general(D) -> {_Name, Slogan, Ver} = lists:keyfind(ssh,1,application:which_applications()), - underline(io_lib:format("~s ~s", [Slogan, Ver]), $=), - io:format('This printout is generated ~s. ~n',[datetime()]). + underline(D, io_lib:format("~s ~s", [Slogan, Ver]), $=), + io:format(D, 'This printout is generated ~s. ~n',[datetime()]). %%%================================================================ -print_clients() -> +print_clients(D) -> + PrintClient = fun(X) -> print_client(D,X) end, try - lists:foreach(fun print_client/1, supervisor:which_children(sshc_sup)) + lists:foreach(PrintClient, supervisor:which_children(sshc_sup)) catch C:E -> - io:format('***FAILED: ~p:~p~n',[C,E]) + io:format(D, '***FAILED: ~p:~p~n',[C,E]) end. -print_client({undefined,Pid,supervisor,[ssh_connection_handler]}) -> +print_client(D, {undefined,Pid,supervisor,[ssh_connection_handler]}) -> {{Local,Remote},_Str} = ssh_connection_handler:get_print_info(Pid), - io:format(" Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]); -print_client(Other) -> - io:format(" [[Other 1: ~p]]~n",[Other]). + io:format(D, " Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]); +print_client(D, Other) -> + io:format(D, " [[Other 1: ~p]]~n",[Other]). %%%================================================================ -print_servers() -> +print_servers(D) -> + PrintServer = fun(X) -> print_server(D,X) end, try - lists:foreach(fun print_server/1, supervisor:which_children(sshd_sup)) + lists:foreach(PrintServer, supervisor:which_children(sshd_sup)) catch C:E -> - io:format('***FAILED: ~p:~p~n',[C,E]) + io:format(D, '***FAILED: ~p:~p~n',[C,E]) end. -print_server({{server,ssh_system_sup,LocalHost,LocalPort},Pid,supervisor,[ssh_system_sup]}) when is_pid(Pid) -> - io:format('Local=~s (~p children)~n',[fmt_host_port({LocalHost,LocalPort}), - ssh_acceptor:number_of_connections(Pid)]), - lists:foreach(fun print_system_sup/1, supervisor:which_children(Pid)); -print_server(Other) -> - io:format(" [[Other 2: ~p]]~n",[Other]). +print_server(D, {{server,ssh_system_sup,LocalHost,LocalPort},Pid,supervisor,[ssh_system_sup]}) when is_pid(Pid) -> + io:format(D, 'Local=~s (~p children)~n',[fmt_host_port({LocalHost,LocalPort}), + ssh_acceptor:number_of_connections(Pid)]), + PrintSystemSup = fun(X) -> print_system_sup(D,X) end, + lists:foreach(PrintSystemSup, supervisor:which_children(Pid)); +print_server(D, Other) -> + io:format(D, " [[Other 2: ~p]]~n",[Other]). -print_system_sup({Ref,Pid,supervisor,[ssh_subsystem_sup]}) when is_reference(Ref), +print_system_sup(D, {Ref,Pid,supervisor,[ssh_subsystem_sup]}) when is_reference(Ref), is_pid(Pid) -> - lists:foreach(fun print_channels/1, supervisor:which_children(Pid)); -print_system_sup({{ssh_acceptor_sup,LocalHost,LocalPort}, Pid,supervisor, [ssh_acceptor_sup]}) when is_pid(Pid) -> - io:format(" [Acceptor for ~s]~n",[fmt_host_port({LocalHost,LocalPort})]); -print_system_sup(Other) -> - io:format(" [[Other 3: ~p]]~n",[Other]). - -print_channels({{server,ssh_channel_sup,_,_},Pid,supervisor,[ssh_channel_sup]}) when is_pid(Pid) -> - lists:foreach(fun print_channel/1, supervisor:which_children(Pid)); -print_channels(Other) -> - io:format(" [[Other 4: ~p]]~n",[Other]). - - -print_channel({Ref,Pid,worker,[ssh_channel]}) when is_reference(Ref), - is_pid(Pid) -> + PrintChannels = fun(X) -> print_channels(D,X) end, + lists:foreach(PrintChannels, supervisor:which_children(Pid)); +print_system_sup(D, {{ssh_acceptor_sup,LocalHost,LocalPort}, Pid,supervisor, [ssh_acceptor_sup]}) when is_pid(Pid) -> + io:format(D, " [Acceptor for ~s]~n",[fmt_host_port({LocalHost,LocalPort})]); +print_system_sup(D, Other) -> + io:format(D, " [[Other 3: ~p]]~n",[Other]). + +print_channels(D, {{server,ssh_channel_sup,_,_},Pid,supervisor,[ssh_channel_sup]}) when is_pid(Pid) -> + PrintChannel = fun(X) -> print_channel(D,X) end, + lists:foreach(PrintChannel, supervisor:which_children(Pid)); +print_channels(D, Other) -> + io:format(D, " [[Other 4: ~p]]~n",[Other]). + + +print_channel(D, {Ref,Pid,worker,[ssh_channel]}) when is_reference(Ref), + is_pid(Pid) -> {{ConnManager,ChannelID}, Str} = ssh_channel:get_print_info(Pid), {{Local,Remote},StrM} = ssh_connection_handler:get_print_info(ConnManager), - io:format(' ch ~p: ~s ~s',[ChannelID, StrM, Str]), - io:format(" Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]); -print_channel(Other) -> - io:format(" [[Other 5: ~p]]~n",[Other]). + io:format(D, ' ch ~p: ~s ~s',[ChannelID, StrM, Str]), + io:format(D, " Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]); +print_channel(D, Other) -> + io:format(D, " [[Other 5: ~p]]~n",[Other]). %%%================================================================ -define(inc(N), (N+4)). -walk_sups(StartPid) -> - io:format("Start at ~p, ~s.~n",[StartPid,dead_or_alive(StartPid)]), - walk_sups(children(StartPid), _Indent=?inc(0)). +walk_sups(D, StartPid) -> + io:format(D, "Start at ~p, ~s.~n",[StartPid,dead_or_alive(StartPid)]), + walk_sups(D, children(StartPid), _Indent=?inc(0)). -walk_sups([H={_,Pid,SupOrWorker,_}|T], Indent) -> - indent(Indent), io:format('~200p ~p is ~s~n',[H,Pid,dead_or_alive(Pid)]), +walk_sups(D, [H={_,Pid,SupOrWorker,_}|T], Indent) -> + indent(D, Indent), io:format(D, '~200p ~p is ~s~n',[H,Pid,dead_or_alive(Pid)]), case SupOrWorker of - supervisor -> walk_sups(children(Pid), ?inc(Indent)); + supervisor -> walk_sups(D, children(Pid), ?inc(Indent)); _ -> ok end, - walk_sups(T, Indent); -walk_sups([], _) -> + walk_sups(D, T, Indent); +walk_sups(_D, [], _) -> ok. dead_or_alive(Name) when is_atom(Name) -> @@ -149,7 +157,7 @@ dead_or_alive(Pid) when is_pid(Pid) -> _ -> "alive" end. -indent(I) -> io:format('~*c',[I,$ ]). +indent(D, I) -> io:format(D,'~*c',[I,$ ]). children(Pid) -> Parent = self(), @@ -166,27 +174,20 @@ children(Pid) -> end. %%%================================================================ -underline(Str) -> - underline(Str, $-). +underline(D, Str) -> + underline(D, Str, $-). -underline(Str, LineChar) -> +underline(D, Str, LineChar) -> Len = lists:flatlength(Str), - io:format('~s~n',[Str]), - line(Len,LineChar). + io:format(D, '~s~n',[Str]), + line(D,Len,LineChar). -line(Len, Char) -> - io:format('~*c~n', [Len,Char]). +line(D, Len, Char) -> + io:format(D, '~*c~n', [Len,Char]). datetime() -> - %% Adapt to new OTP 18 erlang time API and be back-compatible - TimeStamp = try - erlang:timestamp() - catch - error:undef -> - erlang:now() - end, - {{YYYY,MM,DD}, {H,M,S}} = calendar:now_to_universal_time(TimeStamp), + {{YYYY,MM,DD}, {H,M,S}} = calendar:now_to_universal_time(erlang:timestamp()), lists:flatten(io_lib:format('~4w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w UTC',[YYYY,MM,DD, H,M,S])). @@ -195,6 +196,6 @@ fmt_host_port({Host,Port}) -> io_lib:format('~s:~p',[Host,Port]). -nyi() -> - io:format('Not yet implemented~n',[]), +nyi(D) -> + io:format(D,'Not yet implemented~n',[]), nyi. diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index 613f8f25b2..bab688f226 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -111,7 +111,7 @@ start_channel(Cm, Opts) when is_pid(Cm) -> TimeOut end; {error, Reason} -> - {error, Reason}; + {error, format_channel_start_error(Reason)}; ignore -> {error, ignore} end; @@ -136,7 +136,7 @@ start_channel(Host, Port, Opts) -> TimeOut end; {error, Reason} -> - {error, Reason}; + {error, format_channel_start_error(Reason)}; ignore -> {error, ignore} end; @@ -491,9 +491,9 @@ init([Cm, ChannelId, Options]) -> inf = new_inf(), opts = Options}}; failure -> - {stop, "server failed to start sftp subsystem"}; + {stop, {shutdown, "server failed to start sftp subsystem"}}; Error -> - {stop, Error} + {stop, {shutdown, Error}} end. %%-------------------------------------------------------------------- @@ -508,12 +508,12 @@ init([Cm, ChannelId, Options]) -> %%-------------------------------------------------------------------- handle_call({{timeout, infinity}, wait_for_version_negotiation}, From, #state{xf = #ssh_xfer{vsn = undefined} = Xf} = State) -> - {noreply, State#state{xf = Xf#ssh_xfer{vsn = From}}}; + {noreply, State#state{xf = Xf#ssh_xfer{vsn = {wait, From, undefined}}}}; handle_call({{timeout, Timeout}, wait_for_version_negotiation}, From, #state{xf = #ssh_xfer{vsn = undefined} = Xf} = State) -> - timer:send_after(Timeout, {timeout, undefined, From}), - {noreply, State#state{xf = Xf#ssh_xfer{vsn = From}}}; + TRef = erlang:send_after(Timeout, self(), {timeout, undefined, From}), + {noreply, State#state{xf = Xf#ssh_xfer{vsn = {wait, From, TRef}}}}; handle_call({_, wait_for_version_negotiation}, _, State) -> {reply, ok, State}; @@ -865,7 +865,12 @@ do_handle_reply(#state{xf = Xf} = State, case Xf#ssh_xfer.vsn of undefined -> ok; - From -> + {wait, From, TRef} -> + if is_reference(TRef) -> + erlang:cancel_timer(TRef); + true -> + ok + end, ssh_channel:reply(From, ok) end, State#state{xf = Xf#ssh_xfer{vsn = Version, ext = Ext}, rep_buf = Rest}; @@ -1412,3 +1417,8 @@ open_buf1(Pid, BufInfo0, FileOpTimeout, CryptoState, ChunkSize) -> BufHandle = make_ref(), call(Pid, {put_bufinf,BufHandle,BufInfo}, FileOpTimeout), {ok,BufHandle}. + +format_channel_start_error({shutdown, Reason}) -> + Reason; +format_channel_start_error(Reason) -> + Reason. diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 76fa776113..8669be570e 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -44,12 +44,34 @@ versions(client, Options)-> Vsn = proplists:get_value(vsn, Options, ?DEFAULT_CLIENT_VERSION), - Version = format_version(Vsn), - {Vsn, Version}; + {Vsn, format_version(Vsn, software_version(Options))}; versions(server, Options) -> Vsn = proplists:get_value(vsn, Options, ?DEFAULT_SERVER_VERSION), - Version = format_version(Vsn), - {Vsn, Version}. + {Vsn, format_version(Vsn, software_version(Options))}. + +software_version(Options) -> + case proplists:get_value(id_string, Options) of + undefined -> + "Erlang"++ssh_vsn(); + {random,Nlo,Nup} -> + random_id(Nlo,Nup); + ID -> + ID + end. + +ssh_vsn() -> + try {ok,L} = application:get_all_key(ssh), + proplists:get_value(vsn,L,"") + of + "" -> ""; + VSN when is_list(VSN) -> "/" ++ VSN; + _ -> "" + catch + _:_ -> "" + end. + +random_id(Nlo, Nup) -> + [crypto:rand_uniform($a,$z+1) || _<- lists:duplicate(crypto:rand_uniform(Nlo,Nup+1),x) ]. hello_version_msg(Data) -> [Data,"\r\n"]. @@ -77,9 +99,9 @@ is_valid_mac(Mac, Data, #ssh{recv_mac = Algorithm, yes_no(Ssh, Prompt) -> (Ssh#ssh.io_cb):yes_no(Prompt, Ssh). -format_version({Major,Minor}) -> +format_version({Major,Minor}, SoftwareVersion) -> "SSH-" ++ integer_to_list(Major) ++ "." ++ - integer_to_list(Minor) ++ "-Erlang". + integer_to_list(Minor) ++ "-" ++ SoftwareVersion. handle_hello_version(Version) -> try diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index b449012ffc..bd029ad420 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -50,6 +50,14 @@ all() -> double_close, ssh_connect_timeout, ssh_connect_arg4_timeout, + packet_size_zero, + ssh_daemon_minimal_remote_max_packet_size_option, + id_string_no_opt_client, + id_string_own_string_client, + id_string_random_client, + id_string_no_opt_server, + id_string_own_string_server, + id_string_random_server, {group, hardening_tests} ]. @@ -715,14 +723,7 @@ ssh_connect_arg4_timeout(_Config) -> %% try to connect with a timeout, but "supervise" it Client = spawn(fun() -> - %% Adapt to OTP 18 erlang time API and be back-compatible - T0 = try - erlang:monotonic_time() - catch - error:undef -> - %% Use Erlang system time as monotonic time - erlang:now() - end, + T0 = erlang:monotonic_time(), Rc = ssh:connect("localhost",Port,[],Timeout), ct:log("Client ssh:connect got ~p",[Rc]), Parent ! {done,self(),Rc,T0} @@ -731,7 +732,7 @@ ssh_connect_arg4_timeout(_Config) -> %% Wait for client reaction on the connection try: receive {done, Client, {error,timeout}, T0} -> - Msp = ms_passed(T0), + Msp = ms_passed(T0), exit(Server,hasta_la_vista___baby), Low = 0.9*Timeout, High = 1.1*Timeout, @@ -755,17 +756,130 @@ ssh_connect_arg4_timeout(_Config) -> {fail, "Didn't timeout"} end. - %% Help function, elapsed milliseconds since T0 -ms_passed({_,_,_} = T0 ) -> - %% OTP 17 and earlier - timer:now_diff(erlang:now(), T0)/1000; - ms_passed(T0) -> %% OTP 18 - erlang:convert_time_resolution(erlang:monotonic_time() - T0, - erlang:time_resolution(), - 1000000)/1000. + erlang:convert_time_unit(erlang:monotonic_time() - T0, + native, + micro_seconds) / 1000. + +%%-------------------------------------------------------------------- +packet_size_zero(Config) -> + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + + {Server, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, + {user_passwords, [{"vego", "morot"}]}]), + Conn = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user_dir, UserDir}, + {user_interaction, false}, + {user, "vego"}, + {password, "morot"}]), + + {ok,Chan} = ssh_connection:session_channel(Conn, 1000, _MaxPacketSize=0, 60000), + ok = ssh_connection:shell(Conn, Chan), + + ssh:close(Conn), + ssh:stop_daemon(Server), + + receive + {ssh_cm,Conn,{data,Chan,_Type,_Msg1}} = M -> + ct:pal("Got ~p",[M]), + ct:fail(doesnt_obey_max_packet_size_0) + after 5000 -> + ok + end. + +%%-------------------------------------------------------------------- +ssh_daemon_minimal_remote_max_packet_size_option(Config) -> + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + + {Server, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, + {user_passwords, [{"vego", "morot"}]}, + {failfun, fun ssh_test_lib:failfun/2}, + {minimal_remote_max_packet_size, 14}]), + Conn = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user_dir, UserDir}, + {user_interaction, false}, + {user, "vego"}, + {password, "morot"}]), + + %% Try the limits of the minimal_remote_max_packet_size: + {ok, _ChannelId} = ssh_connection:session_channel(Conn, 100, 14, infinity), + {open_error,_,"Maximum packet size below 14 not supported",_} = + ssh_connection:session_channel(Conn, 100, 13, infinity), + + ssh:close(Conn), + ssh:stop_daemon(Server). + +%%-------------------------------------------------------------------- +id_string_no_opt_client(Config) -> + {Server, Host, Port} = fake_daemon(Config), + {error,_} = ssh:connect(Host, Port, []), + receive + {id,Server,"SSH-2.0-Erlang/"++Vsn} -> + true = expected_ssh_vsn(Vsn); + {id,Server,Other} -> + ct:fail("Unexpected id: ~s.",[Other]) + end. + +%%-------------------------------------------------------------------- +id_string_own_string_client(Config) -> + {Server, Host, Port} = fake_daemon(Config), + {error,_} = ssh:connect(Host, Port, [{id_string,"Pelle"}]), + receive + {id,Server,"SSH-2.0-Pelle\r\n"} -> + ok; + {id,Server,Other} -> + ct:fail("Unexpected id: ~s.",[Other]) + end. + +%%-------------------------------------------------------------------- +id_string_random_client(Config) -> + {Server, Host, Port} = fake_daemon(Config), + {error,_} = ssh:connect(Host, Port, [{id_string,random}]), + receive + {id,Server,Id="SSH-2.0-Erlang"++_} -> + ct:fail("Unexpected id: ~s.",[Id]); + {id,Server,Rnd="SSH-2.0-"++_} -> + ct:log("Got ~s.",[Rnd]); + {id,Server,Id} -> + ct:fail("Unexpected id: ~s.",[Id]) + end. + +%%-------------------------------------------------------------------- +id_string_no_opt_server(Config) -> + {_Server, Host, Port} = std_daemon(Config, []), + {ok,S1}=gen_tcp:connect(Host,Port,[{active,false}]), + {ok,"SSH-2.0-Erlang/"++Vsn} = gen_tcp:recv(S1, 0, 2000), + true = expected_ssh_vsn(Vsn). + +%%-------------------------------------------------------------------- +id_string_own_string_server(Config) -> + {_Server, Host, Port} = std_daemon(Config, [{id_string,"Olle"}]), + {ok,S1}=gen_tcp:connect(Host,Port,[{active,false}]), + {ok,"SSH-2.0-Olle\r\n"} = gen_tcp:recv(S1, 0, 2000). + +%%-------------------------------------------------------------------- +id_string_random_server(Config) -> + {_Server, Host, Port} = std_daemon(Config, [{id_string,random}]), + {ok,S1}=gen_tcp:connect(Host,Port,[{active,false}]), + {ok,"SSH-2.0-"++Rnd} = gen_tcp:recv(S1, 0, 2000), + case Rnd of + "Erlang"++_ -> ct:log("Id=~p",[Rnd]), + {fail,got_default_id}; + "Olle\r\n" -> {fail,got_previous_tests_value}; + _ -> ct:log("Got ~s.",[Rnd]) + end. %%-------------------------------------------------------------------- ssh_connect_negtimeout_parallel(Config) -> ssh_connect_negtimeout(Config,true). @@ -981,7 +1095,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> %% Due to timing the error message may or may not be delivered to %% the "tcp-application" before the socket closed message is recived -check_error("Internal error") -> +check_error("Invalid state") -> ok; check_error("Connection closed") -> ok; @@ -1046,3 +1160,46 @@ do_shell(IO, Shell) -> %% {'EXIT', Shell, killed} -> %% ok %% end. + + +std_daemon(Config, ExtraOpts) -> + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + {_Server, _Host, _Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, + {failfun, fun ssh_test_lib:failfun/2} | ExtraOpts]). + +expected_ssh_vsn(Str) -> + try + {ok,L} = application:get_all_key(ssh), + proplists:get_value(vsn,L,"")++"\r\n" + of + Str -> true; + "\r\n" -> true; + _ -> false + catch + _:_ -> true %% ssh not started so we dont't know + end. + + +fake_daemon(_Config) -> + Parent = self(), + %% start the server + Server = spawn(fun() -> + {ok,Sl} = gen_tcp:listen(0,[]), + {ok,{Host,Port}} = inet:sockname(Sl), + Parent ! {sockname,self(),Host,Port}, + Rsa = gen_tcp:accept(Sl), + ct:log("Server gen_tcp:accept got ~p",[Rsa]), + {ok,S} = Rsa, + receive + {tcp, S, Id} -> Parent ! {id,self(),Id} + end + end), + %% Get listening host and port + receive + {sockname,Server,ServerHost,ServerPort} -> {Server, ServerHost, ServerPort} + end. + diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index c9441a46b0..6fc09876ad 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -76,12 +76,13 @@ end_per_suite(_Config) -> crypto:stop(). %%-------------------------------------------------------------------- -init_per_group(openssh, _Config) -> +init_per_group(openssh, Config) -> case gen_tcp:connect("localhost", 22, []) of {error,econnrefused} -> {skip,"No openssh deamon"}; {ok, Socket} -> - gen_tcp:close(Socket) + gen_tcp:close(Socket), + ssh_test_lib:openssh_sanity_check(Config) end; init_per_group(_, Config) -> Config. @@ -93,7 +94,7 @@ end_per_group(_, Config) -> init_per_testcase(_TestCase, Config) -> %% To make sure we start clean as it is not certain that %% end_per_testcase will be run! - ssh:stop(), + end_per_testcase(Config), ssh:start(), Config. diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index b8abf5e80e..8ca05746db 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2012. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -358,3 +358,16 @@ do_inet_port(Node) -> {ok, Socket} = rpc:call(Node, gen_tcp, listen, [0, [{reuseaddr, true}]]), {ok, Port} = rpc:call(Node, inet, port, [Socket]), {Port, Socket}. + +openssh_sanity_check(Config) -> + ssh:start(), + case ssh:connect("localhost", 22, []) of + {ok, Pid} -> + ssh:close(Pid), + ssh:stop(), + Config; + Err -> + Str = lists:append(io_lib:format("~p", [Err])), + ssh:stop(), + {skip, Str} + end. diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index af70eeb46c..a61fd2dd41 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -66,7 +66,7 @@ init_per_suite(Config) -> {error,econnrefused} -> {skip,"No openssh deamon"}; _ -> - Config + ssh_test_lib:openssh_sanity_check(Config) end; _Else -> {skip,"Could not start crypto!"} @@ -545,6 +545,7 @@ receive_hej() -> receive_logout() -> receive <<"logout">> -> + extra_logout(), receive <<"Connection closed">> -> ok @@ -564,6 +565,14 @@ receive_normal_exit(Shell) -> ct:fail({unexpected_msg, Other}) end. +extra_logout() -> + receive + <<"logout">> -> + ok + after 500 -> + ok + end. + %%-------------------------------------------------------------------- %%-------------------------------------------------------------------- %% Check if we have a "newer" ssh client that supports these test cases diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index c8cac3e852..cef9992f1b 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,4 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 3.1 +SSH_VSN = 4.0 APP_VSN = "ssh-$(SSH_VSN)" - diff --git a/lib/ssl/doc/src/Makefile b/lib/ssl/doc/src/Makefile index cfbf98f6e3..143756bd39 100644 --- a/lib/ssl/doc/src/Makefile +++ b/lib/ssl/doc/src/Makefile @@ -37,7 +37,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = refman.xml -XML_REF3_FILES = ssl.xml ssl_crl_cache.xml ssl_crl_cache.xml ssl_session_cache_api.xml +XML_REF3_FILES = ssl.xml ssl_crl_cache.xml ssl_crl_cache_api.xml ssl_session_cache_api.xml XML_REF6_FILES = ssl_app.xml XML_PART_FILES = release_notes.xml usersguide.xml diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 4349e5a456..352563700b 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -25,7 +25,80 @@ <file>notes.xml</file> </header> <p>This document describes the changes made to the SSL application.</p> - <section><title>SSL 5.3.8</title> + <section><title>SSL 6.0</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Exclude self-signed trusted anchor certificates from + certificate prospective certification path according to + RFC 3280.</p> + <p> + This will avoid some unnecessary certificate processing.</p> + <p> + Own Id: OTP-12449</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Separate client and server session cache internally.</p> + <p> + Avoid session table growth when client starts many + connections in such a manner that many connections are + started before session reuse is possible. Only save a new + session in client if there is no equivalent session + already stored.</p> + <p> + Own Id: OTP-11365</p> + </item> + <item> + <p> + The PEM cache is now validated by a background process, + instead of always keeping it if it is small enough and + clearing it otherwise. That strategy required that small + caches where cleared by API function if a file changes on + disk.</p> + <p> + However export the API function to clear the cache as it + may still be useful.</p> + <p> + Own Id: OTP-12391</p> + </item> + <item> + <p> + Add padding check for TLS-1.0 to remove Poodle + vulnerability from TLS 1.0, also add the option + padding_check. This option only affects TLS-1.0 + connections and if set to false it disables the block + cipher padding check to be able to interoperate with + legacy software.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-12420</p> + </item> + <item> + <p> + Add support for TLS_FALLBACK_SCSV used to prevent + undesired TLS version downgrades. If used by a client + that is vulnerable to the POODLE attack, and the server + also supports TLS_FALLBACK_SCSV, the attack can be + prevented.</p> + <p> + Own Id: OTP-12458</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 5.3.8</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index c9b02d44ec..cdf6870c25 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -21,243 +21,272 @@ </legalnotice> <title>ssl</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> <file>ssl.xml</file> </header> <module>ssl</module> <modulesummary>Interface Functions for Secure Socket Layer</modulesummary> <description> - <p>This module contains interface functions to the Secure Socket - Layer. - </p> + <p>This module contains interface functions for the SSL.</p> </description> <section> <title>SSL</title> <list type="bulleted"> - <item>ssl requires the crypto and public_key applications.</item> + <item>For application dependencies see <seealso marker="ssl_app"> ssl(6)</seealso> </item> <item>Supported SSL/TLS-versions are SSL-3.0, TLS-1.0, - TLS-1.1 and TLS-1.2.</item> + TLS-1.1, and TLS-1.2.</item> <item>For security reasons SSL-2.0 is not supported.</item> <item>For security reasons SSL-3.0 is no longer supported by default, - but may be configured.</item> - <item>Ephemeral Diffie-Hellman cipher suites are supported + but can be configured.</item> + <item>Ephemeral Diffie-Hellman cipher suites are supported, but not Diffie Hellman Certificates cipher suites.</item> - <item>Elliptic Curve cipher suites are supported if crypto - supports it and named curves are used. + <item>Elliptic Curve cipher suites are supported if the Crypto + application supports it and named curves are used. </item> <item>Export cipher suites are not supported as the U.S. lifted its export restrictions in early 2000.</item> <item>IDEA cipher suites are not supported as they have - become deprecated by the latest TLS spec so there is not any - real motivation to implement them.</item> + become deprecated by the latest TLS specification so it is not + motivated to implement them.</item> <item>CRL validation is supported.</item> - <item>Policy certificate extensions are not supported - yet. </item> - <item>Support for 'Server Name Indication' extension client side - (RFC 6066 section 3).</item> + <item>Policy certificate extensions are not supported.</item> + <item>'Server Name Indication' extension client side + (RFC 6066, Section 3) is supported.</item> </list> </section> <section> - <title>COMMON DATA TYPES</title> - <p>The following data types are used in the functions below: - </p> + <title>DATA TYPES</title> + <p>The following data types are used in the functions for SSL:</p> - <p><c>boolean() = true | false</c></p> + <taglist> - <p><c>option() = socketoption() | ssloption() | transportoption()</c></p> + <tag><c>boolean()</c></tag> + <item><p><c>= true | false</c></p></item> - <p><c>socketoption() = proplists:property() - The default socket options are - [{mode,list},{packet, 0},{header, 0},{active, true}]. - </c></p> + <tag><c>option()</c></tag> + <item><p><c>= socketoption() | ssloption() | transportoption()</c></p> + </item> - <p>For valid options - see <seealso marker="kernel:inet">inet(3)</seealso> and - <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso>. - </p> - - <p><marker id="type-ssloption"></marker><c>ssloption() = {verify, verify_type()} | - {verify_fun, {fun(), term()}} | - {fail_if_no_peer_cert, boolean()} - {depth, integer()} | - {cert, der_encoded()}| {certfile, path()} | - {key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' |'PrivateKeyInfo', der_encoded()}} | - {keyfile, path()} | {password, string()} | - {cacerts, [der_encoded()]} | {cacertfile, path()} | - |{dh, der_encoded()} | {dhfile, path()} | {ciphers, ciphers()} | - {user_lookup_fun, {fun(), term()}}, {psk_identity, string()}, {srp_identity, {string(), string()}} | - {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | {reuse_session, fun()} - {next_protocols_advertised, [binary()]} | - {client_preferred_next_protocols, {client | server, [binary()]} | {client | server, [binary()], binary()}} | - {log_alert, boolean()} | {server_name_indication, hostname() | disable} - </c></p> - - <p><c>transportoption() = {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom(), ErrTag:atom()}} - - defaults to {gen_tcp, tcp, tcp_closed, tcp_error}. Can be used to customize - the transport layer. The callback module must implement a reliable transport - protocol and behave as gen_tcp and in addition have functions corresponding to - inet:setopts/2, inet:getopts/2, inet:peername/1, inet:sockname/1 and inet:port/1. - The callback gen_tcp is treated specially and will call inet directly. - </c></p> - - <p><c> CallbackModule = - atom()</c> - </p> <p><c> DataTag = - atom() - tag used in socket data message.</c></p> - <p><c> ClosedTag = atom() - tag used in - socket close message.</c></p> - - <p><c>verify_type() = verify_none | verify_peer</c></p> - - <p><c>path() = string() - representing a file path.</c></p> + <tag><c>socketoption()</c></tag> + <item><p><c>= proplists:property()</c></p> + <p>The default socket options are + <c>[{mode,list},{packet, 0},{header, 0},{active, true}]</c>.</p> + <p>For valid options, see the + <seealso marker="kernel:inet">inet(3)</seealso> and + <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso> manual pages + in Kernel.</p></item> + + <tag><marker id="type-ssloption"></marker><c>ssloption()</c></tag> + <item><p><c>= {verify, verify_type()}</c></p> + <p><c>| {verify_fun, {fun(), term()}}</c></p> + <p><c>| {fail_if_no_peer_cert, boolean()} {depth, integer()}</c></p> + <p><c>| {cert, public_key:der_encoded()}</c></p> + <p><c>| {certfile, path()}</c></p> + <p><c>| {key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' + | 'PrivateKeyInfo', public_key:der_encoded()}}</c></p> + <p><c>| {keyfile, path()}</c></p> + <p><c>| {password, string()}</c></p> + <p><c>| {cacerts, [public_key:der_encoded()]}</c></p> + <p><c>| {cacertfile, path()}</c></p> + <p><c>| {dh, public_key:der_encoded()}</c></p> + <p><c>| {dhfile, path()}</c></p> + <p><c>| {ciphers, ciphers()}</c></p> + <p><c>| {user_lookup_fun, {fun(), term()}}, {psk_identity, string()}, + {srp_identity, {string(), string()}}</c></p> + <p><c>| {reuse_sessions, boolean()}</c></p> + <p><c>| {reuse_session, fun()} {next_protocols_advertised, [binary()]}</c></p> + <p><c>| {client_preferred_next_protocols, {client | server, + [binary()]} | {client | server, [binary()], binary()}}</c></p> + <p><c>| {log_alert, boolean()}</c></p> + <p><c>| {server_name_indication, hostname() | disable}</c></p></item> + + <tag><c>transportoption()</c></tag> + <item><p><c>= {cb_info, {CallbackModule::atom(), DataTag::atom(), + ClosedTag::atom(), ErrTag:atom()}}</c></p> + <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error}</c>. Can be used + to customize the transport layer. The callback module must implement a + reliable transport protocol, behave as <c>gen_tcp</c>, and have functions + corresponding to <c>inet:setopts/2</c>, <c>inet:getopts/2</c>, + <c>inet:peername/1</c>, <c>inet:sockname/1</c>, and <c>inet:port/1</c>. + The callback <c>gen_tcp</c> is treated specially and calls <c>inet</c> + directly.</p> + <taglist> + <tag><c>CallbackModule</c></tag> + <item><p><c>= atom()</c></p></item> + <tag><c>DataTag</c></tag> + <item><p><c>= atom()</c></p> + <p>Used in socket data message.</p></item> + <tag><c>ClosedTag</c></tag> + <item><p><c>= atom()</c></p> + <p>Used in socket close message.</p></item> + </taglist> + </item> - <p><c>der_encoded() = binary() -Asn1 DER encoded entity as an erlang binary.</c></p> - - <p><c>host() = hostname() | ipaddress()</c></p> - - <p><c>hostname() = string()</c></p> - - <p><c> - ip_address() = {N1,N2,N3,N4} % IPv4 - | {K1,K2,K3,K4,K5,K6,K7,K8} % IPv6 </c></p> + <tag><c>verify_type()</c></tag> + <item><p><c>= verify_none | verify_peer</c></p></item> - <p><c>sslsocket() - opaque to the user. </c></p> - - <p><c>protocol() = sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2' </c></p> - - <p><c>ciphers() = [ciphersuite()] | string() (according to old API)</c></p> - - <p><c>ciphersuite() = - {key_exchange(), cipher(), hash()}</c></p> - - <p><c>key_exchange() = rsa | dhe_dss | dhe_rsa | dh_anon - | psk | dhe_psk | rsa_psk | srp_anon | srp_dss | srp_rsa - | ecdh_anon | ecdh_ecdsa | ecdhe_ecdsa | ecdh_rsa | ecdhe_rsa - </c></p> + <tag><c>path()</c></tag> + <item><p><c>= string()</c></p> + <p>Represents a file path.</p></item> + + <tag><c>public_key:der_encoded()</c></tag> + <item><p><c>= binary()</c></p> + <p>ASN.1 DER-encoded entity as an Erlang binary.</p></item> + + <tag><c>host()</c></tag> + <item><p><c>= hostname() | ipaddress()</c></p></item> + + <tag><c>hostname()</c></tag> + <item><p><c>= string()</c></p></item> + + <tag><c>ip_address()</c></tag> + <item><p><c>= {N1,N2,N3,N4} % IPv4 | {K1,K2,K3,K4,K5,K6,K7,K8} % IPv6 + </c></p></item> + + <tag><c>sslsocket()</c></tag> + <item><p>Opaque to the user.</p></item> + + <tag><c>protocol()</c></tag> + <item><p><c>= sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2'</c></p></item> + + <tag><c>ciphers()</c></tag> + <item><p><c>= [ciphersuite()] | string()</c></p> + <p>According to old API.</p></item> - <p><c>cipher() = rc4_128 | des_cbc | '3des_ede_cbc' - | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm </c></p> + <tag><c>ciphersuite()</c></tag> + <item><p><c>= {key_exchange(), cipher(), hash()}</c></p></item> - <p> <c>hash() = md5 | sha - </c></p> + <tag><c>key_exchange()</c></tag> + <item><p><c>= rsa | dhe_dss | dhe_rsa | dh_anon | psk | dhe_psk + | rsa_psk | srp_anon | srp_dss | srp_rsa | ecdh_anon | ecdh_ecdsa + | ecdhe_ecdsa | ecdh_rsa | ecdhe_rsa</c></p></item> - <p><c>prf_random() = client_random | server_random - </c></p> + <tag><c>cipher()</c></tag> + <item><p><c>= rc4_128 | des_cbc | '3des_ede_cbc' + | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm</c></p></item> - <p><c>srp_param_type() = srp_1024 | srp_1536 | srp_2048 | srp_3072 - | srp_4096 | srp_6144 | srp_8192</c></p> + <tag><c>hash()</c></tag> + <item><p><c>= md5 | sha</c></p></item> + <tag><c>prf_random()</c></tag> + <item><p><c>= client_random | server_random</c></p></item> + + <tag><c>srp_param_type()</c></tag> + <item><p><c>= srp_1024 | srp_1536 | srp_2048 | srp_3072 + | srp_4096 | srp_6144 | srp_8192</c></p></item> + + </taglist> </section> <section> <title>SSL OPTION DESCRIPTIONS - COMMON for SERVER and CLIENT</title> - <p>Options described here are options that are have the same - meaning in the client and the server. - </p> + <p>The following options have the same meaning in the client and + the server:</p> <taglist> - <tag>{cert, der_encoded()}</tag> - <item> The DER encoded users certificate. If this option - is supplied it will override the certfile option.</item> + <tag><c>{cert, public_key:der_encoded()}</c></tag> + <item><p>The DER-encoded users certificate. If this option + is supplied, it overrides option <c>certfile</c>.</p></item> - <tag>{certfile, path()}</tag> - <item>Path to a file containing the user's PEM encoded certificate.</item> + <tag><c>{certfile, path()}</c></tag> + <item><p>Path to a file containing the user certificate.</p></item> - <tag>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' |'PrivateKeyInfo', der_encoded()}}</tag> - <item> The DER encoded users private key. If this option - is supplied it will override the keyfile option.</item> + <tag><c>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' + |'PrivateKeyInfo', public_key:der_encoded()}}</c></tag> + <item><p>The DER-encoded user's private key. If this option + is supplied, it overrides option <c>keyfile</c>.</p></item> - <tag>{keyfile, path()}</tag> - <item>Path to file containing user's - private PEM encoded key. As PEM-files may contain several - entries this option defaults to the same file as given by - certfile option.</item> - - <tag>{password, string()}</tag> - <item>String containing the user's password. - Only used if the private keyfile is password protected. - </item> - - <tag>{cacerts, [der_encoded()]}</tag> - <item> The DER encoded trusted certificates. If this option - is supplied it will override the cacertfile option.</item> - - <tag>{ciphers, ciphers()}</tag> - <item>The cipher suites that should be supported. The function + <tag><c>{keyfile, path()}</c></tag> + <item><p>Path to the file containing the user's + private PEM-encoded key. As PEM-files can contain several + entries, this option defaults to the same file as given by + option <c>certfile</c>.</p></item> + + <tag><c>{password, string()}</c></tag> + <item><p>String containing the user's password. Only used if the + private keyfile is password-protected.</p></item> + + <tag><c>{ciphers, ciphers()}</c></tag> + <item><p>Supported cipher suites. The function <c>cipher_suites/0</c> can be used to find all ciphers that are - supported by default. <c>cipher_suites(all)</c> may be called - to find all available cipher suites. - Pre-Shared Key (<url href="http://www.ietf.org/rfc/rfc4279.txt">RFC 4279</url> and + supported by default. <c>cipher_suites(all)</c> can be called + to find all available cipher suites. Pre-Shared Key + (<url href="http://www.ietf.org/rfc/rfc4279.txt">RFC 4279</url> and <url href="http://www.ietf.org/rfc/rfc5487.txt">RFC 5487</url>), - Secure Remote Password (<url href="http://www.ietf.org/rfc/rfc5054.txt">RFC 5054</url>) + Secure Remote Password + (<url href="http://www.ietf.org/rfc/rfc5054.txt">RFC 5054</url>), RC4 cipher suites, and anonymous cipher suites only work if explicitly enabled by - this option and they are supported/enabled by the peer also. - Note that anonymous cipher suites are supported for testing purposes - only and should not be used when security matters. - </item> - - <tag>{ssl_imp, new | old}</tag> - <item>No longer has any meaning as the old implementation has - been removed, it will be ignored. + this option; they are supported/enabled by the peer also. + Anonymous cipher suites are supported for testing purposes + only and are not be used when security matters.</p></item> + + <tag><c>{secure_renegotiate, boolean()}</c></tag> + <item><p>Specifies if to reject renegotiation attempt that does + not live up to + <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>. + By default <c>secure_renegotiate</c> is set to <c>false</c>, + that is, secure renegotiation is used if possible, + but it fallback to unsecure renegotiation if the peer + does not support + <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>.</p> </item> - <tag>{secure_renegotiate, boolean()}</tag> - <item>Specifies if to reject renegotiation attempt that does - not live up to <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>. By default secure_renegotiate is - set to false i.e. secure renegotiation will be used if possible - but it will fallback to unsecure renegotiation if the peer - does not support <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>. - </item> + <tag><c>{depth, integer()}</c></tag> + <item><p>Maximum number of non-self-issued + intermediate certificates that can follow the peer certificate + in a valid certification path. So, if depth is 0 the PEER must + be signed by the trusted ROOT-CA directly; if 1 the path can + be PEER, CA, ROOT-CA; if 2 the path can be PEER, CA, CA, + ROOT-CA, and so on. The default value is 1.</p></item> - <tag>{depth, integer()}</tag> - <item> - The depth is the maximum number of non-self-issued - intermediate certificates that may follow the peer certificate - in a valid certification path. So if depth is 0 the PEER must - be signed by the trusted ROOT-CA directly, if 1 the path can - be PEER, CA, ROOT-CA, if it is 2 PEER, CA, CA, ROOT-CA and so - on. The default value is 1. - </item> - - <tag>{verify_fun, {Verifyfun :: fun(), InitialUserState :: term()}}</tag> - <item> - <p>The verification fun should be defined as:</p> + <tag><c>{verify_fun, {Verifyfun :: fun(), InitialUserState :: + term()}}</c></tag> + <item><p>The verification fun is to be defined as follows:</p> <code> -fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revoked, atom()}} | +fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revoked, +atom()}} | {extension, #'Extension'{}}, InitialUserState :: term()) -> {valid, UserState :: term()} | {valid_peer, UserState :: term()} | {fail, Reason :: term()} | {unknown, UserState :: term()}. </code> - <p>The verify fun will be called during the X509-path - validation when an error or an extension unknown to the ssl - application is encountered. Additionally it will be called + <p>The verification fun is called during the X509-path + validation when an error or an extension unknown to the SSL + application is encountered. It is also called when a certificate is considered valid by the path validation to allow access to each certificate in the path to the user - application. Note that it will differentiate between the - peer certificate and CA certificates by using valid_peer or - valid as the second argument to the verify fun. See <seealso - marker="public_key:cert_records">the public_key User's - Guide</seealso> for definition of #'OTPCertificate'{} and - #'Extension'{}.</p> - - <p>If the verify callback fun returns {fail, Reason}, the - verification process is immediately stopped and an alert is - sent to the peer and the TLS/SSL handshake is terminated. If - the verify callback fun returns {valid, UserState}, the - verification process is continued. If the verify callback fun - always returns {valid, UserState}, the TLS/SSL handshake will - not be terminated with respect to verification failures and - the connection will be established. If called with an - extension unknown to the user application, the return value - {unknown, UserState} should be used.</p> - - <p>The default verify_fun option in verify_peer mode:</p> + application. It differentiates between the peer + certificate and the CA certificates by using <c>valid_peer</c> or + <c>valid</c> as second argument to the verification fun. See the + <seealso marker="public_key:cert_records">public_key User's + Guide</seealso> for definition of <c>#'OTPCertificate'{}</c> and + <c>#'Extension'{}</c>.</p> + + <list type="bulleted"> + <item><p>If the verify callback fun returns <c>{fail, Reason}</c>, + the verification process is immediately stopped, an alert is + sent to the peer, and the TLS/SSL handshake terminates.</p></item> + <item><p>If the verify callback fun returns <c>{valid, UserState}</c>, + the verification process continues.</p></item> + <item><p>If the verify callback fun always returns + <c>{valid, UserState}</c>, the TLS/SSL handshake does not + terminate regarding verification failures and the connection is + established.</p></item> + <item><p>If called with an extension unknown to the user application, + return value <c>{unknown, UserState}</c> is to be used.</p></item> + </list> + + <p>Default option <c>verify_fun</c> in <c>verify_peer mode</c>:</p> <code> {fun(_,{bad_cert, _} = Reason, _) -> @@ -271,7 +300,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revo end, []} </code> - <p>The default verify_fun option in verify_none mode:</p> + <p>Default option <c>verify_fun</c> in mode <c>verify_none</c>:</p> <code> {fun(_,{bad_cert, _}, UserState) -> @@ -285,53 +314,56 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revo end, []} </code> - <p>Possible path validation errors are given on the form {bad_cert, Reason} where Reason is:</p> + <p>The possible path validation errors are given on form + <c>{bad_cert, Reason}</c> where <c>Reason</c> is:</p> <taglist> - <tag>unknown_ca</tag> - <item>No trusted CA was found in the trusted store. The trusted CA is - normally a so called ROOT CA that is a self-signed cert. Trust may - be claimed for an intermediat CA (trusted anchor does not have to be self signed - according to X-509) by using the option <c>partial_chain</c></item> - - <tag>selfsigned_peer</tag> - <item>The chain consisted only of one self-signed certificate.</item> - - <tag>PKIX X-509-path validation error</tag> - <item> Possible such reasons see <seealso - marker="public_key:public_key#pkix_path_validation-3"> public_key:pkix_path_validation/3 </seealso></item> + <tag><c>unknown_ca</c></tag> + <item><p>No trusted CA was found in the trusted store. The trusted CA is + normally a so called ROOT CA, which is a self-signed certificate. Trust can + be claimed for an intermediat CA (trusted anchor does not have to be + self-signed according to X-509) by using option <c>partial_chain</c>.</p> + </item> + + <tag><c>selfsigned_peer</c></tag> + <item><p>The chain consisted only of one self-signed certificate.</p></item> + + <tag><c>PKIX X-509-path validation error</c></tag> + <item><p>For possible reasons, see <seealso +marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso> + </p></item> </taglist> </item> - <tag>{crl_check, boolean() | peer | best_effort )</tag> + <tag><c>{crl_check, boolean() | peer | best_effort }</c></tag> <item> Perform CRL (Certificate Revocation List) verification - <seealso marker="public_key:public_key#pkix_crl_validate-3"> - public_key:pkix_crls_validate/3</seealso>, during the + <seealso marker="public_key:public_key#pkix_crls_validate-3"> + (public_key:pkix_crls_validate/3)</seealso> on all the certificates during the path validation <seealso - marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3 </seealso> - invokation on all the certificates in the peer certificate chain. Defaults to - false. - + marker="public_key:public_key#pkix_path_validation-3">(public_key:pkix_path_validation/3) + </seealso> + of the certificate chain. Defaults to false. + <p><c>peer</c> - check is only performed on the peer certificate.</p> - <p><c>best_effort</c> - if certificate revokation status can not be determined + <p><c>best_effort</c> - if certificate revocation status can not be determined it will be accepted as valid.</p> <p>The CA certificates specified for the connection will be used to construct the certificate chain validating the CRLs.</p> - <p>The CRLs will be fetched from a local or external cache + <p>The CRLs will be fetched from a local or external cache see <seealso marker="ssl:ssl_crl_cache_api">ssl_crl_cache_api(3)</seealso>.</p> </item> - <tag>{crl_cache, {Module::atom, {DbHandle::internal | term(), Args::list()}}</tag> + <tag><c>{crl_cache, {Module :: atom(), {DbHandle :: internal | term(), Args :: list()}}}</c></tag> <item> <p>Module defaults to ssl_crl_cache with <c> DbHandle </c> internal and an empty argument list. The following arguments may be specified for the internal cache.</p> <taglist> - <tag>{http, timeout()}</tag> + <tag><c>{http, timeout()}</c></tag> <item> Enables fetching of CRLs specified as http URIs in<seealso marker="public_key:cert_records"> X509 cerificate extensions.</seealso> @@ -339,32 +371,31 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revo </item> </taglist> </item> - - <tag>{partial_chain, fun(Chain::[DerCert]) -> {trusted_ca, DerCert} | unknown_ca </tag> - - <item> - Claim an intermediat CA in the chain as trusted. TLS will then perform the public_key:pkix_path_validation/3 - with the selected CA as trusted anchor and the rest of the chain. - </item> - <tag>{versions, [protocol()]}</tag> - <item>TLS protocol versions that will be supported by started clients and servers. - This option overrides the application environment option <c>protocol_version</c>. If the - environment option is not set it defaults to all versions, except SSL-3.0, supported by the SSL application. See also - <seealso marker="ssl:ssl_app">ssl(6)</seealso> - </item> - - <tag>{hibernate_after, integer()|undefined}</tag> - <item>When an integer-value is specified, the <c>ssl_connection</c> - will go into hibernation after the specified number of milliseconds - of inactivity, thus reducing its memory footprint. When - <c>undefined</c> is specified (this is the default), the process - will never go into hibernation. - </item> + <tag><c>{partial_chain, fun(Chain::[DerCert]) -> {trusted_ca, DerCert} | + unknown_ca }</c></tag> + <item><p>Claim an intermediate CA in the chain as trusted. TLS then + performs <seealso + marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso> + with the selected CA as trusted anchor and the rest of the chain.</p></item> + + <tag><c>{versions, [protocol()]}</c></tag> + <item><p>TLS protocol versions supported by started clients and servers. + This option overrides the application environment option + <c>protocol_version</c>. If the environment option is not set, it defaults + to all versions, except SSL-3.0, supported by the SSL application. + See also <seealso marker="ssl:ssl_app">ssl(6).</seealso></p></item> + + <tag><c>{hibernate_after, integer()|undefined}</c></tag> + <item><p>When an integer-value is specified, <c>ssl_connection</c> + goes into hibernation after the specified number of milliseconds + of inactivity, thus reducing its memory footprint. When + <c>undefined</c> is specified (this is the default), the process + never goes into hibernation.</p></item> + + <tag><c>{user_lookup_fun, {Lookupfun :: fun(), UserState :: term()}}</c></tag> + <item><p>The lookup fun is to defined as follows:</p> - <tag>{user_lookup_fun, {Lookupfun :: fun(), UserState :: term()}}</tag> - <item> - <p>The lookup fun should be defined as:</p> <code> fun(psk, PSKIdentity ::string(), UserState :: term()) -> {ok, SharedSecret :: binary()} | error; @@ -372,104 +403,121 @@ fun(srp, Username :: string(), UserState :: term()) -> {ok, {SRPParams :: srp_param_type(), Salt :: binary(), DerivedKey :: binary()}} | error. </code> - <p>For Pre-Shared Key (PSK) cipher suites, the lookup fun will - be called by the client and server to determine the shared - secret. When called by the client, PSKIdentity will be set to the - hint presented by the server or undefined. When called by the - server, PSKIdentity is the identity presented by the client. - </p> - - <p>For Secure Remote Password (SRP), the fun will only be used by the server to obtain - parameters that it will use to generate its session keys. <c>DerivedKey</c> should be - derived according to <url href="http://tools.ietf.org/html/rfc2945#section-3"> RFC 2945</url> and - <url href="http://tools.ietf.org/html/rfc5054#section-2.4"> RFC 5054</url>: - <c>crypto:sha([Salt, crypto:sha([Username, <<$:>>, Password])]) </c> + <p>For Pre-Shared Key (PSK) cipher suites, the lookup fun is + called by the client and server to determine the shared + secret. When called by the client, <c>PSKIdentity</c> is set to the + hint presented by the server or to undefined. When called by the + server, <c>PSKIdentity</c> is the identity presented by the client.</p> + + <p>For Secure Remote Password (SRP), the fun is only used by the server to + obtain parameters that it uses to generate its session keys. + <c>DerivedKey</c> is to be derived according to + <url href="http://tools.ietf.org/html/rfc2945#section-3"> RFC 2945</url> and + <url href="http://tools.ietf.org/html/rfc5054#section-2.4"> RFC 5054</url>: + <c>crypto:sha([Salt, crypto:sha([Username, <<$:>>, Password])])</c> </p> </item> - <tag>{padding_check, boolean()}</tag> - <item> - <p> This option only affects TLS-1.0 connections. - If set to false it disables the block cipher padding check - to be able to interoperate with legacy software. - </p> - - <warning><p> Using this option makes TLS vulnerable to - the Poodle attack</p></warning> - - </item> - + <tag><c>{padding_check, boolean()}</c></tag> + <item><p>Affects TLS-1.0 connections only. + If set to <c>false</c>, it disables the block cipher padding check + to be able to interoperate with legacy software.</p></item> + </taglist> - + + <warning><p>Using <c>{padding_check, boolean()}</c> makes TLS + vulnerable to the Poodle attack.</p></warning> + </section> <section> <title>SSL OPTION DESCRIPTIONS - CLIENT SIDE</title> - <p>Options described here are client specific or has a slightly different - meaning in the client than in the server.</p> + <p>The following options are client-specific or have a slightly different + meaning in the client than in the server:</p> <taglist> - <tag>{verify, verify_type()}</tag> - <item> In verify_none mode the default behavior will be to - allow all x509-path validation errors. See also the verify_fun - option. - </item> - <tag>{reuse_sessions, boolean()}</tag> - <item>Specifies if client should try to reuse sessions - when possible. + + <tag><c>{verify, verify_type()}</c></tag> + <item><p>In mode <c>verify_none</c> the default behavior is to allow + all x509-path validation errors. See also option <c>verify_fun</c>.</p> </item> + + <tag><c>{reuse_sessions, boolean()}</c></tag> + <item><p>Specifies if the client is to try to reuse sessions + when possible.</p></item> + + <tag><c>{cacerts, [public_key:der_encoded()]}</c></tag> + <item><p>The DER-encoded trusted certificates. If this option + is supplied it overrides option <c>cacertfile</c>.</p></item> - <tag>{cacertfile, path()}</tag> - <item>The path to a file containing PEM encoded CA certificates. The CA + <tag><c>{cacertfile, path()}</c></tag> + <item><p>Path to a file containing PEM-encoded CA certificates. The CA certificates are used during server authentication and when building the - client certificate chain. - </item> - - <tag>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()]}}</tag> - <tag>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()], Default :: binary()}}</tag> + client certificate chain.</p> + </item> + + <tag><c>{alpn_advertised_protocols, [binary()]}</c></tag> + <item> + <p>The list of protocols supported by the client to be sent to the + server to be used for an Application-Layer Protocol Negotiation (ALPN). + If the server supports ALPN then it will choose a protocol from this + list; otherwise it will fail the connection with a "no_application_protocol" + alert. A server that does not support ALPN will ignore this value.</p> + + <p>The list of protocols must not contain an empty binary.</p> + + <p>The negotiated protocol can be retrieved using the <c>negotiated_protocol/1</c> function.</p> + </item> + + <tag><c>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()]}}</c></tag> + <tag><c>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()], Default :: binary()}}</c></tag> <item> - <p>Indicates the client will try to perform Next Protocol + <p>Indicates that the client is to try to perform Next Protocol Negotiation.</p> - <p>If precedence is server the negotiated protocol will be the - first protocol that appears on the server advertised list that is + <p>If precedence is server, the negotiated protocol is the + first protocol to be shown on the server advertised list, which is also on the client preference list.</p> - <p>If precedence is client the negotiated protocol will be the - first protocol that appears on the client preference list that is + <p>If precedence is client, the negotiated protocol is the + first protocol to be shown on the client preference list, which is also on the server advertised list.</p> <p>If the client does not support any of the server advertised - protocols or the server does not advertise any protocols the - client will fallback to the first protocol in its list or if a - default is supplied it will fallback to that instead. If the - server does not support Next Protocol Negotiation the - connection will be aborted if no default protocol is supplied.</p> + protocols or the server does not advertise any protocols, the + client falls back to the first protocol in its list or to the + default protocol (if a default is supplied). If the + server does not support Next Protocol Negotiation, the + connection terminates if no default protocol is supplied.</p> </item> - <tag>{psk_identity, string()}</tag> - <item>Specifies the identity the client presents to the server. The matching secret is - found by calling the user_look_fun. - </item> - <tag>{srp_identity, {Username :: string(), Password :: string()}</tag> - <item>Specifies the Username and Password to use to authenticate to the server. + <tag><c>{psk_identity, string()}</c></tag> + <item><p>Specifies the identity the client presents to the server. + The matching secret is found by calling <c>user_lookup_fun</c>.</p> </item> - <tag>{server_name_indication, hostname()}</tag> - <tag>{server_name_indication, disable}</tag> + + <tag><c>{srp_identity, {Username :: string(), Password :: string()} + </c></tag> + <item><p>Specifies the username and password to use to authenticate + to the server.</p></item> + + <tag><c>{server_name_indication, hostname()}</c></tag> + <item><p>Can be specified when upgrading a TCP socket to a TLS + socket to use the TLS Server Name Indication extension.</p></item> + + <tag><c>{server_name_indication, disable}</c></tag> <item> - <p>This option can be specified when upgrading a TCP socket to a TLS - socket to use the TLS Server Name Indication extension.</p> - <p>When starting a TLS connection without upgrade the Server Name - Indication extension will be sent if possible, this option may also be + <p>When starting a TLS connection without upgrade, the Server Name + Indication extension is sent if possible. This option can be used to disable that behavior.</p> </item> - <tag>{fallback, boolean()}</tag> + <tag><c>{fallback, boolean()}</c></tag> <item> <p> Send special cipher suite TLS_FALLBACK_SCSV to avoid undesired TLS version downgrade. Defaults to false</p> <warning><p>Note this option is not needed in normal TLS usage and should not be used - to implement new clients. But legacy clients that that retries connections in the following manner</p> + to implement new clients. But legacy clients that retries connections in the following manner</p> <p><c> ssl:connect(Host, Port, [...{versions, ['tlsv2', 'tlsv1.1', 'tlsv1', 'sslv3']}])</c></p> <p><c> ssl:connect(Host, Port, [...{versions, [tlsv1.1', 'tlsv1', 'sslv3']}, {fallback, true}])</c></p> @@ -487,123 +535,132 @@ fun(srp, Username :: string(), UserState :: term()) -> <section> <title>SSL OPTION DESCRIPTIONS - SERVER SIDE</title> - <p>Options described here are server specific or has a slightly different - meaning in the server than in the client.</p> + <p>The following options are server-specific or have a slightly different + meaning in the server than in the client:</p> <taglist> + + <tag><c>{cacerts, [public_key:der_encoded()]}</c></tag> + <item><p>The DER-encoded trusted certificates. If this option + is supplied it overrides option <c>cacertfile</c>.</p></item> - <tag>{cacertfile, path()}</tag> - <item>The path to a file containing PEM encoded CA + <tag><c>{cacertfile, path()}</c></tag> + <item><p>Path to a file containing PEM-encoded CA certificates. The CA certificates are used to build the server - certificate chain, and for client authentication. Also the CAs - are used in the list of acceptable client CAs passed to the - client when a certificate is requested. May be omitted if there - is no need to verify the client and if there are not any - intermediate CAs for the server certificate. - </item> + certificate chain and for client authentication. The CAs are + also used in the list of acceptable client CAs passed to the + client when a certificate is requested. Can be omitted if there + is no need to verify the client and if there are no + intermediate CAs for the server certificate.</p></item> - <tag>{dh, der_encoded()}</tag> - <item>The DER encoded Diffie Hellman parameters. If this option - is supplied it will override the dhfile option. + <tag><c>{dh, public_key:der_encoded()}</c></tag> + <item><p>The DER-encoded Diffie-Hellman parameters. If specified, + it overrides option <c>dhfile</c>.</p></item> + + <tag><c>{dhfile, path()}</c></tag> + <item><p>Path to a file containing PEM-encoded Diffie Hellman parameters + to be used by the server if a cipher suite using Diffie Hellman key + exchange is negotiated. If not specified, default parameters are used. + </p></item> + + <tag><c>{verify, verify_type()}</c></tag> + <item><p>A server only does x509-path validation in mode <c>verify_peer</c>, + as it then sends a certificate request to the client + (this message is not sent if the verify option is <c>verify_none</c>). + You can then also want to specify option <c>fail_if_no_peer_cert</c>. + </p></item> + + <tag><c>{fail_if_no_peer_cert, boolean()}</c></tag> + <item><p>Used together with <c>{verify, verify_peer}</c> by an SSL server. + If set to <c>true</c>, the server fails if the client does not have + a certificate to send, that is, sends an empty certificate. If set to + <c>false</c>, it fails only if the client sends an invalid + certificate (an empty certificate is considered valid). Defaults to false.</p> </item> - <tag>{dhfile, path()}</tag> - <item>Path to file containing PEM encoded Diffie Hellman parameters, - for the server to use if a cipher suite using Diffie Hellman key exchange - is negotiated. If not specified default parameters will be used. - </item> + <tag><c>{reuse_sessions, boolean()}</c></tag> + <item><p>Specifies if the server is to agree to reuse sessions + when requested by the clients. See also option <c>reuse_session</c>. + </p></item> + + <tag><c>{reuse_session, fun(SuggestedSessionId, + PeerCert, Compression, CipherSuite) -> boolean()}</c></tag> + <item><p>Enables the SSL server to have a local policy + for deciding if a session is to be reused or not. + Meaningful only if <c>reuse_sessions</c> is set to <c>true</c>. + <c>SuggestedSessionId</c> is a <c>binary()</c>, <c>PeerCert</c> is + a DER-encoded certificate, <c>Compression</c> is an enumeration integer, + and <c>CipherSuite</c> is of type <c>ciphersuite()</c>.</p></item> + + <tag><c>{alpn_preferred_protocols, [binary()]}</c></tag> + <item> + <p>Indicates the server will try to perform Application-Layer + Protocol Negotiation (ALPN).</p> - <tag>{verify, verify_type()}</tag> - <item>Servers only do the x509-path validation in verify_peer - mode, as it then will send a certificate request to the client - (this message is not sent if the verify option is verify_none) - and you may then also want to specify the option - fail_if_no_peer_cert. - </item> + <p>The list of protocols is in order of preference. The protocol + negotiated will be the first in the list that matches one of the + protocols advertised by the client. If no protocol matches, the + server will fail the connection with a "no_application_protocol" alert.</p> - <tag>{fail_if_no_peer_cert, boolean()}</tag> - <item>Used together with {verify, verify_peer} by an ssl server. - If set to true, the server will fail if the client does not have - a certificate to send, i.e. sends a empty certificate, if set to - false it will only fail if the client sends an invalid - certificate (an empty certificate is considered valid). + <p>The negotiated protocol can be retrieved using the <c>negotiated_protocol/1</c> function.</p> </item> - <tag>{reuse_sessions, boolean()}</tag> - <item>Specifies if the server should agree to reuse sessions - when the clients request to do so. See also the reuse_session - option. - </item> + <tag><c>{next_protocols_advertised, Protocols :: [binary()]}</c></tag> + <item><p>List of protocols to send to the client if the client indicates that + it supports the Next Protocol extension. The client can select a protocol + that is not on this list. The list of protocols must not contain an empty + binary. If the server negotiates a Next Protocol, it can be accessed + using the <c>negotiated_next_protocol/1</c> method.</p></item> - <tag>{reuse_session, fun(SuggestedSessionId, - PeerCert, Compression, CipherSuite) -> boolean()}</tag> - <item>Enables the ssl server to have a local policy - for deciding if a session should be reused or not, - only meaningful if <c>reuse_sessions</c> is set to true. - SuggestedSessionId is a binary(), PeerCert is a DER encoded - certificate, Compression is an enumeration integer - and CipherSuite is of type ciphersuite(). - </item> + <tag><c>{psk_identity, string()}</c></tag> + <item><p>Specifies the server identity hint, which the server presents to + the client.</p></item> - <tag>{next_protocols_advertised, Protocols :: [binary()]}</tag> - <item>The list of protocols to send to the client if the client indicates - it supports the Next Protocol extension. The client may select a protocol - that is not on this list. The list of protocols must not contain an empty - binary. If the server negotiates a Next Protocol it can be accessed - using <c>negotiated_next_protocol/1</c> method. - </item> + <tag><c>{log_alert, boolean()}</c></tag> + <item><p>If set to <c>false</c>, error reports are not displayed.</p></item> - <tag>{psk_identity, string()}</tag> - <item>Specifies the server identity hint the server presents to the client. - </item> - <tag>{log_alert, boolean()}</tag> - <item>If false, error reports will not be displayed.</item> - <tag>{honor_cipher_order, boolean()}</tag> - <item>If true, use the server's preference for cipher selection. If false - (the default), use the client's preference. - </item> + <tag><c>{honor_cipher_order, boolean()}</c></tag> + <item><p>If set to <c>true</c>, use the server preference for cipher + selection. If set to <c>false</c> (the default), use the client + preference.</p></item> + + </taglist> </section> <section> <title>General</title> - <p>When an ssl socket is in active mode (the default), data from the + <p>When an SSL socket is in active mode (the default), data from the socket is delivered to the owner of the socket in the form of - messages: - </p> + messages:</p> + <list type="bulleted"> - <item>{ssl, Socket, Data} - </item> - <item>{ssl_closed, Socket} - </item> - <item> - {ssl_error, Socket, Reason} - </item> + <item><p><c>{ssl, Socket, Data}</c></p></item> + <item><p><c>{ssl_closed, Socket}</c></p></item> + <item><p><c>{ssl_error, Socket, Reason}</c></p></item> </list> - - <p>A <c>Timeout</c> argument specifies a timeout in milliseconds. The - default value for a <c>Timeout</c> argument is <c>infinity</c>. - </p> + + <p>A <c>Timeout</c> argument specifies a time-out in milliseconds. The + default value for argument <c>Timeout</c> is <c>infinity</c>.</p> </section> <funcs> <func> <name>cipher_suites() -></name> <name>cipher_suites(Type) -> ciphers()</name> - <fsummary> Returns a list of supported cipher suites</fsummary> + <fsummary>Returns a list of supported cipher suites.</fsummary> <type> <v>Type = erlang | openssl | all</v> - </type> <desc><p>Returns a list of supported cipher suites. - cipher_suites() is equivalent to cipher_suites(erlang). - Type openssl is provided for backwards compatibility with - old ssl that used openssl. cipher_suites(all) returns + <c>cipher_suites()</c> is equivalent to <c>cipher_suites(erlang).</c> + Type <c>openssl</c> is provided for backwards compatibility with the + old SSL, which used OpenSSL. <c>cipher_suites(all)</c> returns all available cipher suites. The cipher suites not present - in cipher_suites(erlang) but in included in cipher_suites(all) - will not be used unless explicitly configured by the user. - </p> + in <c>cipher_suites(erlang)</c> but included in + <c>cipher_suites(all)</c> are not used unless explicitly configured + by the user.</p> </desc> </func> @@ -623,17 +680,17 @@ fun(srp, Username :: string(), UserState :: term()) -> <name>connect(Socket, SslOptions) -> </name> <name>connect(Socket, SslOptions, Timeout) -> {ok, SslSocket} | {error, Reason}</name> - <fsummary> Upgrades a gen_tcp, or - equivalent, connected socket to an ssl socket. </fsummary> + <fsummary>Upgrades a <c>gen_tcp</c>, or + equivalent, connected socket to an SSL socket.</fsummary> <type> - <v>Socket = socket()</v> - <v>SslOptions = [ssloption()]</v> + <v>Socket = socket()</v> + <v>SslOptions = [ssloption()]</v> <v>Timeout = integer() | infinity</v> <v>SslSocket = sslsocket()</v> <v>Reason = term()</v> </type> - <desc> <p>Upgrades a gen_tcp, or equivalent, - connected socket to an ssl socket i.e. performs the + <desc><p>Upgrades a <c>gen_tcp</c>, or equivalent, + connected socket to an SSL socket, that is, performs the client-side ssl handshake.</p> </desc> </func> @@ -642,7 +699,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <name>connect(Host, Port, Options) -></name> <name>connect(Host, Port, Options, Timeout) -> {ok, SslSocket} | {error, Reason}</name> - <fsummary>Opens an ssl connection to Host, Port. </fsummary> + <fsummary>Opens an SSL connection to <c>Host</c>, <c>Port</c>.</fsummary> <type> <v>Host = host()</v> <v>Port = integer()</v> @@ -651,72 +708,70 @@ fun(srp, Username :: string(), UserState :: term()) -> <v>SslSocket = sslsocket()</v> <v>Reason = term()</v> </type> - <desc> <p>Opens an ssl connection to Host, Port.</p> </desc> + <desc><p>Opens an SSL connection to <c>Host</c>, <c>Port</c>.</p></desc> </func> <func> <name>close(SslSocket) -> ok | {error, Reason}</name> - <fsummary>Close an ssl connection</fsummary> + <fsummary>Closes an SSL connection.</fsummary> <type> <v>SslSocket = sslsocket()</v> <v>Reason = term()</v> </type> - <desc><p>Close an ssl connection.</p> + <desc><p>Closes an SSL connection.</p> + </desc> + </func> + + <func> + <name>connection_info(SslSocket) -> + {ok, {ProtocolVersion, CipherSuite}} | {error, Reason}</name> + <fsummary>Returns the Negotiated Protocol version and cipher suite. + </fsummary> + <type> + <v>CipherSuite = ciphersuite()</v> + <v>ProtocolVersion = protocol()</v> + </type> + <desc><p>Returns the Negotiated Protocol version and cipher suite.</p> </desc> </func> <func> <name>controlling_process(SslSocket, NewOwner) -> ok | {error, Reason}</name> - <fsummary>Assigns a new controlling process to the - ssl-socket.</fsummary> - + SSL socket.</fsummary> <type> <v>SslSocket = sslsocket()</v> <v>NewOwner = pid()</v> <v>Reason = term()</v> </type> - <desc><p>Assigns a new controlling process to the ssl-socket. A - controlling process is the owner of an ssl-socket, and receives - all messages from the socket.</p> + <desc><p>Assigns a new controlling process to the SSL socket. A + controlling process is the owner of an SSL socket, and receives + all messages from the socket.</p> </desc> </func> <func> - <name>connection_info(SslSocket) -> - {ok, {ProtocolVersion, CipherSuite}} | {error, Reason} </name> - <fsummary>Returns the negotiated protocol version and cipher suite. - </fsummary> - <type> - <v>CipherSuite = ciphersuite()</v> - <v>ProtocolVersion = protocol()</v> - </type> - <desc><p>Returns the negotiated protocol version and cipher suite.</p> - </desc> - </func> - - <func> <name>format_error(Reason) -> string()</name> - <fsummary>Return an error string.</fsummary> + <fsummary>Returns an error string.</fsummary> <type> <v>Reason = term()</v> </type> <desc> - <p>Presents the error returned by an ssl function as a printable string.</p> + <p>Presents the error returned by an SSL function as a printable string.</p> </desc> </func> <func> <name>getopts(Socket, OptionNames) -> {ok, [socketoption()]} | {error, Reason}</name> - <fsummary>Get the value of the specified options.</fsummary> + <fsummary>Gets the values of the specified options.</fsummary> <type> <v>Socket = sslsocket()</v> <v>OptionNames = [atom()]</v> </type> <desc> - <p>Get the value of the specified socket options. + <p>Gets the values of the specified socket options. </p> </desc> </func> @@ -724,34 +779,49 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>listen(Port, Options) -> {ok, ListenSocket} | {error, Reason}</name> - <fsummary>Creates an ssl listen socket.</fsummary> + <fsummary>Creates an SSL listen socket.</fsummary> <type> <v>Port = integer()</v> <v>Options = options()</v> <v>ListenSocket = sslsocket()</v> </type> <desc> - <p>Creates an ssl listen socket.</p> + <p>Creates an SSL listen socket.</p> </desc> </func> <func> + <name>negotiated_protocol(Socket) -> {ok, Protocol} | {error, protocol_not_negotiated}</name> + <fsummary>Returns the protocol negotiated through ALPN or NPN extensions.</fsummary> + <type> + <v>Socket = sslsocket()</v> + <v>Protocol = binary()</v> + </type> + <desc> + <p> + Returns the protocol negotiated through ALPN or NPN extensions. + </p> + </desc> + </func> + + <func> <name>peercert(Socket) -> {ok, Cert} | {error, Reason}</name> - <fsummary>Return the peer certificate.</fsummary> + <fsummary>Returns the peer certificate.</fsummary> <type> <v>Socket = sslsocket()</v> <v>Cert = binary()</v> </type> <desc> - <p>The peer certificate is returned as a DER encoded binary. - The certificate can be decoded with <c>public_key:pkix_decode_cert/2</c>. - </p> + <p>The peer certificate is returned as a DER-encoded binary. + The certificate can be decoded with + <c>public_key:pkix_decode_cert/2</c>.</p> </desc> </func> + <func> <name>peername(Socket) -> {ok, {Address, Port}} | {error, Reason}</name> - <fsummary>Return peer address and port.</fsummary> + <fsummary>Returns the peer address and port.</fsummary> <type> <v>Socket = sslsocket()</v> <v>Address = ipaddress()</v> @@ -761,12 +831,32 @@ fun(srp, Username :: string(), UserState :: term()) -> <p>Returns the address and port number of the peer.</p> </desc> </func> + + <func> + <name>prf(Socket, Secret, Label, Seed, WantedLength) -> {ok, binary()} | {error, reason()}</name> + <fsummary>Uses a session Pseudo-Random Function to generate key material.</fsummary> + <type> + <v>Socket = sslsocket()</v> + <v>Secret = binary() | master_secret</v> + <v>Label = binary()</v> + <v>Seed = [binary() | prf_random()]</v> + <v>WantedLength = non_neg_integer()</v> + </type> + <desc> + <p>Uses the Pseudo-Random Function (PRF) of a TLS session to generate + extra key material. It either takes user-generated values for + <c>Secret</c> and <c>Seed</c> or atoms directing it to use a specific + value from the session security parameters.</p> + <p>Can only be used with TLS connections; <c>{error, undefined}</c> + is returned for SSLv3 connections.</p> + </desc> + </func> <func> <name>recv(Socket, Length) -> </name> <name>recv(Socket, Length, Timeout) -> {ok, Data} | {error, Reason}</name> - <fsummary>Receive data on a socket.</fsummary> + <fsummary>Receives data on a socket.</fsummary> <type> <v>Socket = sslsocket()</v> <v>Length = integer()</v> @@ -774,63 +864,43 @@ fun(srp, Username :: string(), UserState :: term()) -> <v>Data = [char()] | binary()</v> </type> <desc> - <p>This function receives a packet from a socket in passive - mode. A closed socket is indicated by a return value + <p>Receives a packet from a socket in passive + mode. A closed socket is indicated by return value <c>{error, closed}</c>.</p> - <p>The <c>Length</c> argument is only meaningful when - the socket is in <c>raw</c> mode and denotes the number of + <p>Argument <c>Length</c> is meaningful only when + the socket is in mode <c>raw</c> and denotes the number of bytes to read. If <c>Length</c> = 0, all available bytes are returned. If <c>Length</c> > 0, exactly <c>Length</c> bytes are returned, or an error; possibly discarding less than <c>Length</c> bytes of data when the socket gets closed from the other side.</p> - <p>The optional <c>Timeout</c> parameter specifies a timeout in + <p>Optional argument <c>Timeout</c> specifies a time-out in milliseconds. The default value is <c>infinity</c>.</p> </desc> </func> <func> - <name>prf(Socket, Secret, Label, Seed, WantedLength) -> {ok, binary()} | {error, reason()}</name> - <fsummary>Use a sessions pseudo random function to generate key material.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Secret = binary() | master_secret</v> - <v>Label = binary()</v> - <v>Seed = [binary() | prf_random()]</v> - <v>WantedLength = non_neg_integer()</v> - </type> - <desc> - <p>Use the pseudo random function (PRF) of a TLS session to generate - additional key material. It either takes user generated values for - <c>Secret</c> and <c>Seed</c> or atoms directing it use a specific - value from the session security parameters.</p> - <p>This function can only be used with TLS connections, <c>{error, undefined}</c> - is returned for SSLv3 connections.</p> - </desc> - </func> - - <func> <name>renegotiate(Socket) -> ok | {error, Reason}</name> - <fsummary> Initiates a new handshake.</fsummary> + <fsummary>Initiates a new handshake.</fsummary> <type> <v>Socket = sslsocket()</v> </type> <desc><p>Initiates a new handshake. A notable return value is <c>{error, renegotiation_rejected}</c> indicating that the peer - refused to go through with the renegotiation but the connection + refused to go through with the renegotiation, but the connection is still active using the previously negotiated session.</p> </desc> </func> <func> <name>send(Socket, Data) -> ok | {error, Reason}</name> - <fsummary>Write data to a socket.</fsummary> + <fsummary>Writes data to a socket.</fsummary> <type> <v>Socket = sslsocket()</v> <v>Data = iodata()</v> </type> <desc> - <p>Writes <c>Data</c> to <c>Socket</c>. </p> + <p>Writes <c>Data</c> to <c>Socket</c>.</p> <p>A notable return value is <c>{error, closed}</c> indicating that the socket is closed.</p> </desc> @@ -838,31 +908,31 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>setopts(Socket, Options) -> ok | {error, Reason}</name> - <fsummary>Set socket options.</fsummary> + <fsummary>Sets socket options.</fsummary> <type> <v>Socket = sslsocket()</v> <v>Options = [socketoption]()</v> </type> <desc> - <p>Sets options according to <c>Options</c> for the socket - <c>Socket</c>. </p> + <p>Sets options according to <c>Options</c> for socket + <c>Socket</c>.</p> </desc> </func> <func> <name>shutdown(Socket, How) -> ok | {error, Reason}</name> - <fsummary>Immediately close a socket</fsummary> + <fsummary>Immediately closes a socket.</fsummary> <type> <v>Socket = sslsocket()</v> <v>How = read | write | read_write</v> <v>Reason = reason()</v> </type> <desc> - <p>Immediately close a socket in one or two directions.</p> + <p>Immediately closes a socket in one or two directions.</p> <p><c>How == write</c> means closing the socket for writing, reading from it is still possible.</p> <p>To be able to handle that the peer has done a shutdown on - the write side, the <c>{exit_on_close, false}</c> option + the write side, option <c>{exit_on_close, false}</c> is useful.</p> </desc> </func> @@ -870,16 +940,16 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>ssl_accept(Socket) -> </name> <name>ssl_accept(Socket, Timeout) -> ok | {error, Reason}</name> - <fsummary>Perform server-side SSL/TLS handshake</fsummary> + <fsummary>Performs server-side SSL/TLS handshake.</fsummary> <type> <v>Socket = sslsocket()</v> <v>Timeout = integer()</v> <v>Reason = term()</v> </type> <desc> - <p> Performs the SSL/TLS server-side handshake <c>Socket</c> is a socket as returned - by <seealso - marker="#transport_accept-2">ssl:transport_accept/[1,2]</seealso> + <p>Performs the SSL/TLS server-side handshake.</p> + <p><c>Socket</c> is a socket as returned by + <seealso marker="#transport_accept-2">ssl:transport_accept/[1,2]</seealso> </p> </desc> </func> @@ -887,7 +957,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>ssl_accept(Socket, SslOptions) -> </name> <name>ssl_accept(Socket, SslOptions, Timeout) -> {ok, Socket} | ok | {error, Reason}</name> - <fsummary>Perform server-side SSL/TLS handshake</fsummary> + <fsummary>Performs server-side SSL/TLS handshake.</fsummary> <type> <v>Socket = socket() | sslsocket() </v> <v>SslOptions = ssloptions()</v> @@ -895,17 +965,19 @@ fun(srp, Username :: string(), UserState :: term()) -> <v>Reason = term()</v> </type> <desc> - <p> If <c>Socket</c> is a socket() - upgrades a gen_tcp, or equivalent, socket to an ssl socket - i.e. performs the SSL/TLS server-side handshake and returns the ssl socket. - </p> + <p>If <c>Socket</c> is a <c>socket()</c>: upgrades a <c>gen_tcp</c>, + or equivalent, socket to an SSL socket, that is, performs + the SSL/TLS server-side handshake and returns the SSL socket.</p> - <warning><p>Note that the listen socket should be in {active, false} mode + <warning><p>The listen socket is to be in mode <c>{active, false}</c> before telling the client that the server is ready to upgrade - by calling this function, otherwise the upgrade may - or may not succeed depending on timing.</p></warning> + by calling this function, else the upgrade succeeds or does not + succeed depending on timing.</p></warning> - <p> If <c>Socket</c> is an sslsocket() - provides additional SSL/TLS options to those specified in <seealso - marker="#listen-2">ssl:listen/2 </seealso> and then performs the SSL/TLS handshake. + <p>If <c>Socket</c> is an <c>sslsocket()</c>: provides extra SSL/TLS + options to those specified in + <seealso marker="#listen-2">ssl:listen/2 </seealso> and then performs + the SSL/TLS handshake. </p> </desc> </func> @@ -913,14 +985,14 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>sockname(Socket) -> {ok, {Address, Port}} | {error, Reason}</name> - <fsummary>Return the local address and port.</fsummary> + <fsummary>Returns the local address and port.</fsummary> <type> <v>Socket = sslsocket()</v> <v>Address = ipaddress()</v> <v>Port = integer()</v> </type> <desc> - <p>Returns the local address and port number of the socket + <p>Returns the local address and port number of socket <c>Socket</c>.</p> </desc> </func> @@ -928,22 +1000,21 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>start() -> </name> <name>start(Type) -> ok | {error, Reason}</name> - <fsummary>Starts the Ssl application. </fsummary> + <fsummary>Starts the SSL application.</fsummary> <type> - <v>Type = permanent | transient | temporary</v> + <v>Type = permanent | transient | temporary</v> </type> <desc> - <p>Starts the Ssl application. Default type - is temporary. - <seealso marker="kernel:application">application(3)</seealso></p> + <p>Starts the SSL application. Default type + is <c>temporary</c>.</p> </desc> </func> + <func> <name>stop() -> ok </name> - <fsummary>Stops the Ssl application.</fsummary> + <fsummary>Stops the SSL application.</fsummary> <desc> - <p>Stops the Ssl application. - <seealso marker="kernel:application">application(3)</seealso></p> + <p>Stops the SSL application.</p> </desc> </func> @@ -951,8 +1022,8 @@ fun(srp, Username :: string(), UserState :: term()) -> <name>transport_accept(ListenSocket) -></name> <name>transport_accept(ListenSocket, Timeout) -> {ok, NewSocket} | {error, Reason}</name> - <fsummary>Accept an incoming connection and - prepare for <c>ssl_accept</c></fsummary> + <fsummary>Accepts an incoming connection and + prepares for <c>ssl_accept</c>.</fsummary> <type> <v>ListenSocket = NewSocket = sslsocket()</v> <v>Timeout = integer()</v> @@ -961,23 +1032,22 @@ fun(srp, Username :: string(), UserState :: term()) -> <desc> <p>Accepts an incoming connection request on a listen socket. <c>ListenSocket</c> must be a socket returned from - <seealso - marker="#listen-2"> ssl:listen/2</seealso>. - The socket returned should be passed to + <seealso marker="#listen-2"> ssl:listen/2</seealso>. + The socket returned is to be passed to <seealso marker="#ssl_accept-2"> ssl:ssl_accept[2,3]</seealso> - to complete handshaking i.e + to complete handshaking, that is, establishing the SSL/TLS connection.</p> <warning> <p>The socket returned can only be used with - <seealso marker="#ssl_accept-2"> ssl:ssl_accept[2,3]</seealso> - no traffic can be sent or received before that call.</p> + <seealso marker="#ssl_accept-2"> ssl:ssl_accept[2,3]</seealso>. + No traffic can be sent or received before that call.</p> </warning> <p>The accepted socket inherits the options set for - <c>ListenSocket</c> in <seealso - marker="#listen-2"> ssl:listen/2</seealso>.</p> + <c>ListenSocket</c> in + <seealso marker="#listen-2"> ssl:listen/2</seealso>.</p> <p>The default value for <c>Timeout</c> is <c>infinity</c>. If - <c>Timeout</c> is specified, and no connection is accepted + <c>Timeout</c> is specified and no connection is accepted within the given time, <c>{error, timeout}</c> is returned.</p> </desc> @@ -986,59 +1056,42 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>versions() -> [versions_info()]</name> <fsummary>Returns version information relevant for the - ssl application.</fsummary> + SSL application.</fsummary> <type> <v>versions_info() = {app_vsn, string()} | {supported | available, [protocol()] </v> </type> <desc> - <p> - Returns version information relevant for the - ssl application. - </p> + <p>Returns version information relevant for the SSL + application.</p> <taglist> - <tag>app_vsn</tag> - <item> The application version of the OTP ssl application.</item> - - <tag>supported</tag> + <tag><c>app_vsn</c></tag> + <item>The application version of the SSL application.</item> + <tag><c>supported</c></tag> <item>TLS/SSL versions supported by default. - Overridden by a versions option on - <seealso marker="#connect-2"> connect/[2,3,4]</seealso>, <seealso - marker="#listen-2"> listen/2</seealso> and <seealso - marker="#ssl_accept-2">ssl_accept/[1,2,3]</seealso>. For the - negotiated TLS/SSL version see <seealso + Overridden by a version option on + <seealso marker="#connect-2"> connect/[2,3,4]</seealso>, + <seealso marker="#listen-2"> listen/2</seealso>, and <seealso + marker="#ssl_accept-2">ssl_accept/[1,2,3]</seealso>. + For the negotiated TLS/SSL version, see <seealso marker="#connection_info-1">ssl:connection_info/1 - </seealso></item> - - <tag>available</tag> - <item>All TLS/SSL versions that the Erlang ssl application - can support. Note that TLS 1.2 requires sufficient support - from the crypto application. </item> + </seealso>.</item> + + <tag><c>available</c></tag> + <item>All TLS/SSL versions supported by the SSL application. + TLS 1.2 requires sufficient support from the Crypto + application.</item> </taglist> </desc> </func> - <func> - <name>negotiated_next_protocol(Socket) -> {ok, Protocol} | {error, next_protocol_not_negotiated}</name> - <fsummary>Returns the Next Protocol negotiated.</fsummary> - <type> - <v>Socket = sslsocket()</v> - <v>Protocol = binary()</v> - </type> - <desc> - <p> - Returns the Next Protocol negotiated. - </p> - </desc> - </func> - + </funcs> <section> <title>SEE ALSO</title> - <p><seealso marker="kernel:inet">inet(3) </seealso> and - <seealso marker="kernel:gen_tcp">gen_tcp(3) </seealso> + <p><seealso marker="kernel:inet">inet(3)</seealso> and + <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso> </p> </section> </erlref> - diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index e3a3fc27f2..f17f5cb9fe 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -22,66 +22,60 @@ </legalnotice> <title>ssl</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> <file>ssl_app.sgml</file> </header> <app>ssl</app> - <appsummary>The SSL application provides secure communication over + <appsummary>The ssl application provides secure communication over sockets.</appsummary> + <description></description> <section> <title>DEPENDENCIES</title> - <p>The ssl application uses the Erlang applications public_key and - crypto to handle public keys and encryption, hence these - applications needs to be loaded for the ssl application to work. In - an embedded environment that means they need to be started with - application:start/[1,2] before the ssl application is started. - </p> + <p>The SSL application uses the <c>public_key</c> and + Crypto application to handle public keys and encryption, hence + these applications must be loaded for the SSL application to work. + In an embedded environment this means they must be started with + <c>application:start/[1,2]</c> before the SSL application is + started.</p> </section> <section> - <title>ENVIRONMENT</title> - <p>The following application environment configuration parameters - are defined for the SSL application. See <seealso - marker="kernel:application">application(3)</seealso>for more - information about configuration parameters. - </p> - <p>Note that the environment parameters can be set on the command line, - for instance,</p> - <p><c>erl ... -ssl protocol_version '[sslv3, tlsv1]' ...</c>. - </p> + <title>CONFIGURATION</title> + <p>The application environment configuration parameters in this section + are defined for the SSL application. For more information + about configuration parameters, see the + <seealso marker="kernel:application">application(3)</seealso> + manual page in Kernel.</p> + + <p>The environment parameters can be set on the command line, + for example:</p> + + <p><c>erl -ssl protocol_version "['tlsv1.2', 'tlsv1.1']"</c></p> + <taglist> - <tag><c><![CDATA[protocol_version = [sslv3|tlsv1] <optional>]]></c>.</tag> - <item> - <p>Protocol that will be supported by started clients and - servers. If this option is not set it will default to all - protocols currently supported by the erlang ssl application. - Note that this option may be overridden by the version option - to ssl:connect/[2,3] and ssl:listen/2. - </p> - </item> + <tag><c><![CDATA[protocol_version = <seealso marker="kernel:error_logger">ssl:protocol()</seealso> <optional>]]></c>.</tag> + <item><p>Protocol supported by started clients and + servers. If this option is not set, it defaults to all + protocols currently supported by the SSL application. + This option can be overridden by the version option + to <c>ssl:connect/[2,3]</c> and <c>ssl:listen/2</c>.</p></item> <tag><c><![CDATA[session_lifetime = integer() <optional>]]></c></tag> - <item> - <p>The lifetime of session data in seconds. - </p> - </item> + <item><p>Lifetime of the session data in seconds.</p></item> - <tag><c><![CDATA[session_cb = atom() <optional>]]></c></tag> - <item> - <p> - Name of session cache callback module that implements - the ssl_session_cache_api behavior, defaults to - ssl_session_cache.erl. - </p> - </item> + <tag><c><![CDATA[session_cb = atom() <optional>]]></c></tag> + <item><p>Name of the session cache callback module that implements + the <c>ssl_session_cache_api</c> behavior. Defaults to + <c>ssl_session_cache.erl</c>.</p></item> <tag><c><![CDATA[session_cb_init_args = proplist:proplist() <optional>]]></c></tag> - <item> - <p> - List of additional user defined arguments to the init function in session cache - callback module, defaults to []. - </p> - </item> + + <item><p>List of extra user-defined arguments to the <c>init</c> function + in the session cache callback module. Defaults to <c>[]</c>.</p></item> <tag><c><![CDATA[ssl_pem_cache_clean = integer() <optional>]]></c></tag> <item> @@ -96,6 +90,11 @@ </section> <section> + <title>ERROR LOGGER AND EVENT HANDLERS</title> + <p>The SSL application uses the default <seealso marker="kernel:error_logger">OTP error logger</seealso> to log unexpected errors and TLS alerts. The logging of TLS alerts may be turned off with the <c>log_alert</c> option. </p> + </section> + + <section> <title>SEE ALSO</title> <p><seealso marker="kernel:application">application(3)</seealso></p> </section> diff --git a/lib/ssl/doc/src/ssl_crl_cache.xml b/lib/ssl/doc/src/ssl_crl_cache.xml index 1ed76d3e2a..83b03375b1 100644 --- a/lib/ssl/doc/src/ssl_crl_cache.xml +++ b/lib/ssl/doc/src/ssl_crl_cache.xml @@ -29,38 +29,37 @@ <p> Implements an internal CRL (Certificate Revocation List) cache. In addition to implementing the <seealso - marker="ssl_cache_crl_api"> ssl_cache_crl_api</seealso> + marker="ssl_crl_cache_api"> ssl_crl_cache_api</seealso> behaviour the following functions are available. </p> </description> <funcs> <func> - <name>insert(CRLSrc) -> ok | {error, Reason}</name> - <name>insert(URI, CRLSrc) -> ok | {error, Reason}</name> - <fsummary> </fsummary> - <type> - <v> CRLSrc = {file, string()} | {der, [ <seealso - marker="public_key:public_key"> der_encoded() </seealso> ]}</v> - <v> URI = http_uri:uri()</v> - <v> Reason = term()</v> - </type> - <desc> - Insert CRLs into the ssl applications local cache. - </desc> - </func> - - <func> - <name>delete(Entries) -> ok | {error, Reason} </name> - <fsummary> </fsummary> - <type> - <v> Entries = http_uri:uri() | {file, string()} | {der, [<seealso - marker="public_key:public_key"> der_encoded() </seealso>]}</v> - <v> Reason = term()</v> - </type> - <desc> - Delete CRLs from the ssl applications local cache. - </desc> - </func> + <name>delete(Entries) -> ok | {error, Reason} </name> + <fsummary> </fsummary> + <type> + <v> Entries = <seealso marker="inets:http_uri">http_uri:uri() </seealso> | {file, string()} | {der, [<seealso + marker="public_key:public_key"> public_key:der_encoded() </seealso>]}</v> + <v> Reason = term()</v> + </type> + <desc> + <p>Delete CRLs from the ssl applications local cache. </p> + </desc> + </func> + <func> + <name>insert(CRLSrc) -> ok | {error, Reason}</name> + <name>insert(URI, CRLSrc) -> ok | {error, Reason}</name> + <fsummary> </fsummary> + <type> + <v> CRLSrc = {file, string()} | {der, [ <seealso + marker="public_key:public_key"> public_key:der_encoded() </seealso> ]}</v> + <v> URI = <seealso marker="inets:http_uri">http_uri:uri() </seealso> </v> + <v> Reason = term()</v> + </type> + <desc> + <p>Insert CRLs into the ssl applications local cache. </p> + </desc> + </func> </funcs> </erlref>
\ No newline at end of file diff --git a/lib/ssl/doc/src/ssl_crl_cache_api.xml b/lib/ssl/doc/src/ssl_crl_cache_api.xml index 24365c9f59..1d9353a2cc 100644 --- a/lib/ssl/doc/src/ssl_crl_cache_api.xml +++ b/lib/ssl/doc/src/ssl_crl_cache_api.xml @@ -27,28 +27,53 @@ <modulesummary>API for a SSL/TLS CRL (Certificate Revocation List) cache.</modulesummary> <description> <p> - When SSL/TLS performs certificate path validation according to - <url href="http://www.ietf.org/rfc/rfc5280.txt">RFC 5280 </url> it should - also perform CRL validation checks. To enable the CRL checks the application - needs access to CRLs. A database of CRLs can be set up in many different ways. - This module provides an API to integrate an arbitrary CRL cache with the erlang - ssl application. It is also used by the application itself to provide a simple - default implementation of a CRL cache. + When SSL/TLS performs certificate path validation according to + <url href="http://www.ietf.org/rfc/rfc5280.txt">RFC 5280 </url> + it should also perform CRL validation checks. To enable the CRL + checks the application needs access to CRLs. A database of CRLs + can be set up in many different ways. This module provides the + behavior of the API needed to integrate an arbitrary CRL cache + with the erlang ssl application. It is also used by the + application itself to provide a simple default implementation of + a CRL cache. </p> </description> <section> - <title>Common Data Types</title> + <title>DATA TYPES</title> <p>The following data types are used in the functions below: </p> - <p><c>cache_ref() = opaque()</c></p> - <p> dist_point() = #'DistributionPoint'{} see <seealso - marker="public_key:cert_records"> X509 certificates records</seealso></p> + <taglist> + + <tag><c>cache_ref()</c></tag> + <item> = opaque()</item> + <tag><c>dist_point()</c></tag> + <item> = #'DistributionPoint'{} see <seealso + marker="public_key:cert_records"> X509 certificates records</seealso></item> + + </taglist> + </section> - <funcs> + <func> + <name>fresh_crl(DistributionPoint, CRL) -> FreshCRL</name> + <fsummary> <c>fun fresh_crl/2 </c> will be used as input option <c>update_crl</c> to + public_key:pkix_crls_validate/3 </fsummary> + <type> + <v> DistributionPoint = dist_point() </v> + <v> CRL = [<seealso + marker="public_key:public_key">public_key:der_encoded()</seealso>] </v> + <v> FreshCRL = [<seealso + marker="public_key:public_key">public_key:der_encoded()</seealso>] </v> + </type> + <desc> + <p> <c>fun fresh_crl/2 </c> will be used as input option <c>update_crl</c> to + <seealso marker="public_key:public_key#pkix_crls_validate-3">public_key:pkix_crls_validate/3 </seealso> </p> + </desc> + </func> + <func> <name>lookup(DistributionPoint, DbHandle) -> not_available | CRLs </name> <fsummary> </fsummary> @@ -58,7 +83,7 @@ <v> CRLs = [<seealso marker="public_key:public_key">public_key:der_encoded()</seealso>] </v> </type> - <desc> <p>Lookup the CRLs belonging to the distribution point <c> Distributionpoint </c> </p>. + <desc> <p>Lookup the CRLs belonging to the distribution point <c> Distributionpoint</c>. </p> This function may choose to only look in the cache or to follow distribution point links depending on how the cache is administrated. </desc> @@ -76,22 +101,5 @@ <p>Select the CRLs in the cache that are issued by <c>Issuer</c> </p> </desc> </func> - - <func> - <name>fresh_crl(DistributionPoint, CRL) -> FreshCRL</name> - <fsummary> <c>fun fresh_crl/2 </c> will be used as input option <c>update_crl</c> to - public_key:pkix_crls_validate/3 </fsummary> - <type> - <v> DistributionPoint = dist_point() </v> - <v> CRL = [<seealso - marker="public_key:public_key">public_key:der_encoded()</seealso>] </v> - <v> FreshCRL = [<seealso - marker="public_key:public_key">public_key:der_encoded()</seealso>] </v> - </type> - <desc> - <p> <c>fun fresh_crl/2 </c> will be used as input option <c>update_crl</c> to - <seealso marker="public_key#pkix_path_validation-3">public_key:pkix_crls_validate/3 </seealso> </p> - </desc> - </func> </funcs> </erlref>
\ No newline at end of file diff --git a/lib/ssl/doc/src/ssl_distribution.xml b/lib/ssl/doc/src/ssl_distribution.xml index 4b4d042f70..effb304938 100644 --- a/lib/ssl/doc/src/ssl_distribution.xml +++ b/lib/ssl/doc/src/ssl_distribution.xml @@ -31,23 +31,20 @@ <rev>B</rev> <file>ssl_distribution.xml</file> </header> - <p>This chapter describes how the Erlang distribution can use - SSL to get additional verification and security. - </p> + <p>This section describes how the Erlang distribution can use + SSL to get extra verification and security.</p> - <section> - <title>Introduction</title> - <p>The Erlang distribution can in theory use almost any connection - based protocol as bearer. A module that implements the protocol - specific parts of the connection setup is however needed. The - default distribution module is <c>inet_tcp_dist</c> which is - included in the Kernel application. When starting an + <p>The Erlang distribution can in theory use almost any + connection-based protocol as bearer. However, a module that + implements the protocol-specific parts of the connection setup is + needed. The default distribution module is <c>inet_tcp_dist</c> + in the Kernel application. When starting an Erlang node distributed, <c>net_kernel</c> uses this module to - setup listen ports and connections. </p> + set up listen ports and connections.</p> - <p>In the SSL application there is an additional distribution - module, <c>inet_tls_dist</c> which can be used as an - alternative. All distribution connections will be using SSL and + <p>In the SSL application, an exra distribution + module, <c>inet_tls_dist</c>, can be used as an + alternative. All distribution connections will use SSL and all participating Erlang nodes in a distributed system must use this distribution module.</p> @@ -55,35 +52,45 @@ SSL connection setup. Erlang node cookies are however always used, as they can be used to differentiate between two different Erlang networks.</p> - <p>Setting up Erlang distribution over SSL involves some simple but - necessary steps:</p> + + <p>To set up Erlang distribution over SSL:</p> <list type="bulleted"> - <item>Building boot scripts including the SSL application</item> - <item>Specifying the distribution module for net_kernel</item> - <item>Specifying security options and other SSL options</item> + <item><em>Step 1:</em> Build boot scripts including the + SSL application.</item> + <item><em>Step 2:</em> Specify the distribution module for + <c>net_kernel</c>.</item> + <item><em>Step 3:</em> Specify the security options and other + SSL options.</item> + <item><em>Step 4:</em> Set up the environment to always use SSL.</item> </list> - <p>The rest of this chapter describes the above mentioned steps in - more detail.</p> - </section> + + <p>The following sections describe these steps.</p> <section> - <title>Building boot scripts including the SSL application</title> + <title>Building Boot Scripts Including the ssl Application</title> <p>Boot scripts are built using the <c>systools</c> utility in the - SASL application. Refer to the SASL documentations - for more information on systools. This is only an example of + <c>sasl</c> application. For more information on <c>systools</c>, + see the <c>sasl</c> documentation. This is only an example of what can be done.</p> - <p>The simplest boot script possible includes only the Kernel - and STDLIB applications. Such a script is located in the - Erlang distributions bin directory. The source for the script - can be found under the Erlang installation top directory under - <c><![CDATA[releases/<OTP version>/start_clean.rel]]></c>. Copy that - script to another location (and preferably another name) - and add the applications crypto, public_key and SSL with their current version numbers - after the STDLIB application.</p> - <p>An example .rel file with SSL added may look like this:</p> + <p>The simplest boot script possible includes only the Kernel + and STDLIB applications. Such a script is located in the + <c>bin</c> directory of the Erlang distribution. The source for the + script is found under the Erlang installation top directory under + <c><![CDATA[releases/<OTP version>/start_clean.rel]]></c>.</p> + + <p>Do the following:</p> + <list type="bulleted"> + <item><p>Copy that script to another location (and preferably another + name).</p></item> + <item><p>Add the applications Crypto, Public Key, and + SSL with their current version numbers after the + STDLIB application.</p></item> + </list> + <p>The following shows an example <c>.rel</c> file with SSL + added:</p> <code type="none"> {release, {"OTP APN 181 01","R15A"}, {erts, "5.9"}, [{kernel,"2.15"}, @@ -94,23 +101,29 @@ ]}. </code> - <p>Note that the version numbers surely will differ in your system. - Whenever one of the applications included in the script is - upgraded, the script has to be changed.</p> - <p>Assuming the above .rel file is stored in a file - <c>start_ssl.rel</c> in the current directory, a boot script - can be built like this:</p> + <p>The version numbers differ in your system. Whenever one of the + applications included in the script is upgraded, change the script.</p> + <p>Do the following:</p> + <list type="bulleted"> + <item><p>Build the boot script.</p> + <p>Assuming the <c>.rel file</c> is stored in a file + <c>start_ssl.rel</c> in the current directory, a boot script + can be built as follows:</p></item> + </list> <code type="none"> 1> systools:make_script("start_ssl",[]). </code> - <p>There will now be a file <c>start_ssl.boot</c> in the current - directory. To test the boot script, start Erlang with the - <c>-boot</c> command line parameter specifying this boot script - (with its full path but without the <c>.boot</c> suffix), in - Unix it could look like this:</p> - <p></p> + <p>There is now a <c>start_ssl.boot</c> file in the current + directory.</p> + <p>Do the following:</p> + <list type="bulleted"> + <item><p>Test the boot script. To do this, start Erlang with the + <c>-boot</c> command-line parameter specifying this boot script + (with its full path, but without the <c>.boot</c> suffix). In + UNIX it can look as follows:</p></item> + </list> <code type="none"><![CDATA[ $ erl -boot /home/me/ssl/start_ssl Erlang (BEAM) emulator version 5.0 @@ -118,86 +131,99 @@ Erlang (BEAM) emulator version 5.0 Eshell V5.0 (abort with ^G) 1> whereis(ssl_manager). <0.41.0> ]]></code> - <p>The <c>whereis</c> function call verifies that the SSL - application is really started.</p> - <p>As an alternative to building a bootscript, one can explicitly + <p>The <c>whereis</c> function-call verifies that the SSL + application is started.</p> + + <p>As an alternative to building a bootscript, you can explicitly add the path to the SSL <c>ebin</c> directory on the command - line. This is done with the command line option <c>-pa</c>. This + line. This is done with command-line option <c>-pa</c>. This works as the SSL application does not need to be started for the distribution to come up, as a clone of the SSL application is - hooked into the kernel application, so as long as the - SSL applications code can be reached, the distribution will - start. The <c>-pa</c> method is only recommended for testing - purposes.</p> + hooked into the Kernel application. So, as long as the + SSL application code can be reached, the distribution starts. + The <c>-pa</c> method is only recommended for testing purposes.</p> - <note><p>Note that the clone of the SSL application is necessary to + <note><p>The clone of the SSL application must enable the use of the SSL code in such an early bootstage as - needed to setup the distribution, however this will make it + needed to set up the distribution. However, this makes it impossible to soft upgrade the SSL application.</p></note> </section> <section> - <title>Specifying distribution module for net_kernel</title> + <title>Specifying Distribution Module for net_kernel</title> <p>The distribution module for SSL is named <c>inet_tls_dist</c> - and is specified on the command line with the <c>-proto_dist</c> - option. The argument to <c>-proto_dist</c> should be the module - name without the <c>_dist</c> suffix, so this distribution + and is specified on the command line with option <c>-proto_dist</c>. + The argument to <c>-proto_dist</c> is to be the module + name without suffix <c>_dist</c>. So, this distribution module is specified with <c>-proto_dist inet_tls</c> on the command line.</p> - <p></p> - <p>Extending the command line from above gives us the following:</p> + <p>Extending the command line gives the following:</p> <code type="none"> $ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls </code> -<p>For the distribution to actually be started, we need to give -the emulator a name as well:</p> +<p>For the distribution to be started, give the emulator a name as well:</p> <code type="none"> $ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls -sname ssl_test Erlang (BEAM) emulator version 5.0 [source] Eshell V5.0 (abort with ^G) (ssl_test@myhost)1> </code> - <p>Note however that a node started in this way will refuse to talk - to other nodes, as no ssl parameters are supplied - (see below).</p> + + <p>However, a node started in this way refuses to talk + to other nodes, as no SSL parameters are supplied + (see the next section).</p> </section> <section> - <title>Specifying SSL options</title> <p>For SSL to work, at least - a public key and certificate needs to be specified for the server - side. In the following example the PEM-files consists of two - entries the servers certificate and its private key.</p> - - <p>On the <c>erl</c> command line one can specify options that the - SSL distribution will add when creating a socket.</p> - - <p>One can specify the simpler SSL options certfile, keyfile, - password, cacertfile, verify, reuse_sessions, - secure_renegotiate, depth, hibernate_after and ciphers (use old - string format) by adding the prefix server_ or client_ to the - option name. The server can also take the options dhfile and - fail_if_no_peer_cert (also prefixed). - <c>client_</c>-prfixed options are used when the distribution initiates a - connection to another node and the <c>server_</c>-prefixed options are used - when accepting a connection from a remote node. </p> - - <p> More complex options such as verify_fun are not available at - the moment but a mechanism to handle such options may be added in - a future release. </p> - - <p> Raw socket options such as packet and size must not be specified on - the command line</p>. - - <p>The command line argument for specifying the SSL options is named - <c>-ssl_dist_opt</c> and should be followed by pairs of - SSL options and their values. The <c>-ssl_dist_opt</c> argument can + <title>Specifying SSL Options</title> + <p>For SSL to work, at least + a public key and a certificate must be specified for the server + side. In the following example, the PEM-files consist of two + entries, the server certificate and its private key.</p> + + <p>On the <c>erl</c> command line you can specify options that the + SSL distribution adds when creating a socket.</p> + + <p>The simplest SSL options in the following list can be specified + by adding the + prefix <c>server_</c> or <c>client_</c> to the option name:</p> + <list type="bulleted"> + <item><c>certfile</c></item> + <item><c>keyfile</c></item> + <item><c>password</c></item> + <item><c>cacertfile</c></item> + <item><c>verify</c></item> + <item><c>reuse_sessions</c></item> + <item><c>secure_renegotiate</c></item> + <item><c>depth</c></item> + <item><c>hibernate_after</c></item> + <item><c>ciphers</c> (use old string format)</item> + </list> + + <p>The server can also take the options <c>dhfile</c> and + <c>fail_if_no_peer_cert</c> (also prefixed).</p> + + <p><c>client_</c>-prefixed options are used when the distribution + initiates a connection to another node. <c>server_</c>-prefixed + options are used when accepting a connection from a remote node.</p> + + <p>More complex options, such as <c>verify_fun</c>, are currently not + available, but a mechanism to handle such options may be added in + a future release.</p> + + <p>Raw socket options, such as <c>packet</c> and <c>size</c> must not + be specified on the command line.</p> + + <p>The command-line argument for specifying the SSL options is named + <c>-ssl_dist_opt</c> and is to be followed by pairs of + SSL options and their values. Argument <c>-ssl_dist_opt</c> can be repeated any number of times.</p> - <p>An example command line would now look something like this + <p>An example command line can now look as follows (line breaks in the command are for readability, - they should not be there when typed):</p> + and are not be there when typed):</p> <code type="none"> $ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls -ssl_dist_opt server_certfile "/home/me/ssl/erlserver.pem" @@ -207,20 +233,20 @@ Erlang (BEAM) emulator version 5.0 [source] Eshell V5.0 (abort with ^G) (ssl_test@myhost)1> </code> - <p>A node started in this way will be fully functional, using SSL + <p>A node started in this way is fully functional, using SSL as the distribution protocol.</p> </section> <section> - <title>Setting up environment to always use SSL</title> - <p>A convenient way to specify arguments to Erlang is to use the - <c>ERL_FLAGS</c> environment variable. All the flags needed to - use SSL distribution can be specified in that variable and will - then be interpreted as command line arguments for all + <title>Setting up Environment to Always Use SSL</title> + <p>A convenient way to specify arguments to Erlang is to use environment + variable <c>ERL_FLAGS</c>. All the flags needed to + use the SSL distribution can be specified in that variable and are + then interpreted as command-line arguments for all subsequent invocations of Erlang.</p> - <p></p> - <p>In a Unix (Bourne) shell it could look like this (line breaks for - readability, they should not be there when typed):</p> + + <p>In a Unix (Bourne) shell, it can look as follows (line breaks are for + readability, they are not to be there when typed):</p> <code type="none"> $ ERL_FLAGS="-boot /home/me/ssl/start_ssl -proto_dist inet_tls -ssl_dist_opt server_certfile /home/me/ssl/erlserver.pem @@ -240,7 +266,8 @@ Eshell V5.0 (abort with ^G) {ssl_dist_opt,["server_secure_renegotiate","true", "client_secure_renegotiate","true"] {home,["/home/me"]}] </code> + <p>The <c>init:get_arguments()</c> call verifies that the correct - arguments are supplied to the emulator. </p> + arguments are supplied to the emulator.</p> </section> </chapter> diff --git a/lib/ssl/doc/src/ssl_introduction.xml b/lib/ssl/doc/src/ssl_introduction.xml new file mode 100644 index 0000000000..64607a393a --- /dev/null +++ b/lib/ssl/doc/src/ssl_introduction.xml @@ -0,0 +1,53 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2015</year> + <year>2015</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + + <title>Introduction</title> + <prepared>OTP team</prepared> + <docno></docno> + <date>2015-03-05</date> + <rev>A</rev> + <file>ssl_introduction.xml</file> + </header> + + <section> + <title>Purpose</title> + <p>Transport Layer Security (TLS) and its predecessor, the Secure + Sockets Layer (SSL), are cryptographic protocols designed to + provide communications security over a computer network. The protocols use + use X.509 certificates and hence public key (asymmetric) cryptography to + authenticate the counterpart with whom they communicate, + and to exchange a symmetric key for payload encryption. The protocol provides + data/message confidentiality (encryption), integrity (through message authentication code checks) + and host verification (through certificate path validation).</p> + </section> + + <section> + <title>Prerequisites</title> + <p>It is assumed that the reader is familiar with the Erlang + programming language, the concepts of OTP, and has a basic + understanding of SSL/TLS.</p> + </section> + +</chapter> diff --git a/lib/ssl/doc/src/ssl_protocol.xml b/lib/ssl/doc/src/ssl_protocol.xml index 80d9cc4ee8..cc49515066 100644 --- a/lib/ssl/doc/src/ssl_protocol.xml +++ b/lib/ssl/doc/src/ssl_protocol.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2013</year> + <year>2003</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -21,33 +21,42 @@ </legalnotice> - <title>Transport Layer Security (TLS) and its predecessor, Secure Socket Layer (SSL)</title> + <title>TLS and its Predecessor, SSL</title> + <prepared></prepared> + <responsible></responsible> + <docno></docno> + <approved></approved> + <checked></checked> + <date></date> + <rev></rev> <file>ssl_protocol.xml</file> </header> - <p>The erlang SSL application currently implements the protocol SSL/TLS - for currently supported versions see <seealso marker="ssl">ssl(3)</seealso> + <p>The Erlang SSL application implements the SSL/TLS protocol + for the currently supported versions, see the + <seealso marker="ssl">ssl(3)</seealso> manual page. </p> - <p>By default erlang SSL is run over the TCP/IP protocol even - though you could plug in any other reliable transport protocol - with the same API as gen_tcp.</p> + <p>By default SSL/TLS is run over the TCP/IP protocol even + though you can plug in any other reliable transport protocol + with the same Application Programming Interface (API) as the + <c>gen_tcp</c> module in Kernel.</p> - <p>If a client and server wants to use an upgrade mechanism, such as - defined by RFC2817, to upgrade a regular TCP/IP connection to an SSL - connection the erlang SSL API supports this. This can be useful for - things such as supporting HTTP and HTTPS on the same port and + <p>If a client and a server wants to use an upgrade mechanism, such as + defined by RFC 2817, to upgrade a regular TCP/IP connection to an SSL + connection, this is supported by the Erlang SSL application API. This can be + useful for, for example, supporting HTTP and HTTPS on the same port and implementing virtual hosting. </p> <section> - <title>Security overview</title> + <title>Security Overview</title> - <p>To achieve authentication and privacy the client and server will - perform a TLS Handshake procedure before transmitting or receiving - any data. During the handshake they agree on a protocol version and - cryptographic algorithms, they generate shared secrets using public - key cryptographics and optionally authenticate each other with + <p>To achieve authentication and privacy, the client and server + perform a TLS handshake procedure before transmitting or receiving + any data. During the handshake, they agree on a protocol version and + cryptographic algorithms, generate shared secrets using public + key cryptographies, and optionally authenticate each other with digital certificates.</p> </section> @@ -55,20 +64,21 @@ <title>Data Privacy and Integrity</title> <p>A <em>symmetric key</em> algorithm has one key only. The key is - used for both encryption and decryption. These algorithms are fast - compared to public key algorithms (using two keys, a public and a - private one) and are therefore typically used for encrypting bulk + used for both encryption and decryption. These algorithms are fast, + compared to public key algorithms (using two keys, one public and one + private) and are therefore typically used for encrypting bulk data. </p> <p>The keys for the symmetric encryption are generated uniquely for each connection and are based on a secret negotiated - in the TLS handshake. </p> + in the TLS handshake.</p> - <p>The TLS handshake protocol and data transfer is run on top of - the TLS Record Protocol that uses a keyed-hash MAC (Message - Authenticity Code), or HMAC, to protect the message's data - integrity. From the TLS RFC "A Message Authentication Code is a + <p>The TLS handshake protocol and data transfer is run on top of + the TLS Record Protocol, which uses a keyed-hash Message + Authenticity Code (MAC), or a Hash-based MAC (HMAC), + to protect the message data + integrity. From the TLS RFC: "A Message Authentication Code is a one-way hash computed from a message and some secret data. It is difficult to forge without knowing the secret data. Its purpose is to detect if the message has been altered." @@ -82,40 +92,43 @@ passport. The holder of the certificate is called the <em>subject</em>. The certificate is signed with the private key of the issuer of the certificate. A chain - of trust is build by having the issuer in its turn being - certified by another certificate and so on until you reach the - so called root certificate that is self signed i.e. issued + of trust is built by having the issuer in its turn being + certified by another certificate, and so on, until you reach the + so called root certificate, which is self-signed, that is, issued by itself.</p> - <p>Certificates are issued by <em>certification - authorities</em> (<em>CA</em>s) only. There are a handful of - top CAs in the world that issue root certificates. You can - examine the certificates of several of them by clicking + <p>Certificates are issued by Certification Authorities (CAs) only. + A handful of top CAs in the world issue root certificates. You can + examine several of these certificates by clicking through the menus of your web browser. </p> </section> <section> - <title>Authentication of Sender</title> + <title>Peer Authentication</title> - <p>Authentication of the sender is done by public key path - validation as defined in RFC 3280. Simplified that means that - each certificate in the certificate chain is issued by the one - before, the certificates attributes are valid ones, and the - root cert is a trusted cert that is present in the trusted - certs database kept by the peer.</p> + <p>Authentication of the peer is done by public key path + validation as defined in RFC 3280. This means basically + the following:</p> + <list type="bulleted"> + <item>Each certificate in the certificate chain is issued by the + previous one.</item> + <item>The certificates attributes are valid.</item> + <item>The root certificate is a trusted certificate that is present + in the trusted certificate database kept by the peer.</item> + </list> - <p>The server will always send a certificate chain as part of - the TLS handshake, but the client will only send one if - the server requests it. If the client does not have - an appropriate certificate it may send an "empty" certificate + <p>The server always sends a certificate chain as part of + the TLS handshake, but the client only sends one if requested + by the server. If the client does not have + an appropriate certificate, it can send an "empty" certificate to the server.</p> - <p>The client may choose to accept some path evaluation errors - for instance a web browser may ask the user if they want to - accept an unknown CA root certificate. The server, if it request - a certificate, will on the other hand not accept any path validation - errors. It is configurable if the server should accept + <p>The client can choose to accept some path evaluation errors, + for example, a web browser can ask the user whether to + accept an unknown CA root certificate. The server, if it requests + a certificate, does however not accept any path validation + errors. It is configurable if the server is to accept or reject an "empty" certificate as response to a certificate request.</p> </section> @@ -123,25 +136,24 @@ <section> <title>TLS Sessions</title> - <p>From the TLS RFC "A TLS session is an association between a - client and a server. Sessions are created by the handshake + <p>From the TLS RFC: "A TLS session is an association between a + client and a server. Sessions are created by the handshake protocol. Sessions define a set of cryptographic security parameters, which can be shared among multiple connections. Sessions are used to avoid the expensive negotiation of new security parameters for each connection."</p> <p>Session data is by default kept by the SSL application in a - memory storage hence session data will be lost at application - restart or takeover. Users may define their own callback module + memory storage, hence session data is lost at application + restart or takeover. Users can define their own callback module to handle session data storage if persistent data storage is - required. Session data will also be invalidated after 24 hours - from it was saved, for security reasons. It is of course - possible to configure the amount of time the session data should be - saved.</p> + required. Session data is also invalidated after 24 hours + from it was saved, for security reasons. The amount of time the + session data is to be saved can be configured.</p> - <p>SSL clients will by default try to reuse an available session, - SSL servers will by default agree to reuse sessions when clients - ask to do so.</p> + <p>By default the SSL clients try to reuse an available session and + by default the SSL servers agree to reuse sessions when clients + ask for it.</p> </section> </chapter> diff --git a/lib/ssl/doc/src/ssl_session_cache_api.xml b/lib/ssl/doc/src/ssl_session_cache_api.xml index 9f87d31e90..c89d3874a1 100644 --- a/lib/ssl/doc/src/ssl_session_cache_api.xml +++ b/lib/ssl/doc/src/ssl_session_cache_api.xml @@ -21,42 +21,54 @@ </legalnotice> <title>ssl</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> <file>ssl_session_cache_api.xml</file> </header> <module>ssl_session_cache_api</module> - <modulesummary>Defines the API for the TLS session cache so - that the data storage scheme can be replaced by - defining a new callback module implementing this API.</modulesummary> + <modulesummary>TLS session cache API</modulesummary> + <description>Defines the API for the TLS session cache so + that the data storage scheme can be replaced by + defining a new callback module implementing this API.</description> <section> - <title>Common Data Types</title> + <title>DATA TYPES</title> - <p>The following data types are used in the functions below: - </p> + <p>The following data types are used in the functions for + <c>ssl_session_cache_api</c>:</p> - <p><c>cache_ref() = opaque()</c></p> - - <p><c>key() = {partialkey(), session_id()}</c></p> - - <p><c>partialkey() = opaque()</c></p> - - <p><c>session_id() = binary()</c></p> + <taglist> + <tag><c>cache_ref()</c></tag> + <item><p>= <c>opaque()</c></p></item> + + <tag><c>key()</c></tag> + <item><p>= <c>{partialkey(), session_id()}</c></p></item> + + <tag><c>partialkey()</c></tag> + <item><p>= <c>opaque()</c></p></item> + + <tag><c>session_id()</c></tag> + <item><p>= <c>binary()</c></p></item> + + <tag><c>session()</c></tag> + <item><p>= <c>opaque()</c></p></item> + </taglist> - <p><c>session() = opaque()</c></p> - </section> <funcs> <func> <name>delete(Cache, Key) -> _</name> - <fsummary></fsummary> + <fsummary>Deletes a cache entry.</fsummary> <type> - <v> Cache = cache_ref()</v> - <v> Key = key()</v> + <v>Cache = cache_ref()</v> + <v>Key = key()</v> </type> <desc> - <p> Deletes a cache entry. Will only be called from the cache + <p>Deletes a cache entry. Is only called from the cache handling process. </p> </desc> @@ -69,49 +81,50 @@ <v></v> </type> <desc> - <p>Calls Fun(Elem, AccIn) on successive elements of the - cache, starting with AccIn == Acc0. Fun/2 must return a new - accumulator which is passed to the next call. The function returns - the final value of the accumulator. Acc0 is returned if the cache is - empty. + <p>Calls <c>Fun(Elem, AccIn)</c> on successive elements of the + cache, starting with <c>AccIn == Acc0</c>. <c>Fun/2</c> must + return a new accumulator, which is passed to the next call. + The function returns the final value of the accumulator. + <c>Acc0</c> is returned if the cache is empty. </p> </desc> </func> <func> <name>init(Args) -> opaque() </name> - <fsummary>Return cache reference</fsummary> + <fsummary>Returns cache reference.</fsummary> <type> <v>Args = proplists:proplist()</v> - <d>Will always include the property {role, client | server}. Currently this - is the only predefined property, there may also be user defined properties. - <seealso marker="ssl_app"> See also application environment variable - session_cb_init_args</seealso> - </d> </type> <desc> + <p>Includes property <c>{role, client | server}</c>. + Currently this is the only predefined property, + there can also be user-defined properties. See also + application environment variable + <seealso marker="ssl_app">session_cb_init_args</seealso>. + </p> <p>Performs possible initializations of the cache and returns - a reference to it that will be used as parameter to the other - API functions. Will be called by the cache handling processes - init function, hence putting the same requirements on it as a - normal process init function. Note that this function will be - called twice when starting the ssl application, once with the - role client and once with the role server, as the ssl application - must be prepared to take on both roles. + a reference to it that is used as parameter to the other + API functions. Is called by the cache handling processes + <c>init</c> function, hence putting the same requirements on it + as a normal process <c>init</c> function. This function is + called twice when starting the SSL application, once with + the role client and once with the role server, as the SSL + application must be prepared to take on both roles. </p> </desc> </func> <func> <name>lookup(Cache, Key) -> Entry</name> - <fsummary> Looks up a cache entry.</fsummary> + <fsummary>Looks up a cache entry.</fsummary> <type> - <v> Cache = cache_ref()</v> - <v> Key = key()</v> - <v> Entry = session() | undefined </v> + <v>Cache = cache_ref()</v> + <v>Key = key()</v> + <v>Entry = session() | undefined</v> </type> <desc> - <p>Looks up a cache entry. Should be callable from any + <p>Looks up a cache entry. Is to be callable from any process. </p> </desc> @@ -119,14 +132,14 @@ <func> <name>select_session(Cache, PartialKey) -> [session()]</name> - <fsummary>Selects a sessions that could be reused.</fsummary> + <fsummary>Selects sessions that can be reused.</fsummary> <type> - <v> Cache = cache_ref()</v> - <v> PartialKey = partialkey()</v> - <v> Session = session()</v> + <v>Cache = cache_ref()</v> + <v>PartialKey = partialkey()</v> + <v>Session = session()</v> </type> <desc> - <p>Selects a sessions that could be reused. Should be callable + <p>Selects sessions that can be reused. Is to be callable from any process. </p> </desc> @@ -137,7 +150,7 @@ <fsummary>Called by the process that handles the cache when it is about to terminate.</fsummary> <type> - <v>Cache = term() - as returned by init/0</v> + <v>Cache = term() - as returned by init/0</v> </type> <desc> <p>Takes care of possible cleanup that is needed when the @@ -148,15 +161,15 @@ <func> <name>update(Cache, Key, Session) -> _</name> - <fsummary> Caches a new session or updates a already cached one.</fsummary> + <fsummary>Caches a new session or updates an already cached one.</fsummary> <type> - <v> Cache = cache_ref()</v> - <v> Key = key()</v> - <v> Session = session()</v> + <v>Cache = cache_ref()</v> + <v>Key = key()</v> + <v>Session = session()</v> </type> <desc> - <p> Caches a new session or updates a already cached one. Will - only be called from the cache handling process. + <p>Caches a new session or updates an already cached one. Is + only called from the cache handling process. </p> </desc> </func> diff --git a/lib/ssl/doc/src/usersguide.xml b/lib/ssl/doc/src/usersguide.xml index b1c7190085..6fce022507 100644 --- a/lib/ssl/doc/src/usersguide.xml +++ b/lib/ssl/doc/src/usersguide.xml @@ -23,14 +23,17 @@ <title>SSL User's Guide</title> <prepared>OTP Team</prepared> + <docno></docno> <date>2003-05-26</date> + <rev></rev> <file>usersguide.sgml</file> </header> <description> - <p>The <em>SSL</em> application provides secure communication over + <p>The Secure Socket Layer (SSL) application provides secure communication over sockets. </p> </description> + <xi:include href="ssl_introduction.xml"/> <xi:include href="ssl_protocol.xml"/> <xi:include href="using_ssl.xml"/> <xi:include href="ssl_distribution.xml"/> diff --git a/lib/ssl/doc/src/using_ssl.xml b/lib/ssl/doc/src/using_ssl.xml index cce388d02a..dbbc1aa9d3 100644 --- a/lib/ssl/doc/src/using_ssl.xml +++ b/lib/ssl/doc/src/using_ssl.xml @@ -21,126 +21,131 @@ </legalnotice> - <title>Using the SSL API</title> + <title>Using SSL API</title> + <prepared></prepared> + <responsible></responsible> + <docno></docno> + <approved></approved> + <checked></checked> + <date></date> + <rev></rev> <file>using_ssl.xml</file> </header> - - <section> - <title>General information</title> - <p>To see relevant version information for ssl you can - call ssl:versions/0</p> + <p>To see relevant version information for ssl, call + <seealso marker="ssl:ssl#versions-0"><c>ssl:versions/0</c></seealso> + .</p> - <p>To see all supported cipher suites - call ssl:cipher_suites/0. Note that available cipher suites - for a connection will depend on your certificate. It is also - possible to specify a specific cipher suite(s) that you - want your connection to use. Default is to use the strongest - available.</p> - - </section> + <p>To see all supported cipher suites, call <seealso marker="ssl:ssl#cipher_suites-1"><c>ssl:cipher_suites(all)</c> </seealso>. + The available cipher suites for a connection depend on your certificate. + Specific cipher suites that you want your connection to use can also be + specified. Default is to use the strongest available.</p> <section> - <title>Setting up connections</title> + <title>Setting up Connections</title> - <p>Here follows some small example of how to set up client/server connections - using the erlang shell. The returned value of the sslsocket has been abbreviated with - <c>[...]</c> as it can be fairly large and is opaque.</p> + <p>This section shows a small example of how to set up client/server connections + using the Erlang shell. The returned value of the <c>sslsocket</c> is abbreviated + with <c>[...]</c> as it can be fairly large and is opaque.</p> <section> - <title>Minmal example</title> + <title>Minimal Example</title> - <note><p> The minimal setup is not the most secure setup of ssl.</p> + <note><p> The minimal setup is not the most secure setup of SSL.</p> </note> - - <p> Start server side</p> + + <p>To set up client/server connections:</p> + + <p><em>Step 1:</em> Start the server side:</p> <code type="erl">1 server> ssl:start(). ok</code> - <p>Create an ssl listen socket</p> + <p><em>Step 2:</em> Create an SSL listen socket:</p> <code type="erl">2 server> {ok, ListenSocket} = ssl:listen(9999, [{certfile, "cert.pem"}, {keyfile, "key.pem"},{reuseaddr, true}]). {ok,{sslsocket, [...]}}</code> - <p>Do a transport accept on the ssl listen socket</p> + <p><em>Step 3:</em> Do a transport accept on the SSL listen socket:</p> <code type="erl">3 server> {ok, Socket} = ssl:transport_accept(ListenSocket). {ok,{sslsocket, [...]}}</code> - <p>Start client side</p> + <p><em>Step 4:</em> Start the client side:</p> <code type="erl">1 client> ssl:start(). ok</code> <code type="erl">2 client> {ok, Socket} = ssl:connect("localhost", 9999, [], infinity). {ok,{sslsocket, [...]}}</code> - <p>Do the ssl handshake</p> + <p><em>Step 5:</em> Do the SSL handshake:</p> <code type="erl">4 server> ok = ssl:ssl_accept(Socket). ok</code> - <p>Send a messag over ssl</p> + <p><em>Step 6:</em> Send a message over SSL:</p> <code type="erl">5 server> ssl:send(Socket, "foo"). ok</code> - <p>Flush the shell message queue to see that we got the message - sent on the server side</p> + <p><em>Step 7:</em> Flush the shell message queue to see that the message + was sent on the server side:</p> <code type="erl">3 client> flush(). Shell got {ssl,{sslsocket,[...]},"foo"} ok</code> </section> <section> - <title>Upgrade example</title> + <title>Upgrade Example</title> - <note><p> To upgrade a TCP/IP connection to an ssl connection the - client and server have to aggre to do so. Agreement - may be accompliced by using a protocol such the one used by HTTP - specified in RFC 2817.</p> </note> + <note><p>To upgrade a TCP/IP connection to an SSL connection, the + client and server must agree to do so. The agreement + can be accomplished by using a protocol, for example, the one used by HTTP + specified in RFC 2817.</p></note> + + <p>To upgrade to an SSL connection:</p> - <p>Start server side</p> + <p><em>Step 1:</em> Start the server side:</p> <code type="erl">1 server> ssl:start(). ok</code> - <p>Create a normal tcp listen socket</p> + <p><em>Step 2:</em> Create a normal TCP listen socket:</p> <code type="erl">2 server> {ok, ListenSocket} = gen_tcp:listen(9999, [{reuseaddr, true}]). {ok, #Port<0.475>}</code> - <p>Accept client connection</p> + <p><em>Step 3:</em> Accept client connection:</p> <code type="erl">3 server> {ok, Socket} = gen_tcp:accept(ListenSocket). {ok, #Port<0.476>}</code> - <p>Start client side</p> + <p><em>Step 4:</em> Start the client side:</p> <code type="erl">1 client> ssl:start(). ok</code> <code type="erl">2 client> {ok, Socket} = gen_tcp:connect("localhost", 9999, [], infinity).</code> - <p>Make sure active is set to false before trying - to upgrade a connection to an ssl connection, otherwhise - ssl handshake messages may be deliverd to the wrong process.</p> + <p><em>Step 5:</em> Ensure <c>active</c> is set to <c>false</c> before trying + to upgrade a connection to an SSL connection, otherwise + SSL handshake messages can be delivered to the wrong process:</p> <code type="erl">4 server> inet:setopts(Socket, [{active, false}]). ok</code> - <p>Do the ssl handshake.</p> + <p><em>Step 6:</em> Do the SSL handshake:</p> <code type="erl">5 server> {ok, SSLSocket} = ssl:ssl_accept(Socket, [{cacertfile, "cacerts.pem"}, {certfile, "cert.pem"}, {keyfile, "key.pem"}]). {ok,{sslsocket,[...]}}</code> - <p> Upgrade to an ssl connection. Note that the client and server - must agree upon the upgrade and the server must call - ssl:accept/2 before the client calls ssl:connect/3.</p> + <p><em>Step 7:</em> Upgrade to an SSL connection. The client and server + must agree upon the upgrade. The server must call + <c>ssl:accept/2</c> before the client calls <c>ssl:connect/3.</c></p> <code type="erl">3 client>{ok, SSLSocket} = ssl:connect(Socket, [{cacertfile, "cacerts.pem"}, {certfile, "cert.pem"}, {keyfile, "key.pem"}], infinity). {ok,{sslsocket,[...]}}</code> - <p>Send a messag over ssl</p> + <p><em>Step 8:</em> Send a message over SSL:</p> <code type="erl">4 client> ssl:send(SSLSocket, "foo"). ok</code> - <p>Set active true on the ssl socket</p> + <p><em>Step 9:</em> Set <c>active true</c> on the SSL socket:</p> <code type="erl">4 server> ssl:setopts(SSLSocket, [{active, true}]). ok</code> - <p>Flush the shell message queue to see that we got the message - sent on the client side</p> + <p><em>Step 10:</em> Flush the shell message queue to see that the message + was sent on the client side:</p> <code type="erl">5 server> flush(). Shell got {ssl,{sslsocket,[...]},"foo"} ok</code> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 508983ddac..610e2c4e41 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -146,7 +146,7 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) -> Handshake = ssl_handshake:init_handshake_history(), TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}), try ssl_config:init(SSLOpts0, Role) of - {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, OwnCert, Key, DHParams} -> + {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, CRLDbInfo, OwnCert, Key, DHParams} -> Session = State0#state.session, State = State0#state{ tls_handshake_history = Handshake, @@ -155,6 +155,7 @@ init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) -> file_ref_db = FileRefHandle, cert_db_ref = Ref, cert_db = CertDbHandle, + crl_db = CRLDbInfo, session_cache = CacheHandle, private_key = Key, diffie_hellman_params = DHParams}, @@ -227,9 +228,9 @@ hello(Hello, case dtls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of #alert{} = Alert -> handle_own_alert(Alert, ReqVersion, hello, State); - {Version, NewId, ConnectionStates, NextProtocol} -> + {Version, NewId, ConnectionStates, ProtoExt, Protocol} -> ssl_connection:handle_session(Hello, - Version, NewId, ConnectionStates, NextProtocol, State) + Version, NewId, ConnectionStates, ProtoExt, Protocol, State) end; hello(Msg, State) -> diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 31d525b295..30381df050 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -181,8 +181,8 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, SslOpt, ConnectionStates0, Renegotiation) of #alert{} = Alert -> Alert; - {ConnectionStates, Protocol} -> - {Version, SessionId, ConnectionStates, Protocol} + {ConnectionStates, ProtoExt, Protocol} -> + {Version, SessionId, ConnectionStates, ProtoExt, Protocol} end. dtls_fragment(Mss, MsgType, Len, MsgSeq, Bin, Offset, Acc) diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 955875fa95..be8ef6f85f 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -53,7 +53,7 @@ {applications, [crypto, public_key, kernel, stdlib]}, {env, []}, {mod, {ssl_app, []}}, - {runtime_dependencies, ["stdlib-2.0","public_key-0.22","kernel-3.0", - "erts-6.0","crypto-3.3"]}]}. + {runtime_dependencies, ["stdlib-2.0","public_key-1.0","kernel-3.0", + "erts-6.0","crypto-3.3", "inets-5.10.7"]}]}. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 623fa92121..6461f64c1c 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -38,10 +38,12 @@ %% SSL/TLS protocol handling -export([cipher_suites/0, cipher_suites/1, suite_definition/1, connection_info/1, versions/0, session_info/1, format_error/1, - renegotiate/1, prf/5, negotiated_next_protocol/1]). + renegotiate/1, prf/5, negotiated_protocol/1, negotiated_next_protocol/1]). %% Misc -export([random_bytes/1]). +-deprecated({negotiated_next_protocol, 1, next_major_release}). + -include("ssl_api.hrl"). -include("ssl_internal.hrl"). -include("ssl_record.hrl"). @@ -330,13 +332,27 @@ suite_definition(S) -> {KeyExchange, Cipher, Hash}. %%-------------------------------------------------------------------- +-spec negotiated_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}. +%% +%% Description: Returns the protocol that has been negotiated. If no +%% protocol has been negotiated will return {error, protocol_not_negotiated} +%%-------------------------------------------------------------------- +negotiated_protocol(#sslsocket{pid = Pid}) -> + ssl_connection:negotiated_protocol(Pid). + +%%-------------------------------------------------------------------- -spec negotiated_next_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}. %% %% Description: Returns the next protocol that has been negotiated. If no %% protocol has been negotiated will return {error, next_protocol_not_negotiated} %%-------------------------------------------------------------------- -negotiated_next_protocol(#sslsocket{pid = Pid}) -> - ssl_connection:negotiated_next_protocol(Pid). +negotiated_next_protocol(Socket) -> + case negotiated_protocol(Socket) of + {error, protocol_not_negotiated} -> + {error, next_protocol_not_negotiated}; + Res -> + Res + end. %%-------------------------------------------------------------------- -spec cipher_suites(erlang | openssl | all) -> [ssl_cipher:erl_cipher_suite()] | @@ -644,6 +660,10 @@ handle_options(Opts0) -> renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), hibernate_after = handle_option(hibernate_after, Opts, undefined), erl_dist = handle_option(erl_dist, Opts, false), + alpn_advertised_protocols = + handle_option(alpn_advertised_protocols, Opts, undefined), + alpn_preferred_protocols = + handle_option(alpn_preferred_protocols, Opts, undefined), next_protocols_advertised = handle_option(next_protocols_advertised, Opts, undefined), next_protocol_selector = @@ -667,7 +687,8 @@ handle_options(Opts0) -> user_lookup_fun, psk_identity, srp_identity, ciphers, reuse_session, reuse_sessions, ssl_imp, cb_info, renegotiate_at, secure_renegotiate, hibernate_after, - erl_dist, next_protocols_advertised, + erl_dist, alpn_advertised_protocols, + alpn_preferred_protocols, next_protocols_advertised, client_preferred_next_protocols, log_alert, server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache, fallback], @@ -803,6 +824,20 @@ 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) + when Opt =:= alpn_advertised_protocols orelse Opt =:= alpn_preferred_protocols, + is_list(Value) -> + case tls_record:highest_protocol_version([]) of + {3,0} -> + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); + _ -> + validate_binary_list(Opt, Value), + Value + end; +validate_option(Opt, Value) + when Opt =:= alpn_advertised_protocols orelse Opt =:= alpn_preferred_protocols, + Value =:= undefined -> + undefined; validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols} = Value) when is_list(PreferredProtocols) -> case tls_record:highest_protocol_version([]) of @@ -1131,6 +1166,10 @@ new_ssl_options([{secure_renegotiate, Value} | Rest], #ssl_options{} = Opts, Rec new_ssl_options(Rest, Opts#ssl_options{secure_renegotiate = validate_option(secure_renegotiate, Value)}, RecordCB); new_ssl_options([{hibernate_after, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{hibernate_after = validate_option(hibernate_after, Value)}, RecordCB); +new_ssl_options([{alpn_advertised_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{alpn_advertised_protocols = validate_option(alpn_advertised_protocols, Value)}, RecordCB); +new_ssl_options([{alpn_preferred_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{alpn_preferred_protocols = validate_option(alpn_preferred_protocols, Value)}, RecordCB); new_ssl_options([{next_protocols_advertised, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{next_protocols_advertised = validate_option(next_protocols_advertised, Value)}, RecordCB); new_ssl_options([{client_preferred_next_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index 9e372f739a..c46facb75d 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -163,5 +163,7 @@ description_txt(?UNKNOWN_PSK_IDENTITY) -> "unknown psk identity"; description_txt(?INAPPROPRIATE_FALLBACK) -> "inappropriate fallback"; +description_txt(?NO_APPLICATION_PROTOCOL) -> + "no application protocol"; description_txt(Enum) -> lists:flatten(io_lib:format("unsupported/unknown alert: ~p", [Enum])). diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl index a3619e4a35..70b7523975 100644 --- a/lib/ssl/src/ssl_alert.hrl +++ b/lib/ssl/src/ssl_alert.hrl @@ -69,6 +69,8 @@ %% bad_certificate_hash_value(114), %% RFC 4366 %% unknown_psk_identity(115), +%% RFC 7301 +%% no_application_protocol(120), %% (255) %% } AlertDescription; @@ -103,6 +105,7 @@ -define(BAD_CERTIFICATE_STATUS_RESPONSE, 113). -define(BAD_CERTIFICATE_HASH_VALUE, 114). -define(UNKNOWN_PSK_IDENTITY, 115). +-define(NO_APPLICATION_PROTOCOL, 120). -define(ALERT_REC(Level,Desc), #alert{level=Level,description=Desc,where={?FILE, ?LINE}}). diff --git a/lib/ssl/src/ssl_api.hrl b/lib/ssl/src/ssl_api.hrl index 22185ff60a..78127eeafa 100644 --- a/lib/ssl/src/ssl_api.hrl +++ b/lib/ssl/src/ssl_api.hrl @@ -49,6 +49,8 @@ {srp_identity, {string(), string()}} | {ciphers, ciphers()} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | {reuse_session, fun()} | {hibernate_after, integer()|undefined} | + {alpn_advertised_protocols, [binary()]} | + {alpn_preferred_protocols, [binary()]} | {next_protocols_advertised, list(binary())} | {client_preferred_next_protocols, binary(), client | server, list(binary())}. diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 764bd82de0..34e4a8b447 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -84,7 +84,7 @@ trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef, PartialChainHandler) - end. %%-------------------------------------------------------------------- --spec certificate_chain(undefined | binary(), db_handle(), certdb_ref()) -> +-spec certificate_chain(undefined | binary() | #'OTPCertificate'{} , db_handle(), certdb_ref()) -> {error, no_cert} | {ok, #'OTPCertificate'{} | undefined, [der_cert()]}. %% %% Description: Return the certificate chain to send to peer. diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 08d0145aa7..4a839872a6 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -42,10 +42,10 @@ %% User Events -export([send/2, recv/3, close/1, shutdown/2, new_user/2, get_opts/2, set_opts/2, info/1, session_info/1, - peer_certificate/1, renegotiation/1, negotiated_next_protocol/1, prf/5 + peer_certificate/1, renegotiation/1, negotiated_protocol/1, prf/5 ]). --export([handle_session/6]). +-export([handle_session/7]). %% SSL FSM state functions -export([hello/3, abbreviated/3, certify/3, cipher/3, connection/3]). @@ -191,12 +191,12 @@ new_user(ConnectionPid, User) -> sync_send_all_state_event(ConnectionPid, {new_user, User}). %%-------------------------------------------------------------------- --spec negotiated_next_protocol(pid()) -> {ok, binary()} | {error, reason()}. +-spec negotiated_protocol(pid()) -> {ok, binary()} | {error, reason()}. %% %% Description: Returns the negotiated protocol %%-------------------------------------------------------------------- -negotiated_next_protocol(ConnectionPid) -> - sync_send_all_state_event(ConnectionPid, negotiated_next_protocol). +negotiated_protocol(ConnectionPid) -> + sync_send_all_state_event(ConnectionPid, negotiated_protocol). %%-------------------------------------------------------------------- -spec get_opts(pid(), list()) -> {ok, list()} | {error, reason()}. @@ -258,27 +258,26 @@ prf(ConnectionPid, Secret, Label, Seed, WantedLength) -> handle_session(#server_hello{cipher_suite = CipherSuite, compression_method = Compression}, - Version, NewId, ConnectionStates, NextProtocol, + Version, NewId, ConnectionStates, ProtoExt, Protocol0, #state{session = #session{session_id = OldId}, - negotiated_version = ReqVersion} = State0) -> + negotiated_version = ReqVersion, + negotiated_protocol = CurrentProtocol} = State0) -> {KeyAlgorithm, _, _, _} = ssl_cipher:suite_definition(CipherSuite), PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm), - - NewNextProtocol = case NextProtocol of - undefined -> - State0#state.next_protocol; - _ -> - NextProtocol - end, - + + {ExpectNPN, Protocol} = case Protocol0 of + undefined -> {false, CurrentProtocol}; + _ -> {ProtoExt =:= npn, Protocol0} + end, + State = State0#state{key_algorithm = KeyAlgorithm, negotiated_version = Version, connection_states = ConnectionStates, premaster_secret = PremasterSecret, - expecting_next_protocol_negotiation = NextProtocol =/= undefined, - next_protocol = NewNextProtocol}, + expecting_next_protocol_negotiation = ExpectNPN, + negotiated_protocol = Protocol}, case ssl_session:is_new(OldId, NewId) of true -> @@ -371,7 +370,7 @@ abbreviated(#finished{verify_data = Data} = Finished, abbreviated(#next_protocol{selected_protocol = SelectedProtocol}, #state{role = server, expecting_next_protocol_negotiation = true} = State0, Connection) -> - {Record, State} = Connection:next_record(State0#state{next_protocol = SelectedProtocol}), + {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, _) -> @@ -593,7 +592,7 @@ cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashS %% client must send a next protocol message if we are expecting it cipher(#finished{}, #state{role = server, expecting_next_protocol_negotiation = true, - next_protocol = undefined, negotiated_version = Version} = State0, + negotiated_protocol = undefined, negotiated_version = Version} = State0, Connection) -> Connection:handle_own_alert(?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), Version, cipher, State0); @@ -623,7 +622,7 @@ cipher(#finished{verify_data = Data} = Finished, cipher(#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{next_protocol = SelectedProtocol}), + {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, _) -> @@ -759,10 +758,10 @@ handle_sync_event({get_opts, OptTags}, _From, StateName, socket_options = SockOpts} = State) -> OptsReply = get_socket_opts(Transport, Socket, OptTags, SockOpts, []), {reply, OptsReply, StateName, State, get_timeout(State)}; -handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = undefined} = State) -> - {reply, {error, next_protocol_not_negotiated}, StateName, State, get_timeout(State)}; -handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = NextProtocol} = State) -> - {reply, {ok, NextProtocol}, 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, protocol_cb = Connection, @@ -1484,11 +1483,11 @@ finalize_handshake(State0, StateName, Connection) -> next_protocol(#state{role = server} = State, _) -> State; -next_protocol(#state{next_protocol = undefined} = State, _) -> +next_protocol(#state{negotiated_protocol = undefined} = State, _) -> State; next_protocol(#state{expecting_next_protocol_negotiation = false} = State, _) -> State; -next_protocol(#state{next_protocol = NextProtocol} = State0, Connection) -> +next_protocol(#state{negotiated_protocol = NextProtocol} = State0, Connection) -> NextProtocolMessage = ssl_handshake:next_protocol(NextProtocol), Connection:send_handshake(NextProtocolMessage, State0). diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index ac3b26e4bf..e569d706af 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -78,7 +78,7 @@ allow_renegotiate = true ::boolean(), expecting_next_protocol_negotiation = false ::boolean(), expecting_finished = false ::boolean(), - next_protocol = undefined :: undefined | binary(), + negotiated_protocol = undefined :: undefined | binary(), client_ecc, % {Curves, PointFmt} tracker :: pid() %% Tracker process for listen socket }). diff --git a/lib/ssl/src/ssl_crl.erl b/lib/ssl/src/ssl_crl.erl index b8761f0601..1a08d3c80a 100644 --- a/lib/ssl/src/ssl_crl.erl +++ b/lib/ssl/src/ssl_crl.erl @@ -73,8 +73,6 @@ verify_crl_issuer(CRL, ErlCertCandidate, Issuer, NotIssuer) -> true -> throw({ok, ErlCertCandidate}); false -> - NotIssuer; - _ -> NotIssuer end; _ -> diff --git a/lib/ssl/src/ssl_crl_cache.erl b/lib/ssl/src/ssl_crl_cache.erl index b2bdb19979..b9d6a61c3b 100644 --- a/lib/ssl/src/ssl_crl_cache.erl +++ b/lib/ssl/src/ssl_crl_cache.erl @@ -34,7 +34,7 @@ %% Cache callback API %%==================================================================== -lookup(#'DistributionPoint'{distributionPoint={fullName, Names}}, +lookup(#'DistributionPoint'{distributionPoint = {fullName, Names}}, CRLDbInfo) -> get_crls(Names, CRLDbInfo); lookup(_,_) -> @@ -48,8 +48,8 @@ select(Issuer, {{_Cache, Mapping},_}) -> CRLs end. -fresh_crl(DistributionPoint, CRL) -> - case get_crls(DistributionPoint, undefined) of +fresh_crl(#'DistributionPoint'{distributionPoint = {fullName, Names}}, CRL) -> + case get_crls(Names, undefined) of not_available -> CRL; [NewCRL] -> diff --git a/lib/ssl/src/ssl_crl_cache_api.erl b/lib/ssl/src/ssl_crl_cache_api.erl index 0915ba12e5..79db65104b 100644 --- a/lib/ssl/src/ssl_crl_cache_api.erl +++ b/lib/ssl/src/ssl_crl_cache_api.erl @@ -25,6 +25,6 @@ -type db_handle() :: term(). --callback lookup(#'DistributionPoint'{}, db_handle()) -> not_available | [public_key:der_encode()]. --callback select(term(), db_handle()) -> [public_key:der_encode()]. --callback fresh_crl(#'DistributionPoint'{}, public_key:der_encode()) -> public_key:der_encode(). +-callback lookup(#'DistributionPoint'{}, db_handle()) -> not_available | [public_key:der_encoded()]. +-callback select(term(), db_handle()) -> [public_key:der_encoded()]. +-callback fresh_crl(#'DistributionPoint'{}, public_key:der_encoded()) -> public_key:der_encoded(). diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 6cab8eb7a1..b538fefe53 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -136,6 +136,7 @@ client_hello_extensions(Host, Version, CipherSuites, SslOpts, ConnectionStates, hash_signs = advertised_hash_signs(Version), ec_point_formats = EcPointFormats, elliptic_curves = EllipticCurves, + alpn = encode_alpn(SslOpts#ssl_options.alpn_advertised_protocols, Renegotiation), next_protocol_negotiation = encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector, Renegotiation), @@ -242,7 +243,7 @@ key_exchange(client, _Version, {dh, PublicKey}) -> dh_public = PublicKey} }; -key_exchange(client, _Version, {ecdh, #'ECPrivateKey'{publicKey = {0, ECPublicKey}}}) -> +key_exchange(client, _Version, {ecdh, #'ECPrivateKey'{publicKey = ECPublicKey}}) -> #client_key_exchange{ exchange_keys = #client_ec_diffie_hellman_public{ dh_public = ECPublicKey} @@ -283,7 +284,7 @@ key_exchange(server, Version, {dh, {PublicKey, _}, enc_server_key_exchange(Version, ServerDHParams, HashSign, ClientRandom, ServerRandom, PrivateKey); -key_exchange(server, Version, {ecdh, #'ECPrivateKey'{publicKey = {0, ECPublicKey}, +key_exchange(server, Version, {ecdh, #'ECPrivateKey'{publicKey = ECPublicKey, parameters = ECCurve}, HashSign, ClientRandom, ServerRandom, PrivateKey}) -> ServerECParams = #server_ecdh_params{curve = ECCurve, public = ECPublicKey}, @@ -577,11 +578,10 @@ prf({3,_N}, Secret, Label, Seed, WantedLength) -> %%-------------------------------------------------------------------- select_hashsign(_, undefined, _Version) -> {null, anon}; -select_hashsign(undefined, Cert, Version) -> - #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp), - #'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, - select_hashsign_algs(undefined, Algo, Version); -select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, Version) -> +%% The signature_algorithms extension was introduced with TLS 1.2. Ignore it if we have +%% negotiated a lower version. +select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, {Major, Minor} = Version) + when Major >= 3 andalso Minor >= 3 -> #'OTPCertificate'{tbsCertificate = TBSCert} =public_key:pkix_decode_cert(Cert, otp), #'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, DefaultHashSign = {_, Sign} = select_hashsign_algs(undefined, Algo, Version), @@ -599,7 +599,11 @@ select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, Version) -> DefaultHashSign; [HashSign| _] -> HashSign - end. + end; +select_hashsign(_, Cert, Version) -> + #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp), + #'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, + select_hashsign_algs(undefined, Algo, Version). %%-------------------------------------------------------------------- -spec select_hashsign_algs(#hash_sign_algos{}| undefined, oid(), ssl_record:ssl_version()) -> @@ -764,6 +768,11 @@ encode_hello_extensions([], Acc) -> Size = byte_size(Acc), <<?UINT16(Size), Acc/binary>>; +encode_hello_extensions([#alpn{extension_data = ExtensionData} | Rest], Acc) -> + Len = byte_size(ExtensionData), + ExtLen = Len + 2, + encode_hello_extensions(Rest, <<?UINT16(?ALPN_EXT), ?UINT16(ExtLen), ?UINT16(Len), + ExtensionData/binary, Acc/binary>>); encode_hello_extensions([#next_protocol_negotiation{extension_data = ExtensionData} | Rest], Acc) -> Len = byte_size(ExtensionData), encode_hello_extensions(Rest, <<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), @@ -862,6 +871,25 @@ decode_client_key(ClientKey, Type, Version) -> decode_server_key(ServerKey, Type, Version) -> dec_server_key(ServerKey, key_exchange_alg(Type), Version). +%% +%% Description: Encode and decode functions for ALPN extension data. +%%-------------------------------------------------------------------- + +%% While the RFC opens the door to allow ALPN during renegotiation, in practice +%% this does not work and it is recommended to ignore any ALPN extension during +%% renegotiation, as done here. +encode_alpn(_, true) -> + undefined; +encode_alpn(undefined, _) -> + undefined; +encode_alpn(Protocols, _) -> + #alpn{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}. + +decode_alpn(undefined) -> + undefined; +decode_alpn(#alpn{extension_data=Data}) -> + decode_protocols(Data, []). + encode_client_protocol_negotiation(undefined, _) -> undefined; encode_client_protocol_negotiation(_, false) -> @@ -1124,8 +1152,10 @@ handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, #hello_extensions{renegotiation_info = Info, srp = SRP, ec_point_formats = ECCFormat, + alpn = ALPN, next_protocol_negotiation = NextProtocolNegotiation}, Version, - #ssl_options{secure_renegotiate = SecureRenegotation} = Opts, + #ssl_options{secure_renegotiate = SecureRenegotation, + alpn_preferred_protocols = ALPNPreferredProtocols} = Opts, #session{cipher_suite = NegotiatedCipherSuite, compression_method = Compression} = Session0, ConnectionStates0, Renegotiation) -> @@ -1134,19 +1164,34 @@ handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, Random, NegotiatedCipherSuite, ClientCipherSuites, Compression, ConnectionStates0, Renegotiation, SecureRenegotation), - ProtocolsToAdvertise = handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, Opts), - + ServerHelloExtensions = #hello_extensions{ renegotiation_info = renegotiation_info(RecordCB, server, ConnectionStates, Renegotiation), - ec_point_formats = server_ecc_extension(Version, ECCFormat), - next_protocol_negotiation = - encode_protocols_advertised_on_server(ProtocolsToAdvertise) + ec_point_formats = server_ecc_extension(Version, ECCFormat) }, - {Session, ConnectionStates, ServerHelloExtensions}. + + %% If we receive an ALPN extension and have ALPN configured for this connection, + %% we handle it. Otherwise we check for the NPN extension. + if + ALPN =/= undefined, ALPNPreferredProtocols =/= undefined -> + case handle_alpn_extension(ALPNPreferredProtocols, decode_alpn(ALPN)) of + #alert{} = Alert -> + Alert; + Protocol -> + {Session, ConnectionStates, Protocol, + ServerHelloExtensions#hello_extensions{alpn=encode_alpn([Protocol], Renegotiation)}} + end; + true -> + ProtocolsToAdvertise = handle_next_protocol_extension(NextProtocolNegotiation, Renegotiation, Opts), + {Session, ConnectionStates, undefined, + ServerHelloExtensions#hello_extensions{next_protocol_negotiation= + encode_protocols_advertised_on_server(ProtocolsToAdvertise)}} + end. handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression, #hello_extensions{renegotiation_info = Info, + alpn = ALPN, next_protocol_negotiation = NextProtocolNegotiation}, Version, #ssl_options{secure_renegotiate = SecureRenegotation, next_protocol_selector = NextProtoSelector}, @@ -1155,11 +1200,23 @@ handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression, CipherSuite, undefined, Compression, ConnectionStates0, Renegotiation, SecureRenegotation), - case handle_next_protocol(NextProtocolNegotiation, NextProtoSelector, Renegotiation) of - #alert{} = Alert -> - Alert; - Protocol -> - {ConnectionStates, Protocol} + + %% If we receive an ALPN extension then this is the protocol selected, + %% otherwise handle the NPN extension. + case decode_alpn(ALPN) of + %% ServerHello contains exactly one protocol: the one selected. + %% We also ignore the ALPN extension during renegotiation (see encode_alpn/2). + [Protocol] when not Renegotiation -> + {ConnectionStates, alpn, Protocol}; + undefined -> + case handle_next_protocol(NextProtocolNegotiation, NextProtoSelector, Renegotiation) of + #alert{} = Alert -> + Alert; + Protocol -> + {ConnectionStates, npn, Protocol} + end; + _ -> %% {error, _Reason} or a list of 0/2+ protocols. + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) end. select_version(RecordCB, ClientVersion, Versions) -> @@ -1267,10 +1324,11 @@ hello_extensions_list(#hello_extensions{renegotiation_info = RenegotiationInfo, hash_signs = HashSigns, ec_point_formats = EcPointFormats, elliptic_curves = EllipticCurves, + alpn = ALPN, next_protocol_negotiation = NextProtocolNegotiation, sni = Sni}) -> [Ext || Ext <- [RenegotiationInfo, SRP, HashSigns, - EcPointFormats, EllipticCurves, NextProtocolNegotiation, Sni], Ext =/= undefined]. + EcPointFormats, EllipticCurves, ALPN, NextProtocolNegotiation, Sni], Ext =/= undefined]. srp_user(#ssl_options{srp_identity = {UserName, _}}) -> #srp{username = UserName}; @@ -1708,6 +1766,10 @@ dec_server_key_signature(_, _, _) -> dec_hello_extensions(<<>>, Acc) -> Acc; +dec_hello_extensions(<<?UINT16(?ALPN_EXT), ?UINT16(ExtLen), ?UINT16(Len), ExtensionData:Len/binary, Rest/binary>>, Acc) + when Len + 2 =:= ExtLen -> + ALPN = #alpn{extension_data = ExtensionData}, + dec_hello_extensions(Rest, Acc#hello_extensions{alpn = ALPN}); dec_hello_extensions(<<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), ExtensionData:Len/binary, Rest/binary>>, Acc) -> NextP = #next_protocol_negotiation{extension_data = ExtensionData}, dec_hello_extensions(Rest, Acc#hello_extensions{next_protocol_negotiation = NextP}); @@ -1788,18 +1850,19 @@ dec_sni(<<?BYTE(_), ?UINT16(Len), _:Len, Rest/binary>>) -> dec_sni(Rest); dec_sni(_) -> undefined. decode_next_protocols({next_protocol_negotiation, Protocols}) -> - decode_next_protocols(Protocols, []). -decode_next_protocols(<<>>, Acc) -> + decode_protocols(Protocols, []). + +decode_protocols(<<>>, Acc) -> lists:reverse(Acc); -decode_next_protocols(<<?BYTE(Len), Protocol:Len/binary, Rest/binary>>, Acc) -> +decode_protocols(<<?BYTE(Len), Protocol:Len/binary, Rest/binary>>, Acc) -> case Len of 0 -> - {error, invalid_next_protocols}; + {error, invalid_protocols}; _ -> - decode_next_protocols(Rest, [Protocol|Acc]) + decode_protocols(Rest, [Protocol|Acc]) end; -decode_next_protocols(_Bytes, _Acc) -> - {error, invalid_next_protocols}. +decode_protocols(_Bytes, _Acc) -> + {error, invalid_protocols}. %% encode/decode stream of certificate data to/from list of certificate data certs_to_list(ASN1Certs) -> @@ -1853,6 +1916,17 @@ key_exchange_alg(_) -> %%-------------Extension handling -------------------------------- +%% Receive protocols, choose one from the list, return it. +handle_alpn_extension(_, {error, _Reason}) -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); +handle_alpn_extension([], _) -> + ?ALERT_REC(?FATAL, ?NO_APPLICATION_PROTOCOL); +handle_alpn_extension([ServerProtocol|Tail], ClientProtocols) -> + case lists:member(ServerProtocol, ClientProtocols) of + true -> ServerProtocol; + false -> handle_alpn_extension(Tail, ClientProtocols) + end. + handle_next_protocol(undefined, _NextProtocolSelector, _Renegotiating) -> undefined; @@ -1998,12 +2072,12 @@ crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _) - case dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) of [] -> valid; %% No relevant CRL existed - Dps -> - crl_check_same_issuer(OtpCert, Check, Dps, Options) + DpsAndCRls -> + crl_check_same_issuer(OtpCert, Check, DpsAndCRls, Options) end; - Dps -> %% This DP list may be empty if relevant CRLs existed + DpsAndCRLs -> %% This DP list may be empty if relevant CRLs existed %% but could not be retrived, will result in {bad_cert, revocation_status_undetermined} - case public_key:pkix_crls_validate(OtpCert, Dps, Options) of + case public_key:pkix_crls_validate(OtpCert, DpsAndCRLs, Options) of {bad_cert, revocation_status_undetermined} -> crl_check_same_issuer(OtpCert, Check, dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer), Options); diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index 80284faef0..91f674a6fc 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -95,6 +95,7 @@ -record(hello_extensions, { renegotiation_info, hash_signs, % supported combinations of hashes/signature algos + alpn, next_protocol_negotiation = undefined, % [binary()] srp, ec_point_formats, @@ -301,6 +302,14 @@ }). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Application-Layer Protocol Negotiation RFC 7301 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-define(ALPN_EXT, 16). + +-record(alpn, {extension_data}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Next Protocol Negotiation %% (http://tools.ietf.org/html/draft-agl-tls-nextprotoneg-02) %% (http://technotes.googlecode.com/git/nextprotoneg.html) diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 8df79f9e8c..90f8b8a412 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -116,16 +116,18 @@ hibernate_after :: boolean(), %% This option should only be set to true by inet_tls_dist erl_dist = false :: boolean(), - next_protocols_advertised = undefined, %% [binary()], + alpn_advertised_protocols = undefined :: [binary()] | undefined , + alpn_preferred_protocols = undefined :: [binary()] | undefined, + next_protocols_advertised = undefined :: [binary()] | undefined, next_protocol_selector = undefined, %% fun([binary()]) -> binary()) log_alert :: boolean(), server_name_indication = undefined, %% Should the server prefer its own cipher order over the one provided by %% the client? - honor_cipher_order = false, - padding_check = true, - fallback = false, - crl_check, + honor_cipher_order = false :: boolean(), + padding_check = true :: boolean(), + fallback = false :: boolean(), + crl_check :: boolean() | peer | best_effort, crl_cache }). diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 9c4b2a8bad..396013825e 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -101,8 +101,10 @@ start_link_dist(Opts) -> gen_server:start_link({local, DistMangerName}, ?MODULE, [DistMangerName, Opts], []). %%-------------------------------------------------------------------- --spec connection_init(binary()| {der, list()}, client | server, {Cb :: atom(), Handle:: term()}) -> - {ok, certdb_ref(), db_handle(), db_handle(), db_handle(), db_handle()}. +-spec connection_init(binary()| {der, list()}, client | server, + {Cb :: atom(), Handle:: term()}) -> + {ok, certdb_ref(), db_handle(), db_handle(), + db_handle(), db_handle(), CRLInfo::term()}. %% %% Description: Do necessary initializations for a new connection. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 77d3aa7889..0577222980 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -188,19 +188,27 @@ hello(Hello = #client_hello{client_version = ClientVersion, renegotiation = {Renegotiation, _}, session_cache = Cache, session_cache_cb = CacheCb, + negotiated_protocol = CurrentProtocol, ssl_options = SslOpts}) -> case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) of + #alert{} = Alert -> + handle_own_alert(Alert, ClientVersion, hello, State); {Version, {Type, Session}, - ConnectionStates, ServerHelloExt} -> + ConnectionStates, Protocol0, ServerHelloExt} -> + + Protocol = case Protocol0 of + undefined -> CurrentProtocol; + _ -> Protocol0 + end, + HashSign = ssl_handshake:select_hashsign(HashSigns, Cert, Version), ssl_connection:hello({common_client_hello, Type, ServerHelloExt, HashSign}, State#state{connection_states = ConnectionStates, negotiated_version = Version, session = Session, - client_ecc = {EllipticCurves, EcPointFormats}}, ?MODULE); - #alert{} = Alert -> - handle_own_alert(Alert, ClientVersion, hello, State) + client_ecc = {EllipticCurves, EcPointFormats}, + negotiated_protocol = Protocol}, ?MODULE) end; hello(Hello, #state{connection_states = ConnectionStates0, @@ -211,9 +219,9 @@ hello(Hello, case tls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of #alert{} = Alert -> handle_own_alert(Alert, ReqVersion, hello, State); - {Version, NewId, ConnectionStates, NextProtocol} -> + {Version, NewId, ConnectionStates, ProtoExt, Protocol} -> ssl_connection:handle_session(Hello, - Version, NewId, ConnectionStates, NextProtocol, State) + Version, NewId, ConnectionStates, ProtoExt, Protocol, State) end; hello(Msg, State) -> diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index b0b6d5a8e3..d936310991 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -78,12 +78,14 @@ client_hello(Host, Port, ConnectionStates, %%-------------------------------------------------------------------- -spec hello(#server_hello{} | #client_hello{}, #ssl_options{}, #connection_states{} | {inet:port_number(), #session{}, db_handle(), - atom(), #connection_states{}, binary() | undefined}, + atom(), #connection_states{}, + binary() | undefined}, boolean()) -> - {tls_record:tls_version(), session_id(), #connection_states{}, binary() | undefined}| - {tls_record:tls_version(), {resumed | new, #session{}}, #connection_states{}, - [binary()] | undefined, - [ssl_handshake:oid()] | undefined, [ssl_handshake:oid()] | undefined} | + {tls_record:tls_version(), session_id(), + #connection_states{}, alpn | npn, binary() | undefined}| + {tls_record:tls_version(), {resumed | new, #session{}}, + #connection_states{}, binary() | undefined, + #hello_extensions{}} | #alert{}. %% %% Description: Handles a recieved hello message @@ -246,8 +248,10 @@ handle_client_hello_extensions(Version, Type, Random, CipherSuites, try ssl_handshake:handle_client_hello_extensions(tls_record, Random, CipherSuites, HelloExt, Version, SslOpts, Session0, ConnectionStates0, Renegotiation) of - {Session, ConnectionStates, ServerHelloExt} -> - {Version, {Type, Session}, ConnectionStates, ServerHelloExt} + #alert{} = Alert -> + Alert; + {Session, ConnectionStates, Protocol, ServerHelloExt} -> + {Version, {Type, Session}, ConnectionStates, Protocol, ServerHelloExt} catch throw:Alert -> Alert end. @@ -260,7 +264,7 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, SslOpt, ConnectionStates0, Renegotiation) of #alert{} = Alert -> Alert; - {ConnectionStates, Protocol} -> - {Version, SessionId, ConnectionStates, Protocol} + {ConnectionStates, ProtoExt, Protocol} -> + {Version, SessionId, ConnectionStates, ProtoExt, Protocol} end. diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 09cc5981e7..8c45a788a4 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -36,6 +36,7 @@ VSN=$(GS_VSN) MODULES = \ ssl_test_lib \ + ssl_alpn_handshake_SUITE \ ssl_basic_SUITE \ ssl_bench_SUITE \ ssl_cipher_SUITE \ diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl index b534c0130e..12ad1e5402 100644 --- a/lib/ssl/test/erl_make_certs.erl +++ b/lib/ssl/test/erl_make_certs.erl @@ -114,7 +114,7 @@ verify_signature(DerEncodedCert, DerKey, _KeyParams) -> #'DSAPrivateKey'{p=P, q=Q, g=G, y=Y} -> public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}}); #'ECPrivateKey'{version = _Version, privateKey = _PrivKey, - parameters = Params, publicKey = {0, PubKey}} -> + parameters = Params, publicKey = PubKey} -> public_key:pkix_verify(DerEncodedCert, {#'ECPoint'{point = PubKey}, Params}) end. @@ -292,7 +292,7 @@ publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) -> publickey(#'ECPrivateKey'{version = _Version, privateKey = _PrivKey, parameters = Params, - publicKey = {0, PubKey}}) -> + publicKey = PubKey}) -> Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-ecPublicKey', parameters=Params}, #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = #'ECPoint'{point = PubKey}}. @@ -401,9 +401,9 @@ gen_ec2(CurveId) -> {PubKey, PrivKey} = crypto:generate_key(ecdh, CurveId), #'ECPrivateKey'{version = 1, - privateKey = binary_to_list(PrivKey), + privateKey = PrivKey, parameters = {namedCurve, pubkey_cert_records:namedCurves(CurveId)}, - publicKey = {0, PubKey}}. + publicKey = PubKey}. %% See fips_186-3.pdf dsa_search(T, P0, Q, Iter) when Iter > 0 -> diff --git a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl new file mode 100644 index 0000000000..ccd70fa605 --- /dev/null +++ b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl @@ -0,0 +1,414 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +-module(ssl_alpn_handshake_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). +-include_lib("common_test/include/ct.hrl"). + +-define(SLEEP, 500). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group, 'tlsv1.2'}, + {group, 'tlsv1.1'}, + {group, 'tlsv1'}, + {group, 'sslv3'}]. + +groups() -> + [ + {'tlsv1.2', [], alpn_tests()}, + {'tlsv1.1', [], alpn_tests()}, + {'tlsv1', [], alpn_tests()}, + {'sslv3', [], alpn_not_supported()} + ]. + +alpn_tests() -> + [empty_protocols_are_not_allowed, + protocols_must_be_a_binary_list, + empty_client, + empty_server, + empty_client_empty_server, + no_matching_protocol, + client_alpn_and_server_alpn, + client_alpn_and_server_no_support, + client_no_support_and_server_alpn, + client_alpn_npn_and_server_alpn, + client_alpn_npn_and_server_alpn_npn, + client_alpn_and_server_alpn_npn, + client_renegotiate, + session_reused + ]. + +alpn_not_supported() -> + [alpn_not_supported_client, + alpn_not_supported_server + ]. + +init_per_suite(Config) -> + catch crypto:stop(), + try crypto:start() of + ok -> + ssl:start(), + Result = + (catch make_certs:all(?config(data_dir, Config), + ?config(priv_dir, Config))), + ct:log("Make certs ~p~n", [Result]), + ssl_test_lib:cert_options(Config) + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(_Config) -> + ssl:stop(), + application:unload(ssl), + application:stop(crypto). + + +init_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + case ssl_test_lib:sufficient_crypto_support(GroupName) of + true -> + ssl_test_lib:init_tls_version(GroupName), + Config; + false -> + {skip, "Missing crypto support"} + end; + _ -> + ssl:start(), + Config + end. + +end_per_group(_GroupName, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- + +empty_protocols_are_not_allowed(Config) when is_list(Config) -> + {error, {options, {alpn_preferred_protocols, {invalid_protocol, <<>>}}}} + = (catch ssl:listen(9443, + [{alpn_preferred_protocols, [<<"foo/1">>, <<"">>]}])), + {error, {options, {alpn_advertised_protocols, {invalid_protocol, <<>>}}}} + = (catch ssl:connect({127,0,0,1}, 9443, + [{alpn_advertised_protocols, [<<"foo/1">>, <<"">>]}])). + +%-------------------------------------------------------------------------------- + +protocols_must_be_a_binary_list(Config) when is_list(Config) -> + Option1 = {alpn_preferred_protocols, hello}, + {error, {options, Option1}} = (catch ssl:listen(9443, [Option1])), + Option2 = {alpn_preferred_protocols, [<<"foo/1">>, hello]}, + {error, {options, {alpn_preferred_protocols, {invalid_protocol, hello}}}} + = (catch ssl:listen(9443, [Option2])), + Option3 = {alpn_advertised_protocols, hello}, + {error, {options, Option3}} = (catch ssl:connect({127,0,0,1}, 9443, [Option3])), + Option4 = {alpn_advertised_protocols, [<<"foo/1">>, hello]}, + {error, {options, {alpn_advertised_protocols, {invalid_protocol, hello}}}} + = (catch ssl:connect({127,0,0,1}, 9443, [Option4])). + +%-------------------------------------------------------------------------------- + +empty_client(Config) when is_list(Config) -> + run_failing_handshake(Config, + [{alpn_advertised_protocols, []}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}], + {connect_failed,{tls_alert,"no application protocol"}}). + +%-------------------------------------------------------------------------------- + +empty_server(Config) when is_list(Config) -> + run_failing_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], + [{alpn_preferred_protocols, []}], + {connect_failed,{tls_alert,"no application protocol"}}). + +%-------------------------------------------------------------------------------- + +empty_client_empty_server(Config) when is_list(Config) -> + run_failing_handshake(Config, + [{alpn_advertised_protocols, []}], + [{alpn_preferred_protocols, []}], + {connect_failed,{tls_alert,"no application protocol"}}). + +%-------------------------------------------------------------------------------- + +no_matching_protocol(Config) when is_list(Config) -> + run_failing_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}], + {connect_failed,{tls_alert,"no application protocol"}}). + +%-------------------------------------------------------------------------------- + +client_alpn_and_server_alpn(Config) when is_list(Config) -> + run_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}], + {ok, <<"http/1.1">>}). + +%-------------------------------------------------------------------------------- + +client_alpn_and_server_no_support(Config) when is_list(Config) -> + run_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], + [], + {error, protocol_not_negotiated}). + +%-------------------------------------------------------------------------------- + +client_no_support_and_server_alpn(Config) when is_list(Config) -> + run_handshake(Config, + [], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}], + {error, protocol_not_negotiated}). + +%-------------------------------------------------------------------------------- + +client_alpn_npn_and_server_alpn(Config) when is_list(Config) -> + run_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}, + {client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"spdy/3">>}}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}], + {ok, <<"http/1.1">>}). + +%-------------------------------------------------------------------------------- + +client_alpn_npn_and_server_alpn_npn(Config) when is_list(Config) -> + run_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}, + {client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"spdy/3">>}}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, + {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.0">>]}], + {ok, <<"http/1.1">>}). + +%-------------------------------------------------------------------------------- + +client_alpn_and_server_alpn_npn(Config) when is_list(Config) -> + run_handshake(Config, + [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}], + [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, + {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.0">>]}], + {ok, <<"http/1.1">>}). + +%-------------------------------------------------------------------------------- + +client_renegotiate(Config) when is_list(Config) -> + Data = "hello world", + + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = [{alpn_advertised_protocols, [<<"http/1.0">>]}] ++ ClientOpts0, + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0, + ExpectedProtocol = {ok, <<"http/1.0">>}, + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, ssl_receive_and_assert_alpn, [ExpectedProtocol, Data]}}, + {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, assert_alpn_and_renegotiate_and_send_data, [ExpectedProtocol, Data]}}, + {options, ClientOpts}]), + + ssl_test_lib:check_result(Server, ok, Client, ok). + +%-------------------------------------------------------------------------------- + +session_reused(Config) when is_list(Config)-> + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = [{alpn_advertised_protocols, [<<"http/1.0">>]}] ++ ClientOpts0, + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0, + + {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, session_info_result, []}}, + {options, ServerOpts}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result_msg, []}}, + {options, ClientOpts}]), + + SessionInfo = + receive + {Server, Info} -> + Info + end, + + Server ! {listen, {mfa, {ssl_test_lib, no_result, []}}}, + + %% Make sure session is registered + ct:sleep(?SLEEP), + + Client1 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, session_info_result, []}}, + {from, self()}, {options, ClientOpts}]), + + receive + {Client1, SessionInfo} -> + ok; + {Client1, Other} -> + ct:fail(Other) + end, + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client), + ssl_test_lib:close(Client1). + +%-------------------------------------------------------------------------------- + +alpn_not_supported_client(Config) when is_list(Config) -> + ClientOpts0 = ?config(client_opts, Config), + PrefProtocols = {client_preferred_next_protocols, + {client, [<<"http/1.0">>], <<"http/1.1">>}}, + ClientOpts = [PrefProtocols] ++ ClientOpts0, + {ClientNode, _ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, + {port, 8888}, {host, Hostname}, + {from, self()}, {options, ClientOpts}]), + + ssl_test_lib:check_result(Client, {error, + {options, + {not_supported_in_sslv3, PrefProtocols}}}). + +%-------------------------------------------------------------------------------- + +alpn_not_supported_server(Config) when is_list(Config)-> + ServerOpts0 = ?config(server_opts, Config), + AdvProtocols = {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, + ServerOpts = [AdvProtocols] ++ ServerOpts0, + + {error, {options, {not_supported_in_sslv3, AdvProtocols}}} = ssl:listen(0, ServerOpts). + +%%-------------------------------------------------------------------- +%% Internal functions ------------------------------------------------ +%%-------------------------------------------------------------------- + +run_failing_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedResult) -> + ClientOpts = ClientExtraOpts ++ ?config(client_opts, Config), + ServerOpts = ServerExtraOpts ++ ?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, {?MODULE, placeholder, []}}, + {options, ServerOpts}]), + + Port = ssl_test_lib:inet_port(Server), + ExpectedResult + = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, placeholder, []}}, + {options, ClientOpts}]). + +run_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) -> + Data = "hello world", + + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = ClientExtraOpts ++ ClientOpts0, + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = ServerExtraOpts ++ ServerOpts0, + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, ssl_receive_and_assert_alpn, [ExpectedProtocol, Data]}}, + {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, ssl_send_and_assert_alpn, [ExpectedProtocol, Data]}}, + {options, ClientOpts}]), + + ssl_test_lib:check_result(Server, ok, Client, ok). + +assert_alpn(Socket, Protocol) -> + ct:log("Negotiated Protocol ~p, Expecting: ~p ~n", + [ssl:negotiated_protocol(Socket), Protocol]), + Protocol = ssl:negotiated_protocol(Socket). + +assert_alpn_and_renegotiate_and_send_data(Socket, Protocol, Data) -> + assert_alpn(Socket, Protocol), + ct:log("Renegotiating ~n", []), + ok = ssl:renegotiate(Socket), + ssl:send(Socket, Data), + assert_alpn(Socket, Protocol), + ok. + +ssl_send_and_assert_alpn(Socket, Protocol, Data) -> + assert_alpn(Socket, Protocol), + ssl_send(Socket, Data). + +ssl_receive_and_assert_alpn(Socket, Protocol, Data) -> + assert_alpn(Socket, Protocol), + ssl_receive(Socket, Data). + +ssl_send(Socket, Data) -> + ct:log("Connection info: ~p~n", + [ssl:connection_info(Socket)]), + ssl:send(Socket, Data). + +ssl_receive(Socket, Data) -> + ssl_receive(Socket, Data, []). + +ssl_receive(Socket, Data, Buffer) -> + ct:log("Connection info: ~p~n", + [ssl:connection_info(Socket)]), + receive + {ssl, Socket, MoreData} -> + ct:log("Received ~p~n",[MoreData]), + NewBuffer = Buffer ++ MoreData, + case NewBuffer of + Data -> + ssl:send(Socket, "Got it"), + ok; + _ -> + ssl_receive(Socket, Data, NewBuffer) + end; + Other -> + ct:fail({unexpected_message, Other}) + after 4000 -> + ct:fail({did_not_get, Data}) + end. + +connection_info_result(Socket) -> + ssl:connection_info(Socket). diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index 8dca733526..d4433393a1 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -40,7 +40,47 @@ all() -> [decode_hello_handshake, encode_single_hello_sni_extension_correctly, decode_single_hello_sni_extension_correctly, decode_empty_server_sni_correctly, - select_proper_tls_1_2_rsa_default_hashsign]. + select_proper_tls_1_2_rsa_default_hashsign, + ignore_hassign_extension_pre_tls_1_2]. + +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + Config. +end_per_suite(Config) -> + Config. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_,Config) -> + Config. + +init_per_testcase(ignore_hassign_extension_pre_tls_1_2, Config0) -> + catch crypto:stop(), + try crypto:start() of + ok -> + case is_supported(sha512) of + true -> + ssl:start(), + %% make rsa certs using oppenssl + Result = + (catch make_certs:all(?config(data_dir, Config0), + ?config(priv_dir, Config0))), + ct:log("Make certs ~p~n", [Result]), + ssl_test_lib:cert_options(Config0); + false -> + {skip, "Crypto did not support sha512"} + end + catch _:_ -> + {skip, "Crypto did not start"} + end; +init_per_testcase(_, Config0) -> + Config0. + +end_per_testcase(ignore_hassign_extension_pre_tls_1_2, _) -> + crypto:stop(); +end_per_testcase(_TestCase, Config) -> + Config. %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- @@ -121,3 +161,18 @@ select_proper_tls_1_2_rsa_default_hashsign(_Config) -> {md5sha, rsa} = ssl_handshake:select_hashsign_algs(undefined, ?rsaEncryption, {3,2}), {md5sha, rsa} = ssl_handshake:select_hashsign_algs(undefined, ?rsaEncryption, {3,0}). + +ignore_hassign_extension_pre_tls_1_2(Config) -> + Opts = ?config(server_opts, Config), + CertFile = proplists:get_value(certfile, Opts), + [{_, Cert, _}] = ssl_test_lib:pem_to_der(CertFile), + HashSigns = #hash_sign_algos{hash_sign_algos = [{sha512, rsa}, {sha, dsa}]}, + {sha512, rsa} = ssl_handshake:select_hashsign(HashSigns, Cert, {3,3}), + %%% Ignore + {md5sha, rsa} = ssl_handshake:select_hashsign(HashSigns, Cert, {3,2}), + {md5sha, rsa} = ssl_handshake:select_hashsign(HashSigns, Cert, {3,0}). + +is_supported(Hash) -> + Algos = crypto:supports(), + Hashs = proplists:get_value(hashs, Algos), + lists:member(Hash, Hashs). diff --git a/lib/ssl/test/ssl_npn_handshake_SUITE.erl b/lib/ssl/test/ssl_npn_handshake_SUITE.erl index 30c0a67a36..326f907e66 100644 --- a/lib/ssl/test/ssl_npn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_npn_handshake_SUITE.erl @@ -172,7 +172,7 @@ no_client_negotiate_but_server_supports_npn(Config) when is_list(Config) -> run_npn_handshake(Config, [], [{next_protocols_advertised, [<<"spdy/1">>, <<"http/1.1">>, <<"http/1.0">>]}], - {error, next_protocol_not_negotiated}). + {error, protocol_not_negotiated}). %-------------------------------------------------------------------------------- @@ -180,7 +180,7 @@ client_negotiate_server_does_not_support(Config) when is_list(Config) -> run_npn_handshake(Config, [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}}], [], - {error, next_protocol_not_negotiated}). + {error, protocol_not_negotiated}). %-------------------------------------------------------------------------------- renegotiate_from_client_after_npn_handshake(Config) when is_list(Config) -> @@ -311,8 +311,8 @@ run_npn_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) -> assert_npn(Socket, Protocol) -> ct:log("Negotiated Protocol ~p, Expecting: ~p ~n", - [ssl:negotiated_next_protocol(Socket), Protocol]), - Protocol = ssl:negotiated_next_protocol(Socket). + [ssl:negotiated_protocol(Socket), Protocol]), + Protocol = ssl:negotiated_protocol(Socket). assert_npn_and_renegotiate_and_send_data(Socket, Protocol, Data) -> assert_npn(Socket, Protocol), diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 7d0546210c..d19e3b7fdb 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1090,6 +1090,8 @@ cipher_restriction(Config0) -> check_sane_openssl_version(Version) -> case {Version, os:cmd("openssl version")} of + {_, "OpenSSL 1.0.2" ++ _} -> + true; {_, "OpenSSL 1.0.1" ++ _} -> true; {'tlsv1.2', "OpenSSL 1.0" ++ _} -> diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 942c446ec4..94426a3061 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -50,9 +50,9 @@ all() -> groups() -> [{basic, [], basic_tests()}, - {'tlsv1.2', [], all_versions_tests() ++ npn_tests()}, - {'tlsv1.1', [], all_versions_tests() ++ npn_tests()}, - {'tlsv1', [], all_versions_tests()++ npn_tests()}, + {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests()}, + {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests()}, + {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests()}, {'sslv3', [], all_versions_tests()}]. basic_tests() -> @@ -79,6 +79,18 @@ all_versions_tests() -> expired_session, ssl2_erlang_server_openssl_client]. +alpn_tests() -> + [erlang_client_alpn_openssl_server_alpn, + erlang_server_alpn_openssl_client_alpn, + erlang_client_alpn_openssl_server, + erlang_client_openssl_server_alpn, + erlang_server_alpn_openssl_client, + erlang_server_openssl_client_alpn, + erlang_client_alpn_openssl_server_alpn_renegotiate, + erlang_server_alpn_openssl_client_alpn_renegotiate, + erlang_client_alpn_npn_openssl_server_alpn_npn, + erlang_server_alpn_npn_openssl_client_alpn_npn]. + npn_tests() -> [erlang_client_openssl_server_npn, erlang_server_openssl_client_npn, @@ -161,6 +173,36 @@ special_init(ssl2_erlang_server_openssl_client, Config) -> check_sane_openssl_sslv2(Config); special_init(TestCase, Config) + when TestCase == erlang_client_alpn_openssl_server_alpn; + TestCase == erlang_server_alpn_openssl_client_alpn; + TestCase == erlang_client_alpn_openssl_server; + TestCase == erlang_client_openssl_server_alpn; + TestCase == erlang_server_alpn_openssl_client; + TestCase == erlang_server_openssl_client_alpn -> + check_openssl_alpn_support(Config); + +special_init(TestCase, Config) + when TestCase == erlang_client_alpn_openssl_server_alpn_renegotiate; + TestCase == erlang_server_alpn_openssl_client_alpn_renegotiate -> + {ok, Version} = application:get_env(ssl, protocol_version), + case check_sane_openssl_renegotaite(Config, Version) of + {skip, _} = Skip -> + Skip; + _ -> + check_openssl_alpn_support(Config) + end; + +special_init(TestCase, Config) + when TestCase == erlang_client_alpn_npn_openssl_server_alpn_npn; + TestCase == erlang_server_alpn_npn_openssl_client_alpn_npn -> + case check_openssl_alpn_support(Config) of + {skip, _} = Skip -> + Skip; + _ -> + check_openssl_npn_support(Config) + end; + +special_init(TestCase, Config) when TestCase == erlang_client_openssl_server_npn; TestCase == erlang_server_openssl_client_npn; TestCase == erlang_server_openssl_client_npn_only_server; @@ -179,6 +221,7 @@ special_init(TestCase, Config) _ -> check_openssl_npn_support(Config) end; + special_init(_, Config) -> Config. @@ -924,6 +967,128 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> process_flag(trap_exit, false). %%-------------------------------------------------------------------- + +erlang_client_alpn_openssl_server_alpn(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, fun(Client, OpensslPort) -> + true = port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok) + end), + ok. + +%%-------------------------------------------------------------------- + +erlang_server_alpn_openssl_client_alpn(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, fun(Client, OpensslPort) -> + true = port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok) + end), + ok. + +%%-------------------------------------------------------------------------- + +erlang_client_alpn_openssl_server(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_with_opts(Config, + [{alpn_advertised_protocols, [<<"spdy/2">>]}], + "", + Data, fun(Server, OpensslPort) -> + true = port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. + +%%-------------------------------------------------------------------------- + +erlang_client_openssl_server_alpn(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_with_opts(Config, + [], + "-alpn spdy/2", + Data, fun(Server, OpensslPort) -> + true = port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. + +%%-------------------------------------------------------------------------- + +erlang_server_alpn_openssl_client(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_with_opts(Config, + [{alpn_advertised_protocols, [<<"spdy/2">>]}], + "", + Data, fun(Server, OpensslPort) -> + true = port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. + +%%-------------------------------------------------------------------------- + +erlang_server_openssl_client_alpn(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_with_opts(Config, + [], + "-alpn spdy/2", + Data, fun(Server, OpensslPort) -> + true = port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. + +%%-------------------------------------------------------------------- + +erlang_client_alpn_openssl_server_alpn_renegotiate(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, fun(Client, OpensslPort) -> + true = port_command(OpensslPort, ?OPENSSL_RENEGOTIATE), + ct:sleep(?SLEEP), + true = port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok) + end), + ok. + +%%-------------------------------------------------------------------- + +erlang_server_alpn_openssl_client_alpn_renegotiate(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, fun(Client, OpensslPort) -> + true = port_command(OpensslPort, ?OPENSSL_RENEGOTIATE), + ct:sleep(?SLEEP), + true = port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok) + end), + ok. + +%%-------------------------------------------------------------------- + +erlang_client_alpn_npn_openssl_server_alpn_npn(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, fun(Client, OpensslPort) -> + true = port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok) + end), + ok. + +%%-------------------------------------------------------------------- + +erlang_server_alpn_npn_openssl_client_alpn_npn(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, fun(Client, OpensslPort) -> + true = port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok) + end), + ok. + +%%-------------------------------------------------------------------- erlang_client_openssl_server_npn() -> [{doc,"Test erlang client with openssl server doing npn negotiation"}]. @@ -1139,6 +1304,142 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens ssl_test_lib:close(Client), process_flag(trap_exit, false). +start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callback) -> + process_flag(trap_exit, true), + ServerOpts = ?config(server_opts, Config), + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]} | ClientOpts0], + + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + + Data = "From openssl to erlang", + + Port = ssl_test_lib:inet_port(node()), + CertFile = proplists:get_value(certfile, ServerOpts), + KeyFile = proplists:get_value(keyfile, ServerOpts), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), + + Cmd = "openssl s_server -msg -alpn http/1.1,spdy/2 -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ + " -cert " ++ CertFile ++ " -key " ++ KeyFile, + + ct:log("openssl cmd: ~p~n", [Cmd]), + + OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + ssl_test_lib:wait_for_openssl_server(), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}}, + {options, ClientOpts}]), + + Callback(Client, OpensslPort), + + %% Clean close down! Server needs to be closed first !! + ssl_test_lib:close_port(OpensslPort), + + ssl_test_lib:close(Client), + process_flag(trap_exit, false). + +start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callback) -> + process_flag(trap_exit, true), + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>]} | ServerOpts0], + + {_, ServerNode, _} = ssl_test_lib:run_where(Config), + + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), + Cmd = "openssl s_client -alpn http/1.0,spdy/2 -msg -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ + " -host localhost", + + ct:log("openssl cmd: ~p~n", [Cmd]), + + OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + Callback(Server, OpenSslPort), + + ssl_test_lib:close(Server), + + ssl_test_lib:close_port(OpenSslPort), + process_flag(trap_exit, false). + +start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Callback) -> + process_flag(trap_exit, true), + ServerOpts = ?config(server_opts, Config), + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]}, + {client_preferred_next_protocols, {client, [<<"spdy/3">>, <<"http/1.1">>]}} | ClientOpts0], + + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + + Data = "From openssl to erlang", + + Port = ssl_test_lib:inet_port(node()), + CertFile = proplists:get_value(certfile, ServerOpts), + KeyFile = proplists:get_value(keyfile, ServerOpts), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), + + Cmd = "openssl s_server -msg -alpn http/1.1,spdy/2 -nextprotoneg spdy/3 -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ + " -cert " ++ CertFile ++ " -key " ++ KeyFile, + + ct:log("openssl cmd: ~p~n", [Cmd]), + + OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + ssl_test_lib:wait_for_openssl_server(), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}}, + {options, ClientOpts}]), + + Callback(Client, OpensslPort), + + %% Clean close down! Server needs to be closed first !! + ssl_test_lib:close_port(OpensslPort), + + ssl_test_lib:close(Client), + process_flag(trap_exit, false). + +start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, Callback) -> + process_flag(trap_exit, true), + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>]}, + {next_protocols_advertised, [<<"spdy/3">>, <<"http/1.1">>]} | ServerOpts0], + + {_, ServerNode, _} = ssl_test_lib:run_where(Config), + + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), + Cmd = "openssl s_client -alpn http/1.1,spdy/2 -nextprotoneg spdy/3 -msg -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ + " -host localhost", + + ct:log("openssl cmd: ~p~n", [Cmd]), + + OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + Callback(Server, OpenSslPort), + + ssl_test_lib:close(Server), + + ssl_test_lib:close_port(OpenSslPort), + process_flag(trap_exit, false). + start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callback) -> process_flag(trap_exit, true), ServerOpts = ?config(server_opts, Config), @@ -1167,7 +1468,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac {host, Hostname}, {from, self()}, {mfa, {?MODULE, - erlang_ssl_receive_and_assert_npn, [<<"spdy/2">>, Data]}}, + erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}}, {options, ClientOpts}]), Callback(Client, OpensslPort), @@ -1188,7 +1489,7 @@ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callbac Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, - {mfa, {?MODULE, erlang_ssl_receive_and_assert_npn, [<<"spdy/2">>, Data]}}, + {mfa, {?MODULE, erlang_ssl_receive_and_assert_negotiated_protocol, [<<"spdy/2">>, Data]}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), @@ -1236,10 +1537,10 @@ start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenS process_flag(trap_exit, false). -erlang_ssl_receive_and_assert_npn(Socket, Protocol, Data) -> - {ok, Protocol} = ssl:negotiated_next_protocol(Socket), +erlang_ssl_receive_and_assert_negotiated_protocol(Socket, Protocol, Data) -> + {ok, Protocol} = ssl:negotiated_protocol(Socket), erlang_ssl_receive(Socket, Data), - {ok, Protocol} = ssl:negotiated_next_protocol(Socket), + {ok, Protocol} = ssl:negotiated_protocol(Socket), ok. erlang_ssl_receive(Socket, Data) -> @@ -1297,6 +1598,15 @@ check_openssl_npn_support(Config) -> Config end. +check_openssl_alpn_support(Config) -> + HelpText = os:cmd("openssl s_client --help"), + case string:str(HelpText, "alpn") of + 0 -> + {skip, "Openssl not compiled with alpn support"}; + _ -> + Config + end. + check_sane_openssl_renegotaite(Config, Version) when Version == 'tlsv1.1'; Version == 'tlsv1.2' -> case os:cmd("openssl version") of diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index f5d8b2072a..a4a2ed9931 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2012. All Rights Reserved. +# Copyright Ericsson AB 1997-2015. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -48,6 +48,7 @@ XML_REF3_FILES = \ digraph.xml \ digraph_utils.xml \ epp.xml \ + erl_anno.xml \ erl_eval.xml \ erl_expand_records.xml \ erl_id_trans.xml \ @@ -81,6 +82,7 @@ XML_REF3_FILES = \ proplists.xml \ qlc.xml \ queue.xml \ + rand.xml \ random.xml \ re.xml \ sets.xml \ diff --git a/lib/stdlib/doc/src/calendar.xml b/lib/stdlib/doc/src/calendar.xml index e32a639b81..d8193a9ec2 100644 --- a/lib/stdlib/doc/src/calendar.xml +++ b/lib/stdlib/doc/src/calendar.xml @@ -270,7 +270,8 @@ <fsummary>Convert now to local date and time</fsummary> <desc> <p>This function returns local date and time converted from - the return value from <c>erlang:now()</c>.</p> + the return value from + <seealso marker="erts:erlang#timestamp/0"><c>erlang:timestamp/0</c></seealso>.</p> </desc> </func> <func> @@ -279,7 +280,8 @@ <fsummary>Convert now to date and time</fsummary> <desc> <p>This function returns Universal Coordinated Time (UTC) - converted from the return value from <c>erlang:now()</c>.</p> + converted from the return value from + <seealso marker="erts:erlang#timestamp/0"><c>erlang:timestamp/0</c></seealso>.</p> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/erl_anno.xml b/lib/stdlib/doc/src/erl_anno.xml new file mode 100644 index 0000000000..281feacdc4 --- /dev/null +++ b/lib/stdlib/doc/src/erl_anno.xml @@ -0,0 +1,308 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2015</year> + <year>2015</year> + <holder>Ericsson AB, All Rights Reserved</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved on line at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + The Initial Developer of the Original Code is Ericsson AB. + </legalnotice> + + <title>erl_anno</title> + <prepared>Hans Bolinder</prepared> + <responsible>Kenneth Lundin</responsible> + <docno>1</docno> + <approved></approved> + <checked></checked> + <date>2015-02-26</date> + <rev>A</rev> + <file>erl_anno.xml</file> + </header> + <module>erl_anno</module> + + <modulesummary> + Abstract Datatype for the Annotations of the Erlang Compiler + </modulesummary> + + <description> + <p>This module implements an abstract type that is used by the + Erlang Compiler and its helper modules for holding data such as + column, line number, and text. The data type is a collection of + <marker id="annotations"><em>annotations</em></marker> as + described in the following.</p> + <p>The Erlang Token Scanner returns tokens with a subset of + the following annotations, depending on the options:</p> + <taglist> + <tag><c>column</c></tag> + <item><p>The column where the token begins.</p></item> + <tag><c>location</c></tag> + <item><p>The line and column where the token begins, or + just the line if the column unknown.</p> + </item> + <tag><c>text</c></tag> + <item><p>The token's text.</p></item> + </taglist> + <p>From the above the following annotation is derived:</p> + <taglist> + <tag><c>line</c></tag> + <item><p>The line where the token begins.</p></item> + </taglist> + <p>Furthermore, the following annotations are supported by + this module, and used by various modules:</p> + <taglist> + <tag><c>file</c></tag> + <item><p>A filename.</p></item> + <tag><c>generated</c></tag> + <item><p>A Boolean indicating if the abstract code is + compiler generated. The Erlang Compiler does not emit warnings + for such code.</p> + </item> + <tag><c>record</c></tag> + <item><p>A Boolean indicating if the origin of the abstract + code is a record. Used by Dialyzer to assign types to tuple + elements.</p> + </item> + </taglist> + <p>The functions + <seealso marker="erl_scan#column/1">column()</seealso>, + <seealso marker="erl_scan#end_location/1">end_location()</seealso>, + <seealso marker="erl_scan#line/1">line()</seealso>, + <seealso marker="erl_scan#location/1">location()</seealso>, and + <seealso marker="erl_scan#text/1">text()</seealso> + in the <c>erl_scan</c> module can be used for inspecting + annotations in tokens.</p> + <p>The functions + <seealso marker="erl_parse#map_anno/2">map_anno()</seealso>, + <seealso marker="erl_parse#fold_anno/3">fold_anno()</seealso>, + <seealso marker="erl_parse#mapfold_anno/3">mapfold_anno()</seealso>, + <seealso marker="erl_parse#new_anno/1">new_anno()</seealso>, + <seealso marker="erl_parse#anno_from_term/1"> + anno_from_term()</seealso>, and + <seealso marker="erl_parse#anno_to_term/1"> + anno_to_term()</seealso> in the <c>erl_parse</c> module can be + used for manipulating annotations in abstract code. + </p> + </description> + + <datatypes> + <datatype> + <name><marker id="type-anno">anno()</marker></name> + <desc><p>A collection of annotations.</p> + </desc> + </datatype> + <datatype> + <name name="anno_term"></name> + <desc> + <p>The term representing a collection of annotations. It is + either a <c>location()</c> or a list of key-value pairs.</p> + </desc> + </datatype> + <datatype> + <name name="column"></name> + </datatype> + <datatype> + <name name="line"></name> + <desc> + <p>To be changed to a non-negative integer in Erlang/OTP 19.0.</p> + </desc> + </datatype> + <datatype> + <name name="location"></name> + </datatype> + <datatype> + <name name="text"></name> + </datatype> + </datatypes> + + <funcs> + <func> + <name name="column" arity="1"/> + <type name="column"></type> + <fsummary>Return the column</fsummary> + <desc> + <p>Returns the column of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="end_location" arity="1"/> + <type name="location"></type> + <fsummary>Return the end location of the text</fsummary> + <desc> + <p>Returns the end location of the text of the + annotations <anno>Anno</anno>. If there is no text, + <c>undefined</c> is returned. + </p> + </desc> + </func> + <func> + <name name="file" arity="1"/> + <type name="filename"></type> + <fsummary>Return the filename</fsummary> + <desc> + <p>Returns the filename of the annotations <anno>Anno</anno>. + If there is no filename, <c>undefined</c> is returned. + </p> + </desc> + </func> + <func> + <name name="from_term" arity="1"/> + <fsummary>Return annotations given a term</fsummary> + <desc> + <p>Returns annotations with the representation <anno>Term</anno>. + </p> + <!-- + <p>Although it is possible to create new annotations by calling + <c>from_term/1</c>, the intention is that one should not do + so - the proper way to create annotations is to call + <c>new/1</c> and then modify the annotations + by calling the <c>set_*</c> functions.</p> + --> + <p>See also <seealso marker="#to_term/1">to_term()</seealso>. + </p> + </desc> + </func> + <func> + <name name="generated" arity="1"/> + <type name="generated"></type> + <fsummary>Return the generated Boolean</fsummary> + <desc> + <p>Returns <c>true</c> if the annotations <anno>Anno</anno> + has been marked as generated. The default is to return + <c>false</c>. + </p> + </desc> + </func> + <func> + <name name="is_anno" arity="1"/> + <fsummary>Test for a collection of annotations</fsummary> + <desc> + <p>Returns <c>true</c> if <anno>Term</anno> is a collection of + annotations, <c>false</c> otherwise.</p> + </desc> + </func> + <func> + <name name="line" arity="1"/> + <type name="line"></type> + <fsummary>Return the line</fsummary> + <desc> + <p>Returns the line of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="location" arity="1"/> + <type name="location"></type> + <fsummary>Return the location</fsummary> + <desc> + <p>Returns the location of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="new" arity="1"/> + <type name="location"></type> + <fsummary>Create a new collection of annotations</fsummary> + <desc> + <p>Creates a new collection of annotations given a location.</p> + </desc> + </func> + <func> + <name name="set_file" arity="2"/> + <type name="filename"></type> + <fsummary>Modify the filename</fsummary> + <desc> + <p>Modifies the filename of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="set_generated" arity="2"/> + <type name="generated"></type> + <fsummary>Modify the generated marker</fsummary> + <desc> + <p>Modifies the generated marker of the annotations + <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="set_line" arity="2"/> + <type name="line"></type> + <fsummary>Modify the line</fsummary> + <desc> + <p>Modifies the line of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="set_location" arity="2"/> + <type name="location"></type> + <fsummary>Modify the location</fsummary> + <desc> + <p>Modifies the location of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="set_record" arity="2"/> + <type name="record"></type> + <fsummary>Modify the record marker</fsummary> + <desc> + <p>Modifies the record marker of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="set_text" arity="2"/> + <type name="text"></type> + <fsummary>Modify the text</fsummary> + <desc> + <p>Modifies the text of the annotations <anno>Anno</anno>. + </p> + </desc> + </func> + <func> + <name name="text" arity="1"/> + <type name="text"></type> + <fsummary>Return the text</fsummary> + <desc> + <p>Returns the text of the annotations <anno>Anno</anno>. + If there is no text, <c>undefined</c> is returned. + </p> + </desc> + </func> + <func> + <name name="to_term" arity="1"/> + <fsummary>Return the term representing a collection of + annotations</fsummary> + <desc> + <p>Returns the term representing the annotations <anno>Anno</anno>. + </p> + <p>See also <seealso marker="#from_term/1">from_term()</seealso>. + </p> + </desc> + </func> + </funcs> + <section> + <title>See Also</title> + <p><seealso marker="erl_scan">erl_scan(3)</seealso>, + <seealso marker="erl_parse">erl_parse(3)</seealso> + </p> + </section> +</erlref> diff --git a/lib/stdlib/doc/src/erl_parse.xml b/lib/stdlib/doc/src/erl_parse.xml index cf0bff48cd..b97d06e919 100644 --- a/lib/stdlib/doc/src/erl_parse.xml +++ b/lib/stdlib/doc/src/erl_parse.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2014</year> + <year>1996</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -192,6 +192,97 @@ considered a string.</p> </desc> </func> + <func> + <name name="map_anno" arity="2"/> + <fsummary> + Map a function over the annotations of an abstract form + </fsummary> + <desc> + <p>Modifies the abstract form <anno>Abstr</anno> by applying + <anno>Fun</anno> on every collection of annotations of the + abstract form. The abstract form is traversed in a + depth-first, left-to-right, fashion. + </p> + </desc> + </func> + <func> + <name name="fold_anno" arity="3"/> + <fsummary> + Fold a function over the annotations of an abstract form + </fsummary> + <desc> + <p>Updates an accumulator by applying <anno>Fun</anno> on + every collection of annotations of the abstract form + <anno>Abstr</anno>. The first call to <anno>Fun</anno> has + <anno>AccIn</anno> as argument, and the returned accumulator + <anno>AccOut</anno> is passed to the next call, and so on. + The final value of the accumulator is returned. The abstract + form is traversed in a depth-first, left-to-right, fashion. + </p> + </desc> + </func> + <func> + <name name="mapfold_anno" arity="3"/> + <fsummary> + Map and fold a function over the annotations of an abstract form + </fsummary> + <desc> + <p>Modifies the abstract form <anno>Abstr</anno> by applying + <anno>Fun</anno> on every collection of annotations of the + abstract form, while at the same time updating an + accumulator. The first call to <anno>Fun</anno> has + <anno>AccIn</anno> as second argument, and the returned + accumulator <anno>AccOut</anno> is passed to the next call, + and so on. The modified abstract form as well as the the + final value of the accumulator is returned. The abstract + form is traversed in a depth-first, left-to-right, fashion. + </p> + </desc> + </func> + <func> + <name name="new_anno" arity="1"/> + <fsummary> + Create new annotations + </fsummary> + <desc> + <p>Creates an abstract form from a term which has the same + structure as an abstract form, but <seealso + marker="erl_anno#type-location">locations</seealso> where the + abstract form has annotations. For each location, <seealso + marker="erl_anno#new/1"><c>erl_anno:new/1</c></seealso> is + called, and the annotations replace the location. + </p> + </desc> + </func> + <func> + <name name="anno_from_term" arity="1"/> + <fsummary> + Return annotations as terms + </fsummary> + <desc> + <p>Assumes that <anno>Term</anno> is a term with the same + structure as an abstract form, but with terms, T say, on + those places where an abstract form has annotations. Returns + an abstract form where every term T has been replaced by the + value returned by calling <c>erl_anno:from_term(T)</c>. The + term <anno>Term</anno> is traversed in a depth-first, + left-to-right, fashion. + </p> + </desc> + </func> + <func> + <name name="anno_to_term" arity="1"/> + <fsummary> + Return the representation of annotations + </fsummary> + <desc> + <p>Returns a term where every collection of annotations Anno of + <anno>Abstr</anno> has been replaced by the term returned by + calling <c>erl_anno:to_term(Anno)</c>. The abstract form is + traversed in a depth-first, left-to-right, fashion. + </p> + </desc> + </func> </funcs> <section> @@ -211,8 +302,9 @@ <section> <title>See Also</title> <p><seealso marker="io">io(3)</seealso>, - <seealso marker="erl_scan">erl_scan(3)</seealso>, - ERTS User's Guide</p> + <seealso marker="erl_anno">erl_anno(3)</seealso>, + <seealso marker="erl_scan">erl_scan(3)</seealso>, + <seealso marker="erts:absform">ERTS User's Guide</seealso></p> </section> </erlref> diff --git a/lib/stdlib/doc/src/erl_scan.xml b/lib/stdlib/doc/src/erl_scan.xml index 855c8fc195..8f9c1db25b 100644 --- a/lib/stdlib/doc/src/erl_scan.xml +++ b/lib/stdlib/doc/src/erl_scan.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -120,7 +120,7 @@ <c>string(<anno>String</anno>, <anno>StartLocation</anno>, [])</c>.</p> <p><c><anno>StartLocation</anno></c> indicates the initial location - when scanning starts. If <c><anno>StartLocation</anno></c> is a line + when scanning starts. If <c><anno>StartLocation</anno></c> is a line, <c>attributes()</c> as well as <c><anno>EndLocation</anno></c> and <c><anno>ErrorLocation</anno></c> will be lines. If <c><anno>StartLocation</anno></c> is a pair of a line and a column @@ -132,8 +132,12 @@ line where the token begins, as well as the text of the token (if the <c>text</c> option is given), all of which can be accessed by calling <seealso - marker="#token_info/1">token_info/1,2</seealso> or <seealso - marker="#attributes_info/1">attributes_info/1,2</seealso>.</p> + marker="#token_info/1">token_info/1,2</seealso>, <seealso + marker="#attributes_info/1">attributes_info/1,2</seealso>, + <seealso marker="#column/1">column/1</seealso>, + <seealso marker="#line/1">line/1</seealso>, + <seealso marker="#location/1">location/1</seealso>, and + <seealso marker="#text/1">text/1</seealso>.</p> <p>A <em>token</em> is a tuple containing information about syntactic category, the token attributes, and the actual terminal symbol. For punctuation characters (e.g. <c>;</c>, @@ -237,6 +241,70 @@ </desc> </func> <func> + <name name="category" arity="1"/> + <fsummary>Return the category</fsummary> + <desc> + <p>Returns the category of <c><anno>Token</anno></c>. + </p> + </desc> + </func> + <func> + <name name="symbol" arity="1"/> + <fsummary>Return the symbol</fsummary> + <desc> + <p>Returns the symbol of <c><anno>Token</anno></c>. + </p> + </desc> + </func> + <func> + <name name="column" arity="1"/> + <fsummary>Return the column</fsummary> + <desc> + <p>Returns the column of <c><anno>Token</anno></c>'s + collection of annotations. + </p> + </desc> + </func> + <func> + <name name="end_location" arity="1"/> + <fsummary>Return the end location of the text</fsummary> + <desc> + <p>Returns the end location of the text of + <c><anno>Token</anno></c>'s collection of annotations. If + there is no text, + <c>undefined</c> is returned. + </p> + </desc> + </func> + <func> + <name name="line" arity="1"/> + <fsummary>Return the line</fsummary> + <desc> + <p>Returns the line of <c><anno>Token</anno></c>'s collection + of annotations. + </p> + </desc> + </func> + <func> + <name name="location" arity="1"/> + <fsummary>Return the location</fsummary> + <desc> + <p>Returns the location of <c><anno>Token</anno></c>'s + collection of annotations. + </p> + </desc> + </func> + <func> + <name name="text" arity="1"/> + <fsummary>Return the text</fsummary> + <desc> + <p>Returns the text of <c><anno>Token</anno></c>'s collection + of annotations. If there is no text, <c>undefined</c> is + returned. + </p> + </desc> + </func> + <func> <name name="token_info" arity="1"/> <fsummary>Return information about a token</fsummary> <desc> @@ -417,6 +485,7 @@ Module:format_error(ErrorDescriptor)</code> <section> <title>See Also</title> <p><seealso marker="io">io(3)</seealso>, - <seealso marker="erl_parse">erl_parse(3)</seealso></p> + <seealso marker="erl_anno">erl_anno(3)</seealso>, + <seealso marker="erl_parse">erl_parse(3)</seealso></p> </section> </erlref> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 902a921fbf..6b9524ef63 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -1618,14 +1618,18 @@ true</pre> </func> <func> <name name="update_counter" arity="3" clause_i="1"/> + <name name="update_counter" arity="4" clause_i="1"/> <name name="update_counter" arity="3" clause_i="2"/> + <name name="update_counter" arity="4" clause_i="2"/> <name name="update_counter" arity="3" clause_i="3"/> + <name name="update_counter" arity="4" clause_i="3"/> <type variable="Tab"/> <type variable="Key"/> <type variable="UpdateOp" name_i="1"/> <type variable="Pos" name_i="1"/> <type variable="Threshold" name_i="1"/> <type variable="SetValue" name_i="1"/> + <type variable="Default"/> <fsummary>Update a counter object in an ETS table.</fsummary> <desc> <p>This function provides an efficient way to update one or more @@ -1667,12 +1671,22 @@ true</pre> <seealso marker="#lookup/2">lookup/2</seealso> and <seealso marker="#new/2">new/2</seealso> for details on the difference).</p> + <p>If a default object <c><anno>Default</anno></c> is given, it is used + as the object to be updated if the key is missing from the table. The + value in place of the key is ignored and replaced by the proper key + value. The return value is as if the default object had not been used, + that is a single updated element or a list of them.</p> <p>The function will fail with reason <c>badarg</c> if:</p> <list type="bulleted"> <item>the table is not of type <c>set</c> or <c>ordered_set</c>,</item> - <item>no object with the right key exists,</item> + <item>no object with the right key exists and no default object were + supplied,</item> <item>the object has the wrong arity,</item> + <item>the default object arity is smaller than + <c><![CDATA[<keypos>]]></c></item> + <item>any field from the default object being updated is not an + integer</item> <item>the element to update is not an integer,</item> <item>the element to update is also the key, or,</item> <item>any of <c><anno>Pos</anno></c>, <c><anno>Incr</anno></c>, <c><anno>Threshold</anno></c> or diff --git a/lib/stdlib/doc/src/file_sorter.xml b/lib/stdlib/doc/src/file_sorter.xml index 16572df3c5..c069333c29 100644 --- a/lib/stdlib/doc/src/file_sorter.xml +++ b/lib/stdlib/doc/src/file_sorter.xml @@ -105,9 +105,9 @@ <c>file:get_cwd()</c> is used instead. The names of temporary files are derived from the Erlang nodename (<c>node()</c>), the process identifier of the current Erlang - emulator (<c>os:getpid()</c>), and a timestamp - (<c>erlang:now()</c>); a typical name would be - <c>fs_mynode@myhost_1763_1043_337000_266005.17</c>, where + emulator (<c>os:getpid()</c>), and a unique integer + (<c>erlang:unique_integer([positive])</c>); a typical name would be + <c>fs_mynode@myhost_1763_4711.17</c>, where <c>17</c> is a sequence number. Existing files will be overwritten. Temporary files are deleted unless some uncaught EXIT signal occurs. diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml index a915e567a5..3c92de59b9 100644 --- a/lib/stdlib/doc/src/gen_server.xml +++ b/lib/stdlib/doc/src/gen_server.xml @@ -321,7 +321,7 @@ gen_server:abcast -----> Module:handle_cast/2 which may be infinity.</p> <p>This problem does not exist if all nodes are Erlang nodes.</p> </warning> - <p>To avoid that late answers (after the timeout) pollutes + <p>To prevent late answers (after the timeout) from polluting the caller's message queue, a middleman process is used to do the actual calls. Late answers will then be discarded when they arrive to a terminated process.</p> diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml index f766c843be..59c26d9896 100644 --- a/lib/stdlib/doc/src/maps.xml +++ b/lib/stdlib/doc/src/maps.xml @@ -40,6 +40,9 @@ Returns a tuple <c>{ok, Value}</c> where <c><anno>Value</anno></c> is the value associated with <c><anno>Key</anno></c>, or <c>error</c> if no value is associated with <c><anno>Key</anno></c> in <c><anno>Map</anno></c>. </p> + <p> + The call will fail with a <c>{badmap,Map}</c> exception if <c><anno>Map</anno></c> is not a map. + </p> <p>Example:</p> <code type="none"> > Map = #{"hi" => 42}, @@ -95,8 +98,10 @@ <p> Returns the value <c><anno>Value</anno></c> associated with <c><anno>Key</anno></c> if <c><anno>Map</anno></c> contains <c><anno>Key</anno></c>. - If no value is associated with <c><anno>Key</anno></c> then the call will - fail with an exception. + </p> + <p> + The call will fail with a <c>{badmap,Map}</c> exception if <c><anno>Map</anno></c> is not a map, + or with a <c>{badkey,Key}</c> exception if no value is associated with <c><anno>Key</anno></c>. </p> <p>Example:</p> <code type="none"> @@ -116,6 +121,10 @@ <c><anno>Map</anno></c> contains <c><anno>Key</anno></c>. If no value is associated with <c><anno>Key</anno></c> then returns <c><anno>Default</anno></c>. </p> + <p> + The call will fail with a <c>{badmap,Map}</c> exception if <c><anno>Map</anno></c> is not a map. + + </p> <p>Example:</p> <code type="none"> > Map = #{ key1 => val1, key2 => val2 }. @@ -134,7 +143,9 @@ val1 <p> Returns <c>true</c> if map <c><anno>Map</anno></c> contains <c><anno>Key</anno></c> and returns <c>false</c> if it does not contain the <c><anno>Key</anno></c>. - The function will fail with an exception if <c><anno>Map</anno></c> is not a Map. + </p> + <p> + The call will fail with a <c>{badmap,Map}</c> exception if <c><anno>Map</anno></c> is not a map. </p> <p>Example:</p> <code type="none"> @@ -154,6 +165,9 @@ false</code> <p> Returns a complete list of keys, in arbitrary order, which resides within <c><anno>Map</anno></c>. </p> + <p> + The call will fail with a <c>{badmap,Map}</c> exception if <c><anno>Map</anno></c> is not a map. + </p> <p>Example:</p> <code type="none"> > Map = #{42 => value_three,1337 => "value two","a" => 1}, @@ -189,6 +203,10 @@ false</code> Merges two maps into a single map <c><anno>Map3</anno></c>. If two keys exists in both maps the value in <c><anno>Map1</anno></c> will be superseded by the value in <c><anno>Map2</anno></c>. </p> + <p> + The call will fail with a <c>{badmap,Map}</c> exception if <c><anno>Map1</anno></c> or + <c><anno>Map2</anno></c> is not a map. + </p> <p>Example:</p> <code type="none"> > Map1 = #{a => "value_one", b => "value_two"}, @@ -222,6 +240,10 @@ false</code> replaced by value <c><anno>Value</anno></c>. The function returns a new map <c><anno>Map2</anno></c> containing the new association and the old associations in <c><anno>Map1</anno></c>. </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" => 1}. @@ -241,6 +263,9 @@ false</code> 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 new map <c><anno>Map2</anno></c> without key <c><anno>Key</anno></c>. </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" => 1}. @@ -276,6 +301,9 @@ false</code> The fuction returns a list of pairs representing the key-value associations of <c><anno>Map</anno></c>, where the pairs, <c>[{K1,V1}, ..., {Kn,Vn}]</c>, are returned in arbitrary order. </p> + <p> + The call will fail with a <c>{badmap,Map}</c> exception if <c><anno>Map</anno></c> is not a map. + </p> <p>Example:</p> <code type="none"> > Map = #{42 => value_three,1337 => "value two","a" => 1}, @@ -291,8 +319,11 @@ false</code> <p> If <c><anno>Key</anno></c> exists in <c><anno>Map1</anno></c> the old associated value is replaced by value <c><anno>Value</anno></c>. The function returns a new map <c><anno>Map2</anno></c> containing - the new associated value. If <c><anno>Key</anno></c> does not exist in <c><anno>Map1</anno></c> an exception is - generated. + the new associated value. + </p> + <p> + The call will fail with a <c>{badmap,Map}</c> exception if <c><anno>Map1</anno></c> is not a map, + or with a <c>{badkey,Key}</c> exception if no value is associated with <c><anno>Key</anno></c>. </p> <p>Example:</p> <code type="none"> @@ -310,6 +341,9 @@ false</code> <p> Returns a complete list of values, in arbitrary order, contained in map <c>M</c>. </p> + <p> + The call will fail with a <c>{badmap,Map}</c> exception if <c><anno>Map</anno></c> is not a map. + </p> <p>Example:</p> <code type="none"> > Map = #{42 => value_three,1337 => "value two","a" => 1}, diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index 8582bfc9f9..301a5ee2e8 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -30,6 +30,41 @@ </header> <p>This document describes the changes made to the STDLIB application.</p> +<section><title>STDLIB 2.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Behaviour of character types \d, \w and \s has always + been to not match characters with value above 255, not + 128, i.e. they are limited to ISO-Latin-1 and not ASCII</p> + <p> + Own Id: OTP-12521</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + c:m/1 now displays the module's MD5 sum.</p> + <p> + Own Id: OTP-12500</p> + </item> + <item> + <p> + Make ets:i/1 handle binary input from IO server.</p> + <p> + Own Id: OTP-12550</p> + </item> + </list> + </section> + +</section> + <section><title>STDLIB 2.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/stdlib/doc/src/orddict.xml b/lib/stdlib/doc/src/orddict.xml index 6d1702bc59..ec1e43f29c 100644 --- a/lib/stdlib/doc/src/orddict.xml +++ b/lib/stdlib/doc/src/orddict.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2000</year><year>2013</year> + <year>2000</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -125,8 +125,7 @@ <c><anno>Orddict</anno></c> together with an extra argument <c>Acc</c> (short for accumulator). <c><anno>Fun</anno></c> must return a new accumulator which is passed to the next call. <c><anno>Acc0</anno></c> is - returned if the list is empty. The evaluation order is - undefined.</p> + returned if the list is empty.</p> </desc> </func> <func> @@ -150,8 +149,7 @@ <fsummary>Map a function over a dictionary</fsummary> <desc> <p><c>map</c> calls <c><anno>Fun</anno></c> on successive keys and values - of <c><anno>Orddict1</anno></c> to return a new value for each key. - The evaluation order is undefined.</p> + of <c><anno>Orddict1</anno></c> to return a new value for each key.</p> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/proc_lib.xml b/lib/stdlib/doc/src/proc_lib.xml index f27a974242..9a0ff85038 100644 --- a/lib/stdlib/doc/src/proc_lib.xml +++ b/lib/stdlib/doc/src/proc_lib.xml @@ -173,7 +173,7 @@ <name name="init_ack" arity="2"/> <fsummary>Used by a process when it has started.</fsummary> <desc> - <p>This function must used by a process that has been started by + <p>This function must be used by a process that has been started by a <seealso marker="#start/3">start[_link]/3,4,5</seealso> function. It tells <c><anno>Parent</anno></c> that the process has initialized itself, has started, or has failed to initialize diff --git a/lib/stdlib/doc/src/rand.xml b/lib/stdlib/doc/src/rand.xml new file mode 100644 index 0000000000..178afda5a0 --- /dev/null +++ b/lib/stdlib/doc/src/rand.xml @@ -0,0 +1,246 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2015</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>rand</title> + <prepared></prepared> + <responsible></responsible> + <docno>1</docno> + <approved></approved> + <checked></checked> + <date></date> + <rev>A</rev> + <file>rand.xml</file> + </header> + <module>rand</module> + <modulesummary>Pseudo random number generation</modulesummary> + <description> + <p>Random number generator.</p> + + <p>The module contains several different algorithms and can be + extended with more in the future. The current uniform + distribution algorithms uses the + <url href="http://xorshift.di.unimi.it"> + scrambled Xorshift algorithms by Sebastiano Vigna</url> and the + normal distribution algorithm uses the + <url href="http://www.jstatsoft.org/v05/i08"> + Ziggurat Method by Marsaglia and Tsang</url>. + </p> + + <p>The implemented algorithms are:</p> + <taglist> + <tag><c>exsplus</c></tag> <item>Xorshift116+, 58 bits precision and period of 2^116-1.</item> + <tag><c>exs64</c></tag> <item>Xorshift64*, 64 bits precision and a period of 2^64-1.</item> + <tag><c>exs1024</c></tag> <item>Xorshift1024*, 64 bits precision and a period of 2^1024-1.</item> + </taglist> + + <p>The current default algorithm is <c>exsplus</c>. The default + may change in future. If a specific algorithm is required make + sure to always use <seealso marker="#seed-1">seed/1</seealso> + to initialize the state. + </p> + + <p>Every time a random number is requested, a state is used to + calculate it and a new state produced. The state can either be + implicit or it can be an explicit argument and return value. + </p> + + <p>The functions with implicit state use the process dictionary + variable <c>rand_seed</c> to remember the current state.</p> + + <p>If a process calls <seealso marker="#uniform-0">uniform/0</seealso> or + <seealso marker="#uniform-1">uniform/1</seealso> without + setting a seed first, <seealso marker="#seed-1">seed/1</seealso> + is called automatically with the default algorithm and creates a + non-constant seed.</p> + + <p>The functions with explicit state never use the process + dictionary.</p> + + <p>Examples:</p> + <pre> + %% Simple usage. Creates and seeds the default algorithm + %% with a non-constant seed if not already done. + R0 = rand:uniform(), + R1 = rand:uniform(), + + %% Use a given algorithm. + _ = rand:seed(exs1024), + R2 = rand:uniform(), + + %% Use a given algorithm with a constant seed. + _ = rand:seed(exs1024, {123, 123534, 345345}), + R3 = rand:uniform(), + + %% Use the functional api with non-constant seed. + S0 = rand:seed_s(exsplus), + {R4, S1} = rand:uniform_s(S0), + + %% Create a standard normal deviate. + {SND0, S2} = rand:normal_s(S1), + </pre> + + <note><p>This random number generator is not cryptographically + strong. If a strong cryptographic random number generator is + needed, use one of functions in the + <seealso marker="crypto:crypto">crypto</seealso> + module, for example <c>crypto:rand_bytes/1</c>.</p></note> + </description> + <datatypes> + <datatype> + <name name="alg"/> + </datatype> + + <datatype> + <name name="state"/> + <desc><p>Algorithm dependent state.</p></desc> + </datatype> + + <datatype> + <name name="export_state"/> + <desc><p>Algorithm dependent state which can be printed or saved to file.</p></desc> + </datatype> + </datatypes> + + <funcs> + <func> + <name name="seed" arity="1"/> + <fsummary>Seed random number generator</fsummary> + <desc> + <marker id="seed-1"/> + <p>Seeds random number generation with the given algorithm and time dependent + data if <anno>AlgOrExpState</anno> is an algorithm.</p> + <p>Otherwise recreates the exported seed in the process + dictionary, and returns the state. + <em>See also:</em> <seealso marker="#export_seed-0">export_seed/0</seealso>.</p> + </desc> + </func> + <func> + <name name="seed_s" arity="1"/> + <fsummary>Seed random number generator</fsummary> + <desc> + <p>Seeds random number generation with the given algorithm and time dependent + data if <anno>AlgOrExpState</anno> is an algorithm.</p> + <p>Otherwise recreates the exported seed and returns the state. + <em>See also:</em> <seealso marker="#export_seed-0">export_seed/0</seealso>.</p> + </desc> + </func> + <func> + <name name="seed" arity="2"/> + <fsummary>Seed the random number generation</fsummary> + <desc> + <p>Seeds random number generation with the given algorithm and + integers in the process dictionary and returns + the state.</p> + </desc> + </func> + <func> + <name name="seed_s" arity="2"/> + <fsummary>Seed the random number generation</fsummary> + <desc> + <p>Seeds random number generation with the given algorithm and + integers and returns the state.</p> + </desc> + </func> + + <func> + <name name="export_seed" arity="0"/> + <fsummary>Export the random number generation state</fsummary> + <desc><marker id="export_seed-0"/> + <p>Returns the random number state in an external format. + To be used with <seealso marker="#seed-1">seed/1</seealso>.</p> + </desc> + </func> + + <func> + <name name="export_seed_s" arity="1"/> + <fsummary>Export the random number generation state</fsummary> + <desc><marker id="export_seed_s-1"/> + <p>Returns the random number generator state in an external format. + To be used with <seealso marker="#seed-1">seed/1</seealso>.</p> + </desc> + </func> + + <func> + <name name="uniform" arity="0"/> + <fsummary>Return a random float</fsummary> + <desc> + <marker id="uniform-0"/> + <p>Returns a random float uniformly distributed in the value + range <c>0.0 < <anno>X</anno> < 1.0 </c> and + updates the state in the process dictionary.</p> + </desc> + </func> + <func> + <name name="uniform_s" arity="1"/> + <fsummary>Return a random float</fsummary> + <desc> + <p>Given a state, <c>uniform_s/1</c> returns a random float + uniformly distributed in the value range <c>0.0 < + <anno>X</anno> < 1.0</c> and a new state.</p> + </desc> + </func> + + <func> + <name name="uniform" arity="1"/> + <fsummary>Return a random integer</fsummary> + <desc> + <marker id="uniform-1"/> + <p>Given an integer <c><anno>N</anno> >= 1</c>, + <c>uniform/1</c> returns a random integer uniformly + distributed in the value range + <c>1 <= <anno>X</anno> <= <anno>N</anno></c> and + updates the state in the process dictionary.</p> + </desc> + </func> + <func> + <name name="uniform_s" arity="2"/> + <fsummary>Return a random integer</fsummary> + <desc> + <p>Given an integer <c><anno>N</anno> >= 1</c> and a state, + <c>uniform_s/2</c> returns a random integer uniformly + distributed in the value range <c>1 <= <anno>X</anno> <= + <anno>N</anno></c> and a new state.</p> + </desc> + </func> + + <func> + <name name="normal" arity="0"/> + <fsummary>Return a standard normal distributed random float</fsummary> + <desc> + <p>Returns a standard normal deviate float (that is, the mean + is 0 and the standard deviation is 1) and updates the state in + the process dictionary.</p> + </desc> + </func> + <func> + <name name="normal_s" arity="1"/> + <fsummary>Return a standard normal distributed random float</fsummary> + <desc> + <p>Given a state, <c>normal_s/1</c> returns a standard normal + deviate float (that is, the mean is 0 and the standard + deviation is 1) and a new state.</p> + </desc> + </func> + + </funcs> +</erlref> diff --git a/lib/stdlib/doc/src/random.xml b/lib/stdlib/doc/src/random.xml index e001058e19..e475cda23d 100644 --- a/lib/stdlib/doc/src/random.xml +++ b/lib/stdlib/doc/src/random.xml @@ -48,6 +48,9 @@ <p>It should be noted that this random number generator is not cryptographically strong. If a strong cryptographic random number generator is needed for example <c>crypto:rand_bytes/1</c> could be used instead.</p> + <note><p>The new and improved <seealso + marker="stdlib:rand">rand</seealso> module should be used + instead of this module.</p></note> </description> <datatypes> <datatype> @@ -70,12 +73,11 @@ <desc> <p>Seeds random number generation with integer values in the process dictionary, and returns the old state.</p> - <p>One way of obtaining a seed is to use the BIF <c>now/0</c>:</p> + <p>One easy way of obtaining a unique value to seed with is to:</p> <code type="none"> - ... - {A1,A2,A3} = now(), - random:seed(A1, A2, A3), - ...</code> + random:seed(<seealso marker="erts:erlang#phash2/1">erlang:phash2</seealso>([<seealso marker="erts:erlang#node/0">node()</seealso>]), + <seealso marker="erts:erlang#monotonic_time/0">erlang:monotonic_time()</seealso>, + <seealso marker="erts:erlang#unique_integer/0">erlang:unique_integer()</seealso>)</code> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index ea4009dc3e..eee4a68ca1 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -4,7 +4,7 @@ <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -45,6 +45,7 @@ <xi:include href="digraph.xml"/> <xi:include href="digraph_utils.xml"/> <xi:include href="epp.xml"/> + <xi:include href="erl_anno.xml"/> <xi:include href="erl_eval.xml"/> <xi:include href="erl_expand_records.xml"/> <xi:include href="erl_id_trans.xml"/> @@ -78,6 +79,7 @@ <xi:include href="proplists.xml"/> <xi:include href="qlc.xml"/> <xi:include href="queue.xml"/> + <xi:include href="rand.xml"/> <xi:include href="random.xml"/> <xi:include href="re.xml"/> <xi:include href="sets.xml"/> diff --git a/lib/stdlib/doc/src/sets.xml b/lib/stdlib/doc/src/sets.xml index c5b8dce4b7..4a31648f8f 100644 --- a/lib/stdlib/doc/src/sets.xml +++ b/lib/stdlib/doc/src/sets.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2000</year><year>2014</year> + <year>2000</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -65,7 +65,7 @@ </func> <func> <name name="is_set" arity="1"/> - <fsummary>Test for an <c>Set</c></fsummary> + <fsummary>Test for a <c>Set</c></fsummary> <desc> <p>Returns <c>true</c> if <c><anno>Set</anno></c> is a set of elements, otherwise <c>false</c>.</p> @@ -80,21 +80,22 @@ </func> <func> <name name="to_list" arity="1"/> - <fsummary>Convert an <c>Set</c>into a list</fsummary> + <fsummary>Convert a <c>Set</c>into a list</fsummary> <desc> - <p>Returns the elements of <c><anno>Set</anno></c> as a list.</p> + <p>Returns the elements of <c><anno>Set</anno></c> as a list. + The order of the returned elements is undefined.</p> </desc> </func> <func> <name name="from_list" arity="1"/> - <fsummary>Convert a list into an <c>Set</c></fsummary> + <fsummary>Convert a list into a <c>Set</c></fsummary> <desc> - <p>Returns an set of the elements in <c><anno>List</anno></c>.</p> + <p>Returns a set of the elements in <c><anno>List</anno></c>.</p> </desc> </func> <func> <name name="is_element" arity="2"/> - <fsummary>Test for membership of an <c>Set</c></fsummary> + <fsummary>Test for membership of a <c>Set</c></fsummary> <desc> <p>Returns <c>true</c> if <c><anno>Element</anno></c> is an element of <c><anno>Set</anno></c>, otherwise <c>false</c>.</p> @@ -102,7 +103,7 @@ </func> <func> <name name="add_element" arity="2"/> - <fsummary>Add an element to an <c>Set</c></fsummary> + <fsummary>Add an element to a <c>Set</c></fsummary> <desc> <p>Returns a new set formed from <c><anno>Set1</anno></c> with <c><anno>Element</anno></c> inserted.</p> @@ -110,7 +111,7 @@ </func> <func> <name name="del_element" arity="2"/> - <fsummary>Remove an element from an <c>Set</c></fsummary> + <fsummary>Remove an element from a <c>Set</c></fsummary> <desc> <p>Returns <c><anno>Set1</anno></c>, but with <c><anno>Element</anno></c> removed.</p> </desc> @@ -175,7 +176,8 @@ <fsummary>Fold over set elements</fsummary> <desc> <p>Fold <c><anno>Function</anno></c> over every element in <c><anno>Set</anno></c> - returning the final value of the accumulator.</p> + returning the final value of the accumulator. + The evaluation order is undefined.</p> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/specs.xml b/lib/stdlib/doc/src/specs.xml index fd77b52da6..0418bf7b22 100644 --- a/lib/stdlib/doc/src/specs.xml +++ b/lib/stdlib/doc/src/specs.xml @@ -11,6 +11,7 @@ <xi:include href="../specs/specs_digraph.xml"/> <xi:include href="../specs/specs_digraph_utils.xml"/> <xi:include href="../specs/specs_epp.xml"/> + <xi:include href="../specs/specs_erl_anno.xml"/> <xi:include href="../specs/specs_erl_eval.xml"/> <xi:include href="../specs/specs_erl_expand_records.xml"/> <xi:include href="../specs/specs_erl_id_trans.xml"/> @@ -44,6 +45,7 @@ <xi:include href="../specs/specs_proplists.xml"/> <xi:include href="../specs/specs_qlc.xml"/> <xi:include href="../specs/specs_queue.xml"/> + <xi:include href="../specs/specs_rand.xml"/> <xi:include href="../specs/specs_random.xml"/> <xi:include href="../specs/specs_re.xml"/> <xi:include href="../specs/specs_sets.xml"/> diff --git a/lib/stdlib/doc/src/timer.xml b/lib/stdlib/doc/src/timer.xml index eca9a72d36..791a29689e 100644 --- a/lib/stdlib/doc/src/timer.xml +++ b/lib/stdlib/doc/src/timer.xml @@ -217,12 +217,14 @@ </func> <func> <name name="now_diff" arity="2"/> - <fsummary>Calculate time difference between <c>now/0</c>timestamps</fsummary> + <fsummary>Calculate time difference between timestamps</fsummary> <type_desc variable="Tdiff">In microseconds</type_desc> <desc> <p>Calculates the time difference <c><anno>Tdiff</anno> = <anno>T2</anno> - <anno>T1</anno></c> in - <em>microseconds</em>, where <c><anno>T1</anno></c> and <c><anno>T2</anno></c> probably - are timestamp tuples returned from <c>erlang:now/0</c>.</p> + <em>microseconds</em>, where <c><anno>T1</anno></c> and <c><anno>T2</anno></c> + are timestamp tuples on the same format as returned from + <seealso marker="erts:erlang#timestamp/0"><c>erlang:timestamp/0</c></seealso>, + or <seealso marker="kernel:os#timestamp/0"><c>os:timestamp/0</c></seealso>.</p> </desc> </func> <func> @@ -234,7 +236,7 @@ </func> <func> <name name="minutes" arity="1"/> - <fsummary>Converts <c>Minutes</c>to <c>Milliseconds</c>.</fsummary> + <fsummary>Converts <c>Minutes</c> to <c>Milliseconds</c>.</fsummary> <desc> <p>Return the number of milliseconds in <c><anno>Minutes</anno></c>.</p> </desc> diff --git a/lib/stdlib/doc/src/zip.xml b/lib/stdlib/doc/src/zip.xml index 48b376743d..d201e81a79 100644 --- a/lib/stdlib/doc/src/zip.xml +++ b/lib/stdlib/doc/src/zip.xml @@ -135,6 +135,12 @@ <p>These options are described in <seealso marker="#zip_options">create/3</seealso>.</p> </desc> </datatype> + <datatype> + <name name="handle"/> + <desc> + <p>As returned by <seealso marker="#zip_open/2">zip_open/2</seealso>.</p> + </desc> + </datatype> </datatypes> <funcs> <func> @@ -430,6 +436,8 @@ means that subsequently reading files from the archive will be faster than unzipping files one at a time with <c>unzip</c>.</p> <p>The archive must be closed with <c>zip_close/1</c>.</p> + <p>The <c><anno>ZipHandle</anno></c> will be closed if the + process which originally opened the archive dies.</p> </desc> </func> <func> diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 1b3744b6fb..55bda60da5 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2013. All Rights Reserved. +# Copyright Ericsson AB 1996-2015. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -58,6 +58,7 @@ MODULES= \ edlin \ edlin_expand \ epp \ + erl_anno \ erl_bits \ erl_compile \ erl_eval \ @@ -104,6 +105,7 @@ MODULES= \ qlc \ qlc_pt \ queue \ + rand \ random \ sets \ shell \ @@ -168,6 +170,7 @@ docs: # specifications. primary_bootstrap_compiler: \ $(BOOTSTRAP_COMPILER)/ebin/epp.beam \ + $(BOOTSTRAP_COMPILER)/ebin/erl_anno.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_scan.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_parse.beam \ $(BOOTSTRAP_COMPILER)/ebin/erl_lint.beam \ diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index 1a7b7d5a5e..4a6b489204 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -652,7 +652,13 @@ chunk_to_data(abstract_code=Id, Chunk, File, _Cs, AtomTable, Mod) -> {'EXIT', _} -> error({invalid_chunk, File, chunk_name_to_id(Id, File)}); Term -> - {AtomTable, {Id, Term}} + try + {AtomTable, {Id, anno_from_term(Term)}} + catch + _:_ -> + error({invalid_chunk, File, + chunk_name_to_id(Id, File)}) + end end end; chunk_to_data(atoms=Id, _Chunk, _File, Cs, AtomTable0, _Mod) -> @@ -878,7 +884,22 @@ decrypt_abst(Type, Module, File, Id, AtomTable, Bin) -> decrypt_abst_1({Type,Key,IVec,_BlockSize}, Bin) -> ok = start_crypto(), NewBin = crypto:block_decrypt(Type, Key, IVec, Bin), - binary_to_term(NewBin). + Term = binary_to_term(NewBin), + anno_from_term(Term). + +anno_from_term({raw_abstract_v1, Forms}) -> + {raw_abstract_v1, anno_from_forms(Forms)}; +anno_from_term({Tag, Forms}) when Tag =:= abstract_v1; Tag =:= abstract_v2 -> + try {Tag, anno_from_forms(Forms)} + catch + _:_ -> + {Tag, Forms} + end; +anno_from_term(T) -> + T. + +anno_from_forms(Forms) -> + [erl_parse:anno_from_term(Form) || Form <- Forms]. start_crypto() -> case crypto:start() of diff --git a/lib/stdlib/src/calendar.erl b/lib/stdlib/src/calendar.erl index 0320e0cd0e..d08001c933 100644 --- a/lib/stdlib/src/calendar.erl +++ b/lib/stdlib/src/calendar.erl @@ -299,7 +299,7 @@ local_time_to_universal_time_dst(DateTime) -> %% now_to_universal_time(Now) %% now_to_datetime(Now) %% -%% Convert from now() to UTC. +%% Convert from erlang:timestamp() to UTC. %% %% Args: Now = now(); now() = {MegaSec, Sec, MilliSec}, MegaSec = Sec %% = MilliSec = integer() diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index a4bd45ea19..5d365ac962 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -1963,7 +1963,7 @@ do_safe_fixtable(Head, Pid, true) -> case Head#head.fixed of false -> link(Pid), - Fixed = {erlang:now(), [{Pid, 1}]}, + Fixed = {utime_now(), [{Pid, 1}]}, Ftab = dets_utils:get_freelists(Head), Head#head{fixed = Fixed, freelists = {Ftab, Ftab}}; {TimeStamp, Counters} -> @@ -3088,14 +3088,14 @@ update_cache(Head, ToAdd) -> {Head1, Found, []}; Cache#cache.wrtime =:= undefined -> %% Empty cache. Schedule a delayed write. - Now = now(), Me = self(), + Now = time_now(), Me = self(), Call = ?DETS_CALL(Me, {delayed_write, Now}), erlang:send_after(Cache#cache.delay, Me, Call), {Head1#head{cache = NewCache#cache{wrtime = Now}}, Found, []}; Size0 =:= 0 -> %% Empty cache that has been written after the %% currently scheduled delayed write. - {Head1#head{cache = NewCache#cache{wrtime = now()}}, Found, []}; + {Head1#head{cache = NewCache#cache{wrtime = time_now()}}, Found, []}; true -> %% Cache is not empty, delayed write has been scheduled. {Head1, Found, []} @@ -3158,11 +3158,7 @@ delayed_write(Head, WrTime) -> Head#head{cache = NewCache}; true -> %% Yes, schedule a new delayed write. - {MS1,S1,M1} = WrTime, - {MS2,S2,M2} = LastWrTime, - WrT = M1+1000000*(S1+1000000*MS1), - LastWrT = M2+1000000*(S2+1000000*MS2), - When = round((LastWrT - WrT)/1000), Me = self(), + When = round((LastWrTime - WrTime)/1000), Me = self(), Call = ?DETS_CALL(Me, {delayed_write, LastWrTime}), erlang:send_after(When, Me, Call), Head @@ -3274,6 +3270,16 @@ err(Error) -> Error end. +-compile({inline, [time_now/0]}). +time_now() -> + erlang:monotonic_time(1000000). + +-compile({inline, [utime_now/0]}). +utime_now() -> + Time = time_now(), + UniqueCounter = erlang:unique_integer([monotonic]), + {Time, UniqueCounter}. + %%%%%%%%%%%%%%%%% DEBUG functions %%%%%%%%%%%%%%%% file_info(FileName) -> diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl index 6c176ad513..26e22dbd5b 100644 --- a/lib/stdlib/src/dets_utils.erl +++ b/lib/stdlib/src/dets_utils.erl @@ -447,7 +447,7 @@ reset_cache(C) -> WrTime =:= undefined -> WrTime; true -> - now() + erlang:monotonic_time(1000000) end, PK = family(C#cache.cache), NewC = C#cache{cache = [], csize = 0, inserts = 0, wrtime = NewWrTime}, diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index b3bc5f6d92..362669545e 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -21,7 +21,7 @@ %% A simple Emacs-like line editor. %% About Latin-1 characters: see the beginning of erl_scan.erl. --export([init/0,start/1,start/2,edit_line/2,prefix_arg/1]). +-export([init/0,init/1,start/1,start/2,edit_line/2,prefix_arg/1]). -export([erase_line/1,erase_inp/1,redraw_line/1]). -export([length_before/1,length_after/1,prompt/1]). -export([current_line/1, current_chars/1]). @@ -44,6 +44,20 @@ init() -> put(kill_buffer, []). +init(Pid) -> + %% copy the kill_buffer from the process Pid + CopiedKillBuf = + case erlang:process_info(Pid, dictionary) of + {dictionary,Dict} -> + case proplists:get_value(kill_buffer, Dict) of + undefined -> []; + Buf -> Buf + end; + undefined -> + [] + end, + put(kill_buffer, CopiedKillBuf). + %% start(Prompt) %% edit(Characters, Continuation) %% Return diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index 5f8637c118..7866b5f792 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -158,7 +158,7 @@ scan_erl_form(Epp) -> {'ok', AbsForm} | {'eof', Line} | {error, ErrorInfo} when Epp :: epp_handle(), AbsForm :: erl_parse:abstract_form(), - Line :: erl_scan:line(), + Line :: erl_anno:line(), ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). parse_erl_form(Epp) -> @@ -220,7 +220,7 @@ format_error(E) -> file:format_error(E). IncludePath :: [DirectoryName :: file:name()], Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | {'eof',Line}, PredefMacros :: macros(), - Line :: erl_scan:line(), + Line :: erl_anno:line(), ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(), OpenError :: file:posix() | badarg | system_limit. @@ -235,7 +235,7 @@ parse_file(Ifile, Path, Predefs) -> {'default_encoding', DefEncoding :: source_encoding()} | 'extra'], Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | {'eof',Line}, - Line :: erl_scan:line(), + Line :: erl_anno:line(), ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(), Extra :: [{'encoding', source_encoding() | 'none'}], OpenError :: file:posix() | badarg | system_limit. @@ -257,7 +257,7 @@ parse_file(Ifile, Options) -> -spec parse_file(Epp) -> [Form] when Epp :: epp_handle(), Form :: erl_parse:abstract_form() | {'error', ErrorInfo} | {'eof',Line}, - Line :: erl_scan:line(), + Line :: erl_anno:line(), ErrorInfo :: erl_scan:error_info() | erl_parse:error_info(). parse_file(Epp) -> @@ -280,7 +280,7 @@ parse_file(Epp) -> {error,E} -> [{error,E}|parse_file(Epp)]; {eof,Location} -> - [{eof,Location}] + [{eof,erl_anno:new(Location)}] end. -spec default_encoding() -> source_encoding(). @@ -547,7 +547,8 @@ init_server(Pid, Name, Options, St0) -> path=Path, macs=Ms1, default_encoding=DefEncoding}, From = wait_request(St), - enter_file_reply(From, Name, AtLocation, AtLocation), + Anno = erl_anno:new(AtLocation), + enter_file_reply(From, Name, Anno, AtLocation, code), wait_req_scan(St); {error,E} -> epp_reply(Pid, {error,E}) @@ -559,15 +560,16 @@ init_server(Pid, Name, Options, St0) -> predef_macros(File) -> Machine = list_to_atom(erlang:system_info(machine)), + Anno = line1(), dict:from_list([ - {{atom,'FILE'}, {none,[{string,1,File}]}}, - {{atom,'LINE'}, {none,[{integer,1,1}]}}, + {{atom,'FILE'}, {none,[{string,Anno,File}]}}, + {{atom,'LINE'}, {none,[{integer,Anno,1}]}}, {{atom,'MODULE'}, undefined}, {{atom,'MODULE_STRING'}, undefined}, {{atom,'BASE_MODULE'}, undefined}, {{atom,'BASE_MODULE_STRING'}, undefined}, - {{atom,'MACHINE'}, {none,[{atom,1,Machine}]}}, - {{atom,Machine}, {none,[{atom,1,true}]}} + {{atom,'MACHINE'}, {none,[{atom,Anno,Machine}]}}, + {{atom,Machine}, {none,[{atom,Anno,true}]}} ]). %% user_predef(PreDefMacros, Macros) -> @@ -595,8 +597,9 @@ user_predef([M|Pdm], Ms) when is_atom(M) -> {ok,_Def} -> %% Predefined macros {error,{redefine_predef,M}}; error -> + A = line1(), user_predef(Pdm, - dict:store({atom,M}, [{none, {none,[{atom,1,true}]}}], Ms)) + dict:store({atom,M}, [{none, {none,[{atom,A,true}]}}], Ms)) end; user_predef([Md|_Pdm], _Ms) -> {error,{bad,Md}}; user_predef([], Ms) -> {ok,Ms}. @@ -645,7 +648,7 @@ wait_req_skip(St, Sis) -> enter_file(_NewName, Inc, From, St) when length(St#epp.sstk) >= 8 -> - epp_reply(From, {error,{abs_loc(Inc),epp,{depth,"include"}}}), + epp_reply(From, {error,{loc(Inc),epp,{depth,"include"}}}), wait_req_scan(St); enter_file(NewName, Inc, From, St) -> case file:path_open(St#epp.path, NewName, [read]) of @@ -653,7 +656,7 @@ enter_file(NewName, Inc, From, St) -> Loc = start_loc(St#epp.location), wait_req_scan(enter_file2(NewF, Pname, From, St, Loc)); {error,_E} -> - epp_reply(From, {error,{abs_loc(Inc),epp,{include,file,NewName}}}), + epp_reply(From, {error,{loc(Inc),epp,{include,file,NewName}}}), wait_req_scan(St) end. @@ -661,9 +664,9 @@ enter_file(NewName, Inc, From, St) -> %% Set epp to use this file and "enter" it. enter_file2(NewF, Pname, From, St0, AtLocation) -> - Loc = start_loc(AtLocation), - enter_file_reply(From, Pname, Loc, AtLocation), - Ms = dict:store({atom,'FILE'}, {none,[{string,Loc,Pname}]}, St0#epp.macs), + Anno = erl_anno:new(AtLocation), + enter_file_reply(From, Pname, Anno, AtLocation, code), + Ms = dict:store({atom,'FILE'}, {none,[{string,Anno,Pname}]}, St0#epp.macs), %% update the head of the include path to be the directory of the new %% source file, so that an included file can always include other files %% relative to its current location (this is also how C does it); note @@ -673,16 +676,20 @@ enter_file2(NewF, Pname, From, St0, AtLocation) -> Path = [filename:dirname(Pname) | tl(St0#epp.path)], DefEncoding = St0#epp.default_encoding, _ = set_encoding(NewF, DefEncoding), - #epp{file=NewF,location=Loc,name=Pname,name2=Pname,delta=0, + #epp{file=NewF,location=AtLocation,name=Pname,name2=Pname,delta=0, sstk=[St0|St0#epp.sstk],path=Path,macs=Ms, default_encoding=DefEncoding}. -enter_file_reply(From, Name, Location, AtLocation) -> - Attr = loc_attr(AtLocation), - Rep = {ok, [{'-',Attr},{atom,Attr,file},{'(',Attr}, - {string,Attr,file_name(Name)},{',',Attr}, - {integer,Attr,get_line(Location)},{')',Location}, - {dot,Attr}]}, +enter_file_reply(From, Name, LocationAnno, AtLocation, Where) -> + Anno0 = loc_anno(AtLocation), + Anno = case Where of + code -> Anno0; + generated -> erl_anno:set_generated(true, Anno0) + end, + Rep = {ok, [{'-',Anno},{atom,Anno,file},{'(',Anno}, + {string,Anno,file_name(Name)},{',',Anno}, + {integer,Anno,get_line(LocationAnno)},{')',LocationAnno}, + {dot,Anno}]}, epp_reply(From, Rep). %% Flatten filename to a string. Must be a valid filename. @@ -710,18 +717,20 @@ leave_file(From, St) -> #epp{location=OldLoc, delta=Delta, name=OldName, name2=OldName2} = OldSt, CurrLoc = add_line(OldLoc, Delta), + Anno = erl_anno:new(CurrLoc), Ms = dict:store({atom,'FILE'}, - {none,[{string,CurrLoc,OldName2}]}, + {none,[{string,Anno,OldName2}]}, St#epp.macs), NextSt = OldSt#epp{sstk=Sts,macs=Ms,uses=St#epp.uses}, - enter_file_reply(From, OldName, CurrLoc, CurrLoc), + enter_file_reply(From, OldName, Anno, CurrLoc, code), case OldName2 =:= OldName of true -> ok; false -> NFrom = wait_request(NextSt), - enter_file_reply(NFrom, OldName2, OldLoc, - neg_line(CurrLoc)) + OldAnno = erl_anno:new(OldLoc), + enter_file_reply(NFrom, OldName2, OldAnno, + CurrLoc, generated) end, wait_req_scan(NextSt); [] -> @@ -818,9 +827,9 @@ scan_extends(_Ts, _As, Ms) -> Ms. %% scan_define(Tokens, DefineToken, From, EppState) -scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{',',Lc}|Toks], _Def, From, St) +scan_define([{'(',_Lp},{Type,_Lm,M}=Mac,{',',_}=Comma|Toks], _Def, From, St) when Type =:= atom; Type =:= var -> - case catch macro_expansion(Toks, Lc) of + case catch macro_expansion(Toks, Comma) of Expansion when is_list(Expansion) -> case dict:find({atom,M}, St#epp.macs) of {ok, Defs} when is_list(Defs) -> @@ -910,10 +919,12 @@ macro_ref([]) -> []; macro_ref([{'?', _}, {'?', _} | Rest]) -> macro_ref(Rest); -macro_ref([{'?', _}, {atom, Lm, A} | Rest]) -> +macro_ref([{'?', _}, {atom, _, A}=Atom | Rest]) -> + Lm = loc(Atom), Arity = count_args(Rest, Lm, A), [{{atom, A}, Arity} | macro_ref(Rest)]; -macro_ref([{'?', _}, {var, Lm, A} | Rest]) -> +macro_ref([{'?', _}, {var, _, A}=Var | Rest]) -> + Lm = loc(Var), Arity = count_args(Rest, Lm, A), [{{atom, A}, Arity} | macro_ref(Rest)]; macro_ref([_Token | Rest]) -> @@ -940,7 +951,7 @@ scan_include([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc, NewName = expand_var(NewName0), enter_file(NewName, Inc, From, St); scan_include(_Toks, Inc, From, St) -> - epp_reply(From, {error,{abs_loc(Inc),epp,{bad,include}}}), + epp_reply(From, {error,{loc(Inc),epp,{bad,include}}}), wait_req_scan(St). %% scan_include_lib(Tokens, IncludeToken, From, EppState) @@ -955,7 +966,7 @@ find_lib_dir(NewName) -> scan_include_lib([{'(',_Llp},{string,_Lf,_NewName0},{')',_Lrp},{dot,_Ld}], Inc, From, St) when length(St#epp.sstk) >= 8 -> - epp_reply(From, {error,{abs_loc(Inc),epp,{depth,"include_lib"}}}), + epp_reply(From, {error,{loc(Inc),epp,{depth,"include_lib"}}}), wait_req_scan(St); scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], Inc, From, St) -> @@ -974,18 +985,18 @@ scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], St, Loc)); {error,_E2} -> epp_reply(From, - {error,{abs_loc(Inc),epp, + {error,{loc(Inc),epp, {include,lib,NewName}}}), wait_req_scan(St) end; _Error -> - epp_reply(From, {error,{abs_loc(Inc),epp, + epp_reply(From, {error,{loc(Inc),epp, {include,lib,NewName}}}), wait_req_scan(St) end end; scan_include_lib(_Toks, Inc, From, St) -> - epp_reply(From, {error,{abs_loc(Inc),epp,{bad,include_lib}}}), + epp_reply(From, {error,{loc(Inc),epp,{bad,include_lib}}}), wait_req_scan(St). %% scan_ifdef(Tokens, IfdefToken, From, EppState) @@ -1088,11 +1099,12 @@ scan_endif(_Toks, Endif, From, St) -> scan_file([{'(',_Llp},{string,_Ls,Name},{',',_Lc},{integer,_Li,Ln},{')',_Lrp}, {dot,_Ld}], Tf, From, St) -> - enter_file_reply(From, Name, Ln, neg_line(abs_loc(Tf))), - Ms = dict:store({atom,'FILE'}, {none,[{string,1,Name}]}, St#epp.macs), + Anno = erl_anno:new(Ln), + enter_file_reply(From, Name, Anno, loc(Tf), generated), + Ms = dict:store({atom,'FILE'}, {none,[{string,line1(),Name}]}, St#epp.macs), Locf = loc(Tf), NewLoc = new_location(Ln, St#epp.location, Locf), - Delta = abs(get_line(element(2, Tf)))-Ln + St#epp.delta, + Delta = get_line(element(2, Tf))-Ln + St#epp.delta, wait_req_scan(St#epp{name2=Name,location=NewLoc,delta=Delta,macs=Ms}); scan_file(_Toks, Tf, From, St) -> epp_reply(From, {error,{loc(Tf),epp,{bad,file}}}), @@ -1153,7 +1165,7 @@ skip_else(_Else, From, St, Sis) -> skip_toks(From, St, Sis). %% macro_pars(Tokens, ArgStack) -%% macro_expansion(Tokens, Line) +%% macro_expansion(Tokens, Anno) %% Extract the macro parameters and the expansion from a macro definition. macro_pars([{')',_Lp}, {',',Ld}|Ex], Args) -> @@ -1165,11 +1177,12 @@ macro_pars([{var,_L,Name}, {',',_}|Ts], Args) -> false = lists:member(Name, Args), macro_pars(Ts, [Name|Args]). -macro_expansion([{')',_Lp},{dot,_Ld}], _L0) -> []; -macro_expansion([{dot,Ld}], _L0) -> throw({error,Ld,missing_parenthesis}); -macro_expansion([T|Ts], _L0) -> - [T|macro_expansion(Ts, element(2, T))]; -macro_expansion([], L0) -> throw({error,L0,premature_end}). +macro_expansion([{')',_Lp},{dot,_Ld}], _Anno0) -> []; +macro_expansion([{dot,_}=Dot], _Anno0) -> + throw({error,loc(Dot),missing_parenthesis}); +macro_expansion([T|Ts], _Anno0) -> + [T|macro_expansion(Ts, T)]; +macro_expansion([], Anno0) -> throw({error,loc(Anno0),premature_end}). %% expand_macros(Tokens, Macros) %% expand_macro(Tokens, MacroToken, RestTokens) @@ -1239,17 +1252,17 @@ expand_macros([{'?',_Lq},{atom,_Lm,M}=MacT|Toks], Ms) -> expand_macros(atom, MacT, M, Toks, Ms); %% Special macros expand_macros([{'?',_Lq},{var,Lm,'LINE'}=Tok|Toks], Ms) -> - {line,Line} = erl_scan:token_info(Tok, line), + Line = erl_scan:line(Tok), [{integer,Lm,Line}|expand_macros(Toks, Ms)]; expand_macros([{'?',_Lq},{var,_Lm,M}=MacT|Toks], Ms) -> expand_macros(atom, MacT, M, Toks, Ms); %% Illegal macros expand_macros([{'?',_Lq},Token|_Toks], _Ms) -> - T = case erl_scan:token_info(Token, text) of - {text,Text} -> + T = case erl_scan:text(Token) of + Text when is_list(Text) -> Text; undefined -> - {symbol,Symbol} = erl_scan:token_info(Token, symbol), + Symbol = erl_scan:symbol(Token), io_lib:write(Symbol) end, throw({error,loc(Token),{call,[$?|T]}}); @@ -1383,7 +1396,7 @@ expand_arg([], Ts, L, Rest, Bs) -> %%% stringify(Ts, L) returns a list of one token: a string which when %%% tokenized would yield the token list Ts. -%% erl_scan:token_info(T, text) is not backward compatible with this. +%% erl_scan:text(T) is not backward compatible with this. %% Note that escaped characters will be replaced by themselves. token_src({dot, _}) -> "."; @@ -1456,36 +1469,29 @@ fname_join(Components) -> filename:join(Components). %% The line only. (Other tokens may have the column and text as well...) -loc_attr(Line) when is_integer(Line) -> - Line; -loc_attr({Line,_Column}) -> - Line. +loc_anno(Line) when is_integer(Line) -> + erl_anno:new(Line); +loc_anno({Line,_Column}) -> + erl_anno:new(Line). loc(Token) -> - {location,Location} = erl_scan:token_info(Token, location), - Location. + erl_scan:location(Token). -abs_loc(Token) -> - loc(setelement(2, Token, abs_line(element(2, Token)))). - -neg_line(L) -> - erl_scan:set_attribute(line, L, fun(Line) -> -abs(Line) end). - -abs_line(L) -> - erl_scan:set_attribute(line, L, fun(Line) -> abs(Line) end). - -add_line(L, Offset) -> - erl_scan:set_attribute(line, L, fun(Line) -> Line+Offset end). +add_line(Line, Offset) when is_integer(Line) -> + Line+Offset; +add_line({Line, Column}, Offset) -> + {Line+Offset, Column}. start_loc(Line) when is_integer(Line) -> 1; start_loc({_Line, _Column}) -> - {1,1}. + {1, 1}. -get_line(Line) when is_integer(Line) -> - Line; -get_line({Line,_Column}) -> - Line. +line1() -> + erl_anno:new(1). + +get_line(Anno) -> + erl_anno:line(Anno). %% epp has always output -file attributes when entering and leaving %% included files (-include, -include_lib). Starting with R11B the @@ -1525,14 +1531,15 @@ get_line({Line,_Column}) -> interpret_file_attribute(Forms) -> interpret_file_attr(Forms, 0, []). -interpret_file_attr([{attribute,Loc,file,{File,Line}}=Form | Forms], +interpret_file_attr([{attribute,Anno,file,{File,Line}}=Form | Forms], Delta, Fs) -> - {line, L} = erl_scan:attributes_info(Loc, line), + L = get_line(Anno), + Generated = erl_anno:generated(Anno), if - L < 0 -> + Generated -> %% -file attribute - interpret_file_attr(Forms, (abs(L) + Delta) - Line, Fs); - true -> + interpret_file_attr(Forms, (L + Delta) - Line, Fs); + not Generated -> %% -include or -include_lib % true = L =:= Line, case Fs of @@ -1543,11 +1550,11 @@ interpret_file_attr([{attribute,Loc,file,{File,Line}}=Form | Forms], end end; interpret_file_attr([Form0 | Forms], Delta, Fs) -> - F = fun(Attrs) -> - F2 = fun(L) -> abs(L) + Delta end, - erl_scan:set_attribute(line, Attrs, F2) + F = fun(Anno) -> + Line = erl_anno:line(Anno), + erl_anno:set_line(Line + Delta, Anno) end, - Form = erl_lint:modify_line(Form0, F), + Form = erl_parse:map_anno(F, Form0), [Form | interpret_file_attr(Forms, Delta, Fs)]; interpret_file_attr([], _Delta, _Fs) -> []. diff --git a/lib/stdlib/src/erl_anno.erl b/lib/stdlib/src/erl_anno.erl new file mode 100644 index 0000000000..963b7278a6 --- /dev/null +++ b/lib/stdlib/src/erl_anno.erl @@ -0,0 +1,460 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(erl_anno). + +-export([new/1, is_anno/1]). +-export([column/1, end_location/1, file/1, generated/1, + line/1, location/1, record/1, text/1]). +-export([set_file/2, set_generated/2, set_line/2, set_location/2, + set_record/2, set_text/2]). + +%% To be used when necessary to avoid Dialyzer warnings. +-export([to_term/1, from_term/1]). + +-export_type([anno/0, line/0, column/0, location/0, text/0]). + +-export_type([anno_term/0]). + +-define(LN(L), is_integer(L)). +-define(COL(C), (is_integer(C) andalso C >= 1)). + +%% Location. +-define(LCOLUMN(C), ?COL(C)). +-define(LLINE(L), ?LN(L)). + +%% Debug: define DEBUG to make sure that annotations are handled as an +%% opaque type. Note that all abstract code need to be compiled with +%% DEBUG=true. See also ./erl_pp.erl. + +%-define(DEBUG, true). + +-type annotation() :: {'file', filename()} + | {'generated', generated()} + | {'location', location()} + | {'record', record()} + | {'text', string()}. + +-type anno() :: location() | [annotation(), ...]. +-type anno_term() :: term(). + +-type column() :: pos_integer(). +-type generated() :: boolean(). +-type filename() :: file:filename_all(). +-type line() :: integer(). +-type location() :: line() | {line(), column()}. +-type record() :: boolean(). +-type text() :: string(). + +-ifdef(DEBUG). +%% Anything 'false' accepted by the compiler. +-define(ALINE(A), is_reference(A)). +-define(ACOLUMN(A), is_reference(A)). +-else. +-define(ALINE(L), ?LN(L)). +-define(ACOLUMN(C), ?COL(C)). +-endif. + +-spec to_term(Anno) -> anno_term() when + Anno :: anno(). + +-ifdef(DEBUG). +to_term(Anno) -> + simplify(Anno). +-else. +to_term(Anno) -> + Anno. +-endif. + +-spec from_term(Term) -> Anno when + Term :: anno_term(), + Anno :: anno(). + +-ifdef(DEBUG). +from_term(Term) when is_list(Term) -> + Term; +from_term(Term) -> + [{location, Term}]. +-else. +from_term(Term) -> + Term. +-endif. + +-spec new(Location) -> anno() when + Location :: location(). + +new(Line) when ?LLINE(Line) -> + new_location(Line); +new({Line, Column}=Loc) when ?LLINE(Line), ?LCOLUMN(Column) -> + new_location(Loc); +new(Term) -> + erlang:error(badarg, [Term]). + +-ifdef(DEBUG). +new_location(Location) -> + [{location, Location}]. +-else. +new_location(Location) -> + Location. +-endif. + +-spec is_anno(Term) -> boolean() when + Term :: any(). + +is_anno(Line) when ?ALINE(Line) -> + true; +is_anno({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + true; +is_anno(Anno) -> + (Anno =/= [] andalso + is_anno1(Anno) andalso + lists:keymember(location, 1, Anno)). + +is_anno1([{Item, Value}|Anno]) -> + is_anno2(Item, Value) andalso is_anno1(Anno); +is_anno1(A) -> + A =:= []. + +is_anno2(location, Line) when ?LN(Line) -> + true; +is_anno2(location, {Line, Column}) when ?LN(Line), ?COL(Column) -> + true; +is_anno2(generated, true) -> + true; +is_anno2(file, Filename) -> + is_filename(Filename); +is_anno2(record, true) -> + true; +is_anno2(text, Text) -> + is_string(Text); +is_anno2(_, _) -> + false. + +is_filename(T) -> + is_string(T) orelse is_binary(T). + +is_string(T) -> + try lists:all(fun(C) when is_integer(C), C >= 0 -> true end, T) + catch _:_ -> false + end. + +-spec column(Anno) -> column() | 'undefined' when + Anno :: anno(). + +column({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + Column; +column(Line) when ?ALINE(Line) -> + undefined; +column(Anno) -> + case location(Anno) of + {_Line, Column} -> + Column; + _Line -> + undefined + end. + +-spec end_location(Anno) -> location() | 'undefined' when + Anno :: anno(). + +end_location(Anno) -> + case text(Anno) of + undefined -> + undefined; + Text -> + case location(Anno) of + {Line, Column} -> + end_location(Text, Line, Column); + Line -> + end_location(Text, Line) + end + end. + +-spec file(Anno) -> filename() | 'undefined' when + Anno :: anno(). + +file(Line) when ?ALINE(Line) -> + undefined; +file({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + undefined; +file(Anno) -> + anno_info(Anno, file). + +-spec generated(Anno) -> generated() when + Anno :: anno(). + +generated(Line) when ?ALINE(Line) -> + Line =< 0; +generated({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + Line =< 0; +generated(Anno) -> + _ = anno_info(Anno, generated, false), + {location, Location} = lists:keyfind(location, 1, Anno), + case Location of + {Line, _Column} -> + Line =< 0; + Line -> + Line =< 0 + end. + +-spec line(Anno) -> line() when + Anno :: anno(). + +line(Anno) -> + case location(Anno) of + {Line, _Column} -> + Line; + Line -> + Line + end. + +-spec location(Anno) -> location() when + Anno :: anno(). + +location(Line) when ?ALINE(Line) -> + abs(Line); +location({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + {abs(Line), Column}; +location(Anno) -> + case anno_info(Anno, location) of + Line when Line < 0 -> + -Line; + {Line, Column} when Line < 0 -> + {-Line, Column}; + Location -> + Location + end. + +-spec record(Anno) -> record() when + Anno :: anno(). + +record(Line) when ?ALINE(Line) -> + false; +record({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + false; +record(Anno) -> + anno_info(Anno, record, false). + +-spec text(Anno) -> text() | 'undefined' when + Anno :: anno(). + +text(Line) when ?ALINE(Line) -> + undefined; +text({Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column) -> + undefined; +text(Anno) -> + anno_info(Anno, text). + +-spec set_file(File, Anno) -> Anno when + File :: filename(), + Anno :: anno(). + +set_file(File, Anno) -> + set(file, File, Anno). + +-spec set_generated(Generated, Anno) -> Anno when + Generated :: generated(), + Anno :: anno(). + +set_generated(true, Line) when ?ALINE(Line) -> + -abs(Line); +set_generated(false, Line) when ?ALINE(Line) -> + abs(Line); +set_generated(true, {Line, Column}) when ?ALINE(Line), + ?ACOLUMN(Column) -> + {-abs(Line),Column}; +set_generated(false, {Line, Column}) when ?ALINE(Line), + ?ACOLUMN(Column) -> + {abs(Line),Column}; +set_generated(Generated, Anno) -> + _ = set(generated, Generated, Anno), + {location, Location} = lists:keyfind(location, 1, Anno), + NewLocation = + case Location of + {Line, Column} when Generated -> + {-abs(Line), Column}; + {Line, Column} when not Generated -> + {abs(Line), Column}; + Line when Generated -> + -abs(Line); + Line when not Generated -> + abs(Line) + end, + lists:keyreplace(location, 1, Anno, {location, NewLocation}). + +-spec set_line(Line, Anno) -> Anno when + Line :: line(), + Anno :: anno(). + +set_line(Line, Anno) -> + case location(Anno) of + {_Line, Column} -> + set_location({Line, Column}, Anno); + _Line -> + set_location(Line, Anno) + end. + +-spec set_location(Location, Anno) -> Anno when + Location :: location(), + Anno :: anno(). + +set_location(Line, L) when ?ALINE(L), ?LLINE(Line) -> + new_location(fix_line(Line, L)); +set_location(Line, {L, Column}) when ?ALINE(L), ?ACOLUMN(Column), + ?LLINE(Line) -> + new_location(fix_line(Line, L)); +set_location({L, C}=Loc, Line) when ?ALINE(Line), ?LLINE(L), ?LCOLUMN(C) -> + new_location(fix_location(Loc, Line)); +set_location({L, C}=Loc, {Line, Column}) when ?ALINE(Line), ?ACOLUMN(Column), + ?LLINE(L), ?LCOLUMN(C) -> + new_location(fix_location(Loc, Line)); +set_location(Location, Anno) -> + _ = set(location, Location, Anno), + {location, OldLocation} = lists:keyfind(location, 1, Anno), + NewLocation = + case {Location, OldLocation} of + {{_Line, _Column}=Loc, {L, _C}} -> + fix_location(Loc, L); + {Line, {L, _C}} -> + fix_line(Line, L); + {{_Line, _Column}=Loc, L} -> + fix_location(Loc, L); + {Line, L} -> + fix_line(Line, L) + end, + lists:keyreplace(location, 1, Anno, {location, NewLocation}). + +fix_location({Line, Column}, OldLine) -> + {fix_line(Line, OldLine), Column}. + +fix_line(Line, OldLine) when OldLine < 0, Line > 0 -> + -Line; +fix_line(Line, _OldLine) -> + Line. + +-spec set_record(Record, Anno) -> Anno when + Record :: record(), + Anno :: anno(). + +set_record(Record, Anno) -> + set(record, Record, Anno). + +-spec set_text(Text, Anno) -> Anno when + Text :: text(), + Anno :: anno(). + +set_text(Text, Anno) -> + set(text, Text, Anno). + +set(Item, Value, Anno) -> + case {is_settable(Item, Value), Anno} of + {true, Line} when ?ALINE(Line) -> + set_anno(Item, Value, [{location, Line}]); + {true, {L, C}=Location} when ?ALINE(L), ?ACOLUMN(C) -> + set_anno(Item, Value, [{location, Location}]); + {true, A} when is_list(A), A =/= [] -> + set_anno(Item, Value, Anno); + _ -> + erlang:error(badarg, [Item, Value, Anno]) + end. + +set_anno(Item, Value, Anno) -> + case default(Item, Value) of + true -> + reset(Anno, Item); + false -> + R = case anno_info(Anno, Item) of + undefined -> + [{Item, Value}|Anno]; + _ -> + lists:keyreplace(Item, 1, Anno, {Item, Value}) + end, + simplify(R) + end. + +reset(Anno, Item) -> + A = lists:keydelete(Item, 1, Anno), + reset_simplify(A). + +-ifdef(DEBUG). +reset_simplify(A) -> + A. +-else. +reset_simplify(A) -> + simplify(A). +-endif. + +simplify([{location, Location}]) -> + Location; +simplify(Anno) -> + Anno. + +anno_info(Anno, Item, Default) -> + try lists:keyfind(Item, 1, Anno) of + false -> + Default; + {Item, Value} -> + Value + catch + _:_ -> + erlang:error(badarg, [Anno]) + end. + +anno_info(Anno, Item) -> + try lists:keyfind(Item, 1, Anno) of + {Item, Value} -> + Value; + false -> + undefined + catch + _:_ -> + erlang:error(badarg, [Anno]) + end. + +end_location("", Line, Column) -> + {Line, Column}; +end_location([$\n|String], Line, _Column) -> + end_location(String, Line+1, 1); +end_location([_|String], Line, Column) -> + end_location(String, Line, Column+1). + +end_location("", Line) -> + Line; +end_location([$\n|String], Line) -> + end_location(String, Line+1); +end_location([_|String], Line) -> + end_location(String, Line). + +is_settable(file, File) -> + is_filename(File); +is_settable(generated, Boolean) when Boolean; not Boolean -> + true; +is_settable(location, Line) when ?LLINE(Line) -> + true; +is_settable(location, {Line, Column}) when ?LLINE(Line), ?LCOLUMN(Column) -> + true; +is_settable(record, Boolean) when Boolean; not Boolean -> + true; +is_settable(text, Text) -> + is_string(Text); +is_settable(_, _) -> + false. + +default(generated, false) -> true; +default(record, false) -> true; +default(_, _) -> false. diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 371573dc23..39f833009f 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -246,18 +246,14 @@ expr({record,_,_,Name,_}, _Bs, _Lf, _Ef, _RBs) -> %% map expr({map,_,Binding,Es}, Bs0, Lf, Ef, RBs) -> {value, Map0, Bs1} = expr(Binding, Bs0, Lf, Ef, none), - case Map0 of - #{} -> - {Vs,Bs2} = eval_map_fields(Es, Bs0, Lf, Ef), - Map1 = lists:foldl(fun ({map_assoc,K,V}, Mi) -> - maps:put(K, V, Mi); - ({map_exact,K,V}, Mi) -> - maps:update(K, V, Mi) - end, Map0, Vs), - ret_expr(Map1, merge_bindings(Bs2, Bs1), RBs); - _ -> - erlang:raise(error, {badarg,Map0}, stacktrace()) - end; + {Vs,Bs2} = eval_map_fields(Es, Bs0, Lf, Ef), + _ = maps:put(k, v, Map0), %Validate map. + Map1 = lists:foldl(fun ({map_assoc,K,V}, Mi) -> + maps:put(K, V, Mi); + ({map_exact,K,V}, Mi) -> + maps:update(K, V, Mi) + end, Map0, Vs), + ret_expr(Map1, merge_bindings(Bs2, Bs1), RBs); expr({map,_,Es}, Bs0, Lf, Ef, RBs) -> {Vs,Bs} = eval_map_fields(Es, Bs0, Lf, Ef), ret_expr(lists:foldl(fun @@ -483,12 +479,13 @@ expr({value,_,Val}, Bs, _Lf, _Ef, RBs) -> % Special case straight values. find_maxline(LC) -> put('$erl_eval_max_line', 0), - F = fun(L) -> + F = fun(A) -> + L = erl_anno:line(A), case is_integer(L) and (L > get('$erl_eval_max_line')) of true -> put('$erl_eval_max_line', L); false -> ok end end, - _ = erl_lint:modify_line(LC, F), + _ = erl_parse:map_anno(F, LC), erase('$erl_eval_max_line'). hide_calls(LC, MaxLine) -> @@ -498,14 +495,16 @@ hide_calls(LC, MaxLine) -> %% v/1 and local calls are hidden. hide({value,L,V}, Id, D) -> - {{atom,Id,ok}, Id+1, dict:store(Id, {value,L,V}, D)}; + A = erl_anno:new(Id), + {{atom,A,ok}, Id+1, dict:store(Id, {value,L,V}, D)}; hide({call,L,{atom,_,N}=Atom,Args}, Id0, D0) -> {NArgs, Id, D} = hide(Args, Id0, D0), C = case erl_internal:bif(N, length(Args)) of true -> {call,L,Atom,NArgs}; false -> - {call,Id,{remote,L,{atom,L,m},{atom,L,f}},NArgs} + A = erl_anno:new(Id), + {call,A,{remote,L,{atom,L,m},{atom,L,f}},NArgs} end, {C, Id+1, dict:store(Id, {call,Atom}, D)}; hide(T0, Id0, D0) when is_tuple(T0) -> @@ -518,11 +517,23 @@ hide([E0 | Es0], Id0, D0) -> hide(E, Id, D) -> {E, Id, D}. -unhide_calls({atom,Id,ok}, MaxLine, D) when Id > MaxLine -> - dict:fetch(Id, D); -unhide_calls({call,Id,{remote,L,_M,_F},Args}, MaxLine, D) when Id > MaxLine -> - {call,Atom} = dict:fetch(Id, D), - {call,L,Atom,unhide_calls(Args, MaxLine, D)}; +unhide_calls({atom,A,ok}=E, MaxLine, D) -> + L = erl_anno:line(A), + if + L > MaxLine -> + dict:fetch(L, D); + true -> + E + end; +unhide_calls({call,A,{remote,L,{atom,L,m},{atom,L,f}}=F,Args}, MaxLine, D) -> + Line = erl_anno:line(A), + if + Line > MaxLine -> + {call,Atom} = dict:fetch(Line, D), + {call,L,Atom,unhide_calls(Args, MaxLine, D)}; + true -> + {call,A,F,unhide_calls(Args, MaxLine, D)} + end; unhide_calls(T, MaxLine, D) when is_tuple(T) -> list_to_tuple(unhide_calls(tuple_to_list(T), MaxLine, D)); unhide_calls([E | Es], MaxLine, D) -> diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index 64a00acd88..0d3debae22 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2014. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -38,8 +38,6 @@ checked_ra=[] % successfully accessed records }). --define(REC_OFFSET, 100000000). % A hundred millions. Also in v3_core. - -spec(module(AbsForms, CompileOptions) -> AbsForms when AbsForms :: [erl_parse:abstract_form()], CompileOptions :: [compile:option()]). @@ -149,7 +147,7 @@ pattern({record_index,Line,Name,Field}, St) -> pattern({record,Line0,Name,Pfs}, St0) -> Fs = record_fields(Name, St0), {TMs,St1} = pattern_list(pattern_fields(Fs, Pfs), St0), - Line = record_offset(Line0, St1), + Line = mark_record(Line0, St1), {{tuple,Line,[{atom,Line0,Name} | TMs]},St1}; pattern({bin,Line,Es0}, St0) -> {Es1,St1} = pattern_bin(Es0, St0), @@ -243,7 +241,7 @@ record_test_in_guard(Line, Term, Name, St) -> expr({atom,Line,false}, St); false -> Fs = record_fields(Name, St), - NLine = neg_line(Line), + NLine = no_compiler_warning(Line), expr({call,NLine,{remote,NLine,{atom,NLine,erlang},{atom,NLine,is_record}}, [Term,{atom,Line,Name},{integer,Line,length(Fs)+1}]}, St) @@ -269,7 +267,7 @@ record_test_in_body(Line, Expr, Name, St0) -> %% evaluate to a tuple properly. Fs = record_fields(Name, St0), {Var,St} = new_var(Line, St0), - NLine = neg_line(Line), + NLine = no_compiler_warning(Line), expr({block,Line, [{match,Line,Var,Expr}, {call,NLine,{remote,NLine,{atom,NLine,erlang}, @@ -333,7 +331,7 @@ expr({record_index,Line,Name,F}, St) -> I = index_expr(Line, F, Name, record_fields(Name, St)), expr(I, St); expr({record,Line0,Name,Is}, St) -> - Line = record_offset(Line0, St), + Line = mark_record(Line0, St), expr({tuple,Line,[{atom,Line0,Name} | record_inits(record_fields(Name, St), Is)]}, St); @@ -384,21 +382,11 @@ expr({call,Line,{tuple,_,[{atom,_,erlang},{atom,_,is_record}]}, expr({call,Line,{atom,_La,N}=Atom,As0}, St0) -> {As,St1} = expr_list(As0, St0), Ar = length(As), - case erl_internal:bif(N, Ar) of - true -> - {{call,Line,Atom,As},St1}; - false -> - case imported(N, Ar, St1) of - {yes,_Mod} -> - {{call,Line,Atom,As},St1}; - no -> - case {N,Ar} of - {record_info,2} -> - record_info_call(Line, As, St1); - _ -> - {{call,Line,Atom,As},St1} - end - end + case {N,Ar} =:= {record_info,2} andalso not imported(N, Ar, St1) of + true -> + record_info_call(Line, As, St1); + false -> + {{call,Line,Atom,As},St1} end; expr({call,Line,{remote,Lr,M,F},As0}, St0) -> {[M1,F1 | As1],St1} = expr_list([M,F | As0], St0), @@ -469,7 +457,7 @@ strict_record_access(E0, St0) -> conj([], _E) -> empty; conj([{{Name,_Rp},L,R,Sz} | AL], E) -> - NL = neg_line(L), + NL = no_compiler_warning(L), T1 = {op,NL,'orelse', {call,NL, {remote,NL,{atom,NL,erlang},{atom,NL,is_record}}, @@ -585,8 +573,8 @@ strict_get_record_field(Line, R, {atom,_,F}=Index, Name, St0) -> Fs = record_fields(Name, St), I = index_expr(F, Fs, 2), P = record_pattern(2, I, Var, length(Fs)+1, Line, [{atom,Line,Name}]), - NLine = neg_line(Line), - RLine = record_offset(NLine, St), + NLine = no_compiler_warning(Line), + RLine = mark_record(NLine, St), E = {'case',NLine,R, [{clause,NLine,[{tuple,RLine,P}],[],[Var]}, {clause,NLine,[{var,NLine,'_'}],[], @@ -600,7 +588,8 @@ strict_get_record_field(Line, R, {atom,_,F}=Index, Name, St0) -> I = index_expr(Line, Index, Name, Fs), {ExpR,St1} = expr(R, St0), %% Just to make comparison simple: - ExpRp = erl_lint:modify_line(ExpR, fun(_L) -> 0 end), + A0 = erl_anno:new(0), + ExpRp = erl_parse:map_anno(fun(_A) -> A0 end, ExpR), RA = {{Name,ExpRp},Line,ExpR,length(Fs)+1}, St2 = St1#exprec{strict_ra = [RA | St1#exprec.strict_ra]}, {{call,Line, @@ -701,8 +690,8 @@ record_update(R, Name, Fs, Us0, St0) -> record_match(R, Name, Lr, Fs, Us, St0) -> {Ps,News,St1} = record_upd_fs(Fs, Us, St0), - NLr = neg_line(Lr), - RLine = record_offset(Lr, St1), + NLr = no_compiler_warning(Lr), + RLine = mark_record(Lr, St1), {{'case',Lr,R, [{clause,Lr,[{tuple,RLine,[{atom,Lr,Name} | Ps]}],[], [{tuple,RLine,[{atom,Lr,Name} | News]}]}, @@ -733,8 +722,8 @@ record_setel(R, Name, Fs, Us0) -> Us = [T || {_,T} <- Us2], Lr = element(2, hd(Us)), Wildcards = duplicate(length(Fs), {var,Lr,'_'}), - NLr = neg_line(Lr), - %% Note: calling record_offset() here is not necessary since it is + NLr = no_compiler_warning(Lr), + %% Note: calling mark_record() here is not necessary since it is %% targeted at Dialyzer which always calls the compiler with %% 'strict_record_updates' meaning that record_setel() will never %% be called. @@ -832,10 +821,7 @@ add_imports(Mod, [F | Fs], Is) -> add_imports(_, [], Is) -> Is. imported(F, A, St) -> - case orddict:find({F,A}, St#exprec.imports) of - {ok,Mod} -> {yes,Mod}; - error -> no - end. + orddict:is_key({F,A}, St#exprec.imports). %%% %%% Replace is_record/3 in guards with matching if possible. @@ -969,12 +955,11 @@ opt_remove_2({call,Line,{atom,_,is_record}, end; opt_remove_2(A, _) -> A. -neg_line(L) -> - erl_parse:set_line(L, fun(Line) -> -abs(Line) end). +no_compiler_warning(Anno) -> + erl_anno:set_generated(true, Anno). -record_offset(L, St) -> +mark_record(Anno, St) -> case lists:member(dialyzer, St#exprec.compile) of - true when L >= 0 -> L+?REC_OFFSET; - true when L < 0 -> L-?REC_OFFSET; - false -> L + true -> erl_anno:set_record(true, Anno); + false -> Anno end. diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index cbe6eeec3c..821d81a6b4 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -34,6 +34,8 @@ -import(lists, [member/2,map/2,foldl/3,foldr/3,mapfoldl/3,all/2,reverse/1]). +-deprecated([{modify_line, 2, next_major_release}]). + %% bool_option(OnOpt, OffOpt, Default, Options) -> boolean(). %% value_option(Flag, Default, Options) -> Value. %% value_option(Flag, Default, OnOpt, OnVal, OffOpt, OffVal, Options) -> @@ -76,7 +78,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> %%-define(DEBUGF(X,Y), io:format(X, Y)). -define(DEBUGF(X,Y), void). --type line() :: erl_scan:line(). % a convenient alias +-type line() :: erl_anno:line(). % a convenient alias -type fa() :: {atom(), arity()}. % function+arity -type ta() :: {atom(), arity()}. % type+arity @@ -111,7 +113,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> defined=gb_sets:empty() %Defined fuctions :: gb_sets:set(fa()), on_load=[] :: [fa()], %On-load function - on_load_line=0 :: line(), %Line for on_load + on_load_line=erl_anno:new(0) %Line for on_load + :: erl_anno:anno(), clashes=[], %Exported functions named as BIFs not_deprecated=[], %Not considered deprecated func=[], %Current function @@ -140,7 +143,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> -type lint_state() :: #lint{}. -type error_description() :: term(). --type error_info() :: {erl_scan:line(), module(), error_description()}. +-type error_info() :: {erl_anno:line(), module(), error_description()}. %% format_error(Error) %% Return a string describing the error. @@ -227,6 +230,8 @@ format_error({deprecated, MFA, ReplacementMFA, Rel}) -> [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]); format_error({deprecated, {M1, F1, A1}, String}) when is_list(String) -> io_lib:format("~p:~p/~p: ~s", [M1, F1, A1, String]); +format_error({deprecated_type, {M1, F1, A1}, String}) when is_list(String) -> + io_lib:format("~p:~p~s: ~s", [M1, F1, gen_type_paren(A1), String]); format_error({removed, MFA, ReplacementMFA, Rel}) -> io_lib:format("call to ~s will fail, since it was removed in ~s; " "use ~s", [format_mfa(MFA), Rel, format_mfa(ReplacementMFA)]); @@ -425,13 +430,13 @@ exprs(Exprs, BindingsList) -> exprs_opt(Exprs, BindingsList, Opts) -> {St0,Vs} = foldl(fun({{record,_SequenceNumber,_Name},Attr0}, {St1,Vs1}) -> - Attr = zip_file_and_line(Attr0, "none"), + Attr = set_file(Attr0, "none"), {attribute_state(Attr, St1),Vs1}; ({V,_}, {St1,Vs1}) -> {St1,[{V,{bound,unused,[]}} | Vs1]} end, {start("nofile",Opts),[]}, BindingsList), Vt = orddict:from_list(Vs), - {_Evt,St} = exprs(zip_file_and_line(Exprs, "nofile"), Vt, St0), + {_Evt,St} = exprs(set_file(Exprs, "nofile"), Vt, St0), return_status(St). used_vars(Exprs, BindingsList) -> @@ -439,7 +444,7 @@ used_vars(Exprs, BindingsList) -> ({V,_Val}, Vs0) -> [{V,{bound,unused,[]}} | Vs0] end, [], BindingsList), Vt = orddict:from_list(Vs), - {Evt,_St} = exprs(zip_file_and_line(Exprs, "nofile"), Vt, start()), + {Evt,_St} = exprs(set_file(Exprs, "nofile"), Vt, start()), {ok, foldl(fun({V,{_,used,_}}, L) -> [V | L]; (_, L) -> L end, [], Evt)}. @@ -605,8 +610,8 @@ pack_warnings(Ws) -> add_error(E, St) -> St#lint{errors=[{St#lint.file,E}|St#lint.errors]}. -add_error(FileLine, E, St) -> - {File,Location} = loc(FileLine), +add_error(Anno, E, St) -> + {File,Location} = loc(Anno), add_error({Location,erl_lint,E}, St#lint{file = File}). add_warning(W, St) -> St#lint{warnings=[{St#lint.file,W}|St#lint.warnings]}. @@ -615,22 +620,19 @@ add_warning(FileLine, W, St) -> {File,Location} = loc(FileLine), add_warning({Location,erl_lint,W}, St#lint{file = File}). -loc(L) -> - case erl_parse:get_attribute(L, location) of - {location,{{File,Line},Column}} -> - {File,{Line,Column}}; - {location,{File,Line}} -> - {File,Line} - end. +loc(Anno) -> + File = erl_anno:file(Anno), + Location = erl_anno:location(Anno), + {File,Location}. %% forms([Form], State) -> State' forms(Forms0, St0) -> Forms = eval_file_attribute(Forms0, St0), + %% Annotations from now on include the 'file' item. Locals = local_functions(Forms), AutoImportSuppressed = auto_import_suppressed(St0#lint.compile), StDeprecated = disallowed_compile_flags(Forms,St0), - %% Line numbers are from now on pairs {File,Line}. St1 = includes_qlc_hrl(Forms, StDeprecated#lint{locals = Locals, no_auto = AutoImportSuppressed}), St2 = bif_clashes(Forms, St1), @@ -666,15 +668,14 @@ eval_file_attribute(Forms, St) -> eval_file_attr([{attribute,_L,file,{File,_Line}}=Form | Forms], _File) -> [Form | eval_file_attr(Forms, File)]; eval_file_attr([Form0 | Forms], File) -> - Form = zip_file_and_line(Form0, File), + Form = set_file(Form0, File), [Form | eval_file_attr(Forms, File)]; eval_file_attr([], _File) -> []. -zip_file_and_line(T, File) -> - F0 = fun(Line) -> {File,Line} end, - F = fun(L) -> erl_parse:set_line(L, F0) end, - modify_line(T, F). +set_file(T, File) -> + F = fun(Anno) -> erl_anno:set_file(File, Anno) end, + erl_parse:map_anno(F, T). %% form(Form, State) -> State' %% Check a form returning the updated State. Handle generic cases here. @@ -796,9 +797,11 @@ not_deprecated(Forms, St0) -> disallowed_compile_flags(Forms, St0) -> %% There are (still) no line numbers in St0#lint.compile. Errors0 = [ {St0#lint.file,{L,erl_lint,disallowed_nowarn_bif_clash}} || - {attribute,[{line,{_,L}}],compile,nowarn_bif_clash} <- Forms ], + {attribute,A,compile,nowarn_bif_clash} <- Forms, + {_,L} <- [loc(A)] ], Errors1 = [ {St0#lint.file,{L,erl_lint,disallowed_nowarn_bif_clash}} || - {attribute,[{line,{_,L}}],compile,{nowarn_bif_clash, {_,_}}} <- Forms ], + {attribute,A,compile,{nowarn_bif_clash, {_,_}}} <- Forms, + {_,L} <- [loc(A)] ], Disabled = (not is_warn_enabled(bif_clash, St0)), Errors = if Disabled andalso Errors0 =:= [] -> @@ -1299,7 +1302,7 @@ imported(F, A, St) -> error -> no end. --spec on_load(line(), fa(), lint_state()) -> lint_state(). +-spec on_load(erl_anno:anno(), fa(), lint_state()) -> lint_state(). %% Check an on_load directive and remember it. on_load(Line, {Name,Arity}=Fa, #lint{on_load=OnLoad0}=St0) @@ -1954,10 +1957,10 @@ is_guard_test(E) -> is_guard_test(Expression, Forms) -> RecordAttributes = [A || A = {attribute, _, record, _D} <- Forms], St0 = foldl(fun(Attr0, St1) -> - Attr = zip_file_and_line(Attr0, "none"), + Attr = set_file(Attr0, "none"), attribute_state(Attr, St1) end, start(), RecordAttributes), - is_guard_test2(zip_file_and_line(Expression, "nofile"), St0#lint.records). + is_guard_test2(set_file(Expression, "nofile"), St0#lint.records). %% is_guard_test2(Expression, RecordDefs :: dict:dict()) -> boolean(). is_guard_test2({call,Line,{atom,Lr,record},[E,A]}, RDs) -> @@ -2619,7 +2622,7 @@ type_def(_Attr, _Line, {record, _RecName}, Fields, [], St0) -> %% The record field names and such are checked in the record format. %% We only need to check the types. Types = [T || {typed_record_field, _, T} <- Fields], - check_type({type, -1, product, Types}, St0); + check_type({type, nowarn(), product, Types}, St0); type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> TypeDefs = St0#lint.types, Arity = length(Args), @@ -2628,7 +2631,7 @@ type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> StoreType = fun(St) -> NewDefs = dict:store(TypePair, Info, TypeDefs), - CheckType = {type, -1, product, [ProtoType|Args]}, + CheckType = {type, nowarn(), product, [ProtoType|Args]}, check_type(CheckType, St#lint{types=NewDefs}) end, case is_default_type(TypePair) of @@ -2684,7 +2687,9 @@ check_type({ann_type, _L, [_Var, Type]}, SeenVars, St) -> check_type({paren_type, _L, [Type]}, SeenVars, St) -> check_type(Type, SeenVars, St); check_type({remote_type, L, [{atom, _, Mod}, {atom, _, Name}, Args]}, - SeenVars, #lint{module=CurrentMod} = St) -> + SeenVars, St0) -> + St = deprecated_type(L, Mod, Name, Args, St0), + CurrentMod = St#lint.module, case Mod =:= CurrentMod of true -> check_type({user_type, L, Name, Args}, SeenVars, St); false -> @@ -2712,7 +2717,7 @@ check_type({type, L, 'fun', [Dom, Range]}, SeenVars, St) -> {type, _, any} -> St; _ -> add_error(L, {type_syntax, 'fun'}, St) end, - check_type({type, -1, product, [Dom, Range]}, SeenVars, St1); + check_type({type, nowarn(), product, [Dom, Range]}, SeenVars, St1); check_type({type, L, range, [From, To]}, SeenVars, St) -> St1 = case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of @@ -2729,7 +2734,7 @@ check_type({type, _L, map, Pairs}, SeenVars, St) -> check_type(Pair, AccSeenVars, AccSt) end, {SeenVars, St}, Pairs); check_type({type, _L, map_field_assoc, [Dom, Range]}, SeenVars, St) -> - check_type({type, -1, product, [Dom, Range]}, SeenVars, St); + check_type({type, nowarn(), product, [Dom, Range]}, SeenVars, St); check_type({type, _L, tuple, any}, SeenVars, St) -> {SeenVars, St}; check_type({type, _L, any}, SeenVars, St) -> {SeenVars, St}; check_type({type, L, binary, [Base, Unit]}, SeenVars, St) -> @@ -2772,7 +2777,7 @@ check_type({type, La, TypeName, Args}, SeenVars, St) -> end; _ -> St end, - check_type({type, -1, product, Args}, SeenVars, St1); + check_type({type, nowarn(), product, Args}, SeenVars, St1); check_type({user_type, L, TypeName, Args}, SeenVars, St) -> Arity = length(Args), TypePair = {TypeName, Arity}, @@ -2919,11 +2924,16 @@ check_specs([FunType|Left], Arity, St0) -> true -> St0; false -> add_error(L, spec_wrong_arity, St0) end, - St2 = check_type({type, -1, product, [FunType1|CTypes]}, St1), + St2 = check_type({type, nowarn(), product, [FunType1|CTypes]}, St1), check_specs(Left, Arity, St2); check_specs([], _Arity, St) -> St. +nowarn() -> + A0 = erl_anno:new(0), + A1 = erl_anno:set_generated(true, A0), + erl_anno:set_file("", A1). + check_specs_without_function(#lint{module=Mod,defined=Funcs,specs=Specs}=St) -> Fun = fun({M, F, A}, Line, AccSt) when M =:= Mod -> FA = {F, A}, @@ -3452,58 +3462,15 @@ vt_no_unused(Vt) -> [V || {_,{_,U,_L}}=V <- Vt, U =/= unused]. %% copy_expr(Expr, Line) -> Expr. %% Make a copy of Expr converting all line numbers to Line. -copy_expr(Expr, Line) -> - modify_line(Expr, fun(_L) -> Line end). +copy_expr(Expr, Anno) -> + erl_parse:map_anno(fun(_A) -> Anno end, Expr). %% modify_line(Form, Fun) -> Form %% modify_line(Expression, Fun) -> Expression %% Applies Fun to each line number occurrence. modify_line(T, F0) -> - modify_line1(T, F0). - -%% Forms. -modify_line1({function,F,A}, _Mf) -> {function,F,A}; -modify_line1({function,M,F,A}, Mf) -> - {function,modify_line1(M, Mf),modify_line1(F, Mf),modify_line1(A, Mf)}; -modify_line1({attribute,L,record,{Name,Fields}}, Mf) -> - {attribute,Mf(L),record,{Name,modify_line1(Fields, Mf)}}; -modify_line1({attribute,L,spec,{Fun,Types}}, Mf) -> - {attribute,Mf(L),spec,{Fun,modify_line1(Types, Mf)}}; -modify_line1({attribute,L,callback,{Fun,Types}}, Mf) -> - {attribute,Mf(L),callback,{Fun,modify_line1(Types, Mf)}}; -modify_line1({attribute,L,type,{TypeName,TypeDef,Args}}, Mf) -> - {attribute,Mf(L),type,{TypeName,modify_line1(TypeDef, Mf), - modify_line1(Args, Mf)}}; -modify_line1({attribute,L,opaque,{TypeName,TypeDef,Args}}, Mf) -> - {attribute,Mf(L),opaque,{TypeName,modify_line1(TypeDef, Mf), - modify_line1(Args, Mf)}}; -modify_line1({attribute,L,Attr,Val}, Mf) -> {attribute,Mf(L),Attr,Val}; -modify_line1({warning,W}, _Mf) -> {warning,W}; -modify_line1({error,W}, _Mf) -> {error,W}; -%% Expressions. -modify_line1({clauses,Cs}, Mf) -> {clauses,modify_line1(Cs, Mf)}; -modify_line1({typed_record_field,Field,Type}, Mf) -> - {typed_record_field,modify_line1(Field, Mf),modify_line1(Type, Mf)}; -modify_line1({Tag,L}, Mf) -> {Tag,Mf(L)}; -modify_line1({Tag,L,E1}, Mf) -> - {Tag,Mf(L),modify_line1(E1, Mf)}; -modify_line1({Tag,L,E1,E2}, Mf) -> - {Tag,Mf(L),modify_line1(E1, Mf),modify_line1(E2, Mf)}; -modify_line1({bin_element,L,E1,E2,TSL}, Mf) -> - {bin_element,Mf(L),modify_line1(E1, Mf),modify_line1(E2, Mf), TSL}; -modify_line1({Tag,L,E1,E2,E3}, Mf) -> - {Tag,Mf(L),modify_line1(E1, Mf),modify_line1(E2, Mf),modify_line1(E3, Mf)}; -modify_line1({Tag,L,E1,E2,E3,E4}, Mf) -> - {Tag,Mf(L), - modify_line1(E1, Mf), - modify_line1(E2, Mf), - modify_line1(E3, Mf), - modify_line1(E4, Mf)}; -modify_line1([H|T], Mf) -> - [modify_line1(H, Mf)|modify_line1(T, Mf)]; -modify_line1([], _Mf) -> []; -modify_line1(E, _Mf) when not is_tuple(E), not is_list(E) -> E. + erl_parse:map_anno(F0, T). %% Check a record_info call. We have already checked that it is not %% shadowed by an import. @@ -3573,6 +3540,20 @@ deprecated_function(Line, M, F, As, St) -> St end. +deprecated_type(L, M, N, As, St) -> + NAs = length(As), + case otp_internal:obsolete_type(M, N, NAs) of + {deprecated, String} when is_list(String) -> + case is_warn_enabled(deprecated_type, St) of + true -> + add_warning(L, {deprecated_type, {M,N,NAs}, String}, St); + false -> + St + end; + no -> + St + end. + obsolete_guard({call,Line,{atom,Lr,F},As}, St0) -> Arity = length(As), case erl_internal:old_type_test(F, Arity) of diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 3502a50eaa..e328e065e3 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -92,7 +92,7 @@ spec_fun -> atom ':' atom '/' integer '::' : {'$1', '$3', '$5'}. typed_attr_val -> expr ',' typed_record_fields : {typed_record, '$1', '$3'}. typed_attr_val -> expr '::' top_type : {type_def, '$1', '$3'}. -typed_record_fields -> '{' typed_exprs '}' : {tuple, ?line('$1'), '$2'}. +typed_record_fields -> '{' typed_exprs '}' : {tuple, ?anno('$1'), '$2'}. typed_exprs -> typed_expr : ['$1']. typed_exprs -> typed_expr ',' typed_exprs : ['$1'|'$3']. @@ -105,26 +105,26 @@ type_sigs -> type_sig : ['$1']. type_sigs -> type_sig ';' type_sigs : ['$1'|'$3']. type_sig -> fun_type : '$1'. -type_sig -> fun_type 'when' type_guards : {type, ?line('$1'), bounded_fun, +type_sig -> fun_type 'when' type_guards : {type, ?anno('$1'), bounded_fun, ['$1','$3']}. type_guards -> type_guard : ['$1']. type_guards -> type_guard ',' type_guards : ['$1'|'$3']. -type_guard -> atom '(' top_types ')' : {type, ?line('$1'), constraint, +type_guard -> atom '(' top_types ')' : {type, ?anno('$1'), constraint, ['$1', '$3']}. type_guard -> var '::' top_type : build_def('$1', '$3'). top_types -> top_type : ['$1']. top_types -> top_type ',' top_types : ['$1'|'$3']. -top_type -> var '::' top_type_100 : {ann_type, ?line('$1'), ['$1','$3']}. +top_type -> var '::' top_type_100 : {ann_type, ?anno('$1'), ['$1','$3']}. top_type -> top_type_100 : '$1'. top_type_100 -> type_200 : '$1'. top_type_100 -> type_200 '|' top_type_100 : lift_unions('$1','$3'). -type_200 -> type_300 '..' type_300 : {type, ?line('$1'), range, +type_200 -> type_300 '..' type_300 : {type, ?anno('$1'), range, [skip_paren('$1'), skip_paren('$3')]}. type_200 -> type_300 : '$1'. @@ -140,61 +140,61 @@ type_400 -> type_500 : '$1'. type_500 -> prefix_op type : ?mkop1('$1', skip_paren('$2')). type_500 -> type : '$1'. -type -> '(' top_type ')' : {paren_type, ?line('$2'), ['$2']}. +type -> '(' top_type ')' : {paren_type, ?anno('$2'), ['$2']}. type -> var : '$1'. type -> atom : '$1'. type -> atom '(' ')' : build_gen_type('$1'). type -> atom '(' top_types ')' : build_type('$1', '$3'). -type -> atom ':' atom '(' ')' : {remote_type, ?line('$1'), +type -> atom ':' atom '(' ')' : {remote_type, ?anno('$1'), ['$1', '$3', []]}. -type -> atom ':' atom '(' top_types ')' : {remote_type, ?line('$1'), +type -> atom ':' atom '(' top_types ')' : {remote_type, ?anno('$1'), ['$1', '$3', '$5']}. -type -> '[' ']' : {type, ?line('$1'), nil, []}. -type -> '[' top_type ']' : {type, ?line('$1'), list, ['$2']}. -type -> '[' top_type ',' '...' ']' : {type, ?line('$1'), +type -> '[' ']' : {type, ?anno('$1'), nil, []}. +type -> '[' top_type ']' : {type, ?anno('$1'), list, ['$2']}. +type -> '[' top_type ',' '...' ']' : {type, ?anno('$1'), nonempty_list, ['$2']}. -type -> '#' '{' '}' : {type, ?line('$1'), map, []}. -type -> '#' '{' map_pair_types '}' : {type, ?line('$1'), map, '$3'}. -type -> '{' '}' : {type, ?line('$1'), tuple, []}. -type -> '{' top_types '}' : {type, ?line('$1'), tuple, '$2'}. -type -> '#' atom '{' '}' : {type, ?line('$1'), record, ['$2']}. -type -> '#' atom '{' field_types '}' : {type, ?line('$1'), +type -> '#' '{' '}' : {type, ?anno('$1'), map, []}. +type -> '#' '{' map_pair_types '}' : {type, ?anno('$1'), map, '$3'}. +type -> '{' '}' : {type, ?anno('$1'), tuple, []}. +type -> '{' top_types '}' : {type, ?anno('$1'), tuple, '$2'}. +type -> '#' atom '{' '}' : {type, ?anno('$1'), record, ['$2']}. +type -> '#' atom '{' field_types '}' : {type, ?anno('$1'), record, ['$2'|'$4']}. type -> binary_type : '$1'. type -> integer : '$1'. -type -> 'fun' '(' ')' : {type, ?line('$1'), 'fun', []}. +type -> 'fun' '(' ')' : {type, ?anno('$1'), 'fun', []}. type -> 'fun' '(' fun_type_100 ')' : '$3'. fun_type_100 -> '(' '...' ')' '->' top_type - : {type, ?line('$1'), 'fun', - [{type, ?line('$1'), any}, '$5']}. + : {type, ?anno('$1'), 'fun', + [{type, ?anno('$1'), any}, '$5']}. fun_type_100 -> fun_type : '$1'. -fun_type -> '(' ')' '->' top_type : {type, ?line('$1'), 'fun', - [{type, ?line('$1'), product, []}, '$4']}. +fun_type -> '(' ')' '->' top_type : {type, ?anno('$1'), 'fun', + [{type, ?anno('$1'), product, []}, '$4']}. fun_type -> '(' top_types ')' '->' top_type - : {type, ?line('$1'), 'fun', - [{type, ?line('$1'), product, '$2'},'$5']}. + : {type, ?anno('$1'), 'fun', + [{type, ?anno('$1'), product, '$2'},'$5']}. map_pair_types -> map_pair_type : ['$1']. map_pair_types -> map_pair_type ',' map_pair_types : ['$1'|'$3']. -map_pair_type -> top_type '=>' top_type : {type, ?line('$2'), map_field_assoc,['$1','$3']}. +map_pair_type -> top_type '=>' top_type : {type, ?anno('$2'), map_field_assoc,['$1','$3']}. field_types -> field_type : ['$1']. field_types -> field_type ',' field_types : ['$1'|'$3']. -field_type -> atom '::' top_type : {type, ?line('$1'), field_type, +field_type -> atom '::' top_type : {type, ?anno('$1'), field_type, ['$1', '$3']}. -binary_type -> '<<' '>>' : {type, ?line('$1'),binary, - [abstract(0, ?line('$1')), - abstract(0, ?line('$1'))]}. -binary_type -> '<<' bin_base_type '>>' : {type, ?line('$1'),binary, - ['$2', abstract(0, ?line('$1'))]}. -binary_type -> '<<' bin_unit_type '>>' : {type, ?line('$1'),binary, - [abstract(0, ?line('$1')), '$2']}. +binary_type -> '<<' '>>' : {type, ?anno('$1'),binary, + [abstract2(0, ?anno('$1')), + abstract2(0, ?anno('$1'))]}. +binary_type -> '<<' bin_base_type '>>' : {type, ?anno('$1'),binary, + ['$2', abstract2(0, ?anno('$1'))]}. +binary_type -> '<<' bin_unit_type '>>' : {type, ?anno('$1'),binary, + [abstract2(0, ?anno('$1')), '$2']}. binary_type -> '<<' bin_base_type ',' bin_unit_type '>>' - : {type, ?line('$1'), binary, ['$2', '$4']}. + : {type, ?anno('$1'), binary, ['$2', '$4']}. bin_base_type -> var ':' type : build_bin_type(['$1'], '$3'). @@ -210,7 +210,7 @@ function_clauses -> function_clause : ['$1']. function_clauses -> function_clause ';' function_clauses : ['$1'|'$3']. function_clause -> atom clause_args clause_guard clause_body : - {clause,?line('$1'),element(3, '$1'),'$2','$3','$4'}. + {clause,?anno('$1'),element(3, '$1'),'$2','$3','$4'}. clause_args -> argument_list : element(1, '$1'). @@ -221,10 +221,10 @@ clause_guard -> '$empty' : []. clause_body -> '->' exprs: '$2'. -expr -> 'catch' expr : {'catch',?line('$1'),'$2'}. +expr -> 'catch' expr : {'catch',?anno('$1'),'$2'}. expr -> expr_100 : '$1'. -expr_100 -> expr_150 '=' expr_100 : {match,?line('$2'),'$1','$3'}. +expr_100 -> expr_150 '=' expr_100 : {match,?anno('$2'),'$1','$3'}. expr_100 -> expr_150 '!' expr_100 : ?mkop2('$1', '$2', '$3'). expr_100 -> expr_150 : '$1'. @@ -260,7 +260,7 @@ expr_700 -> record_expr : '$1'. expr_700 -> expr_800 : '$1'. expr_800 -> expr_max ':' expr_max : - {remote,?line('$2'),'$1','$3'}. + {remote,?anno('$2'),'$1','$3'}. expr_800 -> expr_max : '$1'. expr_max -> var : '$1'. @@ -272,7 +272,7 @@ expr_max -> binary_comprehension : '$1'. expr_max -> tuple : '$1'. %%expr_max -> struct : '$1'. expr_max -> '(' expr ')' : '$2'. -expr_max -> 'begin' exprs 'end' : {block,?line('$1'),'$2'}. +expr_max -> 'begin' exprs 'end' : {block,?anno('$1'),'$2'}. expr_max -> if_expr : '$1'. expr_max -> case_expr : '$1'. expr_max -> receive_expr : '$1'. @@ -280,22 +280,22 @@ expr_max -> fun_expr : '$1'. expr_max -> try_expr : '$1'. -list -> '[' ']' : {nil,?line('$1')}. -list -> '[' expr tail : {cons,?line('$1'),'$2','$3'}. +list -> '[' ']' : {nil,?anno('$1')}. +list -> '[' expr tail : {cons,?anno('$1'),'$2','$3'}. -tail -> ']' : {nil,?line('$1')}. +tail -> ']' : {nil,?anno('$1')}. tail -> '|' expr ']' : '$2'. -tail -> ',' expr tail : {cons,?line('$2'),'$2','$3'}. +tail -> ',' expr tail : {cons,?anno('$2'),'$2','$3'}. -binary -> '<<' '>>' : {bin,?line('$1'),[]}. -binary -> '<<' bin_elements '>>' : {bin,?line('$1'),'$2'}. +binary -> '<<' '>>' : {bin,?anno('$1'),[]}. +binary -> '<<' bin_elements '>>' : {bin,?anno('$1'),'$2'}. bin_elements -> bin_element : ['$1']. bin_elements -> bin_element ',' bin_elements : ['$1'|'$3']. bin_element -> bit_expr opt_bit_size_expr opt_bit_type_list : - {bin_element,?line('$1'),'$1','$2','$3'}. + {bin_element,?anno('$1'),'$1','$2','$3'}. bit_expr -> prefix_op expr_max : ?mkop1('$1', '$2'). bit_expr -> expr_max : '$1'. @@ -316,29 +316,29 @@ bit_size_expr -> expr_max : '$1'. list_comprehension -> '[' expr '||' lc_exprs ']' : - {lc,?line('$1'),'$2','$4'}. + {lc,?anno('$1'),'$2','$4'}. binary_comprehension -> '<<' binary '||' lc_exprs '>>' : - {bc,?line('$1'),'$2','$4'}. + {bc,?anno('$1'),'$2','$4'}. lc_exprs -> lc_expr : ['$1']. lc_exprs -> lc_expr ',' lc_exprs : ['$1'|'$3']. lc_expr -> expr : '$1'. -lc_expr -> expr '<-' expr : {generate,?line('$2'),'$1','$3'}. -lc_expr -> binary '<=' expr : {b_generate,?line('$2'),'$1','$3'}. +lc_expr -> expr '<-' expr : {generate,?anno('$2'),'$1','$3'}. +lc_expr -> binary '<=' expr : {b_generate,?anno('$2'),'$1','$3'}. -tuple -> '{' '}' : {tuple,?line('$1'),[]}. -tuple -> '{' exprs '}' : {tuple,?line('$1'),'$2'}. +tuple -> '{' '}' : {tuple,?anno('$1'),[]}. +tuple -> '{' exprs '}' : {tuple,?anno('$1'),'$2'}. %%struct -> atom tuple : -%% {struct,?line('$1'),element(3, '$1'),element(3, '$2')}. +%% {struct,?anno('$1'),element(3, '$1'),element(3, '$2')}. map_expr -> '#' map_tuple : - {map, ?line('$1'),'$2'}. + {map, ?anno('$1'),'$2'}. map_expr -> expr_max '#' map_tuple : - {map, ?line('$2'),'$1','$3'}. + {map, ?anno('$2'),'$1','$3'}. map_expr -> map_expr '#' map_tuple : - {map, ?line('$2'),'$1','$3'}. + {map, ?anno('$2'),'$1','$3'}. map_tuple -> '{' '}' : []. map_tuple -> '{' map_fields '}' : '$2'. @@ -350,10 +350,10 @@ map_field -> map_field_assoc : '$1'. map_field -> map_field_exact : '$1'. map_field_assoc -> map_key '=>' expr : - {map_field_assoc,?line('$1'),'$1','$3'}. + {map_field_assoc,?anno('$1'),'$1','$3'}. map_field_exact -> map_key ':=' expr : - {map_field_exact,?line('$1'),'$1','$3'}. + {map_field_exact,?anno('$1'),'$1','$3'}. map_key -> expr : '$1'. @@ -363,17 +363,17 @@ map_key -> expr : '$1'. %% always atoms for the moment, this might change in the future. record_expr -> '#' atom '.' atom : - {record_index,?line('$1'),element(3, '$2'),'$4'}. + {record_index,?anno('$1'),element(3, '$2'),'$4'}. record_expr -> '#' atom record_tuple : - {record,?line('$1'),element(3, '$2'),'$3'}. + {record,?anno('$1'),element(3, '$2'),'$3'}. record_expr -> expr_max '#' atom '.' atom : - {record_field,?line('$2'),'$1',element(3, '$3'),'$5'}. + {record_field,?anno('$2'),'$1',element(3, '$3'),'$5'}. record_expr -> expr_max '#' atom record_tuple : - {record,?line('$2'),'$1',element(3, '$3'),'$4'}. + {record,?anno('$2'),'$1',element(3, '$3'),'$4'}. record_expr -> record_expr '#' atom '.' atom : - {record_field,?line('$2'),'$1',element(3, '$3'),'$5'}. + {record_field,?anno('$2'),'$1',element(3, '$3'),'$5'}. record_expr -> record_expr '#' atom record_tuple : - {record,?line('$2'),'$1',element(3, '$3'),'$4'}. + {record,?anno('$2'),'$1',element(3, '$3'),'$4'}. record_tuple -> '{' '}' : []. record_tuple -> '{' record_fields '}' : '$2'. @@ -381,47 +381,47 @@ record_tuple -> '{' record_fields '}' : '$2'. record_fields -> record_field : ['$1']. record_fields -> record_field ',' record_fields : ['$1' | '$3']. -record_field -> var '=' expr : {record_field,?line('$1'),'$1','$3'}. -record_field -> atom '=' expr : {record_field,?line('$1'),'$1','$3'}. +record_field -> var '=' expr : {record_field,?anno('$1'),'$1','$3'}. +record_field -> atom '=' expr : {record_field,?anno('$1'),'$1','$3'}. %% N.B. This is called from expr_700. function_call -> expr_800 argument_list : - {call,?line('$1'),'$1',element(1, '$2')}. + {call,?anno('$1'),'$1',element(1, '$2')}. -if_expr -> 'if' if_clauses 'end' : {'if',?line('$1'),'$2'}. +if_expr -> 'if' if_clauses 'end' : {'if',?anno('$1'),'$2'}. if_clauses -> if_clause : ['$1']. if_clauses -> if_clause ';' if_clauses : ['$1' | '$3']. if_clause -> guard clause_body : - {clause,?line(hd(hd('$1'))),[],'$1','$2'}. + {clause,?anno(hd(hd('$1'))),[],'$1','$2'}. case_expr -> 'case' expr 'of' cr_clauses 'end' : - {'case',?line('$1'),'$2','$4'}. + {'case',?anno('$1'),'$2','$4'}. cr_clauses -> cr_clause : ['$1']. cr_clauses -> cr_clause ';' cr_clauses : ['$1' | '$3']. cr_clause -> expr clause_guard clause_body : - {clause,?line('$1'),['$1'],'$2','$3'}. + {clause,?anno('$1'),['$1'],'$2','$3'}. receive_expr -> 'receive' cr_clauses 'end' : - {'receive',?line('$1'),'$2'}. + {'receive',?anno('$1'),'$2'}. receive_expr -> 'receive' 'after' expr clause_body 'end' : - {'receive',?line('$1'),[],'$3','$4'}. + {'receive',?anno('$1'),[],'$3','$4'}. receive_expr -> 'receive' cr_clauses 'after' expr clause_body 'end' : - {'receive',?line('$1'),'$2','$4','$5'}. + {'receive',?anno('$1'),'$2','$4','$5'}. fun_expr -> 'fun' atom '/' integer : - {'fun',?line('$1'),{function,element(3, '$2'),element(3, '$4')}}. + {'fun',?anno('$1'),{function,element(3, '$2'),element(3, '$4')}}. fun_expr -> 'fun' atom_or_var ':' atom_or_var '/' integer_or_var : - {'fun',?line('$1'),{function,'$2','$4','$6'}}. + {'fun',?anno('$1'),{function,'$2','$4','$6'}}. fun_expr -> 'fun' fun_clauses 'end' : - build_fun(?line('$1'), '$2'). + build_fun(?anno('$1'), '$2'). atom_or_var -> atom : '$1'. atom_or_var -> var : '$1'. @@ -433,16 +433,16 @@ fun_clauses -> fun_clause : ['$1']. fun_clauses -> fun_clause ';' fun_clauses : ['$1' | '$3']. fun_clause -> argument_list clause_guard clause_body : - {Args,Pos} = '$1', - {clause,Pos,'fun',Args,'$2','$3'}. + {Args,Anno} = '$1', + {clause,Anno,'fun',Args,'$2','$3'}. fun_clause -> var argument_list clause_guard clause_body : {clause,element(2, '$1'),element(3, '$1'),element(1, '$2'),'$3','$4'}. try_expr -> 'try' exprs 'of' cr_clauses try_catch : - build_try(?line('$1'),'$2','$4','$5'). + build_try(?anno('$1'),'$2','$4','$5'). try_expr -> 'try' exprs try_catch : - build_try(?line('$1'),'$2',[],'$3'). + build_try(?anno('$1'),'$2',[],'$3'). try_catch -> 'catch' try_clauses 'end' : {'$2',[]}. @@ -455,18 +455,18 @@ try_clauses -> try_clause : ['$1']. try_clauses -> try_clause ';' try_clauses : ['$1' | '$3']. try_clause -> expr clause_guard clause_body : - L = ?line('$1'), - {clause,L,[{tuple,L,[{atom,L,throw},'$1',{var,L,'_'}]}],'$2','$3'}. + A = ?anno('$1'), + {clause,A,[{tuple,A,[{atom,A,throw},'$1',{var,A,'_'}]}],'$2','$3'}. try_clause -> atom ':' expr clause_guard clause_body : - L = ?line('$1'), - {clause,L,[{tuple,L,['$1','$3',{var,L,'_'}]}],'$4','$5'}. + A = ?anno('$1'), + {clause,A,[{tuple,A,['$1','$3',{var,A,'_'}]}],'$4','$5'}. try_clause -> var ':' expr clause_guard clause_body : - L = ?line('$1'), - {clause,L,[{tuple,L,['$1','$3',{var,L,'_'}]}],'$4','$5'}. + A = ?anno('$1'), + {clause,A,[{tuple,A,['$1','$3',{var,A,'_'}]}],'$4','$5'}. -argument_list -> '(' ')' : {[],?line('$1')}. -argument_list -> '(' exprs ')' : {'$2',?line('$1')}. +argument_list -> '(' ')' : {[],?anno('$1')}. +argument_list -> '(' exprs ')' : {'$2',?anno('$1')}. exprs -> expr : ['$1']. @@ -483,7 +483,7 @@ atomic -> strings : '$1'. strings -> string : '$1'. strings -> string strings : - {string,?line('$1'),element(3, '$1') ++ element(3, '$2')}. + {string,?anno('$1'),element(3, '$1') ++ element(3, '$2')}. prefix_op -> '+' : '$1'. prefix_op -> '-' : '$1'. @@ -524,8 +524,14 @@ Erlang code. -export([normalise/1,abstract/1,tokens/1,tokens/2]). -export([abstract/2]). -export([inop_prec/1,preop_prec/1,func_prec/0,max_prec/0]). +-export([map_anno/2, fold_anno/3, mapfold_anno/3, + new_anno/1, anno_to_term/1, anno_from_term/1]). -export([set_line/2,get_attribute/2,get_attributes/1]). +-deprecated([{set_line, 2, next_major_release}, + {get_attribute, 2, next_major_release}, + {get_attributes, 1, next_major_release}]). + %% The following directive is needed for (significantly) faster compilation %% of the generated .erl file by the HiPE compiler. Please do not remove. -compile([{hipe,[{regalloc,linear_scan}]}]). @@ -533,30 +539,31 @@ Erlang code. -export_type([abstract_clause/0, abstract_expr/0, abstract_form/0, error_info/0]). +%% XXX. To be refined. -type abstract_clause() :: term(). -type abstract_expr() :: term(). -type abstract_form() :: term(). -type error_description() :: term(). --type error_info() :: {erl_scan:line(), module(), error_description()}. +-type error_info() :: {erl_anno:line(), module(), error_description()}. -type token() :: erl_scan:token(). -%% mkop(Op, Arg) -> {op,Line,Op,Arg}. -%% mkop(Left, Op, Right) -> {op,Line,Op,Left,Right}. +%% mkop(Op, Arg) -> {op,Anno,Op,Arg}. +%% mkop(Left, Op, Right) -> {op,Anno,Op,Left,Right}. --define(mkop2(L, OpPos, R), +-define(mkop2(L, OpAnno, R), begin - {Op,Pos} = OpPos, - {op,Pos,Op,L,R} + {Op,Anno} = OpAnno, + {op,Anno,Op,L,R} end). --define(mkop1(OpPos, A), +-define(mkop1(OpAnno, A), begin - {Op,Pos} = OpPos, - {op,Pos,Op,A} + {Op,Anno} = OpAnno, + {op,Anno,Op,A} end). -%% keep track of line info in tokens --define(line(Tup), element(2, Tup)). +%% keep track of annotation info in tokens +-define(anno(Tup), element(2, Tup)). %% Entry points compatible to old erl_parse. %% These really suck and are only here until Calle gets multiple @@ -566,10 +573,10 @@ Erlang code. Tokens :: [token()], AbsForm :: abstract_form(), ErrorInfo :: error_info(). -parse_form([{'-',L1},{atom,L2,spec}|Tokens]) -> - parse([{'-',L1},{'spec',L2}|Tokens]); -parse_form([{'-',L1},{atom,L2,callback}|Tokens]) -> - parse([{'-',L1},{'callback',L2}|Tokens]); +parse_form([{'-',A1},{atom,A2,spec}|Tokens]) -> + parse([{'-',A1},{'spec',A2}|Tokens]); +parse_form([{'-',A1},{atom,A2,callback}|Tokens]) -> + parse([{'-',A1},{'callback',A2}|Tokens]); parse_form(Tokens) -> parse(Tokens). @@ -578,7 +585,8 @@ parse_form(Tokens) -> ExprList :: [abstract_expr()], ErrorInfo :: error_info(). parse_exprs(Tokens) -> - case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of + A = erl_anno:new(0), + case parse([{atom,A,f},{'(',A},{')',A},{'->',A}|Tokens]) of {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],Exprs}]}} -> {ok,Exprs}; {error,_} = Err -> Err @@ -589,42 +597,43 @@ parse_exprs(Tokens) -> Term :: term(), ErrorInfo :: error_info(). parse_term(Tokens) -> - case parse([{atom,0,f},{'(',0},{')',0},{'->',0}|Tokens]) of - {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[Expr]}]}} -> + A = erl_anno:new(0), + case parse([{atom,A,f},{'(',A},{')',A},{'->',A}|Tokens]) of + {ok,{function,_Af,f,0,[{clause,_Ac,[],[],[Expr]}]}} -> try normalise(Expr) of Term -> {ok,Term} catch - _:_R -> {error,{?line(Expr),?MODULE,"bad term"}} + _:_R -> {error,{location(?anno(Expr)),?MODULE,"bad term"}} end; - {ok,{function,_Lf,f,0,[{clause,_Lc,[],[],[_E1,E2|_Es]}]}} -> - {error,{?line(E2),?MODULE,"bad term"}}; + {ok,{function,_Af,f,A,[{clause,_Ac,[],[],[_E1,E2|_Es]}]}} -> + {error,{location(?anno(E2)),?MODULE,"bad term"}}; {error,_} = Err -> Err end. -type attributes() :: 'export' | 'file' | 'import' | 'module' | 'opaque' | 'record' | 'type'. -build_typed_attribute({atom,La,record}, - {typed_record, {atom,_Ln,RecordName}, RecTuple}) -> - {attribute,La,record,{RecordName,record_tuple(RecTuple)}}; -build_typed_attribute({atom,La,Attr}, +build_typed_attribute({atom,Aa,record}, + {typed_record, {atom,_An,RecordName}, RecTuple}) -> + {attribute,Aa,record,{RecordName,record_tuple(RecTuple)}}; +build_typed_attribute({atom,Aa,Attr}, {type_def, {call,_,{atom,_,TypeName},Args}, Type}) when Attr =:= 'type' ; Attr =:= 'opaque' -> case lists:all(fun({var, _, _}) -> true; (_) -> false end, Args) of - true -> {attribute,La,Attr,{TypeName,Type,Args}}; - false -> error_bad_decl(La, Attr) + true -> {attribute,Aa,Attr,{TypeName,Type,Args}}; + false -> error_bad_decl(Aa, Attr) end; -build_typed_attribute({atom,La,Attr},_) -> +build_typed_attribute({atom,Aa,Attr},_) -> case Attr of - record -> error_bad_decl(La, record); - type -> error_bad_decl(La, type); - opaque -> error_bad_decl(La, opaque); - _ -> ret_err(La, "bad attribute") + record -> error_bad_decl(Aa, record); + type -> error_bad_decl(Aa, type); + opaque -> error_bad_decl(Aa, opaque); + _ -> ret_err(Aa, "bad attribute") end. -build_type_spec({Kind,La}, {SpecFun, TypeSpecs}) +build_type_spec({Kind,Aa}, {SpecFun, TypeSpecs}) when (Kind =:= spec) or (Kind =:= callback) -> NewSpecFun = case SpecFun of @@ -639,7 +648,7 @@ build_type_spec({Kind,La}, {SpecFun, TypeSpecs}) %% Old style spec. Allow this for now. {Mod,Fun,Arity} end, - {attribute,La,Kind,{NewSpecFun, TypeSpecs}}. + {attribute,Aa,Kind,{NewSpecFun, TypeSpecs}}. find_arity_from_specs([Spec|_]) -> %% Use the first spec to find the arity. If all are not the same, @@ -651,40 +660,40 @@ find_arity_from_specs([Spec|_]) -> {type, _, 'fun', [{type, _, product, Args},_]} = Fun, length(Args). -build_def({var, L, '_'}, _Types) -> - ret_err(L, "bad type variable"); +build_def({var, A, '_'}, _Types) -> + ret_err(A, "bad type variable"); build_def(LHS, Types) -> - IsSubType = {atom, ?line(LHS), is_subtype}, - {type, ?line(LHS), constraint, [IsSubType, [LHS, Types]]}. + IsSubType = {atom, ?anno(LHS), is_subtype}, + {type, ?anno(LHS), constraint, [IsSubType, [LHS, Types]]}. -lift_unions(T1, {type, _La, union, List}) -> - {type, ?line(T1), union, [T1|List]}; +lift_unions(T1, {type, _Aa, union, List}) -> + {type, ?anno(T1), union, [T1|List]}; lift_unions(T1, T2) -> - {type, ?line(T1), union, [T1, T2]}. + {type, ?anno(T1), union, [T1, T2]}. -skip_paren({paren_type,_L,[Type]}) -> +skip_paren({paren_type,_A,[Type]}) -> skip_paren(Type); skip_paren(Type) -> Type. -build_gen_type({atom, La, tuple}) -> - {type, La, tuple, any}; -build_gen_type({atom, La, map}) -> - {type, La, map, any}; -build_gen_type({atom, La, Name}) -> +build_gen_type({atom, Aa, tuple}) -> + {type, Aa, tuple, any}; +build_gen_type({atom, Aa, map}) -> + {type, Aa, map, any}; +build_gen_type({atom, Aa, Name}) -> Tag = type_tag(Name, 0), - {Tag, La, Name, []}. + {Tag, Aa, Name, []}. build_bin_type([{var, _, '_'}|Left], Int) -> build_bin_type(Left, Int); build_bin_type([], Int) -> skip_paren(Int); -build_bin_type([{var, La, _}|_], _) -> - ret_err(La, "Bad binary type"). +build_bin_type([{var, Aa, _}|_], _) -> + ret_err(Aa, "Bad binary type"). -build_type({atom, L, Name}, Types) -> +build_type({atom, A, Name}, Types) -> Tag = type_tag(Name, length(Types)), - {Tag, L, Name, Types}. + {Tag, A, Name, Types}. type_tag(TypeName, NumberOfTypeVariables) -> case erl_internal:is_type(TypeName, NumberOfTypeVariables) of @@ -692,71 +701,75 @@ type_tag(TypeName, NumberOfTypeVariables) -> false -> user_type end. +abstract2(Term, Anno) -> + Line = erl_anno:line(Anno), + abstract(Term, Line). + %% build_attribute(AttrName, AttrValue) -> -%% {attribute,Line,module,Module} -%% {attribute,Line,export,Exports} -%% {attribute,Line,import,Imports} -%% {attribute,Line,record,{Name,Inits}} -%% {attribute,Line,file,{Name,Line}} -%% {attribute,Line,Name,Val} - -build_attribute({atom,La,module}, Val) -> +%% {attribute,Anno,module,Module} +%% {attribute,Anno,export,Exports} +%% {attribute,Anno,import,Imports} +%% {attribute,Anno,record,{Name,Inits}} +%% {attribute,Anno,file,{Name,Line}} +%% {attribute,Anno,Name,Val} + +build_attribute({atom,Aa,module}, Val) -> case Val of - [{atom,_Lm,Module}] -> - {attribute,La,module,Module}; - [{atom,_Lm,Module},ExpList] -> - {attribute,La,module,{Module,var_list(ExpList)}}; + [{atom,_Am,Module}] -> + {attribute,Aa,module,Module}; + [{atom,_Am,Module},ExpList] -> + {attribute,Aa,module,{Module,var_list(ExpList)}}; _Other -> - error_bad_decl(La, module) + error_bad_decl(Aa, module) end; -build_attribute({atom,La,export}, Val) -> +build_attribute({atom,Aa,export}, Val) -> case Val of [ExpList] -> - {attribute,La,export,farity_list(ExpList)}; - _Other -> error_bad_decl(La, export) + {attribute,Aa,export,farity_list(ExpList)}; + _Other -> error_bad_decl(Aa, export) end; -build_attribute({atom,La,import}, Val) -> +build_attribute({atom,Aa,import}, Val) -> case Val of - [{atom,_Lm,Mod},ImpList] -> - {attribute,La,import,{Mod,farity_list(ImpList)}}; - _Other -> error_bad_decl(La, import) + [{atom,_Am,Mod},ImpList] -> + {attribute,Aa,import,{Mod,farity_list(ImpList)}}; + _Other -> error_bad_decl(Aa, import) end; -build_attribute({atom,La,record}, Val) -> +build_attribute({atom,Aa,record}, Val) -> case Val of - [{atom,_Ln,Record},RecTuple] -> - {attribute,La,record,{Record,record_tuple(RecTuple)}}; - _Other -> error_bad_decl(La, record) + [{atom,_An,Record},RecTuple] -> + {attribute,Aa,record,{Record,record_tuple(RecTuple)}}; + _Other -> error_bad_decl(Aa, record) end; -build_attribute({atom,La,file}, Val) -> +build_attribute({atom,Aa,file}, Val) -> case Val of - [{string,_Ln,Name},{integer,_Ll,Line}] -> - {attribute,La,file,{Name,Line}}; - _Other -> error_bad_decl(La, file) + [{string,_An,Name},{integer,_Al,Line}] -> + {attribute,Aa,file,{Name,Line}}; + _Other -> error_bad_decl(Aa, file) end; -build_attribute({atom,La,Attr}, Val) -> +build_attribute({atom,Aa,Attr}, Val) -> case Val of [Expr0] -> Expr = attribute_farity(Expr0), - {attribute,La,Attr,term(Expr)}; - _Other -> ret_err(La, "bad attribute") + {attribute,Aa,Attr,term(Expr)}; + _Other -> ret_err(Aa, "bad attribute") end. -var_list({cons,_Lc,{var,_,V},Tail}) -> +var_list({cons,_Ac,{var,_,V},Tail}) -> [V|var_list(Tail)]; -var_list({nil,_Ln}) -> []; +var_list({nil,_An}) -> []; var_list(Other) -> - ret_err(?line(Other), "bad variable list"). + ret_err(?anno(Other), "bad variable list"). -attribute_farity({cons,L,H,T}) -> - {cons,L,attribute_farity(H),attribute_farity(T)}; -attribute_farity({tuple,L,Args0}) -> +attribute_farity({cons,A,H,T}) -> + {cons,A,attribute_farity(H),attribute_farity(T)}; +attribute_farity({tuple,A,Args0}) -> Args = attribute_farity_list(Args0), - {tuple,L,Args}; -attribute_farity({map,L,Args0}) -> + {tuple,A,Args}; +attribute_farity({map,A,Args0}) -> Args = attribute_farity_map(Args0), - {map,L,Args}; -attribute_farity({op,L,'/',{atom,_,_}=Name,{integer,_,_}=Arity}) -> - {tuple,L,[Name,Arity]}; + {map,A,Args}; +attribute_farity({op,A,'/',{atom,_,_}=Name,{integer,_,_}=Arity}) -> + {tuple,A,[Name,Arity]}; attribute_farity(Other) -> Other. attribute_farity_list(Args) -> @@ -764,45 +777,45 @@ attribute_farity_list(Args) -> %% It is not meaningful to have farity keys. attribute_farity_map(Args) -> - [{Op,L,K,attribute_farity(V)} || {Op,L,K,V} <- Args]. + [{Op,A,K,attribute_farity(V)} || {Op,A,K,V} <- Args]. --spec error_bad_decl(integer(), attributes()) -> no_return(). +-spec error_bad_decl(erl_anno:anno(), attributes()) -> no_return(). -error_bad_decl(L, S) -> - ret_err(L, io_lib:format("bad ~w declaration", [S])). +error_bad_decl(Anno, S) -> + ret_err(Anno, io_lib:format("bad ~w declaration", [S])). -farity_list({cons,_Lc,{op,_Lo,'/',{atom,_La,A},{integer,_Li,I}},Tail}) -> +farity_list({cons,_Ac,{op,_Ao,'/',{atom,_Aa,A},{integer,_Ai,I}},Tail}) -> [{A,I}|farity_list(Tail)]; -farity_list({nil,_Ln}) -> []; +farity_list({nil,_An}) -> []; farity_list(Other) -> - ret_err(?line(Other), "bad function arity"). + ret_err(?anno(Other), "bad function arity"). -record_tuple({tuple,_Lt,Fields}) -> +record_tuple({tuple,_At,Fields}) -> record_fields(Fields); record_tuple(Other) -> - ret_err(?line(Other), "bad record declaration"). + ret_err(?anno(Other), "bad record declaration"). -record_fields([{atom,La,A}|Fields]) -> - [{record_field,La,{atom,La,A}}|record_fields(Fields)]; -record_fields([{match,_Lm,{atom,La,A},Expr}|Fields]) -> - [{record_field,La,{atom,La,A},Expr}|record_fields(Fields)]; +record_fields([{atom,Aa,A}|Fields]) -> + [{record_field,Aa,{atom,Aa,A}}|record_fields(Fields)]; +record_fields([{match,_Am,{atom,Aa,A},Expr}|Fields]) -> + [{record_field,Aa,{atom,Aa,A},Expr}|record_fields(Fields)]; record_fields([{typed,Expr,TypeInfo}|Fields]) -> [Field] = record_fields([Expr]), TypeInfo1 = case Expr of {match, _, _, _} -> TypeInfo; %% If we have an initializer. - {atom, La, _} -> + {atom, Aa, _} -> case has_undefined(TypeInfo) of false -> TypeInfo2 = maybe_add_paren(TypeInfo), - lift_unions(abstract(undefined, La), TypeInfo2); + lift_unions(abstract2(undefined, Aa), TypeInfo2); true -> TypeInfo end end, [{typed_record_field,Field,TypeInfo1}|record_fields(Fields)]; record_fields([Other|_Fields]) -> - ret_err(?line(Other), "bad record field"); + ret_err(?anno(Other), "bad record field"); record_fields([]) -> []. has_undefined({atom,_,undefined}) -> @@ -816,52 +829,53 @@ has_undefined({type,_,union,Ts}) -> has_undefined(_) -> false. -maybe_add_paren({ann_type,L,T}) -> - {paren_type,L,[{ann_type,L,T}]}; +maybe_add_paren({ann_type,A,T}) -> + {paren_type,A,[{ann_type,A,T}]}; maybe_add_paren(T) -> T. term(Expr) -> try normalise(Expr) - catch _:_R -> ret_err(?line(Expr), "bad attribute") + catch _:_R -> ret_err(?anno(Expr), "bad attribute") end. -%% build_function([Clause]) -> {function,Line,Name,Arity,[Clause]} +%% build_function([Clause]) -> {function,Anno,Name,Arity,[Clause]} build_function(Cs) -> Name = element(3, hd(Cs)), Arity = length(element(4, hd(Cs))), - {function,?line(hd(Cs)),Name,Arity,check_clauses(Cs, Name, Arity)}. + {function,?anno(hd(Cs)),Name,Arity,check_clauses(Cs, Name, Arity)}. -%% build_fun(Line, [Clause]) -> {'fun',Line,{clauses,[Clause]}}. +%% build_fun(Anno, [Clause]) -> {'fun',Anno,{clauses,[Clause]}}. -build_fun(Line, Cs) -> +build_fun(Anno, Cs) -> Name = element(3, hd(Cs)), Arity = length(element(4, hd(Cs))), CheckedCs = check_clauses(Cs, Name, Arity), case Name of 'fun' -> - {'fun',Line,{clauses,CheckedCs}}; + {'fun',Anno,{clauses,CheckedCs}}; Name -> - {named_fun,Line,Name,CheckedCs} + {named_fun,Anno,Name,CheckedCs} end. check_clauses(Cs, Name, Arity) -> [case C of - {clause,L,N,As,G,B} when N =:= Name, length(As) =:= Arity -> - {clause,L,As,G,B}; - {clause,L,_N,_As,_G,_B} -> - ret_err(L, "head mismatch") + {clause,A,N,As,G,B} when N =:= Name, length(As) =:= Arity -> + {clause,A,As,G,B}; + {clause,A,_N,_As,_G,_B} -> + ret_err(A, "head mismatch") end || C <- Cs]. -build_try(L,Es,Scs,{Ccs,As}) -> - {'try',L,Es,Scs,Ccs,As}. +build_try(A,Es,Scs,{Ccs,As}) -> + {'try',A,Es,Scs,Ccs,As}. -spec ret_err(_, _) -> no_return(). -ret_err(L, S) -> - {location,Location} = get_attribute(L, location), - return_error(Location, S). +ret_err(Anno, S) -> + return_error(location(Anno), S). +location(Anno) -> + erl_anno:location(Anno). %% Convert between the abstract form of a term and a term. @@ -909,7 +923,8 @@ normalise_list([]) -> Data :: term(), AbsTerm :: abstract_expr(). abstract(T) -> - abstract(T, 0, enc_func(epp:default_encoding())). + Anno = erl_anno:new(0), + abstract(T, Anno, enc_func(epp:default_encoding())). -type encoding_func() :: fun((non_neg_integer()) -> boolean()). @@ -919,16 +934,18 @@ abstract(T) -> Options :: Line | [Option], Option :: {line, Line} | {encoding, Encoding}, Encoding :: 'latin1' | 'unicode' | 'utf8' | 'none' | encoding_func(), - Line :: erl_scan:line(), + Line :: erl_anno:line(), AbsTerm :: abstract_expr(). abstract(T, Line) when is_integer(Line) -> - abstract(T, Line, enc_func(epp:default_encoding())); + Anno = erl_anno:new(Line), + abstract(T, Anno, enc_func(epp:default_encoding())); abstract(T, Options) when is_list(Options) -> Line = proplists:get_value(line, Options, 0), Encoding = proplists:get_value(encoding, Options,epp:default_encoding()), EncFunc = enc_func(Encoding), - abstract(T, Line, EncFunc). + Anno = erl_anno:new(Line), + abstract(T, Anno, EncFunc). -define(UNICODE(C), (C < 16#D800 orelse @@ -942,53 +959,53 @@ enc_func(none) -> none; enc_func(Fun) when is_function(Fun, 1) -> Fun; enc_func(Term) -> erlang:error({badarg, Term}). -abstract(T, L, _E) when is_integer(T) -> {integer,L,T}; -abstract(T, L, _E) when is_float(T) -> {float,L,T}; -abstract(T, L, _E) when is_atom(T) -> {atom,L,T}; -abstract([], L, _E) -> {nil,L}; -abstract(B, L, _E) when is_bitstring(B) -> - {bin, L, [abstract_byte(Byte, L) || Byte <- bitstring_to_list(B)]}; -abstract([H|T], L, none=E) -> - {cons,L,abstract(H, L, E),abstract(T, L, E)}; -abstract(List, L, E) when is_list(List) -> - abstract_list(List, [], L, E); -abstract(Tuple, L, E) when is_tuple(Tuple) -> - {tuple,L,abstract_tuple_list(tuple_to_list(Tuple), L, E)}; -abstract(Map, L, E) when is_map(Map) -> - {map,L,abstract_map_fields(maps:to_list(Map),L,E)}. - -abstract_list([H|T], String, L, E) -> +abstract(T, A, _E) when is_integer(T) -> {integer,A,T}; +abstract(T, A, _E) when is_float(T) -> {float,A,T}; +abstract(T, A, _E) when is_atom(T) -> {atom,A,T}; +abstract([], A, _E) -> {nil,A}; +abstract(B, A, _E) when is_bitstring(B) -> + {bin, A, [abstract_byte(Byte, A) || Byte <- bitstring_to_list(B)]}; +abstract([H|T], A, none=E) -> + {cons,A,abstract(H, A, E),abstract(T, A, E)}; +abstract(List, A, E) when is_list(List) -> + abstract_list(List, [], A, E); +abstract(Tuple, A, E) when is_tuple(Tuple) -> + {tuple,A,abstract_tuple_list(tuple_to_list(Tuple), A, E)}; +abstract(Map, A, E) when is_map(Map) -> + {map,A,abstract_map_fields(maps:to_list(Map),A,E)}. + +abstract_list([H|T], String, A, E) -> case is_integer(H) andalso H >= 0 andalso E(H) of true -> - abstract_list(T, [H|String], L, E); + abstract_list(T, [H|String], A, E); false -> - AbstrList = {cons,L,abstract(H, L, E),abstract(T, L, E)}, - not_string(String, AbstrList, L, E) + AbstrList = {cons,A,abstract(H, A, E),abstract(T, A, E)}, + not_string(String, AbstrList, A, E) end; -abstract_list([], String, L, _E) -> - {string, L, lists:reverse(String)}; -abstract_list(T, String, L, E) -> - not_string(String, abstract(T, L, E), L, E). - -not_string([C|T], Result, L, E) -> - not_string(T, {cons, L, {integer, L, C}, Result}, L, E); -not_string([], Result, _L, _E) -> +abstract_list([], String, A, _E) -> + {string, A, lists:reverse(String)}; +abstract_list(T, String, A, E) -> + not_string(String, abstract(T, A, E), A, E). + +not_string([C|T], Result, A, E) -> + not_string(T, {cons, A, {integer, A, C}, Result}, A, E); +not_string([], Result, _A, _E) -> Result. -abstract_tuple_list([H|T], L, E) -> - [abstract(H, L, E)|abstract_tuple_list(T, L, E)]; -abstract_tuple_list([], _L, _E) -> +abstract_tuple_list([H|T], A, E) -> + [abstract(H, A, E)|abstract_tuple_list(T, A, E)]; +abstract_tuple_list([], _A, _E) -> []. -abstract_map_fields(Fs,L,E) -> - [{map_field_assoc,L,abstract(K,L,E),abstract(V,L,E)}||{K,V}<-Fs]. +abstract_map_fields(Fs,A,E) -> + [{map_field_assoc,A,abstract(K,A,E),abstract(V,A,E)}||{K,V}<-Fs]. -abstract_byte(Byte, L) when is_integer(Byte) -> - {bin_element, L, {integer, L, Byte}, default, default}; -abstract_byte(Bits, L) -> +abstract_byte(Byte, A) when is_integer(Byte) -> + {bin_element, A, {integer, A, Byte}, default, default}; +abstract_byte(Bits, A) -> Sz = bit_size(Bits), <<Val:Sz>> = Bits, - {bin_element, L, {integer, L, Val}, {integer, L, Sz}, default}. + {bin_element, A, {integer, A, Val}, {integer, A, Sz}, default}. %% Generate a list of tokens representing the abstract term. @@ -1002,32 +1019,32 @@ tokens(Abs) -> AbsTerm :: abstract_expr(), MoreTokens :: [token()], Tokens :: [token()]. -tokens({char,L,C}, More) -> [{char,L,C}|More]; -tokens({integer,L,N}, More) -> [{integer,L,N}|More]; -tokens({float,L,F}, More) -> [{float,L,F}|More]; -tokens({atom,L,A}, More) -> [{atom,L,A}|More]; -tokens({var,L,V}, More) -> [{var,L,V}|More]; -tokens({string,L,S}, More) -> [{string,L,S}|More]; -tokens({nil,L}, More) -> [{'[',L},{']',L}|More]; -tokens({cons,L,Head,Tail}, More) -> - [{'[',L}|tokens(Head, tokens_tail(Tail, More))]; -tokens({tuple,L,[]}, More) -> - [{'{',L},{'}',L}|More]; -tokens({tuple,L,[E|Es]}, More) -> - [{'{',L}|tokens(E, tokens_tuple(Es, ?line(E), More))]. - -tokens_tail({cons,L,Head,Tail}, More) -> - [{',',L}|tokens(Head, tokens_tail(Tail, More))]; -tokens_tail({nil,L}, More) -> - [{']',L}|More]; +tokens({char,A,C}, More) -> [{char,A,C}|More]; +tokens({integer,A,N}, More) -> [{integer,A,N}|More]; +tokens({float,A,F}, More) -> [{float,A,F}|More]; +tokens({atom,Aa,A}, More) -> [{atom,Aa,A}|More]; +tokens({var,A,V}, More) -> [{var,A,V}|More]; +tokens({string,A,S}, More) -> [{string,A,S}|More]; +tokens({nil,A}, More) -> [{'[',A},{']',A}|More]; +tokens({cons,A,Head,Tail}, More) -> + [{'[',A}|tokens(Head, tokens_tail(Tail, More))]; +tokens({tuple,A,[]}, More) -> + [{'{',A},{'}',A}|More]; +tokens({tuple,A,[E|Es]}, More) -> + [{'{',A}|tokens(E, tokens_tuple(Es, ?anno(E), More))]. + +tokens_tail({cons,A,Head,Tail}, More) -> + [{',',A}|tokens(Head, tokens_tail(Tail, More))]; +tokens_tail({nil,A}, More) -> + [{']',A}|More]; tokens_tail(Other, More) -> - L = ?line(Other), - [{'|',L}|tokens(Other, [{']',L}|More])]. + A = ?anno(Other), + [{'|',A}|tokens(Other, [{']',A}|More])]. -tokens_tuple([E|Es], Line, More) -> - [{',',Line}|tokens(E, tokens_tuple(Es, ?line(E), More))]; -tokens_tuple([], Line, More) -> - [{'}',Line}|More]. +tokens_tuple([E|Es], Anno, More) -> + [{',',Anno}|tokens(E, tokens_tuple(Es, ?anno(E), More))]; +tokens_tuple([], Anno, More) -> + [{'}',Anno}|More]. %% Give the relative precedences of operators. @@ -1092,13 +1109,168 @@ max_prec() -> 900. %%% longer apply. To get all present attributes as a property list %%% get_attributes() should be used. +-compile({nowarn_deprecated_function,{erl_scan,set_attribute,3}}). set_line(L, F) -> erl_scan:set_attribute(line, L, F). +-compile({nowarn_deprecated_function,{erl_scan,attributes_info,2}}). get_attribute(L, Name) -> erl_scan:attributes_info(L, Name). +-compile({nowarn_deprecated_function,{erl_scan,attributes_info,1}}). get_attributes(L) -> erl_scan:attributes_info(L). +-spec map_anno(Fun, Abstr) -> NewAbstr when + Fun :: fun((Anno) -> Anno), + Anno :: erl_anno:anno(), + Abstr :: abstract_form() | abstract_expr(), + NewAbstr :: abstract_form() | abstract_expr(). + +map_anno(F0, Abstr) -> + F = fun(A, Acc) -> {F0(A), Acc} end, + {NewAbstr, []} = modify_anno1(Abstr, [], F), + NewAbstr. + +-spec fold_anno(Fun, Acc0, Abstr) -> NewAbstr when + Fun :: fun((Anno, AccIn) -> AccOut), + Anno :: erl_anno:anno(), + Acc0 :: term(), + AccIn :: term(), + AccOut :: term(), + Abstr :: abstract_form() | abstract_expr(), + NewAbstr :: abstract_form() | abstract_expr(). + +fold_anno(F0, Acc0, Abstr) -> + F = fun(A, Acc) -> {A, F0(A, Acc)} end, + {_, NewAcc} = modify_anno1(Abstr, Acc0, F), + NewAcc. + +-spec mapfold_anno(Fun, Acc0, Abstr) -> {NewAbstr, Acc1} when + Fun :: fun((Anno, AccIn) -> {Anno, AccOut}), + Anno :: erl_anno:anno(), + Acc0 :: term(), + Acc1 :: term(), + AccIn :: term(), + AccOut :: term(), + Abstr :: abstract_form() | abstract_expr(), + NewAbstr :: abstract_form() | abstract_expr(). + +mapfold_anno(F, Acc0, Abstr) -> + modify_anno1(Abstr, Acc0, F). + +-spec new_anno(Term) -> Abstr when + Term :: term(), + Abstr :: abstract_form() | abstract_expr(). + +new_anno(Term) -> + map_anno(fun erl_anno:new/1, Term). + +-spec anno_to_term(Abstr) -> term() when + Abstr :: abstract_form() | abstract_expr(). + +anno_to_term(Abstract) -> + map_anno(fun erl_anno:to_term/1, Abstract). + +-spec anno_from_term(Term) -> abstract_form() | abstract_expr() when + Term :: term(). + +anno_from_term(Term) -> + map_anno(fun erl_anno:from_term/1, Term). + +%% Forms. +%% Recognize what sys_pre_expand does: +modify_anno1({'fun',A,F,{_,_,_}=Id}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {F1,Ac2} = modify_anno1(F, Ac1, Mf), + {{'fun',A1,F1,Id},Ac2}; +modify_anno1({named_fun,A,N,F,{_,_,_}=Id}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {F1,Ac2} = modify_anno1(F, Ac1, Mf), + {{named_fun,A1,N,F1,Id},Ac2}; +modify_anno1({attribute,A,N,[V]}, Ac, Mf) -> + {{attribute,A1,N1,V1},Ac1} = modify_anno1({attribute,A,N,V}, Ac, Mf), + {{attribute,A1,N1,[V1]},Ac1}; +%% End of sys_pre_expand special forms. +modify_anno1({function,F,A}, Ac, _Mf) -> + {{function,F,A},Ac}; +modify_anno1({function,M,F,A}, Ac, Mf) -> + {M1,Ac1} = modify_anno1(M, Ac, Mf), + {F1,Ac2} = modify_anno1(F, Ac1, Mf), + {A1,Ac3} = modify_anno1(A, Ac2, Mf), + {{function,M1,F1,A1},Ac3}; +modify_anno1({attribute,A,record,{Name,Fields}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {Fields1,Ac2} = modify_anno1(Fields, Ac1, Mf), + {{attribute,A1,record,{Name,Fields1}},Ac2}; +modify_anno1({attribute,A,spec,{Fun,Types}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {Types1,Ac2} = modify_anno1(Types, Ac1, Mf), + {{attribute,A1,spec,{Fun,Types1}},Ac2}; +modify_anno1({attribute,A,callback,{Fun,Types}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {Types1,Ac2} = modify_anno1(Types, Ac1, Mf), + {{attribute,A1,callback,{Fun,Types1}},Ac2}; +modify_anno1({attribute,A,type,{TypeName,TypeDef,Args}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {TypeDef1,Ac2} = modify_anno1(TypeDef, Ac1, Mf), + {Args1,Ac3} = modify_anno1(Args, Ac2, Mf), + {{attribute,A1,type,{TypeName,TypeDef1,Args1}},Ac3}; +modify_anno1({attribute,A,opaque,{TypeName,TypeDef,Args}}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {TypeDef1,Ac2} = modify_anno1(TypeDef, Ac1, Mf), + {Args1,Ac3} = modify_anno1(Args, Ac2, Mf), + {{attribute,A1,opaque,{TypeName,TypeDef1,Args1}},Ac3}; +modify_anno1({attribute,A,Attr,Val}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {{attribute,A1,Attr,Val},Ac1}; +modify_anno1({warning,W}, Ac, _Mf) -> + {{warning,W},Ac}; +modify_anno1({error,W}, Ac, _Mf) -> + {{error,W},Ac}; +%% Expressions. +modify_anno1({clauses,Cs}, Ac, Mf) -> + {Cs1,Ac1} = modify_anno1(Cs, Ac, Mf), + {{clauses,Cs1},Ac1}; +modify_anno1({typed_record_field,Field,Type}, Ac, Mf) -> + {Field1,Ac1} = modify_anno1(Field, Ac, Mf), + {Type1,Ac2} = modify_anno1(Type, Ac1, Mf), + {{typed_record_field,Field1,Type1},Ac2}; +modify_anno1({Tag,A}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {{Tag,A1},Ac1}; +modify_anno1({Tag,A,E1}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {{Tag,A1,E11},Ac2}; +modify_anno1({Tag,A,E1,E2}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {E21,Ac3} = modify_anno1(E2, Ac2, Mf), + {{Tag,A1,E11,E21},Ac3}; +modify_anno1({bin_element,A,E1,E2,TSL}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {E21,Ac3} = modify_anno1(E2, Ac2, Mf), + {{bin_element,A1,E11,E21, TSL},Ac3}; +modify_anno1({Tag,A,E1,E2,E3}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {E21,Ac3} = modify_anno1(E2, Ac2, Mf), + {E31,Ac4} = modify_anno1(E3, Ac3, Mf), + {{Tag,A1,E11,E21,E31},Ac4}; +modify_anno1({Tag,A,E1,E2,E3,E4}, Ac, Mf) -> + {A1,Ac1} = Mf(A, Ac), + {E11,Ac2} = modify_anno1(E1, Ac1, Mf), + {E21,Ac3} = modify_anno1(E2, Ac2, Mf), + {E31,Ac4} = modify_anno1(E3, Ac3, Mf), + {E41,Ac5} = modify_anno1(E4, Ac4, Mf), + {{Tag,A1,E11,E21,E31,E41},Ac5}; +modify_anno1([H|T], Ac, Mf) -> + {H1,Ac1} = modify_anno1(H, Ac, Mf), + {T1,Ac2} = modify_anno1(T, Ac1, Mf), + {[H1|T1],Ac2}; +modify_anno1([], Ac, _Mf) -> {[],Ac}; +modify_anno1(E, Ac, _Mf) when not is_tuple(E), not is_list(E) -> {E,Ac}. + %% vim: ft=erlang diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 469ce544c7..623a29f923 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -46,6 +46,23 @@ -record(options, {hook, encoding, opts}). +%-define(DEBUG, true). + +-ifdef(DEBUG). +-define(TEST(T), + %% Assumes that erl_anno has been compiled with DEBUG=true. + %% erl_pp does not use the annoations, but test it anyway. + %% Note: hooks are not handled. + _ = try + erl_parse:map_anno(fun(A) when is_list(A) -> A end, T) + catch + _:_ -> + erlang:error(badarg, [T]) + end). +-else. +-define(TEST(T), ok). +-endif. + %%% %%% Exported functions %%% @@ -61,6 +78,7 @@ form(Thing) -> Options :: options()). form(Thing, Options) -> + ?TEST(Thing), State = state(Options), frmt(lform(Thing, options(Options), State), State). @@ -75,6 +93,7 @@ attribute(Thing) -> Options :: options()). attribute(Thing, Options) -> + ?TEST(Thing), State = state(Options), frmt(lattribute(Thing, options(Options), State), State). @@ -89,6 +108,7 @@ function(F) -> Options :: options()). function(F, Options) -> + ?TEST(F), frmt(lfunction(F, options(Options)), state(Options)). -spec(guard(Guard) -> io_lib:chars() when @@ -102,6 +122,7 @@ guard(Gs) -> Options :: options()). guard(Gs, Options) -> + ?TEST(Gs), frmt(lguard(Gs, options(Options)), state(Options)). -spec(exprs(Expressions) -> io_lib:chars() when @@ -123,12 +144,14 @@ exprs(Es, Options) -> Options :: options()). exprs(Es, I, Options) -> + ?TEST(Es), frmt({seq,[],[],[$,],lexprs(Es, options(Options))}, I, state(Options)). -spec(expr(Expression) -> io_lib:chars() when Expression :: erl_parse:abstract_expr()). expr(E) -> + ?TEST(E), frmt(lexpr(E, 0, options(none)), state(none)). -spec(expr(Expression, Options) -> io_lib:chars() when @@ -136,6 +159,7 @@ expr(E) -> Options :: options()). expr(E, Options) -> + ?TEST(E), frmt(lexpr(E, 0, options(Options)), state(Options)). -spec(expr(Expression, Indent, Options) -> io_lib:chars() when @@ -144,6 +168,7 @@ expr(E, Options) -> Options :: options()). expr(E, I, Options) -> + ?TEST(E), frmt(lexpr(E, 0, options(Options)), I, state(Options)). -spec(expr(Expression, Indent, Precedence, Options) -> io_lib:chars() when @@ -153,6 +178,7 @@ expr(E, I, Options) -> Options :: options()). expr(E, I, P, Options) -> + ?TEST(E), frmt(lexpr(E, P, options(Options)), I, state(Options)). %%% @@ -213,24 +239,25 @@ lattribute({attribute,_Line,Name,Arg}, Opts, State) -> [lattribute(Name, Arg, Opts, State),leaf(".\n")]. lattribute(module, {M,Vs}, _Opts, _State) -> - attr("module",[{var,0,pname(M)}, - foldr(fun(V, C) -> {cons,0,{var,0,V},C} - end, {nil,0}, Vs)]); + A = a0(), + attr("module",[{var,A,pname(M)}, + foldr(fun(V, C) -> {cons,A,{var,A,V},C} + end, {nil,A}, Vs)]); lattribute(module, M, _Opts, _State) -> - attr("module", [{var,0,pname(M)}]); + attr("module", [{var,a0(),pname(M)}]); lattribute(export, Falist, _Opts, _State) -> - call({var,0,"-export"}, [falist(Falist)], 0, options(none)); + call({var,a0(),"-export"}, [falist(Falist)], 0, options(none)); lattribute(import, Name, _Opts, _State) when is_list(Name) -> - attr("import", [{var,0,pname(Name)}]); + attr("import", [{var,a0(),pname(Name)}]); lattribute(import, {From,Falist}, _Opts, _State) -> - attr("import",[{var,0,pname(From)},falist(Falist)]); + attr("import",[{var,a0(),pname(From)},falist(Falist)]); lattribute(optional_callbacks, Falist, Opts, _State) -> ArgL = try falist(Falist) catch _:_ -> abstract(Falist, Opts) end, - call({var,0,"-optional_callbacks"}, [ArgL], 0, options(none)); + call({var,a0(),"-optional_callbacks"}, [ArgL], 0, options(none)); lattribute(file, {Name,Line}, _Opts, State) -> - attr("file", [{var,0,(State#pp.string_fun)(Name)},{integer,0,Line}]); + attr("file", [{var,a0(),(State#pp.string_fun)(Name)},{integer,a0(),Line}]); lattribute(record, {Name,Is}, Opts, _State) -> Nl = leaf(format("-record(~w,", [Name])), [{first,Nl,record_fields(Is, Opts)},$)]; @@ -242,7 +269,7 @@ abstract(Arg, #options{encoding = Encoding}) -> typeattr(Tag, {TypeName,Type,Args}, _Opts) -> {first,leaf("-"++atom_to_list(Tag)++" "), - typed(call({atom,0,TypeName}, Args, 0, options(none)), Type)}. + typed(call({atom,a0(),TypeName}, Args, 0, options(none)), Type)}. ltype({ann_type,_Line,[V,T]}) -> typed(lexpr(V, options(none)), T); @@ -384,7 +411,7 @@ ltypes(Ts, F) -> [F(T) || T <- Ts]. attr(Name, Args) -> - call({var,0,format("-~s", [Name])}, Args, 0, options(none)). + call({var,a0(),format("-~s", [Name])}, Args, 0, options(none)). pname(['' | As]) -> [$. | pname(As)]; @@ -396,9 +423,10 @@ pname(A) when is_atom(A) -> write(A). falist([]) -> - {nil,0}; + {nil,a0()}; falist([{Name,Arity}|Falist]) -> - {cons,0,{var,0,format("~w/~w", [Name,Arity])},falist(Falist)}. + A = a0(), + {cons,A,{var,A,format("~w/~w", [Name,Arity])},falist(Falist)}. lfunction({function,_Line,Name,_Arity,Cs}, Opts) -> Cll = nl_clauses(fun (C, H) -> func_clause(Name, C, H) end, $;, Opts, Cs), @@ -1111,6 +1139,9 @@ write_char(C, PP) -> %% Utilities %% +a0() -> + erl_anno:new(0). + chars_size([C | Es]) when is_integer(C) -> 1 + chars_size(Es); chars_size([E | Es]) -> diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 4960a86760..5e7cc5f6d6 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -55,6 +55,15 @@ token_info/1,token_info/2, attributes_info/1,attributes_info/2,set_attribute/3]). +-export([column/1,end_location/1,line/1,location/1,text/1, + category/1,symbol/1]). + +-deprecated([{attributes_info, 1, next_major_release}, + {attributes_info, 2, next_major_release}, + {set_attribute, 3, next_major_release}, + {token_info, 1, next_major_release}, + {token_info, 2, next_major_release}]). + %%% Private -export([continuation_location/1]). @@ -78,9 +87,9 @@ -define(SETATTRFUN(F), is_function(F, 1)). -type category() :: atom(). --type column() :: pos_integer(). --type line() :: integer(). --type location() :: line() | {line(),column()}. +-type column() :: pos_integer(). % Deprecated +-type line() :: integer(). % Deprecated +-type location() :: line() | {line(),column()}. % Deprecated -type resword_fun() :: fun((atom()) -> boolean()). -type option() :: 'return' | 'return_white_spaces' | 'return_comments' | 'text' | {'reserved_word_fun', resword_fun()}. @@ -197,6 +206,56 @@ continuation_location({erl_scan_continuation,_,no_col,_,Line,_,_,_}) -> continuation_location({erl_scan_continuation,_,Col,_,Line,_,_,_}) -> {Line,Col}. +-spec column(Token) -> erl_anno:column() | 'undefined' when + Token :: token(). + +column(Token) -> + erl_anno:column(element(2, Token)). + +-spec end_location(Token) -> erl_anno:location() | 'undefined' when + Token :: token(). + +end_location(Token) -> + erl_anno:end_location(element(2, Token)). + +-spec line(Token) -> erl_anno:line() when + Token :: token(). + +line(Token) -> + erl_anno:line(element(2, Token)). + +-spec location(Token) -> erl_anno:location() when + Token :: token(). + +location(Token) -> + erl_anno:location(element(2, Token)). + +-spec text(Token) -> erl_anno:text() | 'undefined' when + Token :: token(). + +text(Token) -> + erl_anno:text(element(2, Token)). + +-spec category(Token) -> category() when + Token :: token(). + +category({Category,_Anno}) -> + Category; +category({Category,_Anno,_Symbol}) -> + Category; +category(T) -> + erlang:error(badarg, [T]). + +-spec symbol(Token) -> symbol() when + Token :: token(). + +symbol({Category,_Anno}) -> + Category; +symbol({_Category,_Anno,Symbol}) -> + Symbol; +symbol(T) -> + erlang:error(badarg, [T]). + -type attribute_item() :: 'column' | 'length' | 'line' | 'location' | 'text'. -type info_location() :: location() | term(). @@ -276,7 +335,17 @@ attributes_info({Line,Column}, column=Item) when ?ALINE(Line), attributes_info(Line, column) when ?ALINE(Line) -> undefined; attributes_info(Attrs, column=Item) -> - attr_info(Attrs, Item); + case attr_info(Attrs, Item) of + undefined -> + case erl_anno:column(Attrs) of + undefined -> + undefined; + Column -> + {Item,Column} + end; + T -> + T + end; attributes_info(Attrs, length=Item) -> case attributes_info(Attrs, text) of undefined -> @@ -290,14 +359,26 @@ attributes_info({Line,Column}, line=Item) when ?ALINE(Line), ?COLUMN(Column) -> {Item,Line}; attributes_info(Attrs, line=Item) -> - attr_info(Attrs, Item); + case attr_info(Attrs, Item) of + undefined -> + case attr_info(Attrs, location) of + {location,{Line,_Column}} -> + {Item,Line}; + {location,Line} -> + {Item,Line}; + undefined -> + undefined + end; + T -> + T + end; attributes_info({Line,Column}=Location, location=Item) when ?ALINE(Line), ?COLUMN(Column) -> {Item,Location}; attributes_info(Line, location=Item) when ?ALINE(Line) -> {Item,Line}; attributes_info(Attrs, location=Item) -> - {line,Line} = attributes_info(Attrs, line), % assume line is present + {line,Line} = attributes_info(Attrs, line), case attributes_info(Attrs, column) of undefined -> %% If set_attribute() has assigned a term such as {17,42} @@ -419,12 +500,28 @@ set_attr(line, {Line,Column}, Fun) when ?ALINE(Line), ?COLUMN(Column) -> [{line,Ln},{column,Column}] end; set_attr(line=Tag, Attrs, Fun) when is_list(Attrs) -> - {line,Line} = lists:keyfind(Tag, 1, Attrs), - case lists:keyreplace(Tag, 1, Attrs, {line,Fun(Line)}) of - [{line,Ln}] when ?ALINE(Ln) -> - Ln; - As -> - As + case lists:keyfind(Tag, 1, Attrs) of + {line,Line} -> + case lists:keyreplace(Tag, 1, Attrs, {line,Fun(Line)}) of + [{line,Ln}] when ?ALINE(Ln) -> + Ln; + As -> + As + end; + false -> + {location, Location} = lists:keyfind(location, 1, Attrs), + Ln = case Location of + {Line,Column} when ?ALINE(Line), ?COLUMN(Column) -> + {Fun(Line),Column}; + _ -> + Fun(Location) + end, + case lists:keyreplace(location, 1, Attrs, {location,Ln}) of + [{location,Ln}] when ?ALINE(Ln) -> + Ln; + As -> + As + end end; set_attr(T1, T2, T3) -> erlang:error(badarg, [T1,T2,T3]). @@ -708,17 +805,17 @@ scan_name(Cs, Ncs) -> -define(STR(St, S), if St#erl_scan.text -> S; true -> [] end). scan_dot([$%|_]=Cs, St, Line, Col, Toks, Ncs) -> - Attrs = attributes(Line, Col, St, Ncs), - {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 1)}; + Anno = anno(Line, Col, St, Ncs), + {ok,[{dot,Anno}|Toks],Cs,Line,incr_column(Col, 1)}; scan_dot([$\n=C|Cs], St, Line, Col, Toks, Ncs) -> - Attrs = attributes(Line, Col, St, ?STR(St, Ncs++[C])), - {ok,[{dot,Attrs}|Toks],Cs,Line+1,new_column(Col, 1)}; + Anno = anno(Line, Col, St, ?STR(St, Ncs++[C])), + {ok,[{dot,Anno}|Toks],Cs,Line+1,new_column(Col, 1)}; scan_dot([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) -> - Attrs = attributes(Line, Col, St, ?STR(St, Ncs++[C])), - {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 2)}; + Anno = anno(Line, Col, St, ?STR(St, Ncs++[C])), + {ok,[{dot,Anno}|Toks],Cs,Line,incr_column(Col, 2)}; scan_dot(eof=Cs, St, Line, Col, Toks, Ncs) -> - Attrs = attributes(Line, Col, St, Ncs), - {ok,[{dot,Attrs}|Toks],Cs,Line,incr_column(Col, 1)}; + Anno = anno(Line, Col, St, Ncs), + {ok,[{dot,Anno}|Toks],Cs,Line,incr_column(Col, 1)}; scan_dot(Cs, St, Line, Col, Toks, Ncs) -> tok2(Cs, St, Line, Col, Toks, Ncs, '.', 1). @@ -773,12 +870,12 @@ scan_nl_tabs(Cs, St, Line, Col, Toks, N) -> %% stop anyway, nothing is gained by not collecting all white spaces. scan_nl_white_space([$\n|Cs], #erl_scan{text = false}=St, Line, no_col=Col, Toks0, Ncs) -> - Toks = [{white_space,Line,lists:reverse(Ncs)}|Toks0], + Toks = [{white_space,anno(Line),lists:reverse(Ncs)}|Toks0], scan_newline(Cs, St, Line+1, Col, Toks); scan_nl_white_space([$\n|Cs], St, Line, Col, Toks, Ncs0) -> Ncs = lists:reverse(Ncs0), - Attrs = attributes(Line, Col, St, Ncs), - Token = {white_space,Attrs,Ncs}, + Anno = anno(Line, Col, St, Ncs), + Token = {white_space,Anno,Ncs}, scan_newline(Cs, St, Line+1, new_column(Col, length(Ncs)), [Token|Toks]); scan_nl_white_space([C|Cs], St, Line, Col, Toks, Ncs) when ?WHITE_SPACE(C) -> scan_nl_white_space(Cs, St, Line, Col, Toks, [C|Ncs]); @@ -786,19 +883,20 @@ scan_nl_white_space([]=Cs, _St, Line, Col, Toks, Ncs) -> {more,{Cs,Col,Toks,Line,Ncs,fun scan_nl_white_space/6}}; scan_nl_white_space(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Ncs) -> - scan1(Cs, St, Line+1, Col, [{white_space,Line,lists:reverse(Ncs)}|Toks]); + Anno = anno(Line), + scan1(Cs, St, Line+1, Col, [{white_space,Anno,lists:reverse(Ncs)}|Toks]); scan_nl_white_space(Cs, St, Line, Col, Toks, Ncs0) -> Ncs = lists:reverse(Ncs0), - Attrs = attributes(Line, Col, St, Ncs), - Token = {white_space,Attrs,Ncs}, + Anno = anno(Line, Col, St, Ncs), + Token = {white_space,Anno,Ncs}, scan1(Cs, St, Line+1, new_column(Col, length(Ncs)), [Token|Toks]). newline_end(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _N, Ncs) -> - scan1(Cs, St, Line+1, Col, [{white_space,Line,Ncs}|Toks]); + scan1(Cs, St, Line+1, Col, [{white_space,anno(Line),Ncs}|Toks]); newline_end(Cs, St, Line, Col, Toks, N, Ncs) -> - Attrs = attributes(Line, Col, St, Ncs), - scan1(Cs, St, Line+1, new_column(Col, N), [{white_space,Attrs,Ncs}|Toks]). + Anno = anno(Line, Col, St, Ncs), + scan1(Cs, St, Line+1, new_column(Col, N), [{white_space,Anno,Ncs}|Toks]). scan_spcs([$\s|Cs], St, Line, Col, Toks, N) when N < 16 -> scan_spcs(Cs, St, Line, Col, Toks, N+1); @@ -847,20 +945,20 @@ scan_char([$\\|Cs]=Cs0, St, Line, Col, Toks) -> {eof,Ncol} -> scan_error(char, Line, Col, Line, Ncol, eof); {nl,Val,Str,Ncs,Ncol} -> - Attrs = attributes(Line, Col, St, ?STR(St, "$\\"++Str)), %" - Ntoks = [{char,Attrs,Val}|Toks], + Anno = anno(Line, Col, St, ?STR(St, "$\\"++Str)), %" + Ntoks = [{char,Anno,Val}|Toks], scan1(Ncs, St, Line+1, Ncol, Ntoks); {Val,Str,Ncs,Ncol} -> - Attrs = attributes(Line, Col, St, ?STR(St, "$\\"++Str)), %" - Ntoks = [{char,Attrs,Val}|Toks], + Anno = anno(Line, Col, St, ?STR(St, "$\\"++Str)), %" + Ntoks = [{char,Anno,Val}|Toks], scan1(Ncs, St, Line, Ncol, Ntoks) end; scan_char([$\n=C|Cs], St, Line, Col, Toks) -> - Attrs = attributes(Line, Col, St, ?STR(St, [$$,C])), - scan1(Cs, St, Line+1, new_column(Col, 1), [{char,Attrs,C}|Toks]); + Anno = anno(Line, Col, St, ?STR(St, [$$,C])), + scan1(Cs, St, Line+1, new_column(Col, 1), [{char,Anno,C}|Toks]); scan_char([C|Cs], St, Line, Col, Toks) when ?UNICODE(C) -> - Attrs = attributes(Line, Col, St, ?STR(St, [$$,C])), - scan1(Cs, St, Line, incr_column(Col, 2), [{char,Attrs,C}|Toks]); + Anno = anno(Line, Col, St, ?STR(St, [$$,C])), + scan1(Cs, St, Line, incr_column(Col, 2), [{char,Anno,C}|Toks]); scan_char([C|_Cs], _St, Line, Col, _Toks) when ?CHAR(C) -> scan_error({illegal,character}, Line, Col, Line, incr_column(Col, 1), eof); scan_char([], _St, Line, Col, Toks) -> @@ -879,8 +977,8 @@ scan_string(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> Estr = string:substr(Nwcs, 1, 16), % Expanded escape chars. scan_error({string,$\",Estr}, Line0, Col0, Nline, Ncol, Ncs); %" {Ncs,Nline,Ncol,Nstr,Nwcs} -> - Attrs = attributes(Line0, Col0, St, Nstr), - scan1(Ncs, St, Nline, Ncol, [{string,Attrs,Nwcs}|Toks]) + Anno = anno(Line0, Col0, St, Nstr), + scan1(Ncs, St, Nline, Ncol, [{string,Anno,Nwcs}|Toks]) end. scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> @@ -896,8 +994,8 @@ scan_qatom(Cs, St, Line, Col, Toks, {Wcs,Str,Line0,Col0}) -> {Ncs,Nline,Ncol,Nstr,Nwcs} -> case catch list_to_atom(Nwcs) of A when is_atom(A) -> - Attrs = attributes(Line0, Col0, St, Nstr), - scan1(Ncs, St, Nline, Ncol, [{atom,Attrs,A}|Toks]); + Anno = anno(Line0, Col0, St, Nstr), + scan1(Ncs, St, Nline, Ncol, [{atom,Anno,A}|Toks]); _ -> scan_error({illegal,atom}, Line0, Col0, Nline, Ncol, Ncs) end @@ -1173,28 +1271,28 @@ scan_comment(Cs, St, Line, Col, Toks, Ncs0) -> tok3(Cs, St, Line, Col, Toks, comment, Ncs, Ncs). tok2(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _Wcs, P) -> - scan1(Cs, St, Line, Col, [{P,Line}|Toks]); + scan1(Cs, St, Line, Col, [{P,anno(Line)}|Toks]); tok2(Cs, St, Line, Col, Toks, Wcs, P) -> - Attrs = attributes(Line, Col, St, Wcs), - scan1(Cs, St, Line, incr_column(Col, length(Wcs)), [{P,Attrs}|Toks]). + Anno = anno(Line, Col, St, Wcs), + scan1(Cs, St, Line, incr_column(Col, length(Wcs)), [{P,Anno}|Toks]). tok2(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, _Wcs, P, _N) -> - scan1(Cs, St, Line, Col, [{P,Line}|Toks]); + scan1(Cs, St, Line, Col, [{P,anno(Line)}|Toks]); tok2(Cs, St, Line, Col, Toks, Wcs, P, N) -> - Attrs = attributes(Line, Col, St, Wcs), - scan1(Cs, St, Line, incr_column(Col, N), [{P,Attrs}|Toks]). + Anno = anno(Line, Col, St, Wcs), + scan1(Cs, St, Line, incr_column(Col, N), [{P,Anno}|Toks]). tok3(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Item, _S, Sym) -> - scan1(Cs, St, Line, Col, [{Item,Line,Sym}|Toks]); + scan1(Cs, St, Line, Col, [{Item,anno(Line),Sym}|Toks]); tok3(Cs, St, Line, Col, Toks, Item, String, Sym) -> - Token = {Item,attributes(Line, Col, St, String),Sym}, + Token = {Item,anno(Line, Col, St, String),Sym}, scan1(Cs, St, Line, incr_column(Col, length(String)), [Token|Toks]). tok3(Cs, #erl_scan{text = false}=St, Line, no_col=Col, Toks, Item, _String, Sym, _Length) -> - scan1(Cs, St, Line, Col, [{Item,Line,Sym}|Toks]); + scan1(Cs, St, Line, Col, [{Item,anno(Line),Sym}|Toks]); tok3(Cs, St, Line, Col, Toks, Item, String, Sym, Length) -> - Token = {Item,attributes(Line, Col, St, String),Sym}, + Token = {Item,anno(Line, Col, St, String),Sym}, scan1(Cs, St, Line, incr_column(Col, Length), [Token|Toks]). scan_error(Error, Line, Col, EndLine, EndCol, Rest) -> @@ -1205,23 +1303,28 @@ scan_error(Error, Line, Col, EndLine, EndCol, Rest) -> scan_error(Error, ErrorLoc, EndLoc, Rest) -> {{error,{ErrorLoc,?MODULE,Error},EndLoc},Rest}. --compile({inline,[attributes/4]}). +-compile({inline,[anno/4]}). -attributes(Line, no_col, #erl_scan{text = false}, _String) -> - Line; -attributes(Line, no_col, #erl_scan{text = true}, String) -> - [{line,Line},{text,String}]; -attributes(Line, Col, #erl_scan{text = false}, _String) -> - {Line,Col}; -attributes(Line, Col, #erl_scan{text = true}, String) -> - [{line,Line},{column,Col},{text,String}]. +anno(Line, no_col, #erl_scan{text = false}, _String) -> + anno(Line); +anno(Line, no_col, #erl_scan{text = true}, String) -> + Anno = anno(Line), + erl_anno:set_text(String, Anno); +anno(Line, Col, #erl_scan{text = false}, _String) -> + anno({Line, Col}); +anno(Line, Col, #erl_scan{text = true}, String) -> + Anno = anno({Line, Col}), + erl_anno:set_text(String, Anno). location(Line, no_col) -> Line; location(Line, Col) when is_integer(Col) -> {Line,Col}. --compile({inline,[incr_column/2,new_column/2]}). +-compile({inline,[anno/1,incr_column/2,new_column/2]}). + +anno(Location) -> + erl_anno:new(Location). incr_column(no_col=Col, _N) -> Col; diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index caa3276d09..72bd54fa29 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -300,7 +300,7 @@ format_error(Term) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% add1(TarFile, Bin, NameInArchive, Opts) when is_binary(Bin) -> - Now = calendar:now_to_local_time(now()), + Now = calendar:now_to_local_time(erlang:timestamp()), Info = #file_info{size = byte_size(Bin), type = regular, access = read_write, diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 6bd0eb8a22..f0827009a5 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -620,12 +620,13 @@ parse_source(S, File, Fd, StartLine, HeaderSz, CheckOnly) -> {ok, {attribute,_, module, M} = Form} -> epp_parse_file(Epp, S2#state{module = M}, [Form, FileForm]); {ok, _} -> - ModForm = {attribute,1,module, Module}, + ModForm = {attribute,a1(),module, Module}, epp_parse_file2(Epp, S2, [ModForm, FileForm], OptModRes); {error, _} -> epp_parse_file2(Epp, S2, [FileForm], OptModRes); - {eof, _LastLine} = Eof -> - S#state{forms_or_bin = [FileForm, Eof]} + {eof, LastLine} -> + Anno = anno(LastLine), + S#state{forms_or_bin = [FileForm, {eof, Anno}]} end, ok = epp:close(Epp), ok = file:close(Fd), @@ -644,7 +645,7 @@ check_source(S, CheckOnly) -> %% Optionally add export of main/1 Forms2 = case ExpMain of - false -> [{attribute,0,export, [{main,1}]} | Forms]; + false -> [{attribute, a0(), export, [{main,1}]} | Forms]; true -> Forms end, Forms3 = [FileForm2, ModForm2 | Forms2], @@ -663,7 +664,8 @@ check_source(S, CheckOnly) -> end. pre_def_macros(File) -> - {MegaSecs, Secs, MicroSecs} = erlang:now(), + {MegaSecs, Secs, MicroSecs} = erlang:timestamp(), + Unique = erlang:unique_integer([positive]), Replace = fun(Char) -> case Char of $\. -> $\_; @@ -675,8 +677,9 @@ pre_def_macros(File) -> CleanBase ++ "__" ++ "escript__" ++ integer_to_list(MegaSecs) ++ "__" ++ - integer_to_list(Secs) ++ "__" ++ - integer_to_list(MicroSecs), + integer_to_list(Secs) ++ "__" ++ + integer_to_list(MicroSecs) ++ "__" ++ + integer_to_list(Unique), Module = list_to_atom(ModuleStr), PreDefMacros = [{'MODULE', Module, redefine}, {'MODULE_STRING', ModuleStr, redefine}], @@ -720,8 +723,9 @@ epp_parse_file2(Epp, S, Forms, Parsed) -> io:format("~ts:~w: ~ts\n", [S#state.file,Ln,Mod:format_error(Args)]), epp_parse_file(Epp, S#state{n_errors = S#state.n_errors + 1}, [Form | Forms]); - {eof, _LastLine} = Eof -> - S#state{forms_or_bin = lists:reverse([Eof | Forms])} + {eof, LastLine} -> + Anno = anno(LastLine), + S#state{forms_or_bin = lists:reverse([{eof, Anno} | Forms])} end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -776,7 +780,8 @@ interpret(Forms, HasRecs, File, Args) -> end, Dict = parse_to_dict(Forms2), ArgsA = erl_parse:abstract(Args, 0), - Call = {call,0,{atom,0,main},[ArgsA]}, + Anno = a0(), + Call = {call,Anno,{atom,Anno,main},[ArgsA]}, try _ = erl_eval:expr(Call, erl_eval:new_bindings(), @@ -888,6 +893,15 @@ enc() -> Enc -> [Enc] end. +a0() -> + anno(0). + +a1() -> + anno(1). + +anno(L) -> + erl_anno:new(L). + fatal(Str) -> throw(Str). diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 09c8924650..1df069755d 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -72,7 +72,7 @@ select_count/2, select_delete/2, select_reverse/1, select_reverse/2, select_reverse/3, setopts/2, slot/2, take/2, - update_counter/3, update_element/3]). + update_counter/3, update_counter/4, update_element/3]). -spec all() -> [Tab] when Tab :: tab(). @@ -439,6 +439,38 @@ take(_, _) -> update_counter(_, _, _) -> erlang:nif_error(undef). +-spec update_counter(Tab, Key, UpdateOp, Default) -> Result when + Tab :: tab(), + Key :: term(), + UpdateOp :: {Pos, Incr} + | {Pos, Incr, Threshold, SetValue}, + Pos :: integer(), + Incr :: integer(), + Threshold :: integer(), + SetValue :: integer(), + Result :: integer(), + Default :: tuple(); + (Tab, Key, [UpdateOp], Default) -> [Result] when + Tab :: tab(), + Key :: term(), + UpdateOp :: {Pos, Incr} + | {Pos, Incr, Threshold, SetValue}, + Pos :: integer(), + Incr :: integer(), + Threshold :: integer(), + SetValue :: integer(), + Result :: integer(), + Default :: tuple(); + (Tab, Key, Incr, Default) -> Result when + Tab :: tab(), + Key :: term(), + Incr :: integer(), + Result :: integer(), + Default :: tuple(). + +update_counter(_, _, _, _) -> + erlang:nif_error(undef). + -spec update_element(Tab, Key, ElementSpec :: {Pos, Value}) -> boolean() when Tab :: tab(), Key :: term(), diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl index 687d72b4bd..61b489513a 100644 --- a/lib/stdlib/src/file_sorter.erl +++ b/lib/stdlib/src/file_sorter.erl @@ -1425,8 +1425,8 @@ tmp_prefix1(Dir, TmpDirOpt) -> U = "_", Node = node(), Pid = os:getpid(), - {MSecs,Secs,MySecs} = now(), - F = lists:concat(["fs_",Node,U,Pid,U,MSecs,U,Secs,U,MySecs,"."]), + Unique = erlang:unique_integer([positive]), + F = lists:concat(["fs_",Node,U,Pid,U,Unique,"."]), TmpDir = case TmpDirOpt of default -> Dir; diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index 632af17e2a..68bd4f71cc 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -648,7 +648,7 @@ split(Name0) -> unix_splitb(Name) -> L = binary:split(Name,[<<"/">>],[global]), LL = case L of - [<<>>|Rest] -> + [<<>>|Rest] when Rest =/= [] -> [<<"/">>|Rest]; _ -> L diff --git a/lib/stdlib/src/gb_sets.erl b/lib/stdlib/src/gb_sets.erl index 0a26d0182d..393fb07229 100644 --- a/lib/stdlib/src/gb_sets.erl +++ b/lib/stdlib/src/gb_sets.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2014. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -207,21 +207,19 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% gb_sets:set() in OTP 17 only. - -spec empty() -> Set when - Set :: gb_sets:set(). + Set :: set(). empty() -> {0, nil}. -spec new() -> Set when - Set :: gb_sets:set(). + Set :: set(). new() -> empty(). -spec is_empty(Set) -> boolean() when - Set :: gb_sets:set(). + Set :: set(). is_empty({0, nil}) -> true; @@ -229,7 +227,7 @@ is_empty(_) -> false. -spec size(Set) -> non_neg_integer() when - Set :: gb_sets:set(). + Set :: set(). size({Size, _}) -> Size. diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl index b9ace2f442..0b59546dc4 100644 --- a/lib/stdlib/src/io.erl +++ b/lib/stdlib/src/io.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -45,7 +45,7 @@ %% ErrorDescription is whatever the I/O-server sends. -type server_no_data() :: {'error', ErrorDescription :: term()} | 'eof'. --type location() :: erl_scan:location(). +-type location() :: erl_anno:location(). %%------------------------------------------------------------------------- diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index e90cda0533..3378d668a5 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -287,6 +287,8 @@ write([H|T], D) -> end; write(F, _D) when is_function(F) -> erlang:fun_to_list(F); +write(Term, D) when is_map(Term) -> + write_map(Term, D); write(T, D) when is_tuple(T) -> if D =:= 1 -> "{...}"; @@ -295,9 +297,7 @@ write(T, D) when is_tuple(T) -> [write(element(1, T), D-1)| write_tail(tl(tuple_to_list(T)), D-1, $,)], $}] - end; -%write(Term, D) when is_map(Term) -> write_map(Term, D); -write(Term, D) -> write_map(Term, D). + end. %% write_tail(List, Depth, CharacterBeforeDots) %% Test the terminating case first as this looks better with depth. diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index ba4d6a5c87..3877c150ec 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -19,31 +19,15 @@ -module(maps). --export([ - fold/3, - map/2, - size/1, - without/2, - with/2, - get/3 - ]). +-export([get/3,fold/3, map/2, size/1, + without/2, with/2]). %%% BIFs --export([ - get/2, - find/2, - from_list/1, - is_key/2, - keys/1, - merge/2, - new/0, - put/3, - remove/2, - to_list/1, - update/3, - values/1 - ]). +-export([get/2, find/2, from_list/1, + is_key/2, keys/1, merge/2, + new/0, put/3, remove/2, + to_list/1, update/3, values/1]). -spec get(Key,Map) -> Value when Key :: term(), @@ -150,13 +134,15 @@ values(_) -> erlang:nif_error(undef). Value :: term(), Default :: term(). -get(Key, Map, Default) -> +get(Key,Map,Default) when is_map(Map) -> case maps:find(Key, Map) of {ok, Value} -> Value; error -> Default - end. + end; +get(Key,Map,Default) -> + erlang:error({badmap,Map},[Key,Map,Default]). -spec fold(Fun,Init,Map) -> Acc when @@ -169,8 +155,10 @@ get(Key, Map, Default) -> K :: term(), V :: term(). -fold(Fun, Init, Map) when is_function(Fun,3), is_map(Map) -> - lists:foldl(fun({K,V},A) -> Fun(K,V,A) end,Init,maps:to_list(Map)). +fold(Fun,Init,Map) when is_function(Fun,3), is_map(Map) -> + lists:foldl(fun({K,V},A) -> Fun(K,V,A) end,Init,maps:to_list(Map)); +fold(Fun,Init,Map) -> + erlang:error(error_type(Map),[Fun,Init,Map]). -spec map(Fun,Map1) -> Map2 when Fun :: fun((K, V1) -> V2), @@ -180,18 +168,22 @@ fold(Fun, Init, Map) when is_function(Fun,3), is_map(Map) -> V1 :: term(), V2 :: term(). -map(Fun, Map) when is_function(Fun, 2), is_map(Map) -> +map(Fun,Map) when is_function(Fun, 2), is_map(Map) -> maps:from_list(lists:map(fun ({K,V}) -> {K,Fun(K,V)} - end,maps:to_list(Map))). + end,maps:to_list(Map))); +map(Fun,Map) -> + erlang:error(error_type(Map),[Fun,Map]). -spec size(Map) -> non_neg_integer() when Map :: map(). size(Map) when is_map(Map) -> - erlang:map_size(Map). + erlang:map_size(Map); +size(Val) -> + erlang:error({badmap,Val},[Val]). -spec without(Ks,Map1) -> Map2 when @@ -200,8 +192,10 @@ size(Map) when is_map(Map) -> Map2 :: map(), K :: term(). -without(Ks, M) when is_list(Ks), is_map(M) -> - maps:from_list([{K,V}||{K,V} <- maps:to_list(M), not lists:member(K, Ks)]). +without(Ks,M) when is_list(Ks), is_map(M) -> + maps:from_list([{K,V}||{K,V} <- maps:to_list(M), not lists:member(K, Ks)]); +without(Ks,M) -> + erlang:error(error_type(M),[Ks,M]). -spec with(Ks, Map1) -> Map2 when @@ -210,5 +204,11 @@ without(Ks, M) when is_list(Ks), is_map(M) -> Map2 :: map(), K :: term(). -with(Ks, M) when is_list(Ks), is_map(M) -> - maps:from_list([{K,V}||{K,V} <- maps:to_list(M), lists:member(K, Ks)]). +with(Ks,M) when is_list(Ks), is_map(M) -> + maps:from_list([{K,V}||{K,V} <- maps:to_list(M), lists:member(K, Ks)]); +with(Ks,M) -> + erlang:error(error_type(M),[Ks,M]). + + +error_type(M) when is_map(M) -> badarg; +error_type(V) -> {badmap, V}. diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 7b6f4e5b50..6e3723bb98 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -822,9 +822,10 @@ th(T,B,OB) when is_tuple(T) -> th(Nonstruct,B,_OB) -> {Nonstruct,B}. -warn_var_clash(Line,Name,OuterBound) -> +warn_var_clash(Anno,Name,OuterBound) -> case gb_sets:is_member(Name,OuterBound) of true -> + Line = erl_anno:line(Anno), add_warning(Line,{?WARN_SHADOW_VAR,Name}); _ -> ok diff --git a/lib/stdlib/src/orddict.erl b/lib/stdlib/src/orddict.erl index c98d78b34d..af5d917840 100644 --- a/lib/stdlib/src/orddict.erl +++ b/lib/stdlib/src/orddict.erl @@ -115,8 +115,8 @@ erase(_, []) -> []. Orddict1 :: orddict(), Orddict2 :: orddict(). -store(Key, New, [{K,_}=E|Dict]) when Key < K -> - [{Key,New},E|Dict]; +store(Key, New, [{K,_}|_]=Dict) when Key < K -> + [{Key,New}|Dict]; store(Key, New, [{K,_}=E|Dict]) when Key > K -> [E|store(Key, New, Dict)]; store(Key, New, [{_K,_Old}|Dict]) -> %Key == K @@ -129,8 +129,8 @@ store(Key, New, []) -> [{Key,New}]. Orddict1 :: orddict(), Orddict2 :: orddict(). -append(Key, New, [{K,_}=E|Dict]) when Key < K -> - [{Key,[New]},E|Dict]; +append(Key, New, [{K,_}|_]=Dict) when Key < K -> + [{Key,[New]}|Dict]; append(Key, New, [{K,_}=E|Dict]) when Key > K -> [E|append(Key, New, Dict)]; append(Key, New, [{_K,Old}|Dict]) -> %Key == K @@ -143,8 +143,8 @@ append(Key, New, []) -> [{Key,[New]}]. Orddict1 :: orddict(), Orddict2 :: orddict(). -append_list(Key, NewList, [{K,_}=E|Dict]) when Key < K -> - [{Key,NewList},E|Dict]; +append_list(Key, NewList, [{K,_}|_]=Dict) when Key < K -> + [{Key,NewList}|Dict]; append_list(Key, NewList, [{K,_}=E|Dict]) when Key > K -> [E|append_list(Key, NewList, Dict)]; append_list(Key, NewList, [{_K,Old}|Dict]) -> %Key == K @@ -170,8 +170,8 @@ update(Key, Fun, [{K,Val}|Dict]) when Key == K -> Orddict1 :: orddict(), Orddict2 :: orddict(). -update(Key, _, Init, [{K,_}=E|Dict]) when Key < K -> - [{Key,Init},E|Dict]; +update(Key, _, Init, [{K,_}|_]=Dict) when Key < K -> + [{Key,Init}|Dict]; update(Key, Fun, Init, [{K,_}=E|Dict]) when Key > K -> [E|update(Key, Fun, Init, Dict)]; update(Key, Fun, _Init, [{_K,Val}|Dict]) -> %Key == K @@ -184,8 +184,8 @@ update(Key, _, Init, []) -> [{Key,Init}]. Orddict1 :: orddict(), Orddict2 :: orddict(). -update_counter(Key, Incr, [{K,_}=E|Dict]) when Key < K -> - [{Key,Incr},E|Dict]; +update_counter(Key, Incr, [{K,_}|_]=Dict) when Key < K -> + [{Key,Incr}|Dict]; update_counter(Key, Incr, [{K,_}=E|Dict]) when Key > K -> [E|update_counter(Key, Incr, Dict)]; update_counter(Key, Incr, [{_K,Val}|Dict]) -> %Key == K diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 4a338798d0..24721da187 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -18,7 +18,7 @@ %% -module(otp_internal). --export([obsolete/3]). +-export([obsolete/3, obsolete_type/3]). %%---------------------------------------------------------------------- @@ -26,7 +26,7 @@ -type mfas() :: mfa() | {atom(), atom(), [byte()]}. -type release() :: string(). --spec obsolete(atom(), atom(), byte()) -> +-spec obsolete(module(), atom(), arity()) -> 'no' | {tag(), string()} | {tag(), mfas(), release()}. obsolete(Module, Name, Arity) -> @@ -59,6 +59,11 @@ obsolete_1(erl_eval, arg_list, 3) -> obsolete_1(erlang, hash, 2) -> {deprecated, {erlang, phash2, 2}}; +obsolete_1(erlang, now, 0) -> + {deprecated, + "Deprecated BIF. See the \"Time and Time Correction in Erlang\" " + "chapter of the ERTS User's Guide for more information."}; + obsolete_1(calendar, local_time_to_universal_time, 1) -> {deprecated, {calendar, local_time_to_universal_time_dst, 1}}; @@ -590,6 +595,41 @@ obsolete_1(core_lib, is_literal_list, 1) -> " instead"}; obsolete_1(core_lib, literal_value, 1) -> {deprecated,{core_lib,concrete,1}}; +obsolete_1(erl_scan, set_attribute, 3) -> + {deprecated, + "deprecated (will be removed in OTP 19); use erl_anno:set_line/2 instead"}; +obsolete_1(erl_scan, attributes_info, 1) -> + {deprecated, + "deprecated (will be removed in OTP 19); use " + "erl_anno:{column,line,location,text}/1 instead"}; +obsolete_1(erl_scan, attributes_info, 2) -> + {deprecated, + "deprecated (will be removed in OTP 19); use " + "erl_anno:{column,line,location,text}/1 instead"}; +obsolete_1(erl_scan, token_info, 1) -> + {deprecated, + "deprecated (will be removed in OTP 19); use " + "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; +obsolete_1(erl_scan, token_info, 2) -> + {deprecated, + "deprecated (will be removed in OTP 19); use " + "erl_scan:{category,column,line,location,symbol,text}/1 instead"}; +obsolete_1(erl_parse, set_line, 2) -> + {deprecated, + "deprecated (will be removed in OTP 19); use erl_anno:set_line/2 instead"}; +obsolete_1(erl_parse, get_attributes, 1) -> + {deprecated, + "deprecated (will be removed in OTP 19); use " + "erl_anno:{column,line,location,text}/1 instead"}; +obsolete_1(erl_parse, get_attribute, 2) -> + {deprecated, + "deprecated (will be removed in OTP 19); use " + "erl_anno:{column,line,location,text}/1 instead"}; +obsolete_1(erl_lint, modify_line, 2) -> + {deprecated, + "deprecated (will be removed in OTP 19); use erl_parse:map_anno/2 instead"}; +obsolete_1(ssl, negotiated_next_protocol, 1) -> + {deprecated,{ssl,negotiated_protocol,1}}; obsolete_1(_, _, _) -> no. @@ -637,3 +677,30 @@ is_snmp_agent_function(add_agent_caps, 2) -> true; is_snmp_agent_function(del_agent_caps, 1) -> true; is_snmp_agent_function(get_agent_caps, 0) -> true; is_snmp_agent_function(_, _) -> false. + +-spec obsolete_type(module(), atom(), arity()) -> + 'no' | {tag(), string()} | {tag(), mfas(), release()}. + +obsolete_type(Module, Name, NumberOfVariables) -> + case obsolete_type_1(Module, Name, NumberOfVariables) of +%% {deprecated=Tag,{_,_,_}=Replacement} -> +%% {Tag,Replacement,"in a future release"}; + {_,String}=Ret when is_list(String) -> + Ret; +%% {_,_,_}=Ret -> +%% Ret; + no -> + no + end. + +obsolete_type_1(erl_scan,column,0) -> + {deprecated, + "deprecated (will be removed in OTP 19); use erl_anno:column() instead"}; +obsolete_type_1(erl_scan,line,0) -> + {deprecated, + "deprecated (will be removed in OTP 19); use erl_anno:line() instead"}; +obsolete_type_1(erl_scan,location,0) -> + {deprecated, + "deprecated (will be removed in OTP 19); use erl_anno:location() instead"}; +obsolete_type_1(_,_,_) -> + no. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 002032d48d..ad8aafbb1a 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1006,7 +1006,7 @@ listify(T) -> -record(simple_qlc, {p, % atom(), pattern variable le, - line, + line :: erl_anno:anno(), init_value, optz % #optz }). @@ -1148,15 +1148,18 @@ abstract(Info, true=_Flat, NElements, Depth) -> [{match,_,Expr,Q}] -> Q; [{match,_,Expr,Q} | Body] -> - {block, 0, lists:reverse(Body, [Q])}; + {block, anno0(), lists:reverse(Body, [Q])}; _ -> - {block, 0, lists:reverse(Body0, [Expr])} + {block, anno0(), lists:reverse(Body0, [Expr])} end. -abstract({qlc, E0, Qs0, Opt}, NElements, Depth) -> +abstract(Info, NElements, Depth) -> + abstract1(Info, NElements, Depth, anno1()). + +abstract1({qlc, E0, Qs0, Opt}, NElements, Depth, A) -> Qs = lists:map(fun({generate, P, LE}) -> - {generate, 1, binary_to_term(P), - abstract(LE, NElements, Depth)}; + {generate, A, binary_to_term(P), + abstract1(LE, NElements, Depth, A)}; (F) -> binary_to_term(F) end, Qs0), @@ -1165,12 +1168,12 @@ abstract({qlc, E0, Qs0, Opt}, NElements, Depth) -> [] -> []; _ -> [abstract_term(Opt, 1)] end, - ?QLC_Q(1, 1, 1, 1, {lc,1,E,Qs}, Os); -abstract({table, {M, F, As0}}, _NElements, _Depth) + ?QLC_Q(A, A, A, A, {lc,A,E,Qs}, Os); +abstract1({table, {M, F, As0}}, _NElements, _Depth, Anno) when is_atom(M), is_atom(F), is_list(As0) -> As = [abstract_term(A, 1) || A <- As0], - {call, 1, {remote, 1, {atom, 1, M}, {atom, 1, F}}, As}; -abstract({table, TableDesc}, _NElements, _Depth) -> + {call, Anno, {remote, Anno, {atom, Anno, M}, {atom, Anno, F}}, As}; +abstract1({table, TableDesc}, _NElements, _Depth, _A) -> case io_lib:deep_char_list(TableDesc) of true -> {ok, Tokens, _} = erl_scan:string(lists:flatten(TableDesc++".")), @@ -1179,27 +1182,28 @@ abstract({table, TableDesc}, _NElements, _Depth) -> false -> % abstract expression TableDesc end; -abstract({append, Infos}, NElements, Depth) -> +abstract1({append, Infos}, NElements, Depth, A) -> As = lists:foldr(fun(Info, As0) -> - {cons,1,abstract(Info, NElements, Depth),As0} - end, {nil, 1}, Infos), - {call, 1, {remote, 1, {atom, 1, ?MODULE}, {atom, 1, append}}, [As]}; -abstract({sort, Info, SortOptions}, NElements, Depth) -> - {call, 1, {remote, 1, {atom, 1, ?MODULE}, {atom, 1, sort}}, - [abstract(Info, NElements, Depth), abstract_term(SortOptions, 1)]}; -abstract({keysort, Info, Kp, SortOptions}, NElements, Depth) -> - {call, 1, {remote, 1, {atom, 1, ?MODULE}, {atom, 1, keysort}}, - [abstract_term(Kp, 1), abstract(Info, NElements, Depth), + {cons,A,abstract1(Info, NElements, Depth, A), + As0} + end, {nil, A}, Infos), + {call, A, {remote, A, {atom, A, ?MODULE}, {atom, A, append}}, [As]}; +abstract1({sort, Info, SortOptions}, NElements, Depth, A) -> + {call, A, {remote, A, {atom, A, ?MODULE}, {atom, A, sort}}, + [abstract1(Info, NElements, Depth, A), abstract_term(SortOptions, 1)]}; +abstract1({keysort, Info, Kp, SortOptions}, NElements, Depth, A) -> + {call, A, {remote, A, {atom, A, ?MODULE}, {atom, A, keysort}}, + [abstract_term(Kp, 1), abstract1(Info, NElements, Depth, A), abstract_term(SortOptions, 1)]}; -abstract({list,L,MS}, NElements, Depth) -> - {call, 1, {remote, 1, {atom, 1, ets}, {atom, 1, match_spec_run}}, - [abstract(L, NElements, Depth), - {call, 1, {remote, 1, {atom, 1, ets}, {atom, 1, match_spec_compile}}, +abstract1({list,L,MS}, NElements, Depth, A) -> + {call, A, {remote, A, {atom, A, ets}, {atom, A, match_spec_run}}, + [abstract1(L, NElements, Depth, A), + {call, A, {remote, A, {atom, A, ets}, {atom, A, match_spec_compile}}, [abstract_term(depth(MS, Depth), 1)]}]}; -abstract({list, L}, NElements, Depth) when NElements =:= infinity; - NElements >= length(L) -> +abstract1({list, L}, NElements, Depth, _A) when NElements =:= infinity; + NElements >= length(L) -> abstract_term(depth(L, Depth), 1); -abstract({list, L}, NElements, Depth) -> +abstract1({list, L}, NElements, Depth, _A) -> abstract_term(depth(lists:sublist(L, NElements), Depth) ++ '...', 1). depth(List, infinity) -> @@ -1251,14 +1255,14 @@ abstract_term(Term) -> abstract_term(Term, 0). abstract_term(Term, Line) -> - abstr_term(Term, Line). + abstr_term(Term, anno(Line)). abstr_term(Tuple, Line) when is_tuple(Tuple) -> {tuple,Line,[abstr_term(E, Line) || E <- tuple_to_list(Tuple)]}; abstr_term([_ | _]=L, Line) -> case io_lib:char_list(L) of true -> - erl_parse:abstract(L, Line); + erl_parse:abstract(L, erl_anno:line(Line)); false -> abstr_list(L, Line) end; @@ -1285,7 +1289,7 @@ abstr_term(Fun, Line) when is_function(Fun) -> abstr_term(PPR, Line) when is_pid(PPR); is_port(PPR); is_reference(PPR) -> {special, Line, lists:flatten(io_lib:write(PPR))}; abstr_term(Simple, Line) -> - erl_parse:abstract(Simple, Line). + erl_parse:abstract(Simple, erl_anno:line(Line)). abstr_list([H | T], Line) -> {cons, Line, abstr_term(H, Line), abstr_list(T, Line)}; @@ -1519,7 +1523,7 @@ join_info(Join, QInfo, Qdata, Code) -> %% Only compared constants (==). [Cs1_0, Cs2_0] end, - L = 0, + L = anno0(), G1_0 = {var,L,'G1'}, G2_0 = {var,L,'G2'}, JP = element(JQNum + 1, Code), %% Create code for wh1 and wh2 in #join{}: @@ -1571,7 +1575,7 @@ join_merge_info(QNum, QInfo, Code, G, ExtraConstants) -> {P, P}; _ -> {PV, _} = aux_name1('P', 0, abstract_vars(P)), - L = 0, + L = erl_anno:new(0), V = {var, L, PV}, {V, {match, L, V, P}} end, @@ -1579,19 +1583,20 @@ join_merge_info(QNum, QInfo, Code, G, ExtraConstants) -> LEI = {generate, term_to_binary(M), LEInfo}, TP = term_to_binary(G), CFs = [begin - Call = {call,0,{atom,0,element},[{integer,0,Col},EPV]}, - F = list2op([{op,0,Op,abstract_term(Con),Call} - || {Con,Op} <- ConstOps], 'or'), + A = anno0(), + Call = {call,A,{atom,A,element},[{integer,A,Col},EPV]}, + F = list2op([{op,A,Op,abstract_term(Con),Call} + || {Con,Op} <- ConstOps], 'or', A), term_to_binary(F) end || {Col,ConstOps} <- ExtraConstants], {{I,G}, [{generate, TP, {qlc, DQP, [LEI | CFs], []}}]} end. -list2op([E], _Op) -> +list2op([E], _Op, _Anno) -> E; -list2op([E | Es], Op) -> - {op,0,Op,E,list2op(Es, Op)}. +list2op([E | Es], Op, Anno) -> + {op,Anno,Op,E,list2op(Es, Op, Anno)}. join_lookup_info(QNum, QInfo, G) -> {generate, _, LEInfo}=I = lists:nth(QNum, QInfo), @@ -1704,7 +1709,7 @@ eval_le(LE_fun, GOpt) -> prep_qlc_lc({simple_v1, PVar, LE_fun, L}, Opt, GOpt, _H) -> check_lookup_option(Opt, false), - prep_simple_qlc(PVar, L, eval_le(LE_fun, GOpt), Opt); + prep_simple_qlc(PVar, anno(L), eval_le(LE_fun, GOpt), Opt); prep_qlc_lc({qlc_v1, QFun, CodeF, Qdata0, QOpt}, Opt, GOpt, _H) -> F = fun(?qual_data(_QNum, _GoI, _SI, fil)=QualData, ModGens) -> {QualData, ModGens}; @@ -1821,7 +1826,7 @@ may_create_simple(#qlc_opt{unique = Unique, cache = Cache} = Opt, if Unique and not IsUnique; (Cache =/= false) and not IsCached -> - prep_simple_qlc(?SIMPLE_QVAR, 1, Prep, Opt); + prep_simple_qlc(?SIMPLE_QVAR, anno(1), Prep, Opt); true -> Prep end. @@ -2764,8 +2769,8 @@ tmp_filename(TmpDirOpt) -> U = "_", Node = node(), Pid = os:getpid(), - {MSecs,Secs,MySecs} = erlang:now(), - F = lists:concat([?MODULE,U,Node,U,Pid,U,MSecs,U,Secs,U,MySecs]), + Unique = erlang:unique_integer(), + F = lists:concat([?MODULE,U,Node,U,Pid,U,Unique]), TmpDir = case TmpDirOpt of "" -> {ok, CurDir} = file:get_cwd(), @@ -3772,6 +3777,15 @@ grd(Fun, Arg) -> false end. +anno0() -> + anno(0). + +anno1() -> + anno(1). + +anno(L) -> + erl_anno:new(L). + family(L) -> sofs:to_external(sofs:relation_to_family(sofs:relation(L))). diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index b6bb758dfb..a4d2157b35 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -39,7 +39,12 @@ opt % #qlc_opt }). --record(state, {imp, maxargs, records, xwarnings = []}). +-record(state, {imp, + maxargs, + records, + xwarnings = [], + intro_vars, + node_info}). %-define(debug, true). @@ -66,37 +71,49 @@ Options :: [Option], Option :: type_checker | compile:option()). -parse_transform(Forms, Options) -> +parse_transform(Forms0, Options) -> ?DEBUG("qlc Parse Transform~n", []), - State = #state{imp = is_qlc_q_imported(Forms), - maxargs = ?COMPILE_MAX_NUM_OF_ARGS, - records = record_attributes(Forms)}, - case called_from_type_checker(Options) of - true -> - %% The returned value should conform to the types, but - %% need not evaluate to anything meaningful. - L = 0, - {tuple,_,Fs0} = abstr(#qlc_lc{}, L), - F = fun(_Id, LC, A) -> - Init = simple(L, 'V', LC, L), - {{tuple,L,set_field(#qlc_lc.lc, Fs0, Init)}, A} - end, - {Forms1,ok} = qlc_mapfold(F, ok, Forms, State), - Forms1; - false -> - FormsNoShadows = no_shadows(Forms, State), - case compile_messages(Forms, FormsNoShadows, Options, State) of - {[],[],Warnings} -> - {NewForms, State1} = transform(FormsNoShadows, State), - ExtraWs = State1#state.xwarnings, - {[],WForms} = no_duplicates(NewForms, [], Warnings, - ExtraWs, Options), - WForms ++ NewForms; - {E0,Errors,Warnings} -> - {EForms,WForms} = no_duplicates(Forms, E0++Errors, - Warnings, [], Options), - EForms ++ WForms ++ Forms - end + Imported = is_qlc_q_imported(Forms0), + {Forms, FormsNoShadows, State} = initiate(Forms0, Imported), + NodeInfo = State#state.node_info, + try + case called_from_type_checker(Options) of + true -> + %% The returned value should conform to the types, but + %% need not evaluate to anything meaningful. + L = anno0(), + {tuple,_,Fs0} = abstr(#qlc_lc{}, L), + F = fun(_Id, LC, A) -> + Init = simple(L, 'V', LC, L), + {{tuple,L,set_field(#qlc_lc.lc, Fs0, Init)}, A} + end, + {Forms1,ok} = qlc_mapfold(F, ok, Forms, State), + Forms1; + false -> + case + compile_messages(Forms, FormsNoShadows, Options, State) + of + {[],Warnings} -> + ?DEBUG("node info1 ~p~n", + [lists:sort(ets:tab2list(NodeInfo))]), + {NewForms, State1} = + transform(FormsNoShadows, State), + ExtraWs = State1#state.xwarnings, + {[],WForms} = no_duplicates(NewForms, [], Warnings, + ExtraWs, Options), + (restore_locations(WForms, State) ++ + restore_anno(NewForms, NodeInfo)); + {Errors,Warnings} -> + ?DEBUG("node info2 ~p~n", + [lists:sort(ets:tab2list(NodeInfo))]), + {EForms,WForms} = no_duplicates(FormsNoShadows, Errors, + Warnings, [], + Options), + restore_locations(EForms ++ WForms, State) ++ Forms0 + end + end + after + true = ets:delete(NodeInfo) end. -spec(transform_from_evaluator(LC, Bs) -> Expr when @@ -124,30 +141,78 @@ called_from_type_checker(Options) -> lists:member(type_checker, Options). transform_expression(LC, Bs0, WithLintErrors) -> - L = 1, + L = anno1(), As = [{var,L,V} || {V,_Val} <- Bs0], Ar = length(As), F = {function,L,bar,Ar,[{clause,L,As,[],[?QLC_Q(L, L, L, L, LC, [])]}]}, - Forms = [{attribute,L,file,{"foo",L}}, - {attribute,L,module,foo}, F], - State = #state{imp = false, - maxargs = ?EVAL_MAX_NUM_OF_ARGS, - records = record_attributes(Forms)}, + Forms0 = [{attribute,L,file,{"foo",L}}, + {attribute,L,module,foo}, F], + {Forms, FormsNoShadows, State} = initiate(Forms0, false), + NodeInfo = State#state.node_info, Options = [], - FormsNoShadows = no_shadows(Forms, State), - case compile_messages(Forms, FormsNoShadows, Options, State) of - {[],[],_Warnings} -> - {NewForms,_State1} = transform(FormsNoShadows, State), - {function,L,bar,Ar,[{clause,L,As,[],[NF]}]} = - lists:last(NewForms), - {ok,NF}; - {E0,Errors,_Warnings} when WithLintErrors -> - {not_ok,mforms(error, E0 ++ Errors)}; - {E0,Errors0,_Warnings} -> - [{error,Reason} | _] = mforms(error, E0++Errors0), - {not_ok, {error, ?APIMOD, Reason}} + try compile_messages(Forms, FormsNoShadows, Options, State) of + {Errors0,_Warnings} -> + case restore_locations(Errors0, State) of + [] -> + {NewForms,_State1} = transform(FormsNoShadows, State), + NewForms1 = restore_anno(NewForms, NodeInfo), + {function,L,bar,Ar,[{clause,L,As,[],[NF]}]} = + lists:last(NewForms1), + {ok,NF}; + Errors when WithLintErrors -> + {not_ok,mforms(error, Errors)}; + Errors -> + [{error,Reason} | _] = mforms(error, Errors), + {not_ok, {error, ?APIMOD, Reason}} + end + after + true = ets:delete(NodeInfo) end. +-ifdef(DEBUG). +-define(ILIM, 0). +-else. +-define(ILIM, 255). +-endif. + +initiate(Forms0, Imported) -> + NodeInfo = ets:new(?APIMOD, []), + true = ets:insert(NodeInfo, {var_n, ?ILIM}), + exclude_integers_from_unique_line_numbers(Forms0, NodeInfo), + ?DEBUG("node info0 ~p~n", + [lists:sort(ets:tab2list(NodeInfo))]), + State0 = #state{imp = Imported, + maxargs = ?EVAL_MAX_NUM_OF_ARGS, + records = record_attributes(Forms0), + node_info = NodeInfo}, + Forms = save_anno(Forms0, NodeInfo), + FormsNoShadows = no_shadows(Forms, State0), + IntroVars = intro_variables(FormsNoShadows, State0), + State = State0#state{intro_vars = IntroVars}, + {Forms, FormsNoShadows, State}. + +%% Make sure restore_locations() does not confuse integers with (the +%% unique) line numbers. +exclude_integers_from_unique_line_numbers(Forms, NodeInfo) -> + Integers = find_integers(Forms), + lists:foreach(fun(I) -> ets:insert(NodeInfo, {I}) end, Integers). + +find_integers(Forms) -> + F = fun(A) -> + Fs1 = erl_parse:map_anno(fun(_) -> A end, Forms), + ordsets:from_list(integers(Fs1, [])) + end, + ordsets:to_list(ordsets:intersection(F(anno0()), F(anno1()))). + +integers([E | Es], L) -> + integers(Es, integers(E, L)); +integers(T, L) when is_tuple(T) -> + integers(tuple_to_list(T), L); +integers(I, L) when is_integer(I), I > ?ILIM -> + [I | L]; +integers(_, L) -> + L. + -define(I(I), {integer, L, I}). -define(A(A), {atom, L, A}). -define(V(V), {var, L, V}). @@ -164,9 +229,15 @@ mforms(Tag, L) -> %% Avoid duplicated lint warnings and lint errors. Care has been taken %% not to introduce unused variables in the transformed code. %% -no_duplicates(Forms, Errors, Warnings0, ExtraWarnings, Options) -> +no_duplicates(Forms, Errors, Warnings0, ExtraWarnings0, Options) -> %% Some mistakes such as "{X} =:= {}" are found by strong %% validation as well as by qlc. Prefer the warnings from qlc: + %% The Compiler and qlc do not agree on the location of errors. + %% For now, qlc's messages about failing patterns and filters + %% are ignored. + ExtraWarnings = [W || W={_File,[{_,qlc,Tag}]} <- + ExtraWarnings0, + not lists:member(Tag, [nomatch_pattern,nomatch_filter])], Warnings1 = mforms(Warnings0) -- ([{File,[{L,v3_core,nomatch}]} || {File,[{L,qlc,M}]} <- mforms(ExtraWarnings), @@ -185,13 +256,22 @@ mforms(L) -> lists:sort([{File,[M]} || {File,Ms} <- L, M <- Ms]). mforms2(Tag, L) -> - Line = 0, + Line = anno0(), ML = lists:flatmap(fun({File,Ms}) -> - [[{attribute,Line,file,{File,Line}}, {Tag,M}] || + [[{attribute,Line,file,{File,0}}, {Tag,M}] || M <- Ms] end, lists:sort(L)), lists:flatten(lists:sort(ML)). +restore_locations([T | Ts], State) -> + [restore_locations(T, State) | restore_locations(Ts, State)]; +restore_locations(T, State) when is_tuple(T) -> + list_to_tuple(restore_locations(tuple_to_list(T), State)); +restore_locations(I, State) when I > ?ILIM -> + restore_loc(I, State); +restore_locations(T, _State) -> + T. + is_qlc_q_imported(Forms) -> [[] || {attribute,_,import,{?APIMOD,FAs}} <- Forms, {?Q,1} <- FAs] =/= []. @@ -212,13 +292,20 @@ compile_messages(Forms, FormsNoShadows, Options, State) -> (_QId, Q, GA, A) -> {Q,GA,A} end, - {_,BGens} = qual_fold(BGenF, [], [], FormsNoShadows, State), + {_,BGens} = qual_fold(BGenF, [], [], Forms, State), GenForm = used_genvar_check(FormsNoShadows, State), ?DEBUG("GenForm = ~ts~n", [catch erl_pp:form(GenForm)]), - WarnFun = fun(Id, LC, A) -> {tag_lines(LC, get_lcid_no(Id)), A} end, + {GEs,_} = compile_forms([GenForm], Options), + UsedGenVarMsgs = used_genvar_messages(GEs, State), + NodeInfo = State#state.node_info, + WarnFun = fun(_Id, LC, A) -> {lc_nodes(LC, NodeInfo), A} end, {WForms,ok} = qlc_mapfold(WarnFun, ok, Forms, State), - {Es,Ws} = compile_forms(WForms ++ [GenForm], Options), - {badarg(Forms, State),tagged_messages(Es)++BGens,tagged_messages(Ws)}. + {Es,Ws} = compile_forms(WForms, Options), + LcEs = lc_messages(Es, NodeInfo), + LcWs = lc_messages(Ws, NodeInfo), + Errors = badarg(Forms, State) ++ UsedGenVarMsgs++LcEs++BGens, + Warnings = LcWs, + {Errors,Warnings}. badarg(Forms, State) -> F = fun(_Id, {lc,_L,_E,_Qs}=LC, Es) -> @@ -230,54 +317,39 @@ badarg(Forms, State) -> {_,E0} = qlc_mapfold(F, [], Forms, State), E0. -tag_lines(E, No) -> - map_lines(fun(Id) -> - case is_lcid(Id) of - true -> Id; - false -> make_lcid(Id, No) - end - end, E). - -map_lines(F, E) -> - erl_lint:modify_line(E, F). - -tagged_messages(MsL) -> - [{File, - [{Loc,Mod,untag(T)} || {Loc0,Mod,T} <- Ms, - {true,Loc} <- [tloc(Loc0)]]} - || {File,Ms} <- MsL] - ++ +lc_nodes(E, NodeInfo) -> + erl_parse:map_anno(fun(Anno) -> + N = erl_anno:line(Anno), + [{N, Data}] = ets:lookup(NodeInfo, N), + NData = Data#{inside_lc => true}, + true = ets:insert(NodeInfo, {N, NData}), + Anno + end, E). + +used_genvar_messages(MsL, S) -> [{File,[{Loc,?APIMOD,{used_generator_variable,V}}]} - || {_, Ms} <- MsL, + || {_, Ms} <- MsL, {XLoc,erl_lint,{unbound_var,_}} <- Ms, - {Loc,File,V} <- [extra(XLoc)]]. - -tloc({Id,Column}) -> - {IsLcid,T} = tloc(Id), - {IsLcid,{T,Column}}; -tloc(Id) -> - IsLcid = is_lcid(Id), - {IsLcid,case IsLcid of - true -> get_lcid_line(Id); - false -> any - end}. - -extra({extra,Line,File,V}) -> - {Line,File,V}; -extra({Line,Column}) -> - case extra(Line) of - {L,File,V} -> {{L,Column},File,V}; - Else -> Else - end; -extra(Else) -> - Else. - -untag([E | Es]) -> [untag(E) | untag(Es)]; -untag(T) when is_tuple(T) -> list_to_tuple(untag(tuple_to_list(T))); -untag(E) -> - case is_lcid(E) of - true -> get_lcid_line(E); - false -> E + {Loc,File,V} <- [genvar_pos(XLoc, S)]]. + +lc_messages(MsL, NodeInfo) -> + [{File,[{Loc,Mod,T} || {Loc,Mod,T} <- Ms, lc_loc(Loc, NodeInfo)]} || + {File,Ms} <- MsL]. + +lc_loc(N, NodeInfo) -> + case ets:lookup(NodeInfo, N) of + [{N, #{inside_lc := true}}] -> + true; + [{N, _}] -> + false + end. + +genvar_pos(Location, S) -> + case ets:lookup(S#state.node_info, Location) of + [{Location, #{genvar_pos := Pos}}] -> + Pos; + [] -> + Location end. %% -> [{Qid,[variable()]}]. @@ -293,6 +365,7 @@ untag(E) -> %% variables (unless they are unsafe). %% intro_variables(FormsNoShadows, State) -> + NodeInfo = State#state.node_info, Fun = fun(QId, {T,_L,P0,_E0}=Q, {GVs,QIds}, Foo) when T =:= b_generate; T =:= generate -> PVs = qlc:var_ufold(fun({var,_,V}) -> {QId,V} end, P0), @@ -302,10 +375,11 @@ intro_variables(FormsNoShadows, State) -> %% where E is an LC expression consisting of a %% template mentioning all variables occurring in F. Vs = ordsets:to_list(qlc:vars(Filter0)), - Id = QId#qid.lcid, - LC1 = embed_vars(intro_set_line({QId,f1}, Vs), Id), - LC2 = embed_vars(intro_set_line({QId,f2}, Vs), Id), - AnyLine = -1, + AnyLine = anno0(), + Vars = [{var,AnyLine,V} || V <- Vs], + LC = embed_vars(Vars, AnyLine), + LC1 = intro_anno(LC, before, QId, NodeInfo), + LC2 = intro_anno(LC, 'after', QId, NodeInfo), Filter = {block,AnyLine,[LC1,Filter0,LC2]}, {Filter,{GVs,[{QId,[]} | QIds]},Foo} end, @@ -317,9 +391,15 @@ intro_variables(FormsNoShadows, State) -> Es0 = compile_errors(FForms), %% A variable is bound inside the filter if it is not bound before %% the filter, but it is bound after the filter (obviously). - Before = [{QId,V} || {{QId,f1},erl_lint,{unbound_var,V}} <- Es0], - After = [{QId,V} || {{QId,f2},erl_lint,{unbound_var,V}} <- Es0], - Unsafe = [{QId,V} || {{QId,f2},erl_lint,{unsafe_var,V,_Where}} <- Es0], + Before = [{QId,V} || + {L,erl_lint,{unbound_var,V}} <- Es0, + {_L,{QId,before}} <- ets:lookup(NodeInfo, L)], + After = [{QId,V} || + {L,erl_lint,{unbound_var,V}} <- Es0, + {_L,{QId,'after'}} <- ets:lookup(NodeInfo, L)], + Unsafe = [{QId,V} || + {L,erl_lint,{unsafe_var,V,_Where}} <- Es0, + {_L,{QId,'after'}} <- ets:lookup(NodeInfo, L)], ?DEBUG("Before = ~p~n", [Before]), ?DEBUG("After = ~p~n", [After]), ?DEBUG("Unsafe = ~p~n", [Unsafe]), @@ -328,9 +408,14 @@ intro_variables(FormsNoShadows, State) -> I1 = family(IV ++ GenVars), sofs:to_external(sofs:family_union(sofs:family(QIds), I1)). -intro_set_line(Tag, Vars) -> - L = erl_parse:set_line(1, fun(_) -> Tag end), - [{var,L,V} || V <- Vars]. +intro_anno(LC, Where, QId, NodeInfo) -> + Data = {QId,Where}, + Fun = fun(Anno) -> + Location = erl_anno:location(Anno), + true = ets:insert(NodeInfo, {Location,Data}), + Anno + end, + erl_parse:map_anno(Fun, save_anno(LC, NodeInfo)). compile_errors(FormsNoShadows) -> case compile_forms(FormsNoShadows, []) of @@ -341,11 +426,8 @@ compile_errors(FormsNoShadows) -> lists:flatmap(fun({_File,Es}) -> Es end, Errors) end. --define(MAX_NUM_OF_LINES, 23). % assume max 1^23 lines (> 8 millions) - compile_forms(Forms0, Options) -> - Forms = [F || F <- Forms0, element(1, F) =/= eof] ++ - [{eof,1 bsl ?MAX_NUM_OF_LINES}], + Forms = [F || F <- Forms0, element(1, F) =/= eof] ++ [{eof,anno0()}], try case compile:noenv_forms(Forms, compile_options(Options)) of {ok, _ModName, Ws0} -> @@ -384,20 +466,23 @@ bitstr_options() -> %% for each ListExpr. The expression mentions all introduced variables %% occurring in ListExpr. Running the function through the compiler %% yields error messages for erroneous use of introduced variables. -%% The messages have the form -%% {{extra,LineNo,File,Var},Module,{unbound_var,V}}, where Var is the -%% original variable name and V is the name invented by no_shadows/2. %% used_genvar_check(FormsNoShadows, State) -> - F = fun(QId, {T, Ln, _P, LE}=Q, {QsIVs0, Exprs0}, IVsSoFar0) + NodeInfo = State#state.node_info, + F = fun(QId, {T, Ln, _P, LE}=Q, {QsIVs0, Exprs0}, IVsSoFar0) when T =:= b_generate; T =:= generate -> - F = fun({var, _, V}=Var) -> - {var, L, OrigVar} = undo_no_shadows(Var), - AF = fun(Line) -> - {extra, Line, get(?QLC_FILE), OrigVar} - end, - L2 = erl_parse:set_line(L, AF), - {var, L2, V} + F = fun(Var) -> + {var, Anno0, OrigVar} = + undo_no_shadows(Var, State), + {var, Anno, _} = NewVar = save_anno(Var, NodeInfo), + Location0 = erl_anno:location(Anno0), + Location = erl_anno:location(Anno), + [{Location, Data}] = + ets:lookup(NodeInfo, Location), + Pos = {Location0,get(?QLC_FILE),OrigVar}, + NData = Data#{genvar_pos => Pos}, + true = ets:insert(NodeInfo, {Location, NData}), + NewVar end, Vs = [Var || {var, _, V}=Var <- qlc:var_fold(F, [], LE), lists:member(V, IVsSoFar0)], @@ -411,12 +496,12 @@ used_genvar_check(FormsNoShadows, State) -> {QsIVs, IVsSoFar} = q_intro_vars(QId, QsIVs0, IVsSoFar0), {Filter, {QsIVs, Exprs}, IVsSoFar} end, - IntroVars = intro_variables(FormsNoShadows, State), - Acc0 = {IntroVars, [{atom, 0, true}]}, + Acc0 = {State#state.intro_vars, [{atom, anno0(), true}]}, {_, {[], Exprs}} = qual_fold(F, Acc0, [], FormsNoShadows, State), FunctionNames = [Name || {function, _, Name, _, _} <- FormsNoShadows], UniqueFName = qlc:aux_name(used_genvar, 1, sets:from_list(FunctionNames)), - {function,0,UniqueFName,0,[{clause,0,[],[],lists:reverse(Exprs)}]}. + A = anno0(), + {function,A,UniqueFName,0,[{clause,A,[],[],lists:reverse(Exprs)}]}. q_intro_vars(QId, [{QId, IVs} | QsIVs], IVsSoFar) -> {QsIVs, IVs ++ IVsSoFar}. @@ -514,7 +599,8 @@ q_intro_vars(QId, [{QId, IVs} | QsIVs], IVsSoFar) -> {QsIVs, IVs ++ IVsSoFar}. %% (calling LEf returns the objects generated by LE). transform(FormsNoShadows, State) -> - IntroVars = intro_variables(FormsNoShadows, State), + _ = erlang:system_flag(backtrace_depth, 500), + IntroVars = State#state.intro_vars, AllVars = sets:from_list(ordsets:to_list(qlc:vars(FormsNoShadows))), ?DEBUG("AllVars = ~p~n", [sets:to_list(AllVars)]), F1 = fun(QId, {generate,_,P,LE}, Foo, {GoI,SI}) -> @@ -588,8 +674,8 @@ transform(FormsNoShadows, State) -> [{match,L,{var,L,Fun},FunC}, {call,L,{var,L,Fun},As0}]}]}}, {ok, OrigE0} = dict:find(Id, Source), - OrigE = undo_no_shadows(OrigE0), - QCode = qcode(OrigE, XQCs, Source, L), + OrigE = undo_no_shadows(OrigE0, State), + QCode = qcode(OrigE, XQCs, Source, L, State), Qdata = qdata(XQCs, L), TemplateInfo = template_columns(Qs, E, AllIVs, Dependencies, State), @@ -598,7 +684,7 @@ transform(FormsNoShadows, State) -> Opt = opt_info(TemplateInfo, SizeInfo, JoinInfo, MSQs, L, EqColumnConstants, EqualColumnConstants), LCTuple = - case qlc_kind(OrigE, Qs) of + case qlc_kind(OrigE, Qs, State) of qlc -> {tuple,L,[?A(qlc_v1),FunW,QCode,Qdata,Opt]}; {simple, PL, LE, V} -> @@ -612,7 +698,7 @@ transform(FormsNoShadows, State) -> end, {NForms,{[],XW}} = qlc_mapfold(F2, {IntroVars,[]}, ModifiedForms1, State), display_forms(NForms), - {restore_line_numbers(NForms), State#state{xwarnings = XW}}. + {NForms, State#state{xwarnings = XW}}. join_kind(Qs, LcL, AllIVs, Dependencies, State) -> {EqualCols2, EqualColsN} = equal_columns(Qs, AllIVs, Dependencies, State), @@ -623,20 +709,21 @@ join_kind(Qs, LcL, AllIVs, Dependencies, State) -> if EqualColsN =/= []; MatchColsN =/= [] -> {[], - [{get(?QLC_FILE),[{abs(LcL),?APIMOD,too_complex_join}]}]}; + [{get(?QLC_FILE),[{LcL,?APIMOD,too_complex_join}]}]}; EqualCols2 =:= [], MatchCols2 =:= [] -> {[], []}; length(Tables) > 2 -> {[], - [{get(?QLC_FILE),[{abs(LcL),?APIMOD,too_many_joins}]}]}; + [{get(?QLC_FILE),[{LcL,?APIMOD,too_many_joins}]}]}; EqualCols2 =:= MatchCols2 -> {EqualCols2, []}; true -> {{EqualCols2, MatchCols2}, []} end. -qlc_kind(OrigE, Qs) -> - {OrigFilterData, OrigGeneratorData} = qual_data(undo_no_shadows(Qs)), +qlc_kind(OrigE, Qs, State) -> + {OrigFilterData, OrigGeneratorData} = + qual_data(undo_no_shadows(Qs, State)), OrigAllFilters = filters_as_one(OrigFilterData), {_FilterData, GeneratorData} = qual_data(Qs), case {OrigE, OrigAllFilters, OrigGeneratorData} of @@ -663,12 +750,12 @@ warn_failing_qualifiers(Qualifiers, AllIVs, Dependencies, State) -> lists:foldl(fun({_QId,{fil,_Filter}}, {[]=Frames,Warnings}) -> {Frames,Warnings}; ({_QId,{fil,Filter}}, {Frames,Warnings}) -> - case filter(set_line(Filter, 0), Frames, BindFun, + case filter(reset_anno(Filter), Frames, BindFun, State, Imported) of [] -> {[], [{get(?QLC_FILE), - [{abs_loc(element(2, Filter)),?APIMOD, + [{loc(element(2, Filter)),?APIMOD, nomatch_filter}]} | Warnings]}; Frames1 -> {Frames1,Warnings} @@ -678,7 +765,7 @@ warn_failing_qualifiers(Qualifiers, AllIVs, Dependencies, State) -> {failed, _, _} -> {Frames, [{get(?QLC_FILE), - [{abs_loc(element(2, Pattern)),?APIMOD, + [{loc(element(2, Pattern)),?APIMOD, nomatch_pattern}]} | Warnings]}; _ -> {Frames,Warnings} @@ -751,8 +838,8 @@ opt_constants(L, ColumnConstants) -> || IdNo <- Ns] ++ [{clause,L,[?V('_')],[],[?A(no_column_fun)]}]. -abstr(Term, Line) -> - erl_parse:abstract(Term, Line). +abstr(Term, Anno) -> + erl_parse:abstract(Term, loc(Anno)). %% Extra generators are introduced for join. join_quals(JoinInfo, QCs, L, LcNo, ExtraConstants, AllVars) -> @@ -837,9 +924,10 @@ join_handle(AP, L, [F, H, O, C], Constants) -> {{var, _, _}, []} -> {'fun',L,{clauses,[{clause,L,[H],[],[H]}]}}; _ -> + A = anno0(), G0 = [begin - Call = {call,0,{atom,0,element},[{integer,0,Col},O]}, - list2op([{op,0,Op,Con,Call} || {Con,Op} <- Cs], 'or') + Call = {call,A,{atom,A,element},[{integer,A,Col},O]}, + list2op([{op,A,Op,Con,Call} || {Con,Op} <- Cs], 'or') end || {Col,Cs} <- Constants], G = if G0 =:= [] -> G0; true -> [G0] end, CC1 = {clause,L,[AP],G,[{cons,L,O,closure({call,L,F,[F,C]},L)}]}, @@ -876,14 +964,15 @@ join_handle_constants(QId, ExtraConstants) -> %% order the traverse fun would return them. column_fun(Columns, QualifierNumber, LcL) -> + A = anno0(), ColCls0 = [begin true = Vs0 =/= [], % at least one value to look up Vs1 = list2cons(Vs0), - Fils1 = {tuple,0,[{atom,0,FTag}, + Fils1 = {tuple,A,[{atom,A,FTag}, lists:foldr - (fun(F, A) -> {cons,0,{integer,0,F},A} - end, {nil,0}, Fils)]}, + (fun(F, Ac) -> {cons,A,{integer,A,F},Ac} + end, {nil,A}, Fils)]}, Tag = case ordsets:to_list(qlc:vars(Vs1)) of Imp when length(Imp) > 0, % imported vars length(Vs0) > 1 -> @@ -891,13 +980,13 @@ column_fun(Columns, QualifierNumber, LcL) -> _ -> values end, - Vs = {tuple,0,[{atom,0,Tag},Vs1,Fils1]}, - {clause,0,[erl_parse:abstract(Col)],[],[Vs]} + Vs = {tuple,A,[{atom,A,Tag},Vs1,Fils1]}, + {clause,A,[erl_parse:abstract(Col)],[],[Vs]} end || {{CIdNo,Col}, Vs0, {FTag,Fils}} <- Columns, CIdNo =:= QualifierNumber] - ++ [{clause,0,[{var,0,'_'}],[],[{atom,0,false}]}], - ColCls = set_line(ColCls0, LcL), + ++ [{clause,A,[{var,A,'_'}],[],[{atom,A,false}]}], + ColCls = set_anno(ColCls0, LcL), {'fun', LcL, {clauses, ColCls}}. %% Tries to find columns of the template that (1) are equal to (or @@ -920,7 +1009,7 @@ template_columns(Qs0, E0, AllIVs, Dependencies, State) -> MatchColumns = eq_columns2(Qs, AllIVs, Dependencies, State), Equal = template_cols(EqualColumns), Match = template_cols(MatchColumns), - L = 0, + L = anno0(), if Match =:= Equal -> [{?V('_'), Match}]; @@ -947,7 +1036,7 @@ template_cols(ColumnClasses) -> template_as_pattern(E) -> P = simple_template(E), - {?TID,foo,foo,{gen,P,{nil,0}}}. + {?TID,foo,foo,{gen,P,{nil,anno0()}}}. simple_template({call,L,{remote,_,{atom,_,erlang},{atom,_,element}}=Call, [{integer,_,I}=A1,A2]}) when I > 0 -> @@ -1004,10 +1093,10 @@ match_spec_quals(Template, Dependencies, Qualifiers, State) -> GQId =:= QId2, {FQId,{fil,F}}=Filter <- Filters, % guard filters only FQId =:= QId] - ++ [{GId#qid.no,Pattern,[],{atom,0,true}} || + ++ [{GId#qid.no,Pattern,[],{atom,anno0(),true}} || {GId,{gen,Pattern,_}} <- GeneratorData, lists:member(GId, NoFilterGIds)], - E = {nil, 0}, + E = {nil, anno0()}, GF = [{{GNum,Pattern},Filter} || {GNum,Pattern,Filter,F} <- Candidates, no =/= try_ms(E, Pattern, F, State)], @@ -1024,7 +1113,7 @@ match_spec_quals(Template, Dependencies, Qualifiers, State) -> %% expressione can be replaced by a match specification. [{GNum, AbstrMS, all}] catch _:_ -> - {TemplVar, _} = anon_var({var,0,'_'}, 0), + {TemplVar, _} = anon_var({var,anno0(),'_'}, 0), [one_gen_match_spec(GNum, Pattern, GFilterData, State, TemplVar) || {{GNum,Pattern},GFilterData} <- GFFL] end. @@ -1038,7 +1127,7 @@ gen_ms(E, Pattern, GFilterData, State) -> {ok, MS, AMS} = try_ms(E, Pattern, filters_as_one(GFilterData), State), case MS of [{'$1',[true],['$1']}] -> - {atom, 0, no_match_spec}; + {atom, anno0(), no_match_spec}; _ -> AMS end. @@ -1060,7 +1149,7 @@ pattern_as_template({match,_,_E,{var,_,_}=V}=P, _TemplVar) -> pattern_as_template({match,_,{var,_,_}=V,_E}=P, _TemplVar) -> {V, P}; pattern_as_template(E, TemplVar) -> - L = 0, + L = anno0(), {TemplVar, {match, L, E, TemplVar}}. %% Tries to find columns which are compared or matched against @@ -1203,7 +1292,7 @@ lu_skip(ColConstants, FilterData, PatternFrame, PatternVars, ColFil = [{Column, FId#qid.no} || {FId,{fil,Fil}} <- filter_list(FilterData, Dependencies, State), - [] =/= (SFs = safe_filter(set_line(Fil, 0), PatternFrames, + [] =/= (SFs = safe_filter(reset_anno(Fil), PatternFrames, BindFun, State, Imported)), {GId,PV} <- PatternVars, [] =/= @@ -1392,7 +1481,7 @@ join_skip(JoinClasses, FilterData, PatternFrame, PatternVars, Dependencies, JF = unify(JoinOp, V1, V2, JF2, BindFun, Imported), %% "Run" the filter: - SFs = safe_filter(set_line(Fil, 0), PatternFrames, + SFs = safe_filter(reset_anno(Fil), PatternFrames, BindFun, State, Imported), JImp = qlc:vars([SFs, JF]), % kludge lists:all(fun(Frame) -> @@ -1403,7 +1492,7 @@ join_skip(JoinClasses, FilterData, PatternFrame, PatternVars, Dependencies, filter_info(FilterData, AllIVs, Dependencies, State) -> FilterList = filter_list(FilterData, Dependencies, State), - Filter0 = set_line(filters_as_one(FilterList), 0), + Filter0 = reset_anno(filters_as_one(FilterList)), Anon0 = 0, {Filter, Anon1} = anon_var(Filter0, Anon0), Imported = ordsets:subtract(qlc:vars(Filter), % anonymous too @@ -1510,7 +1599,7 @@ pattern(P0, AnonI, Frame0, BindFun, State) -> catch _:_ -> P0 % template, records already expanded end, %% Makes test for equality simple: - P2 = set_line(P1, 0), + P2 = reset_anno(P1), {P3, AnonN} = anon_var(P2, AnonI), {P4, F1} = match_in_pattern(tuple2cons(P3), Frame0, BindFun), {P, F2} = element_calls(P4, F1, BindFun, _Imp=[]), % kludge for templates @@ -1550,8 +1639,11 @@ anon_var(E, AnonI) -> (Var, N) -> {Var, N} end, AnonI, E). -set_line(T, L) -> - map_lines(fun(_L) -> L end, T). +reset_anno(T) -> + set_anno(T, anno0()). + +set_anno(T, A) -> + erl_parse:map_anno(fun(_L) -> A end, T). -record(fstate, {state, bind_fun, imported}). @@ -1673,7 +1765,7 @@ frames_to_columns(Fs, PatternVars, DerefFun, SelectorFun, Imp, CompOp) -> %% same variables have to be the representatives in every frame.) SizesVarsL = [begin - PatVar = {var,0,PV}, + PatVar = {var,anno0(),PV}, PatternSizes = [pattern_size([F], PatVar, false) || F <- Fs], MaxPZ = lists:max([0 | PatternSizes -- [undefined]]), @@ -1692,8 +1784,8 @@ frames_to_columns(Fs, PatternVars, DerefFun, SelectorFun, Imp, CompOp) -> frames2cols(Fs, PatN, PatSizes, Vars, DerefFun, SelectorFun, CompOp) -> Rs = [ begin RL = [{{PatN,Col},cons2tuple(element(2, Const))} || - {V, Col} <- lists:zip(sublist(Vars, PatSz), - seq(1, PatSz)), + {V, Col} <- lists:zip(lists:sublist(Vars, PatSz), + lists:seq(1, PatSz)), %% Do not handle the case where several %% values compare equal, e.g. "X =:= 1 %% andalso X == 1.0". Looking up both @@ -1722,11 +1814,11 @@ frames2cols(Fs, PatN, PatSizes, Vars, DerefFun, SelectorFun, CompOp) -> [C || {_,Vs}=C <- sofs:to_external(Cs), not col_ignore(Vs, CompOp)]. pat_vars(N) -> - [unique_var() || _ <- seq(1, N)]. + [unique_var() || _ <- lists:seq(1, N)]. pat_tuple(Sz, Vars) when is_integer(Sz), Sz > 0 -> TupleTail = unique_var(), - {cons_tuple, list2cons(sublist(Vars, Sz) ++ TupleTail)}; + {cons_tuple, list2cons(lists:sublist(Vars, Sz) ++ TupleTail)}; pat_tuple(_, _Vars) -> unique_var(). @@ -1740,7 +1832,7 @@ col_ignore(Vs, '==') -> pattern_sizes(PatternVars, Fs) -> [{QId#qid.no, Size} || {QId,PV} <- PatternVars, - undefined =/= (Size = pattern_size(Fs, {var,0,PV}, true))]. + undefined =/= (Size = pattern_size(Fs, {var,anno0(),PV}, true))]. pattern_size(Fs, PatternVar, Exact) -> Fun = fun(F) -> (deref_pattern(_Imported = []))(PatternVar, F) end, @@ -1768,7 +1860,8 @@ prep_expr(E, F, S, BF, Imported) -> element_calls(tuple2cons(expand_expr_records(E, S)), F, BF, Imported). unify_column(Frame, Var, Col, BindFun, Imported) -> - Call = {call,0,{atom,0,element},[{integer,0,Col}, {var,0,Var}]}, + A = anno0(), + Call = {call,A,{atom,A,element},[{integer,A,Col}, {var,A,Var}]}, element_calls(Call, Frame, BindFun, Imported). %% cons_tuple is used for representing {V1, ..., Vi | TupleTail}. @@ -1800,19 +1893,21 @@ element_calls(E, F, _BF, _Imported) -> {E, F}. unique_var() -> - {var, 0, make_ref()}. + {var, anno0(), make_ref()}. is_unique_var({var, _L, V}) -> is_reference(V). expand_pattern_records(P, State) -> - E = {'case',0,{atom,0,true},[{clause,0,[P],[],[{atom,0,true}]}]}, - {'case',_,_,[{clause,0,[NP],_,_}]} = expand_expr_records(E, State), + A = anno0(), + E = {'case',A,{atom,A,true},[{clause,A,[P],[],[{atom,A,true}]}]}, + {'case',_,_,[{clause,A,[NP],_,_}]} = expand_expr_records(E, State), NP. expand_expr_records(E, State) -> RecordDefs = State#state.records, - Forms = RecordDefs ++ [{function,1,foo,0,[{clause,1,[],[],[pe(E)]}]}], + A = anno1(), + Forms = RecordDefs ++ [{function,A,foo,0,[{clause,A,[],[],[pe(E)]}]}], [{function,_,foo,0,[{clause,_,[],[],[NE]}]}] = erl_expand_records:module(Forms, [no_strict_record_tests]), NE. @@ -2126,15 +2221,15 @@ tuple2cons(E) -> E. list2cons([E | Es]) -> - {cons, 0, E, list2cons(Es)}; + {cons, anno0(), E, list2cons(Es)}; list2cons([]) -> - {nil, 0}; + {nil, anno0()}; list2cons(E) -> E. %% Returns {..., Variable} if Variable is a tuple tail. cons2tuple({cons_tuple, Es}) -> - {tuple, 0, cons2list(Es)}; + {tuple, anno0(), cons2list(Es)}; cons2tuple(T) when is_tuple(T) -> list_to_tuple(cons2tuple(tuple_to_list(T))); cons2tuple([E | Es]) -> @@ -2173,11 +2268,10 @@ bindings_subset(F1, F2, Imp) -> %% not to have guard semantics, affected filters will have to be %% recognized and excluded here as well. try_ms(E, P, Fltr, State) -> - L = 1, + L = anno1(), Fun = {'fun',L,{clauses,[{clause,L,[P],[[Fltr]],[E]}]}}, Expr = {call,L,{remote,L,{atom,L,ets},{atom,L,fun2ms}},[Fun]}, - Form0 = {function,L,foo,0,[{clause,L,[],[],[Expr]}]}, - Form = restore_line_numbers(Form0), + Form = {function,L,foo,0,[{clause,L,[],[],[Expr]}]}, X = ms_transform:parse_transform(State#state.records ++ [Form], []), case catch begin @@ -2194,11 +2288,11 @@ try_ms(E, P, Fltr, State) -> end. filters_as_one([]) -> - {atom, 0, true}; + {atom, anno0(), true}; filters_as_one(FilterData) -> [{_,{fil,Filter1}} | Filters] = lists:reverse(FilterData), lists:foldr(fun({_QId,{fil,Filter}}, AbstF) -> - {op,0,'andalso',Filter,AbstF} + {op,anno0(),'andalso',Filter,AbstF} end, Filter1, Filters). qual_data(Qualifiers) -> @@ -2233,38 +2327,40 @@ qdata([], L) -> {nil,L}. qcon(Cs) -> - list2cons([{tuple,0,[{integer,0,Col},list2cons(qcon1(ConstOps))]} || + A = anno0(), + list2cons([{tuple,A,[{integer,A,Col},list2cons(qcon1(ConstOps))]} || {Col,ConstOps} <- Cs]). qcon1(ConstOps) -> - [{tuple,0,[Const,abstr(Op, 0)]} || {Const,Op} <- ConstOps]. + A = anno0(), + [{tuple,A,[Const,abstr(Op, A)]} || {Const,Op} <- ConstOps]. %% The original code (in Source) is used for filters and the template %% since the translated code can have QLCs and we don't want them to %% be visible. -qcode(E, QCs, Source, L) -> +qcode(E, QCs, Source, L, State) -> CL = [begin Bin = term_to_binary(C, [compressed]), {bin, L, [{bin_element, L, {string, L, binary_to_list(Bin)}, default, default}]} end || {_,C} <- lists:keysort(1, [{qlc:template_state(),E} | - qcode(QCs, Source)])], + qcode(QCs, Source, State)])], {'fun', L, {clauses, [{clause, L, [], [], [{tuple, L, CL}]}]}}. -qcode([{_QId, {_QIvs, {{gen,P,_LE,_GV}, GoI, _SI}}} | QCs], Source) -> - [{GoI,undo_no_shadows(P)} | qcode(QCs, Source)]; -qcode([{QId, {_QIVs, {{fil,_F}, GoI, _SI}}} | QCs], Source) -> +qcode([{_QId, {_QIvs, {{gen,P,_LE,_GV}, GoI, _SI}}} | QCs], Source, State) -> + [{GoI,undo_no_shadows(P, State)} | qcode(QCs, Source, State)]; +qcode([{QId, {_QIVs, {{fil,_F}, GoI, _SI}}} | QCs], Source, State) -> {ok,OrigF} = dict:find(QId, Source), - [{GoI,undo_no_shadows(OrigF)} | qcode(QCs, Source)]; -qcode([], _Source) -> + [{GoI,undo_no_shadows(OrigF, State)} | qcode(QCs, Source, State)]; +qcode([], _Source, _State) -> []. closure(Code, L) -> {'fun',L,{clauses,[{clause,L,[],[],[Code]}]}}. -simple(L, Var, Init, Line) -> - {tuple,L,[?A(simple_v1),?A(Var),Init,?I(Line)]}. +simple(L, Var, Init, Anno) -> + {tuple,L,[?A(simple_v1),?A(Var),Init,abstr(loc(Anno), Anno)]}. clauses([{QId,{QIVs,{QualData,GoI,S}}} | QCs], RL, Fun, Go, NGV, E, IVs,St) -> ?DEBUG("QIVs = ~p~n", [QIVs]), @@ -2426,19 +2522,22 @@ aux_var(Name, LcN, QN, N, AllVars) -> qlc:aux_name(lists:concat([Name, LcN, '_', QN, '_']), N, AllVars). no_compiler_warning(L) -> - erl_parse:set_line(L, fun(Line) -> -abs(Line) end). + Anno = erl_anno:new(L), + erl_anno:set_generated(true, Anno). -abs_loc(L) -> - loc(erl_parse:set_line(L, fun(Line) -> abs(Line) end)). - -loc(L) -> - {location,Location} = erl_parse:get_attribute(L, location), - Location. +loc(A) -> + erl_anno:location(A). list2op([E], _Op) -> E; list2op([E | Es], Op) -> - {op,0,Op,E,list2op(Es, Op)}. + {op,anno0(),Op,E,list2op(Es, Op)}. + +anno0() -> + erl_anno:new(0). + +anno1() -> + erl_anno:new(1). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2491,13 +2590,61 @@ qlcmf(T, _F, _Imp, A, No) -> occ_vars(E) -> qlc:var_fold(fun({var,_L,V}) -> V end, [], E). +%% Every Anno is replaced by a unique number. The number is used in a +%% table that holds data about the abstract node where Anno resides. +%% In particular, the original location is kept there, so that the +%% original abstract code can be re-created. +save_anno(Abstr, NodeInfo) -> + F = fun(Anno) -> + N = next_slot(NodeInfo), + Location = erl_anno:location(Anno), + Data = {N, #{location => Location}}, + true = ets:insert(NodeInfo, Data), + erl_anno:new(N) + end, + erl_parse:map_anno(F, Abstr). + +next_slot(T) -> + I = ets:update_counter(T, var_n, 1), + case ets:lookup(T, I) of + [] -> + I; + _ -> + next_slot(T) + end. + +restore_anno(Abstr, NodeInfo) -> + F = fun(Anno) -> + Location = erl_anno:location(Anno), + case ets:lookup(NodeInfo, Location) of + [{Location, Data}] -> + OrigLocation = maps:get(location, Data), + erl_anno:set_location(OrigLocation, Anno); + [{Location}] -> % generated code + Anno; + [] -> + Anno + end + end, + erl_parse:map_anno(F, Abstr). + +restore_loc(Location, #state{node_info = NodeInfo}) -> + case ets:lookup(NodeInfo, Location) of + [{Location, #{location := OrigLocation}}] -> + OrigLocation; + [{Location}] -> + Location; + [] -> + Location + end. + no_shadows(Forms0, State) -> %% Variables that may shadow other variables are introduced in %% LCs and Funs. Such variables (call them SV, Shadowing %% Variables) are now renamed. Each (new) occurrence in a pattern %% is assigned an index (integer), unique in the file. %% - %% The state {LastIndex,ActiveVars,UsedVars,AllVars,Singletons} + %% The state {LastIndex,ActiveVars,UsedVars,AllVars,Singletons,State} %% holds the last index used for each SV (LastIndex), the SVs in %% the current scope (ActiveVars), used SVs (UsedVars, the indexed %% name is the key), all variables occurring in the file @@ -2507,16 +2654,15 @@ no_shadows(Forms0, State) -> %% the indexed name of an SV occurs in the file, next index is %% tried (to avoid mixing up introduced names with existing ones). %% - %% The original names of variables are kept in the line number - %% position of the abstract code: {var, {nos, OriginalName, L}, - %% NewName}. undo_no_shadows/1 re-creates the original code. + %% The original names of variables are kept in a table in State. + %% undo_no_shadows/2 re-creates the original code. AllVars = sets:from_list(ordsets:to_list(qlc:vars(Forms0))), ?DEBUG("nos AllVars = ~p~n", [sets:to_list(AllVars)]), VFun = fun(_Id, LC, Vs) -> nos(LC, Vs) end, LI = ets:new(?APIMOD,[]), UV = ets:new(?APIMOD,[]), D0 = dict:new(), - S1 = {LI, D0, UV, AllVars, []}, + S1 = {LI, D0, UV, AllVars, [], State}, _ = qlc_mapfold(VFun, S1, Forms0, State), ?DEBUG("UsedIntroVars = ~p~n", [ets:match_object(UV, '_')]), Singletons = ets:select(UV, ets:fun2ms(fun({K,0}) -> K end)), @@ -2524,7 +2670,7 @@ no_shadows(Forms0, State) -> true = ets:delete_all_objects(LI), true = ets:delete_all_objects(UV), %% Do it again, this time we know which variables are singletons. - S2 = {LI, D0, UV, AllVars, Singletons}, + S2 = {LI, D0, UV, AllVars, Singletons, State}, {Forms,_} = qlc_mapfold(VFun, S2, Forms0, State), true = ets:delete(LI), true = ets:delete(UV), @@ -2568,11 +2714,11 @@ nos({lc,L,E0,Qs0}, S) -> {Qs, S1} = lists:mapfoldl(F, S, Qs0), {E, _} = nos(E0, S1), {{lc,L,E,Qs}, S}; -nos({var,L,V}=Var, {_LI,Vs,UV,_A,_Sg}=S) when V =/= '_' -> +nos({var,L,V}=Var, {_LI,Vs,UV,_A,_Sg,State}=S) when V =/= '_' -> case used_var(V, Vs, UV) of {true, VN} -> - NL = nos_var(L, V), - {{var,NL,VN}, S}; + nos_var(L, V, State), + {{var,L,VN}, S}; false -> {Var, S} end; @@ -2590,7 +2736,7 @@ nos_pattern([P0 | Ps0], S0, PVs0) -> {P, S1, PVs1} = nos_pattern(P0, S0, PVs0), {Ps, S, PVs} = nos_pattern(Ps0, S1, PVs1), {[P | Ps], S, PVs}; -nos_pattern({var,L,V}, {LI,Vs0,UV,A,Sg}, PVs0) when V =/= '_' -> +nos_pattern({var,L,V}, {LI,Vs0,UV,A,Sg,State}, PVs0) when V =/= '_' -> {Name, Vs, PVs} = case lists:keyfind(V, 1, PVs0) of {V, VN} -> @@ -2604,16 +2750,25 @@ nos_pattern({var,L,V}, {LI,Vs0,UV,A,Sg}, PVs0) when V =/= '_' -> end, {N, Vs1, [{V,VN} | PVs0]} end, - NL = nos_var(L, V), - {{var,NL,Name}, {LI,Vs,UV,A,Sg}, PVs}; + nos_var(L, V, State), + {{var,L,Name}, {LI,Vs,UV,A,Sg,State}, PVs}; nos_pattern(T, S0, PVs0) when is_tuple(T) -> {TL, S, PVs} = nos_pattern(tuple_to_list(T), S0, PVs0), {list_to_tuple(TL), S, PVs}; nos_pattern(T, S, PVs) -> {T, S, PVs}. -nos_var(L, Name) -> - erl_parse:set_line(L, fun(Line) -> {nos,Name,Line} end). +nos_var(Anno, Name, State) -> + NodeInfo = State#state.node_info, + Location = erl_anno:location(Anno), + case ets:lookup(NodeInfo, Location) of + [{Location, #{name := _}}] -> + true; + [{Location, Data}] -> + true = ets:insert(NodeInfo, {Location, Data#{name => Name}}); + [] -> % cannot happen + true + end. used_var(V, Vs, UV) -> case dict:find(V, Vs) of @@ -2638,69 +2793,30 @@ next_var(V, Vs, AllVars, LI, UV) -> {VN, NVs} end. -undo_no_shadows(E) -> - var_map(fun undo_no_shadows1/1, E). - -undo_no_shadows1({var, L, _}=Var) -> - case erl_parse:get_attribute(L, line) of - {line,{nos,V,_VL}} -> - NL = erl_parse:set_line(L, fun({nos,_V,VL}) -> VL end), - undo_no_shadows1({var, NL, V}); - _Else -> - Var - end. - -restore_line_numbers(E) -> - var_map(fun restore_line_numbers1/1, E). +undo_no_shadows(E, State) -> + var_map(fun(Anno) -> undo_no_shadows1(Anno, State) end, E). -restore_line_numbers1({var, L, V}=Var) -> - case erl_parse:get_attribute(L, line) of - {line,{nos,_,_}} -> - NL = erl_parse:set_line(L, fun({nos,_V,VL}) -> VL end), - restore_line_numbers1({var, NL, V}); - _Else -> +undo_no_shadows1({var, Anno, _}=Var, State) -> + Location = erl_anno:location(Anno), + NodeInfo = State#state.node_info, + case ets:lookup(NodeInfo, Location) of + [{Location, #{name := Name}}] -> + {var, Anno, Name}; + _ -> Var end. %% QLC identifier. %% The first one encountered in the file has No=1. -make_lcid(Attrs, No) when is_integer(No), No > 0 -> - F = fun(Line) when is_integer(Line), Line < (1 bsl ?MAX_NUM_OF_LINES) -> - sgn(Line) * ((No bsl ?MAX_NUM_OF_LINES) + sgn(Line) * Line) - end, - erl_parse:set_line(Attrs, F). - -is_lcid(Attrs) -> - try - {line,Id} = erl_parse:get_attribute(Attrs, line), - is_integer(Id) andalso (abs(Id) > (1 bsl ?MAX_NUM_OF_LINES)) - catch _:_ -> - false - end. - -get_lcid_no(IdAttrs) -> - {line,Id} = erl_parse:get_attribute(IdAttrs, line), - abs(Id) bsr ?MAX_NUM_OF_LINES. - -get_lcid_line(IdAttrs) -> - {line,Id} = erl_parse:get_attribute(IdAttrs, line), - sgn(Id) * (abs(Id) band ((1 bsl ?MAX_NUM_OF_LINES) - 1)). +make_lcid(Anno, No) when is_integer(No), No > 0 -> + {No, erl_anno:line(Anno)}. -sgn(X) when X >= 0 -> - 1; -sgn(X) when X < 0 -> - -1. +get_lcid_no({No, _Line}) -> + No. -seq(S, E) when S - E =:= 1 -> - []; -seq(S, E) -> - lists:seq(S, E). - -sublist(_, 0) -> - []; -sublist(L, N) -> - lists:sublist(L, N). +get_lcid_line({_No, Line}) -> + Line. qid(LCId, No) -> #qid{no = No, lcid = LCId}. diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl new file mode 100644 index 0000000000..6a805eb69e --- /dev/null +++ b/lib/stdlib/src/rand.erl @@ -0,0 +1,591 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% ===================================================================== +%% Multiple PRNG module for Erlang/OTP +%% Copyright (c) 2015 Kenji Rikitake +%% ===================================================================== + +-module(rand). + +-export([seed_s/1, seed_s/2, seed/1, seed/2, + export_seed/0, export_seed_s/1, + uniform/0, uniform/1, uniform_s/1, uniform_s/2, + normal/0, normal_s/1 + ]). + +-compile({inline, [exs64_next/1, exsplus_next/1, + exs1024_next/1, exs1024_calc/2, + get_52/1, normal_kiwi/1]}). + +-define(DEFAULT_ALG_HANDLER, exsplus). +-define(SEED_DICT, rand_seed). + +%% ===================================================================== +%% Types +%% ===================================================================== + +%% 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()}. + +%% Internal state +-opaque state() :: {alg_handler(), alg_seed()}. +-type alg() :: exs64 | exsplus | exs1024. +-opaque export_state() :: {alg(), alg_seed()}. +-export_type([alg/0, state/0, export_state/0]). + +%% ===================================================================== +%% API +%% ===================================================================== + +%% Return algorithm and seed so that RNG state can be recreated with seed/1 +-spec export_seed() -> undefined | export_state(). +export_seed() -> + case seed_get() of + {#{type:=Alg}, Seed} -> {Alg, Seed}; + _ -> undefined + end. + +-spec export_seed_s(state()) -> export_state(). +export_seed_s({#{type:=Alg}, Seed}) -> {Alg, Seed}. + +%% seed(Alg) seeds RNG with runtime dependent values +%% and return the NEW state + +%% seed({Alg,Seed}) setup RNG with a previously exported seed +%% and return the NEW state + +-spec seed(AlgOrExpState::alg() | export_state()) -> state(). +seed(Alg) -> + R = seed_s(Alg), + _ = seed_put(R), + R. + +-spec seed_s(AlgOrExpState::alg() | export_state()) -> state(). +seed_s(Alg) when is_atom(Alg) -> + seed_s(Alg, {erlang:phash2([{node(),self()}]), + erlang:system_time(), + erlang:unique_integer()}); +seed_s({Alg0, Seed}) -> + {Alg,_SeedFun} = mk_alg(Alg0), + {Alg, Seed}. + +%% seed/2: seeds RNG with the algorithm and given values +%% and returns the NEW state. + +-spec seed(Alg :: alg(), {integer(), integer(), integer()}) -> state(). +seed(Alg0, S0) -> + State = seed_s(Alg0, S0), + _ = seed_put(State), + State. + +-spec seed_s(Alg :: alg(), {integer(), integer(), integer()}) -> state(). +seed_s(Alg0, S0 = {_, _, _}) -> + {Alg, Seed} = mk_alg(Alg0), + AS = Seed(S0), + {Alg, AS}. + +%%% uniform/0, uniform/1, uniform_s/1, uniform_s/2 are all +%%% uniformly distributed random numbers. + +%% uniform/0: returns a random float X where 0.0 < X < 1.0, +%% updating the state in the process dictionary. + +-spec uniform() -> X::float(). +uniform() -> + {X, Seed} = uniform_s(seed_get()), + _ = seed_put(Seed), + X. + +%% uniform/1: given an integer N >= 1, +%% uniform/1 returns a random integer X where 1 =< X =< N, +%% updating the state in the process dictionary. + +-spec uniform(N :: pos_integer()) -> X::pos_integer(). +uniform(N) -> + {X, Seed} = uniform_s(N, seed_get()), + _ = seed_put(Seed), + X. + +%% uniform_s/1: given a state, uniform_s/1 +%% returns a random float X where 0.0 < X < 1.0, +%% and a new state. + +-spec uniform_s(state()) -> {X::float(), NewS :: state()}. +uniform_s(State = {#{uniform:=Uniform}, _}) -> + Uniform(State). + +%% uniform_s/2: given an integer N >= 1 and a state, uniform_s/2 +%% uniform_s/2 returns a random integer X where 1 =< X =< N, +%% and a new state. + +-spec uniform_s(N::pos_integer(), state()) -> {X::pos_integer(), NewS::state()}. +uniform_s(N, State = {#{uniform_n:=Uniform, max:=Max}, _}) + when 0 < N, N =< Max -> + Uniform(N, State); +uniform_s(N, State0 = {#{uniform:=Uniform}, _}) + when is_integer(N), 0 < N -> + {F, State} = Uniform(State0), + {trunc(F * N) + 1, State}. + +%% normal/0: returns a random float with standard normal distribution +%% updating the state in the process dictionary. + +-spec normal() -> float(). +normal() -> + {X, Seed} = normal_s(seed_get()), + _ = seed_put(Seed), + X. + +%% normal_s/1: returns a random float with standard normal distribution +%% The Ziggurat Method for generating random variables - Marsaglia and Tsang +%% Paper and reference code: http://www.jstatsoft.org/v05/i08/ + +-spec normal_s(state()) -> {float(), NewS :: state()}. +normal_s(State0) -> + {Sign, R, State} = get_52(State0), + Idx = R band 16#FF, + Idx1 = Idx+1, + {Ki, Wi} = normal_kiwi(Idx1), + X = R * Wi, + case R < Ki of + %% Fast path 95% of the time + true when Sign =:= 0 -> {X, State}; + true -> {-X, State}; + %% Slow path + false when Sign =:= 0 -> normal_s(Idx, Sign, X, State); + false -> normal_s(Idx, Sign, -X, State) + end. + +%% ===================================================================== +%% Internal functions + +-define(UINT21MASK, 16#00000000001fffff). +-define(UINT32MASK, 16#00000000ffffffff). +-define(UINT33MASK, 16#00000001ffffffff). +-define(UINT39MASK, 16#0000007fffffffff). +-define(UINT58MASK, 16#03ffffffffffffff). +-define(UINT64MASK, 16#ffffffffffffffff). + +-type uint64() :: 0..16#ffffffffffffffff. +-type uint58() :: 0..16#03ffffffffffffff. + +-spec seed_put(state()) -> undefined | state(). +seed_put(Seed) -> + put(?SEED_DICT, Seed). + +seed_get() -> + case get(?SEED_DICT) of + undefined -> seed(?DEFAULT_ALG_HANDLER); + Old -> Old % no type checking here + end. + +%% Setup alg record +mk_alg(exs64) -> + {#{type=>exs64, max=>?UINT64MASK, next=>fun exs64_next/1, + uniform=>fun exs64_uniform/1, uniform_n=>fun exs64_uniform/2}, + fun exs64_seed/1}; +mk_alg(exsplus) -> + {#{type=>exsplus, max=>?UINT58MASK, next=>fun exsplus_next/1, + uniform=>fun exsplus_uniform/1, uniform_n=>fun exsplus_uniform/2}, + fun exsplus_seed/1}; +mk_alg(exs1024) -> + {#{type=>exs1024, max=>?UINT64MASK, next=>fun exs1024_next/1, + uniform=>fun exs1024_uniform/1, uniform_n=>fun exs1024_uniform/2}, + fun exs1024_seed/1}. + +%% ===================================================================== +%% exs64 PRNG: Xorshift64* +%% Algorithm by Sebastiano Vigna +%% Reference URL: http://xorshift.di.unimi.it/ +%% ===================================================================== + +-type exs64_state() :: uint64(). + +exs64_seed({A1, A2, A3}) -> + {V1, _} = exs64_next(((A1 band ?UINT32MASK) * 4294967197 + 1)), + {V2, _} = exs64_next(((A2 band ?UINT32MASK) * 4294967231 + 1)), + {V3, _} = exs64_next(((A3 band ?UINT32MASK) * 4294967279 + 1)), + ((V1 * V2 * V3) rem (?UINT64MASK - 1)) + 1. + +%% Advance xorshift64* state for one step and generate 64bit unsigned integer +-spec exs64_next(exs64_state()) -> {uint64(), exs64_state()}. +exs64_next(R) -> + R1 = R bxor (R bsr 12), + R2 = R1 bxor ((R1 band ?UINT39MASK) bsl 25), + R3 = R2 bxor (R2 bsr 27), + {(R3 * 2685821657736338717) band ?UINT64MASK, R3}. + +exs64_uniform({Alg, R0}) -> + {V, R1} = exs64_next(R0), + {V / 18446744073709551616, {Alg, R1}}. + +exs64_uniform(Max, {Alg, R}) -> + {V, R1} = exs64_next(R), + {(V rem Max) + 1, {Alg, R1}}. + +%% ===================================================================== +%% exsplus PRNG: Xorshift116+ +%% Algorithm by Sebastiano Vigna +%% Reference URL: http://xorshift.di.unimi.it/ +%% 58 bits fits into an immediate on 64bits erlang and is thus much faster. +%% Modification of the original Xorshift128+ algorithm to 116 +%% by Sebastiano Vigna, a lot of thanks for his help and work. +%% ===================================================================== +-type exsplus_state() :: nonempty_improper_list(uint58(), uint58()). + +exsplus_seed({A1, A2, A3}) -> + {_, R1} = exsplus_next([(((A1 * 4294967197) + 1) band ?UINT58MASK)| + (((A2 * 4294967231) + 1) band ?UINT58MASK)]), + {_, R2} = exsplus_next([(((A3 * 4294967279) + 1) band ?UINT58MASK)| + tl(R1)]), + R2. + +%% Advance xorshift116+ state for one step and generate 58bit unsigned integer +-spec exsplus_next(exsplus_state()) -> {uint58(), exsplus_state()}. +exsplus_next([S1|S0]) -> + %% Note: members s0 and s1 are swapped here + S11 = (S1 bxor (S1 bsl 24)) band ?UINT58MASK, + S12 = S11 bxor S0 bxor (S11 bsr 11) bxor (S0 bsr 41), + {(S0 + S12) band ?UINT58MASK, [S0|S12]}. + +exsplus_uniform({Alg, R0}) -> + {I, R1} = exsplus_next(R0), + {I / (?UINT58MASK+1), {Alg, R1}}. + +exsplus_uniform(Max, {Alg, R}) -> + {V, R1} = exsplus_next(R), + {(V rem Max) + 1, {Alg, R1}}. + +%% ===================================================================== +%% exs1024 PRNG: Xorshift1024* +%% Algorithm by Sebastiano Vigna +%% Reference URL: http://xorshift.di.unimi.it/ +%% ===================================================================== + +-type exs1024_state() :: {list(uint64()), list(uint64())}. + +exs1024_seed({A1, A2, A3}) -> + B1 = (((A1 band ?UINT21MASK) + 1) * 2097131) band ?UINT21MASK, + B2 = (((A2 band ?UINT21MASK) + 1) * 2097133) band ?UINT21MASK, + B3 = (((A3 band ?UINT21MASK) + 1) * 2097143) band ?UINT21MASK, + {exs1024_gen1024((B1 bsl 43) bor (B2 bsl 22) bor (B3 bsl 1) bor 1), + []}. + +%% Generate a list of 16 64-bit element list +%% of the xorshift64* random sequence +%% from a given 64-bit seed. +%% Note: dependent on exs64_next/1 +-spec exs1024_gen1024(uint64()) -> list(uint64()). +exs1024_gen1024(R) -> + exs1024_gen1024(16, R, []). + +exs1024_gen1024(0, _, L) -> + L; +exs1024_gen1024(N, R, L) -> + {X, R2} = exs64_next(R), + exs1024_gen1024(N - 1, R2, [X|L]). + +%% Calculation of xorshift1024*. +%% exs1024_calc(S0, S1) -> {X, NS1}. +%% X: random number output +-spec exs1024_calc(uint64(), uint64()) -> {uint64(), uint64()}. +exs1024_calc(S0, S1) -> + S11 = S1 bxor ((S1 band ?UINT33MASK) bsl 31), + S12 = S11 bxor (S11 bsr 11), + S01 = S0 bxor (S0 bsr 30), + NS1 = S01 bxor S12, + {(NS1 * 1181783497276652981) band ?UINT64MASK, NS1}. + +%% Advance xorshift1024* state for one step and generate 64bit unsigned integer +-spec exs1024_next(exs1024_state()) -> {uint64(), exs1024_state()}. +exs1024_next({[S0,S1|L3], RL}) -> + {X, NS1} = exs1024_calc(S0, S1), + {X, {[NS1|L3], [S0|RL]}}; +exs1024_next({[H], RL}) -> + NL = [H|lists:reverse(RL)], + exs1024_next({NL, []}). + +exs1024_uniform({Alg, R0}) -> + {V, R1} = exs1024_next(R0), + {V / 18446744073709551616, {Alg, R1}}. + +exs1024_uniform(Max, {Alg, R}) -> + {V, R1} = exs1024_next(R), + {(V rem Max) + 1, {Alg, R1}}. + +%% ===================================================================== +%% Ziggurat cont +%% ===================================================================== +-define(NOR_R, 3.6541528853610087963519472518). +-define(NOR_INV_R, 1/?NOR_R). + +%% return a {sign, Random51bits, State} +get_52({Alg=#{next:=Next}, S0}) -> + {Int,S1} = Next(S0), + {((1 bsl 51) band Int), Int band ((1 bsl 51)-1), {Alg, S1}}. + +%% Slow path +normal_s(0, Sign, X0, State0) -> + {U0, S1} = uniform_s(State0), + X = -?NOR_INV_R*math:log(U0), + {U1, S2} = uniform_s(S1), + Y = -math:log(U1), + case Y+Y > X*X of + false -> + normal_s(0, Sign, X0, S2); + true when Sign =:= 0 -> + {?NOR_R + X, S2}; + true -> + {-?NOR_R - X, S2} + end; +normal_s(Idx, _Sign, X, State0) -> + Fi2 = normal_fi(Idx+1), + {U0, S1} = uniform_s(State0), + case ((normal_fi(Idx) - Fi2)*U0 + Fi2) < math:exp(-0.5*X*X) of + true -> {X, S1}; + false -> normal_s(S1) + end. + +%% Tables for generating normal_s +%% ki is zipped with wi (slightly faster) +normal_kiwi(Indx) -> + element(Indx, + {{2104047571236786,1.736725412160263e-15}, {0,9.558660351455634e-17}, + {1693657211986787,1.2708704834810623e-16},{1919380038271141,1.4909740962495474e-16}, + {2015384402196343,1.6658733631586268e-16},{2068365869448128,1.8136120810119029e-16}, + {2101878624052573,1.9429720153135588e-16},{2124958784102998,2.0589500628482093e-16}, + {2141808670795147,2.1646860576895422e-16},{2154644611568301,2.2622940392218116e-16}, + {2164744887587275,2.353271891404589e-16},{2172897953696594,2.438723455742877e-16}, + {2179616279372365,2.5194879829274225e-16},{2185247251868649,2.5962199772528103e-16}, + {2190034623107822,2.6694407473648285e-16},{2194154434521197,2.7395729685142446e-16}, + {2197736978774660,2.8069646002484804e-16},{2200880740891961,2.871905890411393e-16}, + {2203661538010620,2.9346417484728883e-16},{2206138681109102,2.9953809336782113e-16}, + {2208359231806599,3.054303000719244e-16},{2210361007258210,3.111563633892157e-16}, + {2212174742388539,3.1672988018581815e-16},{2213825672704646,3.2216280350549905e-16}, + {2215334711002614,3.274657040793975e-16},{2216719334487595,3.326479811684171e-16}, + {2217994262139172,3.377180341735323e-16},{2219171977965032,3.4268340353119356e-16}, + {2220263139538712,3.475508873172976e-16},{2221276900117330,3.523266384600203e-16}, + {2222221164932930,3.5701624633953494e-16},{2223102796829069,3.616248057159834e-16}, + {2223927782546658,3.661569752965354e-16},{2224701368170060,3.7061702777236077e-16}, + {2225428170204312,3.75008892787478e-16},{2226112267248242,3.7933619401549554e-16}, + {2226757276105256,3.836022812967728e-16},{2227366415328399,3.8781025861250247e-16}, + {2227942558554684,3.919630085325768e-16},{2228488279492521,3.9606321366256378e-16}, + {2229005890047222,4.001133755254669e-16},{2229497472775193,4.041158312414333e-16}, + {2229964908627060,4.080727683096045e-16},{2230409900758597,4.119862377480744e-16}, + {2230833995044585,4.1585816580828064e-16},{2231238597816133,4.1969036444740733e-16}, + {2231624991250191,4.234845407152071e-16},{2231994346765928,4.272423051889976e-16}, + {2232347736722750,4.309651795716294e-16},{2232686144665934,4.346546035512876e-16}, + {2233010474325959,4.383119410085457e-16},{2233321557544881,4.4193848564470665e-16}, + {2233620161276071,4.455354660957914e-16},{2233906993781271,4.491040505882875e-16}, + {2234182710130335,4.52645351185714e-16},{2234447917093496,4.561604276690038e-16}, + {2234703177503020,4.596502910884941e-16},{2234949014150181,4.631159070208165e-16}, + {2235185913274316,4.665581985600875e-16},{2235414327692884,4.699780490694195e-16}, + {2235634679614920,4.733763047158324e-16},{2235847363174595,4.767537768090853e-16}, + {2236052746716837,4.8011124396270155e-16},{2236251174862869,4.834494540935008e-16}, + {2236442970379967,4.867691262742209e-16},{2236628435876762,4.900709524522994e-16}, + {2236807855342765,4.933555990465414e-16},{2236981495548562,4.966237084322178e-16}, + {2237149607321147,4.998759003240909e-16},{2237312426707209,5.031127730659319e-16}, + {2237470176035652,5.0633490483427195e-16},{2237623064889403,5.095428547633892e-16}, + {2237771290995388,5.127371639978797e-16},{2237915041040597,5.159183566785736e-16}, + {2238054491421305,5.190869408670343e-16},{2238189808931712,5.222434094134042e-16}, + {2238321151397660,5.253882407719454e-16},{2238448668260432,5.285218997682382e-16}, + {2238572501115169,5.316448383216618e-16},{2238692784207942,5.34757496126473e-16}, + {2238809644895133,5.378603012945235e-16},{2238923204068402,5.409536709623993e-16}, + {2239033576548190,5.440380118655467e-16},{2239140871448443,5.471137208817361e-16}, + {2239245192514958,5.501811855460336e-16},{2239346638439541,5.532407845392784e-16}, + {2239445303151952,5.56292888151909e-16},{2239541276091442,5.593378587248462e-16}, + {2239634642459498,5.623760510690043e-16},{2239725483455293,5.65407812864896e-16}, + {2239813876495186,5.684334850436814e-16},{2239899895417494,5.714534021509204e-16}, + {2239983610673676,5.744678926941961e-16},{2240065089506935,5.774772794756965e-16}, + {2240144396119183,5.804818799107686e-16},{2240221591827230,5.834820063333892e-16}, + {2240296735208969,5.864779662894365e-16},{2240369882240293,5.894700628185872e-16}, + {2240441086423386,5.924585947256134e-16},{2240510398907004,5.95443856841806e-16}, + {2240577868599305,5.984261402772028e-16},{2240643542273726,6.014057326642664e-16}, + {2240707464668391,6.043829183936125e-16},{2240769678579486,6.073579788423606e-16}, + {2240830224948980,6.103311925956439e-16},{2240889142947082,6.133028356617911e-16}, + {2240946470049769,6.162731816816596e-16},{2241002242111691,6.192425021325847e-16}, + {2241056493434746,6.222110665273788e-16},{2241109256832602,6.251791426088e-16}, + {2241160563691400,6.281469965398895e-16},{2241210444026879,6.311148930905604e-16}, + {2241258926538122,6.34083095820806e-16},{2241306038658137,6.370518672608815e-16}, + {2241351806601435,6.400214690888025e-16},{2241396255408788,6.429921623054896e-16}, + {2241439408989313,6.459642074078832e-16},{2241481290160038,6.489378645603397e-16}, + {2241521920683062,6.519133937646159e-16},{2241561321300462,6.548910550287415e-16}, + {2241599511767028,6.578711085350741e-16},{2241636510880960,6.608538148078259e-16}, + {2241672336512612,6.638394348803506e-16},{2241707005631362,6.668282304624746e-16}, + {2241740534330713,6.698204641081558e-16},{2241772937851689,6.728163993837531e-16}, + {2241804230604585,6.758163010371901e-16},{2241834426189161,6.78820435168298e-16}, + {2241863537413311,6.818290694006254e-16},{2241891576310281,6.848424730550038e-16}, + {2241918554154466,6.878609173251664e-16},{2241944481475843,6.908846754557169e-16}, + {2241969368073071,6.939140229227569e-16},{2241993223025298,6.969492376174829e-16}, + {2242016054702685,6.999906000330764e-16},{2242037870775710,7.030383934552151e-16}, + {2242058678223225,7.060929041565482e-16},{2242078483339331,7.091544215954873e-16}, + {2242097291739040,7.122232386196779e-16},{2242115108362774,7.152996516745303e-16}, + {2242131937479672,7.183839610172063e-16},{2242147782689725,7.214764709364707e-16}, + {2242162646924736,7.245774899788387e-16},{2242176532448092,7.276873311814693e-16}, + {2242189440853337,7.308063123122743e-16},{2242201373061537,7.339347561177405e-16}, + {2242212329317416,7.370729905789831e-16},{2242222309184237,7.4022134917658e-16}, + {2242231311537397,7.433801711647648e-16},{2242239334556717,7.465498018555889e-16}, + {2242246375717369,7.497305929136979e-16},{2242252431779415,7.529229026624058e-16}, + {2242257498775893,7.561270964017922e-16},{2242261571999416,7.5934354673958895e-16}, + {2242264645987196,7.625726339356756e-16},{2242266714504453,7.658147462610487e-16}, + {2242267770526109,7.690702803721919e-16},{2242267806216711,7.723396417018299e-16}, + {2242266812908462,7.756232448671174e-16},{2242264781077289,7.789215140963852e-16}, + {2242261700316818,7.822348836756411e-16},{2242257559310145,7.855637984161084e-16}, + {2242252345799276,7.889087141441755e-16},{2242246046552082,7.922700982152271e-16}, + {2242238647326615,7.956484300529366e-16},{2242230132832625,7.99044201715713e-16}, + {2242220486690076,8.024579184921259e-16},{2242209691384458,8.058900995272657e-16}, + {2242197728218684,8.093412784821501e-16},{2242184577261310,8.128120042284501e-16}, + {2242170217290819,8.163028415809877e-16},{2242154625735679,8.198143720706533e-16}, + {2242137778609839,8.23347194760605e-16},{2242119650443327,8.26901927108847e-16}, + {2242100214207556,8.304792058805374e-16},{2242079441234906,8.340796881136629e-16}, + {2242057301132135,8.377040521420222e-16},{2242033761687079,8.413529986798028e-16}, + {2242008788768107,8.450272519724097e-16},{2241982346215682,8.487275610186155e-16}, + {2241954395725356,8.524547008695596e-16},{2241924896721443,8.562094740106233e-16}, + {2241893806220517,8.599927118327665e-16},{2241861078683830,8.638052762005259e-16}, + {2241826665857598,8.676480611245582e-16},{2241790516600041,8.715219945473698e-16}, + {2241752576693881,8.754280402517175e-16},{2241712788642916,8.793671999021043e-16}, + {2241671091451078,8.833405152308408e-16},{2241627420382235,8.873490703813135e-16}, + {2241581706698773,8.913939944224086e-16},{2241533877376767,8.954764640495068e-16}, + {2241483854795281,8.9959770648911e-16},{2241431556397035,9.037590026260118e-16}, + {2241376894317345,9.079616903740068e-16},{2241319774977817,9.122071683134846e-16}, + {2241260098640860,9.164968996219135e-16},{2241197758920538,9.208324163262308e-16}, + {2241132642244704,9.252153239095693e-16},{2241064627262652,9.296473063086417e-16}, + {2240993584191742,9.341301313425265e-16},{2240919374095536,9.38665656618666e-16}, + {2240841848084890,9.432558359676707e-16},{2240760846432232,9.479027264651738e-16}, + {2240676197587784,9.526084961066279e-16},{2240587717084782,9.57375432209745e-16}, + {2240495206318753,9.622059506294838e-16},{2240398451183567,9.671026058823054e-16}, + {2240297220544165,9.720681022901626e-16},{2240191264522612,9.771053062707209e-16}, + {2240080312570155,9.822172599190541e-16},{2239964071293331,9.874071960480671e-16}, + {2239842221996530,9.926785548807976e-16},{2239714417896699,9.980350026183645e-16}, + {2239580280957725,1.003480452143618e-15},{2239439398282193,1.0090190861637457e-15}, + {2239291317986196,1.0146553831467086e-15},{2239135544468203,1.0203941464683124e-15}, + {2238971532964979,1.0262405372613567e-15},{2238798683265269,1.0322001115486456e-15}, + {2238616332424351,1.03827886235154e-15},{2238423746288095,1.044483267600047e-15}, + {2238220109591890,1.0508203448355195e-15},{2238004514345216,1.057297713900989e-15}, + {2237775946143212,1.06392366906768e-15},{2237533267957822,1.0707072623632994e-15}, + {2237275200846753,1.0776584002668106e-15},{2237000300869952,1.0847879564403425e-15}, + {2236706931309099,1.0921079038149563e-15},{2236393229029147,1.0996314701785628e-15}, + {2236057063479501,1.1073733224935752e-15},{2235695986373246,1.1153497865853155e-15}, + {2235307169458859,1.1235791107110833e-15},{2234887326941578,1.1320817840164846e-15}, + {2234432617919447,1.140880924258278e-15},{2233938522519765,1.1500027537839792e-15}, + {2233399683022677,1.159477189144919e-15},{2232809697779198,1.169338578691096e-15}, + {2232160850599817,1.17962663529558e-15},{2231443750584641,1.190387629928289e-15}, + {2230646845562170,1.2016759392543819e-15},{2229755753817986,1.2135560818666897e-15}, + {2228752329126533,1.2261054417450561e-15},{2227613325162504,1.2394179789163251e-15}, + {2226308442121174,1.2536093926602567e-15},{2224797391720399,1.268824481425501e-15}, + {2223025347823832,1.2852479319096109e-15},{2220915633329809,1.3031206634689985e-15}, + {2218357446087030,1.3227655770195326e-15},{2215184158448668,1.3446300925011171e-15}, + {2211132412537369,1.3693606835128518e-15},{2205758503851065,1.397943667277524e-15}, + {2198248265654987,1.4319989869661328e-15},{2186916352102141,1.4744848603597596e-15}, + {2167562552481814,1.5317872741611144e-15},{2125549880839716,1.6227698675312968e-15}}). + +normal_fi(Indx) -> + element(Indx, + {1.0000000000000000e+00,9.7710170126767082e-01,9.5987909180010600e-01, + 9.4519895344229909e-01,9.3206007595922991e-01,9.1999150503934646e-01, + 9.0872644005213032e-01,8.9809592189834297e-01,8.8798466075583282e-01, + 8.7830965580891684e-01,8.6900868803685649e-01,8.6003362119633109e-01, + 8.5134625845867751e-01,8.4291565311220373e-01,8.3471629298688299e-01, + 8.2672683394622093e-01,8.1892919160370192e-01,8.1130787431265572e-01, + 8.0384948317096383e-01,7.9654233042295841e-01,7.8937614356602404e-01, + 7.8234183265480195e-01,7.7543130498118662e-01,7.6863731579848571e-01, + 7.6195334683679483e-01,7.5537350650709567e-01,7.4889244721915638e-01, + 7.4250529634015061e-01,7.3620759812686210e-01,7.2999526456147568e-01, + 7.2386453346862967e-01,7.1781193263072152e-01,7.1183424887824798e-01, + 7.0592850133275376e-01,7.0009191813651117e-01,6.9432191612611627e-01, + 6.8861608300467136e-01,6.8297216164499430e-01,6.7738803621877308e-01, + 6.7186171989708166e-01,6.6639134390874977e-01,6.6097514777666277e-01, + 6.5561147057969693e-01,6.5029874311081637e-01,6.4503548082082196e-01, + 6.3982027745305614e-01,6.3465179928762327e-01,6.2952877992483625e-01, + 6.2445001554702606e-01,6.1941436060583399e-01,6.1442072388891344e-01, + 6.0946806492577310e-01,6.0455539069746733e-01,5.9968175261912482e-01, + 5.9484624376798689e-01,5.9004799633282545e-01,5.8528617926337090e-01, + 5.8055999610079034e-01,5.7586868297235316e-01,5.7121150673525267e-01, + 5.6658776325616389e-01,5.6199677581452390e-01,5.5743789361876550e-01, + 5.5291049042583185e-01,5.4841396325526537e-01,5.4394773119002582e-01, + 5.3951123425695158e-01,5.3510393238045717e-01,5.3072530440366150e-01, + 5.2637484717168403e-01,5.2205207467232140e-01,5.1775651722975591e-01, + 5.1348772074732651e-01,5.0924524599574761e-01,5.0502866794346790e-01, + 5.0083757512614835e-01,4.9667156905248933e-01,4.9253026364386815e-01, + 4.8841328470545758e-01,4.8432026942668288e-01,4.8025086590904642e-01, + 4.7620473271950547e-01,4.7218153846772976e-01,4.6818096140569321e-01, + 4.6420268904817391e-01,4.6024641781284248e-01,4.5631185267871610e-01, + 4.5239870686184824e-01,4.4850670150720273e-01,4.4463556539573912e-01, + 4.4078503466580377e-01,4.3695485254798533e-01,4.3314476911265209e-01, + 4.2935454102944126e-01,4.2558393133802180e-01,4.2183270922949573e-01, + 4.1810064983784795e-01,4.1438753404089090e-01,4.1069314827018799e-01, + 4.0701728432947315e-01,4.0335973922111429e-01,3.9972031498019700e-01, + 3.9609881851583223e-01,3.9249506145931540e-01,3.8890886001878855e-01, + 3.8534003484007706e-01,3.8178841087339344e-01,3.7825381724561896e-01, + 3.7473608713789086e-01,3.7123505766823922e-01,3.6775056977903225e-01, + 3.6428246812900372e-01,3.6083060098964775e-01,3.5739482014578022e-01, + 3.5397498080007656e-01,3.5057094148140588e-01,3.4718256395679348e-01, + 3.4380971314685055e-01,3.4045225704452164e-01,3.3711006663700588e-01, + 3.3378301583071823e-01,3.3047098137916342e-01,3.2717384281360129e-01, + 3.2389148237639104e-01,3.2062378495690530e-01,3.1737063802991350e-01, + 3.1413193159633707e-01,3.1090755812628634e-01,3.0769741250429189e-01, + 3.0450139197664983e-01,3.0131939610080288e-01,2.9815132669668531e-01, + 2.9499708779996164e-01,2.9185658561709499e-01,2.8872972848218270e-01, + 2.8561642681550159e-01,2.8251659308370741e-01,2.7943014176163772e-01, + 2.7635698929566810e-01,2.7329705406857691e-01,2.7025025636587519e-01, + 2.6721651834356114e-01,2.6419576399726080e-01,2.6118791913272082e-01, + 2.5819291133761890e-01,2.5521066995466168e-01,2.5224112605594190e-01, + 2.4928421241852824e-01,2.4633986350126363e-01,2.4340801542275012e-01, + 2.4048860594050039e-01,2.3758157443123795e-01,2.3468686187232990e-01, + 2.3180441082433859e-01,2.2893416541468023e-01,2.2607607132238020e-01, + 2.2323007576391746e-01,2.2039612748015194e-01,2.1757417672433113e-01, + 2.1476417525117358e-01,2.1196607630703015e-01,2.0917983462112499e-01, + 2.0640540639788071e-01,2.0364274931033485e-01,2.0089182249465656e-01, + 1.9815258654577511e-01,1.9542500351413428e-01,1.9270903690358912e-01, + 1.9000465167046496e-01,1.8731181422380025e-01,1.8463049242679927e-01, + 1.8196065559952254e-01,1.7930227452284767e-01,1.7665532144373500e-01, + 1.7401977008183875e-01,1.7139559563750595e-01,1.6878277480121151e-01, + 1.6618128576448205e-01,1.6359110823236570e-01,1.6101222343751107e-01, + 1.5844461415592431e-01,1.5588826472447920e-01,1.5334316106026283e-01, + 1.5080929068184568e-01,1.4828664273257453e-01,1.4577520800599403e-01, + 1.4327497897351341e-01,1.4078594981444470e-01,1.3830811644855071e-01, + 1.3584147657125373e-01,1.3338602969166913e-01,1.3094177717364430e-01, + 1.2850872227999952e-01,1.2608687022018586e-01,1.2367622820159654e-01, + 1.2127680548479021e-01,1.1888861344290998e-01,1.1651166562561080e-01, + 1.1414597782783835e-01,1.1179156816383801e-01,1.0944845714681163e-01, + 1.0711666777468364e-01,1.0479622562248690e-01,1.0248715894193508e-01, + 1.0018949876880981e-01,9.7903279038862284e-02,9.5628536713008819e-02, + 9.3365311912690860e-02,9.1113648066373634e-02,8.8873592068275789e-02, + 8.6645194450557961e-02,8.4428509570353374e-02,8.2223595813202863e-02, + 8.0030515814663056e-02,7.7849336702096039e-02,7.5680130358927067e-02, + 7.3522973713981268e-02,7.1377949058890375e-02,6.9245144397006769e-02, + 6.7124653827788497e-02,6.5016577971242842e-02,6.2921024437758113e-02, + 6.0838108349539864e-02,5.8767952920933758e-02,5.6710690106202902e-02, + 5.4666461324888914e-02,5.2635418276792176e-02,5.0617723860947761e-02, + 4.8613553215868521e-02,4.6623094901930368e-02,4.4646552251294443e-02, + 4.2684144916474431e-02,4.0736110655940933e-02,3.8802707404526113e-02, + 3.6884215688567284e-02,3.4980941461716084e-02,3.3093219458578522e-02, + 3.1221417191920245e-02,2.9365939758133314e-02,2.7527235669603082e-02, + 2.5705804008548896e-02,2.3902203305795882e-02,2.2117062707308864e-02, + 2.0351096230044517e-02,1.8605121275724643e-02,1.6880083152543166e-02, + 1.5177088307935325e-02,1.3497450601739880e-02,1.1842757857907888e-02, + 1.0214971439701471e-02,8.6165827693987316e-03,7.0508754713732268e-03, + 5.5224032992509968e-03,4.0379725933630305e-03,2.6090727461021627e-03, + 1.2602859304985975e-03}). diff --git a/lib/stdlib/src/random.erl b/lib/stdlib/src/random.erl index d7b51a151c..cf84f8cecf 100644 --- a/lib/stdlib/src/random.erl +++ b/lib/stdlib/src/random.erl @@ -57,11 +57,17 @@ seed() -> %% seed({A1, A2, A3}) %% Seed random number generation --spec seed({A1, A2, A3}) -> 'undefined' | ran() when +-spec seed(SValue) -> 'undefined' | ran() when + SValue :: {A1, A2, A3} | integer(), A1 :: integer(), A2 :: integer(), A3 :: integer(). +seed(Int) when is_integer(Int) -> + A1 = (Int bsr 16) band 16#fffffff, + A2 = Int band 16#ffffff, + A3 = (Int bsr 36) bor (A2 bsr 16), + seed(A1, A2, A3); seed({A1, A2, A3}) -> seed(A1, A2, A3). diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 679c13f0cf..c6ba574ff4 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -314,7 +314,8 @@ prompt(N, Eval0, Bs0, RT, Ds0) -> case get_prompt_func() of {M,F} -> L = [{history,N}], - C = {call,1,{remote,1,{atom,1,M},{atom,1,F}},[{value,1,L}]}, + A = erl_anno:new(1), + C = {call,A,{remote,A,{atom,A,M},{atom,A,F}},[{value,A,L}]}, {V,Eval,Bs,Ds} = shell_cmd([C], Eval0, Bs0, RT, Ds0, pmt), {Eval,Bs,Ds,case V of {pmt,Val} -> @@ -416,7 +417,7 @@ expand_expr({call,_L,{atom,_,v},[N]}, C) -> {_,undefined,_} -> no_command(N); {Ces,V,CommandN} when is_list(Ces) -> - {value,CommandN,V} + {value,erl_anno:new(CommandN),V} end; expand_expr({call,L,F,Args}, C) -> {call,L,expand_expr(F, C),expand_exprs(Args, C)}; @@ -901,7 +902,7 @@ prep_check({call,Line,{atom,_,f},[{var,_,_Name}]}) -> {atom,Line,ok}; prep_check({value,_CommandN,_Val}) -> %% erl_lint cannot handle the history expansion {value,_,_}. - {atom,0,ok}; + {atom,a0(),ok}; prep_check(T) when is_tuple(T) -> list_to_tuple(prep_check(tuple_to_list(T))); prep_check([E | Es]) -> @@ -913,7 +914,7 @@ expand_records([], E0) -> E0; expand_records(UsedRecords, E0) -> RecordDefs = [Def || {_Name,Def} <- UsedRecords], - L = 1, + L = erl_anno:new(1), E = prep_rec(E0), Forms = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}], [{function,L,foo,0,[{clause,L,[],[],[NE]}]}] = @@ -1320,13 +1321,15 @@ list_bindings([{Name,Val}|Bs], RT) -> case erl_eval:fun_data(Val) of {fun_data,_FBs,FCs0} -> FCs = expand_value(FCs0), % looks nicer - F = {'fun',0,{clauses,FCs}}, - M = {match,0,{var,0,Name},F}, + A = a0(), + F = {'fun',A,{clauses,FCs}}, + M = {match,A,{var,A,Name},F}, io:fwrite(<<"~ts\n">>, [erl_pp:expr(M, enc())]); {named_fun_data,_FBs,FName,FCs0} -> FCs = expand_value(FCs0), % looks nicer - F = {named_fun,0,FName,FCs}, - M = {match,0,{var,0,Name},F}, + A = a0(), + F = {named_fun,A,FName,FCs}, + M = {match,A,{var,A,Name},F}, io:fwrite(<<"~ts\n">>, [erl_pp:expr(M, enc())]); false -> Namel = io_lib:fwrite(<<"~s = ">>, [Name]), @@ -1356,13 +1359,18 @@ expand_value(E) -> %% There is no abstract representation of funs. try_abstract(V, CommandN) -> try erl_parse:abstract(V) - catch _:_ -> {call,0,{atom,0,v},[{integer,0,CommandN}]} + catch + _:_ -> + A = a0(), + {call,A,{atom,A,v},[{integer,A,CommandN}]} end. %% Rather than listing possibly huge results the calls to v/1 are shown. prep_list_commands(E) -> - substitute_v1(fun({value,CommandN,_V}) -> - {call,0,{atom,0,v},[{integer,0,CommandN}]} + A = a0(), + substitute_v1(fun({value,Anno,_V}) -> + CommandN = erl_anno:line(Anno), + {call,A,{atom,A,v},[{integer,A,CommandN}]} end, E). substitute_v1(F, {value,_,_}=Value) -> @@ -1374,6 +1382,9 @@ substitute_v1(F, [E | Es]) -> substitute_v1(_F, E) -> E. +a0() -> + erl_anno:new(0). + check_and_get_history_and_results() -> check_env(shell_history_length), check_env(shell_saved_results), diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl index 1898dc8aba..28da45621a 100644 --- a/lib/stdlib/src/slave.erl +++ b/lib/stdlib/src/slave.erl @@ -128,7 +128,7 @@ relay1(Pid) -> %% {error, {already_running, Name@Host}} -spec start(Host) -> {ok, Node} | {error, Reason} when - Host :: atom(), + Host :: inet:hostname(), Node :: node(), Reason :: timeout | no_rsh | {already_running, Node}. @@ -138,8 +138,8 @@ start(Host) -> start(Host, Name, [], no_link). -spec start(Host, Name) -> {ok, Node} | {error, Reason} when - Host :: atom(), - Name :: atom(), + Host :: inet:hostname(), + Name :: atom() | string(), Node :: node(), Reason :: timeout | no_rsh | {already_running, Node}. @@ -147,8 +147,8 @@ start(Host, Name) -> start(Host, Name, []). -spec start(Host, Name, Args) -> {ok, Node} | {error, Reason} when - Host :: atom(), - Name :: atom(), + Host :: inet:hostname(), + Name :: atom() | string(), Args :: string(), Node :: node(), Reason :: timeout | no_rsh | {already_running, Node}. @@ -157,7 +157,7 @@ start(Host, Name, Args) -> start(Host, Name, Args, no_link). -spec start_link(Host) -> {ok, Node} | {error, Reason} when - Host :: atom(), + Host :: inet:hostname(), Node :: node(), Reason :: timeout | no_rsh | {already_running, Node}. @@ -167,8 +167,8 @@ start_link(Host) -> start(Host, Name, [], self()). -spec start_link(Host, Name) -> {ok, Node} | {error, Reason} when - Host :: atom(), - Name :: atom(), + Host :: inet:hostname(), + Name :: atom() | string(), Node :: node(), Reason :: timeout | no_rsh | {already_running, Node}. @@ -176,8 +176,8 @@ start_link(Host, Name) -> start_link(Host, Name, []). -spec start_link(Host, Name, Args) -> {ok, Node} | {error, Reason} when - Host :: atom(), - Name :: atom(), + Host :: inet:hostname(), + Name :: atom() | string(), Args :: string(), Node :: node(), Reason :: timeout | no_rsh | {already_running, Node}. @@ -210,7 +210,6 @@ start(Host0, Name, Args, LinkTo, Prog) -> Node :: node(). stop(Node) -> -% io:format("stop(~p)~n", [Node]), rpc:call(Node, erlang, halt, []), ok. @@ -229,7 +228,6 @@ wait_for_slave(Parent, Host, Name, Node, Args, LinkTo, Prog) -> Waiter = register_unique_name(0), case mk_cmd(Host, Name, Args, Waiter, Prog) of {ok, Cmd} -> -%% io:format("Command: ~ts~n", [Cmd]), open_port({spawn, Cmd}, [stream]), receive {SlavePid, slave_started} -> diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index f134c75869..a27a35dca2 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -39,6 +39,7 @@ edlin_expand, epp, eval_bits, + erl_anno, erl_bits, erl_compile, erl_eval, @@ -83,6 +84,7 @@ qlc, qlc_pt, queue, + rand, random, re, sets, @@ -102,7 +104,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.4","kernel-3.0.2","erts-6.2","crypto-3.3", + {runtime_dependencies, ["sasl-2.4","kernel-3.0.2","erts-7.0","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index 5900fd3ff3..ee87a8ddb2 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -17,9 +17,9 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 + [{<<"2\\.[1-3](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0 %% Down to - max one major revision back - [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 + [{<<"2\\.[1-3](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0 }. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 658c00dc77..67655b1145 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1383,7 +1383,7 @@ add_restart(State) -> I = State#state.intensity, P = State#state.period, R = State#state.restarts, - Now = erlang:now(), + Now = erlang:monotonic_time(1), R1 = add_restart([Now|R], Now, P), State1 = State#state{restarts = R1}, case length(R1) of @@ -1403,26 +1403,8 @@ add_restart([R|Restarts], Now, Period) -> add_restart([], _, _) -> []. -inPeriod(Time, Now, Period) -> - case difference(Time, Now) of - T when T > Period -> - false; - _ -> - true - end. - -%% -%% Time = {MegaSecs, Secs, MicroSecs} (NOTE: MicroSecs is ignored) -%% Calculate the time elapsed in seconds between two timestamps. -%% If MegaSecs is equal just subtract Secs. -%% Else calculate the Mega difference and add the Secs difference, -%% note that Secs difference can be negative, e.g. -%% {827, 999999, 676} diff {828, 1, 653753} == > 2 secs. -%% -difference({TimeM, TimeS, _}, {CurM, CurS, _}) when CurM > TimeM -> - ((CurM - TimeM) * 1000000) + (CurS - TimeS); -difference({_, TimeS, _}, {_, CurS, _}) -> - CurS - TimeS. +inPeriod(Then, Now, Period) -> + Now =< Then + Period. %%% ------------------------------------------------------ %%% Error and progress reporting. diff --git a/lib/stdlib/src/timer.erl b/lib/stdlib/src/timer.erl index 72a2dd9616..c266177b4d 100644 --- a/lib/stdlib/src/timer.erl +++ b/lib/stdlib/src/timer.erl @@ -161,10 +161,11 @@ sleep(T) -> Time :: integer(), Value :: term(). tc(F) -> - Before = os:timestamp(), + T1 = erlang:monotonic_time(), Val = F(), - After = os:timestamp(), - {now_diff(After, Before), Val}. + T2 = erlang:monotonic_time(), + Time = erlang:convert_time_unit(T2 - T1, native, micro_seconds), + {Time, Val}. %% %% Measure the execution time (in microseconds) for Fun(Args). @@ -175,10 +176,11 @@ tc(F) -> Time :: integer(), Value :: term(). tc(F, A) -> - Before = os:timestamp(), + T1 = erlang:monotonic_time(), Val = apply(F, A), - After = os:timestamp(), - {now_diff(After, Before), Val}. + T2 = erlang:monotonic_time(), + Time = erlang:convert_time_unit(T2 - T1, native, micro_seconds), + {Time, Val}. %% %% Measure the execution time (in microseconds) for an MFA. @@ -190,10 +192,11 @@ tc(F, A) -> Time :: integer(), Value :: term(). tc(M, F, A) -> - Before = os:timestamp(), + T1 = erlang:monotonic_time(), Val = apply(M, F, A), - After = os:timestamp(), - {now_diff(After, Before), Val}. + T2 = erlang:monotonic_time(), + Time = erlang:convert_time_unit(T2 - T1, native, micro_seconds), + {Time, Val}. %% %% Calculate the time difference (in microseconds) of two @@ -437,10 +440,8 @@ positive(X) -> %% %% system_time() -> time in microseconds %% -system_time() -> - {M,S,U} = erlang:now(), - 1000000 * (M*1000000 + S) + U. - +system_time() -> + erlang:monotonic_time(1000000). send([Pid, Msg]) -> Pid ! Msg. diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index b768c6d0b9..3c67bd67c6 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -214,7 +214,9 @@ -type zip_comment() :: #zip_comment{}. -type zip_file() :: #zip_file{}. --export_type([create_option/0, filename/0]). +-opaque handle() :: pid(). + +-export_type([create_option/0, filename/0, handle/0]). %% Open a zip archive with options %% @@ -500,7 +502,7 @@ do_list_dir(F, Options) -> -spec(t(Archive) -> ok when Archive :: file:name() | binary() | ZipHandle, - ZipHandle :: pid()). + ZipHandle :: handle()). t(F) when is_pid(F) -> zip_t(F); t(F) when is_record(F, openzip) -> openzip_t(F); @@ -524,7 +526,7 @@ do_t(F, RawPrint) -> -spec(tt(Archive) -> ok when Archive :: file:name() | binary() | ZipHandle, - ZipHandle :: pid()). + ZipHandle :: handle()). tt(F) when is_pid(F) -> zip_tt(F); tt(F) when is_record(F, openzip) -> openzip_tt(F); @@ -1114,15 +1116,19 @@ local_file_header_from_info_method_name(#file_info{mtime = MTime}, file_name_length = length(Name), extra_field_length = 0}. +server_init(Parent) -> + %% we want to know if our parent dies + process_flag(trap_exit, true), + server_loop(Parent, not_open). %% small, simple, stupid zip-archive server -server_loop(OpenZip) -> +server_loop(Parent, OpenZip) -> receive {From, {open, Archive, Options}} -> case openzip_open(Archive, Options) of {ok, NewOpenZip} -> From ! {self(), {ok, self()}}, - server_loop(NewOpenZip); + server_loop(Parent, NewOpenZip); Error -> From ! {self(), Error} end; @@ -1130,43 +1136,47 @@ server_loop(OpenZip) -> From ! {self(), openzip_close(OpenZip)}; {From, get} -> From ! {self(), openzip_get(OpenZip)}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); {From, {get, FileName}} -> From ! {self(), openzip_get(FileName, OpenZip)}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); {From, list_dir} -> From ! {self(), openzip_list_dir(OpenZip)}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); {From, {list_dir, Opts}} -> From ! {self(), openzip_list_dir(OpenZip, Opts)}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); {From, get_state} -> From ! {self(), OpenZip}, - server_loop(OpenZip); + server_loop(Parent, OpenZip); + {'EXIT', Parent, Reason} -> + _ = openzip_close(OpenZip), + exit({parent_died, Reason}); _ -> {error, bad_msg} end. -spec(zip_open(Archive) -> {ok, ZipHandle} | {error, Reason} when Archive :: file:name() | binary(), - ZipHandle :: pid(), + ZipHandle :: handle(), Reason :: term()). zip_open(Archive) -> zip_open(Archive, []). -spec(zip_open(Archive, Options) -> {ok, ZipHandle} | {error, Reason} when Archive :: file:name() | binary(), - ZipHandle :: pid(), + ZipHandle :: handle(), Options :: [Option], Option :: cooked | memory | {cwd, CWD :: file:filename()}, Reason :: term()). zip_open(Archive, Options) -> - Pid = spawn(fun() -> server_loop(not_open) end), - request(self(), Pid, {open, Archive, Options}). + Self = self(), + Pid = spawn_link(fun() -> server_init(Self) end), + request(Self, Pid, {open, Archive, Options}). -spec(zip_get(ZipHandle) -> {ok, [Result]} | {error, Reason} when - ZipHandle :: pid(), + ZipHandle :: handle(), Result :: file:name() | {file:name(), binary()}, Reason :: term()). @@ -1174,14 +1184,14 @@ zip_get(Pid) when is_pid(Pid) -> request(self(), Pid, get). -spec(zip_close(ZipHandle) -> ok | {error, einval} when - ZipHandle :: pid()). + ZipHandle :: handle()). zip_close(Pid) when is_pid(Pid) -> request(self(), Pid, close). -spec(zip_get(FileName, ZipHandle) -> {ok, Result} | {error, Reason} when FileName :: file:name(), - ZipHandle :: pid(), + ZipHandle :: handle(), Result :: file:name() | {file:name(), binary()}, Reason :: term()). @@ -1190,7 +1200,7 @@ zip_get(FileName, Pid) when is_pid(Pid) -> -spec(zip_list_dir(ZipHandle) -> {ok, Result} | {error, Reason} when Result :: [zip_comment() | zip_file()], - ZipHandle :: pid(), + ZipHandle :: handle(), Reason :: term()). zip_list_dir(Pid) when is_pid(Pid) -> diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index a271229c59..61eb34d565 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -23,6 +23,7 @@ MODULES= \ dummy_via \ edlin_expand_SUITE \ epp_SUITE \ + erl_anno_SUITE \ erl_eval_SUITE \ erl_expand_records_SUITE \ erl_internal_SUITE \ @@ -53,6 +54,7 @@ MODULES= \ proc_lib_SUITE \ qlc_SUITE \ queue_SUITE \ + rand_SUITE \ random_SUITE \ re_SUITE \ run_pcre_tests \ diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl index f828c70b63..5248870744 100644 --- a/lib/stdlib/test/binary_module_SUITE.erl +++ b/lib/stdlib/test/binary_module_SUITE.erl @@ -1130,7 +1130,9 @@ do_random_matches_comp3(N,NeedleRange,HaystackRange) -> Needles = [random_substring(NeedleRange,Haystack) || _ <- lists:duplicate(NumNeedles,a)], RefRes = binref:matches(Haystack,Needles), - true = do_matches_comp_loop(10000,Needles,Haystack, RefRes), + RefRes = binary:matches(Haystack,Needles), + Compiled = binary:compile_pattern(Needles), + true = do_matches_comp_loop(10000,Compiled,Haystack, RefRes), do_random_matches_comp3(N-1,NeedleRange,HaystackRange). do_matches_comp_loop(0,_,_,_) -> @@ -1160,9 +1162,8 @@ do_matches_comp2(N,H,A) -> end. do_matches_comp(N,H) -> A = ?MASK_ERROR(binref:matches(H,N)), - B = ?MASK_ERROR(binref:matches(H,binref:compile_pattern(N))), - C = ?MASK_ERROR(binary:matches(H,N)), - D = ?MASK_ERROR(binary:matches(make_unaligned(H), + B = ?MASK_ERROR(binary:matches(H,N)), + C = ?MASK_ERROR(binary:matches(make_unaligned(H), binary:compile_pattern([make_unaligned2(X) || X <- N]))), if A =/= nomatch -> @@ -1170,14 +1171,14 @@ do_matches_comp(N,H) -> true -> ok end, - case {(A =:= B), (B =:= C),(C =:= D)} of - {true,true,true} -> + case {(A =:= B), (B =:= C)} of + {true,true} -> true; _ -> io:format("Failed to match ~p (needle) against ~s (haystack)~n", [N,H]), - io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p.~n", - [A,B,C,D]), + io:format("A:~p,~nB:~p,~n,C:~p,~n", + [A,B,C]), exit(mismatch) end. @@ -1219,46 +1220,44 @@ do_random_match_comp4(N,NeedleRange,HaystackRange) -> do_match_comp(N,H) -> A = ?MASK_ERROR(binref:match(H,N)), - B = ?MASK_ERROR(binref:match(H,binref:compile_pattern([N]))), - C = ?MASK_ERROR(binary:match(make_unaligned(H),N)), - D = ?MASK_ERROR(binary:match(H,binary:compile_pattern([N]))), - E = ?MASK_ERROR(binary:match(H,binary:compile_pattern(make_unaligned(N)))), + B = ?MASK_ERROR(binary:match(make_unaligned(H),N)), + C = ?MASK_ERROR(binary:match(H,binary:compile_pattern([N]))), + D = ?MASK_ERROR(binary:match(H,binary:compile_pattern(make_unaligned(N)))), if A =/= nomatch -> put(success_counter,get(success_counter)+1); true -> ok end, - case {(A =:= B), (B =:= C),(C =:= D),(D =:= E)} of - {true,true,true,true} -> + case {(A =:= B), (B =:= C),(C =:= D)} of + {true,true,true} -> true; _ -> io:format("Failed to match ~s (needle) against ~s (haystack)~n", [N,H]), - io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p,E:~p.~n", - [A,B,C,D,E]), + io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p.~n", + [A,B,C,D]), exit(mismatch) end. do_match_comp3(N,H) -> A = ?MASK_ERROR(binref:match(H,N)), - B = ?MASK_ERROR(binref:match(H,binref:compile_pattern(N))), - C = ?MASK_ERROR(binary:match(H,N)), - D = ?MASK_ERROR(binary:match(H,binary:compile_pattern(N))), + B = ?MASK_ERROR(binary:match(H,N)), + C = ?MASK_ERROR(binary:match(H,binary:compile_pattern(N))), if A =/= nomatch -> put(success_counter,get(success_counter)+1); true -> ok end, - case {(A =:= B), (B =:= C),(C =:= D)} of - {true,true,true} -> + case {(A =:= B),(B =:= C)} of + {true,true} -> true; _ -> io:format("Failed to match ~s (needle) against ~s (haystack)~n", [N,H]), - io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p.~n", - [A,B,C,D]), + io:format("A:~p,~nB:~p,~n,C:~p.~n", + [A,B,C]), exit(mismatch) end. diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index b17e8bd186..9ab170c826 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -211,7 +211,7 @@ predef_mac(Config) when is_list(Config) -> ?line File = filename:join(?config(data_dir, Config), "mac3.erl"), ?line {ok, List} = epp:parse_file(File, [], []), ?line [_, - {attribute, LineCol1, l, Line1}, + {attribute, Anno, l, Line1}, {attribute, _, f, File}, {attribute, _, machine1, _}, {attribute, _, module, mac3}, @@ -219,13 +219,9 @@ predef_mac(Config) when is_list(Config) -> {attribute, _, ms, "mac3"}, {attribute, _, machine2, _} | _] = List, - ?line case LineCol1 of - Line1 -> ok; - {Line1,_} -> ok - end, + Line1 = erl_anno:line(Anno), ok. - variable_1(doc) -> []; variable_1(suite) -> @@ -553,11 +549,7 @@ otp_7702(Config) when is_list(Config) -> {ok, AC} = beam_lib:chunks(BeamFile, [abstract_code]), {file_7702,[{abstract_code,{_,Forms}}]} = AC, - Fun = fun(Attrs) -> - {line, L} = erl_parse:get_attribute(Attrs, line), - L - end, - Forms2 = [erl_lint:modify_line(Form, Fun) || Form <- Forms], + Forms2 = unopaque_forms(Forms), ?line [{attribute,1,file,_}, _, @@ -1395,9 +1387,10 @@ otp_10820(Config) when is_list(Config) -> do_otp_10820(File, C, PC) -> {ok,Node} = start_node(erl_pp_helper, "+fnu " ++ PC), ok = rpc:call(Node, file, write_file, [File, C]), - {ok,[{attribute,1,file,{File,1}}, - {attribute,2,module,any}, - {eof,2}]} = rpc:call(Node, epp, parse_file, [File, [],[]]), + {ok, Forms} = rpc:call(Node, epp, parse_file, [File, [],[]]), + [{attribute,1,file,{File,1}}, + {attribute,2,module,any}, + {eof,2}] = unopaque_forms(Forms), true = test_server:stop_node(Node), ok. @@ -1440,15 +1433,15 @@ encoding(Config) when is_list(Config) -> {attribute,1,module,encoding}, {error,_}, {error,{2,epp,cannot_parse}}, - {eof,2}]} = epp:parse_file(ErlFile, []), + {eof,2}]} = epp_parse_file(ErlFile, []), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,3}]} = - epp:parse_file(ErlFile, [{default_encoding,latin1}]), + epp_parse_file(ErlFile, [{default_encoding,latin1}]), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,3}],[{encoding,none}]} = - epp:parse_file(ErlFile, [{default_encoding,latin1},extra]), + epp_parse_file(ErlFile, [{default_encoding,latin1},extra]), %% Try a latin-1 file with encoding given in a comment. C2 = <<"-module(encoding). @@ -1459,27 +1452,27 @@ encoding(Config) when is_list(Config) -> {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,4}]} = - epp:parse_file(ErlFile, []), + epp_parse_file(ErlFile, []), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,4}]} = - epp:parse_file(ErlFile, [{default_encoding,latin1}]), + epp_parse_file(ErlFile, [{default_encoding,latin1}]), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,4}]} = - epp:parse_file(ErlFile, [{default_encoding,utf8}]), + epp_parse_file(ErlFile, [{default_encoding,utf8}]), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,4}],[{encoding,latin1}]} = - epp:parse_file(ErlFile, [extra]), + epp_parse_file(ErlFile, [extra]), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,4}],[{encoding,latin1}]} = - epp:parse_file(ErlFile, [{default_encoding,latin1},extra]), + epp_parse_file(ErlFile, [{default_encoding,latin1},extra]), {ok,[{attribute,1,file,_}, {attribute,1,module,encoding}, {eof,4}],[{encoding,latin1}]} = - epp:parse_file(ErlFile, [{default_encoding,utf8},extra]), + epp_parse_file(ErlFile, [{default_encoding,utf8},extra]), ok. @@ -1552,6 +1545,17 @@ errs([_|L], File) -> errs([], _File) -> []. +epp_parse_file(File, Opts) -> + case epp:parse_file(File, Opts) of + {ok, Forms} -> + {ok, unopaque_forms(Forms)}; + {ok, Forms, Other} -> + {ok, unopaque_forms(Forms), Other} + end. + +unopaque_forms(Forms) -> + [erl_parse:anno_to_term(Form) || Form <- Forms]. + run_test(Config, Test0) -> Test = [<<"-module(epp_test). -compile(export_all). ">>, Test0], Filename = "epp_test.erl", diff --git a/lib/stdlib/test/erl_anno_SUITE.erl b/lib/stdlib/test/erl_anno_SUITE.erl new file mode 100644 index 0000000000..7632fbd324 --- /dev/null +++ b/lib/stdlib/test/erl_anno_SUITE.erl @@ -0,0 +1,569 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(erl_anno_SUITE). + +%-define(debug, true). + +-ifdef(debug). +-include_lib("test_server/include/test_server.hrl"). +-define(format(S, A), io:format(S, A)). +-else. +-include_lib("test_server/include/test_server.hrl"). +-define(format(S, A), ok). +-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([new/1, is_anno/1, generated/1, end_location/1, file/1, + line/1, location/1, record/1, text/1, bad/1, neg_line/1]). + +-export([parse_abstract/1, mapfold_anno/1]). + +all() -> + [{group, anno}, {group, parse}]. + +groups() -> + [{anno, [], [new, is_anno, generated, end_location, file, + line, location, record, text, bad, neg_line]}, + {parse, [], [parse_abstract, mapfold_anno]}]. + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(_Case, Config) -> + Dog=?t:timetrap(?t:minutes(1)), + [{watchdog, Dog}|Config]. + +end_per_testcase(_Case, _Config) -> + Dog=?config(watchdog, _Config), + test_server:timetrap_cancel(Dog), + ok. + +-define(INFO(T, V), {T, V}). + +-dialyzer({no_fail_call, new/1}). +new(doc) -> + ["Test erl_anno:new/1"]; +new(_Config) -> + {'EXIT', {badarg, _}} = + (catch erl_anno:new([{location,1},{text, "text"}])), % badarg + ok. + +is_anno(doc) -> + ["Test erl_anno:is_anno/1"]; +is_anno(_Config) -> + false = erl_anno:is_anno(a), + false = erl_anno:is_anno({a}), + false = erl_anno:is_anno([]), + false = erl_anno:is_anno([{location, 1}|{generated, true}]), + false = erl_anno:is_anno([{generated,false}]), + false = erl_anno:is_anno([{generated,true}]), + false = erl_anno:is_anno([{location,1},{file,nofile}]), + false = erl_anno:is_anno([{location,1},{text,notext}]), + false = erl_anno:is_anno([{location,1},{text,[a,b,c]}]), + + true = erl_anno:is_anno(erl_anno:new(1)), + A0 = erl_anno:new({1, 17}), + true = erl_anno:is_anno(A0), + A1 = erl_anno:set_generated(true, A0), + true = erl_anno:is_anno(A1), + A2 = erl_anno:set_file("", A1), + true = erl_anno:is_anno(A2), + A3 = erl_anno:set_record(true, A2), + true = erl_anno:is_anno(A3), + A4 = erl_anno:set_text("text", A3), + true = erl_anno:is_anno(A4), + A5 = erl_anno:set_file(<<"filename">>, A4), + true = erl_anno:is_anno(A5), + ok. + +generated(doc) -> + ["Test 'generated'"]; +generated(_Config) -> + test(1, [{generated, true}, {generated, false}]), + test(1, [{generated, false}, {generated, true}, {generated, false}]), + test({1, 17}, [{generated, false}, + {generated, true}, + {generated, false}]), + test({1, 17}, [{text, "text", [{end_location, {1, 21}}, {length, 4}]}, + {generated, false}, + {generated, true}, + {generated, false}]), + test(1, [{generated, false}, + {generated, true}, + {generated, false}]), + test(1, [{text, "text", [{end_location, 1}, {length, 4}]}, + {generated, false}, + {generated, true}, + {generated, false}]), + ok. + +end_location(doc) -> + ["Test 'end_location'"]; +end_location(_Config) -> + test({1, 17}, [{text, "TEXT", [{end_location, {1, 21}}, {length, 4}]}, + {text, "TEXT\n", [{end_location, {2, 1}}, {length, 5}]}, + {text, "TEXT\ntxt", [{end_location, {2, 4}}, {length, 8}]}]), + test(1, [{text, "TEXT", [{end_location, 1}, {length, 4}]}, + {text, "TEXT\n", [{end_location, 2}, {length, 5}]}, + {text, "TEXT\ntxt", [{end_location, 2}, {length, 8}]}]), + ok. + +file(doc) -> + ["Test 'file'"]; +file(_Config) -> + test(1, [{file, "name"}, {file, ""}]), + test({1, 17}, [{file, "name"}, {file, ""}]), + ok. + +line(doc) -> + ["Test 'line'"]; +line(_Config) -> + test(1, [{line, 17, [{location, 17}]}, + {location, {9, 8}, [{line, 9}, {column, 8}]}, + {line, 14, [{location, {14, 8}}]}]), + ok. + +location(doc) -> + ["Test 'location'"]; +location(_Config) -> + test(1, [{location, 2, [{line,2}]}, + {location, {1, 17}, [{line, 1}, {column, 17}]}, + {location, {9, 6}, [{line, 9}, {column, 6}]}, + {location, 9, [{column, undefined}]}]), + test(1, [{generated, true}, + {location, 2, [{line,2}]}, + {location, {1, 17}, [{line, 1}, {column, 17}]}, + {location, {9, 6}, [{line, 9}, {column, 6}]}, + {location, 9, [{column, undefined}]}]), + test(1, [{record, true}, + {location, 2, [{line,2}]}, + {location, {1, 17}, [{line, 1}, {column, 17}]}, + {location, {9, 6}, [{line, 9}, {column, 6}]}, + {location, 9, [{column, undefined}]}]), + ok. + +record(doc) -> + ["Test 'record'"]; +record(_Config) -> + test({1, 17}, [{record, true}, {record, false}]), + test(1, [{record, true}, {record, false}]), + test({1, 17}, [{generated, false}, + {generated, true}, + {generated, false}]), + test({1, 17}, [{text, "text", [{end_location, {1, 21}}, {length, 4}]}, + {generated, false}, + {generated, true}, + {generated, false}]), + test(1, [{generated, false}, + {generated, true}, + {generated, false}]), + test(1, [{text, "text", [{end_location, 1}, {length, 4}]}, + {generated, false}, + {generated, true}, + {generated, false}]), + ok. + +text(doc) -> + ["Test 'text'"]; +text(_Config) -> + test(1, [{text, "text", [{end_location, 1}, {length, 4}]}, + {text, "", [{end_location, 1}, {length, 0}]}]), + test({1, 17}, [{text, "text", [{end_location, {1,21}}, {length, 4}]}, + {text, "", [{end_location, {1,17}}, {length, 0}]}]), + ok. + +-dialyzer({[no_opaque, no_fail_call], bad/1}). +bad(doc) -> + ["Test bad annotations"]; +bad(_Config) -> + Line = erl_anno:new(1), + LineColumn = erl_anno:new({1, 17}), + {'EXIT', {badarg, _}} = + (catch erl_anno:set_generated(true, bad)), % 3rd arg not opaque + {'EXIT', {badarg, _}} = + (catch erl_anno:set_generated(false, bad)), % 3rd arg not opaque + {'EXIT', {badarg, _}} = + (catch erl_anno:set_generated(19, Line)), + {'EXIT', {badarg, _}} = + (catch erl_anno:set_generated(19, LineColumn)), + + {'EXIT', {badarg, _}} = + (catch erl_anno:generated(bad)), % 1st arg not opaque + {'EXIT', {badarg, _}} = + (catch erl_anno:end_location(bad)), % 1st arg not opaque + {'EXIT', {badarg, _}} = + (catch erl_anno:file(bad)), % 1st arg not opaque + {'EXIT', {badarg, _}} = + (catch erl_anno:text(bad)), % 1st arg not opaque + {'EXIT', {badarg, _}} = + (catch erl_anno:record(bad)), % 1st arg not opaque + ok. + +neg_line(doc) -> + ["Test negative line numbers (OTP 18)"]; +neg_line(_Config) -> + neg_line1(false), + neg_line1(true), + ok. + +neg_line1(TextToo) -> + Minus8_0 = erl_anno:new(-8), + Plus8_0 = erl_anno:new(8), + Minus8C_0 = erl_anno:new({-8, 17}), + Plus8C_0 = erl_anno:new({8, 17}), + + [Minus8, Plus8, Minus8C, Plus8C] = + [case TextToo of + true -> + erl_anno:set_text("foo", A); + false -> + A + end || A <- [Minus8_0, Plus8_0, Minus8C_0, Plus8C_0]], + + tst(-3, erl_anno:set_location(3, Minus8)), + tst(-3, erl_anno:set_location(-3, Plus8)), + tst(-3, erl_anno:set_location(-3, Minus8)), + tst({-3,9}, erl_anno:set_location({3, 9}, Minus8)), + tst({-3,9}, erl_anno:set_location({-3, 9}, Plus8)), + tst({-3,9}, erl_anno:set_location({-3, 9}, Minus8)), + tst(-3, erl_anno:set_location(3, Minus8C)), + tst(-3, erl_anno:set_location(-3, Plus8C)), + tst(-3, erl_anno:set_location(-3, Minus8C)), + tst({-3,9}, erl_anno:set_location({3, 9}, Minus8C)), + tst({-3,9}, erl_anno:set_location({-3, 9}, Plus8C)), + tst({-3,9}, erl_anno:set_location({-3, 9}, Minus8C)), + + tst(-8, erl_anno:set_generated(true, Plus8)), + tst(-8, erl_anno:set_generated(true, Minus8)), + tst({-8,17}, erl_anno:set_generated(true, Plus8C)), + tst({-8,17}, erl_anno:set_generated(true, Minus8C)), + tst(8, erl_anno:set_generated(false, Plus8)), + tst(8, erl_anno:set_generated(false, Minus8)), + tst({8,17}, erl_anno:set_generated(false, Plus8C)), + tst({8,17}, erl_anno:set_generated(false, Minus8C)), + + tst(-3, erl_anno:set_line(3, Minus8)), + tst(-3, erl_anno:set_line(-3, Plus8)), + tst(-3, erl_anno:set_line(-3, Minus8)), + tst({-3,17}, erl_anno:set_line(3, Minus8C)), + tst({-3,17}, erl_anno:set_line(-3, Plus8C)), + tst({-3,17}, erl_anno:set_line(-3, Minus8C)), + ok. + +tst(Term, Anno) -> + ?format("Term: ~p\n", [Term]), + ?format("Anno: ~p\n", [Anno]), + case anno_to_term(Anno) of + Term -> + ok; + Else -> + case lists:keyfind(location, 1, Else) of + {location, Term} -> + ok; + _Else2 -> + ?format("Else2 ~p\n", [_Else2]), + io:format("expected ~p\n got ~p\n", [Term, Else]), + exit({Term, Else}) + end + end. + +parse_abstract(doc) -> + ["Test erl_parse:new_anno/1, erl_parse:anno_to_term/1" + ", and erl_parse:anno_from_term/1"]; +parse_abstract(_Config) -> + T = sample_term(), + A = erl_parse:abstract(T, [{line,17}]), + T1 = erl_parse:anno_to_term(A), + Abstr = erl_parse:new_anno(T1), + T = erl_parse:normalise(Abstr), + Abstr2 = erl_parse:anno_from_term(T1), + T = erl_parse:normalise(Abstr2), + ok. + +mapfold_anno(doc) -> + ["Test erl_parse:{map_anno/2,fold_anno/3, and mapfold_anno/3}"]; +mapfold_anno(_Config) -> + T = sample_term(), + Abstr = erl_parse:abstract(T), + CF = fun(Anno, {L, D}) -> + {erl_anno:new(L), {L+1, dict:store(L, Anno, D)}} + end, + {U, {N, D}} = erl_parse:mapfold_anno(CF, {1, dict:new()}, Abstr), + SeqA = erl_parse:fold_anno(fun(Anno, Acc) -> [Anno|Acc] end, [], U), + Seq = [erl_anno:location(A) || A <- SeqA], + Seq = lists:seq(N-1, 1, -1), + NF = fun(Anno) -> + L = erl_anno:location(Anno), + dict:fetch(L, D) + end, + Abstr = erl_parse:map_anno(NF, U), + ok. + +sample_term() -> + %% This is just a sample. + {3,a,4.0,"foo",<<"bar">>,#{a => <<19:64/unsigned-little>>}, + [1000,2000]}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +test(StartLocation, Updates) -> + S0 = init(StartLocation), + A0 = erl_anno:new(StartLocation), + chk(S0, A0, []), + eval(Updates, S0, A0). + +eval([], _S0, _A0) -> + ok; +eval([{Item, Value}|Updates], S0, A0) -> + {S, A} = set(Item, Value, A0, S0, []), + eval(Updates, S, A); +eval([{Item, Value, Secondary}|Updates], S0, A0) -> + {S, A} = set(Item, Value, A0, S0, Secondary), + eval(Updates, S, A). + +init({Line, Column}) -> + lists:sort([{location, {Line, Column}} | default()]); +init(Line) when is_integer(Line) -> + lists:sort([{location, Line} | default()]). + +set(Item, Value, Anno0, State0, Secondary) -> + true = lists:member(Item, primary_items()), + ?format("Set '~w' to ~p\n", [Item, Value]), + State = set_value(Item, Value, State0), + Anno = anno_set(Item, Value, Anno0), + ?format("State0 ~p\n", [State0]), + ?format("State ~p\n", [State]), + ?format("Anno0 ~p\n", [anno_to_term(Anno0)]), + ?format("Anno ~p\n", [anno_to_term(Anno)]), + chk(State, Anno, Secondary), + ok = frame(Anno0, Anno, Secondary), + {State, Anno}. + +frame(OldAnno, NewAnno, Secondary) -> + SecItems = [I || {I, _} <- Secondary], + Frame = secondary_items() -- (SecItems ++ primary_items()), + ?format("Frame items ~p\n", [Frame]), + frame1(Frame, OldAnno, NewAnno). + +frame1([], _OldAnno, _NewAnno) -> + ok; +frame1([Item|Items], OldAnno, NewAnno) -> + V1 = anno_info(OldAnno, Item), + V2 = anno_info(NewAnno, Item), + ok = check_value(Item, V1, V2), + frame1(Items, OldAnno, NewAnno). + +chk(State, Anno, Secondary) -> + ok = check_simple(Anno), + ok = chk_primary(State, Anno), + ok = check_secondary(Secondary, State, Anno). + +chk_primary(State, Anno) -> + chk_primary(primary_items(), State, Anno). + +chk_primary([], _State, _Anno) -> + ok; +chk_primary([Item | Items], State, Anno) -> + V1 = primary_value(Item, State), + V2 = anno_info(Anno, Item), + ok = check_value(Item, V1, V2), + chk_primary(Items, State, Anno). + +check_secondary([], _State, _Anno) -> + ok; +check_secondary([{Item, _}=V1 | Secondary], State, Anno) -> + V2 = anno_info(Anno, Item), + case {V1, V2} of + {{Item, undefined}, undefined} -> + ok; + _ -> + ok = check_value(Item, V1, V2) + end, + check_secondary(Secondary, State, Anno). + +check_value(Item, V1, V2) -> + ?format("~w: V1 ~p\n", [Item, V1]), + ?format("~w: V2 ~p\n", [Item, V2]), + case V1 =:= V2 of + true -> + ok; + false -> + io:format("~w: expected ~p\n got ~p\n", [Item, V1, V2]), + exit({V1, V2}) + end. + +check_simple(Anno) -> + Term = anno_to_term(Anno), + case find_defaults(Term) of + [] -> + ok; + Ds -> + io:format("found default values ~w in ~p\n", [Ds, Anno]), + exit({defaults, Anno}) + end, + case check_simple1(Term) of + true -> + ok; + false -> + io:format("not simple ~p\n", [Anno]), + exit({not_simple, Anno}) + end. + +check_simple1(L) when is_integer(L) -> + true; +check_simple1({L, C}) when is_integer(L), is_integer(C) -> + true; +check_simple1(List) -> + case lists:sort(List) of + [{location, _}] -> + false; + _ -> + true + end. + +find_defaults(L) when is_list(L) -> + [I || + I <- default_items(), + {I1, Value} <- L, + I =:= I1, + Value =:= default_value(I)]; +find_defaults(_) -> + []. + +anno_to_term(Anno) -> + T = erl_anno:to_term(Anno), + maybe_sort(T). + +maybe_sort(L) when is_list(L) -> + lists:sort(L); +maybe_sort(T) -> + T. + +anno_set(file, Value, Anno) -> + erl_anno:set_file(Value, Anno); +anno_set(generated, Value, Anno) -> + erl_anno:set_generated(Value, Anno); +anno_set(line, Value, Anno) -> + erl_anno:set_line(Value, Anno); +anno_set(location, Value, Anno) -> + erl_anno:set_location(Value, Anno); +anno_set(record, Value, Anno) -> + erl_anno:set_record(Value, Anno); +anno_set(text, Value, Anno) -> + erl_anno:set_text(Value, Anno). + +anno_info(Anno, Item) -> + Value = + case Item of + column -> + erl_anno:column(Anno); + generated -> + erl_anno:generated(Anno); + end_location -> + erl_anno:end_location(Anno); + file -> + erl_anno:file(Anno); + length -> + case erl_anno:text(Anno) of + undefined -> + undefined; + Text -> + length(Text) + end; + line -> + erl_anno:line(Anno); + location -> + erl_anno:location(Anno); + record -> + erl_anno:record(Anno); + text -> + erl_anno:text(Anno); + _ -> + erlang:error(badarg, [Anno, Item]) + end, + if + Value =:= undefined -> + undefined; + true -> + {Item, Value} + end. + +%%% Originally 'location' was primary while 'line' and 'column' were +%%% secondary (their values are determined by 'location'). But since +%%% set_line() is used kind of frequently, 'line' is also primary, +%%% and 'location' secondary (depends on 'line'). 'line' need to be +%%% handled separately. + +set_value(line, Line, State) -> + {location, Location} = primary_value(location, State), + NewLocation = case Location of + {_, Column} -> + {Line, Column}; + _ -> + Line + end, + set_value(location, NewLocation, State); +set_value(Item, Value, State) -> + lists:ukeymerge(1, [{Item, Value}], State). + +primary_value(line, State) -> + {location, Location} = primary_value(location, State), + {line, case Location of + {Line, _} -> + Line; + Line -> + Line + end}; +primary_value(Item, State) -> + case lists:keyfind(Item, 1, State) of + false -> + undefined; + Tuple -> + Tuple + end. + +default() -> + [{Tag, default_value(Tag)} || Tag <- default_items()]. + +primary_items() -> + [file, generated, line, location, record, text]. + +secondary_items() -> + %% 'length' has not been implemented + [column, end_location, length, line, location]. + +default_items() -> + [generated, record]. + +default_value(generated) -> false; +default_value(record) -> false. diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index 3427f431c5..a750c5cace 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1482,8 +1482,11 @@ eep43(Config) when is_list(Config) -> " #{ K1 := 1, K2 := 2, K3 := 3, {2,2} := 4} = Map " "end.", #{ 1 => 1, <<42:301>> => 2, {3,<<42:301>>} => 3, {2,2} => 4}), - error_check("[camembert]#{}.", {badarg,[camembert]}), + error_check("[camembert]#{}.", {badmap,[camembert]}), + error_check("[camembert]#{nonexisting:=v}.", {badmap,[camembert]}), error_check("#{} = 1.", {badmatch,1}), + error_check("[]#{a=>error(bad)}.", bad), + error_check("(#{})#{nonexisting:=value}.", {badkey,nonexisting}), ok. %% Check the string in different contexts: as is; in fun; from compiled code. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index a7c3fd3c2e..c0d9b7c466 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -64,7 +64,7 @@ too_many_arguments/1, basic_errors/1,bin_syntax_errors/1, predef/1, - maps/1,maps_type/1,otp_11851/1 + maps/1,maps_type/1,otp_11851/1,otp_12195/1 ]). % Default timetrap timeout (set in init_per_testcase). @@ -93,7 +93,7 @@ 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]. + maps, maps_type, otp_11851, otp_12195]. groups() -> [{unused_vars_warn, [], @@ -3834,6 +3834,40 @@ otp_11851(Config) when is_list(Config) -> [] = run(Config, Ts), ok. +otp_12195(doc) -> + "OTP-12195: Check obsolete types (tailor made for OTP 18)."; +otp_12195(Config) when is_list(Config) -> + Ts = [{otp_12195_1, + <<"-export_type([r1/0]). + -type r1() :: erl_scan:line() + | erl_scan:column() + | erl_scan:location() + | erl_anno:line().">>, + [], + {warnings,[{2,erl_lint, + {deprecated_type,{erl_scan,line,0}, + "deprecated (will be removed in OTP 19); " + "use erl_anno:line() instead"}}, + {3,erl_lint, + {deprecated_type,{erl_scan,column,0}, + "deprecated (will be removed in OTP 19); use " + "erl_anno:column() instead"}}, + {4,erl_lint, + {deprecated_type,{erl_scan,location,0}, + "deprecated (will be removed in OTP 19); " + "use erl_anno:location() instead"}}]}}, + {otp_12195_2, + <<"-export_type([r1/0]). + -compile(nowarn_deprecated_type). + -type r1() :: erl_scan:line() + | erl_scan:column() + | erl_scan:location() + | erl_anno:line().">>, + [], + []}], + [] = run(Config, Ts), + ok. + run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index f71446dd64..1d63c8e17e 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2014. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -490,7 +490,7 @@ cond1(Config) when is_list(Config) -> [{cons,3,{atom,3,a},{cons,3,{atom,3,b},{nil,3}}}]}, {clause,4,[],[[{atom,4,true}]], [{tuple,5,[{atom,5,x},{atom,5,y}]}]}]}, - ?line CChars = lists:flatten(erl_pp:expr(C)), + CChars = flat_expr1(C), % ?line "cond {foo,bar} -> [a,b]; true -> {x,y} end" = CChars, ?line "cond\n" " {foo,bar} ->\n" @@ -557,7 +557,7 @@ messages(Config) when is_list(Config) -> lists:flatten(erl_pp:form({error,{some,"error"}})), ?line true = "{warning,{some,\"warning\"}}\n" =:= lists:flatten(erl_pp:form({warning,{some,"warning"}})), - ?line true = "\n" =:= lists:flatten(erl_pp:form({eof,0})), + "\n" = flat_form({eof,0}), ok. import_export(suite) -> @@ -616,27 +616,29 @@ hook(Config) when is_list(Config) -> do_hook(HookFun) -> Lc = parse_expr(binary_to_list(<<"[X || X <- [1,2,3]].">>)), H = HookFun(fun hook/4), - Expr = {call,0,{atom,0,fff},[{foo,Lc},{foo,Lc},{foo,Lc}]}, + A0 = erl_anno:new(0), + Expr = {call,A0,{atom,A0,fff},[{foo,Lc},{foo,Lc},{foo,Lc}]}, EChars = lists:flatten(erl_pp:expr(Expr, 0, H)), - Call = {call,0,{atom,0,foo},[Lc]}, - Expr2 = {call,0,{atom,0,fff},[Call,Call,Call]}, + Call = {call,A0,{atom,A0,foo},[Lc]}, + Expr2 = {call,A0,{atom,A0,fff},[Call,Call,Call]}, EChars2 = erl_pp:exprs([Expr2]), ?line true = EChars =:= lists:flatten(EChars2), EsChars = erl_pp:exprs([Expr], H), ?line true = EChars =:= lists:flatten(EsChars), - F = {function,1,ffff,0,[{clause,1,[],[],[Expr]}]}, + A1 = erl_anno:new(1), + F = {function,A1,ffff,0,[{clause,A1,[],[],[Expr]}]}, FuncChars = lists:flatten(erl_pp:function(F, H)), - F2 = {function,1,ffff,0,[{clause,1,[],[],[Expr2]}]}, + F2 = {function,A1,ffff,0,[{clause,A1,[],[],[Expr2]}]}, FuncChars2 = erl_pp:function(F2), ?line true = FuncChars =:= lists:flatten(FuncChars2), FFormChars = erl_pp:form(F, H), ?line true = FuncChars =:= lists:flatten(FFormChars), - A = {attribute,1,record,{r,[{record_field,1,{atom,1,a},Expr}]}}, + A = {attribute,A1,record,{r,[{record_field,A1,{atom,A1,a},Expr}]}}, AChars = lists:flatten(erl_pp:attribute(A, H)), - A2 = {attribute,1,record,{r,[{record_field,1,{atom,1,a},Expr2}]}}, + A2 = {attribute,A1,record,{r,[{record_field,A1,{atom,A1,a},Expr2}]}}, AChars2 = erl_pp:attribute(A2), ?line true = AChars =:= lists:flatten(AChars2), AFormChars = erl_pp:form(A, H), @@ -645,10 +647,10 @@ do_hook(HookFun) -> ?line "INVALID-FORM:{foo,bar}:" = lists:flatten(erl_pp:expr({foo,bar})), %% A list (as before R6), not a list of lists. - G = [{op,1,'>',{atom,1,a},{foo,{atom,1,b}}}], % not a proper guard + G = [{op,A1,'>',{atom,A1,a},{foo,{atom,A1,b}}}], % not a proper guard GChars = lists:flatten(erl_pp:guard(G, H)), - G2 = [{op,1,'>',{atom,1,a}, - {call,0,{atom,0,foo},[{atom,1,b}]}}], % not a proper guard + G2 = [{op,A1,'>',{atom,A1,a}, + {call,A0,{atom,A0,foo},[{atom,A1,b}]}}], % not a proper guard GChars2 = erl_pp:guard(G2), ?line true = GChars =:= lists:flatten(GChars2), @@ -659,14 +661,14 @@ do_hook(HookFun) -> ?line true = EChars =:= lists:flatten(XEChars2), %% Note: no leading spaces before "begin". - Block = {block,0,[{match,0,{var,0,'A'},{integer,0,3}}, - {atom,0,true}]}, + Block = {block,A0,[{match,A0,{var,A0,'A'},{integer,A0,3}}, + {atom,A0,true}]}, ?line "begin\n A =" ++ _ = lists:flatten(erl_pp:expr(Block, 17, none)), %% Special... ?line true = - "{some,value}" =:= lists:flatten(erl_pp:expr({value,0,{some,value}})), + "{some,value}" =:= lists:flatten(erl_pp:expr({value,A0,{some,value}})), %% Silly... ?line true = @@ -674,8 +676,8 @@ do_hook(HookFun) -> flat_expr({'if',0,[{clause,0,[],[],[{atom,0,0}]}]}), %% More compatibility: before R6 - OldIf = {'if',0,[{clause,0,[],[{atom,0,true}],[{atom,0,b}]}]}, - NewIf = {'if',0,[{clause,0,[],[[{atom,0,true}]],[{atom,0,b}]}]}, + OldIf = {'if',A0,[{clause,A0,[],[{atom,A0,true}],[{atom,A0,b}]}]}, + NewIf = {'if',A0,[{clause,A0,[],[[{atom,A0,true}]],[{atom,A0,b}]}]}, OldIfChars = lists:flatten(erl_pp:expr(OldIf)), NewIfChars = lists:flatten(erl_pp:expr(NewIf)), ?line true = OldIfChars =:= NewIfChars, @@ -691,7 +693,8 @@ ehook(HE, I, P, H, foo, bar) -> hook(HE, I, P, H). hook({foo,E}, I, P, H) -> - erl_pp:expr({call,0,{atom,0,foo},[E]}, I, P, H). + A = erl_anno:new(0), + erl_pp:expr({call,A,{atom,A,foo},[E]}, I, P, H). neg_indent(suite) -> []; @@ -774,7 +777,7 @@ otp_6911(Config) when is_list(Config) -> {var,6,'X'}, [{clause,7,[{atom,7,true}],[],[{integer,7,12}]}, {clause,8,[{atom,8,false}],[],[{integer,8,14}]}]}]}]}, - ?line Chars = lists:flatten(erl_pp:form(F)), + Chars = flat_form(F), ?line "thomas(X) ->\n" " case X of\n" " true ->\n" @@ -1084,10 +1087,11 @@ otp_10302(Config) when is_list(Config) -> Opts = [{hook, fun unicode_hook/4},{encoding,unicode}], Lc = parse_expr("[X || X <- [\"\x{400}\",\"\xFF\"]]."), - Expr = {call,0,{atom,0,fff},[{foo,{foo,Lc}},{foo,{foo,Lc}}]}, + A0 = erl_anno:new(0), + Expr = {call,A0,{atom,A0,fff},[{foo,{foo,Lc}},{foo,{foo,Lc}}]}, EChars = lists:flatten(erl_pp:expr(Expr, 0, Opts)), - Call = {call,0,{atom,0,foo},[{call,0,{atom,0,foo},[Lc]}]}, - Expr2 = {call,0,{atom,0,fff},[Call,Call]}, + Call = {call,A0,{atom,A0,foo},[{call,A0,{atom,A0,foo},[Lc]}]}, + Expr2 = {call,A0,{atom,A0,fff},[Call,Call]}, EChars2 = erl_pp:exprs([Expr2], U), EChars = lists:flatten(EChars2), [$\x{400},$\x{400}] = [C || C <- EChars, C > 255], @@ -1097,7 +1101,8 @@ otp_10302(Config) when is_list(Config) -> ok. unicode_hook({foo,E}, I, P, H) -> - erl_pp:expr({call,0,{atom,0,foo},[E]}, I, P, H). + A = erl_anno:new(0), + erl_pp:expr({call,A,{atom,A,foo},[E]}, I, P, H). otp_10820(doc) -> "OTP-10820. Unicode filenames."; @@ -1137,29 +1142,30 @@ otp_11100(Config) when is_list(Config) -> %% Cannot trigger the use of the hook function with export/import. "-export([{fy,a}/b]).\n" = pf({attribute,1,export,[{{fy,a},b}]}), + A1 = erl_anno:new(1), "-type foo() :: integer(INVALID-FORM:{foo,bar}:).\n" = - pf({attribute,1,type,{foo,{type,1,integer,[{foo,bar}]},[]}}), - pf({attribute,1,type, - {a,{type,1,range,[{integer,1,1},{foo,bar}]},[]}}), + pf({attribute,A1,type,{foo,{type,A1,integer,[{foo,bar}]},[]}}), + pf({attribute,A1,type, + {a,{type,A1,range,[{integer,A1,1},{foo,bar}]},[]}}), "-type foo(INVALID-FORM:{foo,bar}:) :: A.\n" = - pf({attribute,1,type,{foo,{var,1,'A'},[{foo,bar}]}}), + pf({attribute,A1,type,{foo,{var,A1,'A'},[{foo,bar}]}}), "-type foo() :: (INVALID-FORM:{foo,bar}: :: []).\n" = - pf({attribute,1,type, - {foo,{paren_type,1, - [{ann_type,1,[{foo,bar},{type,1,nil,[]}]}]}, + pf({attribute,A1,type, + {foo,{paren_type,A1, + [{ann_type,A1,[{foo,bar},{type,A1,nil,[]}]}]}, []}}), "-type foo() :: <<_:INVALID-FORM:{foo,bar}:>>.\n" = - pf({attribute,1,type, - {foo,{type,1,binary,[{foo,bar},{integer,1,0}]},[]}}), + pf({attribute,A1,type, + {foo,{type,A1,binary,[{foo,bar},{integer,A1,0}]},[]}}), "-type foo() :: <<_:10, _:_*INVALID-FORM:{foo,bar}:>>.\n" = - pf({attribute,1,type, - {foo,{type,1,binary,[{integer,1,10},{foo,bar}]},[]}}), + pf({attribute,A1,type, + {foo,{type,A1,binary,[{integer,A1,10},{foo,bar}]},[]}}), "-type foo() :: #r{INVALID-FORM:{foo,bar}: :: integer()}.\n" = - pf({attribute,1,type, - {foo,{type,1,record, - [{atom,1,r}, - {type,1,field_type, - [{foo,bar},{type,1,integer,[]}]}]}, + pf({attribute,A1,type, + {foo,{type,A1,record, + [{atom,A1,r}, + {type,A1,field_type, + [{foo,bar},{type,A1,integer,[]}]}]}, []}}), ok. @@ -1239,9 +1245,18 @@ strip_module_info(Bin) -> <<R:Start/binary,_/binary>> = Bin, R. -flat_expr(Expr) -> +flat_expr1(Expr0) -> + Expr = erl_parse:new_anno(Expr0), + lists:flatten(erl_pp:expr(Expr)). + +flat_expr(Expr0) -> + Expr = erl_parse:new_anno(Expr0), lists:flatten(erl_pp:expr(Expr, -1, none)). +flat_form(Form0) -> + Form = erl_parse:new_anno(Form0), + lists:flatten(erl_pp:form(Form)). + pp_forms(Bin) -> pp_forms(Bin, none). diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 6ef947f0e3..fb85055b6c 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -138,7 +138,7 @@ iso88591(Config) when is_list(Config) -> A1s = [$h,$ä,$r], A2s = [$ö,$r,$e], %% Test parsing atom and variable characters. - {ok,Ts1,_} = erl_scan:string(V1s ++ " " ++ V2s ++ + {ok,Ts1,_} = erl_scan_string(V1s ++ " " ++ V2s ++ "\327" ++ A1s ++ " " ++ A2s), V1s = atom_to_list(element(3, nth(1, Ts1))), @@ -151,7 +151,7 @@ iso88591(Config) when is_list(Config) -> %% Test parsing and printing strings. S1 = V1s ++ "\327" ++ A1s ++ "\250" ++ A2s, S1s = "\"" ++ S1 ++ "\"", - {ok,Ts2,_} = erl_scan:string(S1s), + {ok,Ts2,_} = erl_scan_string(S1s), S1 = element(3, nth(1, Ts2)), S1s = flatten(print(element(3, nth(1, Ts2)))), ok %It all worked @@ -219,7 +219,7 @@ atoms() -> test_string([39,65,200,39], [{atom,{1,1},'AÈ'}]), test_string("ärlig östen", [{atom,{1,1},ärlig},{atom,{1,7},östen}]), ?line {ok,[{atom,_,'$a'}],{1,6}} = - erl_scan:string("'$\\a'", {1,1}), + erl_scan_string("'$\\a'", {1,1}), ?line test("'$\\a'"), ok. @@ -268,24 +268,24 @@ punctuations() -> comments() -> ?line test("a %%\n b"), - ?line {ok,[],1} = erl_scan:string("%"), + {ok,[],1} = erl_scan_string("%"), ?line test("a %%\n b"), {ok,[{atom,{1,1},a},{atom,{2,2},b}],{2,3}} = - erl_scan:string("a %%\n b",{1,1}), + erl_scan_string("a %%\n b", {1,1}), {ok,[{atom,{1,1},a},{comment,{1,3},"%%"},{atom,{2,2},b}],{2,3}} = - erl_scan:string("a %%\n b",{1,1}, [return_comments]), + erl_scan_string("a %%\n b",{1,1}, [return_comments]), {ok,[{atom,{1,1},a}, {white_space,{1,2}," "}, {white_space,{1,5},"\n "}, {atom,{2,2},b}], {2,3}} = - erl_scan:string("a %%\n b",{1,1},[return_white_spaces]), + erl_scan_string("a %%\n b",{1,1},[return_white_spaces]), {ok,[{atom,{1,1},a}, {white_space,{1,2}," "}, {comment,{1,3},"%%"}, {white_space,{1,5},"\n "}, {atom,{2,2},b}], - {2,3}} = erl_scan:string("a %%\n b",{1,1},[return]), + {2,3}} = erl_scan_string("a %%\n b",{1,1},[return]), ok. errors() -> @@ -337,11 +337,11 @@ base_integers() -> erl_scan:string(Str) end || {BS,S} <- [{"3","3"},{"15","f"}, {"12","c"}] ], - ?line {ok,[{integer,1,239},{'@',1}],1} = erl_scan:string("16#ef@"), + {ok,[{integer,1,239},{'@',1}],1} = erl_scan_string("16#ef@"), {ok,[{integer,{1,1},239},{'@',{1,6}}],{1,7}} = - erl_scan:string("16#ef@", {1,1}, []), + erl_scan_string("16#ef@", {1,1}, []), {ok,[{integer,{1,1},14},{atom,{1,5},g@}],{1,7}} = - erl_scan:string("16#eg@", {1,1}, []), + erl_scan_string("16#eg@", {1,1}, []), ok. @@ -382,8 +382,8 @@ dots() -> {ok,[{'.',{1,1}},{atom,{1,2},a}],{1,3}}} ], [begin - R = erl_scan:string(S), - R2 = erl_scan:string(S, {1,1}, []) + R = erl_scan_string(S), + R2 = erl_scan_string(S, {1,1}, []) end || {S, R, R2} <- Dot], ?line {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text), @@ -417,7 +417,7 @@ dots() -> {white_space,{1,4},"\n"}, {dot,{2,1}}], {2,3}}, ""} = - erl_scan:tokens(C, "\n. ", {1,1}, return), % any loc, any options + erl_scan_tokens(C, "\n. ", {1,1}, return), % any loc, any options ?line [test_string(S, R) || {S, R} <- [{".$\n", [{'.',{1,1}},{char,{1,2},$\n}]}, @@ -511,7 +511,7 @@ eof() -> %% An error before R13A. %% ?line {done,Err={error,{1,erl_scan,scan},1},eof} = ?line {done,{ok,[{atom,1,abra}],1},eof} = - erl_scan:tokens(C2, eof, 1), + erl_scan_tokens(C2, eof, 1), %% With column. ?line {more, C3} = erl_scan:tokens([]," \n",{1,1}), @@ -520,7 +520,7 @@ eof() -> %% An error before R13A. %% ?line {done,{error,{{1,1},erl_scan,scan},{1,5}},eof} = ?line {done,{ok,[{atom,_,abra}],{1,5}},eof} = - erl_scan:tokens(C4, eof, 1), + erl_scan_tokens(C4, eof, 1), %% Robert's scanner returns "" as LeftoverChars; %% the R12B scanner returns eof as LeftoverChars: (eof is correct) @@ -528,26 +528,26 @@ eof() -> %% An error before R13A. %% ?line {done,{error,{1,erl_scan,scan},1},eof} = ?line {done,{ok,[{atom,1,a}],1},eof} = - erl_scan:tokens(C5,eof,1), + erl_scan_tokens(C5,eof,1), %% With column. {more, C6} = erl_scan:tokens([], "a", {1,1}), %% An error before R13A. %% {done,{error,{1,erl_scan,scan},1},eof} = {done,{ok,[{atom,{1,1},a}],{1,2}},eof} = - erl_scan:tokens(C6,eof,1), + erl_scan_tokens(C6,eof,1), %% A dot followed by eof is special: ?line {more, C} = erl_scan:tokens([], "a.", 1), - ?line {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan:tokens(C,eof,1), - ?line {ok,[{atom,1,foo},{dot,1}],1} = erl_scan:string("foo."), + {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan_tokens(C,eof,1), + {ok,[{atom,1,foo},{dot,1}],1} = erl_scan_string("foo."), %% With column. {more, CCol} = erl_scan:tokens([], "a.", {1,1}), {done,{ok,[{atom,{1,1},a},{dot,{1,2}}],{1,3}},eof} = - erl_scan:tokens(CCol,eof,1), + erl_scan_tokens(CCol,eof,1), {ok,[{atom,{1,1},foo},{dot,{1,4}}],{1,5}} = - erl_scan:string("foo.", {1,1}, []), + erl_scan_string("foo.", {1,1}, []), ok. @@ -628,23 +628,23 @@ crashes() -> options() -> %% line and column are not options, but tested here ?line {ok,[{atom,1,foo},{white_space,1," "},{comment,1,"% bar"}], 1} = - erl_scan:string("foo % bar", 1, return), + erl_scan_string("foo % bar", 1, return), ?line {ok,[{atom,1,foo},{white_space,1," "}],1} = - erl_scan:string("foo % bar", 1, return_white_spaces), + erl_scan_string("foo % bar", 1, return_white_spaces), ?line {ok,[{atom,1,foo},{comment,1,"% bar"}],1} = - erl_scan:string("foo % bar", 1, return_comments), + erl_scan_string("foo % bar", 1, return_comments), ?line {ok,[{atom,17,foo}],17} = - erl_scan:string("foo % bar", 17), + erl_scan_string("foo % bar", 17), ?line {'EXIT',{function_clause,_}} = (catch {foo, erl_scan:string("foo % bar", {a,1}, [])}), % type error ?line {ok,[{atom,_,foo}],{17,18}} = - erl_scan:string("foo % bar", {17,9}, []), + erl_scan_string("foo % bar", {17,9}, []), ?line {'EXIT',{function_clause,_}} = (catch {foo, erl_scan:string("foo % bar", {1,0}, [])}), % type error ?line {ok,[{foo,1}],1} = - erl_scan:string("foo % bar",1, [{reserved_word_fun, + erl_scan_string("foo % bar",1, [{reserved_word_fun, fun(W) -> W =:= foo end}]), ?line {'EXIT',{badarg,_}} = (catch {foo, @@ -706,8 +706,9 @@ token_info() -> attributes_info() -> ?line {'EXIT',_} = (catch {foo,erl_scan:attributes_info(foo)}), % type error - ?line [{line,18}] = erl_scan:attributes_info(18), - ?line {location,19} = erl_scan:attributes_info(19, location), + [{line,18}] = erl_scan:attributes_info(erl_anno:new(18)), + {location,19} = + erl_scan:attributes_info(erl_anno:new(19), location), ?line {ok,[{atom,A0,foo}],_} = erl_scan:string("foo", 19, [text]), ?line {location,19} = erl_scan:attributes_info(A0, location), @@ -735,7 +736,9 @@ attributes_info() -> set_attribute() -> F = fun(Line) -> -Line end, - ?line -2 = erl_scan:set_attribute(line, 2, F), + Anno2 = erl_anno:new(2), + A0 = erl_scan:set_attribute(line, Anno2, F), + {line, -2} = erl_scan:attributes_info(A0, line), ?line {ok,[{atom,A1,foo}],_} = erl_scan:string("foo", {9,17}), ?line A2 = erl_scan:set_attribute(line, A1, F), ?line {line,-9} = erl_scan:attributes_info(A2, line), @@ -765,10 +768,15 @@ set_attribute() -> ?line {ok,[{atom,A6,foo}],_} = erl_scan:string("foo", 11, [text]), ?line A7 = erl_scan:set_attribute(line, A6, F2), - ?line {line,{17,11}} = erl_scan:attributes_info(A7, line), + %% Incompatible with pre 18: + %% {line,{17,11}} = erl_scan:attributes_info(A7, line), + {line,17} = erl_scan:attributes_info(A7, line), ?line {location,{17,11}} = % mixed up erl_scan:attributes_info(A7, location), - ?line [{line,{17,11}},{text,"foo"}] = + %% Incompatible with pre 18: + %% [{line,{17,11}},{text,"foo"}] = + %% erl_scan:attributes_info(A7, [line,column,text]), + [{line,17},{column,11},{text,"foo"}] = erl_scan:attributes_info(A7, [line,column,text]), ?line {'EXIT',_} = @@ -776,9 +784,13 @@ set_attribute() -> ?line {'EXIT',{badarg,_}} = (catch {foo, erl_scan:set_attribute(column, [], F2)}), % type error + Attr10 = erl_anno:new(8), + Attr20 = erl_scan:set_attribute(line, Attr10, + fun(L) -> {nos,'X',L} end), %% OTP-9412 - ?line 8 = erl_scan:set_attribute(line, [{line,{nos,'X',8}}], - fun({nos,_V,VL}) -> VL end), + Attr30 = erl_scan:set_attribute(line, Attr20, + fun({nos,_V,VL}) -> VL end), + 8 = erl_anno:to_term(Attr30), ok. column_errors() -> @@ -812,7 +824,7 @@ white_spaces() -> {white_space,_," "}, {atom,_,a}, {white_space,_,"\n"}], - _} = erl_scan:string("\r a\n", {1,1}, return), + _} = erl_scan_string("\r a\n", {1,1}, return), ?line test("\r a\n"), L = "{\"a\nb\", \"a\\nb\",\nabc\r,def}.\n\n", ?line {ok,[{'{',_}, @@ -829,7 +841,7 @@ white_spaces() -> {'}',_}, {dot,_}, {white_space,_,"\n"}], - _} = erl_scan:string(L, {1,1}, return), + _} = erl_scan_string(L, {1,1}, return), ?line test(L), ?line test("\"\n\"\n"), ?line test("\n\r\n"), @@ -846,7 +858,7 @@ white_spaces() -> unicode() -> ?line {ok,[{char,1,83},{integer,1,45}],1} = - erl_scan:string("$\\12345"), % not unicode + erl_scan_string("$\\12345"), % not unicode ?line {error,{1,erl_scan,{illegal,character}},1} = erl_scan:string([1089]), @@ -858,7 +870,7 @@ unicode() -> erl_scan:string("'a"++[1089]++"b'", {1,1}), ?line test("\"a"++[1089]++"b\""), {ok,[{char,1,1}],1} = - erl_scan:string([$$,$\\,$^,1089], 1), + erl_scan_string([$$,$\\,$^,1089], 1), {error,{1,erl_scan,Error},1} = erl_scan:string("\"qa\x{aaa}", 1), @@ -870,13 +882,13 @@ unicode() -> erl_scan:string("'qa\\x{aaa}'",{1,1}), {ok,[{char,1,1089}],1} = - erl_scan:string([$$,1089], 1), + erl_scan_string([$$,1089], 1), {ok,[{char,1,1089}],1} = - erl_scan:string([$$,$\\,1089], 1), + erl_scan_string([$$,$\\,1089], 1), Qs = "$\\x{aaa}", {ok,[{char,1,$\x{aaa}}],1} = - erl_scan:string(Qs, 1), + erl_scan_string(Qs, 1), {ok,[Q2],{1,9}} = erl_scan:string("$\\x{aaa}", {1,1}, [text]), [{category,char},{column,1},{length,8}, @@ -884,19 +896,19 @@ unicode() -> erl_scan:token_info(Q2), U1 = "\"\\x{aaa}\"", - {ok, - [{string,[{line,1},{column,1},{text,"\"\\x{aaa}\""}],[2730]}], - {1,10}} = erl_scan:string(U1, {1,1}, [text]), - {ok,[{string,1,[2730]}],1} = erl_scan:string(U1, 1), + {ok,[{string,A1,[2730]}],{1,10}} = erl_scan:string(U1, {1,1}, [text]), + [{line,1},{column,1},{text,"\"\\x{aaa}\""}] = + erl_scan:attributes_info(A1, [line, column, text]), + {ok,[{string,1,[2730]}],1} = erl_scan_string(U1, 1), U2 = "\"\\x41\\x{fff}\\x42\"", - {ok,[{string,1,[$\x41,$\x{fff},$\x42]}],1} = erl_scan:string(U2, 1), + {ok,[{string,1,[$\x41,$\x{fff},$\x42]}],1} = erl_scan_string(U2, 1), U3 = "\"a\n\\x{fff}\n\"", - {ok,[{string,1,[$a,$\n,$\x{fff},$\n]}],3} = erl_scan:string(U3, 1), + {ok,[{string,1,[$a,$\n,$\x{fff},$\n]}],3} = erl_scan_string(U3, 1), U4 = "\"\\^\n\\x{aaa}\\^\n\"", - {ok,[{string,1,[$\n,$\x{aaa},$\n]}],3} = erl_scan:string(U4, 1), + {ok,[{string,1,[$\n,$\x{aaa},$\n]}],3} = erl_scan_string(U4, 1), %% Keep these tests: ?line test(Qs), @@ -906,15 +918,15 @@ unicode() -> ?line test(U4), Str1 = "\"ab" ++ [1089] ++ "cd\"", - {ok,[{string,1,[$a,$b,1089,$c,$d]}],1} = erl_scan:string(Str1, 1), + {ok,[{string,1,[$a,$b,1089,$c,$d]}],1} = erl_scan_string(Str1, 1), {ok,[{string,{1,1},[$a,$b,1089,$c,$d]}],{1,8}} = - erl_scan:string(Str1, {1,1}), + erl_scan_string(Str1, {1,1}), ?line test(Str1), Comment = "%% "++[1089], {ok,[{comment,1,[$%,$%,$\s,1089]}],1} = - erl_scan:string(Comment, 1, [return]), + erl_scan_string(Comment, 1, [return]), {ok,[{comment,{1,1},[$%,$%,$\s,1089]}],{1,5}} = - erl_scan:string(Comment, {1,1}, [return]), + erl_scan_string(Comment, {1,1}, [return]), ok. more_chars() -> @@ -923,12 +935,12 @@ more_chars() -> %% All kinds of tests... ?line {ok,[{char,_,123}],{1,4}} = - erl_scan:string("$\\{",{1,1}), + erl_scan_string("$\\{",{1,1}), ?line {more, C1} = erl_scan:tokens([], "$\\{", {1,1}), ?line {done,{ok,[{char,_,123}],{1,4}},eof} = - erl_scan:tokens(C1, eof, 1), + erl_scan_tokens(C1, eof, 1), ?line {ok,[{char,1,123},{atom,1,a},{'}',1}],1} = - erl_scan:string("$\\{a}"), + erl_scan_string("$\\{a}"), ?line {error,{{1,1},erl_scan,char},{1,4}} = erl_scan:string("$\\x", {1,1}), @@ -993,11 +1005,11 @@ otp_10302(Config) when is_list(Config) -> {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = erl_scan:string("'qa\\x{aaa}'",{1,1}), - {ok,[{char,1,1089}],1} = erl_scan:string([$$,1089], 1), - {ok,[{char,1,1089}],1} = erl_scan:string([$$,$\\,1089],1), + {ok,[{char,1,1089}],1} = erl_scan_string([$$,1089], 1), + {ok,[{char,1,1089}],1} = erl_scan_string([$$,$\\,1089],1), Qs = "$\\x{aaa}", - {ok,[{char,1,2730}],1} = erl_scan:string(Qs,1), + {ok,[{char,1,2730}],1} = erl_scan_string(Qs, 1), {ok,[Q2],{1,9}} = erl_scan:string(Qs,{1,1},[text]), [{category,char},{column,1},{length,8}, {line,1},{symbol,16#aaa},{text,Qs}] = @@ -1011,19 +1023,19 @@ otp_10302(Config) when is_list(Config) -> {symbol,[16#aaa]},{text,U1}] = erl_scan:token_info(T1, Tags), U2 = "\"\\x41\\x{fff}\\x42\"", - {ok,[{string,1,[65,4095,66]}],1} = erl_scan:string(U2, 1), + {ok,[{string,1,[65,4095,66]}],1} = erl_scan_string(U2, 1), U3 = "\"a\n\\x{fff}\n\"", - {ok,[{string,1,[97,10,4095,10]}],3} = erl_scan:string(U3, 1), + {ok,[{string,1,[97,10,4095,10]}],3} = erl_scan_string(U3, 1), U4 = "\"\\^\n\\x{aaa}\\^\n\"", - {ok,[{string,1,[10,2730,10]}],3} = erl_scan:string(U4, 1,[]), + {ok,[{string,1,[10,2730,10]}],3} = erl_scan_string(U4, 1,[]), Str1 = "\"ab" ++ [1089] ++ "cd\"", {ok,[{string,1,[97,98,1089,99,100]}],1} = - erl_scan:string(Str1,1), + erl_scan_string(Str1,1), {ok,[{string,{1,1},[97,98,1089,99,100]}],{1,8}} = - erl_scan:string(Str1, {1,1}), + erl_scan_string(Str1, {1,1}), OK1 = 16#D800-1, OK2 = 16#DFFF+1, @@ -1038,19 +1050,19 @@ otp_10302(Config) when is_list(Config) -> IllegalL = [Illegal1,Illegal2,Illegal3,Illegal4], [{ok,[{comment,1,[$%,$%,$\s,OK]}],1} = - erl_scan:string("%% "++[OK], 1, [return]) || + erl_scan_string("%% "++[OK], 1, [return]) || OK <- OKL], {ok,[{comment,_,[$%,$%,$\s,OK1]}],{1,5}} = - erl_scan:string("%% "++[OK1], {1,1}, [return]), + erl_scan_string("%% "++[OK1], {1,1}, [return]), [{error,{1,erl_scan,{illegal,character}},1} = erl_scan:string("%% "++[Illegal], 1, [return]) || Illegal <- IllegalL], {error,{{1,1},erl_scan,{illegal,character}},{1,5}} = erl_scan:string("%% "++[Illegal1], {1,1}, [return]), - [{ok,[],1} = erl_scan:string("%% "++[OK], 1, []) || + [{ok,[],1} = erl_scan_string("%% "++[OK], 1, []) || OK <- OKL], - {ok,[],{1,5}} = erl_scan:string("%% "++[OK1], {1,1}, []), + {ok,[],{1,5}} = erl_scan_string("%% "++[OK1], {1,1}, []), [{error,{1,erl_scan,{illegal,character}},1} = erl_scan:string("%% "++[Illegal], 1, []) || Illegal <- IllegalL], @@ -1058,7 +1070,7 @@ otp_10302(Config) when is_list(Config) -> erl_scan:string("%% "++[Illegal1], {1,1}, []), [{ok,[{string,{1,1},[OK]}],{1,4}} = - erl_scan:string("\""++[OK]++"\"",{1,1}) || + erl_scan_string("\""++[OK]++"\"",{1,1}) || OK <- OKL], [{error,{{1,2},erl_scan,{illegal,character}},{1,3}} = erl_scan:string("\""++[OK]++"\"",{1,1}) || @@ -1069,93 +1081,93 @@ otp_10302(Config) when is_list(Config) -> Illegal <- IllegalL], {ok,[{char,{1,1},OK1}],{1,3}} = - erl_scan:string([$$,OK1],{1,1}), + erl_scan_string([$$,OK1],{1,1}), {error,{{1,1},erl_scan,{illegal,character}},{1,2}} = erl_scan:string([$$,Illegal1],{1,1}), {ok,[{char,{1,1},OK1}],{1,4}} = - erl_scan:string([$$,$\\,OK1],{1,1}), + erl_scan_string([$$,$\\,OK1],{1,1}), {error,{{1,1},erl_scan,{illegal,character}},{1,4}} = erl_scan:string([$$,$\\,Illegal1],{1,1}), {ok,[{string,{1,1},[55295]}],{1,5}} = - erl_scan:string("\"\\"++[OK1]++"\"",{1,1}), + erl_scan_string("\"\\"++[OK1]++"\"",{1,1}), {error,{{1,2},erl_scan,{illegal,character}},{1,4}} = erl_scan:string("\"\\"++[Illegal1]++"\"",{1,1}), {ok,[{char,{1,1},OK1}],{1,10}} = - erl_scan:string("$\\x{D7FF}",{1,1}), + erl_scan_string("$\\x{D7FF}",{1,1}), {error,{{1,1},erl_scan,{illegal,character}},{1,10}} = erl_scan:string("$\\x{D800}",{1,1}), %% Not erl_scan, but erl_parse. - {integer,0,1} = erl_parse:abstract(1), - Float = 3.14, {float,0,Float} = erl_parse:abstract(Float), - {nil,0} = erl_parse:abstract([]), + {integer,0,1} = erl_parse_abstract(1), + Float = 3.14, {float,0,Float} = erl_parse_abstract(Float), + {nil,0} = erl_parse_abstract([]), {bin,0, [{bin_element,0,{integer,0,1},default,default}, {bin_element,0,{integer,0,2},default,default}]} = - erl_parse:abstract(<<1,2>>), + erl_parse_abstract(<<1,2>>), {cons,0,{tuple,0,[{atom,0,a}]},{atom,0,b}} = - erl_parse:abstract([{a} | b]), - {string,0,"str"} = erl_parse:abstract("str"), + erl_parse_abstract([{a} | b]), + {string,0,"str"} = erl_parse_abstract("str"), {cons,0, {integer,0,$a}, {cons,0,{integer,0,55296},{string,0,"c"}}} = - erl_parse:abstract("a"++[55296]++"c"), + erl_parse_abstract("a"++[55296]++"c"), Line = 17, - {integer,Line,1} = erl_parse:abstract(1, Line), - Float = 3.14, {float,Line,Float} = erl_parse:abstract(Float, Line), - {nil,Line} = erl_parse:abstract([], Line), + {integer,Line,1} = erl_parse_abstract(1, Line), + Float = 3.14, {float,Line,Float} = erl_parse_abstract(Float, Line), + {nil,Line} = erl_parse_abstract([], Line), {bin,Line, [{bin_element,Line,{integer,Line,1},default,default}, {bin_element,Line,{integer,Line,2},default,default}]} = - erl_parse:abstract(<<1,2>>, Line), + erl_parse_abstract(<<1,2>>, Line), {cons,Line,{tuple,Line,[{atom,Line,a}]},{atom,Line,b}} = - erl_parse:abstract([{a} | b], Line), - {string,Line,"str"} = erl_parse:abstract("str", Line), + erl_parse_abstract([{a} | b], Line), + {string,Line,"str"} = erl_parse_abstract("str", Line), {cons,Line, {integer,Line,$a}, {cons,Line,{integer,Line,55296},{string,Line,"c"}}} = - erl_parse:abstract("a"++[55296]++"c", Line), + erl_parse_abstract("a"++[55296]++"c", Line), Opts1 = [{line,17}], - {integer,Line,1} = erl_parse:abstract(1, Opts1), - Float = 3.14, {float,Line,Float} = erl_parse:abstract(Float, Opts1), - {nil,Line} = erl_parse:abstract([], Opts1), + {integer,Line,1} = erl_parse_abstract(1, Opts1), + Float = 3.14, {float,Line,Float} = erl_parse_abstract(Float, Opts1), + {nil,Line} = erl_parse_abstract([], Opts1), {bin,Line, [{bin_element,Line,{integer,Line,1},default,default}, {bin_element,Line,{integer,Line,2},default,default}]} = - erl_parse:abstract(<<1,2>>, Opts1), + erl_parse_abstract(<<1,2>>, Opts1), {cons,Line,{tuple,Line,[{atom,Line,a}]},{atom,Line,b}} = - erl_parse:abstract([{a} | b], Opts1), - {string,Line,"str"} = erl_parse:abstract("str", Opts1), + erl_parse_abstract([{a} | b], Opts1), + {string,Line,"str"} = erl_parse_abstract("str", Opts1), {cons,Line, {integer,Line,$a}, {cons,Line,{integer,Line,55296},{string,Line,"c"}}} = - erl_parse:abstract("a"++[55296]++"c", Opts1), + erl_parse_abstract("a"++[55296]++"c", Opts1), [begin - {integer,Line,1} = erl_parse:abstract(1, Opts2), - Float = 3.14, {float,Line,Float} = erl_parse:abstract(Float, Opts2), - {nil,Line} = erl_parse:abstract([], Opts2), + {integer,Line,1} = erl_parse_abstract(1, Opts2), + Float = 3.14, {float,Line,Float} = erl_parse_abstract(Float, Opts2), + {nil,Line} = erl_parse_abstract([], Opts2), {bin,Line, [{bin_element,Line,{integer,Line,1},default,default}, {bin_element,Line,{integer,Line,2},default,default}]} = - erl_parse:abstract(<<1,2>>, Opts2), + erl_parse_abstract(<<1,2>>, Opts2), {cons,Line,{tuple,Line,[{atom,Line,a}]},{atom,Line,b}} = - erl_parse:abstract([{a} | b], Opts2), - {string,Line,"str"} = erl_parse:abstract("str", Opts2), + erl_parse_abstract([{a} | b], Opts2), + {string,Line,"str"} = erl_parse_abstract("str", Opts2), {string,Line,[97,1024,99]} = - erl_parse:abstract("a"++[1024]++"c", Opts2) + erl_parse_abstract("a"++[1024]++"c", Opts2) end || Opts2 <- [[{encoding,unicode},{line,Line}], [{encoding,utf8},{line,Line}]]], {cons,0, {integer,0,97}, {cons,0,{integer,0,1024},{string,0,"c"}}} = - erl_parse:abstract("a"++[1024]++"c", [{encoding,latin1}]), + erl_parse_abstract("a"++[1024]++"c", [{encoding,latin1}]), ok. otp_10990(doc) -> @@ -1172,13 +1184,13 @@ otp_10992(suite) -> []; otp_10992(Config) when is_list(Config) -> {cons,0,{float,0,42.0},{nil,0}} = - erl_parse:abstract([42.0], [{encoding,unicode}]), + erl_parse_abstract([42.0], [{encoding,unicode}]), {cons,0,{float,0,42.0},{nil,0}} = - erl_parse:abstract([42.0], [{encoding,utf8}]), + erl_parse_abstract([42.0], [{encoding,utf8}]), {cons,0,{integer,0,65},{cons,0,{float,0,42.0},{nil,0}}} = - erl_parse:abstract([$A,42.0], [{encoding,unicode}]), + erl_parse_abstract([$A,42.0], [{encoding,unicode}]), {cons,0,{integer,0,65},{cons,0,{float,0,42.0},{nil,0}}} = - erl_parse:abstract([$A,42.0], [{encoding,utf8}]), + erl_parse_abstract([$A,42.0], [{encoding,utf8}]), ok. otp_11807(doc) -> @@ -1187,29 +1199,72 @@ otp_11807(suite) -> []; otp_11807(Config) when is_list(Config) -> {cons,0,{integer,0,97},{cons,0,{integer,0,98},{nil,0}}} = - erl_parse:abstract("ab", [{encoding,none}]), + erl_parse_abstract("ab", [{encoding,none}]), {cons,0,{integer,0,-1},{nil,0}} = - erl_parse:abstract([-1], [{encoding,latin1}]), + erl_parse_abstract([-1], [{encoding,latin1}]), ASCII = fun(I) -> I >= 0 andalso I < 128 end, - {string,0,"xyz"} = erl_parse:abstract("xyz", [{encoding,ASCII}]), + {string,0,"xyz"} = erl_parse_abstract("xyz", [{encoding,ASCII}]), {cons,0,{integer,0,228},{nil,0}} = - erl_parse:abstract([228], [{encoding,ASCII}]), + erl_parse_abstract([228], [{encoding,ASCII}]), {cons,0,{integer,0,97},{atom,0,a}} = - erl_parse:abstract("a"++a, [{encoding,latin1}]), + erl_parse_abstract("a"++a, [{encoding,latin1}]), {'EXIT', {{badarg,bad},_}} = % minor backward incompatibility (catch erl_parse:abstract("string", [{encoding,bad}])), ok. test_string(String, ExpectedWithCol) -> - {ok, ExpectedWithCol, _EndWithCol} = erl_scan:string(String, {1, 1}, []), + {ok, ExpectedWithCol, _EndWithCol} = erl_scan_string(String, {1, 1}, []), Expected = [ begin {L,_C} = element(2, T), setelement(2, T, L) end || T <- ExpectedWithCol ], - {ok, Expected, _End} = erl_scan:string(String), + {ok, Expected, _End} = erl_scan_string(String), test(String). +erl_scan_string(String) -> + erl_scan_string(String, 1, []). + +erl_scan_string(String, StartLocation) -> + erl_scan_string(String, StartLocation, []). + +erl_scan_string(String, StartLocation, Options) -> + case erl_scan:string(String, StartLocation, Options) of + {ok, Tokens, EndLocation} -> + {ok, unopaque_tokens(Tokens), EndLocation}; + Else -> + Else + end. + +erl_scan_tokens(C, S, L) -> + erl_scan_tokens(C, S, L, []). + +erl_scan_tokens(C, S, L, O) -> + case erl_scan:tokens(C, S, L, O) of + {done, {ok, Ts, End}, R} -> + {done, {ok, unopaque_tokens(Ts), End}, R}; + Else -> + Else + end. + +unopaque_tokens([]) -> + []; +unopaque_tokens([Token|Tokens]) -> + Attrs = element(2, Token), + Term = erl_anno:to_term(Attrs), + T = setelement(2, Token, Term), + [T | unopaque_tokens(Tokens)]. + +erl_parse_abstract(Term) -> + erl_parse_abstract(Term, []). + +erl_parse_abstract(Term, Options) -> + Abstr = erl_parse:abstract(Term, Options), + unopaque_abstract(Abstr). + +unopaque_abstract(Abstr) -> + erl_parse:anno_to_term(Abstr). + %% test_string(String, Expected, StartLocation, Options) -> %% {ok, Expected, _End} = erl_scan:string(String, StartLocation, Options), %% test(String). @@ -1359,7 +1414,7 @@ select_tokens(Tokens, Tags) -> simplify([Token|Tokens]) -> {line,Line} = erl_scan:token_info(Token, line), - [setelement(2, Token, Line) | simplify(Tokens)]; + [setelement(2, Token, erl_anno:new(Line)) | simplify(Tokens)]; simplify([]) -> []. diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 2674f6886f..5774d774b5 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -47,6 +47,7 @@ -export([ordered/1, ordered_match/1, interface_equality/1, fixtable_next/1, fixtable_insert/1, rename/1, rename_unnamed/1, evil_rename/1, update_element/1, update_counter/1, evil_update_counter/1, partly_bound/1, match_heavy/1]). +-export([update_counter_with_default/1]). -export([member/1]). -export([memory/1]). -export([select_fail/1]). @@ -99,7 +100,7 @@ misc1_do/1, safe_fixtable_do/1, info_do/1, dups_do/1, heavy_lookup_do/1, heavy_lookup_element_do/1, member_do/1, otp_5340_do/1, otp_7665_do/1, meta_wb_do/1, do_heavy_concurrent/1, tab2file2_do/2, exit_large_table_owner_do/2, - types_do/1, sleeper/0, memory_do/1, + types_do/1, sleeper/0, memory_do/1, update_counter_with_default_do/1, ms_tracee_dummy/1, ms_tracee_dummy/2, ms_tracee_dummy/3, ms_tracee_dummy/4 ]). @@ -136,7 +137,8 @@ all() -> {group, heavy}, ordered, ordered_match, interface_equality, fixtable_next, fixtable_insert, rename, rename_unnamed, evil_rename, update_element, - update_counter, evil_update_counter, partly_bound, + update_counter, evil_update_counter, + update_counter_with_default, partly_bound, match_heavy, {group, fold}, member, t_delete_object, t_init_table, t_whitebox, t_delete_all_objects, t_insert_list, t_test_ms, t_select_delete, t_ets_dets, @@ -1383,7 +1385,7 @@ random_test() -> {ok,[X]} -> X; _ -> - {A,B,C} = erlang:now(), + {A,B,C} = erlang:timestamp(), random:seed(A,B,C), get(random_seed) end, @@ -1761,6 +1763,14 @@ update_counter_do(Opts) -> OrdSet = ets_new(ordered_set,[ordered_set | Opts]), update_counter_for(Set), update_counter_for(OrdSet), + ets:delete_all_objects(Set), + ets:delete_all_objects(OrdSet), + ets:safe_fixtable(Set, true), + ets:safe_fixtable(OrdSet, true), + update_counter_for(Set), + update_counter_for(OrdSet), + ets:safe_fixtable(Set, false), + ets:safe_fixtable(OrdSet, false), ets:delete(Set), ets:delete(OrdSet), update_counter_neg(Opts). @@ -1780,10 +1790,14 @@ update_counter_for(T) -> ?line {NewObj, Ret} = uc_mimic(Obj,Arg3), ArgHash = erlang:phash2({T,a,Arg3}), %%io:format("update_counter(~p, ~p, ~p) expecting ~p\n",[T,a,Arg3,Ret]), + [DefaultObj] = ets:lookup(T, a), ?line Ret = ets:update_counter(T,a,Arg3), + Ret = ets:update_counter(T, b, Arg3, DefaultObj), % Use other key ?line ArgHash = erlang:phash2({T,a,Arg3}), %%io:format("NewObj=~p~n ",[NewObj]), ?line [NewObj] = ets:lookup(T,a), + true = ets:lookup(T, b) =:= [setelement(1, NewObj, b)], + ets:delete(T, b), Myself(NewObj,Times-1,Arg3,Myself) end, @@ -2008,6 +2022,44 @@ evil_counter_1(Iter, T) -> ets:update_counter(T, dracula, 1), evil_counter_1(Iter-1, T). +update_counter_with_default(Config) when is_list(Config) -> + repeat_for_opts(update_counter_with_default_do). + +update_counter_with_default_do(Opts) -> + T1 = ets_new(a, [set | Opts]), + %% Insert default object. + 3 = ets:update_counter(T1, foo, 2, {beaufort,1}), + %% Increment. + 5 = ets:update_counter(T1, foo, 2, {cabecou,1}), + %% Increment with list. + [9] = ets:update_counter(T1, foo, [{2,4}], {camembert,1}), + %% Same with non-immediate key. + 3 = ets:update_counter(T1, {foo,bar}, 2, {{chaource,chevrotin},1}), + 5 = ets:update_counter(T1, {foo,bar}, 2, {{cantal,comté},1}), + [9] = ets:update_counter(T1, {foo,bar}, [{2,4}], {{emmental,de,savoie},1}), + %% Same with ordered set. + T2 = ets_new(b, [ordered_set | Opts]), + 3 = ets:update_counter(T2, foo, 2, {maroilles,1}), + 5 = ets:update_counter(T2, foo, 2, {mimolette,1}), + [9] = ets:update_counter(T2, foo, [{2,4}], {morbier,1}), + 3 = ets:update_counter(T2, {foo,bar}, 2, {{laguiole},1}), + 5 = ets:update_counter(T2, {foo,bar}, 2, {{saint,nectaire},1}), + [9] = ets:update_counter(T2, {foo,bar}, [{2,4}], {{rocamadour},1}), + %% Arithmetically-equal keys. + 3 = ets:update_counter(T2, 1.0, 2, {1,1}), + 5 = ets:update_counter(T2, 1, 2, {1,1}), + 7 = ets:update_counter(T2, 1, 2, {1.0,1}), + %% Same with reversed type difference. + 3 = ets:update_counter(T2, 2, 2, {2.0,1}), + 5 = ets:update_counter(T2, 2.0, 2, {2.0,1}), + 7 = ets:update_counter(T2, 2.0, 2, {2,1}), + %% bar is not an integer. + {'EXIT',{badarg,_}} = (catch ets:update_counter(T1, qux, 3, {saint,félicien})), + %% No third element in default value. + {'EXIT',{badarg,_}} = (catch ets:update_counter(T1, qux, [{3,1}], {roquefort,1})), + + ok. + fixtable_next(doc) -> ["Check that a first-next sequence always works on a fixed table"]; fixtable_next(suite) -> @@ -3489,12 +3541,9 @@ verify_rescheduling_exit(Config, ForEachData, Flags, Fix, NOTabs, NOProcs) -> fun () -> repeat( fun () -> - {A, B, C} = now(), - ?line Name = list_to_atom( - TestCase - ++ "-" ++ integer_to_list(A) - ++ "-" ++ integer_to_list(B) - ++ "-" ++ integer_to_list(C)), + Uniq = erlang:unique_integer([positive]), + Name = list_to_atom(TestCase ++ "-" ++ + integer_to_list(Uniq)), Tab = ets_new(Name, Flags), ForEachData(fun(Data) -> ets:insert(Tab, Data) end), case Fix of @@ -3779,6 +3828,7 @@ match_object_do(Opts) -> ?line ets:insert(Tab,{{one,5},5}), ?line ets:insert(Tab,{{two,4},4}), ?line ets:insert(Tab,{{two,5},6}), + ?line ets:insert(Tab, {#{camembert=>cabécou},7}), ?line case ets:match_object(Tab, {{one, '_'}, '$0'}) of [{{one,5},5},{{one,4},4}] -> ok; [{{one,4},4},{{one,5},5}] -> ok; @@ -3799,6 +3849,10 @@ match_object_do(Opts) -> [{{two,4},4},{{two,5},6}] -> ok; _ -> ?t:fail("ets:match_object() returned something funny.") end, + % Check that maps are inspected for variables. + [{#{camembert:=cabécou},7}] = + ets:match_object(Tab, {#{camembert=>'_'},7}), + {'EXIT',{badarg,_}} = (catch ets:match_object(Tab, {#{'$1'=>'_'},7})), % Check that unsucessful match returns an empty list. ?line [] = ets:match_object(Tab, {{three,'$0'}, '$92'}), % Check that '$0' equals '_'. @@ -4495,16 +4549,16 @@ build_table2(L1,L2,Num) -> T. time_match_object(Tab,Match, Res) -> - T1 = erlang:now(), + T1 = erlang:monotonic_time(micro_seconds), Res = ets:match_object(Tab,Match), - T2 = erlang:now(), - nowdiff(T1,T2). + T2 = erlang:monotonic_time(micro_seconds), + T2 - T1. time_match(Tab,Match) -> - T1 = erlang:now(), + T1 = erlang:monotonic_time(micro_seconds), ets:match(Tab,Match), - T2 = erlang:now(), - nowdiff(T1,T2). + T2 = erlang:monotonic_time(micro_seconds), + T2 - T1. seventyfive_percent_success(_,S,Fa,0) -> true = (S > ((S + Fa) * 0.75)); @@ -4529,11 +4583,6 @@ fifty_percent_success({M,F,A},S,Fa,N) -> end. -nowtonumber({Mega, Secs, Milli}) -> - Milli + Secs * 1000000 + Mega * 1000000000000. -nowdiff(T1,T2) -> - nowtonumber(T2) - nowtonumber(T1). - create_random_string(0) -> []; @@ -5002,36 +5051,40 @@ colliding_names(Name) -> grow_shrink(Config) when is_list(Config) -> ?line EtsMem = etsmem(), - ?line grow_shrink_0(lists:seq(3071, 5000), EtsMem), - ?line verify_etsmem(EtsMem). -grow_shrink_0([N|Ns], EtsMem) -> - ?line grow_shrink_1(N, [set]), - ?line grow_shrink_1(N, [ordered_set]), - %% Verifying ets-memory here takes too long time, since - %% lock-free allocators were introduced... - %% ?line verify_etsmem(EtsMem), - grow_shrink_0(Ns, EtsMem); -grow_shrink_0([], _) -> ok. - -grow_shrink_1(N, Flags) -> - ?line T = ets_new(a, Flags), - ?line grow_shrink_2(N, N, T), - ?line ets:delete(T). + Set = ets_new(a, [set]), + grow_shrink_0(0, 3071, 3000, 5000, Set), + ets:delete(Set), + + %OrdSet = ets_new(a, [ordered_set]), + %grow_shrink_0(0, lists:seq(3071, 5000), OrdSet), + %ets:delete(OrdSet), + + ?line verify_etsmem(EtsMem). -grow_shrink_2(0, Orig, T) -> - List = [{I,a} || I <- lists:seq(1, Orig)], - List = lists:sort(ets:tab2list(T)), - grow_shrink_3(Orig, T); -grow_shrink_2(N, Orig, T) -> +grow_shrink_0(N, _, _, Max, _) when N >= Max -> + ok; +grow_shrink_0(N0, GrowN, ShrinkN, Max, T) -> + N1 = grow_shrink_1(N0, GrowN, ShrinkN, T), + grow_shrink_0(N1, GrowN, ShrinkN, Max, T). + +grow_shrink_1(N0, GrowN, ShrinkN, T) -> + N1 = grow_shrink_2(N0+1, N0 + GrowN, T), + grow_shrink_3(N1, N1 - ShrinkN, T). + +grow_shrink_2(N, GrowTo, _) when N > GrowTo -> + %io:format("Grown to ~p\n", [GrowTo]), + GrowTo; +grow_shrink_2(N, GrowTo, T) -> true = ets:insert(T, {N,a}), - grow_shrink_2(N-1, Orig, T). + grow_shrink_2(N+1, GrowTo, T). -grow_shrink_3(0, T) -> - [] = ets:tab2list(T); -grow_shrink_3(N, T) -> +grow_shrink_3(N, ShrinkTo, _) when N =< ShrinkTo -> + %io:format("Shrunk to ~p\n", [ShrinkTo]), + ShrinkTo; +grow_shrink_3(N, ShrinkTo, T) -> true = ets:delete(T, N), - grow_shrink_3(N-1, T). + grow_shrink_3(N-1, ShrinkTo, T). grow_pseudo_deleted(doc) -> ["Grow a table that still contains pseudo-deleted objects"]; grow_pseudo_deleted(suite) -> []; @@ -5057,17 +5110,29 @@ grow_pseudo_deleted_do(Type) -> ?line Left = ets:info(T,size), ?line Mult = get_kept_objects(T), filltabstr(T,Mult), - my_spawn_opt(fun()-> ?line true = ets:info(T,fixed), - Self ! start, - io:format("Starting to filltabstr... ~p\n",[now()]), - filltabstr(T,Mult,Mult+10000), - io:format("Done with filltabstr. ~p\n",[now()]), - Self ! done - end, [link, {scheduler,2}]), + my_spawn_opt( + fun() -> + true = ets:info(T,fixed), + Self ! start, + io:put_chars("Starting to filltabstr...\n"), + do_tc(fun() -> + filltabstr(T, Mult, Mult+10000) + end, + fun(Elapsed) -> + io:format("Done with filltabstr in ~p ms\n", + [Elapsed]) + end), + Self ! done + end, [link, {scheduler,2}]), ?line start = receive_any(), - io:format("Unfixing table...~p nitems=~p\n",[now(),ets:info(T,size)]), - ?line true = ets:safe_fixtable(T,false), - io:format("Unfix table done. ~p nitems=~p\n",[now(),ets:info(T,size)]), + io:format("Unfixing table... nitems=~p\n", [ets:info(T, size)]), + do_tc(fun() -> + true = ets:safe_fixtable(T, false) + end, + fun(Elapsed) -> + io:format("Unfix table done in ~p ms. nitems=~p\n", + [Elapsed,ets:info(T, size)]) + end), ?line false = ets:info(T,fixed), ?line 0 = get_kept_objects(T), ?line done = receive_any(), @@ -5097,17 +5162,28 @@ shrink_pseudo_deleted_do(Type) -> [true]}]), ?line Half = ets:info(T,size), ?line Half = get_kept_objects(T), - my_spawn_opt(fun()-> ?line true = ets:info(T,fixed), - Self ! start, - io:format("Starting to delete... ~p\n",[now()]), - del_one_by_one_set(T,1,Half+1), - io:format("Done with delete. ~p\n",[now()]), - Self ! done - end, [link, {scheduler,2}]), + my_spawn_opt( + fun()-> true = ets:info(T,fixed), + Self ! start, + io:put_chars("Starting to delete... ~p\n"), + do_tc(fun() -> + del_one_by_one_set(T, 1, Half+1) + end, + fun(Elapsed) -> + io:format("Done with delete in ~p ms.\n", + [Elapsed]) + end), + Self ! done + end, [link, {scheduler,2}]), ?line start = receive_any(), - io:format("Unfixing table...~p nitems=~p\n",[now(),ets:info(T,size)]), - ?line true = ets:safe_fixtable(T,false), - io:format("Unfix table done. ~p nitems=~p\n",[now(),ets:info(T,size)]), + io:format("Unfixing table... nitems=~p\n", [ets:info(T, size)]), + do_tc(fun() -> + true = ets:safe_fixtable(T, false) + end, + fun(Elapsed) -> + io:format("Unfix table done in ~p ms. nitems=~p\n", + [Elapsed,ets:info(T, size)]) + end), ?line false = ets:info(T,fixed), ?line 0 = get_kept_objects(T), ?line done = receive_any(), @@ -5260,30 +5336,42 @@ smp_unfix_fix_do() -> ?line Deleted = get_kept_objects(T), {Child, Mref} = - my_spawn_opt(fun()-> ?line true = ets:info(T,fixed), - Parent ! start, - io:format("Child waiting for table to be unfixed... now=~p mem=~p\n", - [now(),ets:info(T,memory)]), - repeat_while(fun()-> ets:info(T,fixed) end), - io:format("Table unfixed. Child Fixating! now=~p mem=~p\n", - [now(),ets:info(T,memory)]), - ?line true = ets:safe_fixtable(T,true), - repeat_while(fun(Key) when Key =< NumOfObjs -> - ets:delete(T,Key), {true,Key+1}; - (Key) -> {false,Key} - end, - Deleted), - ?line 0 = ets:info(T,size), - ?line true = get_kept_objects(T) >= Left, - ?line done = receive_any() - end, - [link, monitor, {scheduler,2}]), + my_spawn_opt( + fun()-> + true = ets:info(T,fixed), + Parent ! start, + io:format("Child waiting for table to be unfixed... mem=~p\n", + [ets:info(T, memory)]), + do_tc(fun() -> + repeat_while(fun()-> ets:info(T, fixed) end) + end, + fun(Elapsed) -> + io:format("Table unfixed in ~p ms." + " Child Fixating! mem=~p\n", + [Elapsed,ets:info(T,memory)]) + end), + true = ets:safe_fixtable(T,true), + repeat_while(fun(Key) when Key =< NumOfObjs -> + ets:delete(T,Key), {true,Key+1}; + (Key) -> {false,Key} + end, + Deleted), + 0 = ets:info(T,size), + true = get_kept_objects(T) >= Left, + done = receive_any() + end, + [link, monitor, {scheduler,2}]), ?line start = receive_any(), ?line true = ets:info(T,fixed), - io:format("Parent starting to unfix... ~p\n",[now()]), - ets:safe_fixtable(T,false), - io:format("Parent done with unfix. ~p\n",[now()]), + io:put_chars("Parent starting to unfix... ~p\n"), + do_tc(fun() -> + ets:safe_fixtable(T, false) + end, + fun(Elapsed) -> + io:format("Parent done with unfix in ~p ms.\n", + [Elapsed]) + end), Child ! done, {'DOWN', Mref, process, Child, normal} = receive_any(), ?line false = ets:info(T,fixed), @@ -6285,3 +6373,10 @@ repeat_for_opts_atom2list(compressed) -> [compressed,void]. ets_new(Name, Opts) -> %%ets:new(Name, [compressed | Opts]). ets:new(Name, Opts). + +do_tc(Do, Report) -> + T1 = erlang:monotonic_time(), + Do(), + T2 = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(T2 - T1, native, milli_seconds), + Report(Elapsed). diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index 6f1d1a891d..70e7ad9788 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -395,6 +395,8 @@ split(Config) when is_list(Config) -> ?line ["foo", "bar", "hello"]= filename:split("foo////bar//hello"), ?line ["foo", "bar", "hello"]= filename:split(["foo//",'//bar//h',"ello"]), ?line ["foo", "bar", "hello"]= filename:split(["foo//",'//bar//h'|ello]), + ["/"] = filename:split("/"), + [] = filename:split(""), case os:type() of {win32,_} -> ?line ["a:/","msdev","include"] = @@ -767,6 +769,8 @@ split_bin(Config) when is_list(Config) -> [<<"/">>,<<"usr">>,<<"local">>,<<"bin">>] = filename:split(<<"/usr/local/bin">>), [<<"foo">>,<<"bar">>]= filename:split(<<"foo/bar">>), [<<"foo">>, <<"bar">>, <<"hello">>]= filename:split(<<"foo////bar//hello">>), + [<<"/">>] = filename:split(<<"/">>), + [] = filename:split(<<"">>), case os:type() of {win32,_} -> [<<"a:/">>,<<"msdev">>,<<"include">>] = diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 576a5adfce..6c28eb00c3 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -131,90 +131,105 @@ start(Config) when is_list(Config) -> ok. -hibernate(suite) -> []; hibernate(Config) when is_list(Config) -> - ?line {ok,Pid} = gen_event:start({local, my_dummy_handler}), - ?line ok = gen_event:add_handler(my_dummy_handler, dummy_h, [self()]), - ?line [dummy_h] = gen_event:which_handlers(my_dummy_handler), - ?line true = gen_event:call(my_dummy_handler, dummy_h, hibernate), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line Pid ! wake, - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= - erlang:process_info(Pid,current_function)), - ?line later = gen_event:call(my_dummy_handler, dummy_h, hibernate_later), - ?line true = ({current_function,{erlang,hibernate,3}} =/= - erlang:process_info(Pid,current_function)), - ?line receive after 2000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line Pid ! wake, - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= - erlang:process_info(Pid,current_function)), - ?line gen_event:notify(my_dummy_handler,hibernate), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line gen_event:notify(my_dummy_handler,wakeup), - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= - erlang:process_info(Pid,current_function)), - ?line gen_event:notify(my_dummy_handler,hibernate), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line gen_event:sync_notify(my_dummy_handler,wakeup), - ?line true = ({current_function,{erlang,hibernate,3}} =/= - erlang:process_info(Pid,current_function)), - ?line ok = gen_event:sync_notify(my_dummy_handler,hibernate), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line Pid ! wake, - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= - erlang:process_info(Pid,current_function)), - ?line ok = gen_event:add_handler(my_dummy_handler, dummy1_h, [self()]), - ?line [_,_] = gen_event:which_handlers(my_dummy_handler), - ?line gen_event:notify(my_dummy_handler,hibernate), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line gen_event:notify(my_dummy_handler,wakeup), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line Pid ! wake, - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= - erlang:process_info(Pid,current_function)), - ?line Pid ! gnurf, - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line Pid ! sleep, - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line Pid ! wake, - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= - erlang:process_info(Pid,current_function)), - ?line ok = gen_event:stop(my_dummy_handler), - ?line {ok,Pid2} = gen_event:start({local, my_dummy_handler}), - ?line ok = gen_event:add_handler(my_dummy_handler, dummy_h, [self(),hibernate]), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid2,current_function), - ?line sys:suspend(my_dummy_handler), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid2,current_function), - ?line sys:resume(my_dummy_handler), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid2,current_function), - ?line Pid2 ! wake, - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= - erlang:process_info(Pid2,current_function)), + {ok,Pid} = gen_event:start({local, my_dummy_handler}), + ok = gen_event:add_handler(my_dummy_handler, dummy_h, [self()]), + [dummy_h] = gen_event:which_handlers(my_dummy_handler), + true = gen_event:call(my_dummy_handler, dummy_h, hibernate), + is_in_erlang_hibernate(Pid), + + Pid ! wake, + is_not_in_erlang_hibernate(Pid), + later = gen_event:call(my_dummy_handler, dummy_h, hibernate_later), + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + is_in_erlang_hibernate(Pid), + + Pid ! wake, + is_not_in_erlang_hibernate(Pid), + gen_event:notify(my_dummy_handler, hibernate), + is_in_erlang_hibernate(Pid), + gen_event:notify(my_dummy_handler, wakeup), + is_not_in_erlang_hibernate(Pid), + gen_event:notify(my_dummy_handler, hibernate), + is_in_erlang_hibernate(Pid), + gen_event:sync_notify(my_dummy_handler, wakeup), + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + ok = gen_event:sync_notify(my_dummy_handler, hibernate), + is_in_erlang_hibernate(Pid), + + Pid ! wake, + is_not_in_erlang_hibernate(Pid), + ok = gen_event:add_handler(my_dummy_handler, dummy1_h, [self()]), + [_,_] = gen_event:which_handlers(my_dummy_handler), + gen_event:notify(my_dummy_handler, hibernate), + is_in_erlang_hibernate(Pid), + gen_event:notify(my_dummy_handler, wakeup), + is_in_erlang_hibernate(Pid), + + Pid ! wake, + is_not_in_erlang_hibernate(Pid), + + Pid ! gnurf, + is_in_erlang_hibernate(Pid), + + Pid ! sleep, + is_in_erlang_hibernate(Pid), + + Pid ! wake, + is_not_in_erlang_hibernate(Pid), + ok = gen_event:stop(my_dummy_handler), + + {ok,Pid2} = gen_event:start({local, my_dummy_handler}), + ok = gen_event:add_handler(my_dummy_handler, dummy_h, + [self(),hibernate]), + is_in_erlang_hibernate(Pid2), + sys:suspend(my_dummy_handler), + is_in_erlang_hibernate(Pid2), + sys:resume(my_dummy_handler), + is_in_erlang_hibernate(Pid2), + + Pid2 ! wake, + is_not_in_erlang_hibernate(Pid2), - - ?line ok = gen_event:stop(my_dummy_handler), + ok = gen_event:stop(my_dummy_handler), ok. +is_in_erlang_hibernate(Pid) -> + receive after 1 -> ok end, + is_in_erlang_hibernate_1(200, Pid). + +is_in_erlang_hibernate_1(0, Pid) -> + io:format("~p\n", [erlang:process_info(Pid, current_function)]), + ?t:fail(not_in_erlang_hibernate_3); +is_in_erlang_hibernate_1(N, Pid) -> + {current_function,MFA} = erlang:process_info(Pid, current_function), + case MFA of + {erlang,hibernate,3} -> + ok; + _ -> + receive after 10 -> ok end, + is_in_erlang_hibernate_1(N-1, Pid) + end. + +is_not_in_erlang_hibernate(Pid) -> + receive after 1 -> ok end, + is_not_in_erlang_hibernate_1(200, Pid). + +is_not_in_erlang_hibernate_1(0, Pid) -> + io:format("~p\n", [erlang:process_info(Pid, current_function)]), + ?t:fail(not_in_erlang_hibernate_3); +is_not_in_erlang_hibernate_1(N, Pid) -> + {current_function,MFA} = erlang:process_info(Pid, current_function), + case MFA of + {erlang,hibernate,3} -> + receive after 10 -> ok end, + is_not_in_erlang_hibernate_1(N-1, Pid); + _ -> + ok + end. add_handler(doc) -> []; diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index dabc10aec4..f003630535 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -596,129 +596,123 @@ replace_state(Config) when is_list(Config) -> ok. %% Hibernation -hibernate(suite) -> []; hibernate(Config) when is_list(Config) -> OldFl = process_flag(trap_exit, true), - ?line {ok, Pid0} = gen_fsm:start_link(?MODULE, hiber_now, []), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid0,current_function), - ?line stop_it(Pid0), + {ok, Pid0} = gen_fsm:start_link(?MODULE, hiber_now, []), + is_in_erlang_hibernate(Pid0), + stop_it(Pid0), test_server:messages_get(), - - ?line {ok, Pid} = gen_fsm:start_link(?MODULE, hiber, []), - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line hibernating = gen_fsm:sync_send_event(Pid,hibernate_sync), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line good_morning = gen_fsm:sync_send_event(Pid,wakeup_sync), - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line hibernating = gen_fsm:sync_send_event(Pid,hibernate_sync), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line five_more = gen_fsm:sync_send_event(Pid,snooze_sync), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line good_morning = gen_fsm:sync_send_event(Pid,wakeup_sync), - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line ok = gen_fsm:send_event(Pid,hibernate_async), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line ok = gen_fsm:send_event(Pid,wakeup_async), - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line ok = gen_fsm:send_event(Pid,hibernate_async), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line ok = gen_fsm:send_event(Pid,snooze_async), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line ok = gen_fsm:send_event(Pid,wakeup_async), - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line Pid ! hibernate_later, - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line receive after 2000 -> ok end, - ?line ({current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function)), - ?line 'alive!' = gen_fsm:sync_send_event(Pid,'alive?'), - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line Pid ! hibernate_now, - ?line receive after 1000 -> ok end, - ?line ({current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function)), - ?line 'alive!' = gen_fsm:sync_send_event(Pid,'alive?'), - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - - - ?line hibernating = gen_fsm:sync_send_all_state_event(Pid,hibernate_sync), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line good_morning = gen_fsm:sync_send_all_state_event(Pid,wakeup_sync), - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line hibernating = gen_fsm:sync_send_all_state_event(Pid,hibernate_sync), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line five_more = gen_fsm:sync_send_all_state_event(Pid,snooze_sync), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line good_morning = gen_fsm:sync_send_all_state_event(Pid,wakeup_sync), - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line ok = gen_fsm:send_all_state_event(Pid,hibernate_async), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line ok = gen_fsm:send_all_state_event(Pid,wakeup_async), - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line ok = gen_fsm:send_all_state_event(Pid,hibernate_async), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line ok = gen_fsm:send_all_state_event(Pid,snooze_async), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line ok = gen_fsm:send_all_state_event(Pid,wakeup_async), - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - - ?line hibernating = gen_fsm:sync_send_all_state_event(Pid,hibernate_sync), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line sys:suspend(Pid), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line sys:resume(Pid), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = - erlang:process_info(Pid,current_function), - ?line good_morning = gen_fsm:sync_send_all_state_event(Pid,wakeup_sync), - ?line receive after 1000 -> ok end, - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line stop_it(Pid), + {ok, Pid} = gen_fsm:start_link(?MODULE, hiber, []), + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid,current_function)), + hibernating = gen_fsm:sync_send_event(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + good_morning = gen_fsm:sync_send_event(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + hibernating = gen_fsm:sync_send_event(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + five_more = gen_fsm:sync_send_event(Pid, snooze_sync), + is_in_erlang_hibernate(Pid), + good_morning = gen_fsm:sync_send_event(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + ok = gen_fsm:send_event(Pid, hibernate_async), + is_in_erlang_hibernate(Pid), + ok = gen_fsm:send_event(Pid, wakeup_async), + is_not_in_erlang_hibernate(Pid), + ok = gen_fsm:send_event(Pid, hibernate_async), + is_in_erlang_hibernate(Pid), + ok = gen_fsm:send_event(Pid, snooze_async), + is_in_erlang_hibernate(Pid), + ok = gen_fsm:send_event(Pid, wakeup_async), + is_not_in_erlang_hibernate(Pid), + + Pid ! hibernate_later, + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + is_in_erlang_hibernate(Pid), + + 'alive!' = gen_fsm:sync_send_event(Pid,'alive?'), + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + Pid ! hibernate_now, + is_in_erlang_hibernate(Pid), + + 'alive!' = gen_fsm:sync_send_event(Pid,'alive?'), + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + + hibernating = gen_fsm:sync_send_all_state_event(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + good_morning = gen_fsm:sync_send_all_state_event(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + hibernating = gen_fsm:sync_send_all_state_event(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + five_more = gen_fsm:sync_send_all_state_event(Pid, snooze_sync), + is_in_erlang_hibernate(Pid), + good_morning = gen_fsm:sync_send_all_state_event(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + ok = gen_fsm:send_all_state_event(Pid, hibernate_async), + is_in_erlang_hibernate(Pid), + ok = gen_fsm:send_all_state_event(Pid, wakeup_async), + is_not_in_erlang_hibernate(Pid), + ok = gen_fsm:send_all_state_event(Pid, hibernate_async), + is_in_erlang_hibernate(Pid), + ok = gen_fsm:send_all_state_event(Pid, snooze_async), + is_in_erlang_hibernate(Pid), + ok = gen_fsm:send_all_state_event(Pid, wakeup_async), + is_not_in_erlang_hibernate(Pid), + + hibernating = gen_fsm:sync_send_all_state_event(Pid, hibernate_sync), + is_in_erlang_hibernate(Pid), + sys:suspend(Pid), + is_in_erlang_hibernate(Pid), + sys:resume(Pid), + is_in_erlang_hibernate(Pid), + receive after 1000 -> ok end, + is_in_erlang_hibernate(Pid), + + good_morning = gen_fsm:sync_send_all_state_event(Pid, wakeup_sync), + is_not_in_erlang_hibernate(Pid), + stop_it(Pid), test_server:messages_get(), process_flag(trap_exit, OldFl), ok. +is_in_erlang_hibernate(Pid) -> + receive after 1 -> ok end, + is_in_erlang_hibernate_1(200, Pid). + +is_in_erlang_hibernate_1(0, Pid) -> + io:format("~p\n", [erlang:process_info(Pid, current_function)]), + ?t:fail(not_in_erlang_hibernate_3); +is_in_erlang_hibernate_1(N, Pid) -> + {current_function,MFA} = erlang:process_info(Pid, current_function), + case MFA of + {erlang,hibernate,3} -> + ok; + _ -> + receive after 10 -> ok end, + is_in_erlang_hibernate_1(N-1, Pid) + end. +is_not_in_erlang_hibernate(Pid) -> + receive after 1 -> ok end, + is_not_in_erlang_hibernate_1(200, Pid). + +is_not_in_erlang_hibernate_1(0, Pid) -> + io:format("~p\n", [erlang:process_info(Pid, current_function)]), + ?t:fail(not_in_erlang_hibernate_3); +is_not_in_erlang_hibernate_1(N, Pid) -> + {current_function,MFA} = erlang:process_info(Pid, current_function), + case MFA of + {erlang,hibernate,3} -> + receive after 10 -> ok end, + is_not_in_erlang_hibernate_1(N-1, Pid); + _ -> + ok + end. %%sys1(suite) -> []; %%sys1(_) -> diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 30dabf63c5..66341f495f 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -641,15 +641,13 @@ info(Config) when is_list(Config) -> end, ok. -hibernate(suite) -> []; hibernate(Config) when is_list(Config) -> OldFl = process_flag(trap_exit, true), - ?line {ok, Pid0} = + {ok, Pid0} = gen_server:start_link({local, my_test_name_hibernate0}, - gen_server_SUITE, hibernate, []), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid0,current_function), - ?line ok = gen_server:call(my_test_name_hibernate0, stop), + gen_server_SUITE, hibernate, []), + is_in_erlang_hibernate(Pid0), + ok = gen_server:call(my_test_name_hibernate0, stop), receive {'EXIT', Pid0, stopped} -> ok @@ -657,70 +655,66 @@ hibernate(Config) when is_list(Config) -> test_server:fail(gen_server_did_not_die) end, - ?line {ok, Pid} = + {ok, Pid} = gen_server:start_link({local, my_test_name_hibernate}, - gen_server_SUITE, [], []), + gen_server_SUITE, [], []), - ?line ok = gen_server:call(my_test_name_hibernate, started_p), - ?line true = gen_server:call(my_test_name_hibernate, hibernate), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line Parent = self(), + ok = gen_server:call(my_test_name_hibernate, started_p), + true = gen_server:call(my_test_name_hibernate, hibernate), + is_in_erlang_hibernate(Pid), + Parent = self(), Fun = fun() -> - receive - go -> - ok - end, - receive - after 1000 -> - ok - end, - X = erlang:process_info(Pid,current_function), + receive go -> ok end, + receive after 1000 -> ok end, + X = erlang:process_info(Pid, current_function), Pid ! continue, Parent ! {result,X} end, - ?line Pid2 = spawn_link(Fun), - ?line true = gen_server:call(my_test_name_hibernate, {hibernate_noreply,Pid2}), - - ?line gen_server:cast(my_test_name_hibernate, hibernate_later), - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line receive after 2000 -> ok end, - ?line ({current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function)), - ?line ok = gen_server:call(my_test_name_hibernate, started_p), - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line gen_server:cast(my_test_name_hibernate, hibernate_now), - ?line receive after 1000 -> ok end, - ?line ({current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function)), - ?line ok = gen_server:call(my_test_name_hibernate, started_p), - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line Pid ! hibernate_later, - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line receive after 2000 -> ok end, - ?line ({current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function)), - ?line ok = gen_server:call(my_test_name_hibernate, started_p), - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line Pid ! hibernate_now, - ?line receive after 1000 -> ok end, - ?line ({current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function)), - ?line ok = gen_server:call(my_test_name_hibernate, started_p), - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - ?line receive - {result,R} -> - ?line {current_function,{erlang,hibernate,3}} = R - end, - ?line true = gen_server:call(my_test_name_hibernate, hibernate), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line sys:suspend(my_test_name_hibernate), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line sys:resume(my_test_name_hibernate), - ?line receive after 1000 -> ok end, - ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function), - ?line ok = gen_server:call(my_test_name_hibernate, started_p), - ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), - - ?line ok = gen_server:call(my_test_name_hibernate, stop), + Pid2 = spawn_link(Fun), + true = gen_server:call(my_test_name_hibernate, {hibernate_noreply,Pid2}), + + gen_server:cast(my_test_name_hibernate, hibernate_later), + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + is_in_erlang_hibernate(Pid), + ok = gen_server:call(my_test_name_hibernate, started_p), + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + + gen_server:cast(my_test_name_hibernate, hibernate_now), + is_in_erlang_hibernate(Pid), + ok = gen_server:call(my_test_name_hibernate, started_p), + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + + Pid ! hibernate_later, + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + is_in_erlang_hibernate(Pid), + ok = gen_server:call(my_test_name_hibernate, started_p), + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + + Pid ! hibernate_now, + is_in_erlang_hibernate(Pid), + ok = gen_server:call(my_test_name_hibernate, started_p), + true = ({current_function,{erlang,hibernate,3}} =/= + erlang:process_info(Pid, current_function)), + receive + {result,R} -> + {current_function,{erlang,hibernate,3}} = R + end, + + true = gen_server:call(my_test_name_hibernate, hibernate), + is_in_erlang_hibernate(Pid), + sys:suspend(my_test_name_hibernate), + is_in_erlang_hibernate(Pid), + sys:resume(my_test_name_hibernate), + is_in_erlang_hibernate(Pid), + ok = gen_server:call(my_test_name_hibernate, started_p), + true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)), + + ok = gen_server:call(my_test_name_hibernate, stop), receive {'EXIT', Pid, stopped} -> ok @@ -730,6 +724,23 @@ hibernate(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +is_in_erlang_hibernate(Pid) -> + receive after 1 -> ok end, + is_in_erlang_hibernate_1(200, Pid). + +is_in_erlang_hibernate_1(0, Pid) -> + io:format("~p\n", [erlang:process_info(Pid, current_function)]), + ?t:fail(not_in_erlang_hibernate_3); +is_in_erlang_hibernate_1(N, Pid) -> + {current_function,MFA} = erlang:process_info(Pid, current_function), + case MFA of + {erlang,hibernate,3} -> + ok; + _ -> + receive after 10 -> ok end, + is_in_erlang_hibernate_1(N-1, Pid) + end. + %% -------------------------------------- %% Test gen_server:abcast and handle_cast. %% Test all different return values from diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl index c55836ff87..858a78b1d2 100644 --- a/lib/stdlib/test/io_proto_SUITE.erl +++ b/lib/stdlib/test/io_proto_SUITE.erl @@ -476,149 +476,182 @@ unicode_options(Config) when is_list(Config) -> ok. -unicode_options_gen(suite) -> - []; -unicode_options_gen(doc) -> - ["Tests various unicode options on random generated files"]; +%% Tests various unicode options on random generated files. unicode_options_gen(Config) when is_list(Config) -> - ?line random:seed(1240,900586,553728), - ?line PrivDir = ?config(priv_dir,Config), - ?line AllModes = [utf8,utf16,{utf16,big},{utf16,little},utf32,{utf32,big},{utf32,little}], - ?line FSize = 17*1024, - ?line NumItersRead = 2, - ?line NumItersWrite = 2, - ?line Dir = filename:join([PrivDir,"GENDATA1"]), - ?line file:make_dir(Dir), - - %dbg:tracer(process,{fun(A,_) -> erlang:display(A) end,true}), - %dbg:tpl(file_io_server,x), - %dbg:ctpl(file_io_server,cafu), - %dbg:tp(unicode,x), - - DoOneFile1 = fun(Encoding,N,M) -> - ?dbg({Encoding,M,N}), - io:format("Read test: Encoding ~p, Chunk size ~p, Iteration ~p~n",[Encoding,M,N]), - io:format(standard_error,"Read test: Encoding ~p, Chunk size ~p, Iteration ~p\r\n",[Encoding,M,N]), - ?line Fname = filename:join([Dir,"genfile_"++enc2str(Encoding)++"_"++integer_to_list(N)]), - ?dbg(?LINE), - ?line Ulist = random_unicode(FSize), - ?dbg(?LINE), - ?line my_write_file(Fname,Ulist,Encoding), - ?dbg(?LINE), - ?line {ok,F1} = file:open(Fname,[read,{encoding,Encoding}]), - - ?dbg(?LINE), - ?line Res1 = read_whole_file(fun(FD) -> io:get_line(FD,'') end,F1), - ?dbg(?LINE), - ?line Ulist = unicode:characters_to_list(Res1,unicode), - ?dbg(?LINE), - ?line file:close(F1), - ?line {ok,F2} = file:open(Fname, [read,binary,{encoding,Encoding}]), - ?line Res2 = read_whole_file(fun(FD) -> io:get_chars(FD,'',M) end,F2), - ?line Ulist = unicode:characters_to_list(Res2,unicode), - ?dbg(?LINE), - ?line file:close(F2), - ?line {ok,F3} = file:open(Fname, [read,binary,{encoding,Encoding}]), - ?dbg(?LINE), -%% case {Encoding,M,N} of -%% {{utf16,little},10,2} -> -%% dbg:p(F3,call); -%% _ -> -%% ok -%% end, - - ?line Res3 = read_whole_file(fun(FD) -> case io:fread(FD,'',"~ts") of {ok,D} -> D; O -> O end end, F3), - ?dbg(?LINE), - ?line Ulist2 = [ X || X <- Ulist, - X =/= $\n, X =/= $ ], - ?dbg(?LINE), - ?line Ulist2 = unicode:characters_to_list(Res3,unicode), - ?dbg(?LINE), - ?line file:close(F3), - ?line {ok,F4} = file:open(Fname, [read,{encoding,Encoding}]), - ?line Res4 = read_whole_file(fun(FD) -> case io:fread(FD,'',"~tc") of {ok,D} -> D; O -> O end end,F4), - ?line Ulist3 = [ X || X <- Ulist, - X =/= $\n ], - ?line Ulist3 = unicode:characters_to_list(Res4,unicode), - ?dbg(?LINE), - ?line file:close(F4), - ?line file:delete(Fname) - end, - - [ [ [ DoOneFile1(E,N,M) || E <- AllModes ] || M <- [10,1000,128,1024,8192,8193] ] || N <- lists:seq(1,NumItersRead)], - DoOneFile2 = fun(Encoding,N,M) -> - ?dbg({Encoding,M,N}), - io:format("Write test: Encoding ~p, Chunk size ~p, Iteration ~p~n",[Encoding,M,N]), - io:format(standard_error,"Write test: Encoding ~p, Chunk size ~p, Iteration ~p\r\n",[Encoding,M,N]), - ?line Fname = filename:join([Dir,"genfile_"++enc2str(Encoding)++"_"++integer_to_list(N)]), - ?dbg(?LINE), - ?line Ulist = random_unicode(FSize), - ?dbg(?LINE), - ?line {ok,F1} = file:open(Fname,[write,{encoding,Encoding}]), - ?line io:put_chars(F1,Ulist), - ?line file:close(F1), - ?line Ulist = my_read_file(Fname,Encoding), - ?line file:delete(Fname), - ?line {ok,F2} = file:open(Fname,[write,binary,{encoding,Encoding}]), - ?line io:put_chars(F2,Ulist), - ?line file:close(F2), - ?line Ulist = my_read_file(Fname,Encoding), - ?line file:delete(Fname), - ?line {ok,F3} = file:open(Fname,[write,{encoding,Encoding}]), - ?line LL = string:tokens(Ulist,"\n"), - ?line Ulist2 = lists:flatten(LL), - ?line [ io:format(F3,"~ts",[L]) || L <- LL ], - ?line file:close(F3), - ?line Ulist2 = my_read_file(Fname,Encoding), - ?line file:delete(Fname), - ?line {ok,F4} = file:open(Fname,[write,{encoding,Encoding}]), - ?line [ io:format(F4,"~tc",[C]) || C <- Ulist ], - ?line file:close(F4), - ?line Ulist = my_read_file(Fname,Encoding), - ?line file:delete(Fname), - ?line {ok,F5} = file:open(Fname,[write,{encoding,Encoding}]), - ?line io:put_chars(F5,unicode:characters_to_binary(Ulist)), - ?line file:close(F5), - ?line Ulist = my_read_file(Fname,Encoding), - ?line file:delete(Fname), - ok - end, - [ [ [ DoOneFile2(E,N,M) || E <- AllModes ] || M <- [10,1000,128,1024,8192,8193] ] || N <- lists:seq(1,NumItersWrite)], + random:seed(1240, 900586, 553728), + PrivDir = ?config(priv_dir, Config), + AllModes = [utf8,utf16,{utf16,big},{utf16,little}, + utf32,{utf32,big},{utf32,little}], + FSize = 17*1024, + NumItersRead = 2, + NumItersWrite = 2, + Dir = filename:join(PrivDir, "GENDATA1"), + file:make_dir(Dir), + + DoOneFile1 = + fun(Encoding, N, M) -> + ?dbg({Encoding,M,N}), + io:format("Read test: Encoding ~p, Chunk size ~p, Iteration ~p~n",[Encoding,M,N]), + io:format(standard_error, + "Read test: Encoding ~p, Chunk size ~p, Iteration ~p\r\n",[Encoding,M,N]), + Fname = filename:join(Dir, + "genfile_"++enc2str(Encoding)++ + "_"++integer_to_list(N)), + Ulist = random_unicode(FSize), + Bin = unicode:characters_to_binary(Ulist, utf8, Encoding), + ok = file:write_file(Fname, Bin), + + Read1 = fun(FD) -> io:get_line(FD, '') end, + Res1 = read_whole_file(Fname, + [read,read_ahead,{encoding,Encoding}], + Read1), + + Read2 = fun(FD) -> io:get_chars(FD, '', M) end, + Res2 = read_whole_file(Fname, + [read,binary, + read_ahead,{encoding,Encoding}], + Read2), + + Read3 = fun(FD) -> + case io:fread(FD, '', "~ts") of + {ok,D} -> D; + Other -> Other end + end, + Res3 = read_whole_file(Fname, + [read,binary, + read_ahead,{encoding,Encoding}], + Read3), + + Read4 = fun(FD) -> + case io:fread(FD, '', "~ts") of + {ok,D} -> D; + Other -> Other end + end, + Res4 = read_whole_file(Fname, + [read,read_ahead,{encoding,Encoding}], + Read4), + + Ulist2 = [X || X <- Ulist, X =/= $\n, X =/= $\s], + Ulist3 = [X || X <- Ulist, X =/= $\n], + Ulist = done(Res1), + Ulist = done(Res2), + Ulist2 = done(Res3), + Ulist3 = done(Res4), + + file:delete(Fname) + end, + [ [ [ DoOneFile1(E, N, M) || E <- AllModes ] || + M <- [10,1000,128,1024,8192,8193] ] || + N <- lists:seq(1, NumItersRead) ], + + DoOneFile2 = + fun(Encoding,N,M) -> + ?dbg({Encoding,M,N}), + io:format("Write test: Encoding ~p, Chunk size ~p, Iteration ~p~n",[Encoding,M,N]), + io:format(standard_error, + "Write test: Encoding ~p, Chunk size ~p, Iteration ~p\r\n",[Encoding,M,N]), + Fname = filename:join(Dir, + "genfile_"++enc2str(Encoding)++ + "_"++integer_to_list(N)), + Ulist = random_unicode(FSize), + + Res1 = write_read_file(Fname, 1, + [write], + Encoding, + fun(FD) -> io:put_chars(FD, Ulist) end), + + Res2 = write_read_file(Fname, 2, + [write,binary], + Encoding, + fun(FD) -> io:put_chars(FD, Ulist) end), + + Fun3 = fun(FD) -> + _ = [io:format(FD, "~tc", [C]) || C <- Ulist], + ok + end, + Res3 = write_read_file(Fname, 3, + [write], + Encoding, + Fun3), + + Fun4 = fun(FD) -> + io:put_chars(FD, + unicode:characters_to_binary(Ulist)) + end, + Res4 = write_read_file(Fname, 4, + [write], + Encoding, + Fun4), + + LL = string:tokens(Ulist, "\n"), + Fun5 = fun(FD) -> + _ = [io:format(FD, "~ts", [L]) || L <- LL], + ok + end, + Res5 = write_read_file(Fname, 5, + [write], + Encoding, + Fun5), + + Ulist2 = lists:flatten(LL), + ResBin = done(Res1), + ResBin = done(Res2), + ResBin = done(Res3), + ResBin = done(Res4), + Ulist = unicode:characters_to_list(ResBin, Encoding), + + ResBin2 = done(Res5), + Ulist2 = unicode:characters_to_list(ResBin2, Encoding), + + ok + end, + [ [ [ DoOneFile2(E, N, M) || E <- AllModes ] || + M <- [10,1000,128,1024,8192,8193] ] || + N <- lists:seq(1, NumItersWrite) ], ok. +read_whole_file(Fname, Options, Fun) -> + do(fun() -> + do_read_whole_file(Fname, Options, Fun) + end). +do_read_whole_file(Fname, Options, Fun) -> + {ok,F} = file:open(Fname, Options), + Res = do_read_whole_file_1(Fun, F), + ok = file:close(F), + unicode:characters_to_list(Res, unicode). - -read_whole_file(Fun,F) -> +do_read_whole_file_1(Fun, F) -> case Fun(F) of eof -> []; {error,Error} -> - ?dbg(Error), receive after 10000 -> ok end, exit(Error); Other -> - %?dbg(Other), - [Other | read_whole_file(Fun,F)] + [Other|do_read_whole_file_1(Fun, F)] end. - +write_read_file(Fname0, N, Options, Enc, Writer) -> + Fname = Fname0 ++ "_" ++ integer_to_list(N), + do(fun() -> + do_write_read_file(Fname, Options, Enc, Writer) + end). + +do_write_read_file(Fname, Options, Encoding, Writer) -> + {ok,F} = file:open(Fname, [{encoding,Encoding}|Options]), + Writer(F), + ok = file:close(F), + {ok,Bin} = file:read_file(Fname), + ok = file:delete(Fname), + Bin. + enc2str(Atom) when is_atom(Atom) -> atom_to_list(Atom); enc2str({A1,A2}) when is_atom(A1), is_atom(A2) -> atom_to_list(A1)++"_"++atom_to_list(A2). - - -my_write_file(Filename,UniList,Encoding) -> - Bin = unicode:characters_to_binary(UniList,utf8,Encoding), - file:write_file(Filename,Bin). - -my_read_file(Filename,Encoding) -> - {ok,Bin} = file:read_file(Filename), - unicode:characters_to_list(Bin,Encoding). - random_unicode(0) -> []; random_unicode(N) -> @@ -1733,8 +1766,7 @@ toerl_loop(Port,Acc) -> end. millistamp() -> - {Mega, Secs, Micros} = erlang:now(), - (Micros div 1000) + Secs * 1000 + Mega * 1000000000. + erlang:monotonic_time(milli_seconds). get_data_within(Port, X, Acc) when X =< 0 -> ?dbg({get_data_within, X, Acc, ?LINE}), @@ -1932,3 +1964,15 @@ chomp(<<Ch,Rest/binary>>) -> <<Ch,X/binary>>; chomp(Atom) -> Atom. + +do(Fun) -> + {_,Ref} = spawn_monitor(fun() -> + exit(Fun()) + end), + Ref. + +done(Ref) -> + receive + {'DOWN',Ref,process,_,Result} -> + Result + end. diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl index f4589a8e24..01c138d94c 100644 --- a/lib/stdlib/test/lists_SUITE.erl +++ b/lib/stdlib/test/lists_SUITE.erl @@ -1704,7 +1704,7 @@ fun_pid(Fun) -> get_seed() -> case random:seed() of undefined -> - now(); + erlang:timestamp(); Tuple -> Tuple end. diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl index dda20a615b..1d9c041a74 100644 --- a/lib/stdlib/test/maps_SUITE.erl +++ b/lib/stdlib/test/maps_SUITE.erl @@ -34,13 +34,20 @@ -export([init_per_testcase/2]). -export([end_per_testcase/2]). --export([t_get_3/1,t_with_2/1,t_without_2/1]). +-export([t_get_3/1, + t_fold_3/1,t_map_2/1,t_size_1/1, + t_with_2/1,t_without_2/1]). + +-define(badmap(V,F,Args), {'EXIT', {{badmap,V}, [{maps,F,Args,_}|_]}}). +-define(badarg(F,Args), {'EXIT', {badarg, [{maps,F,Args,_}|_]}}). suite() -> [{ct_hooks, [ts_install_cth]}]. all() -> - [t_get_3,t_with_2,t_without_2]. + [t_get_3, + t_fold_3,t_map_2,t_size_1, + t_with_2,t_without_2]. init_per_suite(Config) -> Config. @@ -63,6 +70,9 @@ t_get_3(Config) when is_list(Config) -> value1 = maps:get(key1, Map, DefaultValue), value2 = maps:get(key2, Map, DefaultValue), DefaultValue = maps:get(key3, Map, DefaultValue), + + %% error case + ?badmap(a,get,[[a,b],a,def]) = (catch maps:get([a,b],id(a),def)), ok. t_without_2(_Config) -> @@ -70,6 +80,11 @@ t_without_2(_Config) -> 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), + + %% error case + ?badmap(a,without,[[a,b],a]) = (catch maps:without([a,b],id(a))), + ?badmap(a,without,[{a,b},a]) = (catch maps:without({a,b},id(a))), + ?badarg(without,[a,#{}]) = (catch maps:without(a,#{})), ok. t_with_2(_Config) -> @@ -77,4 +92,53 @@ t_with_2(_Config) -> M0 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100)]), M1 = maps:from_list([{{k,I},{v,I}}||I<-Ki]), M1 = maps:with([{k,I}||I <- Ki],M0), + + %% error case + ?badmap(a,with,[[a,b],a]) = (catch maps:with([a,b],id(a))), + ?badmap(a,with,[{a,b},a]) = (catch maps:with({a,b},id(a))), + ?badarg(with,[a,#{}]) = (catch maps:with(a,#{})), + ok. + + +t_fold_3(Config) when is_list(Config) -> + Vs = lists:seq(1,200), + M0 = maps:from_list([{{k,I},I}||I<-Vs]), + #{ {k,1} := 1, {k,200} := 200} = M0, + Tot0 = lists:sum(Vs), + Tot1 = maps:fold(fun({k,_},V,A) -> A + V end, 0, M0), + true = Tot0 =:= Tot1, + + %% error case + ?badmap(a,fold,[_,0,a]) = (catch maps:fold(fun(_,_,_) -> ok end,0,id(a))), + ?badarg(fold,[<<>>,0,#{}]) = (catch maps:fold(id(<<>>),0,#{})), ok. + +t_map_2(Config) when is_list(Config) -> + Vs = lists:seq(1,200), + M0 = maps:from_list([{{k,I},I}||I<-Vs]), + #{ {k,1} := 1, {k,200} := 200} = M0, + M1 = maps:map(fun({k,_},V) -> V + 42 end, M0), + #{ {k,1} := 43, {k,200} := 242} = M1, + + %% error case + ?badmap(a,map,[_,a]) = (catch maps:map(fun(_,_) -> ok end, id(a))), + ?badarg(map,[<<>>,#{}]) = (catch maps:map(id(<<>>),#{})), + ok. + + +t_size_1(Config) when is_list(Config) -> + 0 = maps:size(#{}), + 10 = maps:size(maps:from_list([{{"k",I},I}||I<-lists:seq(1,10)])), + 20 = maps:size(maps:from_list([{{"k",I},I}||I<-lists:seq(1,20)])), + 30 = maps:size(maps:from_list([{{"k",I},I}||I<-lists:seq(1,30)])), + 40 = maps:size(maps:from_list([{{"k",I},I}||I<-lists:seq(1,40)])), + 50 = maps:size(maps:from_list([{{"k",I},I}||I<-lists:seq(1,50)])), + 60 = maps:size(maps:from_list([{{"k",I},I}||I<-lists:seq(1,60)])), + 600 = maps:size(maps:from_list([{{"k",I},I}||I<-lists:seq(1,600)])), + + %% error case + ?badmap(a,size,[a]) = (catch maps:size(id(a))), + ?badmap(<<>>,size,[<<>>]) = (catch maps:size(id(<<>>))), + ok. + +id(I) -> I. diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 4173a40d14..348c308f5d 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -396,7 +396,8 @@ nomatch(Config) when is_list(Config) -> qlc:q([3 || {3=4} <- []]). ">>, [], - {warnings,[{{2,27},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,27},qlc,nomatch_pattern}]}}, + {warnings,[{2,v3_core,nomatch}]}}, {nomatch2, <<"nomatch() -> @@ -407,7 +408,8 @@ nomatch(Config) when is_list(Config) -> end, [{1},{2}]). ">>, [], - {warnings,[{{3,33},qlc,nomatch_pattern}]}}, + %% {warnings,[{{3,33},qlc,nomatch_pattern}]}}, + {warnings,[{3,v3_core,nomatch}]}}, {nomatch3, <<"nomatch() -> @@ -419,7 +421,8 @@ nomatch(Config) when is_list(Config) -> end, [{1,2},{2,3}]). ">>, [], - {warnings,[{{3,52},qlc,nomatch_pattern}]}}, + %% {warnings,[{{3,52},qlc,nomatch_pattern}]}}, + {warnings,[{3,v3_core,nomatch}]}}, {nomatch4, <<"nomatch() -> @@ -2487,8 +2490,11 @@ info(Config) when is_list(Config) -> (catch qlc:info([X || {X} <- []], {n_elements, 0})), L = lists:seq(1, 1000), \"[1,2,3,4,5,6,7,8,9,10|'...']\" = qlc:info(L, {n_elements, 10}), - {cons,1,{integer,1,1},{atom,1,'...'}} = + {cons,A1,{integer,A2,1},{atom,A3,'...'}} = qlc:info(L, [{n_elements, 1},{format,abstract_code}]), + 1 = erl_anno:line(A1), + 1 = erl_anno:line(A2), + 1 = erl_anno:line(A3), Q = qlc:q([{X} || X <- [a,b,c,d,e,f]]), {call,_,_,[{cons,_,{atom,_,a},{cons,_,{atom,_,b},{cons,_,{atom,_,c}, {atom,_,'...'}}}}, @@ -2905,7 +2911,8 @@ lookup1(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1},{a}])">>, - {warnings,[{{2,37},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,37},qlc,nomatch_pattern}]}}, + []}, <<"etsc(fun(E) -> Q = qlc:q([X || {X=X,Y=Y}={Y=Y,X=X} <- ets:table(E), @@ -2933,7 +2940,8 @@ lookup1(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{a},{b}])">>, - {warnings,[{{2,35},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,35},qlc,nomatch_pattern}]}}, + []}, {cres, <<"etsc(fun(E) -> @@ -2941,7 +2949,8 @@ lookup1(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{a},{b}])">>, - {warnings,[{{2,35},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,35},qlc,nomatch_pattern}]}}, + []}, <<"etsc(fun(E) -> Q = qlc:q([X || X = <<X>> <- ets:table(E)]), @@ -2988,7 +2997,8 @@ lookup1(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{a,b,c},{d,e,f}])">>, - {warnings,[{{2,34},qlc,nomatch_pattern}]}} + %% {warnings,[{{2,34},qlc,nomatch_pattern}]}} + []} ], ?line run(Config, Ts), @@ -3021,8 +3031,9 @@ lookup2(Config) when is_list(Config) -> end, [{3,true},{4,true}])">>, <<"%% Only guards are inspected. No lookup. - E1 = create_ets(1, 10), - E2 = ets:new(join, []), + E1 = ets:new(e, [ordered_set]), + true = ets:insert(E1, [{1,1}, {2,2}, {3,3}, {4,4}, {5,5}]), + E2 = ets:new(join, [ordered_set]), true = ets:insert(E2, [{true,1},{false,2}]), Q = qlc:q([{X,Z} || {_,X} <- ets:table(E1), {Y,Z} <- ets:table(E2), @@ -3051,7 +3062,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1}, {2}])">>, - {warnings,[{{3,46},qlc,nomatch_filter}]}}, + %% {warnings,[{{3,46},qlc,nomatch_filter}]}}, + []}, {cres, <<"etsc(fun(E) -> @@ -3060,7 +3072,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1}, {2}])">>, - {warnings,[{{3,43},qlc,nomatch_filter}]}}, + %% {warnings,[{{3,43},qlc,nomatch_filter}]}}, + []}, {cres, <<"etsc(fun(E) -> @@ -3069,7 +3082,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1}, {2}])">>, - {warnings,[{{3,48},qlc,nomatch_filter}]}}, + %% {warnings,[{{3,48},qlc,nomatch_filter}]}}, + []}, <<"etsc(fun(E) -> Q = qlc:q([{X,Y} || {X,Y} <- ets:table(E), @@ -3084,7 +3098,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{[3]},{[3,4]}])">>, - {warnings,[{{2,61},qlc,nomatch_filter}]}}, + %% {warnings,[{{2,61},qlc,nomatch_filter}]}}, + []}, <<"etsc(fun(E) -> U = 18, @@ -3116,7 +3131,8 @@ lookup2(Config) when is_list(Config) -> [] = lists:sort(qlc:e(Q)), false = lookup_keys(Q) end, [{2},{3},{4},{8}])">>, - {warnings,[{{4,44},qlc,nomatch_filter}]}}, + %% {warnings,[{{4,44},qlc,nomatch_filter}]}}, + []}, {cres, <<"etsc(fun(E) -> @@ -3126,7 +3142,8 @@ lookup2(Config) when is_list(Config) -> [] = lists:sort(qlc:e(Q)), false = lookup_keys(Q) end, [{2},{3},{4},{8}])">>, - {warnings,[{{4,35},qlc,nomatch_filter}]}}, + %% {warnings,[{{4,35},qlc,nomatch_filter}]}}, + []}, <<"F = fun(U) -> Q = qlc:q([X || {X} <- [a,b,c], @@ -3142,7 +3159,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1,1},{2,1}])">>, - {warnings,[{{2,61},qlc,nomatch_filter}]}}, + %% {warnings,[{{2,61},qlc,nomatch_filter}]}}, + []}, <<"Two = 2.0, etsc(fun(E) -> @@ -3203,8 +3221,10 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1,b},{2,3}])">>, + %% {warnings,[{2,sys_core_fold,nomatch_guard}, + %% {3,qlc,nomatch_filter}, + %% {3,sys_core_fold,{eval_failure,badarg}}]}}, {warnings,[{2,sys_core_fold,nomatch_guard}, - {3,qlc,nomatch_filter}, {3,sys_core_fold,{eval_failure,badarg}}]}}, <<"etsc(fun(E) -> @@ -3227,7 +3247,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{{1}},{{2}}])">>, - {warnings,[{{4,47},qlc,nomatch_filter}]}}, + %% {warnings,[{{4,47},qlc,nomatch_filter}]}}, + []}, {cres, <<"etsc(fun(E) -> @@ -3237,7 +3258,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{{1}},{{2}}])">>, - {warnings,[{{4,47},qlc,nomatch_filter}]}}, + %% {warnings,[{{4,47},qlc,nomatch_filter}]}}, + []}, <<"etsc(fun(E) -> Q = qlc:q([X || {X} <- ets:table(E), @@ -3297,7 +3319,8 @@ lookup2(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{3}, {4}])">>, - {warnings,[{{3,44},qlc,nomatch_filter}]}}, + %% {warnings,[{{3,44},qlc,nomatch_filter}]}}, + []}, <<"etsc(fun(E) -> Q = qlc:q([X || {{X,Y}} <- ets:table(E), @@ -3418,7 +3441,8 @@ lookup2(Config) when is_list(Config) -> end, [{1},{2}])">> ], - ?line run(Config, Ts), + + ok = run(Config, Ts), TsR = [ %% is_record/2,3: @@ -3456,7 +3480,8 @@ lookup2(Config) when is_list(Config) -> end, [{keypos,1}], [#r{}])">> ], - ?line run(Config, <<"-record(r, {a}).\n">>, TsR), + + ok = run(Config, <<"-record(r, {a}).\n">>, TsR), Ts2 = [ <<"etsc(fun(E) -> @@ -3566,7 +3591,6 @@ lookup2(Config) when is_list(Config) -> [{1,2},{2,2}] = qlc:e(Q), [2] = lookup_keys(Q) end, [{keypos,1}], [{1},{2},{3}])">>, - <<"%% Matchspec only. No cache. etsc(fun(E) -> Q = qlc:q([{X,Y} || @@ -3578,7 +3602,7 @@ lookup2(Config) when is_list(Config) -> {generate,_, {table,{ets,_,[_,[{traverse,_}]]}}}],[]} = i(Q), - [{1,2},{1,3},{2,2},{2,3}] = qlc:e(Q), + [{1,2},{1,3},{2,2},{2,3}] = lists:sort(qlc:e(Q)), false = lookup_keys(Q) end, [{keypos,1}], [{1},{2},{3}])">>, <<"%% Matchspec only. Cache @@ -3592,7 +3616,7 @@ lookup2(Config) when is_list(Config) -> {generate,_,{qlc,_, [{generate,_,{table,{ets,_,[_,[{traverse,_}]]}}}], [{cache,ets}]}}],[]} = i(Q), - [{1,2},{1,3},{2,2},{2,3}] = qlc:e(Q), + [{1,2},{1,3},{2,2},{2,3}] = lists:sort(qlc:e(Q)), false = lookup_keys(Q) end, [{keypos,1}], [{1},{2},{3}])">>, <<"%% An empty list. Always unique and cached. @@ -3645,7 +3669,7 @@ lookup2(Config) when is_list(Config) -> ], - ?line run(Config, Ts2), + ok = run(Config, Ts2), LTs = [ <<"etsc(fun(E) -> @@ -3677,7 +3701,8 @@ lookup2(Config) when is_list(Config) -> end, [{1,a},{2,b}])">> ], - ?line run(Config, LTs), + + ok = run(Config, LTs), ok. @@ -3700,7 +3725,8 @@ lookup_rec(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{keypos,2}], [#r{a = 17}, #r{a = 3}, #r{a = 5}])">>, - {warnings,[{{4,44},qlc,nomatch_filter}]}}, + %% {warnings,[{{4,44},qlc,nomatch_filter}]}}, + []}, <<"%% Compares an integer and a float. etsc(fun(E) -> @@ -4004,7 +4030,8 @@ skip_filters(Config) when is_list(Config) -> [] = qlc:e(Q), false = lookup_keys(Q) end, [{1,1},{2,0}])">>, - {warnings,[{{4,37},qlc,nomatch_filter}]}}, + %% {warnings,[{{4,37},qlc,nomatch_filter}]}}, + []}, <<"etsc(fun(E) -> Q = qlc:q([{A,B,C} || @@ -6217,8 +6244,9 @@ otp_7238(Config) when is_list(Config) -> <<"nomatch_1() -> {qlc:q([X || X={X} <- []]), [t || \"a\"=\"b\" <- []]}.">>, [], - {warnings,[{{2,30},qlc,nomatch_pattern}, - {{2,44},v3_core,nomatch}]}}, + %% {warnings,[{{2,30},qlc,nomatch_pattern}, + %% {{2,44},v3_core,nomatch}]}}, + {warnings,[{2,v3_core,nomatch}]}}, %% Not found by qlc... {nomatch_2, @@ -6231,7 +6259,8 @@ otp_7238(Config) when is_list(Config) -> <<"nomatch_3() -> qlc:q([t || [$a, $b] = \"ba\" <- []]).">>, [], - {warnings,[{{2,37},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,37},qlc,nomatch_pattern}]}}, + {warnings,[{2,v3_core,nomatch}]}}, %% Not found by qlc... {nomatch_4, @@ -6252,44 +6281,51 @@ otp_7238(Config) when is_list(Config) -> qlc:q([X || X <- [], X =:= {X}]).">>, [], - {warnings,[{{3,30},qlc,nomatch_filter}]}}, + %% {warnings,[{{3,30},qlc,nomatch_filter}]}}, + []}, {nomatch_7, <<"nomatch_7() -> qlc:q([X || {X=Y,{Y}=X} <- []]).">>, [], - {warnings,[{{2,28},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,28},qlc,nomatch_pattern}]}}, + []}, {nomatch_8, <<"nomatch_8() -> qlc:q([X || {X={},X=[]} <- []]).">>, [], - {warnings,[{{2,28},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,28},qlc,nomatch_pattern}]}}, + []}, {nomatch_9, <<"nomatch_9() -> qlc:q([X || X <- [], X =:= {}, X =:= []]).">>, [], - {warnings,[{{2,49},qlc,nomatch_filter}]}}, + %% {warnings,[{{2,49},qlc,nomatch_filter}]}}, + []}, {nomatch_10, <<"nomatch_10() -> qlc:q([X || X <- [], ((X =:= 1) or (X =:= 2)) and (X =:= 3)]).">>, [], - {warnings,[{{3,53},qlc,nomatch_filter}]}}, + %% {warnings,[{{3,53},qlc,nomatch_filter}]}}, + []}, {nomatch_11, <<"nomatch_11() -> qlc:q([X || X <- [], x =:= []]).">>, [], - {warnings,[{{2,39},qlc,nomatch_filter}]}}, + %% {warnings,[{{2,39},qlc,nomatch_filter}]}}, + {warnings,[{2,sys_core_fold,nomatch_guard}]}}, {nomatch_12, <<"nomatch_12() -> qlc:q([X || X={} <- [], X =:= []]).">>, [], - {warnings,[{{2,42},qlc,nomatch_filter}]}}, + %% {warnings,[{{2,42},qlc,nomatch_filter}]}}, + []}, {nomatch_13, <<"nomatch_13() -> @@ -6297,8 +6333,9 @@ otp_7238(Config) when is_list(Config) -> X={X} <- [], Y={Y} <- []]).">>, [], - {warnings,[{{3,29},qlc,nomatch_pattern}, - {{4,29},qlc,nomatch_pattern}]}}, + %% {warnings,[{{3,29},qlc,nomatch_pattern}, + %% {{4,29},qlc,nomatch_pattern}]}}, + []}, {nomatch_14, <<"nomatch_14() -> @@ -6306,7 +6343,8 @@ otp_7238(Config) when is_list(Config) -> 1 > 0, 1 > X]).">>, [], - {warnings,[{{2,29},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,29},qlc,nomatch_pattern}]}}, + []}, {nomatch_15, <<"nomatch_15() -> @@ -6315,7 +6353,8 @@ otp_7238(Config) when is_list(Config) -> 1 > 0, 1 > X]).">>, [], - {warnings,[{{2,32},qlc,nomatch_pattern}]}}, + %% {warnings,[{{2,32},qlc,nomatch_pattern}]}}, + []}, %% Template warning. {nomatch_template1, @@ -6553,18 +6592,19 @@ otp_7238(Config) when is_list(Config) -> ?line run(Config, T2), T3 = [ - {nomatch_6, - <<"nomatch_6() -> - qlc:q([X || X <- [], - X =:= {X}]).">>, - [], - {[],["filter evaluates to 'false'"]}}, - - {nomatch_7, - <<"nomatch_7() -> - qlc:q([X || {X=Y,{Y}=X} <- []]).">>, - [], - {[],["pattern cannot possibly match"]}}], +%% {nomatch_6, +%% <<"nomatch_6() -> +%% qlc:q([X || X <- [], +%% X =:= {X}]).">>, +%% [], +%% {[],["filter evaluates to 'false'"]}}, + +%% {nomatch_7, +%% <<"nomatch_7() -> +%% qlc:q([X || {X=Y,{Y}=X} <- []]).">>, +%% [], +%% {[],["pattern cannot possibly match"]}} + ], ?line compile_format(Config, T3), %% *Very* simple test - just check that it doesn't crash. @@ -6822,7 +6862,8 @@ otp_6674(Config) when is_list(Config) -> A == 192, B =:= 192.0, {Y} <- [{0},{1},{2}], X == Y]), - {block,0, + A0 = erl_anno:new(0), + {block,A0, [{match,_,_, {call,_,_, [{lc,_,_, @@ -7392,7 +7433,8 @@ try_old_join_info(Config) -> {ok, M} = compile:file(File, [{outdir, ?datadir}]), {module, M} = code:load_abs(filename:rootname(File)), H = M:create_handle(), - {block,0, + A0 = erl_anno:new(0), + {block,A0, [{match,_,_, {call,_,_, [{lc,_,_, @@ -7772,8 +7814,8 @@ table(List, Indices, KeyPos, ParentFun) -> end, FormatFun = fun(all) -> - L = 17, - {call,L,{remote,L,{atom,1,?MODULE},{atom,L,the_list}}, + L = erl_anno:new(17), + {call,L,{remote,L,{atom,L,?MODULE},{atom,L,the_list}}, [erl_parse:abstract(List, 17)]}; ({lookup, Column, Values}) -> {?MODULE, list_keys, [Values, Column, List]} diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl new file mode 100644 index 0000000000..9a1f37aa75 --- /dev/null +++ b/lib/stdlib/test/rand_SUITE.erl @@ -0,0 +1,527 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% + +-module(rand_SUITE). +-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([interval_int/1, interval_float/1, seed/1, + api_eq/1, reference/1, basic_stats/1, + plugin/1, measure/1 + ]). + +-export([test/0, gen/1]). + +-include_lib("test_server/include/test_server.hrl"). + +% Default timetrap timeout (set in init_per_testcase). +-define(default_timeout, ?t:minutes(1)). +-define(LOOP, 1000000). + +init_per_testcase(_Case, Config) -> + Dog = ?t:timetrap(?default_timeout), + [{watchdog, Dog} | Config]. +end_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [seed, interval_int, interval_float, + api_eq, + reference, + basic_stats, + plugin, measure + ]. + +groups() -> []. + +init_per_suite(Config) -> Config. +end_per_suite(_Config) -> ok. + +init_per_group(_GroupName, Config) -> Config. +end_per_group(_GroupName, Config) -> Config. + +%% A simple helper to test without test_server during dev +test() -> + Tests = all(), + lists:foreach(fun(Test) -> + try + ok = ?MODULE:Test([]), + io:format("~p: ok~n", [Test]) + catch _:Reason -> + io:format("Failed: ~p: ~p ~p~n", + [Test, Reason, erlang:get_stacktrace()]) + end + end, Tests). + +algs() -> + [exs64, exsplus, exs1024]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +seed(doc) -> + ["Test that seed and seed_s and export_seed/0 is working."]; +seed(suite) -> + []; +seed(Config) when is_list(Config) -> + Algs = algs(), + Test = fun(Alg) -> + try seed_1(Alg) + catch _:Reason -> + test_server:fail({Alg, Reason, erlang:get_stacktrace()}) + end + end, + [Test(Alg) || Alg <- Algs], + ok. + +seed_1(Alg) -> + %% Check that uniform seeds automatically, + _ = rand:uniform(), + S00 = get(rand_seed), + erase(), + _ = rand:uniform(), + false = S00 =:= get(rand_seed), %% hopefully + + %% Choosing algo and seed + S0 = rand:seed(Alg, {0, 0, 0}), + %% Check that (documented?) process_dict variable is correct + S0 = get(rand_seed), + S0 = rand:seed_s(Alg, {0, 0, 0}), + %% Check that process_dict should not be used for seed_s functionality + _ = rand:seed_s(Alg, {1, 0, 0}), + S0 = get(rand_seed), + %% Test export + ES0 = rand:export_seed(), + ES0 = rand:export_seed_s(S0), + S0 = rand:seed(ES0), + S0 = rand:seed_s(ES0), + %% seed/1 calls should be unique + S1 = rand:seed(Alg), + false = (S1 =:= rand:seed_s(Alg)), + %% Negative integers works + _ = rand:seed_s(Alg, {-1,-1,-1}), + + %% Other term do not work + {'EXIT', _} = (catch rand:seed_s(foobar, os:timestamp())), + {'EXIT', _} = (catch rand:seed_s(Alg, {asd, 1, 1})), + {'EXIT', _} = (catch rand:seed_s(Alg, {0, 234.1234, 1})), + {'EXIT', _} = (catch rand:seed_s(Alg, {0, 234, [1, 123, 123]})), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +api_eq(doc) -> + ["Check that both api's are consistent with each other."]; +api_eq(suite) -> + []; +api_eq(_Config) -> + Algs = algs(), + Small = fun(Alg) -> + Seed = rand:seed(Alg), + io:format("Seed ~p~n",[rand:export_seed_s(Seed)]), + api_eq_1(Seed) + end, + _ = [Small(Alg) || Alg <- Algs], + ok. + +api_eq_1(S00) -> + Check = fun(_, Seed) -> + {V0, S0} = rand:uniform_s(Seed), + V0 = rand:uniform(), + {V1, S1} = rand:uniform_s(1000000, S0), + V1 = rand:uniform(1000000), + {V2, S2} = rand:normal_s(S1), + V2 = rand:normal(), + S2 + end, + S1 = lists:foldl(Check, S00, lists:seq(1, 200)), + S1 = get(rand_seed), + {V0, S2} = rand:uniform_s(S1), + V0 = rand:uniform(), + S2 = get(rand_seed), + + Exported = rand:export_seed(), + Exported = rand:export_seed_s(S2), + + S3 = lists:foldl(Check, S2, lists:seq(1, 200)), + S3 = get(rand_seed), + + S4 = lists:foldl(Check, S3, lists:seq(1, 200)), + S4 = get(rand_seed), + %% Verify that we do not have loops + false = S1 =:= S2, + false = S2 =:= S3, + false = S3 =:= S4, + + S2 = rand:seed(Exported), + S3 = lists:foldl(Check, S2, lists:seq(1, 200)), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +interval_int(doc) -> + ["Check that uniform/1 returns values within the proper interval."]; +interval_int(suite) -> + []; +interval_int(Config) when is_list(Config) -> + Algs = algs(), + Small = fun(Alg) -> + Seed = rand:seed(Alg), + io:format("Seed ~p~n",[rand:export_seed_s(Seed)]), + Max = interval_int_1(100000, 7, 0), + Max =:= 7 orelse exit({7, Alg, Max}) + end, + _ = [Small(Alg) || Alg <- Algs], + %% Test large integers + Large = fun(Alg) -> + Seed = rand:seed(Alg), + io:format("Seed ~p~n",[rand:export_seed_s(Seed)]), + Max = interval_int_1(100000, 1 bsl 128, 0), + Max > 1 bsl 64 orelse exit({large, Alg, Max}) + end, + [Large(Alg) || Alg <- Algs], + ok. + +interval_int_1(0, _, Max) -> Max; +interval_int_1(N, Top, Max) -> + X = rand:uniform(Top), + if + 0 < X, X =< Top -> + ok; + true -> + io:format("X=~p Top=~p 0<~p<~p~n", [X,Top,X,Top]), + exit({X, rand:export_seed()}) + end, + interval_int_1(N-1, Top, max(X, Max)). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +interval_float(doc) -> + ["Check that uniform/0 returns values within the proper interval."]; +interval_float(suite) -> + []; +interval_float(Config) when is_list(Config) -> + Algs = algs(), + Test = fun(Alg) -> + _ = rand:seed(Alg), + interval_float_1(100000) + end, + [Test(Alg) || Alg <- Algs], + ok. + +interval_float_1(0) -> ok; +interval_float_1(N) -> + X = rand:uniform(), + if + 0.0 < X, X < 1.0 -> + ok; + true -> + io:format("X=~p 0<~p<1.0~n", [X,X]), + exit({X, rand:export_seed()}) + end, + interval_float_1(N-1). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +reference(doc) -> ["Check if exs64 algorithm generates the proper sequence."]; +reference(suite) -> []; +reference(Config) when is_list(Config) -> + [reference_1(Alg) || Alg <- algs()], + ok. + +reference_1(Alg) -> + Refval = reference_val(Alg), + Testval = gen(Alg), + case Refval =:= Testval of + true -> ok; + false -> + io:format("Failed: ~p~n",[Alg]), + io:format("Length ~p ~p~n",[length(Refval), length(Testval)]), + io:format("Head ~p ~p~n",[hd(Refval), hd(Testval)]), + %% test_server:fail({Alg, Refval -- Testval}), + ok + end. + +gen(Algo) -> + Seed = case Algo of + exsplus -> %% Printed with orig 'C' code and this seed + rand:seed_s({exsplus, [12345678|12345678]}); + exs64 -> %% Printed with orig 'C' code and this seed + rand:seed_s({exs64, 12345678}); + exs1024 -> %% Printed with orig 'C' code and this seed + rand:seed_s({exs1024, {lists:duplicate(16, 12345678), []}}); + _ -> + rand:seed(Algo, {100, 200, 300}) + end, + gen(?LOOP, Seed, []). + +gen(N, State0 = {#{max:=Max}, _}, Acc) when N > 0 -> + {Random, State} = rand:uniform_s(Max, State0), + case N rem (?LOOP div 100) of + 0 -> gen(N-1, State, [Random|Acc]); + _ -> gen(N-1, State, Acc) + end; +gen(_, _, Acc) -> lists:reverse(Acc). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% This just tests the basics so we have not made any serious errors +%% when making the conversion from the original algorithms. +%% The algorithms must have good properties to begin with +%% + +basic_stats(doc) -> ["Check that the algorithms generate sound values."]; +basic_stats(suite) -> []; +basic_stats(Config) when is_list(Config) -> + io:format("Testing uniform~n",[]), + [basic_uniform_1(?LOOP, rand:seed_s(Alg), 0.0, array:new([{default, 0}])) + || Alg <- algs()], + [basic_uniform_2(?LOOP, rand:seed_s(Alg), 0, array:new([{default, 0}])) + || Alg <- algs()], + io:format("Testing normal~n",[]), + [basic_normal_1(?LOOP, rand:seed_s(Alg), 0, 0) || Alg <- algs()], + ok. + +basic_uniform_1(N, S0, Sum, A0) when N > 0 -> + {X,S} = rand:uniform_s(S0), + I = trunc(X*100), + A = array:set(I, 1+array:get(I,A0), A0), + basic_uniform_1(N-1, S, Sum+X, A); +basic_uniform_1(0, {#{type:=Alg}, _}, Sum, A) -> + AverN = Sum / ?LOOP, + io:format("~.10w: Average: ~.4f~n", [Alg, AverN]), + Counters = array:to_list(A), + Min = lists:min(Counters), + Max = lists:max(Counters), + io:format("~.10w: Min: ~p Max: ~p~n", [Alg, Min, Max]), + + %% Verify that the basic statistics are ok + %% be gentle we don't want to see to many failing tests + abs(0.5 - AverN) < 0.005 orelse test_server:fail({average, Alg, AverN}), + abs(?LOOP div 100 - Min) < 1000 orelse test_server:fail({min, Alg, Min}), + abs(?LOOP div 100 - Max) < 1000 orelse test_server:fail({max, Alg, Max}), + ok. + +basic_uniform_2(N, S0, Sum, A0) when N > 0 -> + {X,S} = rand:uniform_s(100, S0), + A = array:set(X-1, 1+array:get(X-1,A0), A0), + basic_uniform_2(N-1, S, Sum+X, A); +basic_uniform_2(0, {#{type:=Alg}, _}, Sum, A) -> + AverN = Sum / ?LOOP, + io:format("~.10w: Average: ~.4f~n", [Alg, AverN]), + Counters = tl(array:to_list(A)), + Min = lists:min(Counters), + Max = lists:max(Counters), + io:format("~.10w: Min: ~p Max: ~p~n", [Alg, Min, Max]), + + %% Verify that the basic statistics are ok + %% be gentle we don't want to see to many failing tests + abs(50.5 - AverN) < 0.5 orelse test_server:fail({average, Alg, AverN}), + abs(?LOOP div 100 - Min) < 1000 orelse test_server:fail({min, Alg, Min}), + abs(?LOOP div 100 - Max) < 1000 orelse test_server:fail({max, Alg, Max}), + ok. + +basic_normal_1(N, S0, Sum, Sq) when N > 0 -> + {X,S} = rand:normal_s(S0), + basic_normal_1(N-1, S, X+Sum, X*X+Sq); +basic_normal_1(0, {#{type:=Alg}, _}, Sum, SumSq) -> + Mean = Sum / ?LOOP, + StdDev = math:sqrt((SumSq - (Sum*Sum/?LOOP))/(?LOOP - 1)), + io:format("~.10w: Average: ~7.4f StdDev ~6.4f~n", [Alg, Mean, StdDev]), + %% Verify that the basic statistics are ok + %% be gentle we don't want to see to many failing tests + abs(Mean) < 0.005 orelse test_server:fail({average, Alg, Mean}), + abs(StdDev - 1.0) < 0.005 orelse test_server:fail({stddev, Alg, StdDev}), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +plugin(doc) -> ["Test that the user can write algorithms"]; +plugin(suite) -> []; +plugin(Config) when is_list(Config) -> + _ = lists:foldl(fun(_, S0) -> + {V1, S1} = rand:uniform_s(10000, S0), + true = is_integer(V1), + {V2, S2} = rand:uniform_s(S1), + true = is_float(V2), + S2 + end, crypto_seed(), lists:seq(1, 200)), + ok. + +%% Test implementation +crypto_seed() -> + {#{type=>crypto, + max=>(1 bsl 64)-1, + next=>fun crypto_next/1, + uniform=>fun crypto_uniform/1, + uniform_n=>fun crypto_uniform_n/2}, + <<>>}. + +%% Be fair and create bignums i.e. 64bits otherwise use 58bits +crypto_next(<<Num:64, Bin/binary>>) -> + {Num, Bin}; +crypto_next(_) -> + crypto_next(crypto:rand_bytes((64 div 8)*100)). + +crypto_uniform({Api, Data0}) -> + {Int, Data} = crypto_next(Data0), + {Int / (1 bsl 64), {Api, Data}}. + +crypto_uniform_n(N, {Api, Data0}) when N < (1 bsl 64) -> + {Int, Data} = crypto_next(Data0), + {(Int rem N)+1, {Api, Data}}; +crypto_uniform_n(N, State0) -> + {F,State} = crypto_uniform(State0), + {trunc(F * N) + 1, State}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Not a test but measures the time characteristics of the different algorithms +measure(Suite) when is_atom(Suite) -> []; +measure(_Config) -> + Algos = [crypto64|algs()], + io:format("RNG uniform integer performance~n",[]), + _ = measure_1(random, fun(State) -> {int, random:uniform_s(10000, State)} end), + _ = [measure_1(Algo, fun(State) -> {int, rand:uniform_s(10000, State)} end) || Algo <- Algos], + io:format("RNG uniform float performance~n",[]), + _ = measure_1(random, fun(State) -> {uniform, random:uniform_s(State)} end), + _ = [measure_1(Algo, fun(State) -> {uniform, rand:uniform_s(State)} end) || Algo <- Algos], + io:format("RNG normal float performance~n",[]), + io:format("~.10w: not implemented (too few bits)~n", [random]), + _ = [measure_1(Algo, fun(State) -> {normal, rand:normal_s(State)} end) || Algo <- Algos], + ok. + +measure_1(Algo, Gen) -> + Parent = self(), + Seed = fun(crypto64) -> crypto_seed(); + (random) -> random:seed(os:timestamp()), get(random_seed); + (Alg) -> rand:seed_s(Alg) + end, + + Pid = spawn_link(fun() -> + Fun = fun() -> measure_2(?LOOP, Seed(Algo), Gen) end, + {Time, ok} = timer:tc(Fun), + io:format("~.10w: ~pµs~n", [Algo, Time]), + Parent ! {self(), ok}, + normal + end), + receive + {Pid, Msg} -> Msg + end. + +measure_2(N, State0, Fun) when N > 0 -> + case Fun(State0) of + {int, {Random, State}} + when is_integer(Random), Random >= 1, Random =< 100000 -> + measure_2(N-1, State, Fun); + {uniform, {Random, State}} when is_float(Random), Random > 0, Random < 1 -> + measure_2(N-1, State, Fun); + {normal, {Random, State}} when is_float(Random) -> + measure_2(N-1, State, Fun); + Res -> + exit({error, Res, State0}) + end; +measure_2(0, _, _) -> ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Data +reference_val(exs64) -> + [16#3737ad0c703ff6c3,16#3868a78fe71adbbd,16#1f01b62b4338b605,16#50876a917437965f, + 16#b2edfe32a10e27fc,16#995924551d8ebae1,16#9f1e6b94e94e0b58,16#27ec029eb0e94f8e, + 16#bf654e6df7fe5c,16#b7d5ef7b79be65e3,16#4bdba4d1c159126b,16#a9c816fdc701292c, + 16#a377b6c89d85ac8b,16#7abb5cd0e5847a6,16#62666f1fc00a0a90,16#1edc3c3d255a8113, + 16#dfc764073767f18e,16#381783d577ca4e34,16#49693588c085ddcb,16#da6fcb16dd5163f3, + 16#e2357a703475b1b7,16#aaa84c4924b5985a,16#b8fe07bb2bac1e49,16#23973ac0160ff064, + 16#1afbc7b023f5d618,16#9f510f7b7caa2a0f,16#d5b0a57f7f5f1084,16#d8c49b66c5f99a29, + 16#e920ac3b598b5213,16#1090d7e27e7a7c76,16#81171917168ee74f,16#f08489a3eb6988e, + 16#396260c4f0b2ed46,16#4fd0a6a6caefd5b2,16#423dff07a3b888a,16#12718773ebd99987, + 16#e50991e540807cb,16#8cfa03bbaa6679d6,16#55bdf86dfbb92dbf,16#eb7145378cce74a8, + 16#71856c224c846595,16#20461588dae6e24d,16#c73b3e63ced74bac,16#775b11813dda0c78, + 16#91f358e51068ede0,16#399955ef36766bc2,16#4489ee072e8a38b1,16#ba77759d52321ca0, + 16#14f519eab5c53db8,16#1f754bd08e4f34c4,16#99e25ca29b2fcfeb,16#da11927c0d9837f8, + 16#1eeb0f87009f5a87,16#a7c444d3b0db1089,16#49c7fbf0714849ad,16#4f2b693e7f8265cb, + 16#80e1493cbaa8f256,16#186f345bcac2661e,16#330065ae0c698d26,16#5235ed0432c42e93, + 16#429792e31ddb10bb,16#8769054bb6533cff,16#1ab382483444201f,16#2216368786fc7b9, + 16#1efea1155216da0b,16#782dc868ba595452,16#2b80f6d159617f48,16#407fc35121b2fa1b, + 16#90e8be6e618873d1,16#40ad4ec92a8abf8e,16#34e2890f583f435,16#838c0aef0a5d8427, + 16#ed4238f4bd6cbcfa,16#7feed11f7a8bb9f0,16#2b0636a93e26c89d,16#481ad4bea5180646, + 16#673e5ad861afe1cc,16#298eeb519d69e74d,16#eb1dd06d168c856,16#4770651519ee7ef9, + 16#7456ebf1bcf608f1,16#d6200f6fbd61ce05,16#c0695dfab11ab6aa,16#5bff449249983843, + 16#7aba88471474c9ac,16#d7e9e4a21c989e91,16#c5e02ee67ccb7ce1,16#4ea8a3a912246153, + 16#f2e6db7c9ce4ec43,16#39498a95d46d2470,16#c5294fcb8cce8aa9,16#a918fe444719f3dc, + 16#98225f754762c0c0,16#f0721204f2cb43f5,16#b98e77b099d1f2d1,16#691d6f75aee3386, + 16#860c7b2354ec24fd,16#33e007bd0fbcb609,16#7170ae9c20fb3d0,16#31d46938fe383a60]; + +reference_val(exs1024) -> + [16#9c61311d0d4a01fd,16#ce963ef5803b703e,16#545dcffb7b644e1a,16#edd56576a8d778d5, + 16#16bee799783c6b45,16#336f0b3caeb417fa,16#29291b8be26dedfa,16#1efed996d2e1b1a8, + 16#c5c04757bd2dadf9,16#11aa6d194009c616,16#ab2b3e82bdb38a91,16#5011ee46fd2609eb, + 16#766db7e5b701a9bb,16#d42cb2632c419f35,16#107c6a2667bf8557,16#3ffbf922cb306967, + 16#1e71e3d024ac5131,16#6fdb368ec67a5f06,16#b0d8e72e7aa6d1c1,16#e5705a02dae89e3b, + 16#9c24eb68c086a1d3,16#418de330f55f71f0,16#2917ddeb278bc8d2,16#aeba7fba67208f39, + 16#10ceaf40f6af1d8d,16#47a6d06811d33132,16#603a661d6caf720a,16#a28bd0c9bcdacb3c, + 16#f44754f006909762,16#6e25e8e67ccc43bc,16#174378ce374a549e,16#b5598ae9f57c4e50, + 16#ca85807fbcd51dd,16#1816e58d6c3cc32a,16#1b4d630d3c8e96a6,16#c19b1e92b4efc5bd, + 16#665597b20ddd721a,16#fdab4eb21b75c0ae,16#86a612dcfea0756c,16#8fc2da192f9a55f0, + 16#d7c954eb1af31b5,16#6f5ee45b1b80101b,16#ebe8ea4e5a67cbf5,16#1cb952026b4c1400, + 16#44e62caffe7452c0,16#b591d8f3e6d7cbcf,16#250303f8d77b6f81,16#8ef2199aae4c9b8d, + 16#a16baa37a14d7b89,16#c006e4d2b2da158b,16#e6ec7abd54c93b31,16#e6b0d79ae2ab6fa7, + 16#93e4b30e4ab7d4cd,16#42a01b6a4ef63033,16#9ab1e94fe94976e,16#426644e1de302a1f, + 16#8e58569192200139,16#744f014a090107c1,16#15d056801d467c6c,16#51bdad3a8c30225f, + 16#abfc61fb3104bd45,16#c610607122272df7,16#905e67c63116ebfc,16#1e4fd5f443bdc18, + 16#1945d1745bc55a4c,16#f7cd2b18989595bb,16#f0d273b2c646a038,16#ee9a6fdc6fd5d734, + 16#541a518bdb700518,16#6e67ab9a65361d76,16#bcfadc9bfe5b2e06,16#69fa334cf3c11496, + 16#9657df3e0395b631,16#fc0d0442160108ec,16#2ee538da7b1f7209,16#8b20c9fae50a5a9e, + 16#a971a4b5c2b3b6a,16#ff6241e32489438e,16#8fd6433f45255777,16#6e6c82f10818b0dc, + 16#59a8fad3f6af616b,16#7eac34f43f12221c,16#6e429ec2951723ec,16#9a65179767a45c37, + 16#a5f8127d1e6fdf35,16#932c50bc633d8d5c,16#f3bbea4e7ebecb8,16#efc3a2bbf6a8674, + 16#451644a99971cb6,16#cf70776d652c150d,16#c1fe0dcb87a25403,16#9523417132b2452e, + 16#8f98bc30d06b980e,16#bb4b288ecb8daa9a,16#59e54beb32f78045,16#f9ab1562456b9d66, + 16#6435f4130304a793,16#b4bb94c2002e1849,16#49a86d1e4bade982,16#457d63d60ed52b95]; + +reference_val(exsplus) -> + [16#bc76c2e638db,16#15ede2ebb16c9fb,16#185ee2c27d6b88d,16#15d5ee9feafc3a5, + 16#1862e91dfce3e6b,16#2c9744b0fb69e46,16#78b21bc01cef6b,16#2d16a2fae6c76ba, + 16#13dfccb8ff86bce,16#1d9474c59e23f4d,16#d2f67dcd7f0dd6,16#2b6d489d51a0725, + 16#1fa52ef484861d8,16#1ae9e2a38f966d4,16#2264ab1e193acca,16#23bbca085039a05, + 16#2b6eea06a0af0e1,16#3ad47fa8866ea20,16#1ec2802d612d855,16#36c1982b134d50, + 16#296b6a23f5b75e0,16#c5eeb600a9875c,16#2a3fd51d735f9d4,16#56fafa3593a070, + 16#13e9d416ec0423e,16#28101a91b23e9dc,16#32e561eb55ce15a,16#94a7dbba66fe4a, + 16#2e1845043bcec1f,16#235f7513a1b5146,16#e37af1bf2d63cb,16#2048033824a1639, + 16#c255c750995f7,16#2c7542058e89ee3,16#204dfeefbdb62ba,16#f5a936ec63dd66, + 16#33b3b7dbbbd8b90,16#c4f0f79026ffe9,16#20ffee2d37aca13,16#2274f931716be2c, + 16#29b883902ba9df1,16#1a838cd5312717f,16#2edfc49ff3dc1d6,16#418145cbec84c2, + 16#d2d8f1a17d49f,16#d41637bfa4cc6f,16#24437e03a0f5df8,16#3d1d87919b94a90, + 16#20d6997b36769b6,16#16f9d7855cd87ca,16#821ef7e2a062a3,16#2c4d11dc4a2da70, + 16#24a3b27f56ed26b,16#144b23c8b97387a,16#34a2ced56930d12,16#21cc0544113a017, + 16#3e780771f634fb2,16#146c259c02e7e18,16#1d99e4cfad0ef1,16#fdf3dabefc6b3a, + 16#7d0806e4d12dfb,16#3e3ae3580532eae,16#2456544200fbd86,16#f83aad4e88db85, + 16#37c134779463b4d,16#21a20bf64b6e735,16#1c0585ac88b69f2,16#1b3fcea8dd30e56, + 16#334bc301aefd97,16#37066eb7e80a946,16#15a19a6331b570f,16#35e67fa43c3f7d0, + 16#152a4020145fb80,16#8d55139491dfbe,16#21d9cba585c059d,16#31475f363654635, + 16#2567b17acb7a104,16#39201be3a7681c5,16#6bc675fd26b601,16#334b93232b1b1e3, + 16#357c402cb732c6a,16#362e32efe4db46a,16#8edc7ae3da51e5,16#31573376785eac9, + 16#6c6145ffa1169d,16#18ec2c393d45359,16#1f1a5f256e7130c,16#131cc2f49b8004f, + 16#36f715a249f4ec2,16#1c27629826c50d3,16#914d9a6648726a,16#27f5bf5ce2301e8, + 16#3dd493b8012970f,16#be13bed1e00e5c,16#ceef033b74ae10,16#3da38c6a50abe03, + 16#15cbd1a421c7a8c,16#22794e3ec6ef3b1,16#26154d26e7ea99f,16#3a66681359a6ab6]. diff --git a/lib/stdlib/test/random_SUITE.erl b/lib/stdlib/test/random_SUITE.erl index ac9d1a6c06..22c0900651 100644 --- a/lib/stdlib/test/random_SUITE.erl +++ b/lib/stdlib/test/random_SUITE.erl @@ -82,7 +82,7 @@ seed(suite) -> []; seed(Config) when is_list(Config) -> ?line Self = self(), - ?line Seed = {S1, S2, S3} = now(), + Seed = {S1, S2, S3} = erlang:timestamp(), ?line _ = spawn(fun() -> random:seed(S1,S2,S3), Rands = lists:foldl(fun diff --git a/lib/stdlib/test/select_SUITE.erl b/lib/stdlib/test/select_SUITE.erl index 546c25f954..201c38b25a 100644 --- a/lib/stdlib/test/select_SUITE.erl +++ b/lib/stdlib/test/select_SUITE.erl @@ -211,7 +211,7 @@ init_random(Config) -> {ok,[X]} -> X; _ -> - {A,B,C} = erlang:now(), + {A,B,C} = erlang:timestamp(), random:seed(A,B,C), get(random_seed) end, diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index f841e2c4a6..7c18560498 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -404,13 +404,14 @@ records(Config) when is_list(Config) -> ?line ok = file:write_file(Test, Contents), RR5 = "rr(\"" ++ Test ++ "\", '_', {d,test1}), rl([test1,test2]).", - ?line [{attribute,1,record,{test1,_}},ok] = scan(RR5), + A1 = erl_anno:new(1), + [{attribute,A1,record,{test1,_}},ok] = scan(RR5), RR6 = "rr(\"" ++ Test ++ "\", '_', {d,test2}), rl([test1,test2]).", - ?line [{attribute,1,record,{test2,_}},ok] = scan(RR6), + [{attribute,A1,record,{test2,_}},ok] = scan(RR6), RR7 = "rr(\"" ++ Test ++ "\", '_', [{d,test1},{d,test2,17}]), rl([test1,test2]).", - ?line [{attribute,1,record,{test1,_}},{attribute,1,record,{test2,_}}, - ok] = scan(RR7), + [{attribute,A1,record,{test1,_}},{attribute,A1,record,{test2,_}},ok] = + scan(RR7), ?line PreReply = scan(<<"rr(prim_file).">>), % preloaded... ?line true = is_list(PreReply), ?line Dir = filename:join(?config(priv_dir, Config), "*.erl"), diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index a55c710d50..e9ea2e3522 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -120,7 +120,7 @@ chr_rchr(suite) -> chr_rchr(doc) -> []; chr_rchr(Config) when is_list(Config) -> - ?line {_,_,X} = now(), + {_,_,X} = erlang:timestamp(), ?line 0 = string:chr("", (X rem (255-32)) + 32), ?line 0 = string:rchr("", (X rem (255-32)) + 32), ?line 1 = string:chr("x", $x), @@ -144,7 +144,7 @@ str_rstr(suite) -> str_rstr(doc) -> []; str_rstr(Config) when is_list(Config) -> - ?line {_,_,X} = now(), + {_,_,X} = erlang:timestamp(), ?line 0 = string:str("", [(X rem (255-32)) + 32]), ?line 0 = string:rstr("", [(X rem (255-32)) + 32]), ?line 1 = string:str("x", "x"), diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index c98654aef7..9dcf19707c 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -53,7 +53,8 @@ temporary_abnormal/1, temporary_bystander/1]). %% Restart strategy tests --export([ one_for_one/1, +-export([ multiple_restarts/1, + one_for_one/1, one_for_one_escalation/1, one_for_all/1, one_for_all_escalation/1, one_for_all_other_child_fails_restart/1, simple_one_for_one/1, simple_one_for_one_escalation/1, @@ -78,6 +79,7 @@ suite() -> all() -> [{group, sup_start}, {group, sup_start_map}, {group, sup_stop}, child_adm, child_adm_simple, extra_return, child_specs, sup_flags, + multiple_restarts, {group, restart_one_for_one}, {group, restart_one_for_all}, {group, restart_simple_one_for_one}, @@ -873,6 +875,39 @@ temporary_bystander(_Config) -> [{child1, _, _, _}] = supervisor:which_children(SupPid2). %%------------------------------------------------------------------------- +%% Test restarting a process multiple times, being careful not +%% to exceed the maximum restart frquency. +multiple_restarts(Config) when is_list(Config) -> + process_flag(trap_exit, true), + Child1 = #{id => child1, + start => {supervisor_1, start_child, []}, + restart => permanent, + shutdown => brutal_kill, + type => worker, + modules => []}, + SupFlags = #{strategy => one_for_one, + intensity => 1, + period => 1}, + {ok, SupPid} = start_link({ok, {SupFlags, []}}), + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + + %% Terminate the process several times, but being careful + %% not to exceed the maximum restart intensity. + terminate(SupPid, CPid1, child1, abnormal), + _ = [begin + receive after 2100 -> ok end, + [{_, Pid, _, _}|_] = supervisor:which_children(sup_test), + terminate(SupPid, Pid, child1, abnormal) + end || _ <- [1,2,3]], + + %% Verify that the supervisor is still alive and clean up. + ok = supervisor:terminate_child(SupPid, child1), + ok = supervisor:delete_child(SupPid, child1), + exit(SupPid, kill), + ok. + + +%%------------------------------------------------------------------------- %% Test the one_for_one base case. one_for_one(Config) when is_list(Config) -> process_flag(trap_exit, true), diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl index 9b6d65011e..3b54cd0f34 100644 --- a/lib/stdlib/test/tar_SUITE.erl +++ b/lib/stdlib/test/tar_SUITE.erl @@ -89,7 +89,7 @@ borderline_test(Size, TempDir) -> ?line io:format("Testing size ~p", [Size]), %% Create a file and archive it. - ?line {_, _, X0} = erlang:now(), + X0 = erlang:monotonic_time(), ?line file:write_file(Name, random_byte_list(X0, Size)), ?line ok = erl_tar:create(Archive, [Name]), ?line ok = file:delete(Name), diff --git a/lib/stdlib/test/timer_SUITE.erl b/lib/stdlib/test/timer_SUITE.erl index bea2b3fb2a..ae32d98807 100644 --- a/lib/stdlib/test/timer_SUITE.erl +++ b/lib/stdlib/test/timer_SUITE.erl @@ -25,14 +25,11 @@ -include_lib("test_server/include/test_server.hrl"). -%% Test suite for timer module. This is a really nasty test it runs a -%% lot of timeouts and then checks in the end if any of them was -%% trigggered too early or if any late timeouts was much too -%% late. What should be added is more testing of the interface -%% functions I guess. But I don't have time for that now. +%% Random test of the timer module. This is a really nasty test, as it +%% runs a lot of timeouts and then checks in the end if any of them +%% was triggered too early or if any late timeouts was much too late. %% -%% Expect it to run for at least 5-10 minutes! - +%% Running time on average is about 90 seconds. %% The main test case in this module is "do_big_test", which %% orders a large number of timeouts and measures how @@ -40,15 +37,8 @@ %% also a number of other concurrent processes running "nrev" at the same %% time. The result is analyzed afterwards by trying to check if the %% measured values are reasonable. It is hard to determine what is -%% reasonable on different machines therefore the test can sometimes -%% fail, even though the timer module is ok. I have checked against -%% previous versions of the timer module (which contained bugs) and it -%% seems it fails every time when running the buggy timer modules. -%% -%% The solution is to rewrite the test suite. Possible strategies for a -%% rewrite: smarter math on the measuring data, test cases with varying -%% amount of load. The test suite should also include tests that test the -%% interface of the timer module. +%% reasonable on different machines; therefore the test can sometimes +%% fail, even though the timer module is ok. suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -89,10 +79,7 @@ report_result(Error) -> ?line test_server:fail(Error). big_test(N) -> C = start_collect(), system_time(), system_time(), system_time(), - A1 = element(2, erlang:now()), - A2 = A1 * 3, - A3 = element(3, erlang:now()), - random:seed(A1, A2, A3), + random:seed(erlang:timestamp()), random:uniform(100),random:uniform(100),random:uniform(100), big_loop(C, N, []), @@ -146,7 +133,7 @@ big_loop(C, N, Pids) -> %%Pids2=Pids1, %% wait a little while - timer:sleep(random:uniform(200)*10), + timer:sleep(random:uniform(200)*3), %% spawn zero, one or two nrev to get some load ;-/ Pids3 = start_nrev(Pids2, random:uniform(100)), @@ -166,14 +153,14 @@ start_nrev(Pids, _N) -> start_after_test(Pids, C, 1) -> - TO1 = random:uniform(100)*100, + TO1 = random:uniform(100)*47, [s_a_t(C, TO1)|Pids]; start_after_test(Pids, C, 2) -> - TO1 = random:uniform(100)*100, - TO2 = TO1 div random:uniform(3) + 200, + TO1 = random:uniform(100)*47, + TO2 = TO1 div random:uniform(3) + 101, [s_a_t(C, TO1),s_a_t(C, TO2)|Pids]; start_after_test(Pids, C, N) -> - TO1 = random:uniform(100)*100, + TO1 = random:uniform(100)*47, start_after_test([s_a_t(C, TO1)|Pids], C, N-1). s_a_t(C, TimeOut) -> @@ -199,7 +186,7 @@ a_t(C, TimeOut) -> maybe_start_i_test(Pids, C, 1) -> %% ok do it - TOI = random:uniform(100)*100, + TOI = random:uniform(53)*49, CountI = random:uniform(10) + 3, % at least 4 times [spawn_link(timer_SUITE, i_t, [C, TOI, CountI])|Pids]; maybe_start_i_test(Pids, _C, _) -> @@ -374,9 +361,7 @@ res_combine({error,Es}, [{error,E}|T]) -> system_time() -> - %%element(1, statistics(wall_clock)). - {M,S,U} = erlang:now(), - 1000000000 * M + 1000 * S + (U div 1000). + erlang:monotonic_time(milli_seconds). %% ------------------------------------------------------- %% diff --git a/lib/stdlib/test/timer_simple_SUITE.erl b/lib/stdlib/test/timer_simple_SUITE.erl index dc751aad16..3c7e3c5f25 100644 --- a/lib/stdlib/test/timer_simple_SUITE.erl +++ b/lib/stdlib/test/timer_simple_SUITE.erl @@ -374,7 +374,6 @@ performance(Mod) -> big_test(M) -> Load_Pids = start_nrev(20, M), % Increase if more load wanted :) - apply(M, sleep, [9000]), LPids = spawn_timers(5, M, 10000, 5), apply(M, sleep, [4000]), @@ -483,8 +482,7 @@ append([],X) -> X. system_time() -> - {M,S,U} = erlang:now(), - 1000000*(M*1000000 + S) + U. + erlang:monotonic_time(micro_seconds). %% ------------------------------------------------------- %% diff --git a/lib/stdlib/test/unicode_SUITE.erl b/lib/stdlib/test/unicode_SUITE.erl index 10b29d0d28..613be99ccd 100644 --- a/lib/stdlib/test/unicode_SUITE.erl +++ b/lib/stdlib/test/unicode_SUITE.erl @@ -29,7 +29,13 @@ random_lists/1, roundtrips/1, latin1/1, - exceptions/1, binaries_errors/1]). + exceptions/1, + binaries_errors_limit/1, + ex_binaries_errors_utf8/1, + ex_binaries_errors_utf16_little/1, + ex_binaries_errors_utf16_big/1, + ex_binaries_errors_utf32_little/1, + ex_binaries_errors_utf32_big/1]). init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> Dog=?t:timetrap(?t:minutes(20)), @@ -44,10 +50,17 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [utf8_illegal_sequences_bif, utf16_illegal_sequences_bif, random_lists, roundtrips, - latin1, exceptions, binaries_errors]. + latin1, exceptions, + binaries_errors_limit, + {group,binaries_errors}]. groups() -> - []. + [{binaries_errors,[parallel], + [ex_binaries_errors_utf8, + ex_binaries_errors_utf16_little, + ex_binaries_errors_utf16_big, + ex_binaries_errors_utf32_little, + ex_binaries_errors_utf32_big]}]. init_per_suite(Config) -> Config. @@ -61,15 +74,11 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. -binaries_errors(Config) when is_list(Config) -> +binaries_errors_limit(Config) when is_list(Config) -> setlimit(10), ex_binaries_errors_utf8(Config), setlimit(default), - ex_binaries_errors_utf8(Config), - ex_binaries_errors_utf16_little(Config), - ex_binaries_errors_utf16_big(Config), - ex_binaries_errors_utf32_little(Config), - ex_binaries_errors_utf32_big(Config). + ok. ex_binaries_errors_utf8(Config) when is_list(Config) -> %% Original smoke test, we should not forget the original offset... @@ -102,109 +111,84 @@ ex_binaries_errors_utf8(Config) when is_list(Config) -> ok. ex_binaries_errors_utf16_little(Config) when is_list(Config) -> - BrokenPart = << <<X:16/little>> || X <- lists:seq(16#DC00,16#DFFF) >>, - BrokenSz = byte_size(BrokenPart), - [ begin - OKList = lists:flatten(lists:duplicate(N,lists:seq(1,255))), - OKBin = unicode:characters_to_binary(OKList,unicode,{utf16,little}), - OKLen = length(OKList), - %% Copy to avoid that the binary get's writable - PartlyBroken = binary:copy(<<OKBin/binary, BrokenPart/binary>>), - PBSz = byte_size(PartlyBroken), - {error,OKList,DeepBrokenPart} = - unicode:characters_to_list(PartlyBroken,{utf16,little}), - BrokenPart = iolist_to_binary(DeepBrokenPart), - [ begin - NewList = lists:nthtail(X, OKList), - NewSz = byte_size(unicode:characters_to_binary(NewList,unicode,{utf16,little})) + - BrokenSz, - Chomped = binary:part(PartlyBroken,PBSz - NewSz, NewSz), - true = (binary:referenced_byte_size(Chomped) =:= PBSz), - {error,NewList,DeepBrokenPart2} = - unicode:characters_to_list(Chomped,{utf16,little}), - BrokenPart = iolist_to_binary(DeepBrokenPart2) - end || X <- lists:seq(1,OKLen) ] - end || N <- lists:seq(1,16,3) ], - ok. + ex_binaries_errors_utf16(little). + ex_binaries_errors_utf16_big(Config) when is_list(Config) -> - BrokenPart = << <<X:16/big>> || X <- lists:seq(16#DC00,16#DFFF) >>, + ex_binaries_errors_utf16(big). + +ex_binaries_errors_utf16(Endian) -> + BrokenSeq = lists:seq(16#DC00, 16#DFFF), + BrokenPart = case Endian of + little -> + << <<X:16/little>> || X <- BrokenSeq >>; + big -> + << <<X:16/big>> || X <- BrokenSeq >> + end, BrokenSz = byte_size(BrokenPart), + Seq255 = lists:seq(1, 255), [ begin - OKList = lists:flatten(lists:duplicate(N,lists:seq(1,255))), - OKBin = unicode:characters_to_binary(OKList,unicode,{utf16,big}), - OKLen = length(OKList), - %% Copy to avoid that the binary get's writable - PartlyBroken = binary:copy(<<OKBin/binary, BrokenPart/binary>>), + OKList = lists:append(lists:duplicate(N, Seq255)), + OKBin = unicode:characters_to_binary(OKList, unicode, {utf16,Endian}), + PartlyBroken = iolist_to_binary([OKBin,BrokenPart]), PBSz = byte_size(PartlyBroken), {error,OKList,DeepBrokenPart} = - unicode:characters_to_list(PartlyBroken,{utf16,big}), + unicode:characters_to_list(PartlyBroken, {utf16,Endian}), BrokenPart = iolist_to_binary(DeepBrokenPart), - [ begin - NewList = lists:nthtail(X, OKList), - NewSz = byte_size(unicode:characters_to_binary(NewList,unicode,{utf16,big})) + - BrokenSz, - Chomped = binary:part(PartlyBroken,PBSz - NewSz, NewSz), - true = (binary:referenced_byte_size(Chomped) =:= PBSz), - {error,NewList,DeepBrokenPart2} = - unicode:characters_to_list(Chomped,{utf16,big}), - BrokenPart = iolist_to_binary(DeepBrokenPart2) - end || X <- lists:seq(1,OKLen) ] - end || N <- lists:seq(1,16,3) ], + utf16_inner_loop(OKList, BrokenPart, BrokenSz, + PartlyBroken, PBSz, Endian) + end || N <- lists:seq(1, 16, 3) ], + ok. + +utf16_inner_loop([_|List], BrokenPart, BrokenSz, PartlyBroken, PBSz, Endian) -> + Sz = length(List)*2 + BrokenSz, + Chomped = binary:part(PartlyBroken, PBSz - Sz, Sz), + true = binary:referenced_byte_size(Chomped) =:= PBSz, + {error,List,DeepBrokenPart} = + unicode:characters_to_list(Chomped, {utf16,Endian}), + BrokenPart = iolist_to_binary(DeepBrokenPart), + utf16_inner_loop(List, BrokenPart, BrokenSz, PartlyBroken, PBSz, Endian); +utf16_inner_loop([], _, _, _, _, _) -> ok. ex_binaries_errors_utf32_big(Config) when is_list(Config) -> - BrokenPart = << <<X:32/big>> || X <- lists:seq(16#DC00,16#DFFF) >>, - BrokenSz = byte_size(BrokenPart), - [ begin - OKList = lists:flatten(lists:duplicate(N,lists:seq(1,255))), - OKBin = unicode:characters_to_binary(OKList,unicode,{utf32,big}), - OKLen = length(OKList), - %% Copy to avoid that the binary get's writable - PartlyBroken = binary:copy(<<OKBin/binary, BrokenPart/binary>>), - PBSz = byte_size(PartlyBroken), - {error,OKList,DeepBrokenPart} = - unicode:characters_to_list(PartlyBroken,{utf32,big}), - BrokenPart = iolist_to_binary(DeepBrokenPart), - [ begin - NewList = lists:nthtail(X, OKList), - NewSz = byte_size(unicode:characters_to_binary(NewList,unicode,{utf32,big})) + - BrokenSz, - Chomped = binary:part(PartlyBroken,PBSz - NewSz, NewSz), - true = (binary:referenced_byte_size(Chomped) =:= PBSz), - {error,NewList,DeepBrokenPart2} = - unicode:characters_to_list(Chomped,{utf32,big}), - BrokenPart = iolist_to_binary(DeepBrokenPart2) - end || X <- lists:seq(1,OKLen) ] - end || N <- lists:seq(1,16,3) ], - ok. + ex_binaries_errors_utf32(big). ex_binaries_errors_utf32_little(Config) when is_list(Config) -> - BrokenPart = << <<X:32/little>> || X <- lists:seq(16#DC00,16#DFFF) >>, + ex_binaries_errors_utf32(little). + +ex_binaries_errors_utf32(Endian) -> + BrokenSeq = lists:seq(16#DC00, 16#DFFF), + BrokenPart = case Endian of + little -> + << <<X:32/little>> || X <- BrokenSeq >>; + big -> + << <<X:32/big>> || X <- BrokenSeq >> + end, BrokenSz = byte_size(BrokenPart), + Seq255 = lists:seq(1, 255), [ begin - OKList = lists:flatten(lists:duplicate(N,lists:seq(1,255))), - OKBin = unicode:characters_to_binary(OKList,unicode,{utf32,little}), - OKLen = length(OKList), - %% Copy to avoid that the binary get's writable - PartlyBroken = binary:copy(<<OKBin/binary, BrokenPart/binary>>), + OKList = lists:append(lists:duplicate(N, Seq255)), + OKBin = unicode:characters_to_binary(OKList, unicode, {utf32,Endian}), + PartlyBroken = iolist_to_binary([OKBin,BrokenPart]), PBSz = byte_size(PartlyBroken), {error,OKList,DeepBrokenPart} = - unicode:characters_to_list(PartlyBroken,{utf32,little}), + unicode:characters_to_list(PartlyBroken, {utf32,Endian}), BrokenPart = iolist_to_binary(DeepBrokenPart), - [ begin - NewList = lists:nthtail(X, OKList), - NewSz = byte_size(unicode:characters_to_binary(NewList,unicode,{utf32,little})) + - BrokenSz, - Chomped = binary:part(PartlyBroken,PBSz - NewSz, NewSz), - true = (binary:referenced_byte_size(Chomped) =:= PBSz), - {error,NewList,DeepBrokenPart2} = - unicode:characters_to_list(Chomped,{utf32,little}), - BrokenPart = iolist_to_binary(DeepBrokenPart2) - end || X <- lists:seq(1,OKLen) ] - end || N <- lists:seq(1,16,3) ], + utf32_inner_loop(OKList, BrokenPart, BrokenSz, + PartlyBroken, PBSz, Endian) + end || N <- lists:seq(1, 16, 3) ], ok. - +utf32_inner_loop([_|List], BrokenPart, BrokenSz, PartlyBroken, PBSz, Endian) -> + Sz = length(List)*4 + BrokenSz, + Chomped = binary:part(PartlyBroken, PBSz - Sz, Sz), + true = binary:referenced_byte_size(Chomped) =:= PBSz, + {error,List,DeepBrokenPart} = + unicode:characters_to_list(Chomped, {utf32,Endian}), + BrokenPart = iolist_to_binary(DeepBrokenPart), + utf32_inner_loop(List, BrokenPart, BrokenSz, PartlyBroken, PBSz, Endian); +utf32_inner_loop([], _, _, _, _, _) -> + ok. exceptions(Config) when is_list(Config) -> setlimit(10), diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl index a57641ef62..08243f7c4f 100644 --- a/lib/stdlib/test/zip_SUITE.erl +++ b/lib/stdlib/test/zip_SUITE.erl @@ -23,7 +23,7 @@ bad_zip/1, unzip_from_binary/1, unzip_to_binary/1, zip_to_binary/1, unzip_options/1, zip_options/1, list_dir_options/1, aliases/1, - openzip_api/1, zip_api/1, unzip_jar/1, + openzip_api/1, zip_api/1, open_leak/1, unzip_jar/1, compress_control/1, foldl/1]). @@ -38,7 +38,7 @@ all() -> [borderline, atomic, bad_zip, unzip_from_binary, unzip_to_binary, zip_to_binary, unzip_options, zip_options, list_dir_options, aliases, openzip_api, - zip_api, unzip_jar, compress_control, foldl]. + zip_api, open_leak, unzip_jar, compress_control, foldl]. groups() -> []. @@ -84,7 +84,7 @@ borderline_test(Size, TempDir) -> io:format("Testing size ~p", [Size]), %% Create a file and archive it. - {_, _, X0} = erlang:now(), + {_, _, X0} = erlang:timestamp(), file:write_file(Name, random_byte_list(X0, Size)), {ok, Archive} = zip:zip(Archive, [Name]), ok = file:delete(Name), @@ -318,8 +318,46 @@ zip_api(Config) when is_list(Config) -> %% Clean up. delete_files([Names]), + ok. + +open_leak(doc) -> + ["Test that zip doesn't leak processes and ports where the " + "controlling process dies without closing an zip opened with " + "zip:zip_open/1."]; +open_leak(suite) -> []; +open_leak(Config) when is_list(Config) -> + %% Create a zip archive + Zip = "zip.zip", + {ok, Zip} = zip:zip(Zip, [], []), + + %% Open archive in a another process that dies immediately. + ZipSrv = spawn_zip(Zip, [memory]), + + %% Expect the ZipSrv process to die soon after. + true = spawned_zip_dead(ZipSrv), + + %% Clean up. + delete_files([Zip]), + ok. +spawn_zip(Zip, Options) -> + Self = self(), + spawn(fun() -> Self ! zip:zip_open(Zip, Options) end), + receive + {ok, ZipSrv} -> + ZipSrv + end. + +spawned_zip_dead(ZipSrv) -> + Ref = monitor(process, ZipSrv), + receive + {'DOWN', Ref, _, ZipSrv, _} -> + true + after 1000 -> + false + end. + unzip_options(doc) -> ["Test options for unzip, only cwd and file_list currently"]; unzip_options(suite) -> @@ -568,7 +606,7 @@ zip_to_binary(Config) when is_list(Config) -> aliases(doc) -> ["Test using the aliases, extract/2, table/2 and create/3"]; aliases(Config) when is_list(Config) -> - {_, _, X0} = erlang:now(), + {_, _, X0} = erlang:timestamp(), Size = 100, B = list_to_binary(random_byte_list(X0, Size)), %% create diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk index 5be130bac9..f57f31c8de 100644 --- a/lib/stdlib/vsn.mk +++ b/lib/stdlib/vsn.mk @@ -1 +1 @@ -STDLIB_VSN = 2.3 +STDLIB_VSN = 2.4 diff --git a/lib/syntax_tools/doc/src/notes.xml b/lib/syntax_tools/doc/src/notes.xml index b0f11bb243..408f6d5bac 100644 --- a/lib/syntax_tools/doc/src/notes.xml +++ b/lib/syntax_tools/doc/src/notes.xml @@ -31,6 +31,21 @@ <p>This document describes the changes made to the Syntax_Tools application.</p> +<section><title>Syntax_Tools 1.6.18</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix bad format of error in epp_dodger:parse_file/3</p> + <p> + Own Id: OTP-12406</p> + </item> + </list> + </section> + +</section> + <section><title>Syntax_Tools 1.6.17</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl index 3ca7a8197e..39c522fd11 100644 --- a/lib/syntax_tools/src/epp_dodger.erl +++ b/lib/syntax_tools/src/epp_dodger.erl @@ -454,7 +454,7 @@ io_error(L, Desc) -> {L, ?MODULE, Desc}. start_pos([T | _Ts], _L) -> - element(2, T); + erl_anno:line(element(2, T)); start_pos([], L) -> L. diff --git a/lib/syntax_tools/src/erl_recomment.erl b/lib/syntax_tools/src/erl_recomment.erl index 7b2f9f7adb..72e1e2d2f5 100644 --- a/lib/syntax_tools/src/erl_recomment.erl +++ b/lib/syntax_tools/src/erl_recomment.erl @@ -123,7 +123,6 @@ recomment_forms(Tree, Cs, Insert) -> form_list -> Tree1 = erl_syntax:flatten_form_list(Tree), Node = build_tree(Tree1), - %% Here we make a small assumption about the substructure of %% a `form_list' tree: it has exactly one group of subtrees. [Node1] = node_subtrees(Node), @@ -753,7 +752,13 @@ get_line(Node) -> {_, L, _} when is_integer(L) -> L; Pos -> - exit({bad_position, Pos}) + try erl_anno:line(Pos) of + Line -> + Line + catch + _:_ -> + exit({bad_position, Pos}) + end end. diff --git a/lib/syntax_tools/vsn.mk b/lib/syntax_tools/vsn.mk index 673362d01d..1c42ef0ddb 100644 --- a/lib/syntax_tools/vsn.mk +++ b/lib/syntax_tools/vsn.mk @@ -1 +1 @@ -SYNTAX_TOOLS_VSN = 1.6.17 +SYNTAX_TOOLS_VSN = 1.6.18 diff --git a/lib/test_server/doc/src/Makefile b/lib/test_server/doc/src/Makefile index 8c7fa99886..421079ac94 100644 --- a/lib/test_server/doc/src/Makefile +++ b/lib/test_server/doc/src/Makefile @@ -27,6 +27,10 @@ include ../../vsn.mk VSN=$(TEST_SERVER_VSN) APPLICATION=test_server +DOC_EXTRA_FRONT_PAGE_INFO=Important note: \ +The Test Server application is obsolete and will be removed \ +in the next major OTP release + # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- diff --git a/lib/test_server/doc/src/notes.xml b/lib/test_server/doc/src/notes.xml index 68dc1fec88..e996d2b4a3 100644 --- a/lib/test_server/doc/src/notes.xml +++ b/lib/test_server/doc/src/notes.xml @@ -32,6 +32,73 @@ <file>notes.xml</file> </header> +<section><title>Test_Server 3.8.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + If the last expression in a test case causes a timetrap + timeout, the stack trace is ignored and not printed to + the test case log file. This happens because the + {Suite,TestCase,Line} info is not available in the stack + trace in this scenario, due to tail call elimination. + Common Test has been modified to handle this situation by + inserting a {Suite,TestCase,last_expr} tuple in the + correct place and printing the stack trace as expected.</p> + <p> + Own Id: OTP-12697 Aux Id: seq12848 </p> + </item> + </list> + </section> + +</section> + +<section><title>Test_Server 3.8</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + When installing test suites in a cross compilation + environment, ts_install was not able to read the values + of the environment variables specified in the + configuration file. This has been fixed.</p> + <p> + Own Id: OTP-11441</p> + </item> + <item> + <p> + Printouts by means of ct:log/2/3 or ct:pal/2/3 from the + hook functions on_tc_fail/2 and on_tc_skip/2 would (quite + unexpectedly) end up in the "unexpected i/o" log file + instead of in the test case log file. This behaviour has + been changed so that now, all printouts (including stdio + printouts) from these hook functions will be routed to + the test case log file.</p> + <p> + Own Id: OTP-12468</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The format of the information printed on top of the test + case (and configuration function) log file has been + slightly modified, mainly in order to make the start + configuration data easier to read and interpret.</p> + <p> + Own Id: OTP-12518 Aux Id: seq12808 </p> + </item> + </list> + </section> + +</section> + <section><title>Test_Server 3.7.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/test_server/src/erl2html2.erl b/lib/test_server/src/erl2html2.erl index 7cfaa2c325..2e443c7b8b 100644 --- a/lib/test_server/src/erl2html2.erl +++ b/lib/test_server/src/erl2html2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -117,9 +117,11 @@ parse_preprocessed_file(Epp,File,InCorrectFile) -> parse_preprocessed_file(Epp,File,true); {attribute,_,file,{_OtherFile,_}} -> parse_preprocessed_file(Epp,File,false); - {function,L,F,A,[_|C]} when InCorrectFile -> - Clauses = [{clause,CL} || {clause,CL,_,_,_} <- C], - [{atom_to_list(F),A,L} | Clauses] ++ + {function,L,F,A,Cs} when InCorrectFile -> + {CLs,LastCL} = find_clause_lines(Cs, []), + Clauses = [{clause,get_line(CL)} || + {clause,CL,_,_,_} <- tl(CLs)], + [{atom_to_list(F),A,get_line(L),get_line(LastCL)} | Clauses] ++ parse_preprocessed_file(Epp,File,true); _ -> parse_preprocessed_file(Epp,File,InCorrectFile) @@ -146,9 +148,11 @@ parse_non_preprocessed_file(Epp, File, Location) -> case epp_dodger:parse_form(Epp, Location) of {ok,Tree,Location1} -> try erl_syntax:revert(Tree) of - {function,L,F,A,[_|C]} -> - Clauses = [{clause,CL} || {clause,CL,_,_,_} <- C], - [{atom_to_list(F),A,L} | Clauses] ++ + {function,L,F,A,Cs} -> + {CLs,LastCL} = find_clause_lines(Cs, []), + Clauses = [{clause,get_line(CL)} || + {clause,CL,_,_,_} <- tl(CLs)], + [{atom_to_list(F),A,get_line(L),get_line(LastCL)} | Clauses] ++ parse_non_preprocessed_file(Epp, File, Location1); _ -> parse_non_preprocessed_file(Epp, File, Location1) @@ -161,23 +165,52 @@ parse_non_preprocessed_file(Epp, File, Location) -> [] end. +get_line(Anno) -> + erl_anno:line(Anno). + +%%%----------------------------------------------------------------- +%%% Find the line number of the last expression in the function +find_clause_lines([{clause,CL,_Params,_Op,Exprs}], CLs) -> % last clause + try tuple_to_list(lists:last(Exprs)) of + [_Type,ExprLine | _] -> + {lists:reverse([{clause,CL}|CLs]), ExprLine}; + _ -> + {lists:reverse([{clause,CL}|CLs]), CL} + catch + _:_ -> + {lists:reverse([{clause,CL}|CLs]), CL} + end; + +find_clause_lines([{clause,CL,_Params,_Op,_Exprs} | Cs], CLs) -> + find_clause_lines(Cs, [{clause,CL}|CLs]). + %%%----------------------------------------------------------------- %%% Add a link target for each line and one for each function definition. -build_html(SFd,DFd,Encoding,Functions) -> - build_html(SFd,DFd,Encoding,file:read_line(SFd),1,Functions,false). +build_html(SFd,DFd,Encoding,FuncsAndCs) -> + build_html(SFd,DFd,Encoding,file:read_line(SFd),1,FuncsAndCs, + false,undefined). -build_html(SFd,DFd,Encoding,{ok,Str},L,[{F,A,L}|Functions],_IsFuncDef) -> +%% function start line found +build_html(SFd,DFd,Enc,{ok,Str},L0,[{F,A,L0,LastL}|FuncsAndCs], + _IsFuncDef,_FAndLastL) -> FALink = test_server_ctrl:uri_encode(F++"-"++integer_to_list(A),utf8), - file:write(DFd,["<a name=\"",to_raw_list(FALink,Encoding),"\"/>"]), - build_html(SFd,DFd,Encoding,{ok,Str},L,Functions,true); -build_html(SFd,DFd,Encoding,{ok,Str},L,[{clause,L}|Functions],_IsFuncDef) -> - build_html(SFd,DFd,Encoding,{ok,Str},L,Functions,true); -build_html(SFd,DFd,Encoding,{ok,Str},L,Functions,IsFuncDef) -> + file:write(DFd,["<a name=\"",to_raw_list(FALink,Enc),"\"/>"]), + build_html(SFd,DFd,Enc,{ok,Str},L0,FuncsAndCs,true,{F,LastL}); +%% line of last expression in function found +build_html(SFd,DFd,Enc,{ok,Str},LastL,FuncsAndCs,_IsFuncDef,{F,LastL}) -> + LastLineLink = test_server_ctrl:uri_encode(F++"-last_expr",utf8), + file:write(DFd,["<a name=\"", + to_raw_list(LastLineLink,Enc),"\"/>"]), + build_html(SFd,DFd,Enc,{ok,Str},LastL,FuncsAndCs,true,undefined); +build_html(SFd,DFd,Enc,{ok,Str},L,[{clause,L}|FuncsAndCs], + _IsFuncDef,FAndLastL) -> + build_html(SFd,DFd,Enc,{ok,Str},L,FuncsAndCs,true,FAndLastL); +build_html(SFd,DFd,Enc,{ok,Str},L,FuncsAndCs,IsFuncDef,FAndLastL) -> LStr = line_number(L), Str1 = line(Str,IsFuncDef), file:write(DFd,[LStr,Str1]), - build_html(SFd,DFd,Encoding,file:read_line(SFd),L+1,Functions,false); -build_html(_SFd,_DFd,_Encoding,eof,L,_Functions,_IsFuncDef) -> + build_html(SFd,DFd,Enc,file:read_line(SFd),L+1,FuncsAndCs,false,FAndLastL); +build_html(_SFd,_DFd,_Enc,eof,L,_FuncsAndCs,_IsFuncDef,_FAndLastL) -> L. line_number(L) -> diff --git a/lib/test_server/src/test_server.app.src b/lib/test_server/src/test_server.app.src index 173f7075db..5538e8b851 100644 --- a/lib/test_server/src/test_server.app.src +++ b/lib/test_server/src/test_server.app.src @@ -34,5 +34,5 @@ {env, []}, {runtime_dependencies, ["tools-2.6.14","stdlib-2.0","runtime_tools-1.8.14", "observer-2.0","kernel-3.0","inets-5.10", - "syntax_tools-1.6.16","erts-6.0"]}]}. + "syntax_tools-1.6.16","erts-7.0"]}]}. diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 0e685a2d8a..7cb9c4bb5a 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -404,15 +404,6 @@ run_test_case_apply({CaseNum,Mod,Func,Args,Name, }). run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> - {ok,Cwd} = file:get_cwd(), - Args2Print = case Args of - [Args1] when is_list(Args1) -> - lists:keydelete(tc_group_result, 1, Args1); - _ -> - Args - end, - print(minor, "Test case started with:\n~w:~w(~tp)\n", [Mod,Func,Args2Print]), - print(minor, "Current directory is ~tp\n", [Cwd]), print_timestamp(minor,"Started at "), print(minor, "", [], internal_raw), TCCallback = get(test_server_testcase_callback), @@ -687,7 +678,7 @@ handle_tc_exit(Reason, #st{status=tc,config=Config0,mf={Mod,Func},pid=Pid}=St) Msg = {E,AbortReason}, {Msg,Loc0,Msg}; Other -> - {Other,unknown,Other} + {{'EXIT',Other},unknown,Other} end, Timeout = end_conf_timeout(Reason, St), Config = [{tc_status,{failed,F}}|Config0], @@ -701,7 +692,7 @@ handle_tc_exit(Reason, #st{config=Config,mf={Mod,Func0},pid=Pid, {testcase_aborted=E,AbortReason,Loc0} -> {{E,AbortReason},Loc0}; Other -> - {Other,St#st.last_known_loc} + {{'EXIT',Other},St#st.last_known_loc} end, Func = case Status of init_per_testcase=F -> {F,Func0}; @@ -738,18 +729,16 @@ do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) -> EndConfApply = fun() -> timetrap(TVal), - case catch apply(Mod, - end_per_testcase, - [Func,Conf]) of - {'EXIT',Why} -> + try apply(Mod,end_per_testcase,[Func,Conf]) of + _ -> ok + catch + _:Why -> timer:sleep(1), group_leader() ! {printout,12, "WARNING! " "~w:end_per_testcase(~w, ~p)" " crashed!\n\tReason: ~p\n", - [Mod,Func,Conf,Why]}; - _ -> - ok + [Mod,Func,Conf,Why]} end, Supervisor ! {self(),end_conf} end, @@ -778,13 +767,11 @@ spawn_fw_call(Mod,{init_per_testcase,Func},CurrConf,Pid, Skip = {skip,{failed,{Mod,init_per_testcase,Why}}}, %% if init_per_testcase fails, the test case %% should be skipped - case catch do_end_tc_call(Mod,Func, - {Pid,Skip,[CurrConf]}, - Why) of - {'EXIT',FwEndTCErr} -> - exit({fw_notify_done,end_tc,FwEndTCErr}); - _ -> - ok + try do_end_tc_call(Mod,Func, {Pid,Skip,[CurrConf]}, Why) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) end, %% finished, report back SendTo ! {self(),fw_notify_done, @@ -812,12 +799,12 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, " failed!\n\tReason: timetrap timeout" " after ~w ms!\n", [Mod,Func,EndConf,TVal]}, FailLoc = proplists:get_value(tc_fail_loc, EndConf), - case catch do_end_tc_call(Mod,Func, + try do_end_tc_call(Mod,Func, {Pid,Report,[EndConf]}, Why) of - {'EXIT',FwEndTCErr} -> - exit({fw_notify_done,end_tc,FwEndTCErr}); - _ -> - ok + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) end, Warn = "<font color=\"red\">" "WARNING: end_per_testcase timed out!</font>", @@ -853,21 +840,21 @@ spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> end, FwCall = fun() -> - case catch fw_error_notify(Mod,Func1,[], - Error,Loc) of - {'EXIT',FwErrorNotifyErr} -> + try fw_error_notify(Mod,Func1,[], + Error,Loc) of + _ -> ok + catch + _:FwErrorNotifyErr -> exit({fw_notify_done,error_notification, - FwErrorNotifyErr}); - _ -> - ok + FwErrorNotifyErr}) end, Conf = [{tc_status,{failed,Error}}|CurrConf], - case catch do_end_tc_call(Mod,Func1, - {Pid,Error,[Conf]},Error) of - {'EXIT',FwEndTCErr} -> - exit({fw_notify_done,end_tc,FwEndTCErr}); - _ -> - ok + try do_end_tc_call(Mod,Func1, + {Pid,Error,[Conf]},Error) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) end, %% finished, report back SendTo ! {self(),fw_notify_done,{died,Error,Loc,[],undefined}} @@ -1326,12 +1313,30 @@ get_loc(Pid) -> Stk = [rewrite_loc_item(Loc) || Loc <- Stk0], case get(test_server_loc) of [{Suite,Case}] -> - %% location info unknown, check if {Suite,Case,Line} - %% is available in stacktrace. and if so, use stacktrace - %% instead of current test_server_loc + %% Location info unknown, check if {Suite,Case,Line} + %% is available in stacktrace and if so, use stacktrace + %% instead of current test_server_loc. + %% If location is the last expression in a test case + %% function, the info is not available due to tail call + %% elimination. We need to check if the test case has been + %% called by ts_tc/3 and, if so, insert the test case info + %% at that position. case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of - [match|_] -> put(test_server_loc, Stk); - _ -> ok + [match|_] -> + put(test_server_loc, Stk); + _ -> + {PreTC,PostTC} = + lists:splitwith(fun({test_server,ts_tc,_}) -> + false; + (_) -> + true + end, Stk), + if PostTC == [] -> + ok; + true -> + put(test_server_loc, + PreTC++[{Suite,Case,last_expr} | PostTC]) + end end; _ -> put(test_server_loc, Stk) @@ -1358,8 +1363,8 @@ fw_error_notify(Mod, Func, Args, Error, Loc) -> %% Just like io:format, except that depending on the Detail value, the output %% is directed to console, major and/or minor log files. -print(Detail,Format,Args) -> - test_server_ctrl:print(Detail, Format, Args). +%% print(Detail,Format,Args) -> +%% test_server_ctrl:print(Detail, Format, Args). print(Detail,Format,Args,Printer) -> test_server_ctrl:print(Detail, Format, Args, Printer). @@ -1393,9 +1398,12 @@ lookup_config(Key,Config) -> undefined end. -%% timer:tc/3 +%% +%% IMPORTANT: get_loc/1 uses the name of this function when analysing +%% stack traces. If the name changes, get_loc/1 must be updated! +%% ts_tc(M, F, A) -> - Before = erlang:now(), + Before = erlang:monotonic_time(), Result = try apply(M, F, A) catch @@ -1415,12 +1423,8 @@ ts_tc(M, F, A) -> {'EXIT',Reason} end end, - After = erlang:now(), - Elapsed = - (element(1,After)*1000000000000 - +element(2,After)*1000000+element(3,After)) - - (element(1,Before)*1000000000000 - +element(2,Before)*1000000+element(3,Before)), + After = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(After-Before, native, micro_seconds), {Elapsed, Result}. set_loc(Stk) -> @@ -1839,7 +1843,7 @@ time_ms_check(Other) -> time_ms_apply(Func, TCPid, MultAndScale) -> {_,GL} = process_info(TCPid, group_leader), WhoAmI = self(), % either TC or IO server - T0 = now(), + T0 = erlang:monotonic_time(), UserTTSup = spawn(fun() -> user_timetrap_supervisor(Func, WhoAmI, TCPid, @@ -1872,7 +1876,8 @@ user_timetrap_supervisor(Func, Spawner, TCPid, GL, T0, MultAndScale) -> receive {UserTT,Result} -> demonitor(MonRef, [flush]), - Elapsed = trunc(timer:now_diff(now(), T0) / 1000), + T1 = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(T1-T0, native, milli_seconds), try time_ms_check(Result) of TimeVal -> %% this is the new timetrap value to set (return value @@ -1940,7 +1945,7 @@ update_user_timetraps(TCPid, StartTime) -> proplists:delete(TCPid, UserTTs)), proceed; {OtherUserTTSup,OtherStartTime} -> - case timer:now_diff(OtherStartTime, StartTime) of + case OtherStartTime - StartTime of Diff when Diff >= 0 -> ignore; _ -> @@ -2395,9 +2400,8 @@ is_release_available(Release) -> %% run_on_shielded_node(Fun, CArgs) when is_function(Fun), is_list(CArgs) -> - {A,B,C} = now(), - Name = "shielded_node-" ++ integer_to_list(A) ++ "-" ++ integer_to_list(B) - ++ "-" ++ integer_to_list(C), + Nr = erlang:unique_integer([positive]), + Name = "shielded_node-" ++ integer_to_list(Nr), Node = case start_node(Name, slave, [{args, "-hidden " ++ CArgs}]) of {ok, N} -> N; Err -> fail({failed_to_start_shielded_node, Err}) @@ -2456,9 +2460,8 @@ is_cover(Name) -> %% A filename of the form <Stem><Number> is generated, and the %% function checks that that file doesn't already exist. temp_name(Stem) -> - {A,B,C} = erlang:now(), - RandomNum = A bxor B bxor C, - RandomName = Stem ++ integer_to_list(RandomNum), + Num = erlang:unique_integer([positive]), + RandomName = Stem ++ integer_to_list(Num), {ok,Files} = file:list_dir(filename:dirname(Stem)), case lists:member(RandomName,Files) of true -> diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index 488f38d05d..d0c8a1ebe8 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -99,7 +99,7 @@ -define(last_link, "last_link"). -define(last_test, "last_test"). -define(html_ext, ".html"). --define(now, erlang:now()). +-define(now, os:timestamp()). -define(void_fun, fun() -> ok end). -define(mod_result(X), if X == skip -> skipped; @@ -1204,19 +1204,14 @@ init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels, report_severe_error(Reason) -> test_server_sup:framework_call(report, [severe_error,Reason]). -%% timer:tc/3 -ts_tc(M, F, A) -> - Before = ?now, - Val = (catch apply(M, F, A)), - After = ?now, - Elapsed = elapsed_time(Before, After), - {Elapsed,Val}. - -elapsed_time(Before, After) -> - (element(1,After)*1000000000000 + - element(2,After)*1000000 + element(3,After)) - - (element(1,Before)*1000000000000 + - element(2,Before)*1000000 + element(3,Before)). +ts_tc(M,F,A) -> + Before = erlang:monotonic_time(), + Result = (catch apply(M, F, A)), + After = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(After-Before, + native, + micro_seconds), + {Elapsed, Result}. start_extra_tools(ExtraTools) -> start_extra_tools(ExtraTools, []). @@ -1808,20 +1803,37 @@ start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA) -> put(test_server_minor_footer, Footer), io:put_chars(Fd, Header), + io:put_chars(Fd, "<a name=\"top\"></a>"), + io:put_chars(Fd, "<pre>\n"), + SrcListing = downcase(atom_to_list(Mod)) ++ ?src_listing_ext, - case {filelib:is_file(filename:join(LogDir, SrcListing)), - lists:member(no_src, get(test_server_logopts))} of - {true,false} -> - print(Lev, "<a href=\"~ts#~ts\">source code for ~w:~w/1</a>\n", - [uri_encode(SrcListing), - uri_encode(atom_to_list(Func)++"-1",utf8), - Mod,Func]); + + case get_fw_mod(?MODULE) of + Mod when Func == error_in_suite -> + ok; _ -> - ok + {Info,Arity} = + if Func == init_per_suite; Func == end_per_suite -> + {"Config function: ", 1}; + Func == init_per_group; Func == end_per_group -> + {"Config function: ", 2}; + true -> + {"Test case: ", 1} + end, + + case {filelib:is_file(filename:join(LogDir, SrcListing)), + lists:member(no_src, get(test_server_logopts))} of + {true,false} -> + print(Lev, Info ++ "<a href=\"~ts#~ts\">~w:~w/~w</a> " + "(click for source code)\n", + [uri_encode(SrcListing), + uri_encode(atom_to_list(Func)++"-1",utf8), + Mod,Func,Arity]); + _ -> + print(Lev, Info ++ "~w:~w/~w\n", [Mod,Func,Arity]) + end end, - io:put_chars(Fd, "<pre>\n"), - AbsName. stop_minor_log_file() -> @@ -2013,7 +2025,7 @@ add_init_and_end_per_suite([{conf,_,_,{Mod,_}}=Case|Cases], LastMod, PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, NextRef, FwMod)]; add_init_and_end_per_suite([SkipCase|Cases], LastMod, LastRef, FwMod) - when element(1,SkipCase) == skip_case -> + when element(1,SkipCase) == skip_case; element(1,SkipCase) == auto_skip_case-> [SkipCase|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]; add_init_and_end_per_suite([{conf,_,_,_}=Case|Cases], LastMod, LastRef, FwMod) -> [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]; @@ -2478,7 +2490,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, file:set_cwd(filename:dirname(get(test_server_dir))), After = ?now, Before = get(test_server_parallel_start_time), - Elapsed = elapsed_time(Before, After)/1000000, + Elapsed = timer:now_diff(After, Before)/1000000, put(test_server_total_time, Elapsed), {false,tl(Mode0),undefined,Elapsed, update_status(Ref, OkSkipFail, Status)}; @@ -2487,7 +2499,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, %% parallel group (io buffering is active) OkSkipFail = wait_for_cases(Ref), queue_test_case_io(Ref, self(), 0, Mod, Func), - Elapsed = elapsed_time(conf_start(Ref, Mode0),?now)/1000000, + Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000, case CurrIOHandler of {Ref,_} -> %% current_io_handler was set by start conf of this @@ -2504,12 +2516,12 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, %% this is an end conf for a non-parallel group that's not %% nested under a parallel group, so no need to buffer io {false,tl(Mode0),undefined, - elapsed_time(conf_start(Ref, Mode0),?now)/1000000, Status}; + timer:now_diff(?now, conf_start(Ref, Mode0))/1000000, Status}; {Ref,_} -> %% this is an end conf for a non-parallel group nested under %% a parallel group (io buffering is active) queue_test_case_io(Ref, self(), 0, Mod, Func), - Elapsed = elapsed_time(conf_start(Ref, Mode0),?now)/1000000, + Elapsed = timer:now_diff(?now, conf_start(Ref, Mode0))/1000000, case CurrIOHandler of {Ref,_} -> %% current_io_handler was set by start conf of this @@ -2564,7 +2576,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0, %% 1. check the TS_RANDOM_SEED env variable %% 2. check random_seed in process state %% 3. use value provided with shuffle option - %% 4. use now() values for seed + %% 4. use timestamp() values for seed case os:getenv("TS_RANDOM_SEED") of Undef when Undef == false ; Undef == "undefined" -> case get(test_server_random_seed) of @@ -3076,13 +3088,11 @@ print_conf_time(ConfTime) -> print(major, "=group_time ~.3fs", [ConfTime]), print(minor, "~n=== Total execution time of group: ~.3fs~n", [ConfTime]). -print_props(_, []) -> +print_props([]) -> ok; -print_props(true, Props) -> +print_props(Props) -> print(major, "=group_props ~p", [Props]), - print(minor, "Group properties: ~p~n", [Props]); -print_props(_, _) -> - ok. + print(minor, "Group properties: ~p~n", [Props]). %% repeat N times: {repeat,N} %% repeat N times or until all successful: {repeat_until_all_ok,N} @@ -3687,7 +3697,6 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, print(major, "=case ~w:~w", [Mod, Func]), MinorName = start_minor_log_file(Mod, Func, self() /= Main), - print(minor, "<a name=\"top\"></a>", [], internal_raw), MinorBase = filename:basename(MinorName), print(major, "=logfile ~ts", [filename:basename(MinorName)]), @@ -3701,8 +3710,8 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, RunDir = filename:dirname(MinorName), Ext = if Num == 0 -> - {_,S,Us} = now(), - lists:flatten(io_lib:format(".~w.~w", [S,Us])); + Nr = erlang:unique_integer([positive]), + lists:flatten(io_lib:format(".~w", [Nr])); true -> lists:flatten(io_lib:format(".~w", [Num])) end, @@ -3720,7 +3729,20 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, [tc_start,{{Mod,{Func,GrName}}, MinorName}]), - print_props((RunInit==skip_init), get_props(Mode)), + {ok,Cwd} = file:get_cwd(), + Args2Print = if is_list(UpdatedArgs) -> + lists:keydelete(tc_group_result, 1, UpdatedArgs); + true -> + UpdatedArgs + end, + if RunInit == skip_init -> + print_props(get_props(Mode)); + true -> + ok + end, + print(minor, "Config value:\n\n ~tp\n", [Args2Print]), + print(minor, "Current directory is ~tp\n", [Cwd]), + GrNameStr = case GrName of undefined -> ""; Name -> cast_to_list(Name) @@ -3929,8 +3951,8 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time, "<td>~ts~ts</td></tr>\n", [Time,Color,ReasonStr2,Comment1]), FormatLoc = test_server_sup:format_loc(Loc), - print(minor, "=== location ~ts", [FormatLoc]), - print(minor, "=== reason = ~ts", [ReasonStr1]), + print(minor, "=== Location: ~ts", [FormatLoc]), + print(minor, "=== Reason: ~ts", [ReasonStr1]), Ret; progress(failed, CaseNum, Mod, Func, GrName, Loc, timetrap_timeout, T, @@ -3955,8 +3977,8 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, timetrap_timeout, T, "<td>~ts</td></tr>\n", [T/1000,Comment]), FormatLoc = test_server_sup:format_loc(Loc), - print(minor, "=== location ~ts", [FormatLoc]), - print(minor, "=== reason = timetrap timeout", []), + print(minor, "=== Location: ~ts", [FormatLoc]), + print(minor, "=== Reason: timetrap timeout", []), failed; progress(failed, CaseNum, Mod, Func, GrName, Loc, {testcase_aborted,Reason}, _T, @@ -3981,13 +4003,13 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, {testcase_aborted,Reason}, _T, "<td>~ts</td></tr>\n", [Comment]), FormatLoc = test_server_sup:format_loc(Loc), - print(minor, "=== location ~ts", [FormatLoc]), - print(minor, "=== reason = {testcase_aborted,~p}", [Reason]), + print(minor, "=== Location: ~ts", [FormatLoc]), + print(minor, "=== Reason: {testcase_aborted,~p}", [Reason]), failed; progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time, Comment0, {St0,St1}) -> - print(major, "=result failed: ~p, ~w", [Reason,unknown]), + print(major, "=result failed: ~p, ~w", [Reason,unknown_location]), print(1, "*** FAILED ~ts ***", [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName}, @@ -4016,14 +4038,21 @@ progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time, "<td><font color=\"red\">FAILED</font></td>" "<td>~ts</td></tr>\n", [TimeStr,Comment]), - print(minor, "=== location ~w", [unknown]), + print(minor, "=== Location: ~w", [unknown]), {FStr,FormattedReason} = format_exception(Reason), - print(minor, "=== reason = " ++ FStr, [FormattedReason]), + print(minor, "=== Reason: " ++ FStr, [FormattedReason]), failed; progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time, Comment0, {St0,St1}) -> - print(major, "=result failed: ~p, ~p", [Reason,Loc]), + {LocMaj,LocMin} = if Func == error_in_suite -> + case get_fw_mod(undefined) of + Mod -> {unknown_location,unknown}; + _ -> {Loc,Loc} + end; + true -> {Loc,Loc} + end, + print(major, "=result failed: ~p, ~p", [Reason,LocMaj]), print(1, "*** FAILED ~ts ***", [get_info_str(Mod,Func, CaseNum, get(test_server_cases))]), test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName}, @@ -4036,16 +4065,16 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time, "" -> ""; _ -> xhtml("<br>","<br />") ++ to_string(Comment0) end, - FormatLastLoc = test_server_sup:format_loc(get_last_loc(Loc)), + FormatLastLoc = test_server_sup:format_loc(get_last_loc(LocMaj)), print(html, "<td>" ++ St0 ++ "~ts" ++ St1 ++ "</td>" "<td><font color=\"red\">FAILED</font></td>" "<td><font color=\"red\">~ts</font>~ts</td></tr>\n", [TimeStr,FormatLastLoc,Comment]), - FormatLoc = test_server_sup:format_loc(Loc), - print(minor, "=== location ~ts", [FormatLoc]), + FormatLoc = test_server_sup:format_loc(LocMin), + print(minor, "=== Location: ~ts", [FormatLoc]), {FStr,FormattedReason} = format_exception(Reason), - print(minor, "=== reason = " ++ FStr, [FormattedReason]), + print(minor, "=== Reason: " ++ FStr, [FormattedReason]), failed; progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time, @@ -4074,7 +4103,7 @@ progress(ok, _CaseNum, Mod, Func, GrName, _Loc, RetVal, Time, "<td><font color=\"green\">Ok</font></td>" "~ts</tr>\n", [Time,Comment]), - print(minor, "=== returned value = ~p", [RetVal]), + print(minor, "=== Returned value: ~p", [RetVal]), ok. %%-------------------------------------------------------------------- @@ -4662,10 +4691,10 @@ collect_cases({make,InitMFA,CaseList,FinMFA}, St0, Mode) -> collect_cases({Module, Cases}, St, Mode) when is_list(Cases) -> case (catch collect_case(Cases, St#cc{mod=Module}, [], Mode)) of - {ok, NewCases, NewSt} -> - {ok, NewCases, NewSt}; + Result = {ok,_,_} -> + Result; Other -> - {error, Other} + {error,Other} end; collect_cases({_Mod,_Case}=Spec, St, Mode) -> @@ -4683,9 +4712,9 @@ collect_case({Mod,{conf,_,_,_,_}=Conf}, St, Mode) -> collect_case(MFA, St, Mode) -> case in_skip_list(MFA, St#cc.skip) of - {true,Comment} -> + {true,Comment} when Comment /= make_failed -> {ok,[{skip_case,{MFA,Comment},Mode}],St}; - false -> + _ -> case MFA of {Mod,Case} -> collect_case_invoke(Mod, Case, MFA, St, Mode); {_Mod,_Case,_Args} -> {ok,[MFA],St} @@ -4747,17 +4776,25 @@ collect_case_subcases(Mod, Case, SubCases, St0, Mode) -> collect_files(Dir, Pattern, St, Mode) -> {ok,Cwd} = file:get_cwd(), Dir1 = filename:join(Cwd, Dir), - Wc = filename:join([Dir1,Pattern++code:objfile_extension()]), + Wc = filename:join([Dir1,Pattern++"{.erl,"++code:objfile_extension()++"}"]), case catch filelib:wildcard(Wc) of {'EXIT', Reason} -> io:format("Could not collect files: ~p~n", [Reason]), {error,{collect_fail,Dir,Pattern}}; - Mods0 -> - Mods = [{path_to_module(Mod),all} || Mod <- lists:sort(Mods0)], - collect_cases(Mods, St, Mode) + Files -> + %% convert to module names and remove duplicates + Mods = lists:foldl(fun(File, Acc) -> + Mod = fullname_to_mod(File), + case lists:member(Mod, Acc) of + true -> Acc; + false -> [Mod | Acc] + end + end, [], Files), + Tests = [{Mod,all} || Mod <- lists:sort(Mods)], + collect_cases(Tests, St, Mode) end. -path_to_module(Path) when is_list(Path) -> +fullname_to_mod(Path) when is_list(Path) -> %% If this is called with a binary, then we are probably in +fnu %% mode and have found a beam file with name encoded as latin1. We %% will let this crash since it can not work to load such a module diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index acd47788db..9d87eca07e 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -618,9 +618,8 @@ do_quote_progname([Prog,Arg|Args]) -> end. random_element(L) -> - {A,B,C} = now(), - E = lists:sum([A,B,C]) rem length(L), - lists:nth(E+1, L). + random:seed(os:timestamp()), + lists:nth(random:uniform(length(L)), L). find_release(latest) -> "/usr/local/otp/releases/latest/bin/erl"; diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 96e369a138..7d92bc902a 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -61,33 +61,37 @@ timetrap(Timeout0, ReportTVal, Scale, Pid) -> TruncTO = trunc(Timeout), receive after TruncTO -> - case is_process_alive(Pid) of - true -> - TimeToReport = if Timeout0 == ReportTVal -> TruncTO; - true -> ReportTVal end, - MFLs = test_server:get_loc(Pid), - Mon = erlang:monitor(process, Pid), - Trap = {timetrap_timeout,TimeToReport,MFLs}, - exit(Pid, Trap), - receive - {'DOWN', Mon, process, Pid, _} -> - ok - after 10000 -> - %% Pid is probably trapping exits, hit it harder... - catch error_logger:warning_msg( - "Testcase process ~w not " - "responding to timetrap " - "timeout:~n" - " ~p.~n" - "Killing testcase...~n", - [Pid, Trap]), - exit(Pid, kill) - end; - false -> + kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) + end. + +kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) -> + case is_process_alive(Pid) of + true -> + TimeToReport = if Timeout0 == ReportTVal -> TruncTO; + true -> ReportTVal end, + MFLs = test_server:get_loc(Pid), + Mon = erlang:monitor(process, Pid), + Trap = {timetrap_timeout,TimeToReport,MFLs}, + exit(Pid, Trap), + receive + {'DOWN', Mon, process, Pid, _} -> ok - end + after 10000 -> + %% Pid is probably trapping exits, hit it harder... + catch error_logger:warning_msg( + "Testcase process ~w not " + "responding to timetrap " + "timeout:~n" + " ~p.~n" + "Killing testcase...~n", + [Pid, Trap]), + exit(Pid, kill) + end; + false -> + ok end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% timetrap_cancel(Handle) -> ok %% Handle = term() @@ -121,14 +125,8 @@ messages_get(Msgs) -> end. timecall(M, F, A) -> - Befor = erlang:now(), - Val = apply(M, F, A), - After = erlang:now(), - Elapsed = - (element(1,After)*1000000+element(2,After)+element(3,After)/1000000)- - (element(1,Befor)*1000000+element(2,Befor)+element(3,Befor)/1000000), - {Elapsed, Val}. - + {Elapsed, Val} = timer:tc(M, F, A), + {Elapsed / 1000000, Val}. call_crash(Time,Crash,M,F,A) -> @@ -812,10 +810,19 @@ format_loc1({Mod,Func,Line}) -> case {lists:member(no_src, get(test_server_logopts)), lists:reverse(ModStr)} of {false,[$E,$T,$I,$U,$S,$_|_]} -> - io_lib:format("{~w,~w,<a href=\"~ts~ts#~w\">~w</a>}", + Link = if is_integer(Line) -> + integer_to_list(Line); + Line == last_expr -> + list_to_atom(atom_to_list(Func)++"-last_expr"); + is_atom(Line) -> + atom_to_list(Line); + true -> + Line + end, + io_lib:format("{~w,~w,<a href=\"~ts~ts#~s\">~w</a>}", [Mod,Func, test_server_ctrl:uri_encode(downcase(ModStr)), - ?src_listing_ext,Line,Line]); + ?src_listing_ext,Link,Line]); _ -> io_lib:format("{~w,~w,~w}",[Mod,Func,Line]) end. @@ -874,9 +881,8 @@ unique_name() -> util_loop(State) -> receive {From,unique_name} -> - {_,S,Us} = now(), - Ms = trunc(Us/1000), - Name = lists:flatten(io_lib:format("~w.~w", [S,Ms])), + Nr = erlang:unique_integer([positive]), + Name = integer_to_list(Nr), if Name == State#util_state.latest_name -> timer:sleep(1), self() ! {From,unique_name}, diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index d6d2e865e2..469593e947 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -24,15 +24,20 @@ -module(ts). --export([run/0, run/1, run/2, run/3, run/4, run/5, - tests/0, tests/1, +-export([cl_run/1, + run/0, run/1, run/2, run/3, run/4, run/5, + run_category/1, run_category/2, run_category/3, + tests/0, tests/1, suites/1, categories/1, install/0, install/1, - bench/0, bench/1, bench/2, benchmarks/0, - smoke_test/0, smoke_test/1,smoke_test/2, smoke_tests/0, estone/0, estone/1, cross_cover_analyse/1, compile_testcases/0, compile_testcases/1, help/0]). + +%% Functions kept for backwards compatibility +-export([bench/0, bench/1, bench/2, benchmarks/0, + smoke_test/0, smoke_test/1,smoke_test/2, smoke_tests/0]). + -export([i/0, l/1, r/0, r/1, r/2, r/3]). %%%---------------------------------------------------------------------- @@ -82,10 +87,13 @@ -define( install_help, [ - " ts:install() - Install TS with no Options.\n" - " ts:install([Options]) - Install TS with Options\n" + " ts:install()\n", + " Install ts with no options.\n", + "\n", + " ts:install(Options)\n", + " Install ts with a list of options, see below.\n", "\n", - "Installation options supported:\n", + "Installation options supported:\n\n", " {longnames, true} - Use fully qualified hostnames\n", " {verbose, Level} - Sets verbosity level for TS output (0,1,2), 0 is\n" " quiet(default).\n" @@ -110,21 +118,64 @@ help() -> end. help(uninstalled) -> - H = ["TS is not installed yet. To install use:\n\n"], + H = ["ts is not yet installed. To install use:\n\n"], show_help([H,?install_help]); help(installed) -> - H = ["Run functions:\n", - " ts:run() - Run all available tests.\n", - " ts:run(Spec) - Run all tests in given test spec file.\n", - " The spec file is actually ../*_test/Spec.spec\n", - " ts:run([Specs]) - Run all tests in all given test spec files.\n", - " ts:run(Spec, Mod) - Run a single test suite.\n", - " ts:run(Spec, Mod, Case)\n", - " - Run a single test case.\n", - " All above run functions can have an additional Options argument\n", - " which is a list of options.\n", + H = ["\n", + "Run functions:\n\n", + " ts:run()\n", + " Run the tests for all apps. The tests are defined by the\n", + " main test specification for each app: ../App_test/App.spec.\n", + "\n", + " ts:run(Apps)\n", + " Apps = atom() | [atom()]\n", + " Run the tests for an app, or set of apps. The tests are\n", + " defined by the main test specification for each app:\n", + " ../App_test/App.spec.\n", + "\n", + " ts:run(App, Suites)\n", + " App = atom(), Suites = atom() | [atom()]\n", + " Run one or more test suites for App (i.e. modules named\n", + " *_SUITE.erl, located in ../App_test/).\n", + "\n", + " ts:run(App, Suite, TestCases)\n", + " App = atom(), Suite = atom(),\n", + " TestCases = TCs | {testcase,TCs}, TCs = atom() | [atom()]\n", + " Run one or more test cases (functions) in Suite.\n", + "\n", + " ts:run(App, Suite, {group,Groups})\n", + " App = atom(), Suite = atom(), Groups = atom() | [atom()]\n", + " Run one or more test case groups in Suite.\n", + "\n", + " ts:run(App, Suite, {group,Group}, {testcase,TestCases})\n", + " App = atom(), Suite = atom(), Group = atom(),\n", + " TestCases = atom() | [atom()]\n", + " Run one or more test cases in a test case group in Suite.\n", + "\n", + " ts:run_category(TestCategory)\n", + " TestCategory = smoke | essential | bench | atom()\n", + " Run the specified category of tests for all apps.\n", + " For each app, the tests are defined by the specification:\n", + " ../App_test/App_TestCategory.spec.\n", + "\n", + " ts:run_category(Apps, TestCategory)\n", + " Apps = atom() | [atom()],\n", + " TestCategory = smoke | essential | bench | atom()\n", + " Run the specified category of tests for the given app or apps.\n", "\n", - "Run options supported:\n", + " Note that the test category parameter may have arbitrary value,\n", + " but should correspond to an existing test specification with file\n", + " name: ../App_test/App_TestCategory.spec.\n", + " Predefined categories exist for smoke tests, essential tests and\n", + " benchmark tests. The corresponding specs are:\n", + " ../*_test/Spec_smoke.spec, ../*_test/Spec_essential.spec and\n", + " ../*_test/Spec_bench.spec.\n", + "\n", + " All above run functions can take an additional last argument,\n", + " Options, which is a list of options (e.g. ts:run(App, Options),\n", + " or ts:run_category(Apps, TestCategory, Options)).\n", + "\n", + "Run options supported:\n\n", " batch - Do not start a new xterm\n", " {verbose, Level} - Same as the verbosity option for install\n", " verbose - Same as {verbose, 1}\n", @@ -143,47 +194,46 @@ help(installed) -> " files are. The default location is\n" " tests/test_server/.\n" "\n", - "Supported trace information elements\n", + "Supported trace information elements:\n\n", " {tp | tpl, Mod, [] | match_spec()}\n", " {tp | tpl, Mod, Func, [] | match_spec()}\n", " {tp | tpl, Mod, Func, Arity, [] | match_spec()}\n", " {ctp | ctpl, Mod}\n", " {ctp | ctpl, Mod, Func}\n", " {ctp | ctpl, Mod, Func, Arity}\n", + "\n\n", + "Support functions:\n\n", + " ts:tests()\n", + " Returns all apps available for testing.\n", + "\n", + " ts:tests(TestCategory)\n", + " Returns all apps that provide tests in the given category.\n", + "\n", + " ts:suites(App)\n", + " Returns all available test suites for App,\n", + " i.e. ../App_test/*_SUITE.erl\n", + "\n", + " ts:categories(App)\n", + " Returns all test categories available for App.\n", "\n", - "Support functions:\n", - " ts:tests() - Shows all available families of tests.\n", - " ts:tests(Spec) - Shows all available test modules in Spec,\n", - " i.e. ../Spec_test/*_SUITE.erl\n", - " ts:estone() - Run estone_SUITE in kernel application with\n" - " no run options\n", - " ts:estone(Opts) - Run estone_SUITE in kernel application with\n" - " the given run options\n", - " ts:cross_cover_analyse(Level)\n" - " - Used after ts:run with option cover or \n" - " cover_details. Analyses modules specified with\n" - " a 'cross' statement in the cover spec file.\n" - " Level can be 'overview' or 'details'.\n", - " ts:compile_testcases()~n" - " ts:compile_testcases(Apps)~n" - " - Compile all testcases for usage in a cross ~n" - " compile environment." - " \n" - "Benchmark functions:\n" - " ts:benchmarks() - Get all available families of benchmarks\n" - " ts:bench() - Runs all benchmarks\n" - " ts:bench(Spec) - Runs all benchmarks in the given spec file.\n" - " The spec file is actually ../*_test/Spec_bench.spec\n\n" - " ts:bench can take the same Options argument as ts:run.\n" - "Smoke test functions:\n" - " ts:smoke_tests() - Get all available families of smoke tests\n" - " ts:smoke_test() - Runs all smoke tests\n" - " ts:smoke_test(Spec)\n" - " - Runs all smoke tests in the given spec file.\n" - " The spec file is actually ../*_test/Spec_smoke.spec\n\n" - " ts:smoke_test can take the same Options argument as ts:run.\n" - "\n" - "Installation (already done):\n" + " ts:estone()\n", + " Runs estone_SUITE in the kernel application with no run options\n", + "\n", + " ts:estone(Opts)\n", + " Runs estone_SUITE in the kernel application with the given\n", + " run options\n", + "\n", + " ts:cross_cover_analyse(Level)\n", + " Use after ts:run with option cover or cover_details. Analyses\n", + " modules specified with a 'cross' statement in the cover spec file.\n", + " Level can be 'overview' or 'details'.\n", + "\n", + " ts:compile_testcases()\n", + " ts:compile_testcases(Apps)\n", + " Compiles all test cases for the given apps, for usage in a\n", + " cross compilation environment.\n", + "\n\n", + "Installation (already done):\n\n" ], show_help([H,?install_help]). @@ -212,86 +262,128 @@ run_all(_Vars) -> run_some([], _Opts) -> ok; -run_some([{Spec,Mod}|Specs], Opts) -> - case run(Spec, Mod, Opts) of +run_some([{App,Mod}|Apps], Opts) -> + case run(App, Mod, Opts) of ok -> ok; - Error -> io:format("~p: ~p~n",[{Spec,Mod},Error]) + Error -> io:format("~p: ~p~n",[{App,Mod},Error]) end, - run_some(Specs, Opts); -run_some([Spec|Specs], Opts) -> - case run(Spec, Opts) of + run_some(Apps, Opts); +run_some([App|Apps], Opts) -> + case run(App, Opts) of ok -> ok; - Error -> io:format("~p: ~p~n",[Spec,Error]) + Error -> io:format("~p: ~p~n",[App,Error]) end, - run_some(Specs, Opts). + run_some(Apps, Opts). + +%% This can be used from command line. Both App and +%% TestCategory must be specified. App may be 'all' +%% and TestCategory may be 'main'. Examples: +%% erl -s ts cl_run kernel smoke <options> +%% erl -s ts cl_run kernel main <options> +%% erl -s ts cl_run all essential <options> +%% erl -s ts cl_run all main <options> +%% When using the 'main' category and running with cover, +%% one can also use the cross_cover_analysis flag. +cl_run([App,Cat|Options0]) when is_atom(App) -> -%% Runs one test spec (interactive). -run(Testspec) when is_atom(Testspec) -> - Options=check_test_get_opts(Testspec, []), - File = atom_to_list(Testspec), - run_test(File, [{spec,[File++".spec"]}], Options); - -%% This can be used from command line, e.g. -%% erl -s ts run all_tests <config> -%% When using the all_tests flag and running with cover, one can also -%% use the cross_cover_analysis flag. -run([all_tests|Config0]) -> AllAtomsFun = fun(X) when is_atom(X) -> true; (_) -> false end, - Config1 = - case lists:all(AllAtomsFun,Config0) of + Options1 = + case lists:all(AllAtomsFun, Options0) of true -> %% Could be from command line - lists:map(fun(Conf)->to_erlang_term(Conf) end,Config0)--[batch]; + lists:map(fun(Opt) -> + to_erlang_term(Opt) + end, Options0) -- [batch]; false -> - Config0--[batch] + Options0 -- [batch] end, %% Make sure there is exactly one occurence of 'batch' - Config2 = [batch|Config1], - - R = run(tests(),Config2), - - case check_for_cross_cover_analysis_flag(Config2) of + Options2 = [batch|Options1], + + Result = + case {App,Cat} of + {all,main} -> + run(tests(), Options2); + {all,Cat} -> + run_category(Cat, Options2); + {_,main} -> + run(App, Options2); + {_,Cat} -> + run_category(App, Cat, Options2) + end, + case check_for_cross_cover_analysis_flag(Options2) of false -> ok; Level -> cross_cover_analyse(Level) end, + Result. - R; +%% run/1 +%% Runs tests for one app (interactive). +run(App) when is_atom(App) -> + Options = check_test_get_opts(App, []), + File = atom_to_list(App), + run_test(File, [{spec,[File++".spec"]},{allow_user_terms,true}], Options); -%% ts:run(ListOfTests) -run(List) when is_list(List) -> - run(List, [batch]). - -run(List, Opts) when is_list(List), is_list(Opts) -> - run_some(List, Opts); +%% This can be used from command line, e.g. +%% erl -s ts run all <options> +%% erl -s ts run main <options> +run([all,main|Opts]) -> + cl_run([all,main|Opts]); +run([all|Opts]) -> + cl_run([all,main|Opts]); +run([main|Opts]) -> + cl_run([all,main|Opts]); +%% Backwards compatible +run([all_tests|Opts]) -> + cl_run([all,main|Opts]); + +%% run/1 +%% Runs the main tests for all available apps +run(Apps) when is_list(Apps) -> + run(Apps, [batch]). %% run/2 -%% Runs one test spec with list of suites or with options -run(Testspec, ModsOrConfig) when is_atom(Testspec), - is_list(ModsOrConfig) -> - case is_list_of_suites(ModsOrConfig) of +%% Runs the main tests for all available apps +run(Apps, Opts) when is_list(Apps), is_list(Opts) -> + run_some(Apps, Opts); + +%% Runs tests for one app with list of suites or with options +run(App, ModsOrOpts) when is_atom(App), + is_list(ModsOrOpts) -> + case is_list_of_suites(ModsOrOpts) of false -> - run(Testspec, {config_list,ModsOrConfig}); + run(App, {opts_list,ModsOrOpts}); true -> - run_some([{Testspec,M} || M <- ModsOrConfig], + run_some([{App,M} || M <- ModsOrOpts], [batch]) end; -run(Testspec, {config_list,Config}) -> - Options=check_test_get_opts(Testspec, Config), - IsSmoke=proplists:get_value(smoke,Config), - File=atom_to_list(Testspec), + +run(App, {opts_list,Opts}) -> + Options = check_test_get_opts(App, Opts), + File = atom_to_list(App), + + %% check if other test category than main has been specified + {CatSpecName,TestCat} = + case proplists:get_value(test_category, Opts) of + undefined -> + {"",main}; + Cat -> + {"_" ++ atom_to_list(Cat),Cat} + end, + WhatToDo = - case Testspec of + case App of %% Known to exist but fails generic tests below emulator -> test; system -> test; erl_interface -> test; epmd -> test; _ -> - case code:lib_dir(Testspec) of + case code:lib_dir(App) of {error,bad_name} -> %% Application does not exist skip; @@ -313,92 +405,167 @@ run(Testspec, {config_list,Config}) -> end end end, - Spec = - case WhatToDo of - skip -> - create_skip_spec(Testspec, tests(Testspec)); - test when IsSmoke -> - File++"_smoke.spec"; - test -> - File++".spec" - end, - run_test(File, [{spec,[Spec]}], Options); -%% Runs one module in a spec (interactive) -run(Testspec, Mod) when is_atom(Testspec), is_atom(Mod) -> - run_test({atom_to_list(Testspec),Mod}, + case WhatToDo of + skip -> + SkipSpec = create_skip_spec(App, suites(App)), + run_test(File, [{spec,[SkipSpec]}], Options); + test when TestCat == bench -> + check_and_run(fun(Vars) -> + ts_benchmark:run([App], Options, Vars) + end); + test -> + Spec = File ++ CatSpecName ++ ".spec", + run_test(File, [{spec,[Spec]},{allow_user_terms,true}], Options) + end; + +%% Runs one module for an app (interactive) +run(App, Mod) when is_atom(App), is_atom(Mod) -> + run_test({atom_to_list(App),Mod}, [{suite,Mod}], [interactive]). %% run/3 -%% Run one module in a spec with Config -run(Testspec, Mod, Config) when is_atom(Testspec), - is_atom(Mod), - is_list(Config) -> - Options=check_test_get_opts(Testspec, Config), - run_test({atom_to_list(Testspec),Mod}, +%% Run one module for an app with Opts +run(App, Mod, Opts) when is_atom(App), + is_atom(Mod), + is_list(Opts) -> + Options = check_test_get_opts(App, Opts), + run_test({atom_to_list(App),Mod}, [{suite,Mod}], Options); -%% Run multiple modules with Config -run(Testspec, Mods, Config) when is_atom(Testspec), - is_list(Mods), - is_list(Config) -> - run_some([{Testspec,M} || M <- Mods], Config); + +%% Run multiple modules with Opts +run(App, Mods, Opts) when is_atom(App), + is_list(Mods), + is_list(Opts) -> + run_some([{App,M} || M <- Mods], Opts); + %% Runs one test case in a module. -run(Testspec, Mod, Case) when is_atom(Testspec), - is_atom(Mod), - is_atom(Case) -> - Options=check_test_get_opts(Testspec, []), +run(App, Mod, Case) when is_atom(App), + is_atom(Mod), + is_atom(Case) -> + Options = check_test_get_opts(App, []), Args = [{suite,Mod},{testcase,Case}], - run_test(atom_to_list(Testspec), Args, Options); + run_test(atom_to_list(App), Args, Options); + %% Runs one or more groups in a module. -run(Testspec, Mod, Grs={group,_Groups}) when is_atom(Testspec), - is_atom(Mod) -> - Options=check_test_get_opts(Testspec, []), +run(App, Mod, Grs={group,_Groups}) when is_atom(App), + is_atom(Mod) -> + Options = check_test_get_opts(App, []), Args = [{suite,Mod},Grs], - run_test(atom_to_list(Testspec), Args, Options); + run_test(atom_to_list(App), Args, Options); + %% Runs one or more test cases in a module. -run(Testspec, Mod, TCs={testcase,_Cases}) when is_atom(Testspec), - is_atom(Mod) -> - Options=check_test_get_opts(Testspec, []), +run(App, Mod, TCs={testcase,_Cases}) when is_atom(App), + is_atom(Mod) -> + Options = check_test_get_opts(App, []), Args = [{suite,Mod},TCs], - run_test(atom_to_list(Testspec), Args, Options). + run_test(atom_to_list(App), Args, Options). %% run/4 %% Run one test case in a module with Options. -run(Testspec, Mod, Case, Config) when is_atom(Testspec), - is_atom(Mod), - is_atom(Case), - is_list(Config) -> - Options=check_test_get_opts(Testspec, Config), +run(App, Mod, Case, Opts) when is_atom(App), + is_atom(Mod), + is_atom(Case), + is_list(Opts) -> + Options = check_test_get_opts(App, Opts), Args = [{suite,Mod},{testcase,Case}], - run_test(atom_to_list(Testspec), Args, Options); + run_test(atom_to_list(App), Args, Options); + %% Run one or more test cases in a module with Options. -run(Testspec, Mod, {testcase,Cases}, Config) when is_atom(Testspec), - is_atom(Mod) -> - run(Testspec, Mod, Cases, Config); -run(Testspec, Mod, Cases, Config) when is_atom(Testspec), - is_atom(Mod), - is_list(Cases), - is_list(Config) -> - Options=check_test_get_opts(Testspec, Config), +run(App, Mod, {testcase,Cases}, Opts) when is_atom(App), + is_atom(Mod) -> + run(App, Mod, Cases, Opts); +run(App, Mod, Cases, Opts) when is_atom(App), + is_atom(Mod), + is_list(Cases), + is_list(Opts) -> + Options = check_test_get_opts(App, Opts), Args = [{suite,Mod},Cases], - run_test(atom_to_list(Testspec), Args, Options); + run_test(atom_to_list(App), Args, Options); + +%% Run one or more test cases in a group. +run(App, Mod, Gr={group,_Group}, {testcase,Cases}) when is_atom(App), + is_atom(Mod) -> + run(App, Mod, Gr, Cases, [batch]); + + %% Run one or more groups in a module with Options. -run(Testspec, Mod, Grs={group,_Groups}, Config) when is_atom(Testspec), - is_atom(Mod) -> - Options=check_test_get_opts(Testspec, Config), +run(App, Mod, Grs={group,_Groups}, Opts) when is_atom(App), + is_atom(Mod), + is_list(Opts) -> + Options = check_test_get_opts(App, Opts), Args = [{suite,Mod},Grs], - run_test(atom_to_list(Testspec), Args, Options). + run_test(atom_to_list(App), Args, Options). %% run/5 %% Run one or more test cases in a group with Options. -run(Testspec, Mod, Group, Cases, Config) when is_atom(Testspec), - is_atom(Mod), - is_list(Config) -> +run(App, Mod, Group, Cases, Opts) when is_atom(App), + is_atom(Mod), + is_list(Opts) -> Group1 = if is_tuple(Group) -> Group; true -> {group,Group} end, Cases1 = if is_tuple(Cases) -> Cases; true -> {testcase,Cases} end, - Options=check_test_get_opts(Testspec, Config), + Options = check_test_get_opts(App, Opts), Args = [{suite,Mod},Group1,Cases1], - run_test(atom_to_list(Testspec), Args, Options). + run_test(atom_to_list(App), Args, Options). + +%% run_category/1 +run_category(TestCategory) when is_atom(TestCategory) -> + run_category(TestCategory, [batch]). + +%% run_category/2 +run_category(TestCategory, Opts) when is_atom(TestCategory), + is_list(Opts) -> + case ts:tests(TestCategory) of + [] -> + {error, no_tests_available}; + Apps -> + Opts1 = [{test_category,TestCategory} | Opts], + run_some(Apps, Opts1) + end; + +run_category(Apps, TestCategory) when is_atom(TestCategory) -> + run_category(Apps, TestCategory, [batch]). + +%% run_category/3 +run_category(App, TestCategory, Opts) -> + Apps = if is_atom(App) -> [App]; + is_list(App) -> App + end, + Opts1 = [{test_category,TestCategory} | Opts], + run_some(Apps, Opts1). + +%%----------------------------------------------------------------- +%% Functions kept for backwards compatibility + +bench() -> + run_category(bench, []). +bench(Opts) when is_list(Opts) -> + run_category(bench, Opts); +bench(App) -> + run_category(App, bench, []). +bench(App, Opts) when is_atom(App) -> + run_category(App, bench, Opts); +bench(Apps, Opts) when is_list(Apps) -> + run_category(Apps, bench, Opts). + +benchmarks() -> + tests(bench). + +smoke_test() -> + run_category(smoke, []). +smoke_test(Opts) when is_list(Opts) -> + run_category(smoke, Opts); +smoke_test(App) -> + run_category(App, smoke, []). +smoke_test(App, Opts) when is_atom(App) -> + run_category(App, smoke, Opts); +smoke_test(Apps, Opts) when is_list(Apps) -> + run_category(Apps, smoke, Opts). + +smoke_tests() -> + tests(smoke). + +%%----------------------------------------------------------------- is_list_of_suites(List) -> lists:all(fun(Suite) -> @@ -416,29 +583,29 @@ is_list_of_suites(List) -> %% Create a spec to skip all SUITES, this is used when the application %% to be tested is not part of the OTP release to be tested. -create_skip_spec(Testspec, SuitesToSkip) -> +create_skip_spec(App, SuitesToSkip) -> {ok,Cwd} = file:get_cwd(), - TestspecString = atom_to_list(Testspec), - Specname = TestspecString++"_skip.spec", + AppString = atom_to_list(App), + Specname = AppString++"_skip.spec", {ok,D} = file:open(filename:join([filename:dirname(Cwd), - TestspecString++"_test",Specname]), + AppString++"_test",Specname]), [write]), - TestDir = "\"../"++TestspecString++"_test\"", + TestDir = "\"../"++AppString++"_test\"", io:format(D,"{suites, "++TestDir++", all}.~n",[]), io:format(D,"{skip_suites, "++TestDir++", ~w, \"Skipped as application" " is not in path!\"}.",[SuitesToSkip]), Specname. -%% Check testspec to be valid and get possible Options -%% from the config. -check_test_get_opts(Testspec, Config) -> - validate_test(Testspec), - Mode = configmember(batch, {batch, interactive}, Config), - Vars = configvars(Config), - Trace = get_config(trace,Config), - ConfigPath = get_config(config,Config), - KeepTopcase = configmember(keep_topcase, {keep_topcase,[]}, Config), - Cover = configcover(Testspec,Config), +%% Check testspec for App to be valid and get possible options +%% from the list. +check_test_get_opts(App, Opts) -> + validate_test(App), + Mode = configmember(batch, {batch, interactive}, Opts), + Vars = configvars(Opts), + Trace = get_config(trace,Opts), + ConfigPath = get_config(config,Opts), + KeepTopcase = configmember(keep_topcase, {keep_topcase,[]}, Opts), + Cover = configcover(App,Opts), lists:flatten([Vars,Mode,Trace,KeepTopcase,Cover,ConfigPath]). to_erlang_term(Atom) -> @@ -447,7 +614,7 @@ to_erlang_term(Atom) -> {ok, Term} = erl_parse:parse_term(Tokens), Term. -%% Validate that a Testspec really is a testspec, +%% Validate that Testspec really is a testspec, %% and exit if not. validate_test(Testspec) -> case lists:member(Testspec, tests()) of @@ -460,10 +627,10 @@ validate_test(Testspec) -> exit(self(), {error, test_not_available}) end. -configvars(Config) -> - case lists:keysearch(vars, 1, Config) of +configvars(Opts) -> + case lists:keysearch(vars, 1, Opts) of {value, {vars, List}} -> - List0 = special_vars(Config), + List0 = special_vars(Opts), Key = fun(T) -> element(1,T) end, DelDupList = lists:filter(fun(V) -> @@ -474,17 +641,17 @@ configvars(Config) -> end, List), {vars, [List0|DelDupList]}; _ -> - {vars, special_vars(Config)} + {vars, special_vars(Opts)} end. -%% Allow some shortcuts in the Options... -special_vars(Config) -> +%% Allow some shortcuts in the options... +special_vars(Opts) -> SpecVars = - case lists:member(verbose, Config) of + case lists:member(verbose, Opts) of true -> [{verbose, 1}]; false -> - case lists:keysearch(verbose, 1, Config) of + case lists:keysearch(verbose, 1, Opts) of {value, {verbose, Lvl}} -> [{verbose, Lvl}]; _ -> @@ -492,13 +659,13 @@ special_vars(Config) -> end end, SpecVars1 = - case lists:keysearch(diskless, 1, Config) of + case lists:keysearch(diskless, 1, Opts) of {value,{diskless, true}} -> [{diskless, true} | SpecVars]; _ -> SpecVars end, - case lists:keysearch(testcase_callback, 1, Config) of + case lists:keysearch(testcase_callback, 1, Opts) of {value,{testcase_callback, CBM, CBF}} -> [{ts_testcase_callback, {CBM,CBF}} | SpecVars1]; {value,{testcase_callback, CB}} -> @@ -566,50 +733,31 @@ check_for_cross_cover_analysis_flag([_|Config],Level,CrossFlag) -> check_for_cross_cover_analysis_flag([],_,_) -> false. -%% Returns a list of available test suites. +%% Returns all available apps. tests() -> {ok, Cwd} = file:get_cwd(), ts_lib:specs(Cwd). -tests(Spec) -> +%% Returns all apps that provide tests in the given test category +tests(main) -> {ok, Cwd} = file:get_cwd(), - ts_lib:suites(Cwd, atom_to_list(Spec)). - -%% Benchmark related functions - -bench() -> - bench([]). - -bench(Opts) when is_list(Opts) -> - bench(benchmarks(),Opts); -bench(Spec) -> - bench([Spec],[]). - -bench(Spec, Opts) when is_atom(Spec) -> - bench([Spec],Opts); -bench(Specs, Opts) -> - check_and_run(fun(Vars) -> ts_benchmark:run(Specs, Opts, Vars) end). - -benchmarks() -> - ts_benchmark:benchmarks(). - -smoke_test() -> - smoke_test([]). - -smoke_test(Opts) when is_list(Opts) -> - smoke_test(smoke_tests(),Opts); -smoke_test(Spec) -> - smoke_test([Spec],[]). - -smoke_test(Spec, Opts) when is_atom(Spec) -> - smoke_test([Spec],Opts); -smoke_test(Specs, Opts) -> - run(Specs, [{smoke,true}|Opts]). + ts_lib:specs(Cwd); +tests(bench) -> + ts_benchmark:benchmarks(); +tests(TestCategory) -> + {ok, Cwd} = file:get_cwd(), + ts_lib:specialized_specs(Cwd, atom_to_list(TestCategory)). + +%% Returns a list of available test suites for App. +suites(App) -> + {ok, Cwd} = file:get_cwd(), + ts_lib:suites(Cwd, atom_to_list(App)). -smoke_tests() -> +%% Returns all available test categories for App +categories(App) -> {ok, Cwd} = file:get_cwd(), - ts_lib:specialized_specs(Cwd,"smoke"). + ts_lib:test_categories(Cwd, atom_to_list(App)). %% %% estone/0, estone/1 diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl index bc62015ac3..594e619fbc 100644 --- a/lib/test_server/src/ts_install.erl +++ b/lib/test_server/src/ts_install.erl @@ -18,7 +18,6 @@ %% -module(ts_install). - -export([install/2, platform_id/1]). -include("ts.hrl"). @@ -135,15 +134,63 @@ unix_autoconf(XConf) -> case filelib:is_file(Configure) of true -> OSXEnv = macosx_cflags(), + UnQuotedEnv = assign_vars(unquote(Env++OSXEnv)), io:format("Running ~s~nEnv: ~p~n", - [lists:flatten(Configure ++ Args),Env++OSXEnv]), + [lists:flatten(Configure ++ Args),UnQuotedEnv]), Port = open_port({spawn, lists:flatten(["\"",Configure,"\"",Args])}, - [stream, eof, {env,Env++OSXEnv}]), + [stream, eof, {env,UnQuotedEnv}]), ts_lib:print_data(Port); false -> {error, no_configure_script} end. +unquote([{Var,Val}|T]) -> + [{Var,unquote(Val)}|unquote(T)]; +unquote([]) -> + []; +unquote("\""++Rest) -> + lists:reverse(tl(lists:reverse(Rest))); +unquote(String) -> + String. + +assign_vars([]) -> + []; +assign_vars([{VAR,FlagsStr} | VARs]) -> + [{VAR,assign_vars(FlagsStr)} | assign_vars(VARs)]; +assign_vars(FlagsStr) -> + Flags = [assign_all_vars(Str,[]) || Str <- string:tokens(FlagsStr, [$ ])], + string:strip(lists:flatten(lists:map(fun(Flag) -> + Flag ++ " " + end, Flags)), right). + +assign_all_vars([$$ | Rest], FlagSoFar) -> + {VarName,Rest1} = get_var_name(Rest, []), + assign_all_vars(Rest1, FlagSoFar ++ assign_var(VarName)); +assign_all_vars([Char | Rest], FlagSoFar) -> + assign_all_vars(Rest, FlagSoFar ++ [Char]); +assign_all_vars([], Flag) -> + Flag. + +get_var_name([Ch | Rest] = Str, VarR) -> + case valid_char(Ch) of + true -> get_var_name(Rest, [Ch | VarR]); + false -> {lists:reverse(VarR),Str} + end; +get_var_name([], VarR) -> + {lists:reverse(VarR),[]}. + +assign_var(VarName) -> + case os:getenv(VarName) of + false -> ""; + Val -> Val + end. + +valid_char(Ch) when Ch >= $a, Ch =< $z -> true; +valid_char(Ch) when Ch >= $A, Ch =< $Z -> true; +valid_char(Ch) when Ch >= $0, Ch =< $9 -> true; +valid_char($_) -> true; +valid_char(_) -> false. + get_xcomp_flag(Flag, Flags) -> get_xcomp_flag(Flag, Flag, Flags). get_xcomp_flag(Flag, Tag, Flags) -> diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl index 7746bbed6f..54ca69637e 100644 --- a/lib/test_server/src/ts_install_cth.erl +++ b/lib/test_server/src/ts_install_cth.erl @@ -238,12 +238,15 @@ generate_nodenames2(0, _Hosts, Acc) -> Acc; generate_nodenames2(N, Hosts, Acc) -> Host=lists:nth((N rem (length(Hosts)))+1, Hosts), - Name=list_to_atom(temp_nodename("nod", []) ++ "@" ++ Host), + Name=list_to_atom(temp_nodename("nod",N) ++ "@" ++ Host), generate_nodenames2(N-1, Hosts, [Name|Acc]). -temp_nodename([], Acc) -> - lists:flatten(Acc); -temp_nodename([Chr|Base], Acc) -> - {A,B,C} = erlang:now(), - New = [Chr | integer_to_list(Chr bxor A bxor B+A bxor C+B)], - temp_nodename(Base, [New|Acc]). +%% We cannot use erlang:unique_integer([positive]) +%% here since this code in run on older test releases as well. +temp_nodename(Base,I) -> + {A,B,C} = os:timestamp(), + Nstr = integer_to_list(I), + Astr = integer_to_list(A), + Bstr = integer_to_list(B), + Cstr = integer_to_list(C), + Base++Nstr++Astr++Bstr++Cstr. diff --git a/lib/test_server/src/ts_lib.erl b/lib/test_server/src/ts_lib.erl index 5368960446..d27bc55b3a 100644 --- a/lib/test_server/src/ts_lib.erl +++ b/lib/test_server/src/ts_lib.erl @@ -27,7 +27,7 @@ erlang_type/1, initial_capital/1, specs/1, suites/2, - specialized_specs/2, + test_categories/2, specialized_specs/2, subst_file/3, subst/2, print_data/1, make_non_erlang/2, maybe_atom_to_list/1, progress/4, @@ -96,26 +96,47 @@ specialized_specs(Dir,PostFix) -> Specs = filelib:wildcard(filename:join([filename:dirname(Dir), "*_test", "*_"++PostFix++".spec"])), sort_tests([begin - Base = filename:basename(Name), - list_to_atom(string:substr(Base,1,string:rstr(Base,"_")-1)) + DirPart = filename:dirname(Name), + AppTest = hd(lists:reverse(filename:split(DirPart))), + list_to_atom(string:substr(AppTest, 1, length(AppTest)-5)) end || Name <- Specs]). specs(Dir) -> Specs = filelib:wildcard(filename:join([filename:dirname(Dir), "*_test", "*.{dyn,}spec"])), - % Filter away all spec which end with {_bench,_smoke}.spec - NoBench = fun(SpecName) -> - case lists:reverse(SpecName) of - "ceps.hcneb_"++_ -> false; - "ceps.ekoms_"++_ -> false; - _ -> true - end - end, - - sort_tests([filename_to_atom(Name) || Name <- Specs, NoBench(Name)]). - -suites(Dir, Spec) -> - Glob=filename:join([filename:dirname(Dir), Spec++"_test", + %% Make sure only to include the main spec for each application + MainSpecs = + lists:flatmap(fun(FullName) -> + [Spec,TestDir|_] = + lists:reverse(filename:split(FullName)), + [_TestSuffix|TDParts] = + lists:reverse(string:tokens(TestDir,[$_,$.])), + [_SpecSuffix|SParts] = + lists:reverse(string:tokens(Spec,[$_,$.])), + if TDParts == SParts -> + [filename_to_atom(FullName)]; + true -> + [] + end + end, Specs), + sort_tests(MainSpecs). + +test_categories(Dir, App) -> + Specs = filelib:wildcard(filename:join([filename:dirname(Dir), + App++"_test", "*.spec"])), + lists:flatmap(fun(FullName) -> + [Spec,_TestDir|_] = + lists:reverse(filename:split(FullName)), + case filename:rootname(Spec -- App) of + "" -> + []; + [_Sep | Cat] -> + [list_to_atom(Cat)] + end + end, Specs). + +suites(Dir, App) -> + Glob=filename:join([filename:dirname(Dir), App++"_test", "*_SUITE.erl"]), Suites=filelib:wildcard(Glob), [filename_to_atom(Name) || Name <- Suites]. diff --git a/lib/test_server/vsn.mk b/lib/test_server/vsn.mk index 18d7583c35..2a2ed2b3b0 100644 --- a/lib/test_server/vsn.mk +++ b/lib/test_server/vsn.mk @@ -1 +1 @@ -TEST_SERVER_VSN = 3.7.2 +TEST_SERVER_VSN = 3.8.1 diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml index 6f9563bb68..38b57b73a9 100644 --- a/lib/tools/doc/src/notes.xml +++ b/lib/tools/doc/src/notes.xml @@ -30,6 +30,32 @@ </header> <p>This document describes the changes made to the Tools application.</p> +<section><title>Tools 2.7.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix lcnt sorting and printout of histograms.</p> + <p> + Own Id: OTP-12364</p> + </item> + <item> + <p> Fix a Unicode bug in the <c>tags</c> module. </p> + <p> + Own Id: OTP-12567</p> + </item> + <item> + <p> + Fix tags completion in erlang.el for GNU Emacs 23+</p> + <p> + Own Id: OTP-12583</p> + </item> + </list> + </section> + +</section> + <section><title>Tools 2.7.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index c56759ebb9..3610356355 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -2444,7 +2444,10 @@ This is automagically called by the user level function `indent-region'." ;; Parse the Erlang code from the beginning of the clause to ;; the beginning of the region. (while (< (point) indent-point) - (setq state (erlang-partial-parse (point) indent-point state))) + (let ((pt (point))) + (setq state (erlang-partial-parse pt indent-point state)) + (if (= pt (point)) + (error "Illegal syntax")))) ;; Indent every line in the region (while continue (goto-char indent-point) @@ -2480,8 +2483,11 @@ This is automagically called by the user level function `indent-region'." (if (>= from-end (- (point-max) indent-point)) (setq continue nil) (while (< (point) indent-point) - (setq state (erlang-partial-parse - (point) indent-point state)))))))) + (let ((pt (point))) + (setq state (erlang-partial-parse + pt indent-point state)) + (if (= pt (point)) + (error "Illegal syntax"))))))))) (defun erlang-indent-current-buffer () @@ -2528,7 +2534,10 @@ Return nil if line starts inside string, t if in a comment." (goto-char parse-start) (erlang-beginning-of-clause)) (while (< (point) indent-point) - (setq state (erlang-partial-parse (point) indent-point state))) + (let ((pt (point))) + (setq state (erlang-partial-parse pt indent-point state)) + (if (= pt (point)) + (error "Illegal syntax")))) (erlang-calculate-stack-indent indent-point state)))) (defun erlang-show-syntactic-information () @@ -2698,12 +2707,13 @@ Value is list (stack token-start token-type in-what)." (erlang-push (list '|| token (current-column)) stack) (forward-char 2)) - ;; Bit-syntax open paren - ((looking-at "<<") + ;; Bit-syntax open. Note that map syntax allows "<<" to follow ":=" + ;; or "=>" without intervening whitespace, so handle that case here + ((looking-at "\\(:=\\|=>\\)?<<") (erlang-push (list '<< token (current-column)) stack) - (forward-char 2)) + (forward-char (- (match-end 0) (match-beginning 0)))) - ;; Bbit-syntax close paren + ;; Bit-syntax close ((looking-at ">>") (while (memq (car (car stack)) '(|| ->)) (erlang-pop stack)) @@ -4188,7 +4198,10 @@ This function is designed to be a member of a criteria list." ;; Do not return `stop' when inside a list comprehension ;; construction. (The point must be after `||'). (while (< (point) orig-point) - (setq state (erlang-partial-parse (point) orig-point state))) + (let ((pt (point))) + (setq state (erlang-partial-parse pt orig-point state)) + (if (= pt (point)) + (error "Illegal syntax")))) (if (and (car state) (eq (car (car (car state))) '||)) nil 'stop))) @@ -4743,6 +4756,23 @@ for a tag on the form `module:tag'." ;;; `module:tag'. +(when (and (fboundp 'etags-tags-completion-table) + (fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+ + (if (fboundp 'advice-add) + ;; Emacs 24.4+ + (advice-add 'etags-tags-completion-table :around + (lambda (oldfun) + (if (eq find-tag-default-function 'erlang-find-tag-for-completion) + (erlang-etags-tags-completion-table) + (funcall oldfun))) + (list :name 'erlang-replace-tags-table)) + ;; Emacs 23.1-24.3 + (defadvice etags-tags-completion-table (around erlang-replace-tags-table activate) + (if (eq find-tag-default-function 'erlang-find-tag-for-completion) + (setq ad-return-value (erlang-etags-tags-completion-table)) + ad-do-it)))) + + (defun erlang-complete-tag () "Perform tags completion on the text around point. Completes to the set of names listed in the current tags table. @@ -4754,7 +4784,17 @@ about Erlang modules." (require 'etags) (error nil)) (cond ((and erlang-tags-installed - (fboundp 'complete-tag)) ; Emacs 19 + (fboundp 'etags-tags-completion-table) + (fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+ + ;; This depends on the advice called erlang-replace-tags-table + ;; above. It is not enough to let-bind + ;; tags-completion-table-function since that will not override + ;; the buffer-local value in the TAGS buffer. + (let ((find-tag-default-function 'erlang-find-tag-for-completion)) + (complete-tag))) + ((and erlang-tags-installed + (fboundp 'complete-tag) + (fboundp 'tags-complete-tag)) ; Emacs 19 (let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag))) (fset 'tags-complete-tag (symbol-function 'erlang-tags-complete-tag)) @@ -4769,6 +4809,15 @@ about Erlang modules." (error "This version of Emacs can't complete tags")))) +(defun erlang-find-tag-for-completion () + (let ((start (save-excursion + (skip-chars-backward "[:word:][:digit:]_:'") + (point)))) + (unless (eq start (point)) + (buffer-substring-no-properties start (point))))) + + + ;; Based on `tags-complete-tag', but this one uses ;; `erlang-tags-completion-table' instead of `tags-completion-table'. ;; @@ -4816,7 +4865,12 @@ about Erlang modules." ;; the only format supported by Emacs, so far.) (defun erlang-etags-tags-completion-table () (let ((table (make-vector 511 0)) - (file nil)) + (file nil) + (progress-reporter + (when (fboundp 'make-progress-reporter) + (make-progress-reporter + (format "Making erlang tags completion table for %s..." buffer-file-name) + (point-min) (point-max))))) (save-excursion (goto-char (point-min)) ;; This monster regexp matches an etags tag line. @@ -4828,31 +4882,33 @@ about Erlang modules." ;; \6 is the line to start searching at; ;; \7 is the char to start searching at. (while (progn - (while (and - (eq (following-char) ?\f) - (looking-at "\f\n\\([^,\n]*\\),.*\n")) - (setq file (buffer-substring - (match-beginning 1) (match-end 1))) - (goto-char (match-end 0))) - (re-search-forward - "\ + (while (and + (eq (following-char) ?\f) + (looking-at "\f\n\\([^,\n]*\\),.*\n")) + (setq file (buffer-substring + (match-beginning 1) (match-end 1))) + (goto-char (match-end 0))) + (re-search-forward + "\ ^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\ \[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\ \\([0-9]+\\)?,\\([0-9]+\\)?\n" - nil t)) - (let ((tag (if (match-beginning 5) - ;; There is an explicit tag name. - (buffer-substring (match-beginning 5) (match-end 5)) - ;; No explicit tag name. Best guess. - (buffer-substring (match-beginning 3) (match-end 3)))) - (module (and file - (erlang-get-module-from-file-name file)))) - (intern tag table) - (if (stringp module) - (progn - (intern (concat module ":" tag) table) - ;; Only the first one will be stored in the table. - (intern (concat module ":") table)))))) + nil t)) + (let ((tag (if (match-beginning 5) + ;; There is an explicit tag name. + (buffer-substring (match-beginning 5) (match-end 5)) + ;; No explicit tag name. Best guess. + (buffer-substring (match-beginning 3) (match-end 3)))) + (module (and file + (erlang-get-module-from-file-name file)))) + (intern tag table) + (when (stringp module) + (intern (concat module ":" tag) table) + ;; Only the first ones will be stored in the table. + (intern (concat module ":") table) + (intern (concat module ":module_info") table)) + (when progress-reporter + (progress-reporter-update progress-reporter (point)))))) table)) ;;; diff --git a/lib/tools/emacs/test.erl.indented b/lib/tools/emacs/test.erl.indented index 1c1086ca58..abb05fd59b 100644 --- a/lib/tools/emacs/test.erl.indented +++ b/lib/tools/emacs/test.erl.indented @@ -32,6 +32,14 @@ -module(test). -compile(export_all). +%% Used to cause an "Unbalanced parentheses" error. +foo(M) -> + M#{a :=<<"a">> + ,b:=1}. +foo() -> + #{a =><<"a">> + ,b=>1}. + %% Module attributes should be highlighted -export([t/1]). diff --git a/lib/tools/emacs/test.erl.orig b/lib/tools/emacs/test.erl.orig index a9d09000d2..3d8f29fe18 100644 --- a/lib/tools/emacs/test.erl.orig +++ b/lib/tools/emacs/test.erl.orig @@ -32,6 +32,14 @@ -module(test). -compile(export_all). +%% Used to cause an "Unbalanced parentheses" error. +foo(M) -> +M#{a :=<<"a">> +,b:=1}. +foo() -> +#{a =><<"a">> +,b=>1}. + %% Module attributes should be highlighted -export([t/1]). diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 6c32c47069..71e17e0ba1 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -136,7 +136,7 @@ -define(SERVER, cover_server). %% Line doesn't matter. --define(BLOCK(Expr), {block,0,[Expr]}). +-define(BLOCK(Expr), {block,erl_anno:new(0),[Expr]}). -define(BLOCK1(Expr), if element(1, Expr) =:= block -> @@ -1626,18 +1626,18 @@ expand({clause,Line,Pattern,Guards,Body}, Vs, N) -> expand({op,_Line,'andalso',ExprL,ExprR}, Vs, N) -> {ExpandedExprL,N2} = expand(ExprL, Vs, N), {ExpandedExprR,N3} = expand(ExprR, Vs, N2), - LineL = element(2, ExpandedExprL), + Anno = element(2, ExpandedExprL), {bool_switch(ExpandedExprL, ExpandedExprR, - {atom,LineL,false}, + {atom,Anno,false}, Vs, N3), N3 + 1}; expand({op,_Line,'orelse',ExprL,ExprR}, Vs, N) -> {ExpandedExprL,N2} = expand(ExprL, Vs, N), {ExpandedExprR,N3} = expand(ExprR, Vs, N2), - LineL = element(2, ExpandedExprL), + Anno = element(2, ExpandedExprL), {bool_switch(ExpandedExprL, - {atom,LineL,true}, + {atom,Anno,true}, ExpandedExprR, Vs, N3), N3 + 1}; @@ -1746,7 +1746,7 @@ munge_body(Expr, Vars) -> munge_body([Expr|Body], Vars, MungedBody, LastExprBumpLines) -> %% Here is the place to add a call to cover:bump/6! - Line = element(2, Expr), + Line = erl_anno:line(element(2, Expr)), Lines = Vars#vars.lines, case lists:member(Line,Lines) of true -> % already a bump at this line @@ -1882,17 +1882,18 @@ fix_cls([Cl | Cls], Line, Bump) -> false -> {clause,CL,P,G,Body} = Cl, UniqueVarName = list_to_atom(lists:concat(["$cover$ ",Line])), - V = {var,0,UniqueVarName}, + A = erl_anno:new(0), + V = {var,A,UniqueVarName}, [Last|Rest] = lists:reverse(Body), - Body1 = lists:reverse(Rest, [{match,0,V,Last},Bump,V]), + Body1 = lists:reverse(Rest, [{match,A,V,Last},Bump,V]), [{clause,CL,P,G,Body1} | fix_cls(Cls, Line, Bump)] end. bumps_line(E, L) -> try bumps_line1(E, L) catch true -> true end. -bumps_line1({call,0,{remote,0,{atom,0,ets},{atom,0,update_counter}}, - [{atom,0,?COVER_TABLE},{tuple,0,[_,_,_,_,_,{integer,0,Line}]},_]}, +bumps_line1({call,_,{remote,_,{atom,_,ets},{atom,_,update_counter}}, + [{atom,_,?COVER_TABLE},{tuple,_,[_,_,_,_,_,{integer,_,Line}]},_]}, Line) -> throw(true); bumps_line1([E | Es], Line) -> @@ -1906,15 +1907,16 @@ bumps_line1(_, _) -> %%% End of fix of last expression. bump_call(Vars, Line) -> - {call,0,{remote,0,{atom,0,ets},{atom,0,update_counter}}, - [{atom,0,?COVER_TABLE}, - {tuple,0,[{atom,0,?BUMP_REC_NAME}, - {atom,0,Vars#vars.module}, - {atom,0,Vars#vars.function}, - {integer,0,Vars#vars.arity}, - {integer,0,Vars#vars.clause}, - {integer,0,Line}]}, - {integer,0,1}]}. + A = erl_anno:new(0), + {call,A,{remote,A,{atom,A,ets},{atom,A,update_counter}}, + [{atom,A,?COVER_TABLE}, + {tuple,A,[{atom,A,?BUMP_REC_NAME}, + {atom,A,Vars#vars.module}, + {atom,A,Vars#vars.function}, + {integer,A,Vars#vars.arity}, + {integer,A,Vars#vars.clause}, + {integer,A,Line}]}, + {integer,A,1}]}. munge_expr({match,Line,ExprL,ExprR}, Vars) -> {MungedExprL, Vars2} = munge_expr(ExprL, Vars), diff --git a/lib/tools/src/cover_web.erl b/lib/tools/src/cover_web.erl index 69f2f3b1aa..75bb45c659 100644 --- a/lib/tools/src/cover_web.erl +++ b/lib/tools/src/cover_web.erl @@ -734,7 +734,7 @@ generate_filename(Prefix) -> filename:join(Cwd,Prefix ++ "_" ++ ts() ++ ".coverdata"). ts() -> - {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(now()), + {{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(erlang:timestamp()), io_lib:format("~4.4.0w~2.2.0w~2.2.0w-~2.2.0w~2.2.0w~2.2.0w", [Y,M,D,H,Min,S]). diff --git a/lib/tools/src/eprof.erl b/lib/tools/src/eprof.erl index bfbbefb473..28cf493a5f 100644 --- a/lib/tools/src/eprof.erl +++ b/lib/tools/src/eprof.erl @@ -187,7 +187,7 @@ handle_call({profile_start, Rootset, Pattern, {M,F,A}, Opts}, From, #state{fd = case set_process_trace(true, [Pid|Rootset], Topts) of true -> ok = set_pattern_trace(true, Pattern), - T0 = now(), + T0 = erlang:timestamp(), ok = execute_profiling(Pid), {noreply, #state{ profiling = true, @@ -211,7 +211,7 @@ handle_call({profile_start, Rootset, Pattern, undefined, Opts}, From, #state{ fd case set_process_trace(true, Rootset, Topts) of true -> - T0 = now(), + T0 = erlang:timestamp(), ok = set_pattern_trace(true, Pattern), {reply, profiling, #state{ profiling = true, @@ -485,20 +485,22 @@ string_bp_mfa([{Mfa, {Count, Time}}|Mfas], Tus, {MfaW, CountW, PercW, TimeW, TpC erlang:max(TpCW, length(Stpc)) }, [[Smfa, Scount, Sperc, Stime, Stpc] | Strings]). -print_bp_mfa(Mfas, {_Tn, Tus}, Fd, Opts) -> +print_bp_mfa(Mfas, {Tn, Tus}, Fd, Opts) -> Fmfas = filter_mfa(sort_mfa(Mfas, proplists:get_value(sort, Opts)), proplists:get_value(filter, Opts)), {{MfaW, CountW, PercW, TimeW, TpCW}, Strs} = string_bp_mfa(Fmfas, Tus), - Ws = { - erlang:max(length("FUNCTION"), MfaW), - erlang:max(length("CALLS"), CountW), - erlang:max(length(" %"), PercW), - erlang:max(length("TIME"), TimeW), - erlang:max(length("uS / CALLS"), TpCW) - }, - format(Fd, Ws, ["FUNCTION", "CALLS", " %", "TIME", "uS / CALLS"]), - format(Fd, Ws, ["--------", "-----", "---", "----", "----------"]), - + TnStr = s(Tn), + TusStr = s(Tus), + TuspcStr = s("~.2f", [divide(Tus,Tn)]), + Ws = {erlang:max(length("FUNCTION"), MfaW), + lists:max([length("CALLS"), CountW, length(TnStr)]), + erlang:max(length(" %"), PercW), + lists:max([length("TIME"), TimeW, length(TusStr)]), + lists:max([length("uS / CALLS"), TpCW, length(TuspcStr)])}, + format(Fd, Ws, ["FUNCTION", "CALLS", " %", "TIME", "uS / CALLS"]), + format(Fd, Ws, ["--------", "-----", "-------", "----", "----------"]), lists:foreach(fun (String) -> format(Fd, Ws, String) end, Strs), + format(Fd, Ws, [lists:duplicate(N,$-)||N <- tuple_to_list(Ws)]), + format(Fd, Ws, ["Total:", TnStr, "100.00%", TusStr, TuspcStr]), ok. s({M,F,A}) -> s("~w:~w/~w",[M,F,A]); diff --git a/lib/tools/src/tags.erl b/lib/tools/src/tags.erl index e3cc51cdb2..e25db2eb1b 100644 --- a/lib/tools/src/tags.erl +++ b/lib/tools/src/tags.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -297,15 +297,16 @@ word_char(_) -> false. %% Check the options `outfile' and `outdir'. open_out(Options) -> + Opts = [write, {encoding, unicode}], case lists:keysearch(outfile, 1, Options) of {value, {outfile, File}} -> - file:open(File, [write]); + file:open(File, Opts); _ -> case lists:keysearch(outdir, 1, Options) of {value, {outdir, Dir}} -> - file:open(filename:join(Dir, "TAGS"), [write]); + file:open(filename:join(Dir, "TAGS"), Opts); _ -> - file:open("TAGS", [write]) + file:open("TAGS", Opts) end end. diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src index ec5b6f3a82..a4e5d85f92 100644 --- a/lib/tools/src/tools.app.src +++ b/lib/tools/src/tools.app.src @@ -41,7 +41,7 @@ ] }, {runtime_dependencies, ["webtool-0.8.10","stdlib-2.0","runtime_tools-1.8.14", - "kernel-3.0","inets-5.10","erts-6.0", + "kernel-3.0","inets-5.10","erts-7.0", "compiler-5.0"]} ] }. diff --git a/lib/tools/src/xref.hrl b/lib/tools/src/xref.hrl index fa8c5c746d..5e79c477f3 100644 --- a/lib/tools/src/xref.hrl +++ b/lib/tools/src/xref.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -22,6 +22,8 @@ -define(VAR_EXPR, '$F_EXPR'). -define(MOD_EXPR, '$M_EXPR'). +-define(XREF_END_LINE, (1 bsl 23)). + %%% Filenames are stored as directory and basename. A lot of heap can %%% be saved by keeping only one (or few) copy of the directory name. diff --git a/lib/tools/src/xref_compiler.erl b/lib/tools/src/xref_compiler.erl index c4b5c04c12..c914a76bf0 100644 --- a/lib/tools/src/xref_compiler.erl +++ b/lib/tools/src/xref_compiler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2014. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -924,7 +924,7 @@ format_parse_error(["invalid_operator", Op], Line) -> format_parse_error(Error, Line) -> io_lib:format("Parse error~s: ~ts~n", [Line, lists:flatten(Error)]). -format_line(-1) -> +format_line(?XREF_END_LINE) -> " at end of string"; format_line(0) -> ""; diff --git a/lib/tools/src/xref_reader.erl b/lib/tools/src/xref_reader.erl index 142d28ebe6..723fb729cd 100644 --- a/lib/tools/src/xref_reader.erl +++ b/lib/tools/src/xref_reader.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -77,17 +77,18 @@ forms([], S) -> form({attribute, Line, xref, Calls}, S) -> % experimental #xrefr{module = M, function = Fun, lattrs = L, xattrs = X, battrs = B} = S, - attr(Calls, Line, M, Fun, L, X, B, S); + attr(Calls, erl_anno:line(Line), M, Fun, L, X, B, S); form({attribute, _Line, _Attr, _Val}, S) -> S; -form({function, 0, module_info, 0, _Clauses}, S) -> +form({function, _, module_info, 0, _Clauses}, S) -> S; -form({function, 0, module_info, 1, _Clauses}, S) -> +form({function, _, module_info, 1, _Clauses}, S) -> S; -form({function, Line, Name, Arity, Clauses}, S) -> +form({function, Anno, Name, Arity, Clauses}, S) -> MFA0 = {S#xrefr.module, Name, Arity}, MFA = adjust_arity(S, MFA0), S1 = S#xrefr{function = MFA}, + Line = erl_anno:line(Anno), S2 = S1#xrefr{def_at = [{MFA,Line} | S#xrefr.def_at]}, S3 = clauses(Clauses, S2), S3#xrefr{function = []}. @@ -305,10 +306,14 @@ fun_args(apply2, [FunArg, Args]) -> {FunArg, Args}; fun_args(1, [FunArg | Args]) -> {FunArg, Args}; fun_args(2, [_Node, FunArg | Args]) -> {FunArg, Args}. -list2term([A | As]) -> - {cons, 0, A, list2term(As)}; -list2term([]) -> - {nil, 0}. +list2term(L) -> + A = erl_anno:new(0), + list2term(L, A). + +list2term([A | As], Anno) -> + {cons, Anno, A, list2term(As)}; +list2term([], Anno) -> + {nil, Anno}. term2list({cons, _Line, H, T}, L, S) -> term2list(T, [H | L], S); @@ -335,10 +340,11 @@ handle_call(Locality, Module, Name, Arity, Line, S) -> handle_call(Locality, To, Line, S, false) end. -handle_call(Locality, To0, Line, S, IsUnres) -> +handle_call(Locality, To0, Anno, S, IsUnres) -> From = S#xrefr.function, To = adjust_arity(S, To0), Call = {From, To}, + Line = erl_anno:line(Anno), CallAt = {Call, Line}, S1 = if IsUnres -> diff --git a/lib/tools/src/xref_scanner.erl b/lib/tools/src/xref_scanner.erl index 990f8aa87b..4c93033d7c 100644 --- a/lib/tools/src/xref_scanner.erl +++ b/lib/tools/src/xref_scanner.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -19,6 +19,8 @@ -module(xref_scanner). +-include("xref.hrl"). + -export([scan/1]). scan(Chars) -> @@ -77,7 +79,7 @@ lex([V={var,N,Var} | L]) -> lex([T | Ts]) -> [T | lex(Ts)]; lex([]) -> - [{'$end', -1}]. + [{'$end', erl_anno:new(?XREF_END_LINE)}]. is_type('Rel') -> true; is_type('App') -> true; diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk index d9651c30e3..3b3202d38b 100644 --- a/lib/tools/vsn.mk +++ b/lib/tools/vsn.mk @@ -1 +1 @@ -TOOLS_VSN = 2.7.1 +TOOLS_VSN = 2.7.2 diff --git a/lib/webtool/doc/src/Makefile b/lib/webtool/doc/src/Makefile index 32269e9424..08292fcca8 100644 --- a/lib/webtool/doc/src/Makefile +++ b/lib/webtool/doc/src/Makefile @@ -25,6 +25,10 @@ include ../../vsn.mk VSN=$(WEBTOOL_VSN) APPLICATION=webtool +DOC_EXTRA_FRONT_PAGE_INFO=Important note: \ +The Webtool application is obsolete and will be removed \ +in the next major OTP release + # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl index 107d064f4a..8e32aeddc8 100644 --- a/lib/wx/api_gen/wx_gen_cpp.erl +++ b/lib/wx/api_gen/wx_gen_cpp.erl @@ -197,8 +197,8 @@ gen_funcs(Defs) -> w(" if(recurse_level > 1 && refd->type != 4) {~n"), w(" delayed_delete->Append(Ecmd.Save());~n"), w(" } else {~n"), - w(" ((WxeApp *) wxTheApp)->clearPtr(This);~n"), - w(" delete_object(This, refd); }~n"), + w(" delete_object(This, refd);~n"), + w(" ((WxeApp *) wxTheApp)->clearPtr(This);}~n"), w(" } } break;~n"), w(" case WXE_REGISTER_OBJECT: {~n" " registerPid(bp, Ecmd.caller, memenv);~n" @@ -975,6 +975,13 @@ build_ret(Name = "ev->m_scanCode",_,#type{base=bool,single=true,by_val=true}) -> w(" rt.addBool(~s);~n",[Name]), w("#else~n rt.addBool(false);~n",[]), w("#endif~n",[]); +build_ret(Name = "ev->m_metaDown",_,#type{base=bool,single=true,by_val=true}) -> + %% Hardcoded workaround for MAC on 2.9 and later + w("#if wxCHECK_VERSION(2,9,0) && defined(_MACOSX)~n", []), + w(" rt.addBool(ev->m_rawControlDown);~n",[]), + w("#else~n rt.addBool(~s);~n",[Name]), + w("#endif~n",[]); + build_ret(Name,_,#type{base=bool,single=true,by_val=true}) -> w(" rt.addBool(~s);~n",[Name]); build_ret(Name,{arg, both},#type{base=int,single=true,mod=M}) -> diff --git a/lib/wx/api_gen/wxapi.conf b/lib/wx/api_gen/wxapi.conf index 2e961cce98..bbf9add59e 100644 --- a/lib/wx/api_gen/wxapi.conf +++ b/lib/wx/api_gen/wxapi.conf @@ -32,7 +32,10 @@ wxALWAYS_NATIVE_DOUBLE_BUFFER, wxGAUGE_EMULATE_INDETERMINATE_MODE, wxTR_DEFAULT_STYLE, - wxSL_LABELS + wxSL_LABELS, + wxCURSOR_DEFAULT, + wxCURSOR_ARROWWAIT, + wxCURSOR_MAX ]}. {gvars, @@ -1355,7 +1358,8 @@ wxEVT_SCROLL_THUMBRELEASE,wxEVT_SCROLL_CHANGED]}], ['GetOrientation','GetPosition']}. {class, wxScrollWinEvent,wxEvent, - [{event, + [{acc, [{m_commandInt, "GetPosition()"}, {m_extraLong, "GetOrientation()"}]}, + {event, [wxEVT_SCROLLWIN_TOP,wxEVT_SCROLLWIN_BOTTOM,wxEVT_SCROLLWIN_LINEUP, wxEVT_SCROLLWIN_LINEDOWN,wxEVT_SCROLLWIN_PAGEUP, wxEVT_SCROLLWIN_PAGEDOWN,wxEVT_SCROLLWIN_THUMBTRACK, @@ -1380,7 +1384,9 @@ 'ShiftDown' ]}. -{class, wxSetCursorEvent, wxEvent, [{event,[wxEVT_SET_CURSOR]}], +{class, wxSetCursorEvent, wxEvent, + [{acc, [{m_x, "GetX()"}, {m_y, "GetY()"}, {m_cursor, "GetCursor()"}]}, + {event,[wxEVT_SET_CURSOR]}], ['GetCursor','GetX','GetY','HasCursor','SetCursor']}. {class, wxKeyEvent, wxEvent, @@ -1395,7 +1401,7 @@ {class, wxSizeEvent, wxEvent, [{event,[wxEVT_SIZE]}], ['GetSize']}. -{class, wxMoveEvent, wxEvent, [{event,[wxEVT_MOVE]}], +{class, wxMoveEvent, wxEvent, [{acc, [{m_pos, "GetPosition()"}, {m_rect, "GetRect()"}]}, {event,[wxEVT_MOVE]}], ['GetPosition']}. {class, wxPaintEvent, wxEvent, [{event,[wxEVT_PAINT]}],[]}. %%{class, wxNcPaintEvent, wxEvent, [{event,[wxEVT_NC_PAINT]}],[]}. @@ -1404,28 +1410,28 @@ {event, [wxEVT_ERASE_BACKGROUND]}], ['GetDC']}. {class, wxFocusEvent, wxEvent, - [{event,[wxEVT_SET_FOCUS,wxEVT_KILL_FOCUS]}], + [{acc, [{m_win, "GetWindow()"}]}, + {event,[wxEVT_SET_FOCUS,wxEVT_KILL_FOCUS]}], ['GetWindow']}. {class,wxChildFocusEvent,wxCommandEvent, [{event,[wxEVT_CHILD_FOCUS]}], ['GetWindow']}. -%% {class, wxActivateEvent, wxEvent, [{event, -%% [wxEVT_ACTIVATE,wxEVT_ACTIVATE_APP,wxEVT_HIBERNATE]}],[]}. - -%%{class, wxInitDialogEvent, wxEvent, [{event, []}],[]}. - -{class, wxMenuEvent, wxEvent, - [{event, [wxEVT_MENU_OPEN,wxEVT_MENU_CLOSE,wxEVT_MENU_HIGHLIGHT]}], +{class, wxMenuEvent, wxEvent, + [{acc, [{m_menuId, "GetMenuId()"}, {m_menu, "GetMenu()"}]}, + {event, [wxEVT_MENU_OPEN,wxEVT_MENU_CLOSE,wxEVT_MENU_HIGHLIGHT]}], ['GetMenu','GetMenuId','IsPopup']}. {class, wxCloseEvent, wxEvent, [{event, [wxEVT_CLOSE_WINDOW,wxEVT_END_SESSION,wxEVT_QUERY_END_SESSION]}], ['CanVeto','GetLoggingOff','SetCanVeto','SetLoggingOff','Veto']}. -{class, wxShowEvent, wxEvent, [{event,[wxEVT_SHOW]}],['SetShow','GetShow']}. -{class, wxIconizeEvent, wxEvent, [{event,[wxEVT_ICONIZE]}],['Iconized']}. +{class, wxShowEvent, wxEvent, [{acc, [{m_show, "GetShow()"}]},{event,[wxEVT_SHOW]}],['SetShow','GetShow']}. +{class, wxIconizeEvent, wxEvent, [{acc, [{m_iconized, "Iconized()"}]},{event,[wxEVT_ICONIZE]}],['Iconized']}. {class, wxMaximizeEvent, wxEvent, [{event,[wxEVT_MAXIMIZE]}],[]}. -{class, wxJoystickEvent, wxEvent, - [{event,[wxEVT_JOY_BUTTON_DOWN,wxEVT_JOY_BUTTON_UP, +{class, wxJoystickEvent, wxEvent, + [{acc, [{m_pos, "GetPosition()"},{m_zPosition, "GetZPosition()"}, + {m_buttonChange, "GetButtonChange()"}, {m_buttonState, "GetButtonState()"}, + {m_joyStick, "GetJoystick()"}]}, + {event,[wxEVT_JOY_BUTTON_DOWN,wxEVT_JOY_BUTTON_UP, wxEVT_JOY_MOVE,wxEVT_JOY_ZMOVE]}], ['ButtonDown','ButtonIsDown','ButtonUp','GetButtonChange','GetButtonState', 'GetJoystick','GetPosition','GetZPosition','IsButton','IsMove','IsZMove']}. @@ -1463,7 +1469,8 @@ 'SetOrigin', 'SetPosition']}. -{class, wxContextMenuEvent, wxCommandEvent, [{event,[wxEVT_CONTEXT_MENU]}], +{class, wxContextMenuEvent, wxCommandEvent, + [{acc, [{m_pos, "GetPosition()"}]}, {event,[wxEVT_CONTEXT_MENU]}], ['GetPosition','SetPosition']}. {enum, wxIdleMode, "wxIDLE_"}. {class, wxIdleEvent, wxEvent, [{event,[wxEVT_IDLE]}], @@ -1522,7 +1529,8 @@ ]}. {class, wxCalendarEvent, wxDateEvent, - [{event,[wxEVT_CALENDAR_SEL_CHANGED, wxEVT_CALENDAR_DAY_CHANGED, + [{acc, [{m_date, "GetDate()"}, {m_wday, "GetWeekDay()"}]}, + {event,[wxEVT_CALENDAR_SEL_CHANGED, wxEVT_CALENDAR_DAY_CHANGED, wxEVT_CALENDAR_MONTH_CHANGED, wxEVT_CALENDAR_YEAR_CHANGED, wxEVT_CALENDAR_DOUBLECLICKED, wxEVT_CALENDAR_WEEKDAY_CLICKED]}], [ @@ -1727,8 +1735,9 @@ ['GetKeyCode','GetItem','GetKeyEvent','GetLabel','GetOldItem','GetPoint', 'IsEditCancelled','SetToolTip']}. -{class, wxNotebookEvent, wxNotifyEvent, - [{event, [wxEVT_COMMAND_NOTEBOOK_PAGE_CHANGED, +{class, wxNotebookEvent, wxNotifyEvent, + [{acc, [{m_nSel, "GetSelection()"}, {m_nOldSel, "GetOldSelection()"}]}, + {event, [wxEVT_COMMAND_NOTEBOOK_PAGE_CHANGED, wxEVT_COMMAND_NOTEBOOK_PAGE_CHANGING]}], ['GetOldSelection','GetSelection','SetOldSelection','SetSelection']}. diff --git a/lib/wx/c_src/gen/wxe_events.cpp b/lib/wx/c_src/gen/wxe_events.cpp index 255b36c2fa..e042b4d890 100644 --- a/lib/wx/c_src/gen/wxe_events.cpp +++ b/lib/wx/c_src/gen/wxe_events.cpp @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2014. All Rights Reserved. + * Copyright Ericsson AB 2008-2015. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -375,10 +375,13 @@ case 165: {// wxScrollEvent or wxSpinEvent break; } case 166: {// wxScrollWinEvent + wxScrollWinEvent * ev = (wxScrollWinEvent *) event; evClass = (char*)"wxScrollWinEvent"; rt.addAtom((char*)"wxScrollWin"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addInt(ev->GetPosition()); + rt.addInt(ev->GetOrientation()); + rt.addTupleCount(4); break; } case 167: {// wxMouseEvent @@ -394,7 +397,11 @@ case 167: {// wxMouseEvent rt.addBool(ev->m_controlDown); rt.addBool(ev->m_shiftDown); rt.addBool(ev->m_altDown); +#if wxCHECK_VERSION(2,9,0) && defined(_MACOSX) + rt.addBool(ev->m_rawControlDown); +#else rt.addBool(ev->m_metaDown); +#endif rt.addInt(ev->m_wheelRotation); rt.addInt(ev->m_wheelDelta); rt.addInt(ev->m_linesPerAction); @@ -402,10 +409,16 @@ case 167: {// wxMouseEvent break; } case 168: {// wxSetCursorEvent + wxSetCursorEvent * ev = (wxSetCursorEvent *) event; + wxCursor * GetCursor = new wxCursor(ev->GetCursor()); + app->newPtr((void *) GetCursor,3, memenv); evClass = (char*)"wxSetCursorEvent"; rt.addAtom((char*)"wxSetCursor"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addInt(ev->GetX()); + rt.addInt(ev->GetY()); + rt.addRef(getRef((void *)GetCursor,memenv), "wxCursor"); + rt.addTupleCount(5); break; } case 169: {// wxKeyEvent @@ -419,7 +432,11 @@ case 169: {// wxKeyEvent rt.addBool(ev->m_controlDown); rt.addBool(ev->m_shiftDown); rt.addBool(ev->m_altDown); +#if wxCHECK_VERSION(2,9,0) && defined(_MACOSX) + rt.addBool(ev->m_rawControlDown); +#else rt.addBool(ev->m_metaDown); +#endif #if !wxCHECK_VERSION(2,9,0) rt.addBool(ev->m_scanCode); #else @@ -442,10 +459,13 @@ case 170: {// wxSizeEvent break; } case 171: {// wxMoveEvent + wxMoveEvent * ev = (wxMoveEvent *) event; evClass = (char*)"wxMoveEvent"; rt.addAtom((char*)"wxMove"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.add(ev->GetPosition()); + rt.add(ev->GetRect()); + rt.addTupleCount(4); break; } case 172: {// wxPaintEvent @@ -466,10 +486,13 @@ case 173: {// wxEraseEvent break; } case 174: {// wxFocusEvent + wxFocusEvent * ev = (wxFocusEvent *) event; + wxWindow * GetWindow = ev->GetWindow(); evClass = (char*)"wxFocusEvent"; rt.addAtom((char*)"wxFocus"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addRef(getRef((void *)GetWindow,memenv), "wxWindow"); + rt.addTupleCount(3); break; } case 175: {// wxChildFocusEvent @@ -480,10 +503,14 @@ case 175: {// wxChildFocusEvent break; } case 176: {// wxMenuEvent + wxMenuEvent * ev = (wxMenuEvent *) event; + wxMenu * GetMenu = ev->GetMenu(); evClass = (char*)"wxMenuEvent"; rt.addAtom((char*)"wxMenu"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addInt(ev->GetMenuId()); + rt.addRef(getRef((void *)GetMenu,memenv), "wxMenu"); + rt.addTupleCount(4); break; } case 177: {// wxCloseEvent @@ -494,17 +521,21 @@ case 177: {// wxCloseEvent break; } case 178: {// wxShowEvent + wxShowEvent * ev = (wxShowEvent *) event; evClass = (char*)"wxShowEvent"; rt.addAtom((char*)"wxShow"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addBool(ev->GetShow()); + rt.addTupleCount(3); break; } case 179: {// wxIconizeEvent + wxIconizeEvent * ev = (wxIconizeEvent *) event; evClass = (char*)"wxIconizeEvent"; rt.addAtom((char*)"wxIconize"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addBool(ev->Iconized()); + rt.addTupleCount(3); break; } case 180: {// wxMaximizeEvent @@ -515,10 +546,16 @@ case 180: {// wxMaximizeEvent break; } case 181: {// wxJoystickEvent + wxJoystickEvent * ev = (wxJoystickEvent *) event; evClass = (char*)"wxJoystickEvent"; rt.addAtom((char*)"wxJoystick"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.add(ev->GetPosition()); + rt.addInt(ev->GetZPosition()); + rt.addInt(ev->GetButtonChange()); + rt.addInt(ev->GetButtonState()); + rt.addInt(ev->GetJoystick()); + rt.addTupleCount(7); break; } case 182: {// wxUpdateUIEvent @@ -595,10 +632,12 @@ case 191: {// wxHelpEvent break; } case 192: {// wxContextMenuEvent + wxContextMenuEvent * ev = (wxContextMenuEvent *) event; evClass = (char*)"wxContextMenuEvent"; rt.addAtom((char*)"wxContextMenu"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.add(ev->GetPosition()); + rt.addTupleCount(3); break; } case 193: {// wxIdleEvent @@ -659,10 +698,13 @@ case 198: {// wxDateEvent break; } case 199: {// wxCalendarEvent + wxCalendarEvent * ev = (wxCalendarEvent *) event; evClass = (char*)"wxCalendarEvent"; rt.addAtom((char*)"wxCalendar"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addInt(ev->GetWeekDay()); + rt.add(ev->GetDate()); + rt.addTupleCount(4); break; } case 200: {// wxFileDirPickerEvent @@ -734,10 +776,13 @@ case 209: {// wxTreeEvent break; } case 210: {// wxNotebookEvent + wxNotebookEvent * ev = (wxNotebookEvent *) event; evClass = (char*)"wxNotebookEvent"; rt.addAtom((char*)"wxNotebook"); rt.addAtom(Etype->eName); - rt.addTupleCount(2); + rt.addInt(ev->GetSelection()); + rt.addInt(ev->GetOldSelection()); + rt.addTupleCount(4); break; } case 216: {// wxClipboardTextEvent diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp index 91ce5d810c..3b11c0642e 100644 --- a/lib/wx/c_src/gen/wxe_funcs.cpp +++ b/lib/wx/c_src/gen/wxe_funcs.cpp @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2014. All Rights Reserved. + * Copyright Ericsson AB 2008-2015. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -51,8 +51,8 @@ void WxeApp::wxe_dispatch(wxeCommand& Ecmd) if(recurse_level > 1 && refd->type != 4) { delayed_delete->Append(Ecmd.Save()); } else { - ((WxeApp *) wxTheApp)->clearPtr(This); - delete_object(This, refd); } + delete_object(This, refd); + ((WxeApp *) wxTheApp)->clearPtr(This);} } } break; case WXE_REGISTER_OBJECT: { registerPid(bp, Ecmd.caller, memenv); diff --git a/lib/wx/c_src/gen/wxe_init.cpp b/lib/wx/c_src/gen/wxe_init.cpp index 3a4bced790..1673f2a1b3 100644 --- a/lib/wx/c_src/gen/wxe_init.cpp +++ b/lib/wx/c_src/gen/wxe_init.cpp @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2008-2014. All Rights Reserved. + * Copyright Ericsson AB 2008-2015. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -56,6 +56,12 @@ void WxeApp::init_nonconsts(wxeMemEnv *memenv, ErlDrvTermData caller) { rt.addTupleCount(2); rt.addAtom("wxMOD_CMD"); rt.addInt(wxMOD_CMD); rt.addTupleCount(2); + rt.addAtom("wxCURSOR_ARROWWAIT"); rt.addInt(wxCURSOR_ARROWWAIT); + rt.addTupleCount(2); + rt.addAtom("wxCURSOR_DEFAULT"); rt.addInt(wxCURSOR_DEFAULT); + rt.addTupleCount(2); + rt.addAtom("wxCURSOR_MAX"); rt.addInt(wxCURSOR_MAX); + rt.addTupleCount(2); rt.addAtom("wxBLACK"); rt.add(*(wxBLACK)); rt.addTupleCount(2); rt.addAtom("wxBLACK_BRUSH"); rt.addRef(getRef((void *)wxBLACK_BRUSH,memenv),"wxBrush"); @@ -138,7 +144,7 @@ void WxeApp::init_nonconsts(wxeMemEnv *memenv, ErlDrvTermData caller) { rt.addTupleCount(2); rt.addAtom("wxWHITE_PEN"); rt.addRef(getRef((void *)wxWHITE_PEN,memenv),"wxPen"); rt.addTupleCount(2); - rt.endList(57); + rt.endList(60); rt.addTupleCount(2); rt.send(); } diff --git a/lib/wx/c_src/wxe_gl.cpp b/lib/wx/c_src/wxe_gl.cpp index a9feb23831..26b45d219e 100644 --- a/lib/wx/c_src/wxe_gl.cpp +++ b/lib/wx/c_src/wxe_gl.cpp @@ -135,8 +135,12 @@ void deleteActiveGL(wxGLCanvas *canvas) void gl_dispatch(int op, char *bp,ErlDrvTermData caller,WXEBinRef *bins[]){ if(caller != gl_active) { wxGLCanvas * current = glc[caller]; - if(current) { gl_active = caller; current->SetCurrent();} - else { + if(current) { + if(current != glc[gl_active]) { + gl_active = caller; + current->SetCurrent(); + } + } else { ErlDrvTermData rt[] = // Error msg {ERL_DRV_ATOM, driver_mk_atom((char *) "_egl_error_"), ERL_DRV_INT, (ErlDrvTermData) op, diff --git a/lib/wx/c_src/wxe_helpers.cpp b/lib/wx/c_src/wxe_helpers.cpp index 15d75080d9..120919e7aa 100644 --- a/lib/wx/c_src/wxe_helpers.cpp +++ b/lib/wx/c_src/wxe_helpers.cpp @@ -24,23 +24,96 @@ * Erlang Commands * ****************************************************************************/ -wxeCommand::wxeCommand(int fc,char * cbuf,int buflen, wxe_data *sd) - : wxObject() +wxeCommand::wxeCommand() { +} + +wxeCommand::~wxeCommand() +{ + Delete(); +} + +void wxeCommand::Delete() +{ + int n = 0; + + if(buffer) { + while(bin[n]) { + if(bin[n]->bin) + driver_free_binary(bin[n]->bin); + driver_free(bin[n++]); + } + if(len > 64) + driver_free(buffer); + buffer = NULL; + op = -1; + } +} + +/* **************************************************************************** + * wxeFifo + * ****************************************************************************/ +wxeFifo::wxeFifo(unsigned int sz) +{ + m_q = (wxeCommand *) driver_alloc(sizeof(wxeCommand) * sz); + m_orig_sz = sz; + m_max = sz; + m_n = 0; + m_first = 0; + m_old = NULL; + for(unsigned int i = 0; i < sz; i++) { + m_q[i].buffer = NULL; + m_q[i].op = -1; + } +} + +wxeFifo::~wxeFifo() { + // dealloc all memory buffers + driver_free(m_q); +} + +wxeCommand * wxeFifo::Get() +{ + unsigned int pos; + if(m_n > 0) { + pos = m_first++; + m_n--; + m_first %= m_max; + return &m_q[pos]; + } + return NULL; +} + +void wxeFifo::Add(int fc, char * cbuf,int buflen, wxe_data *sd) +{ + unsigned int pos; + wxeCommand *curr; + WXEBinRef *temp, *start, *prev; int n = 0; - ref_count = 1; - caller = driver_caller(sd->port_handle); - port = sd->port; - op = fc; - len = buflen; - bin[0] = NULL; - bin[1] = NULL; - bin[2] = NULL; + + if(m_n == (m_max-1)) { // resize + Realloc(); + } + + pos = (m_first + m_n) % m_max; + m_n++; + + curr = &m_q[pos]; + curr->caller = driver_caller(sd->port_handle); + curr->port = sd->port; + curr->op = fc; + curr->len = buflen; + curr->bin[0] = NULL; + curr->bin[1] = NULL; + curr->bin[2] = NULL; if(cbuf) { - buffer = (char *) driver_alloc(len); - memcpy((void *) buffer, (void *) cbuf, len);; + if(buflen > 64) + curr->buffer = (char *) driver_alloc(buflen); + else + curr->buffer = curr->c_buf; + memcpy((void *) curr->buffer, (void *) cbuf, buflen); temp = sd->bin; @@ -48,8 +121,8 @@ wxeCommand::wxeCommand(int fc,char * cbuf,int buflen, wxe_data *sd) start = temp; while(temp) { - if(caller == temp->from) { - bin[n++] = temp; + if(curr->caller == temp->from) { + curr->bin[n++] = temp; if(prev) { prev->next = temp->next; } else { @@ -63,20 +136,68 @@ wxeCommand::wxeCommand(int fc,char * cbuf,int buflen, wxe_data *sd) } sd->bin = start; } else { // No-op only PING currently - buffer = NULL; + curr->buffer = NULL; } } -wxeCommand::~wxeCommand() { - int n = 0; - if(buffer) { - while(bin[n]) { - if(bin[n]->bin) - driver_free_binary(bin[n]->bin); - driver_free(bin[n++]); +void wxeFifo::Append(wxeCommand *orig) +{ + unsigned int pos; + wxeCommand *curr; + if(m_n == (m_max-1)) { // resize + Realloc(); + } + + pos = (m_first + m_n) % m_max; + m_n++; + curr = &m_q[pos]; + curr->caller = orig->caller; + curr->port = orig->port; + curr->op = orig->op; + curr->len = orig->len; + curr->bin[0] = orig->bin[0]; + curr->bin[1] = orig->bin[1]; + curr->bin[2] = orig->bin[2]; + + if(orig->len > 64) + curr->buffer = orig->buffer; + else { + curr->buffer = curr->c_buf; + memcpy((void *) curr->buffer, (void *) orig->buffer, orig->len); + } + orig->op = -1; + orig->buffer = NULL; + orig->bin[0] = NULL; +} + +void wxeFifo::Realloc() +{ + unsigned int i; + unsigned int growth = m_orig_sz / 2; + unsigned int new_sz = growth + m_max; + unsigned int max = m_max; + unsigned int first = m_first; + unsigned int n = m_n; + wxeCommand * old = m_q; + wxeCommand * queue = (wxeCommand *)driver_alloc(new_sz*sizeof(wxeCommand)); + + m_max=new_sz; + m_first = 0; + m_n=0; + m_q = queue; + + for(i=0; i < n; i++) { + unsigned int pos = i+first; + if(old[pos%max].op >= 0) { + Append(&old[pos%max]); } - driver_free(buffer); } + for(i = m_n; i < new_sz; i++) { // Reset the rest + m_q[i].buffer = NULL; + m_q[i].op = -1; + } + // Can not free old queue here it can be used in the wx thread + m_old = old; } /* **************************************************************************** diff --git a/lib/wx/c_src/wxe_helpers.h b/lib/wx/c_src/wxe_helpers.h index 659bc666c6..ec3a5debdb 100644 --- a/lib/wx/c_src/wxe_helpers.h +++ b/lib/wx/c_src/wxe_helpers.h @@ -39,14 +39,14 @@ class wxeMetaCommand : public wxEvent ErlDrvPDL pdl; }; -class wxeCommand : public wxObject +class wxeCommand { public: - wxeCommand(int fc,char * cbuf,int buflen, wxe_data *); + wxeCommand(); virtual ~wxeCommand(); // Use Delete() - wxeCommand * Save() {ref_count++; return this; }; - void Delete() {if(--ref_count < 1) delete this;}; + wxeCommand * Save() { return this; }; + void Delete(); ErlDrvTermData caller; ErlDrvTermData port; @@ -54,7 +54,27 @@ class wxeCommand : public wxObject char * buffer; int len; int op; - int ref_count; + char c_buf[64]; // 64b covers 90% of usage +}; + +class wxeFifo { + public: + wxeFifo(unsigned int size); + virtual ~wxeFifo(); + + void Add(int fc, char * cbuf,int buflen, wxe_data *); + void Append(wxeCommand *Other); + + wxeCommand * Get(); + + void Realloc(); + + unsigned int m_max; + unsigned int m_first; + unsigned int m_n; + unsigned int m_orig_sz; + wxeCommand *m_q; + wxeCommand *m_old; }; class intListElement { diff --git a/lib/wx/c_src/wxe_impl.cpp b/lib/wx/c_src/wxe_impl.cpp index 0ee52e3af2..ef648e008c 100644 --- a/lib/wx/c_src/wxe_impl.cpp +++ b/lib/wx/c_src/wxe_impl.cpp @@ -55,8 +55,9 @@ extern ErlDrvCond * wxe_batch_locker_c; extern ErlDrvTermData init_caller; extern int wxe_status; -wxList * wxe_batch = NULL; -wxList * wxe_batch_cb_saved = NULL; +wxeFifo * wxe_queue = NULL; +wxeFifo * wxe_queue_cb_saved = NULL; + int wxe_batch_caller = 0; // inside batch if larger than 0 /* ************************************************************ @@ -68,30 +69,30 @@ void push_command(int op,char * buf,int len, wxe_data *sd) { /* fprintf(stderr, "Op %d %d [%ld] %d\r\n", op, (int) driver_caller(sd->port_handle), wxe_batch->size(), wxe_batch_caller),fflush(stderr); */ - wxeCommand *Cmd = new wxeCommand(op, buf, len, sd); erl_drv_mutex_lock(wxe_batch_locker_m); - wxe_batch->Append(Cmd); + wxe_queue->Add(op, buf, len, sd); if(wxe_batch_caller > 0) { // wx-thread is waiting on batch end in cond_wait erl_drv_cond_signal(wxe_batch_locker_c); + erl_drv_mutex_unlock(wxe_batch_locker_m); } else { // wx-thread is waiting gui-events if(op == WXE_BATCH_BEGIN) { wxe_batch_caller = 1; } erl_drv_cond_signal(wxe_batch_locker_c); + erl_drv_mutex_unlock(wxe_batch_locker_m); wxWakeUpIdle(); } - erl_drv_mutex_unlock(wxe_batch_locker_m); + } void meta_command(int what, wxe_data *sd) { if(what == PING_PORT) { erl_drv_mutex_lock(wxe_batch_locker_m); if(wxe_batch_caller > 0) { - wxeCommand *Cmd = new wxeCommand(WXE_DEBUG_PING, NULL, 0, sd); - wxe_batch->Append(Cmd); + wxe_queue->Add(WXE_DEBUG_PING, NULL, 0, sd); erl_drv_cond_signal(wxe_batch_locker_c); } wxWakeUpIdle(); @@ -121,12 +122,12 @@ bool WxeApp::OnInit() { global_me = new wxeMemEnv(); - wxe_batch = new wxList; - wxe_batch_cb_saved = new wxList; + wxe_queue = new wxeFifo(1000); + wxe_queue_cb_saved = new wxeFifo(200); cb_buff = NULL; recurse_level = 0; - delayed_cleanup = new wxList; - delayed_delete = new wxList; + delayed_delete = new wxeFifo(10); + delayed_cleanup = new wxList; wxe_ps_init2(); // wxIdleEvent::SetMode(wxIDLE_PROCESS_SPECIFIED); // Hmm printpreview doesn't work in 2.9 with this @@ -169,6 +170,8 @@ void WxeApp::MacOpenFile(const wxString &filename) { void WxeApp::shutdown(wxeMetaCommand& Ecmd) { ExitMainLoop(); + delete wxe_queue; + delete wxe_queue_cb_saved; } void WxeApp::dummy_close(wxEvent& Ev) { @@ -201,11 +204,11 @@ void handle_event_callback(ErlDrvPort port, ErlDrvTermData process) if(driver_monitor_process(port, process, &monitor) == 0) { // Should we be able to handle commands when recursing? probably erl_drv_mutex_lock(wxe_batch_locker_m); - //fprintf(stderr, "\r\nCB EV Start %lu \r\n", process);fflush(stderr); + // fprintf(stderr, "\r\nCB EV Start %lu \r\n", process);fflush(stderr); app->recurse_level++; - app->dispatch_cb(wxe_batch, wxe_batch_cb_saved, process); + app->dispatch_cb(wxe_queue, wxe_queue_cb_saved, process); app->recurse_level--; - //fprintf(stderr, "CB EV done %lu \r\n", process);fflush(stderr); + // fprintf(stderr, "CB EV done %lu \r\n", process);fflush(stderr); wxe_batch_caller = 0; erl_drv_mutex_unlock(wxe_batch_locker_m); driver_demonitor_process(port, &monitor); @@ -216,22 +219,22 @@ void WxeApp::dispatch_cmds() { erl_drv_mutex_lock(wxe_batch_locker_m); recurse_level++; - int level = dispatch(wxe_batch_cb_saved, 0, WXE_STORED); - dispatch(wxe_batch, level, WXE_NORMAL); + int level = dispatch(wxe_queue_cb_saved, 0, WXE_STORED); + dispatch(wxe_queue, level, WXE_NORMAL); recurse_level--; wxe_batch_caller = 0; + if(wxe_queue->m_old) { + driver_free(wxe_queue->m_old); + wxe_queue->m_old = NULL; + } erl_drv_mutex_unlock(wxe_batch_locker_m); // Cleanup old memenv's and deleted objects if(recurse_level == 0) { - if(delayed_delete->size() > 0) - for( wxList::compatibility_iterator node = delayed_delete->GetFirst(); - node; - node = delayed_delete->GetFirst()) { - wxeCommand *event = (wxeCommand *)node->GetData(); - delayed_delete->Erase(node); - wxe_dispatch(*event); - event->Delete(); - } + wxeCommand *curr; + while((curr = delayed_delete->Get()) != NULL) { + wxe_dispatch(*curr); + curr->Delete(); + } if(delayed_cleanup->size() > 0) for( wxList::compatibility_iterator node = delayed_cleanup->GetFirst(); node; @@ -241,158 +244,145 @@ void WxeApp::dispatch_cmds() destroyMemEnv(*event); delete event; } + if(wxe_queue_cb_saved->m_old) { + driver_free(wxe_queue_cb_saved->m_old); + wxe_queue_cb_saved->m_old = NULL; + } + if(delayed_delete->m_old) { + driver_free(delayed_delete->m_old); + delayed_delete->m_old = NULL; + } } } // Should have erl_drv_mutex_lock(wxe_batch_locker_m); // when entering this function and it should be released // afterwards -int WxeApp::dispatch(wxList * batch, int blevel, int list_type) +int WxeApp::dispatch(wxeFifo * batch, int blevel, int list_type) { int ping = 0; // erl_drv_mutex_lock(wxe_batch_locker_m); must be locked already - while(true) - { - if (batch->size() > 0) { - for( wxList::compatibility_iterator node = batch->GetFirst(); - node; - node = batch->GetFirst()) - { - wxeCommand *event = (wxeCommand *)node->GetData(); - batch->Erase(node); - switch(event->op) { - case WXE_BATCH_END: - {--blevel; } - break; - case WXE_BATCH_BEGIN: - {blevel++; } - break; - case WXE_DEBUG_PING: - // When in debugger we don't want to hang waiting for a BATCH_END - // that never comes, because a breakpoint have hit. - ping++; - if(ping > 2) - blevel = 0; - break; - case WXE_CB_RETURN: - // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after - // whatever cleaning is necessary - if(event->len > 0) { - cb_buff = (char *) driver_alloc(event->len); - memcpy(cb_buff, event->buffer, event->len); - } - return blevel; - default: - erl_drv_mutex_unlock(wxe_batch_locker_m); - if(event->op < OPENGL_START) { - // fprintf(stderr, " c %d (%d) \r\n", event->op, blevel); - wxe_dispatch(*event); - } else { - gl_dispatch(event->op,event->buffer,event->caller,event->bin); - } - erl_drv_mutex_lock(wxe_batch_locker_m); - break; - } - event->Delete(); - } - } else { - if((list_type == WXE_STORED) || (blevel <= 0 && list_type == WXE_NORMAL)) { - // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after - // whatever cleaning is necessary - return blevel; + wxeCommand *event; + while(true) { + while((event = batch->Get()) != NULL) { + switch(event->op) { + case -1: + break; + case WXE_BATCH_END: + {--blevel; } + break; + case WXE_BATCH_BEGIN: + {blevel++; } + break; + case WXE_DEBUG_PING: + // When in debugger we don't want to hang waiting for a BATCH_END + // that never comes, because a breakpoint have hit. + ping++; + if(ping > 2) + blevel = 0; + break; + case WXE_CB_RETURN: + // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after + // whatever cleaning is necessary + if(event->len > 0) { + cb_buff = (char *) driver_alloc(event->len); + memcpy(cb_buff, event->buffer, event->len); } - // sleep until something happens - //fprintf(stderr, "%s:%d sleep %d %d %d %d \r\n", __FILE__, __LINE__, batch->size(), callback_returned, blevel, is_callback);fflush(stderr); - wxe_batch_caller++; - while(batch->size() == 0) { - erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); + event->Delete(); + return blevel; + default: + erl_drv_mutex_unlock(wxe_batch_locker_m); + if(event->op < OPENGL_START) { + // fprintf(stderr, " c %d (%d) \r\n", event->op, blevel); + wxe_dispatch(*event); + } else { + gl_dispatch(event->op,event->buffer,event->caller,event->bin); } + erl_drv_mutex_lock(wxe_batch_locker_m); + break; } + event->Delete(); + } + if((list_type == WXE_STORED) || (blevel <= 0 && list_type == WXE_NORMAL)) { + // erl_drv_mutex_unlock(wxe_batch_locker_m); should be called after + // whatever cleaning is necessary + return blevel; } + // sleep until something happens + //fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, batch->size(), blevel);fflush(stderr); + wxe_batch_caller++; + while(batch->m_n == 0) { + erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); + } + } } -void WxeApp::dispatch_cb(wxList * batch, wxList * temp, ErlDrvTermData process) { - int callback_returned = 0; +void WxeApp::dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process) { + wxeCommand *event; while(true) { - if (batch->size() > 0) { - for( wxList::compatibility_iterator node = batch->GetFirst(); - node; - node = batch->GetFirst()) - { - wxeCommand *event = (wxeCommand *)node->GetData(); - wxeMemEnv *memenv = getMemEnv(event->port); - batch->Erase(node); - // fprintf(stderr, " Ev %d %lu\r\n", event->op, event->caller); - if(event->caller == process || // Callbacks from CB process only - event->op == WXE_CB_START || // Event callback start change process - event->op == WXE_CB_DIED || // Event callback process died - // Allow connect_cb during CB i.e. msg from wxe_server. - (memenv && event->caller == memenv->owner)) - { - switch(event->op) { - case WXE_BATCH_END: - case WXE_BATCH_BEGIN: - case WXE_DEBUG_PING: - break; - case WXE_CB_RETURN: - if(event->len > 0) { - cb_buff = (char *) driver_alloc(event->len); - memcpy(cb_buff, event->buffer, event->len); - } // continue - case WXE_CB_DIED: - callback_returned = 1; - return; - case WXE_CB_START: - // CB start from now accept message from CB process only - process = event->caller; - break; - default: - erl_drv_mutex_unlock(wxe_batch_locker_m); - size_t start=temp->GetCount(); - if(event->op < OPENGL_START) { - // fprintf(stderr, " cb %d \r\n", event->op); - wxe_dispatch(*event); - } else { - gl_dispatch(event->op,event->buffer,event->caller,event->bin); - } - erl_drv_mutex_lock(wxe_batch_locker_m); - if(temp->GetCount() > start) { - // We have recursed dispatch_cb and messages for this - // callback may be saved on temp list move them - // to orig list - for(wxList::compatibility_iterator node = temp->Item(start); - node; - node = node->GetNext()) { - wxeCommand *ev = (wxeCommand *)node->GetData(); - if(ev->caller == process) { - batch->Append(ev); - temp->Erase(node); - } - } - } - if(callback_returned) - return; - break; + while((event = batch->Get()) != NULL) { + wxeMemEnv *memenv = getMemEnv(event->port); + // fprintf(stderr, " Ev %d %lu\r\n", event->op, event->caller); + if(event->caller == process || // Callbacks from CB process only + event->op == WXE_CB_START || // Event callback start change process + event->op == WXE_CB_DIED || // Event callback process died + // Allow connect_cb during CB i.e. msg from wxe_server. + (memenv && event->caller == memenv->owner)) { + switch(event->op) { + case -1: + case WXE_BATCH_END: + case WXE_BATCH_BEGIN: + case WXE_DEBUG_PING: + break; + case WXE_CB_RETURN: + if(event->len > 0) { + cb_buff = (char *) driver_alloc(event->len); + memcpy(cb_buff, event->buffer, event->len); + } // continue + case WXE_CB_DIED: + event->Delete(); + return; + case WXE_CB_START: + // CB start from now accept message from CB process only + process = event->caller; + break; + default: + erl_drv_mutex_unlock(wxe_batch_locker_m); + size_t start=temp->m_n; + if(event->op < OPENGL_START) { + // fprintf(stderr, " cb %d \r\n", event->op); + wxe_dispatch(*event); + } else { + gl_dispatch(event->op,event->buffer,event->caller,event->bin); + } + erl_drv_mutex_lock(wxe_batch_locker_m); + if(temp->m_n > start) { + // We have recursed dispatch_cb and messages for this + // callback may be saved on temp list move them + // to orig list + for(unsigned int i=start; i < temp->m_n; i++) { + wxeCommand *ev = &temp->m_q[(temp->m_first+i) % temp->m_max]; + if(ev->caller == process) { + batch->Append(ev); } - event->Delete(); - } else { - // fprintf(stderr, " save %d \r\n", event->op); - temp->Append(event); + } } + break; } - } else { - if(callback_returned) { - return; - } - // sleep until something happens - //fprintf(stderr, "%s:%d sleep %d %d %d %d \r\n", __FILE__, __LINE__, batch->size(), callback_returned, blevel, is_callback);fflush(stderr); - while(batch->size() == 0) { - erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); + event->Delete(); + } else { + // fprintf(stderr, " save %d %lu\r\n", event->op, event->caller); + temp->Append(event); } } + // sleep until something happens + // fprintf(stderr, "%s:%d sleep %d %d\r\n", __FILE__, __LINE__, + // batch->m_n, temp->m_n);fflush(stderr); + while(batch->m_n == 0) { + erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m); + } } } - /* Memory handling */ void WxeApp::newMemEnv(wxeMetaCommand& Ecmd) { diff --git a/lib/wx/c_src/wxe_impl.h b/lib/wx/c_src/wxe_impl.h index 57bf2e2dba..a0a1c84718 100644 --- a/lib/wx/c_src/wxe_impl.h +++ b/lib/wx/c_src/wxe_impl.h @@ -60,8 +60,8 @@ public: #endif void shutdown(wxeMetaCommand& event); - int dispatch(wxList *, int, int); - void dispatch_cb(wxList * batch, wxList * temp, ErlDrvTermData process); + int dispatch(wxeFifo *, int, int); + void dispatch_cb(wxeFifo * batch, wxeFifo * temp, ErlDrvTermData process); void wxe_dispatch(wxeCommand& event); @@ -93,7 +93,7 @@ public: int recurse_level; wxList * delayed_cleanup; - wxList * delayed_delete; + wxeFifo * delayed_delete; // Temp container for callbacks char *cb_buff; int cb_len; diff --git a/lib/wx/configure.in b/lib/wx/configure.in index 4c4d4f41a8..fbdddb9220 100644 --- a/lib/wx/configure.in +++ b/lib/wx/configure.in @@ -441,19 +441,26 @@ else else CWXWIN_PROG=`cygpath -d "$PROGRAMFILES" | cygpath -f - 2>/dev/null` fi - CWXWIN3=$CWXWIN_PROG/wxWidgets-?.*.* - CWXWIN4=$CWXWIN_PROG/wxMSW-?.*.* - CWX_DOCUMENTED="/opt/local/pgm/wxMSW-?.*.* /opt/local/pgm/wxWidgets-?.*.*" + + CWXWIN3="$CWXWIN_PROG/wxWidgets-3.*.* $CWXWIN_PROG/wxWidgets-2.*.*" + CWXWIN4="$CWXWIN_PROG/wxMSW-3.*.* $CWXWIN_PROG/wxMSW-2.*.*" + + DOC_OPT=/opt/local/pgm + CWX_DOCUMENTED="$DOC_OPT/wxWidgets-2.*.* $DOC_OPT/wxMSW-2.*.*" + CWX_DOCUMENTED="$DOC_OPT/wxWidgets-3.*.* $DOC_OPT/wxMSW-3.*.* $CWX_DOCUMENTED" + case $ac_cv_sizeof_void_p in 8) - CWX_DOCUMENTED="/opt/local64/pgm/wxMSW-?.*.* /opt/local64/pgm/wxWidgets-?.*.* $CWX_DOCUMENTED" + DOC_OPT64=/opt/local64/pgm + CWX_DOCUMENTED="$DOC_OPT64/wxWidgets-2.*.* $DOC_OPT64/wxMSW-2.*.* $CWX_DOCUMENTED" + CWX_DOCUMENTED="$DOC_OPT64/wxWidgets-3.*.* $DOC_OPT64/wxMSW-3.*.* $CWX_DOCUMENTED" ;; *) true ;; - esac - - CWXPATH="$CWXWIN0 $CWXWIN1 $CWXWIN2 $CWX_DOCUMENTED $CWXWIN3.* $CWXWIN4.*" + esac + + CWXPATH="$CWXWIN0 $CWXWIN1 $CWXWIN2 $CWX_DOCUMENTED $CWXWIN3 $CWXWIN4" for dir in $CWXPATH; do AC_MSG_NOTICE(Checking: [$dir]) diff --git a/lib/wx/doc/src/notes.xml b/lib/wx/doc/src/notes.xml index 52087398e7..682ab48ca0 100644 --- a/lib/wx/doc/src/notes.xml +++ b/lib/wx/doc/src/notes.xml @@ -31,6 +31,21 @@ <p>This document describes the changes made to the wxErlang application.</p> +<section><title>Wx 1.3.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix timing related crash during wx application stop.</p> + <p> + Own Id: OTP-12374</p> + </item> + </list> + </section> + +</section> + <section><title>Wx 1.3.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/wx/examples/demo/demo.erl b/lib/wx/examples/demo/demo.erl index 2f560096f5..65fb05cd94 100644 --- a/lib/wx/examples/demo/demo.erl +++ b/lib/wx/examples/demo/demo.erl @@ -256,9 +256,17 @@ handle_event(#wx{id = Id, wx_misc:launchDefaultBrowser("http://www.erlang.org/doc/apps/wx/part_frame.html"), {noreply, State}; ?wxID_ABOUT -> + WxWVer = io_lib:format("~p.~p.~p.~p", + [?wxMAJOR_VERSION, ?wxMINOR_VERSION, + ?wxRELEASE_NUMBER, ?wxSUBRELEASE_NUMBER]), + application:load(wx), + {ok, WxVsn} = application:get_key(wx, vsn), AboutString = "Demo of various widgets\n" - "Authors: Olle & Dan", + "Authors: Olle & Dan\n\n" ++ + "Frontend: wx-" ++ WxVsn ++ + "\nBackend: wxWidgets-" ++ lists:flatten(WxWVer), + wxMessageDialog:showModal(wxMessageDialog:new(State#state.win, AboutString, [{style, ?wxOK bor diff --git a/lib/wx/examples/demo/demo_html_tagger.erl b/lib/wx/examples/demo/demo_html_tagger.erl index 7bb6736fdc..b119f0e226 100644 --- a/lib/wx/examples/demo/demo_html_tagger.erl +++ b/lib/wx/examples/demo/demo_html_tagger.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% Copyright Ericsson AB 2009-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -267,8 +267,10 @@ normalize_toks(Toks) -> normalize_tok(Tok) -> %% this is the portable way ... - [{_,Type},{_,Line},{_,Col},{_,Txt}] = - erl_scan:token_info(Tok, [category,line,column,text]), + Type = erl_scan:category(Tok), + Line = erl_scan:line(Tok), + Col = erl_scan:column(Tok), + Txt = erl_scan:text(Tok), Val = {Type,{Line,Col},Txt}, %% io:format("here:X=~p ~p~n",[Tok,Val]), Val. diff --git a/lib/wx/include/wx.hrl b/lib/wx/include/wx.hrl index 348daf64ce..97cb689374 100644 --- a/lib/wx/include/wx.hrl +++ b/lib/wx/include/wx.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -54,7 +54,9 @@ -type wxListEventType() :: command_list_begin_drag | command_list_begin_rdrag | command_list_begin_label_edit | command_list_end_label_edit | command_list_delete_item | command_list_delete_all_items | command_list_key_down | command_list_insert_item | command_list_col_click | command_list_col_right_click | command_list_col_begin_drag | command_list_col_dragging | command_list_col_end_drag | command_list_item_selected | command_list_item_deselected | command_list_item_right_click | command_list_item_middle_click | command_list_item_activated | command_list_item_focused | command_list_cache_hint. -type wxList() :: #wxList{}. %% Callback event: {@link wxListEvent} --record(wxNotebook, {type :: wxNotebookEventType()}). %% Callback event: {@link wxNotebookEvent} +-record(wxNotebook,{type :: wxNotebookEventType(), %% Callback event: {@link wxNotebookEvent} + nSel :: integer(), + nOldSel :: integer()}). -type wxNotebookEventType() :: command_notebook_page_changed | command_notebook_page_changing. -type wxNotebook() :: #wxNotebook{}. %% Callback event: {@link wxNotebookEvent} @@ -86,7 +88,9 @@ -type wxWindowDestroyEventType() :: destroy. -type wxWindowDestroy() :: #wxWindowDestroy{}. %% Callback event: {@link wxWindowDestroyEvent} --record(wxCalendar, {type :: wxCalendarEventType()}). %% Callback event: {@link wxCalendarEvent} +-record(wxCalendar,{type :: wxCalendarEventType(), %% Callback event: {@link wxCalendarEvent} + wday :: wx:wx_enum(), + date :: wx:wx_datetime()}). -type wxCalendarEventType() :: calendar_sel_changed | calendar_day_changed | calendar_month_changed | calendar_year_changed | calendar_doubleclicked | calendar_weekday_clicked. -type wxCalendar() :: #wxCalendar{}. %% Callback event: {@link wxCalendarEvent} @@ -100,15 +104,19 @@ -type wxScrollEventType() :: scroll_top | scroll_bottom | scroll_lineup | scroll_linedown | scroll_pageup | scroll_pagedown | scroll_thumbtrack | scroll_thumbrelease | scroll_changed. -type wxScroll() :: #wxScroll{}. %% Callback event: {@link wxScrollEvent} --record(wxMenu, {type :: wxMenuEventType()}). %% Callback event: {@link wxMenuEvent} +-record(wxMenu,{type :: wxMenuEventType(), %% Callback event: {@link wxMenuEvent} + menuId :: integer(), + menu :: wxMenu:wxMenu()}). -type wxMenuEventType() :: menu_open | menu_close | menu_highlight. -type wxMenu() :: #wxMenu{}. %% Callback event: {@link wxMenuEvent} --record(wxContextMenu, {type :: wxContextMenuEventType()}). %% Callback event: {@link wxContextMenuEvent} +-record(wxContextMenu,{type :: wxContextMenuEventType(), %% Callback event: {@link wxContextMenuEvent} + pos :: {X::integer(), Y::integer()}}). -type wxContextMenuEventType() :: context_menu. -type wxContextMenu() :: #wxContextMenu{}. %% Callback event: {@link wxContextMenuEvent} --record(wxShow, {type :: wxShowEventType()}). %% Callback event: {@link wxShowEvent} +-record(wxShow,{type :: wxShowEventType(), %% Callback event: {@link wxShowEvent} + show :: boolean()}). -type wxShowEventType() :: show. -type wxShow() :: #wxShow{}. %% Callback event: {@link wxShowEvent} @@ -117,7 +125,10 @@ -type wxSpinEventType() :: command_spinctrl_updated | spin_up | spin_down | spin. -type wxSpin() :: #wxSpin{}. %% Callback event: {@link wxSpinEvent} --record(wxSetCursor, {type :: wxSetCursorEventType()}). %% Callback event: {@link wxSetCursorEvent} +-record(wxSetCursor,{type :: wxSetCursorEventType(), %% Callback event: {@link wxSetCursorEvent} + x :: integer(), + y :: integer(), + cursor :: wxCursor:wxCursor()}). -type wxSetCursorEventType() :: set_cursor. -type wxSetCursor() :: #wxSetCursor{}. %% Callback event: {@link wxSetCursorEvent} @@ -126,7 +137,9 @@ -type wxFontPickerEventType() :: command_fontpicker_changed. -type wxFontPicker() :: #wxFontPicker{}. %% Callback event: {@link wxFontPickerEvent} --record(wxScrollWin, {type :: wxScrollWinEventType()}). %% Callback event: {@link wxScrollWinEvent} +-record(wxScrollWin,{type :: wxScrollWinEventType(), %% Callback event: {@link wxScrollWinEvent} + commandInt :: integer(), + extraLong :: integer()}). -type wxScrollWinEventType() :: scrollwin_top | scrollwin_bottom | scrollwin_lineup | scrollwin_linedown | scrollwin_pageup | scrollwin_pagedown | scrollwin_thumbtrack | scrollwin_thumbrelease. -type wxScrollWin() :: #wxScrollWin{}. %% Callback event: {@link wxScrollWinEvent} @@ -147,7 +160,8 @@ -type wxFileDirPickerEventType() :: command_filepicker_changed | command_dirpicker_changed. -type wxFileDirPicker() :: #wxFileDirPicker{}. %% Callback event: {@link wxFileDirPickerEvent} --record(wxFocus, {type :: wxFocusEventType()}). %% Callback event: {@link wxFocusEvent} +-record(wxFocus,{type :: wxFocusEventType(), %% Callback event: {@link wxFocusEvent} + win :: wxWindow:wxWindow()}). -type wxFocusEventType() :: set_focus | kill_focus. -type wxFocus() :: #wxFocus{}. %% Callback event: {@link wxFocusEvent} @@ -225,7 +239,8 @@ -type wxSizeEventType() :: size. -type wxSize() :: #wxSize{}. %% Callback event: {@link wxSizeEvent} --record(wxIconize, {type :: wxIconizeEventType()}). %% Callback event: {@link wxIconizeEvent} +-record(wxIconize,{type :: wxIconizeEventType(), %% Callback event: {@link wxIconizeEvent} + iconized :: boolean()}). -type wxIconizeEventType() :: iconize. -type wxIconize() :: #wxIconize{}. %% Callback event: {@link wxIconizeEvent} @@ -289,7 +304,12 @@ -type wxCommandEventType() :: command_button_clicked | command_checkbox_clicked | command_choice_selected | command_listbox_selected | command_listbox_doubleclicked | command_text_updated | command_text_enter | command_menu_selected | command_slider_updated | command_radiobox_selected | command_radiobutton_selected | command_scrollbar_updated | command_vlbox_selected | command_combobox_selected | command_tool_rclicked | command_tool_enter | command_checklistbox_toggled | command_togglebutton_clicked | command_left_click | command_left_dclick | command_right_click | command_set_focus | command_kill_focus | command_enter. -type wxCommand() :: #wxCommand{}. %% Callback event: {@link wxCommandEvent} --record(wxJoystick, {type :: wxJoystickEventType()}). %% Callback event: {@link wxJoystickEvent} +-record(wxJoystick,{type :: wxJoystickEventType(), %% Callback event: {@link wxJoystickEvent} + pos :: {X::integer(), Y::integer()}, + zPosition :: integer(), + buttonChange :: integer(), + buttonState :: integer(), + joyStick :: integer()}). -type wxJoystickEventType() :: joy_button_down | joy_button_up | joy_move | joy_zmove. -type wxJoystick() :: #wxJoystick{}. %% Callback event: {@link wxJoystickEvent} @@ -297,7 +317,9 @@ -type wxQueryNewPaletteEventType() :: query_new_palette. -type wxQueryNewPalette() :: #wxQueryNewPalette{}. %% Callback event: {@link wxQueryNewPaletteEvent} --record(wxMove, {type :: wxMoveEventType()}). %% Callback event: {@link wxMoveEvent} +-record(wxMove,{type :: wxMoveEventType(), %% Callback event: {@link wxMoveEvent} + pos :: {X::integer(), Y::integer()}, + rect :: {X::integer(), Y::integer(), W::integer(), H::integer()}}). -type wxMoveEventType() :: move. -type wxMove() :: #wxMove{}. %% Callback event: {@link wxMoveEvent} @@ -1883,9 +1905,9 @@ -define(wxCURSOR_WAIT, 24). -define(wxCURSOR_WATCH, 25). -define(wxCURSOR_BLANK, 26). --define(wxCURSOR_DEFAULT, 27). --define(wxCURSOR_ARROWWAIT, 28). --define(wxCURSOR_MAX, 29). +-define(wxCURSOR_DEFAULT, wxe_util:get_const(wxCURSOR_DEFAULT)). +-define(wxCURSOR_ARROWWAIT, wxe_util:get_const(wxCURSOR_ARROWWAIT)). +-define(wxCURSOR_MAX, wxe_util:get_const(wxCURSOR_MAX)). % From "generic_2laywin.h" -define(wxLAYOUT_QUERY, 256). -define(wxLAYOUT_MRU_LENGTH, 16). diff --git a/lib/wx/test/wx_class_SUITE.erl b/lib/wx/test/wx_class_SUITE.erl index b127e6b71d..45ab0f3a32 100644 --- a/lib/wx/test/wx_class_SUITE.erl +++ b/lib/wx/test/wx_class_SUITE.erl @@ -231,8 +231,15 @@ staticBoxSizer(Config) -> clipboard(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo); -clipboard(_Config) -> - wx:new(), +clipboard(Config) -> + Wx = wx:new(), + Frame = wxFrame:new(Wx, ?wxID_ANY, "Main Frame"), + Ctrl = wxTextCtrl:new(Frame, ?wxID_ANY, [{size, {600,400}}, {style, ?wxTE_MULTILINE}]), + wxTextCtrl:connect(Ctrl, command_text_copy, [{skip, true}]), + wxTextCtrl:connect(Ctrl, command_text_cut, [{skip, true}]), + wxTextCtrl:connect(Ctrl, command_text_paste, [{skip, true}]), + wxWindow:show(Frame), + CB = ?mt(wxClipboard, wxClipboard:get()), wxClipboard:usePrimarySelection(CB), ?m(false, wx:is_null(CB)), @@ -271,7 +278,8 @@ clipboard(_Config) -> ?log("Flushing ~n",[]), wxClipboard:flush(CB), ?log("Stopping ~n",[]), - ok. + wx_test_lib:wx_destroy(Frame,Config). + helpFrame(TestInfo) when is_atom(TestInfo) -> wx_test_lib:tc_info(TestInfo); helpFrame(Config) -> diff --git a/lib/wx/test/wx_event_SUITE.erl b/lib/wx/test/wx_event_SUITE.erl index 3252547c9b..6bcd88e4fb 100644 --- a/lib/wx/test/wx_event_SUITE.erl +++ b/lib/wx/test/wx_event_SUITE.erl @@ -379,25 +379,29 @@ recursive(Config) -> Frame = wxFrame:new(Wx, ?wxID_ANY, "Connect in callback"), Panel = wxPanel:new(Frame, []), Sz = wxBoxSizer:new(?wxVERTICAL), - ListBox = wxListBox:new(Panel, ?wxID_ANY, [{choices, ["foo", "bar", "baz"]}]), - wxSizer:add(Sz, ListBox, [{proportion, 1},{flag, ?wxEXPAND}]), - wxWindow:setSizer(Panel, Sz), - wxListBox:connect(ListBox, command_listbox_selected, - [{callback, - fun(#wx{event=#wxCommand{commandInt=Id}}, _) -> - io:format("Selected ~p~n",[Id]) - end}]), - wxListBox:setSelection(ListBox, 0), - wxListBox:connect(ListBox, size, - [{callback, - fun(#wx{event=#wxSize{}}, _) -> - io:format("Size init ~n",[]), - case wxListBox:getCount(ListBox) > 0 of - true -> wxListBox:delete(ListBox, 0); - false -> ok - end, - io:format("Size done ~n",[]) - end}]), + Ctrl1 = wxTextCtrl:new(Panel, ?wxID_ANY, [{size, {300, -1}}]), + Ctrl2 = wxTextCtrl:new(Panel, ?wxID_ANY, [{size, {300, -1}}]), + wxSizer:add(Sz, Ctrl1, [{proportion, 1},{flag, ?wxEXPAND}]), + wxSizer:add(Sz, Ctrl2, [{proportion, 1},{flag, ?wxEXPAND}]), + wxWindow:setSizerAndFit(Panel, Sz), + + CB1 = fun(#wx{event=#wxCommand{cmdString=String}}, _) -> + io:format(" CB1: ~s~n",[String]), + wxTextCtrl:setValue(Ctrl2, io_lib:format("from CB1 ~s", [String])) + end, + CB2 = fun(#wx{event=#wxCommand{cmdString=String}}, _) -> + io:format(" CB2: ~s~n",[String]), + ok + end, + wxTextCtrl:connect(Ctrl1, command_text_updated, [{callback,CB1}]), + wxTextCtrl:connect(Ctrl2, command_text_updated, [{callback,CB2}]), + wxFrame:connect(Frame, size, + [{callback, + fun(#wx{event=#wxSize{size=Size}}, _) -> + io:format("Size init: ~s ~n",[wxTextCtrl:getValue(Ctrl2)]), + wxTextCtrl:setValue(Ctrl1, io_lib:format("Size ~p", [Size])), + io:format("Size done: ~s ~n",[wxTextCtrl:getValue(Ctrl2)]) + end}]), wxFrame:show(Frame), wx_test_lib:flush(), diff --git a/lib/wx/vsn.mk b/lib/wx/vsn.mk index 78c24ec093..942d4c0d6f 100644 --- a/lib/wx/vsn.mk +++ b/lib/wx/vsn.mk @@ -1 +1 @@ -WX_VSN = 1.3.2 +WX_VSN = 1.3.3 diff --git a/lib/xmerl/src/xmerl.erl b/lib/xmerl/src/xmerl.erl index 01af183eef..88eaefc492 100644 --- a/lib/xmerl/src/xmerl.erl +++ b/lib/xmerl/src/xmerl.erl @@ -313,7 +313,7 @@ apply_cb([M|Ms], F, Df, Args, A, Ms0) -> true -> apply(M, F, Args); false -> apply_cb(Ms, F, Df, Args, A, Ms0) end; -apply_cb([], Df, Df, Args, A, _Ms0) -> +apply_cb([], Df, Df, Args, _A, _Ms0) -> exit({unknown_tag, {Df, Args}}); apply_cb([], F, Df, Args, A, Ms0) -> apply_cb(Ms0, Df, Df, [F|Args], A+1). diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk index aab2a37d6c..1ed230316f 100644 --- a/lib/xmerl/vsn.mk +++ b/lib/xmerl/vsn.mk @@ -1 +1 @@ -XMERL_VSN = 1.3.7 +XMERL_VSN = 1.3.8 |